Fix compiler ppx issue when combining async and uncurried application

Fixes #5854

The compiler ppx for `async` and `await` was propagating annotations of the body. When the body happens to be an uncurried application, the `@res.app` annotation was propagated to the code generated by the PPX and produced a type error (E.g. it would generate an uncurried call to the internal function `unsafe_await`).

Author: cristianoc

CHANGELOG.md

@@ -43,6 +43,7 @@ These are only breaking changes for unformatted code.
 - Fix issue in printing uncurried callbacks https://github.com/rescript-lang/rescript-compiler/pull/5828
 - Fix formatting uncurried functions with attributes https://github.com/rescript-lang/rescript-compiler/pull/5829
 - Fix parsing/printing uncurried functions with type parameters https://github.com/rescript-lang/rescript-compiler/pull/5849
+- Fix compiler ppx issue when combining `async` and uncurried application https://github.com/rescript-lang/rescript-compiler/pull/5856
 
 #### :nail_care: Polish
 

jscomp/frontend/ast_async.ml

@@ -1,13 +1,11 @@
 let add_promise_type ~async (result : Parsetree.expression) =
   if async then
-    let txt =
-      Longident.Ldot (Longident.Ldot (Lident "Js", "Promise"), "unsafe_async")
+    let loc = result.pexp_loc in
+    let unsafe_async =
+      Ast_helper.Exp.ident ~loc
+        { txt = Ldot (Ldot (Lident "Js", "Promise"), "unsafe_async"); loc }
     in
-    let pexp_desc = Parsetree.Pexp_ident { txt; loc = result.pexp_loc } in
-    {
-      result with
-      pexp_desc = Pexp_apply ({ result with pexp_desc }, [ (Nolabel, result) ]);
-    }
+    Ast_helper.Exp.apply ~loc unsafe_async [ (Nolabel, result) ]
   else result
 
 let add_async_attribute ~async (body : Parsetree.expression) =
@@ -30,6 +28,6 @@ let rec add_promise_to_result (e : Parsetree.expression) =
 let make_function_async ~async (e : Parsetree.expression) =
   if async then
     match e.pexp_desc with
-    | Pexp_fun _ -> add_async_attribute ~async (add_promise_to_result e)
+    | Pexp_fun _ -> add_promise_to_result e
     | _ -> assert false
   else e

jscomp/frontend/ast_await.ml

@@ -1,6 +1,7 @@
 let create_await_expression (e : Parsetree.expression) =
-  let txt =
-    Longident.Ldot (Longident.Ldot (Lident "Js", "Promise"), "unsafe_await")
+  let loc = e.pexp_loc in
+  let unsafe_await =
+    Ast_helper.Exp.ident ~loc
+      { txt = Ldot (Ldot (Lident "Js", "Promise"), "unsafe_await"); loc }
   in
-  let pexp_desc = Parsetree.Pexp_ident { txt; loc = e.pexp_loc } in
-  { e with pexp_desc = Pexp_apply ({ e with pexp_desc }, [ (Nolabel, e) ]) }
+  Ast_helper.Exp.apply ~loc unsafe_await [ (Nolabel, e) ]

jscomp/test/async_await.js

@@ -0,0 +1,24 @@
+'use strict';
+
+
+function next(n) {
+  return n + 1 | 0;
+}
+
+async function useNext(param) {
+  return 4;
+}
+
+function Make(I) {
+  var get = async function (key) {
+    return await I.get(key);
+  };
+  return {
+          get: get
+        };
+}
+
+exports.next = next;
+exports.useNext = useNext;
+exports.Make = Make;
+/* No side effect */

jscomp/test/async_await.res

@@ -0,0 +1,12 @@
+@@uncurried
+
+let next = n => n + 1
+let useNext = async () => next(3)
+
+module type Impl = {
+  let get: string => Js.Promise.t<string>
+}
+
+module Make = (I: Impl) => {
+  let get = async key => await I.get(key)
+}

jscomp/test/build.ninja

@@ -145137,14 +145137,12 @@ module Ast_async
 #1 "ast_async.ml"
 let add_promise_type ~async (result : Parsetree.expression) =
   if async then
-    let txt =
-      Longident.Ldot (Longident.Ldot (Lident "Js", "Promise"), "unsafe_async")
+    let loc = result.pexp_loc in
+    let unsafe_async =
+      Ast_helper.Exp.ident ~loc
+        { txt = Ldot (Ldot (Lident "Js", "Promise"), "unsafe_async"); loc }
     in
-    let pexp_desc = Parsetree.Pexp_ident { txt; loc = result.pexp_loc } in
-    {
-      result with
-      pexp_desc = Pexp_apply ({ result with pexp_desc }, [ (Nolabel, result) ]);
-    }
+    Ast_helper.Exp.apply ~loc unsafe_async [ (Nolabel, result) ]
   else result
 
 let add_async_attribute ~async (body : Parsetree.expression) =
@@ -145167,7 +145165,7 @@ let rec add_promise_to_result (e : Parsetree.expression) =
 let make_function_async ~async (e : Parsetree.expression) =
   if async then
     match e.pexp_desc with
-    | Pexp_fun _ -> add_async_attribute ~async (add_promise_to_result e)
+    | Pexp_fun _ -> add_promise_to_result e
     | _ -> assert false
   else e
 
@@ -145658,11 +145656,12 @@ module Ast_await
 = struct
 #1 "ast_await.ml"
 let create_await_expression (e : Parsetree.expression) =
