Add syntax surface, module type name and tests for dynamic import (#6188)

Author: mununki

jscomp/frontend/bs_builtin_ppx.ml

@@ -424,15 +424,12 @@ let local_module_name =
     incr v;
     "local_" ^ string_of_int !v
 
-(* Unpack requires core_type package for type inference;
-   use module type bindings and a function to create safe local names instead. *)
-let local_module_type_name =
-  let v = ref 0 in
-  fun ({txt} : Longident.t Location.loc) ->
-    incr v;
-    "__"
-    ^ (Longident.flatten txt |> List.fold_left (fun ll l -> ll ^ l) "")
-    ^ string_of_int !v ^ "__"
+(* Unpack requires core_type package for type inference:
+   Generate a module type name eg. __Belt_List__*)
+let local_module_type_name txt =
+  "_"
+  ^ (Longident.flatten txt |> List.fold_left (fun ll l -> ll ^ "_" ^ l) "")
+  ^ "__"
 
 let expand_reverse (stru : Ast_structure.t) (acc : Ast_structure.t) :
     Ast_structure.t =
@@ -466,14 +463,15 @@ let expand_reverse (stru : Ast_structure.t) (acc : Ast_structure.t) :
          }
     :: acc)
 
-let rec structure_mapper (self : mapper) (stru : Ast_structure.t) =
+let rec structure_mapper ~await_context (self : mapper) (stru : Ast_structure.t)
+    =
   match stru with
   | [] -> []
   | item :: rest -> (
     match item.pstr_desc with
     | Pstr_extension (({txt = "bs.raw" | "raw"; loc}, payload), _attrs) ->
       Ast_exp_handle_external.handle_raw_structure loc payload
-      :: structure_mapper self rest
+      :: structure_mapper ~await_context self rest
     (* | Pstr_extension (({txt = "i"}, _),_)
        ->
        structure_mapper self rest *)
@@ -493,7 +491,7 @@ let rec structure_mapper (self : mapper) (stru : Ast_structure.t) =
               next
           | PSig _ | PTyp _ | PPat _ ->
             Location.raise_errorf ~loc "private extension is not support")
-        | _ -> expand_reverse acc (structure_mapper self rest)
+        | _ -> expand_reverse acc (structure_mapper ~await_context self rest)
       in
       aux [] stru
     (* Dynamic import of module transformation: module M = @res.await Belt.List *)
@@ -502,30 +500,49 @@ let rec structure_mapper (self : mapper) (stru : Ast_structure.t) =
         as mb)
       when Res_parsetree_viewer.hasAwaitAttribute pmod_attributes ->
       let item = self.structure_item self item in
-      let safe_module_type_name = local_module_type_name {txt; loc} in
+      let safe_module_type_name = local_module_type_name txt in
+      let has_local_module_name =
+        Hashtbl.find_opt !await_context safe_module_type_name
+      in
+      (* module __Belt_List__ = module type of Belt.List *)
       let module_type_decl =
-        let open Ast_helper in
-        Str.modtype ~loc
-          (Mtd.mk ~loc
-             {txt = safe_module_type_name; loc}
-             ~typ:(Mty.typeof_ ~loc me))
+        match has_local_module_name with
+        | Some _ -> []
+        | None ->
+          let open Ast_helper in
+          Hashtbl.add !await_context safe_module_type_name safe_module_type_name;
+          [
+            Str.modtype ~loc
+              (Mtd.mk ~loc
+                 {txt = safe_module_type_name; loc}
+                 ~typ:(Mty.typeof_ ~loc me));
+          ]
       in
-      (* module __BeltList1__ = module type of Belt.List *)
       module_type_decl
