diff --git a/jscomp/frontend/bs_builtin_ppx.ml b/jscomp/frontend/bs_builtin_ppx.ml index a07ded3fea..d585628aec 100644 --- a/jscomp/frontend/bs_builtin_ppx.ml +++ b/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 -> diff --git a/jscomp/test/Import.js b/jscomp/test/Import.js index e559af2e98..ebd9339906 100644 --- a/jscomp/test/Import.js +++ b/jscomp/test/Import.js @@ -49,11 +49,46 @@ var beltAsModule = await import("../../lib/js/belt_List.js"); var M = await import("../../lib/js/belt_List.js"); -var each = M.forEach; +var N0 = await import("../../lib/js/belt_List.js"); + +var O = await import("../../lib/js/belt_List.js"); + +var N1_each = O.forEach; + +var N1 = { + O: O, + each: N1_each +}; + +var N2 = await import("../../lib/js/belt_List.js"); + +var N_each = N2.forEach; + +var N = { + N0: N0, + N1: N1, + N2: N2, + each: N_each +}; + +var M0 = await import("../../lib/js/belt_List.js"); + +var M1 = await import("../../lib/js/belt_List.js"); + +var each = M1.forEach; + +var M2; + +var each2 = O.forEach; exports.eachIntAsync = eachIntAsync; exports.eachIntLazy = eachIntLazy; exports.beltAsModule = beltAsModule; exports.M = M; +exports.N = N; +exports.M0 = M0; +exports.M1 = M1; exports.each = each; +exports.M2 = M2; +exports.each2 = each2; /* Not a pure module */ diff --git a/jscomp/test/Import.res b/jscomp/test/Import.res index cf4436eef1..3fcb575d4f 100644 --- a/jscomp/test/Import.res +++ b/jscomp/test/Import.res @@ -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 \ No newline at end of file +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 diff --git a/res_syntax/src/res_core.ml b/res_syntax/src/res_core.ml index d1c9c850dc..ed48370320 100644 --- a/res_syntax/src/res_core.ml +++ b/res_syntax/src/res_core.ml @@ -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 diff --git a/res_syntax/src/res_grammar.ml b/res_syntax/src/res_grammar.ml index dcc448ce5a..61e6f4ea81 100644 --- a/res_syntax/src/res_grammar.ml +++ b/res_syntax/src/res_grammar.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 diff --git a/res_syntax/src/res_printer.ml b/res_syntax/src/res_printer.ml index b3772194d9..7230f1387d 100644 --- a/res_syntax/src/res_printer.ml +++ b/res_syntax/src/res_printer.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 diff --git a/res_syntax/tests/parsing/grammar/expressions/await.res b/res_syntax/tests/parsing/grammar/expressions/await.res index 32a6fdf956..c88a0e3a05 100644 --- a/res_syntax/tests/parsing/grammar/expressions/await.res +++ b/res_syntax/tests/parsing/grammar/expressions/await.res @@ -23,4 +23,8 @@ let () = { let () = { await delay(10) await delay(20) -} \ No newline at end of file +} + +let forEach = await @a @b Js.Import(Belt.List.forEach) + +module M = await @a @b Belt.List diff --git a/res_syntax/tests/parsing/grammar/expressions/expected/await.res.txt b/res_syntax/tests/parsing/grammar/expressions/expected/await.res.txt index c00ef032cc..e34050650a 100644 --- a/res_syntax/tests/parsing/grammar/expressions/expected/await.res.txt +++ b/res_syntax/tests/parsing/grammar/expressions/expected/await.res.txt @@ -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 ]) \ No newline at end of file + [@res.braces ]) +let forEach = ((Js.Import Belt.List.forEach)[@res.await ][@a ][@b ]) +module M = ((Belt.List)[@res.await ][@a ][@b ]) \ No newline at end of file