-  let txt =
-    Longident.Ldot (Longident.Ldot (Lident "Js", "Promise"), "unsafe_await")
+  let loc = e.pexp_loc in
+  let unsafe_await =
+    Ast_helper.Exp.ident ~loc
+      { txt = Ldot (Ldot (Lident "Js", "Promise"), "unsafe_await"); loc }
   in
-  let pexp_desc = Parsetree.Pexp_ident { txt; loc = e.pexp_loc } in
-  { e with pexp_desc = Pexp_apply ({ e with pexp_desc }, [ (Nolabel, e) ]) }
+  Ast_helper.Exp.apply ~loc unsafe_await [ (Nolabel, e) ]
 
 end
 module Bs_ast_mapper : sig 

lib/4.06.1/unstable/js_compiler.ml

@@ -145137,14 +145137,12 @@ module Ast_async
 #1 "ast_async.ml"
 let add_promise_type ~async (result : Parsetree.expression) =
   if async then
-    let txt =
-      Longident.Ldot (Longident.Ldot (Lident "Js", "Promise"), "unsafe_async")
+    let loc = result.pexp_loc in
+    let unsafe_async =
+      Ast_helper.Exp.ident ~loc
+        { txt = Ldot (Ldot (Lident "Js", "Promise"), "unsafe_async"); loc }
     in
-    let pexp_desc = Parsetree.Pexp_ident { txt; loc = result.pexp_loc } in
-    {
-      result with
-      pexp_desc = Pexp_apply ({ result with pexp_desc }, [ (Nolabel, result) ]);
-    }
+    Ast_helper.Exp.apply ~loc unsafe_async [ (Nolabel, result) ]
   else result
 
 let add_async_attribute ~async (body : Parsetree.expression) =
@@ -145167,7 +145165,7 @@ let rec add_promise_to_result (e : Parsetree.expression) =
 let make_function_async ~async (e : Parsetree.expression) =
   if async then
     match e.pexp_desc with
-    | Pexp_fun _ -> add_async_attribute ~async (add_promise_to_result e)
+    | Pexp_fun _ -> add_promise_to_result e
     | _ -> assert false
   else e
 
@@ -145658,11 +145656,12 @@ module Ast_await
 = struct
 #1 "ast_await.ml"
 let create_await_expression (e : Parsetree.expression) =
-  let txt =
-    Longident.Ldot (Longident.Ldot (Lident "Js", "Promise"), "unsafe_await")
+  let loc = e.pexp_loc in
+  let unsafe_await =
+    Ast_helper.Exp.ident ~loc
+      { txt = Ldot (Ldot (Lident "Js", "Promise"), "unsafe_await"); loc }
   in
-  let pexp_desc = Parsetree.Pexp_ident { txt; loc = e.pexp_loc } in
-  { e with pexp_desc = Pexp_apply ({ e with pexp_desc }, [ (Nolabel, e) ]) }
+  Ast_helper.Exp.apply ~loc unsafe_await [ (Nolabel, e) ]
 
 end
 module Bs_ast_mapper : sig 

lib/4.06.1/unstable/js_playground_compiler.ml

@@ -155421,14 +155421,12 @@ module Ast_async
 #1 "ast_async.ml"
 let add_promise_type ~async (result : Parsetree.expression) =
   if async then
-    let txt =
-      Longident.Ldot (Longident.Ldot (Lident "Js", "Promise"), "unsafe_async")
+    let loc = result.pexp_loc in
+    let unsafe_async =
+      Ast_helper.Exp.ident ~loc
+        { txt = Ldot (Ldot (Lident "Js", "Promise"), "unsafe_async"); loc }
     in
-    let pexp_desc = Parsetree.Pexp_ident { txt; loc = result.pexp_loc } in
-    {
-      result with
-      pexp_desc = Pexp_apply ({ result with pexp_desc }, [ (Nolabel, result) ]);
-    }
+    Ast_helper.Exp.apply ~loc unsafe_async [ (Nolabel, result) ]
   else result
 
 let add_async_attribute ~async (body : Parsetree.expression) =
@@ -155451,7 +155449,7 @@ let rec add_promise_to_result (e : Parsetree.expression) =
 let make_function_async ~async (e : Parsetree.expression) =
   if async then
     match e.pexp_desc with
-    | Pexp_fun _ -> add_async_attribute ~async (add_promise_to_result e)
+    | Pexp_fun _ -> add_promise_to_result e
     | _ -> assert false
   else e
 
@@ -155942,11 +155940,12 @@ module Ast_await
 = struct
 #1 "ast_await.ml"
 let create_await_expression (e : Parsetree.expression) =
-  let txt =
-    Longident.Ldot (Longident.Ldot (Lident "Js", "Promise"), "unsafe_await")
+  let loc = e.pexp_loc in
+  let unsafe_await =
+    Ast_helper.Exp.ident ~loc
+      { txt = Ldot (Ldot (Lident "Js", "Promise"), "unsafe_await"); loc }
   in
-  let pexp_desc = Parsetree.Pexp_ident { txt; loc = e.pexp_loc } in
-  { e with pexp_desc = Pexp_apply ({ e with pexp_desc }, [ (Nolabel, e) ]) }
+  Ast_helper.Exp.apply ~loc unsafe_await [ (Nolabel, e) ]
 
 end
 module Bs_ast_mapper : sig