Support for @await decorator.

Author: cristianoc

example-async/src/AA.res

@@ -1,6 +1,3 @@
-// Boilerplate currently handwritten
-external await: Js.Promise.t<'a> => 'a = "?await"
-
 type testable = (. unit) => Js.Promise.t<unit>
 
 let tests: array<testable> = []
@@ -17,17 +14,17 @@ let foo = @async (. x, y) => x + y
 let bar =
   @async
   (. ff) => {
-    let a = await(ff(. 3, 4))
-    let b = await(foo(. 5, 6))
+    let a = @await ff(. 3, 4)
+    let b = @await foo(. 5, 6)
     a + b
   }
 
-let baz = @async (. ()) => await(bar(. foo))
+let baz = @async (. ()) => @await bar(. foo)
 
 let testBaz: testable =
   @async
   (. ()) => {
-    let n = await(baz(.))
+    let n = @await baz(.)
     Js.log2("baz returned", n)
   }
 
@@ -41,14 +38,15 @@ exception E(int)
 
 let e1: testable = @async (. ()) => raise(E(1000))
 let e2: testable = @async (. ()) => Js.Exn.raiseError("Some JS error")
-let e3: testable = @async (. ()) => await(e1(.))
-let e4: testable = @async (. ()) => await(e2(.))
+let e3: testable = @async (. ()) => @await e1(.)
+let e4: testable = @async (. ()) => @await e2(.)
 let e5: testable = %raw(`function() { return Promise.reject(new Error('fail')) }`)
 
 let testTryCatch =
   @async
   (. fn) =>
-    try await(fn(.)) catch {
+    try @await
+    fn(.) catch {
     | E(n) => Js.log2("testTryCatch: E", n)
     | JsError(_) => Js.log("testTryCatch: JsError")
     }
@@ -82,7 +80,8 @@ let explainError: unknown => string = %raw(`(e)=>e.toString()`)
 let testFetch =
   @async
   (. url) => {
-    switch await(Fetch.fetch(url)) {
+    switch @await
+    Fetch.fetch(url) {
     | response =>
       let status = response->Fetch.Response.status
       Js.log2("Fetch returned status:", status)
@@ -101,8 +100,11 @@ let rec runAllTests =
   @async
   (. n) => {
     if n >= 0 && n < Array.length(tests) {
-      await(tests[n](.))
-      await(runAllTests(. n + 1))
+      @await
+      tests[n](.)
+
+      @await
+      runAllTests(. n + 1)
     }
   }
 

jscomp/frontend/ast_attributes.ml

@@ -164,6 +164,12 @@ let is_inline : attr -> bool =
 
 let has_inline_payload (attrs : t) = Ext_list.find_first attrs is_inline
 
+let is_await : attr -> bool =
+  fun ({ txt }, _) -> txt = "await"
+ 
+let has_await_payload (attrs : t) = Ext_list.find_first attrs is_await
+ 
+
 type derive_attr = { bs_deriving : Ast_payload.action list option } [@@unboxed]
 
 let process_derive_type (attrs : t) : derive_attr * t =

jscomp/frontend/ast_attributes.mli

@@ -44,6 +44,8 @@ val process_bs : t -> bool * t
 
 val has_inline_payload : t -> attr option
 
+val has_await_payload : t -> attr option
+
 type derive_attr = { bs_deriving : Ast_payload.action list option } [@@unboxed]
 
 val iter_process_bs_string_int_unwrap_uncurry :

jscomp/frontend/ast_uncurry_gen.ml

@@ -85,7 +85,7 @@ let to_uncurry_fn loc (self : Bs_ast_mapper.mapper) (label : Asttypes.arg_label)
   let result, rev_extra_args = aux [ (label, first_arg) ] body in
   let result =
     if async then
-      let txt = Longident.Ldot (Longident.Ldot (Lident "Js", "Promise"), "unsafe_cast") in
+      let txt = Longident.Ldot (Longident.Ldot (Lident "Js", "Promise"), "unsafe_async") 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)])}
     else result in

jscomp/frontend/bs_builtin_ppx.ml

@@ -77,6 +77,7 @@ let pat_mapper (self : mapper) (e : Parsetree.pattern) =
     {e with ppat_desc = Ppat_constant (Pconst_integer(s,None))}
   | _ -> default_pat_mapper  self e 
 let expr_mapper  (self : mapper) (e : Parsetree.expression) =
+  let result =
   match e.pexp_desc with
   (* Its output should not be rewritten anymore *)
   | Pexp_extension extension ->
@@ -193,6 +194,14 @@ let expr_mapper  (self : mapper) (e : Parsetree.expression) =
      it is very hard to place attributes correctly
   *)
   | _ ->  default_expr_mapper self e
+  
+  in
+  match Ast_attributes.has_await_payload e.pexp_attributes with
+  | None -> result
+  | Some _ ->
+    let txt = Longident.Ldot (Longident.Ldot (Lident "Js", "Promise"), "unsafe_await") 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)])}
 
 
 let typ_mapper (self : mapper) (typ : Parsetree.core_type) = 

jscomp/others/js_promise.ml

@@ -93,7 +93,8 @@ external catch : ((error -> 'a t)[@bs.uncurry]) -> 'a t = "catch"
 external catch2 : 'a t -> ((exn -> 'a t)[@bs.uncurry]) -> 'a t = "catch"
   [@@bs.send]
 
-external unsafe_cast : 'a -> 'a t = "%identity"
+external unsafe_async : 'a -> 'a t = "%identity"
+external unsafe_await : 'a t -> 'a = "?await"
 
 
 (*