Dynamic import in expression (#6310)

CHANGELOG.md

@@ -17,6 +17,9 @@
 - Semantic-based optimization of code generated for untagged variants https://github.com/rescript-lang/rescript-compiler/issues/6108
 - Record type spreads: Allow using type variables in type spreads. Both uninstantiated and instantiated ones https://github.com/rescript-lang/rescript-compiler/pull/6309
 
+#### :bug: Bug Fix
+- Fix issue where dynamic import of module in the expression https://github.com/rescript-lang/rescript-compiler/pull/6310
+
 # 11.0.0-beta.2
 
 #### :rocket: New Feature

jscomp/frontend/ast_await.ml

@@ -7,7 +7,7 @@ let create_await_expression (e : Parsetree.expression) =
   Ast_helper.Exp.apply ~loc unsafe_await [(Nolabel, e)]
 
 (* Transform `@res.await M` to unpack(@res.await Js.import(module(M: __M0__))) *)
-let create_await_module_expression ~module_type_name (e : Parsetree.module_expr)
+let create_await_module_expression ~module_type_lid (e : Parsetree.module_expr)
     =
   let open Ast_helper in
   let remove_await_attribute =
@@ -33,8 +33,6 @@ let create_await_module_expression ~module_type_name (e : Parsetree.module_expr)
                          pmod_attributes =
                            remove_await_attribute e.pmod_attributes;
                        })
-                    (Typ.package ~loc:e.pmod_loc
-                       {txt = Lident module_type_name; loc = e.pmod_loc}
-                       []) );
+                    (Typ.package ~loc:e.pmod_loc module_type_lid []) );
               ]));
   }

jscomp/frontend/bs_builtin_ppx.ml

@@ -72,6 +72,13 @@ let pat_mapper (self : mapper) (p : Parsetree.pattern) =
     Ast_utf8_string_interp.transform_pat p s delim
   | _ -> default_pat_mapper self p
 
+(* 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 expr_mapper ~async_context ~in_function_def (self : mapper)
     (e : Parsetree.expression) =
   let old_in_function_def = !in_function_def in
@@ -214,6 +221,42 @@ let expr_mapper ~async_context ~in_function_def (self : mapper)
      the attribute to the whole expression, in general, when shuffuling the ast
      it is very hard to place attributes correctly
   *)
+  (* module M = await Belt.List *)
+  | Pexp_letmodule
+      (lid, ({pmod_desc = Pmod_ident {txt}; pmod_attributes} as me), expr)
+    when Res_parsetree_viewer.hasAwaitAttribute pmod_attributes ->
+    let safe_module_type_lid : Ast_helper.lid =
+      {txt = Lident (local_module_type_name txt); loc = me.pmod_loc}
+    in
+    {
+      e with
+      pexp_desc =
+        Pexp_letmodule
+          ( lid,
+            Ast_await.create_await_module_expression
+              ~module_type_lid:safe_module_type_lid me,
+            self.expr self expr );
+    }
+  (* module M = await (Belt.List: BeltList) *)
+  | Pexp_letmodule
+      ( lid,
+        ({
+           pmod_desc =
+             Pmod_constraint
+               ({pmod_desc = Pmod_ident _}, {pmty_desc = Pmty_ident mtyp_lid});
+           pmod_attributes;
+         } as me),
+        expr )
+    when Res_parsetree_viewer.hasAwaitAttribute pmod_attributes ->
+    {
+      e with
+      pexp_desc =
+        Pexp_letmodule
+          ( lid,
+            Ast_await.create_await_module_expression ~module_type_lid:mtyp_lid
+              me,
+            self.expr self expr );
+    }
   | _ -> default_expr_mapper self e
 
 let expr_mapper ~async_context ~in_function_def (self : mapper)
@@ -424,13 +467,6 @@ let local_module_name =
     incr v;
     "local_" ^ 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 =
   if stru = [] then acc
