From 4975b785be96da2b72c30599567d7db1e2c9cf08 Mon Sep 17 00:00:00 2001 From: Woonki Moon Date: Sat, 22 Apr 2023 15:53:06 +0900 Subject: [PATCH 1/8] add syntax test --- res_syntax/tests/parsing/grammar/expressions/await.res | 6 +++++- .../parsing/grammar/expressions/expected/await.res.txt | 4 +++- 2 files changed, 8 insertions(+), 2 deletions(-) diff --git a/res_syntax/tests/parsing/grammar/expressions/await.res b/res_syntax/tests/parsing/grammar/expressions/await.res index 32a6fdf956..47a0041ea1 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 Js.Import(Belt.List.forEach) + +module M = await 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..e2f4e0e2ef 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 ]) +module M = ((Belt.List)[@res.await ]) \ No newline at end of file From 61b2c46af426397ad3b1dcabb5cf83b54f4e8ee4 Mon Sep 17 00:00:00 2001 From: Woonki Moon Date: Sat, 22 Apr 2023 15:55:01 +0900 Subject: [PATCH 2/8] add attributes --- res_syntax/tests/parsing/grammar/expressions/await.res | 4 ++-- .../tests/parsing/grammar/expressions/expected/await.res.txt | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/res_syntax/tests/parsing/grammar/expressions/await.res b/res_syntax/tests/parsing/grammar/expressions/await.res index 47a0041ea1..c88a0e3a05 100644 --- a/res_syntax/tests/parsing/grammar/expressions/await.res +++ b/res_syntax/tests/parsing/grammar/expressions/await.res @@ -25,6 +25,6 @@ let () = { await delay(20) } -let forEach = await Js.Import(Belt.List.forEach) +let forEach = await @a @b Js.Import(Belt.List.forEach) -module M = await Belt.List +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 e2f4e0e2ef..e34050650a 100644 --- a/res_syntax/tests/parsing/grammar/expressions/expected/await.res.txt +++ b/res_syntax/tests/parsing/grammar/expressions/expected/await.res.txt @@ -16,5 +16,5 @@ let () = 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 ]) -module M = ((Belt.List)[@res.await ]) \ No newline at end of file +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 From 6c0740373af3685f40067c371a10af3bae863d49 Mon Sep 17 00:00:00 2001 From: Woonki Moon Date: Sat, 22 Apr 2023 16:14:52 +0900 Subject: [PATCH 3/8] parsing await module --- res_syntax/src/res_core.ml | 15 +++++++++++++++ 1 file changed, 15 insertions(+) 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 From 2d6ec89207a292190a35e09bb66bda06862b074c Mon Sep 17 00:00:00 2001 From: Woonki Moon Date: Sat, 22 Apr 2023 16:24:11 +0900 Subject: [PATCH 4/8] start module expr with await --- res_syntax/src/res_grammar.ml | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) 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 From 85a1c0b74313e86bd8220cd1e6682f1181baf892 Mon Sep 17 00:00:00 2001 From: Woonki Moon Date: Sat, 22 Apr 2023 17:40:09 +0900 Subject: [PATCH 5/8] doc await for module --- res_syntax/src/res_printer.ml | 5 +++++ 1 file changed, 5 insertions(+) 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 From 6b00e3e536fae18094cf9b8cf8c0101f1c540f8a Mon Sep 17 00:00:00 2001 From: Woonki Moon Date: Sat, 22 Apr 2023 17:54:32 +0900 Subject: [PATCH 6/8] test --- jscomp/test/Import.res | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/jscomp/test/Import.res b/jscomp/test/Import.res index cf4436eef1..e136d72b59 100644 --- a/jscomp/test/Import.res +++ b/jscomp/test/Import.res @@ -13,5 +13,5 @@ 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 From b7a203726e4682625b8b1dcc3810b2bca66b01d6 Mon Sep 17 00:00:00 2001 From: Woonki Moon Date: Sat, 22 Apr 2023 20:55:01 +0900 Subject: [PATCH 7/8] using table instead number for safe module type name --- jscomp/frontend/bs_builtin_ppx.ml | 81 +++++++++++++++++++------------ jscomp/test/Import.js | 37 +++++++++++++- jscomp/test/Import.res | 22 +++++++++ 3 files changed, 107 insertions(+), 33 deletions(-) diff --git a/jscomp/frontend/bs_builtin_ppx.ml b/jscomp/frontend/bs_builtin_ppx.ml index a07ded3fea..d0ef390fac 100644 --- a/jscomp/frontend/bs_builtin_ppx.ml +++ b/jscomp/frontend/bs_builtin_ppx.ml @@ -426,13 +426,10 @@ let local_module_name = (* 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 ^ "__" +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 e136d72b59..3fcb575d4f 100644 --- a/jscomp/test/Import.res +++ b/jscomp/test/Import.res @@ -15,3 +15,25 @@ let beltAsModule = await Js.import(module(Belt.List: BeltList)) // module M = unpack(@res.await Js.import(module(Belt.List: BeltList0))) 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 From 13af346a686eef6d5d012e9268e49d08db32f9da Mon Sep 17 00:00:00 2001 From: Woonki Moon Date: Sat, 22 Apr 2023 20:59:19 +0900 Subject: [PATCH 8/8] understandable comment --- jscomp/frontend/bs_builtin_ppx.ml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/jscomp/frontend/bs_builtin_ppx.ml b/jscomp/frontend/bs_builtin_ppx.ml index d0ef390fac..d585628aec 100644 --- a/jscomp/frontend/bs_builtin_ppx.ml +++ b/jscomp/frontend/bs_builtin_ppx.ml @@ -424,8 +424,8 @@ 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. *) +(* 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) "")