-      :: {
-           item with
-           pstr_desc =
-             Pstr_module
-               {
-                 mb with
-                 pmb_expr =
-                   Ast_await.create_await_module_expression
-                     ~module_type_name:safe_module_type_name mb.pmb_expr;
-               };
-         }
-         (* module M = @res.await Belt.List *)
-      :: structure_mapper self rest
-    | _ -> self.structure_item self item :: structure_mapper self rest)
+      @ (* module M = @res.await Belt.List *)
+      {
+        item with
+        pstr_desc =
+          Pstr_module
+            {
+              mb with
+              pmb_expr =
+                Ast_await.create_await_module_expression
+                  ~module_type_name:safe_module_type_name mb.pmb_expr;
+            };
+      }
+      :: structure_mapper ~await_context self rest
+    | _ ->
+      self.structure_item self item :: structure_mapper ~await_context self rest
+    )
+
+let structure_mapper ~await_context (self : mapper) (stru : Ast_structure.t) =
+  let await_saved = !await_context in
+  let result =
+    structure_mapper ~await_context:(ref (Hashtbl.create 10)) self stru
+  in
+  await_context := await_saved;
+  result
 
 let mapper : mapper =
   {
@@ -536,7 +553,7 @@ let mapper : mapper =
     signature_item = signature_item_mapper;
     value_bindings = Ast_tuple_pattern_flatten.value_bindings_mapper;
     structure_item = structure_item_mapper;
-    structure = structure_mapper;
+    structure = structure_mapper ~await_context:(ref (Hashtbl.create 10));
     (* Ad-hoc way to internalize stuff *)
     label_declaration =
       (fun self lbl ->

jscomp/test/Import.js

@@ -13,5 +13,27 @@ let beltAsModule = await Js.import(module(Belt.List: BeltList))
 
 // module type BeltList0 = module type of Belt.List
 // module M = unpack(@res.await Js.import(module(Belt.List: BeltList0)))
-module M = @res.await Belt.List
-let each = M.forEach
+module M = await Belt.List
+let each = M.forEach
+
+module N = {
+  module N0 = await Belt.List
+  let each = N0.forEach
+
+  module N1 = {
+    module O = await Belt.List
+    let each = O.forEach
+  }
+
+  module N2 = await Belt.List
+  let each = N2.forEach
+}
+
+module M0 = await Belt.List
+let each = M0.forEach
+
+module M1 = await Belt.List
+let each = M1.forEach
+
+module M2 = N.N1.O
+let each2 = M2.forEach

jscomp/test/Import.res

@@ -5783,7 +5783,22 @@ and parseFunctorModuleExpr p =
  *  | extension
  *  | attributes module-expr *)
 and parseModuleExpr p =
+  let hasAwait, loc_await =
+    let startPos = p.startPos in
+    match p.Parser.token with
+    | Await ->
+      Parser.expect Await p;
+      let endPos = p.endPos in
+      (true, mkLoc startPos endPos)
+    | _ -> (false, mkLoc startPos startPos)
+  in
   let attrs = parseAttributes p in
+  let attrs =
+    if hasAwait then
+      (({txt = "res.await"; loc = loc_await}, PStr []) : Parsetree.attribute)
+      :: attrs
+    else attrs
+  in
   let modExpr =
     if isEs6ArrowFunctor p then parseFunctorModuleExpr p
     else parsePrimaryModExpr p

res_syntax/src/res_core.ml

@@ -215,7 +215,8 @@ let isFunctorArgStart = function
   | _ -> false
 
 let isModExprStart = function
-  | Token.At | Percent | Uident _ | Lbrace | Lparen | Lident "unpack" -> true
+  | Token.At | Percent | Uident _ | Lbrace | Lparen | Lident "unpack" | Await ->
+    true
   | _ -> false
 
 let isRecordRowStart = function

res_syntax/src/res_grammar.ml

@@ -710,6 +710,11 @@ and printModuleBinding ~state ~isRec moduleBinding cmtTbl i =
         Doc.concat [Doc.text ": "; printModType ~state modType cmtTbl] )
     | modExpr -> (printModExpr ~state modExpr cmtTbl, Doc.nil)
   in
+  let modExprDoc =
+    if ParsetreeViewer.hasAwaitAttribute moduleBinding.pmb_expr.pmod_attributes
+    then Doc.concat [Doc.text "await "; modExprDoc]
+    else modExprDoc
+  in
   let modName =
     let doc = Doc.text moduleBinding.pmb_name.Location.txt in
     printComments doc cmtTbl moduleBinding.pmb_name.loc

res_syntax/src/res_printer.ml

@@ -23,4 +23,8 @@ let () = {
 let () = {
     await delay(10)
     await delay(20)
-}
+}
+
+let forEach = await @a @b Js.Import(Belt.List.forEach)
+
+module M = await @a @b Belt.List

res_syntax/tests/parsing/grammar/expressions/await.res

@@ -15,4 +15,6 @@ let () =
   [@res.braces ])
 let () = ((delay 10)[@res.braces ][@res.await ])
 let () = ((((delay 10)[@res.await ]); ((delay 20)[@res.await ]))
-  [@res.braces ])
+  [@res.braces ])
+let forEach = ((Js.Import Belt.List.forEach)[@res.await ][@a ][@b ])
+module M = ((Belt.List)[@res.await ][@a ][@b ])