@@ -509,15 +545,18 @@ let rec structure_mapper ~await_context (self : mapper) (stru : Ast_structure.t)
         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));
+            Ast_helper.(
+              Str.modtype ~loc
+                (Mtd.mk ~loc
+                   {txt = safe_module_type_name; loc}
+                   ~typ:(Mty.typeof_ ~loc me)));
           ]
       in
+      let safe_module_type_lid : Ast_helper.lid =
+        {txt = Lident safe_module_type_name; loc = mb.pmb_expr.pmod_loc}
+      in
       module_type_decl
       @ (* module M = @res.await Belt.List *)
       {
@@ -528,10 +567,44 @@ let rec structure_mapper ~await_context (self : mapper) (stru : Ast_structure.t)
               mb with
               pmb_expr =
                 Ast_await.create_await_module_expression
-                  ~module_type_name:safe_module_type_name mb.pmb_expr;
+                  ~module_type_lid:safe_module_type_lid mb.pmb_expr;
             };
       }
       :: structure_mapper ~await_context self rest
+    | Pstr_value (_, vbs) ->
+      let item = self.structure_item self item in
+      (* [ module __Belt_List__ = module type of Belt.List ] *)
+      let module_type_decls =
+        vbs
+        |> List.filter_map (fun ({pvb_expr} : Parsetree.value_binding) ->
+               match pvb_expr.pexp_desc with
+               | Pexp_letmodule
+                   ( _,
+                     ({pmod_desc = Pmod_ident {txt; loc}; pmod_attributes} as
+                     me),
+                     _ )
+                 when Res_parsetree_viewer.hasAwaitAttribute pmod_attributes
+                 -> (
+                 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
+
+                 match has_local_module_name with
+                 | Some _ -> None
+                 | None ->
+                   Hashtbl.add !await_context safe_module_type_name
+                     safe_module_type_name;
+                   Some
+                     Ast_helper.(
+                       Str.modtype ~loc
+                         (Mtd.mk ~loc
+                            {txt = safe_module_type_name; loc}
+                            ~typ:(Mty.typeof_ ~loc me))))
+               | _ -> None)
+      in
+
+      module_type_decls @ (item :: structure_mapper ~await_context self rest)
     | _ ->
       self.structure_item self item :: structure_mapper ~await_context self rest
     )

jscomp/syntax/src/res_printer.ml

@@ -705,16 +705,14 @@ and printModuleBinding ~state ~isRec moduleBinding cmtTbl i =
   in
   let modExprDoc, modConstraintDoc =
     match moduleBinding.pmb_expr with
-    | {pmod_desc = Pmod_constraint (modExpr, modType)} ->
+    | {pmod_desc = Pmod_constraint (modExpr, modType)}
+      when not
+             (ParsetreeViewer.hasAwaitAttribute
+                moduleBinding.pmb_expr.pmod_attributes) ->
       ( printModExpr ~state modExpr cmtTbl,
         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
@@ -4967,11 +4965,13 @@ and printExpressionBlock ~state ~braces expr cmtTbl =
       in
       let name, modExpr =
         match modExpr.pmod_desc with
-        | Pmod_constraint (modExpr, modType) ->
+        | Pmod_constraint (modExpr2, modType)
+          when not (ParsetreeViewer.hasAwaitAttribute modExpr.pmod_attributes)
+          ->
           let name =
             Doc.concat [name; Doc.text ": "; printModType ~state modType cmtTbl]
           in
-          (name, modExpr)
+          (name, modExpr2)
         | _ -> (name, modExpr)
       in
       let letModuleDoc =
@@ -5455,6 +5455,14 @@ and printModExpr ~state modExpr cmtTbl =
         ]
     | Pmod_functor _ -> printModFunctor ~state modExpr cmtTbl
   in
