Add support for async methods.

Fixes #7681

Author: cristianoc

compiler/core/js_exp_make.ml

@@ -254,7 +254,7 @@ let ocaml_fun ?comment ?immutable_mask ?directive ~return_unit ~async
     comment;
   }
 
-let method_ ?comment ?immutable_mask ~return_unit params body : t =
+let method_ ?comment ?immutable_mask ~async ~return_unit params body : t =
   let len = List.length params in
   {
     expression_desc =
@@ -265,7 +265,7 @@ let method_ ?comment ?immutable_mask ~return_unit params body : t =
           body;
           env = Js_fun_env.make ?immutable_mask len;
           return_unit;
-          async = false;
+          async;
           directive = None;
         };
     comment;

compiler/core/js_exp_make.mli

@@ -111,6 +111,7 @@ val ocaml_fun :
 val method_ :
   ?comment:string ->
   ?immutable_mask:bool array ->
+  async:bool ->
   return_unit:bool ->
   J.ident list ->
   J.block ->

compiler/core/lam_compile.ml

@@ -1623,9 +1623,9 @@ let compile output_prefix =
     | {primitive = Pjs_unsafe_downgrade _; args} -> assert false
     | {primitive = Pjs_fn_method; args = args_lambda} -> (
       match args_lambda with
-      | [Lfunction {params; body; attr = {return_unit}}] ->
+      | [Lfunction {params; body; attr = {return_unit; async}}] ->
         Js_output.output_of_block_and_expression lambda_cxt.continuation []
-          (E.method_ params ~return_unit
+          (E.method_ ~async ~return_unit params
              (* Invariant:  jmp_table can not across function boundary,
                 here we share env
              *)

compiler/frontend/ast_uncurry_gen.ml

@@ -25,7 +25,7 @@
 open Ast_helper
 
 (* Handling `fun [@this]` used in `object [@bs] end` *)
-let to_method_callback loc (self : Bs_ast_mapper.mapper) label
+let to_method_callback ~async loc (self : Bs_ast_mapper.mapper) label
     (self_pat : Parsetree.pattern) body : Parsetree.expression_desc =
   let self_pat = self.pat self self_pat in
   (match Ast_pat.is_single_variable_pattern_conservative self_pat with
@@ -50,7 +50,9 @@ let to_method_callback loc (self : Bs_ast_mapper.mapper) label
   let arity = List.length rev_extra_args in
   let body =
     match body.pexp_desc with
-    | Pexp_fun f -> {body with pexp_desc = Pexp_fun {f with arity = Some arity}}
+    | Pexp_fun f ->
+      Ast_async.make_function_async ~async
+        {body with pexp_desc = Pexp_fun {f with arity = Some arity; async}}
     | _ -> body
   in
   let arity_s = string_of_int arity in

compiler/frontend/ast_uncurry_gen.mli

@@ -23,6 +23,7 @@
  * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
 
 val to_method_callback :
+  async:bool ->
   Location.t ->
   Bs_ast_mapper.mapper ->
   Asttypes.arg_label ->

compiler/frontend/bs_builtin_ppx.ml

@@ -111,7 +111,8 @@ let expr_mapper ~async_context ~in_function_def (self : mapper)
       {
         e with
         pexp_desc =
-          Ast_uncurry_gen.to_method_callback e.pexp_loc self label pat body;
+          Ast_uncurry_gen.to_method_callback ~async e.pexp_loc self label pat
+            body;
         pexp_attributes;
       })
   | Pexp_apply _ -> Ast_exp_apply.app_exp_mapper e self

tests/tests/src/UncurriedExternals.mjs

@@ -69,8 +69,20 @@ function methodWithAsync(param) {
   return (async arg => $$this + arg | 0)(param);
 }
 
+let p1 = {
+  watch: async function (name, ev) {
+    let pc = this ;
+    console.log(pc);
+  }
+};
+
+let AsyncMethod = {
+  p1: p1
+};
+
 export {
   StandardNotation,
   methodWithAsync,
+  AsyncMethod,
 }
 /* h Not a pure module */

tests/tests/src/UncurriedExternals.res

@@ -36,3 +36,17 @@ module StandardNotation = {
 }
 
 let methodWithAsync = @this this => async arg => this + arg
+
+module AsyncMethod = {
+  type pluginContext
+  type changeEvent
+
+  type p = {watch: @this (pluginContext, string, changeEvent) => promise<unit>}
+
+  let p1 = {
+    watch: @this
+    async (pc, name, ev) => {
+      Console.log(pc)
+    },
+  }
+}