Clean up treatment of async attribute.

Author: cristianoc

example-async/src/AA.res

@@ -98,8 +98,7 @@ testFetch->addTest1("https://www.google.comsdkjdkghdsg")
 let withCallback =
   @async
   (. ()) => {
-    let callback = @async (. x) => @await (x->Js.Promise.resolve) + 1
-    callback
+    @async (. x) => @await (x->Js.Promise.resolve) + 1
   }
 
 let testWithCallback =

jscomp/frontend/ast_attributes.ml

@@ -81,16 +81,15 @@ let process_method_attributes_rev (attrs : t) =
 type attr_kind =
   | Nothing
   | Meth_callback of attr
-  | Uncurry of attr * bool
+  | Uncurry of attr
   | Method of attr
 
 let process_attributes_rev (attrs : t) : attr_kind * t =
   Ext_list.fold_left attrs (Nothing, [])
     (fun (st, acc) (({ txt; loc }, _) as attr) ->
       match (txt, st) with
-      | "async", Uncurry (attr, _async) -> (Uncurry (attr, true), attr :: acc)
       | "bs", (Nothing | Uncurry _) ->
-          (Uncurry (attr, (* async *) false), acc) (* TODO: warn unused/duplicated attribute *)
+          (Uncurry attr, acc) (* TODO: warn unused/duplicated attribute *)
       | ("bs.this" | "this"), (Nothing | Meth_callback _) ->
           (Meth_callback attr, acc)
       | ("bs.meth" | "meth"), (Nothing | Method _) -> (Method attr, acc)
@@ -166,8 +165,12 @@ let has_inline_payload (attrs : t) = Ext_list.find_first attrs is_inline
 
 let is_await : attr -> bool =
   fun ({ txt }, _) -> txt = "await"
- 
+
+let is_async : attr -> bool =
+  fun ({ txt }, _) -> txt = "async"
+
 let has_await_payload (attrs : t) = Ext_list.find_first attrs is_await
+let has_async_payload (attrs : t) = Ext_list.find_first attrs is_async
 
 
 type derive_attr = { bs_deriving : Ast_payload.action list option } [@@unboxed]

jscomp/frontend/ast_attributes.mli

@@ -33,7 +33,7 @@ val process_method_attributes_rev :
 type attr_kind =
   | Nothing
   | Meth_callback of attr
-  | Uncurry of attr * bool(* async *)
+  | Uncurry of attr
   | Method of attr
 
 val process_attributes_rev : t -> attr_kind * t
@@ -45,6 +45,7 @@ val process_bs : t -> bool * t
 val has_inline_payload : t -> attr option
 
 val has_await_payload : t -> attr option
+val has_async_payload : t -> attr option
 
 type derive_attr = { bs_deriving : Ast_payload.action list option } [@@unboxed]
 

jscomp/frontend/ast_core_type_class_type.ml

@@ -147,7 +147,7 @@ let typ_mapper (self : Bs_ast_mapper.mapper) (ty : Parsetree.core_type) =
                   let attrs, core_type =
                     match Ast_attributes.process_attributes_rev attrs with
                     | Nothing, attrs -> (attrs, ty) (* #1678 *)
-                    | Uncurry (attr, _async), attrs -> (attrs, attr +> ty)
+                    | Uncurry attr, attrs -> (attrs, attr +> ty)
                     | Method _, _ ->
                         Location.raise_errorf ~loc
                           "%@get/set conflicts with %@meth"
@@ -160,7 +160,7 @@ let typ_mapper (self : Bs_ast_mapper.mapper) (ty : Parsetree.core_type) =
                   let attrs, core_type =
                     match Ast_attributes.process_attributes_rev attrs with
                     | Nothing, attrs -> (attrs, ty)
-                    | Uncurry (attr, _async), attrs -> (attrs, attr +> ty)
+                    | Uncurry attr, attrs -> (attrs, attr +> ty)
                     | Method _, _ ->
                         Location.raise_errorf ~loc
                           "%@get/set conflicts with %@meth"
@@ -174,7 +174,7 @@ let typ_mapper (self : Bs_ast_mapper.mapper) (ty : Parsetree.core_type) =
                   let attrs, core_type =
                     match Ast_attributes.process_attributes_rev ptyp_attrs with
                     | Nothing, attrs -> (attrs, ty)
-                    | Uncurry (attr, _async), attrs -> (attrs, attr +> ty)
+                    | Uncurry attr, attrs -> (attrs, attr +> ty)
                     | Method attr, attrs -> (attrs, attr +> ty)
                     | Meth_callback attr, attrs -> (attrs, attr +> ty)
                   in

jscomp/frontend/bs_builtin_ppx.ml

@@ -125,8 +125,9 @@ let expr_mapper  (self : mapper) (e : Parsetree.expression) =
     begin match Ast_attributes.process_attributes_rev e.pexp_attributes with
       | Nothing, _
         -> default_expr_mapper self e
-      | Uncurry (_, async), pexp_attributes
+      | Uncurry (_, _async), pexp_attributes
         ->
+        let async = Ast_attributes.has_async_payload e.pexp_attributes <> None in
         {e with
          pexp_desc = Ast_uncurry_gen.to_uncurry_fn e.pexp_loc self label pat body async;
          pexp_attributes}