+  let doc =
+    if ParsetreeViewer.hasAwaitAttribute modExpr.pmod_attributes then
+      match modExpr.pmod_desc with
+      | Pmod_constraint _ ->
+        Doc.concat [Doc.text "await "; Doc.lparen; doc; Doc.rparen]
+      | _ -> Doc.concat [Doc.text "await "; doc]
+    else doc
+  in
   printComments doc cmtTbl modExpr.pmod_loc
 
 and printModFunctor ~state modExpr cmtTbl =

jscomp/syntax/tests/parsing/grammar/expressions/await.res

@@ -28,3 +28,25 @@ let () = {
 let forEach = await @a @b Js.Import(Belt.List.forEach)
 
 module M = await @a @b Belt.List
+
+let f = () => {
+  module M = await @a @b Belt.List
+  M.forEach
+}
+
+let () = {
+  module M = await @a @b Belt.List
+  M.forEach
+}
+
+module type BeltList = module type of Belt.List
+
+let f = () => {
+  module M = await @a @b (Belt.List: BeltList)
+  M.forEach
+}
+
+let () = {
+  module M = await @a @b (Belt.List: BeltList)
+  M.forEach
+}

jscomp/syntax/tests/parsing/grammar/expressions/expected/await.res.txt

@@ -17,4 +17,18 @@ let () = ((delay 10)[@res.braces ][@res.await ])
 let () = ((((delay 10)[@res.await ]); ((delay 20)[@res.await ]))
   [@res.braces ])
 let forEach = ((Js.Import Belt.List.forEach)[@res.await ][@a ][@b ])
-module M = ((Belt.List)[@res.await ][@a ][@b ])
+module M = ((Belt.List)[@res.await ][@a ][@b ])
+let f () =
+  ((let module M = ((Belt.List)[@res.await ][@a ][@b ]) in M.forEach)
+  [@res.braces ])
+let () = ((let module M = ((Belt.List)[@res.await ][@a ][@b ]) in M.forEach)
+  [@res.braces ])
+module type BeltList  = module type of Belt.List
+let f () =
+  ((let module M = (((Belt.List : BeltList))[@res.await ][@a ][@b ]) in
+      M.forEach)
+  [@res.braces ])
+let () =
+  ((let module M = (((Belt.List : BeltList))[@res.await ][@a ][@b ]) in
+      M.forEach)
+  [@res.braces ])

jscomp/syntax/tests/printer/expr/expected/letmodule.res.txt

@@ -2,3 +2,13 @@ let x = {
   module M = ME
   Me.x
 }
+
+let x = {
+  module M = await ME
+  M.x
+}
+
+let x = {
+  module M = await (ME: MT)
+  M.x
+}

jscomp/syntax/tests/printer/expr/letmodule.res

@@ -2,3 +2,13 @@ let x = {
   module M = ME
   Me.x
 }
+
+let x = {
+  module M = await ME
+  M.x
+}
+
+let x = {
+  module M = await (ME: MT)
+  M.x
+}

jscomp/syntax/tests/printer/modExpr/await.res

@@ -0,0 +1,3 @@
+module M = await ME
+
+module M = await (ME: MT)

jscomp/syntax/tests/printer/modExpr/expected/await.res.txt

@@ -0,0 +1,3 @@
+module M = await ME
+
+module M = await (ME: MT)

jscomp/test/Import.res

@@ -37,3 +37,25 @@ let each = M1.forEach
 
 module M2 = N.N1.O
 let each2 = M2.forEach
+
+let f = async () => {
+  module M3 = await Belt.List
+  M3.forEach
+}
+
+let f1 = async () => {
+  module M3 = await (Belt.List: BeltList)
+  M3.forEach
+}
+
+let f2 = async () => {
+  module M3 = await (Belt.List: BeltList)
+  module M4 = await (Belt.List: BeltList)
+  (M3.forEach, M4.forEach)
+}
+
+let f3 = async () => {
+  module M3 = await Belt.List
+  module M4 = await Belt.List
+  (M3.forEach, M4.forEach)
+}