Put async attributes on function at construction time, not with the builtin ppx.

Author: cristianoc

compiler/frontend/bs_builtin_ppx.ml

@@ -111,8 +111,6 @@ let expr_mapper ~async_context ~in_function_def (self : mapper)
     {e with pexp_desc = Pexp_constant (Pconst_integer (s, None))}
   (* End rewriting *)
   | Pexp_newtype (s, body) ->
-    let async = Ast_async.has_async_payload e.pexp_attributes in
-    let body = Ast_async.add_async_attribute ~async body in
     let res = self.expr self body in
     {e with pexp_desc = Pexp_newtype (s, res)}
   | Pexp_fun {arg_label = label; lhs = pat; rhs = body} -> (

compiler/ml/ast_async.ml

@@ -2,13 +2,25 @@ let has_async_payload attrs =
   Ext_list.exists attrs (fun ({Location.txt}, _) -> txt = "res.async")
 
 let add_async_attribute ~async (body : Parsetree.expression) =
+  let add (exp : Parsetree.expression) =
+    if has_async_payload exp.pexp_attributes then exp
+    else
+      {
+        exp with
+        pexp_attributes =
+          ({txt = "res.async"; loc = Location.none}, PStr [])
+          :: exp.pexp_attributes;
+      }
+  in
   if async then
-    {
-      body with
-      pexp_attributes =
-        ({txt = "res.async"; loc = Location.none}, PStr [])
-        :: body.pexp_attributes;
-    }
+    let rec add_to_fun (exp : Parsetree.expression) =
+      match exp.pexp_desc with
+      | Pexp_newtype (txt, e) ->
+        {exp with pexp_desc = Pexp_newtype (txt, add_to_fun e)}
+      | Pexp_fun _ -> add exp
+      | _ -> exp
+    in
+    add (add_to_fun body)
   else body
 
 let add_promise_type ?(loc = Location.none) ~async

tests/syntax_tests/data/parsing/grammar/expressions/expected/async.res.txt

@@ -34,15 +34,16 @@ let ex3 = ((foo |.u (bar ~arg:((arg)[@res.namedArgLoc ])))[@res.await ])
 let ex4 = (((foo.bar).baz)[@res.await ])
 let attr1 = ((fun [arity:1]x -> x + 1)[@res.async ][@a ])
 let attr2 = ((fun (type a) ->
-  fun [arity:1]() -> fun (type b) -> fun (type c) -> fun [arity:1]x -> 3)
-  [@res.async ][@a ])
+  ((fun [arity:1]() -> fun (type b) -> fun (type c) -> fun [arity:1]x -> 3)
+  [@res.async ]))[@res.async ][@a ])
 let attr3 = ((fun (type a) ->
-  fun [arity:1]() -> ((fun (type b) -> fun (type c) -> fun [arity:1]x -> 3)
-    [@res.async ]))
+  fun [arity:1]() -> ((fun (type b) -> fun (type c) -> ((fun [arity:1]x -> 3)
+    [@res.async ]))[@res.async ]))
   [@a ])
 let attr4 = ((fun (type a) ->
-  fun [arity:1]() -> ((fun (type b) -> fun (type c) -> fun [arity:1]x -> 3)
-    [@res.async ][@b ]))
+  fun [arity:1]() -> ((fun (type b) -> fun (type c) -> ((fun [arity:1]x -> 3)
+    [@res.async ]))[@res.async ][@b ]))
   [@a ])
 let (attr5 : int) = ((fun (type a) -> fun (type b) -> fun (type c) ->
-  fun [arity:1]() -> fun [arity:1](x : a) -> x)[@res.async ][@a ][@b ])
+  ((fun [arity:1]() -> fun [arity:1](x : a) -> x)[@res.async ]))
+  [@res.async ][@a ][@b ])