From 79687093af2e15c5cd75a0d46268624cef76c8db Mon Sep 17 00:00:00 2001 From: Woonki Moon Date: Sun, 20 Nov 2022 12:15:30 +0900 Subject: [PATCH 01/14] dynamic import --- jscomp/core/js_packages_info.ml | 2 + jscomp/core/js_packages_info.mli | 2 + jscomp/core/lam_analysis.ml | 2 +- jscomp/core/lam_compile.ml | 256 +++++++++++++------------- jscomp/core/lam_compile.mli | 4 +- jscomp/core/lam_compile_main.ml | 10 +- jscomp/core/lam_compile_primitive.ml | 60 +++++- jscomp/core/lam_compile_primitive.mli | 1 + jscomp/core/lam_convert.ml | 1 + jscomp/core/lam_primitive.ml | 2 + jscomp/core/lam_primitive.mli | 1 + jscomp/core/lam_print.ml | 1 + jscomp/frontend/ast_await.ml | 26 ++- jscomp/frontend/bs_builtin_ppx.ml | 46 ++++- jscomp/others/js.ml | 1 + jscomp/runtime/js.ml | 2 + jscomp/test/Import.js | 58 ++++++ jscomp/test/Import.res | 17 ++ lib/es6/belt_internalBuckets.js | 26 +-- lib/js/belt_internalBuckets.js | 26 +-- 20 files changed, 378 insertions(+), 166 deletions(-) create mode 100644 jscomp/test/Import.js create mode 100644 jscomp/test/Import.res diff --git a/jscomp/core/js_packages_info.ml b/jscomp/core/js_packages_info.ml index 0dc4b52f49..eb37cfcce0 100644 --- a/jscomp/core/js_packages_info.ml +++ b/jscomp/core/js_packages_info.ml @@ -84,6 +84,8 @@ let is_runtime_package (x : t) = x.name = Pkg_runtime let iter (x : t) cb = Ext_list.iter x.module_systems cb +let map (x : t) cb = Ext_list.map x.module_systems cb + (* let equal (x : t) ({name; module_systems}) = x.name = name && Ext_list.for_all2_no_exn diff --git a/jscomp/core/js_packages_info.mli b/jscomp/core/js_packages_info.mli index b5c8caefb5..943c231bae 100644 --- a/jscomp/core/js_packages_info.mli +++ b/jscomp/core/js_packages_info.mli @@ -46,6 +46,8 @@ val same_package_by_name : t -> t -> bool val iter : t -> (package_info -> unit) -> unit +val map : t -> (package_info -> 'a) -> 'a list + val empty : t val from_name : string -> t diff --git a/jscomp/core/lam_analysis.ml b/jscomp/core/lam_analysis.ml index c1f1d2dc83..66edeb0678 100644 --- a/jscomp/core/lam_analysis.ml +++ b/jscomp/core/lam_analysis.ml @@ -60,7 +60,7 @@ let rec no_side_effects (lam : Lam.t) : bool = | Pcreate_extension _ | Pjs_typeof | Pis_null | Pis_not_none | Psome | Psome_not_nest | Pis_undefined | Pis_null_undefined | Pnull_to_opt | Pundefined_to_opt | Pnull_undefined_to_opt | Pjs_fn_make _ | Pjs_fn_make_unit - | Pjs_object_create _ + | Pjs_object_create _ | Pimport (* TODO: check *) | Pbytes_to_string | Pmakeblock _ (* whether it's mutable or not *) diff --git a/jscomp/core/lam_compile.ml b/jscomp/core/lam_compile.ml index 4d8bfd175c..7bb358379c 100644 --- a/jscomp/core/lam_compile.ml +++ b/jscomp/core/lam_compile.ml @@ -225,10 +225,10 @@ type initialization = J.block non-toplevel, it will explode code very quickly *) let rec compile_external_field (* Like [List.empty]*) - (lamba_cxt : Lam_compile_context.t) (id : Ident.t) name : Js_output.t = + output_prefix (lamba_cxt : Lam_compile_context.t) (id : Ident.t) name : Js_output.t = match Lam_compile_env.query_external_id_info id name with | { persistent_closed_lambda = Some lam } when Lam_util.not_function lam -> - compile_lambda lamba_cxt lam + compile_lambda output_prefix lamba_cxt lam | _ -> Js_output.output_of_expression lamba_cxt.continuation ~no_effects:no_effects_const (E.ml_var_dot id name) @@ -260,7 +260,7 @@ let rec compile_external_field (* Like [List.empty]*) for the function, generative module or functor can be a function, however it can not be global -- global can only module *) -and compile_external_field_apply (appinfo : Lam.apply) (module_id : Ident.t) +and compile_external_field_apply output_prefix (appinfo : Lam.apply) (module_id : Ident.t) (field_name : string) (lambda_cxt : Lam_compile_context.t) : Js_output.t = let ident_info = Lam_compile_env.query_external_id_info module_id field_name @@ -273,7 +273,7 @@ and compile_external_field_apply (appinfo : Lam.apply) (module_id : Ident.t) let _, param_map = Lam_closure.is_closed_with_map Set_ident.empty params body in - compile_lambda lambda_cxt + compile_lambda output_prefix lambda_cxt (Lam_beta_reduce.propagate_beta_reduce_with_map lambda_cxt.meta param_map params body ap_args) | _ -> @@ -283,7 +283,7 @@ and compile_external_field_apply (appinfo : Lam.apply) (module_id : Ident.t) else let arg_cxt = { lambda_cxt with continuation = NeedValue Not_tail } in Ext_list.fold_right ap_args dummy (fun arg_lambda (args_code, args) -> - match compile_lambda arg_cxt arg_lambda with + match compile_lambda output_prefix arg_cxt arg_lambda with | { block; value = Some b } -> (Ext_list.append block args_code, b :: args) | _ -> assert false) @@ -312,7 +312,7 @@ and compile_external_field_apply (appinfo : Lam.apply) (module_id : Ident.t) here we share env *) -and compile_recursive_let ~all_bindings (cxt : Lam_compile_context.t) +and compile_recursive_let output_prefix ~all_bindings (cxt : Lam_compile_context.t) (id : Ident.t) (arg : Lam.t) : Js_output.t * initialization = match arg with | Lfunction { params; body; attr = { return_unit; async; oneUnitArg } } -> @@ -336,6 +336,7 @@ and compile_recursive_let ~all_bindings (cxt : Lam_compile_context.t) in let output = compile_lambda + output_prefix { cxt with continuation = @@ -375,7 +376,7 @@ and compile_recursive_let ~all_bindings (cxt : Lam_compile_context.t) [] ) | Lprim { primitive = Pmakeblock (_, _, _); args } when args_either_function_or_const args -> - (compile_lambda { cxt with continuation = Declare (Alias, id) } arg, []) + (compile_lambda output_prefix { cxt with continuation = Declare (Alias, id) } arg, []) (* case of lazy blocks, treat it as usual *) | Lprim { @@ -433,7 +434,7 @@ and compile_recursive_let ~all_bindings (cxt : Lam_compile_context.t) however it would affect scope issues, we have to declare it first *) match - compile_lambda { cxt with continuation = NeedValue Not_tail } arg + compile_lambda output_prefix { cxt with continuation = NeedValue Not_tail } arg with | { block = b; value = Some v } -> (* TODO: check recursive value .. @@ -470,15 +471,15 @@ and compile_recursive_let ~all_bindings (cxt : Lam_compile_context.t) fun _-> print_endline "hey"; v () ]} *) - (compile_lambda { cxt with continuation = Declare (Alias, id) } arg, []) + (compile_lambda output_prefix { cxt with continuation = Declare (Alias, id) } arg, []) -and compile_recursive_lets_aux cxt (id_args : Lam_scc.bindings) : Js_output.t = +and compile_recursive_lets_aux output_prefix cxt (id_args : Lam_scc.bindings) : Js_output.t = (* #1716 *) let output_code, ids = Ext_list.fold_right id_args (Js_output.dummy, []) (fun (ident, arg) (acc, ids) -> let code, declare_ids = - compile_recursive_let ~all_bindings:id_args cxt ident arg + compile_recursive_let output_prefix ~all_bindings:id_args cxt ident arg in (Js_output.append_output code acc, Ext_list.append declare_ids ids)) in @@ -486,7 +487,7 @@ and compile_recursive_lets_aux cxt (id_args : Lam_scc.bindings) : Js_output.t = | [] -> output_code | _ -> Js_output.append_output (Js_output.make ids) output_code -and compile_recursive_lets cxt id_args : Js_output.t = +and compile_recursive_lets output_prefix cxt id_args : Js_output.t = match id_args with | [] -> Js_output.dummy | _ -> ( @@ -494,12 +495,13 @@ and compile_recursive_lets cxt id_args : Js_output.t = match id_args_group with | [] -> assert false | first :: rest -> - let acc = compile_recursive_lets_aux cxt first in + let acc = compile_recursive_lets_aux output_prefix cxt first in Ext_list.fold_left rest acc (fun acc x -> - Js_output.append_output acc (compile_recursive_lets_aux cxt x))) + Js_output.append_output acc (compile_recursive_lets_aux output_prefix cxt x))) and compile_general_cases : 'a . + string -> ('a -> Ast_untagged_variants.literal option) -> ('a -> J.expression) -> ('a option -> J.expression -> 'a option -> J.expression -> J.expression) -> @@ -513,7 +515,7 @@ and compile_general_cases : ('a * Lam.t) list -> default_case -> J.block = - fun (get_cstr_name : _ -> Ast_untagged_variants.literal option) (make_exp : _ -> J.expression) + fun (output_prefix: string) (get_cstr_name : _ -> Ast_untagged_variants.literal option) (make_exp : _ -> J.expression) (eq_exp : 'a option -> J.expression -> 'a option -> J.expression -> J.expression) (cxt : Lam_compile_context.t) (switch : @@ -524,7 +526,7 @@ and compile_general_cases : J.statement) (switch_exp : J.expression) (cases : (_ * Lam.t) list) (default : default_case) -> match (cases, default) with - | [], Default lam -> Js_output.output_as_block (compile_lambda cxt lam) + | [], Default lam -> Js_output.output_as_block (compile_lambda output_prefix cxt lam) | [], (Complete | NonComplete) -> [] | [ (_, lam) ], Complete -> (* To take advantage of such optimizations, @@ -533,18 +535,19 @@ and compile_general_cases : otherwise the compiler engine would think that it's also complete *) - Js_output.output_as_block (compile_lambda cxt lam) + Js_output.output_as_block (compile_lambda output_prefix cxt lam) | [ (id, lam) ], NonComplete -> morph_declare_to_assign cxt (fun cxt define -> [ S.if_ ?declaration:define + (eq_exp None switch_exp (Some id) (make_exp id)) - (Js_output.output_as_block (compile_lambda cxt lam)); + (Js_output.output_as_block (compile_lambda output_prefix cxt lam)); ]) | [ (id, lam) ], Default x | [ (id, lam); (_, x) ], Complete -> morph_declare_to_assign cxt (fun cxt define -> - let else_block = Js_output.output_as_block (compile_lambda cxt x) in - let then_block = Js_output.output_as_block (compile_lambda cxt lam) in + let else_block = Js_output.output_as_block (compile_lambda output_prefix cxt x) in + let then_block = Js_output.output_as_block (compile_lambda output_prefix cxt lam) in [ S.if_ ?declaration:define (eq_exp None switch_exp (Some id) (make_exp id)) @@ -575,7 +578,7 @@ and compile_general_cases : | Complete -> None | NonComplete -> None | Default lam -> - Some (Js_output.output_as_block (compile_lambda cxt lam)) + Some (Js_output.output_as_block (compile_lambda output_prefix cxt lam)) in let make_comment i = match get_cstr_name i with | None -> None @@ -585,7 +588,7 @@ and compile_general_cases : if last then (* merge and shared *) let switch_body, should_break = - Js_output.to_break_block (compile_lambda cxt lam) + Js_output.to_break_block (compile_lambda output_prefix cxt lam) in let should_break = if @@ -624,14 +627,14 @@ and use_compile_literal_cases table get_name = | Some {name; literal_type = None}, Some string_table -> Some ((String name, lam) :: string_table) | _, _ -> None ) table (Some []) -and compile_cases ?(untagged=false) cxt (switch_exp : E.t) table default get_name = +and compile_cases ?(untagged=false) output_prefix cxt (switch_exp : E.t) table default get_name = match use_compile_literal_cases table get_name with | Some string_table -> if untagged then compile_untagged_cases cxt switch_exp string_table default else compile_string_cases cxt switch_exp string_table default | None -> - compile_general_cases get_name + compile_general_cases output_prefix get_name (fun i -> match get_name i with | None -> E.small_int i | Some {literal_type = Some(String s)} -> E.str s @@ -678,19 +681,20 @@ and compile_switch (switch_arg : Lam.t) (sw : Lam.lambda_switch) let untagged = block_cases <> [] in let compile_whole (cxt : Lam_compile_context.t) = match - compile_lambda { cxt with continuation = NeedValue Not_tail } switch_arg + compile_lambda output_prefix { cxt with continuation = NeedValue Not_tail } switch_arg with | { value = None; _ } -> assert false | { block; value = Some e } -> ( block @ if sw_consts_full && sw_consts = [] then - compile_cases ~untagged cxt (if untagged then e else E.tag ~name:tag_name e) sw_blocks sw_blocks_default get_block_name + compile_cases ~untagged output_prefix cxt (if untagged then e else E.tag ~name:tag_name e) sw_blocks sw_blocks_default get_block_name else if sw_blocks_full && sw_blocks = [] then - compile_cases cxt e sw_consts sw_num_default get_const_name + compile_cases output_prefix cxt e sw_consts sw_num_default get_const_name else (* [e] will be used twice *) let dispatch e = + let is_a_literal_case = if block_cases <> [] then @@ -698,9 +702,9 @@ and compile_switch (switch_arg : Lam.t) (sw : Lam.lambda_switch) else E.is_int_tag ~has_null_undefined_other:(has_null_undefined_other sw_names) e in S.if_ is_a_literal_case - (compile_cases cxt e sw_consts sw_num_default get_const_name) + (compile_cases output_prefix cxt e sw_consts sw_num_default get_const_name) ~else_: - (compile_cases ~untagged cxt (if untagged then e else E.tag ~name:tag_name e) sw_blocks sw_blocks_default + (compile_cases ~untagged output_prefix cxt (if untagged then e else E.tag ~name:tag_name e) sw_blocks sw_blocks_default get_block_name) in match e.expression_desc with @@ -728,11 +732,13 @@ and compile_switch (switch_arg : Lam.t) (sw : Lam.lambda_switch) :: compile_whole { lambda_cxt with continuation = Assign id }) | EffectCall _ | Assign _ -> Js_output.make (compile_whole lambda_cxt) -and compile_string_cases cxt switch_exp table default = + + and compile_string_cases output_prefix cxt switch_exp table default = let literal = function | literal -> E.literal literal in compile_general_cases + output_prefix (fun _ -> None) literal (fun _ x _ y -> E.string_equal x y) @@ -781,14 +787,14 @@ and compile_untagged_cases cxt switch_exp table default = body switch_exp table default -and compile_stringswitch l cases default (lambda_cxt : Lam_compile_context.t) = +and compile_stringswitch output_prefix l cases default (lambda_cxt : Lam_compile_context.t) = (* TODO might better optimization according to the number of cases Be careful: we should avoid multiple evaluation of l, The [gen] can be elimiated when number of [cases] is less than 3 *) let cases = cases |> List.map (fun (s,l) -> Ast_untagged_variants.String s, l) in match - compile_lambda { lambda_cxt with continuation = NeedValue Not_tail } l + compile_lambda output_prefix { lambda_cxt with continuation = NeedValue Not_tail } l with | { value = None } -> assert false | { block; value = Some e } -> ( @@ -803,14 +809,14 @@ and compile_stringswitch l cases default (lambda_cxt : Lam_compile_context.t) = let v = Ext_ident.create_tmp () in Js_output.make (Ext_list.append block - (compile_string_cases + (compile_string_cases output_prefix { lambda_cxt with continuation = Declare (Variable, v) } e cases default)) ~value:(E.var v) | _ -> Js_output.make (Ext_list.append block - (compile_string_cases lambda_cxt e cases default))) + (compile_string_cases output_prefix lambda_cxt e cases default))) (* This should be optimized in lambda layer @@ -822,7 +828,7 @@ and compile_stringswitch l cases default (lambda_cxt : Lam_compile_context.t) = default: (exit 1)) with (1) 2)) *) -and compile_staticraise i (largs : Lam.t list) +and compile_staticraise output_prefix i (largs : Lam.t list) (lambda_cxt : Lam_compile_context.t) = (* [i] is the jump table, [largs] is the arguments passed to [Lstaticcatch]*) match Lam_compile_context.find_exn lambda_cxt i with @@ -837,7 +843,7 @@ and compile_staticraise i (largs : Lam.t list) | Lvar id -> Js_output.make [ S.assign bind (E.var id) ] | _ -> (* TODO: should be Assign -- Assign is an optimization *) - compile_lambda + compile_lambda output_prefix { lambda_cxt with continuation = Assign bind } larg in @@ -872,7 +878,7 @@ and compile_staticraise i (largs : Lam.t list) ]} *) -and compile_staticcatch (lam : Lam.t) (lambda_cxt : Lam_compile_context.t) = +and compile_staticcatch output_prefix (lam : Lam.t) (lambda_cxt : Lam_compile_context.t) = let code_table, body = flatten_nested_caches lam in let exit_id = Ext_ident.create_tmp ~name:"exit" () in match (lambda_cxt.continuation, code_table) with @@ -894,13 +900,13 @@ and compile_staticcatch (lam : Lam.t) (lambda_cxt : Lam_compile_context.t) = } in - let lbody = compile_lambda new_cxt body in + let lbody = compile_lambda output_prefix new_cxt body in let declares = Ext_list.map code_table.bindings (fun x -> S.declare_variable ~kind:Variable x) in Js_output.append_output (Js_output.make declares) - (Js_output.append_output lbody (compile_lambda lambda_cxt handler)) + (Js_output.append_output lbody (compile_lambda output_prefix lambda_cxt handler)) | _ -> ( let exit_expr = E.var exit_id in let jmp_table, handlers = @@ -922,12 +928,12 @@ and compile_staticcatch (lam : Lam.t) (lambda_cxt : Lam_compile_context.t) = let new_cxt = { lambda_cxt with jmp_table; continuation = Assign v } in - let lbody = compile_lambda new_cxt body in + let lbody = compile_lambda output_prefix new_cxt body in Js_output.append_output (Js_output.make (S.declare_variable ~kind:Variable v :: declares)) (Js_output.append_output lbody (Js_output.make - (compile_cases new_cxt exit_expr handlers NonComplete + (compile_cases output_prefix new_cxt exit_expr handlers NonComplete (fun _ -> None)) ~value:(E.var v))) | Declare (kind, id) (* declare first this we will do branching*) -> @@ -935,11 +941,11 @@ and compile_staticcatch (lam : Lam.t) (lambda_cxt : Lam_compile_context.t) = let new_cxt = { lambda_cxt with jmp_table; continuation = Assign id } in - let lbody = compile_lambda new_cxt body in + let lbody = compile_lambda output_prefix new_cxt body in Js_output.append_output (Js_output.make declares) (Js_output.append_output lbody (Js_output.make - (compile_cases new_cxt exit_expr handlers NonComplete + (compile_cases output_prefix new_cxt exit_expr handlers NonComplete (fun _ -> None)))) (* place holder -- tell the compiler that we don't know if it's complete @@ -951,31 +957,31 @@ and compile_staticcatch (lam : Lam.t) (lambda_cxt : Lam_compile_context.t) = else EffectCall new_tail_type in let new_cxt = { lambda_cxt with jmp_table; continuation } in - let lbody = compile_lambda new_cxt body in + let lbody = compile_lambda output_prefix new_cxt body in Js_output.append_output (Js_output.make declares) (Js_output.append_output lbody (Js_output.make - (compile_cases new_cxt exit_expr handlers NonComplete + (compile_cases output_prefix new_cxt exit_expr handlers NonComplete (fun _ -> None)))) | Assign _ -> let new_cxt = { lambda_cxt with jmp_table } in - let lbody = compile_lambda new_cxt body in + let lbody = compile_lambda output_prefix new_cxt body in Js_output.append_output (Js_output.make declares) (Js_output.append_output lbody (Js_output.make - (compile_cases new_cxt exit_expr handlers NonComplete + (compile_cases output_prefix new_cxt exit_expr handlers NonComplete (fun _ -> None))))) -and compile_sequand (l : Lam.t) (r : Lam.t) (lambda_cxt : Lam_compile_context.t) +and compile_sequand output_prefix (l : Lam.t) (r : Lam.t) (lambda_cxt : Lam_compile_context.t) = if Lam_compile_context.continuation_is_return lambda_cxt.continuation then - compile_lambda lambda_cxt (Lam.sequand l r) + compile_lambda output_prefix lambda_cxt (Lam.sequand l r) else let new_cxt = { lambda_cxt with continuation = NeedValue Not_tail } in - match compile_lambda new_cxt l with + match compile_lambda output_prefix new_cxt l with | { value = None } -> assert false | { block = l_block; value = Some l_expr } -> ( - match compile_lambda new_cxt r with + match compile_lambda output_prefix new_cxt r with | { value = None } -> assert false | { block = []; value = Some r_expr } -> Js_output.output_of_block_and_expression lambda_cxt.continuation @@ -1006,16 +1012,16 @@ and compile_sequand (l : Lam.t) (r : Lam.t) (lambda_cxt : Lam_compile_context.t) @ [ S.if_ l_expr (r_block @ [ S.assign v r_expr ]) ]) ~value:(E.var v))) -and compile_sequor (l : Lam.t) (r : Lam.t) (lambda_cxt : Lam_compile_context.t) +and compile_sequor output_prefix (l : Lam.t) (r : Lam.t) (lambda_cxt : Lam_compile_context.t) = if Lam_compile_context.continuation_is_return lambda_cxt.continuation then - compile_lambda lambda_cxt (Lam.sequor l r) + compile_lambda output_prefix lambda_cxt (Lam.sequor l r) else let new_cxt = { lambda_cxt with continuation = NeedValue Not_tail } in - match compile_lambda new_cxt l with + match compile_lambda output_prefix new_cxt l with | { value = None } -> assert false | { block = l_block; value = Some l_expr } -> ( - match compile_lambda new_cxt r with + match compile_lambda output_prefix new_cxt r with | { value = None } -> assert false | { block = []; value = Some r_expr } -> let exp = E.or_ l_expr r_expr in @@ -1054,10 +1060,10 @@ and compile_sequor (l : Lam.t) (r : Lam.t) (lambda_cxt : Lam_compile_context.t) while expression, here we generate for statement, leave optimization later. (Sine OCaml expression can be really complex..) *) -and compile_while (predicate : Lam.t) (body : Lam.t) +and compile_while output_prefix (predicate : Lam.t) (body : Lam.t) (lambda_cxt : Lam_compile_context.t) = match - compile_lambda + compile_lambda output_prefix { lambda_cxt with continuation = NeedValue Not_tail } predicate with @@ -1069,7 +1075,7 @@ and compile_while (predicate : Lam.t) (body : Lam.t) [ S.while_ e (Js_output.output_as_block - @@ compile_lambda + @@ compile_lambda output_prefix { lambda_cxt with continuation = EffectCall Not_tail } body); ] @@ -1089,12 +1095,12 @@ and compile_while (predicate : Lam.t) (body : Lam.t) print i each time, so they are different semantics... *) -and compile_for (id : J.for_ident) (start : Lam.t) (finish : Lam.t) +and compile_for output_prefix (id : J.for_ident) (start : Lam.t) (finish : Lam.t) (direction : Js_op.direction_flag) (body : Lam.t) (lambda_cxt : Lam_compile_context.t) = let new_cxt = { lambda_cxt with continuation = NeedValue Not_tail } in let block = - match (compile_lambda new_cxt start, compile_lambda new_cxt finish) with + match (compile_lambda output_prefix new_cxt start, compile_lambda output_prefix new_cxt finish) with | { value = None }, _ | _, { value = None } -> assert false | { block = b1; value = Some e1 }, { block = b2; value = Some e2 } -> ( (* order b1 -- (e1 -- b2 -- e2) @@ -1107,7 +1113,7 @@ and compile_for (id : J.for_ident) (start : Lam.t) (finish : Lam.t) *) let block_body = Js_output.output_as_block - (compile_lambda + (compile_lambda output_prefix { lambda_cxt with continuation = EffectCall Not_tail } body) in @@ -1133,7 +1139,7 @@ and compile_for (id : J.for_ident) (start : Lam.t) (finish : Lam.t) in Js_output.output_of_block_and_expression lambda_cxt.continuation block E.unit -and compile_assign id (lambda : Lam.t) (lambda_cxt : Lam_compile_context.t) = +and compile_assign output_prefix id (lambda : Lam.t) (lambda_cxt : Lam_compile_context.t) = let block = match lambda with | Lprim { primitive = Poffsetint v; args = [ Lvar bid ] } @@ -1141,7 +1147,7 @@ and compile_assign id (lambda : Lam.t) (lambda_cxt : Lam_compile_context.t) = [ S.exp (E.assign (E.var id) (E.int32_add (E.var id) (E.small_int v))) ] | _ -> ( match - compile_lambda + compile_lambda output_prefix { lambda_cxt with continuation = NeedValue Not_tail } lambda with @@ -1164,16 +1170,16 @@ and compile_assign id (lambda : Lam.t) (lambda_cxt : Lam_compile_context.t) = } ]} *) -and compile_trywith lam id catch (lambda_cxt : Lam_compile_context.t) = +and compile_trywith output_prefix lam id catch (lambda_cxt : Lam_compile_context.t) = let aux (with_context : Lam_compile_context.t) (body_context : Lam_compile_context.t) = (* should_return is passed down #1701, try should prevent tailcall *) [ S.try_ - (Js_output.output_as_block (compile_lambda body_context lam)) + (Js_output.output_as_block (compile_lambda output_prefix body_context lam)) ~with_: - (id, Js_output.output_as_block (compile_lambda with_context catch)); + (id, Js_output.output_as_block (compile_lambda output_prefix with_context catch)); ] in match lambda_cxt.continuation with @@ -1240,10 +1246,10 @@ and compile_trywith lam id catch (lambda_cxt : Lam_compile_context.t) = mutable initializers: (obj -> unit) list } ]} *) -and compile_ifthenelse (predicate : Lam.t) (t_branch : Lam.t) (f_branch : Lam.t) +and compile_ifthenelse output_prefix (predicate : Lam.t) (t_branch : Lam.t) (f_branch : Lam.t) (lambda_cxt : Lam_compile_context.t) = match - compile_lambda + compile_lambda output_prefix { lambda_cxt with continuation = NeedValue Not_tail } predicate with @@ -1252,8 +1258,8 @@ and compile_ifthenelse (predicate : Lam.t) (t_branch : Lam.t) (f_branch : Lam.t) match lambda_cxt.continuation with | NeedValue _ -> ( match - ( compile_lambda lambda_cxt t_branch, - compile_lambda lambda_cxt f_branch ) + ( compile_lambda output_prefix lambda_cxt t_branch, + compile_lambda output_prefix lambda_cxt f_branch ) with | { block = []; value = Some out1 }, { block = []; value = Some out2 } -> @@ -1265,8 +1271,8 @@ and compile_ifthenelse (predicate : Lam.t) (t_branch : Lam.t) (f_branch : Lam.t) let id = Ext_ident.create_tmp () in let assign_cxt = { lambda_cxt with continuation = Assign id } in match - ( compile_lambda assign_cxt t_branch, - compile_lambda assign_cxt f_branch ) + ( compile_lambda output_prefix assign_cxt t_branch, + compile_lambda output_prefix assign_cxt f_branch ) with | out1, out2 -> Js_output.make @@ -1283,8 +1289,8 @@ and compile_ifthenelse (predicate : Lam.t) (t_branch : Lam.t) (f_branch : Lam.t) { lambda_cxt with continuation = NeedValue Not_tail } in match - ( compile_lambda declare_cxt t_branch, - compile_lambda declare_cxt f_branch ) + ( compile_lambda output_prefix declare_cxt t_branch, + compile_lambda output_prefix declare_cxt f_branch ) with | { block = []; value = Some out1 }, { block = []; value = Some out2 } -> @@ -1297,20 +1303,20 @@ and compile_ifthenelse (predicate : Lam.t) (t_branch : Lam.t) (f_branch : Lam.t) (Ext_list.append_one b (S.if_ ~declaration:(kind, id) e (Js_output.output_as_block - @@ compile_lambda + @@ compile_lambda output_prefix { lambda_cxt with continuation = Assign id } t_branch) ~else_: (Js_output.output_as_block - @@ compile_lambda + @@ compile_lambda output_prefix { lambda_cxt with continuation = Assign id } f_branch)))) | Assign _ -> let then_output = - Js_output.output_as_block (compile_lambda lambda_cxt t_branch) + Js_output.output_as_block (compile_lambda output_prefix lambda_cxt t_branch) in let else_output = - Js_output.output_as_block (compile_lambda lambda_cxt f_branch) + Js_output.output_as_block (compile_lambda output_prefix lambda_cxt f_branch) in Js_output.make (Ext_list.append_one b (S.if_ e then_output ~else_:else_output)) @@ -1320,8 +1326,8 @@ and compile_ifthenelse (predicate : Lam.t) (t_branch : Lam.t) (f_branch : Lam.t) in match ( should_return, - compile_lambda context1 t_branch, - compile_lambda context1 f_branch ) + compile_lambda output_prefix context1 t_branch, + compile_lambda output_prefix context1 f_branch ) with (* see PR#83 *) | ( Not_tail, @@ -1352,7 +1358,7 @@ and compile_ifthenelse (predicate : Lam.t) (t_branch : Lam.t) (f_branch : Lam.t) [ S.if_ (E.not e) (Js_output.output_as_block - @@ compile_lambda lambda_cxt f_branch); + @@ compile_lambda output_prefix lambda_cxt f_branch); ]) else Js_output.make @@ -1360,10 +1366,10 @@ and compile_ifthenelse (predicate : Lam.t) (t_branch : Lam.t) (f_branch : Lam.t) [ S.if_ e (Js_output.output_as_block - @@ compile_lambda lambda_cxt t_branch) + @@ compile_lambda output_prefix lambda_cxt t_branch) ~else_: (Js_output.output_as_block - @@ compile_lambda lambda_cxt f_branch); + @@ compile_lambda output_prefix lambda_cxt f_branch); ]) | Not_tail, _, { block = []; value = Some out2 } -> let else_ = @@ -1371,13 +1377,13 @@ and compile_ifthenelse (predicate : Lam.t) (t_branch : Lam.t) (f_branch : Lam.t) else Some (Js_output.output_as_block - (compile_lambda lambda_cxt f_branch)) + (compile_lambda output_prefix lambda_cxt f_branch)) in Js_output.make (Ext_list.append_one b (S.if_ e (Js_output.output_as_block - (compile_lambda lambda_cxt t_branch)) + (compile_lambda output_prefix lambda_cxt t_branch)) ?else_)) | ( Maybe_tail_is_return _, { block = []; value = Some out1 }, @@ -1387,16 +1393,16 @@ and compile_ifthenelse (predicate : Lam.t) (t_branch : Lam.t) (f_branch : Lam.t) ~output_finished:True | _, _, _ -> let then_output = - Js_output.output_as_block (compile_lambda lambda_cxt t_branch) + Js_output.output_as_block (compile_lambda output_prefix lambda_cxt t_branch) in let else_output = - Js_output.output_as_block (compile_lambda lambda_cxt f_branch) + Js_output.output_as_block (compile_lambda output_prefix lambda_cxt f_branch) in Js_output.make (Ext_list.append_one b (S.if_ e then_output ~else_:else_output)) )) -and compile_apply (appinfo : Lam.apply) (lambda_cxt : Lam_compile_context.t) = +and compile_apply output_prefix (appinfo : Lam.apply) (lambda_cxt : Lam_compile_context.t) = match appinfo with | { ap_func = @@ -1408,7 +1414,7 @@ and compile_apply (appinfo : Lam.apply) (lambda_cxt : Lam_compile_context.t) = if outer_ap_info.ap_inlined = ap_inlined then outer_ap_info else { outer_ap_info with ap_inlined } in - compile_lambda lambda_cxt + compile_lambda output_prefix lambda_cxt (Lam.apply ap_func (Ext_list.append ap_args appinfo.ap_args) ap_info) (* External function call: it can not be tailcall in this case*) | { @@ -1417,7 +1423,7 @@ and compile_apply (appinfo : Lam.apply) (lambda_cxt : Lam_compile_context.t) = } -> ( match fld_info with | Fld_module { name } -> - compile_external_field_apply appinfo id name lambda_cxt + compile_external_field_apply output_prefix appinfo id name lambda_cxt | _ -> assert false) | _ -> ( (* TODO: --- @@ -1430,7 +1436,7 @@ and compile_apply (appinfo : Lam.apply) (lambda_cxt : Lam_compile_context.t) = = Ext_list.fold_right (ap_func :: appinfo.ap_args) ([], []) (fun x (args_code, fn_code) -> - match compile_lambda new_cxt x with + match compile_lambda output_prefix new_cxt x with | { block; value = Some b } -> (Ext_list.append block args_code, b :: fn_code) | { value = None } -> assert false) @@ -1491,18 +1497,18 @@ and compile_apply (appinfo : Lam.apply) (lambda_cxt : Lam_compile_context.t) = ~info:(call_info_of_ap_status appinfo.ap_info.ap_status) fn_code args)) -and compile_prim (prim_info : Lam.prim_info) +and compile_prim output_prefix (prim_info : Lam.prim_info) (lambda_cxt : Lam_compile_context.t) = match prim_info with | { primitive = Pfield (_, fld_info); args = [ Lglobal_module id ]; _ } -> ( (* should be before Lglobal_global *) match fld_info with | Fld_module { name = field } -> - compile_external_field lambda_cxt id field + compile_external_field output_prefix lambda_cxt id field | _ -> assert false) | { primitive = Praise; args = [ e ]; _ } -> ( match - compile_lambda { lambda_cxt with continuation = NeedValue Not_tail } e + compile_lambda output_prefix { lambda_cxt with continuation = NeedValue Not_tail } e with | { block; value = Some v } -> Js_output.make @@ -1513,8 +1519,8 @@ and compile_prim (prim_info : Lam.prim_info) *) | { value = None } -> assert false) | { primitive = Psequand; args = [ l; r ]; _ } -> - compile_sequand l r lambda_cxt - | { primitive = Psequor; args = [ l; r ] } -> compile_sequor l r lambda_cxt + compile_sequand output_prefix l r lambda_cxt + | { primitive = Psequor; args = [ l; r ] } -> compile_sequor output_prefix l r lambda_cxt | { primitive = Pdebugger; _ } -> (* [%bs.debugger] guarantees that the expression does not matter TODO: make it even safer *) @@ -1534,7 +1540,7 @@ and compile_prim (prim_info : Lam.prim_info) assert (not setter); match - compile_lambda { lambda_cxt with continuation = NeedValue Not_tail } obj + compile_lambda output_prefix { lambda_cxt with continuation = NeedValue Not_tail } obj with | { value = None } -> assert false | { block; value = Some b } -> @@ -1563,8 +1569,8 @@ and compile_prim (prim_info : Lam.prim_info) let need_value_no_return_cxt = { lambda_cxt with continuation = NeedValue Not_tail } in - let obj_output = compile_lambda need_value_no_return_cxt obj in - let arg_output = compile_lambda need_value_no_return_cxt setter_val in + let obj_output = compile_lambda output_prefix need_value_no_return_cxt obj in + let arg_output = compile_lambda output_prefix need_value_no_return_cxt setter_val in let cont obj_block arg_block obj_code = Js_output.output_of_block_and_expression lambda_cxt.continuation (match obj_code with @@ -1596,7 +1602,7 @@ and compile_prim (prim_info : Lam.prim_info) *) match args with | fn :: rest -> - compile_lambda lambda_cxt + compile_lambda output_prefix lambda_cxt (Lam.apply fn rest { ap_loc = loc; @@ -1614,7 +1620,7 @@ and compile_prim (prim_info : Lam.prim_info) here we share env *) (Js_output.output_as_block - (compile_lambda + (compile_lambda output_prefix { lambda_cxt with continuation = @@ -1627,7 +1633,7 @@ and compile_prim (prim_info : Lam.prim_info) body))) | _ -> assert false) | { primitive = Pjs_fn_make arity; args = [ fn ]; loc } -> - compile_lambda lambda_cxt + compile_lambda output_prefix lambda_cxt (Lam_eta_conversion.unsafe_adjust_to_arity loc ~to_:arity ?from:None fn) | { primitive = Pjs_fn_make_unit; args = [ fn ]; loc } -> compile_lambda lambda_cxt fn @@ -1638,7 +1644,7 @@ and compile_prim (prim_info : Lam.prim_info) else let new_cxt = { lambda_cxt with continuation = NeedValue Not_tail } in Ext_list.split_map args (fun x -> - match compile_lambda new_cxt x with + match compile_lambda output_prefix new_cxt x with | { block; value = Some b } -> (block, b) | { value = None } -> assert false) in @@ -1654,19 +1660,19 @@ and compile_prim (prim_info : Lam.prim_info) else let new_cxt = { lambda_cxt with continuation = NeedValue Not_tail } in Ext_list.split_map args (fun x -> - match compile_lambda new_cxt x with + match compile_lambda output_prefix new_cxt x with | { block; value = Some b } -> (block, b) | { value = None } -> assert false) in let args_code : J.block = List.concat args_block in let exp = (* TODO: all can be done in [compile_primitive] *) - Lam_compile_primitive.translate loc lambda_cxt primitive args_expr + Lam_compile_primitive.translate output_prefix loc lambda_cxt primitive args_expr in Js_output.output_of_block_and_expression lambda_cxt.continuation args_code exp -and compile_lambda (lambda_cxt : Lam_compile_context.t) (cur_lam : Lam.t) : +and compile_lambda output_prefix (lambda_cxt : Lam_compile_context.t) (cur_lam : Lam.t) : Js_output.t = match cur_lam with | Lfunction { params; body; attr = { return_unit; async; oneUnitArg } } -> @@ -1677,7 +1683,7 @@ and compile_lambda (lambda_cxt : Lam_compile_context.t) (cur_lam : Lam.t) : here we share env *) (Js_output.output_as_block - (compile_lambda + (compile_lambda output_prefix { lambda_cxt with continuation = @@ -1688,15 +1694,15 @@ and compile_lambda (lambda_cxt : Lam_compile_context.t) (cur_lam : Lam.t) : jmp_table = Lam_compile_context.empty_handler_map; } body))) - | Lapply appinfo -> compile_apply appinfo lambda_cxt + | Lapply appinfo -> compile_apply output_prefix appinfo lambda_cxt | Llet (let_kind, id, arg, body) -> (* Order matters.. see comment below in [Lletrec] *) let args_code = - compile_lambda + compile_lambda output_prefix { lambda_cxt with continuation = Declare (let_kind, id) } arg in - Js_output.append_output args_code (compile_lambda lambda_cxt body) + Js_output.append_output args_code (compile_lambda output_prefix lambda_cxt body) | Lletrec (id_args, body) -> (* There is a bug in our current design, it requires compile args first (register that some objects are jsidentifiers) @@ -1709,8 +1715,8 @@ and compile_lambda (lambda_cxt : Lam_compile_context.t) (cur_lam : Lam.t) : 1. scan the lambda layer first, register js identifier before proceeding 2. delay the method call into javascript ast *) - let v = compile_recursive_lets lambda_cxt id_args in - Js_output.append_output v (compile_lambda lambda_cxt body) + let v = compile_recursive_lets output_prefix lambda_cxt id_args in + Js_output.append_output v (compile_lambda output_prefix lambda_cxt body) | Lvar id -> Js_output.output_of_expression lambda_cxt.continuation ~no_effects:no_effects_const (E.var id) @@ -1725,21 +1731,21 @@ and compile_lambda (lambda_cxt : Lam_compile_context.t) (cur_lam : Lam.t) : *) Js_output.output_of_block_and_expression lambda_cxt.continuation [] (E.ml_module_as_var i) - | Lprim prim_info -> compile_prim prim_info lambda_cxt + | Lprim prim_info -> compile_prim output_prefix prim_info lambda_cxt | Lsequence (l1, l2) -> let output_l1 = - compile_lambda { lambda_cxt with continuation = EffectCall Not_tail } l1 + compile_lambda output_prefix { lambda_cxt with continuation = EffectCall Not_tail } l1 in - let output_l2 = compile_lambda lambda_cxt l2 in + let output_l2 = compile_lambda output_prefix lambda_cxt l2 in Js_output.append_output output_l1 output_l2 | Lifthenelse (predicate, t_branch, f_branch) -> - compile_ifthenelse predicate t_branch f_branch lambda_cxt + compile_ifthenelse output_prefix predicate t_branch f_branch lambda_cxt | Lstringswitch (l, cases, default) -> - compile_stringswitch l cases default lambda_cxt - | Lswitch (switch_arg, sw) -> compile_switch switch_arg sw lambda_cxt - | Lstaticraise (i, largs) -> compile_staticraise i largs lambda_cxt - | Lstaticcatch _ -> compile_staticcatch cur_lam lambda_cxt - | Lwhile (p, body) -> compile_while p body lambda_cxt + compile_stringswitch output_prefix l cases default lambda_cxt + | Lswitch (switch_arg, sw) -> compile_switch output_prefix switch_arg sw lambda_cxt + | Lstaticraise (i, largs) -> compile_staticraise output_prefix i largs lambda_cxt + | Lstaticcatch _ -> compile_staticcatch output_prefix cur_lam lambda_cxt + | Lwhile (p, body) -> compile_while output_prefix p body lambda_cxt | Lfor (id, start, finish, direction, body) -> ( match (direction, finish) with | ( Upto, @@ -1749,12 +1755,12 @@ and compile_lambda (lambda_cxt : Lam_compile_context.t) (cur_lam : Lam.t) : args = [ new_finish; Lconst (Const_int { i = 1l }) ]; } | Lprim { primitive = Poffsetint -1; args = [ new_finish ] } ) ) -> - compile_for id start new_finish Up body lambda_cxt + compile_for output_prefix id start new_finish Up body lambda_cxt | _ -> - compile_for id start finish + compile_for output_prefix id start finish (if direction = Upto then Upto else Downto) body lambda_cxt) - | Lassign (id, lambda) -> compile_assign id lambda lambda_cxt + | Lassign (id, lambda) -> compile_assign output_prefix id lambda lambda_cxt | Ltrywith (lam, id, catch) -> (* generate documentation *) - compile_trywith lam id catch lambda_cxt + compile_trywith output_prefix lam id catch lambda_cxt diff --git a/jscomp/core/lam_compile.mli b/jscomp/core/lam_compile.mli index fd40a4bf1f..ad12c5a015 100644 --- a/jscomp/core/lam_compile.mli +++ b/jscomp/core/lam_compile.mli @@ -25,6 +25,6 @@ (** Compile single lambda IR to JS IR *) val compile_recursive_lets : - Lam_compile_context.t -> (Ident.t * Lam.t) list -> Js_output.t + string -> Lam_compile_context.t -> (Ident.t * Lam.t) list -> Js_output.t -val compile_lambda : Lam_compile_context.t -> Lam.t -> Js_output.t +val compile_lambda : string -> Lam_compile_context.t -> Lam.t -> Js_output.t diff --git a/jscomp/core/lam_compile_main.ml b/jscomp/core/lam_compile_main.ml index e8fe9b6cee..a0e2c8b1e1 100644 --- a/jscomp/core/lam_compile_main.ml +++ b/jscomp/core/lam_compile_main.ml @@ -33,7 +33,7 @@ (* module S = Js_stmt_make *) -let compile_group (meta : Lam_stats.t) +let compile_group output_prefix (meta : Lam_stats.t) (x : Lam_group.t) : Js_output.t = match x with (* @@ -60,20 +60,20 @@ let compile_group (meta : Lam_stats.t) (* let lam = Optimizer.simplify_lets [] lam in *) (* can not apply again, it's wrong USE it with care*) (* ([Js_stmt_make.comment (Gen_of_env.query_type id env )], None) ++ *) - Lam_compile.compile_lambda { continuation = Declare (kind, id); + Lam_compile.compile_lambda output_prefix { continuation = Declare (kind, id); jmp_table = Lam_compile_context.empty_handler_map; meta } lam | Recursive id_lams -> - Lam_compile.compile_recursive_lets + Lam_compile.compile_recursive_lets output_prefix { continuation = EffectCall Not_tail; jmp_table = Lam_compile_context.empty_handler_map; meta } id_lams | Nop lam -> (* TODO: Side effect callls, log and see statistics *) - Lam_compile.compile_lambda {continuation = EffectCall Not_tail; + Lam_compile.compile_lambda output_prefix {continuation = EffectCall Not_tail; jmp_table = Lam_compile_context.empty_handler_map; meta } lam @@ -222,7 +222,7 @@ let maybe_pure = no_side_effects groups in let () = Ext_log.dwarn ~__POS__ "\n@[[TIME:]Pre-compile: %f@]@." (Sys.time () *. 1000.) in #endif let body = - Ext_list.map groups (fun group -> compile_group meta group) + Ext_list.map groups (fun group -> compile_group output_prefix meta group) |> Js_output.concat |> Js_output.output_as_block in diff --git a/jscomp/core/lam_compile_primitive.ml b/jscomp/core/lam_compile_primitive.ml index c2b81cf98d..d8eb181943 100644 --- a/jscomp/core/lam_compile_primitive.ml +++ b/jscomp/core/lam_compile_primitive.ml @@ -36,8 +36,43 @@ let ensure_value_unit (st : Lam_compile_context.continuation) e : E.t = | EffectCall Not_tail -> e (* NeedValue should return a meaningful expression*) -let translate loc (cxt : Lam_compile_context.t) (prim : Lam_primitive.t) - (args : J.expression list) : J.expression = +let module_of_expression = function + | J.Var (J.Qualified (module_id, value)) -> [ (module_id, value) ] + | _ -> [] + +let get_module_system () = + let packages_info = Js_packages_state.get_packages_info () in + let module_systems = + Js_packages_info.map packages_info (fun { module_system } -> module_system) + in + match module_systems with + (* fixme: test mode where the module system is empty *) + | [] -> assert false + | module_system :: _rest -> module_system + +let import_of_path path = + E.call + ~info:{ arity = Full; call_info = Call_na } + (E.js_global "import") + [ E.str path ] + +let wrap_then import value = + let arg = Ident.create "m" in + E.call + ~info:{ arity = Full; call_info = Call_na } + (E.dot import "then") + [ + E.ocaml_fun ~return_unit:false ~async:false [ arg ] + [ + { + statement_desc = J.Return (E.dot (E.var arg) value); + comment = None; + }; + ]; + ] + +let translate output_prefix loc (cxt : Lam_compile_context.t) + (prim : Lam_primitive.t) (args : J.expression list) : J.expression = match prim with | Pis_not_none -> Js_of_lam_option.is_not_none (Ext_list.singleton_exn args) | Pcreate_extension s -> E.make_exception s @@ -78,6 +113,27 @@ let translate loc (cxt : Lam_compile_context.t) (prim : Lam_primitive.t) | _ -> E.runtime_call Js_runtime_modules.option "nullable_to_opt" args ) | _ -> assert false) + | Pimport -> ( + match args with + | [ e ] -> ( + let output_dir = Filename.dirname output_prefix in + + let module_id, module_value = + match module_of_expression e.expression_desc with + | [ module_ ] -> module_ + | _ -> assert false + (* TODO: graceful error message here *) + in + + let path = + Js_name_of_module_id.string_of_module_id module_id ~output_dir + (get_module_system ()) + in + + match module_value with + | Some value -> wrap_then (import_of_path path) value + | None -> import_of_path path) + | _ -> assert false) | Pjs_function_length -> E.function_length (Ext_list.singleton_exn args) | Pcaml_obj_length -> E.obj_length (Ext_list.singleton_exn args) | Pis_null -> E.is_null (Ext_list.singleton_exn args) diff --git a/jscomp/core/lam_compile_primitive.mli b/jscomp/core/lam_compile_primitive.mli index 4ffe2c4198..b507f63b1c 100644 --- a/jscomp/core/lam_compile_primitive.mli +++ b/jscomp/core/lam_compile_primitive.mli @@ -29,6 +29,7 @@ *) val translate : + string -> Location.t -> Lam_compile_context.t -> Lam_primitive.t -> diff --git a/jscomp/core/lam_convert.ml b/jscomp/core/lam_convert.ml index 87d88b6b67..d5737a7756 100644 --- a/jscomp/core/lam_convert.ml +++ b/jscomp/core/lam_convert.ml @@ -479,6 +479,7 @@ let convert (exports : Set_ident.t) (lam : Lambda.lambda) : | "#nullable_to_opt" -> Pnull_undefined_to_opt | "#null_to_opt" -> Pnull_to_opt | "#is_nullable" -> Pis_null_undefined + | "#import" ->Pimport | "#string_append" -> Pstringadd | "#wrap_exn" -> Pwrap_exn | "#obj_length" -> Pcaml_obj_length diff --git a/jscomp/core/lam_primitive.ml b/jscomp/core/lam_primitive.ml index 37a605a5eb..26a9f998b2 100644 --- a/jscomp/core/lam_primitive.ml +++ b/jscomp/core/lam_primitive.ml @@ -143,6 +143,7 @@ type t = | Pis_null | Pis_undefined | Pis_null_undefined + | Pimport | Pjs_typeof | Pjs_function_length | Pcaml_obj_length @@ -219,6 +220,7 @@ let eq_primitive_approx (lhs : t) (rhs : t) = | Psome_not_nest -> rhs = Psome_not_nest | Pis_undefined -> rhs = Pis_undefined | Pis_null_undefined -> rhs = Pis_null_undefined + | Pimport -> rhs = Pimport | Pjs_typeof -> rhs = Pjs_typeof | Pisint -> rhs = Pisint | Pis_poly_var_block -> rhs = Pis_poly_var_block diff --git a/jscomp/core/lam_primitive.mli b/jscomp/core/lam_primitive.mli index 165d9c2faa..d78dd25e64 100644 --- a/jscomp/core/lam_primitive.mli +++ b/jscomp/core/lam_primitive.mli @@ -131,6 +131,7 @@ type t = | Pis_null | Pis_undefined | Pis_null_undefined + | Pimport | Pjs_typeof | Pjs_function_length | Pcaml_obj_length diff --git a/jscomp/core/lam_print.ml b/jscomp/core/lam_print.ml index 0be624d255..045fe5f847 100644 --- a/jscomp/core/lam_print.ml +++ b/jscomp/core/lam_print.ml @@ -79,6 +79,7 @@ let primitive ppf (prim : Lam_primitive.t) = | Pval_from_option_not_nest -> fprintf ppf "[?unbox-not-nest]" | Pis_undefined -> fprintf ppf "[?undefined]" | Pis_null_undefined -> fprintf ppf "[?null?undefined]" + | Pimport -> fprintf ppf "[import]" | Pmakeblock (tag, _, Immutable) -> fprintf ppf "makeblock %i" tag | Pmakeblock (tag, _, Mutable) -> fprintf ppf "makemutable %i" tag | Pfield (n, field_info) -> ( diff --git a/jscomp/frontend/ast_await.ml b/jscomp/frontend/ast_await.ml index 6af5ebaeb9..bebc327ccd 100644 --- a/jscomp/frontend/ast_await.ml +++ b/jscomp/frontend/ast_await.ml @@ -4,4 +4,28 @@ let create_await_expression (e : Parsetree.expression) = Ast_helper.Exp.ident ~loc {txt = Ldot (Ldot (Lident "Js", "Promise"), "unsafe_await"); loc} in - Ast_helper.Exp.apply ~loc unsafe_await [(Nolabel, e)] + Ast_helper.Exp.apply ~loc unsafe_await [ (Nolabel, e) ] + +let create_await_module_expression ~module_type_name (e : Parsetree.module_expr) + = + let open Ast_helper in + { + e with + pmod_desc = + Pmod_unpack + (create_await_expression + (Exp.apply + (Exp.ident ~loc:e.pmod_loc + { + txt = Longident.Ldot (Lident "Js", "import"); + loc = e.pmod_loc; + }) + [ + ( Nolabel, + Exp.constraint_ ~loc:e.pmod_loc + (Exp.pack ~loc:e.pmod_loc e) + (Typ.package ~loc:e.pmod_loc + { txt = Lident module_type_name; loc = e.pmod_loc } + []) ); + ])); + } diff --git a/jscomp/frontend/bs_builtin_ppx.ml b/jscomp/frontend/bs_builtin_ppx.ml index c61c09f981..5fbcf26c9a 100644 --- a/jscomp/frontend/bs_builtin_ppx.ml +++ b/jscomp/frontend/bs_builtin_ppx.ml @@ -224,10 +224,10 @@ let expr_mapper ~async_context ~in_function_def (self : mapper) match Ast_attributes.has_await_payload e.pexp_attributes with | None -> result | Some _ -> - if !async_context = false then - Location.raise_errorf ~loc:e.pexp_loc - "Await on expression not in an async context"; - Ast_await.create_await_expression result + (* if !async_context = false then + Location.raise_errorf ~loc:e.pexp_loc + "Await on expression not in an async context"; *) + Ast_await.create_await_expression result let typ_mapper (self : mapper) (typ : Parsetree.core_type) = Ast_core_type_class_type.typ_mapper self typ @@ -424,6 +424,13 @@ let local_module_name = incr v; "local_" ^ string_of_int !v +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 expand_reverse (stru : Ast_structure.t) (acc : Ast_structure.t) : Ast_structure.t = if stru = [] then acc @@ -486,6 +493,37 @@ let rec structure_mapper (self : mapper) (stru : Ast_structure.t) = | _ -> expand_reverse acc (structure_mapper self rest) in aux [] stru + | Pstr_module + ({ + pmb_expr = + { pmod_desc = Pmod_ident { txt; loc }; pmod_attributes } as me; + } as mb) + (* module M = @res.await Belt.List *) + 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 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)) + in + (* module BeltList0 = 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) let mapper : mapper = diff --git a/jscomp/others/js.ml b/jscomp/others/js.ml index c8203dad14..90b8c28833 100644 --- a/jscomp/others/js.ml +++ b/jscomp/others/js.ml @@ -107,6 +107,7 @@ external toOption : 'a nullable -> 'a option = "#nullable_to_opt" external undefinedToOption : 'a undefined -> 'a option = "#undefined_to_opt" external nullToOption : 'a null -> 'a option = "#null_to_opt" external isNullable : 'a nullable -> bool = "#is_nullable" +external import : 'a -> 'a promise = "#import" external testAny : 'a -> bool = "#is_nullable" (** The same as {!test} except that it is more permissive on the types of input *) diff --git a/jscomp/runtime/js.ml b/jscomp/runtime/js.ml index 7ed38a6058..dacc4aceca 100644 --- a/jscomp/runtime/js.ml +++ b/jscomp/runtime/js.ml @@ -78,6 +78,8 @@ external nullToOption : 'a null -> 'a option = "#null_to_opt" external isNullable : 'a nullable -> bool = "#is_nullable" +external import : 'a -> 'a promise = "#import" + (** The same as {!test} except that it is more permissive on the types of input *) external testAny : 'a -> bool = "#is_nullable" diff --git a/jscomp/test/Import.js b/jscomp/test/Import.js new file mode 100644 index 0000000000..a21d912bf1 --- /dev/null +++ b/jscomp/test/Import.js @@ -0,0 +1,58 @@ +'use strict'; + +var Curry = require("../../lib/js/curry.js"); + +async function eachIntAsync(list, f) { + return Curry._2(await import("../../lib/js/belt_List.js").then(function (m) { + return m.forEach; + }), list, f); +} + +function eachIntLazy(list, f) { + var obj = import("../../lib/js/belt_List.js").then(function (m) { + return m.forEach; + }); + var arg1 = function (each) { + return Promise.resolve(Curry._2(each, list, f)); + }; + return obj.then(arg1); +} + +eachIntLazy({ + hd: 1, + tl: { + hd: 2, + tl: { + hd: 3, + tl: /* [] */0 + } + } + }, (function (n) { + console.log("lazy", n); + })); + +eachIntAsync({ + hd: 1, + tl: { + hd: 2, + tl: { + hd: 3, + tl: /* [] */0 + } + } + }, (function (n) { + console.log("async", n); + })); + +var beltAsModule = import("../../lib/js/belt_List.js"); + +var M = await import("../../lib/js/belt_List.js"); + +var each = M.forEach; + +exports.eachIntAsync = eachIntAsync; +exports.eachIntLazy = eachIntLazy; +exports.beltAsModule = beltAsModule; +exports.M = M; +exports.each = each; +/* Not a pure module */ diff --git a/jscomp/test/Import.res b/jscomp/test/Import.res new file mode 100644 index 0000000000..c0ac165d05 --- /dev/null +++ b/jscomp/test/Import.res @@ -0,0 +1,17 @@ +let eachIntAsync = async (list: list, f: int => unit) => { + list->(await Js.import(Belt.List.forEach))(f) +} + +let eachIntLazy = (list: list, f: int => unit) => + Js.import(Belt.List.forEach) |> Js.Promise.then_(each => list->each(f)->Js.Promise.resolve) + +let _ = list{1, 2, 3}->eachIntLazy(n => Js.log2("lazy", n)) +let _ = list{1, 2, 3}->eachIntAsync(n => Js.log2("async", n)) + +module type BeltList = module type of Belt.List +let beltAsModule = 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 diff --git a/lib/es6/belt_internalBuckets.js b/lib/es6/belt_internalBuckets.js index 09cf0a8f55..302642266a 100644 --- a/lib/es6/belt_internalBuckets.js +++ b/lib/es6/belt_internalBuckets.js @@ -4,6 +4,19 @@ import * as Curry from "./curry.js"; import * as Belt_Array from "./belt_Array.js"; import * as Caml_option from "./caml_option.js"; +function copyBucket(c) { + if (c === undefined) { + return c; + } + var head = { + key: c.key, + value: c.value, + next: undefined + }; + copyAuxCont(c.next, head); + return head; +} + function copyAuxCont(_c, _prec) { while(true) { var prec = _prec; @@ -23,19 +36,6 @@ function copyAuxCont(_c, _prec) { }; } -function copyBucket(c) { - if (c === undefined) { - return c; - } - var head = { - key: c.key, - value: c.value, - next: undefined - }; - copyAuxCont(c.next, head); - return head; -} - function copyBuckets(buckets) { var len = buckets.length; var newBuckets = new Array(len); diff --git a/lib/js/belt_internalBuckets.js b/lib/js/belt_internalBuckets.js index cad3a978dc..eabd14bcbc 100644 --- a/lib/js/belt_internalBuckets.js +++ b/lib/js/belt_internalBuckets.js @@ -4,6 +4,19 @@ var Curry = require("./curry.js"); var Belt_Array = require("./belt_Array.js"); var Caml_option = require("./caml_option.js"); +function copyBucket(c) { + if (c === undefined) { + return c; + } + var head = { + key: c.key, + value: c.value, + next: undefined + }; + copyAuxCont(c.next, head); + return head; +} + function copyAuxCont(_c, _prec) { while(true) { var prec = _prec; @@ -23,19 +36,6 @@ function copyAuxCont(_c, _prec) { }; } -function copyBucket(c) { - if (c === undefined) { - return c; - } - var head = { - key: c.key, - value: c.value, - next: undefined - }; - copyAuxCont(c.next, head); - return head; -} - function copyBuckets(buckets) { var len = buckets.length; var newBuckets = new Array(len); From dd3c38debae5c87eb3daba89d426b5d835ccb8ee Mon Sep 17 00:00:00 2001 From: Woonki Moon Date: Wed, 21 Dec 2022 01:59:04 +0900 Subject: [PATCH 02/14] await for dynamic import without async context --- jscomp/frontend/bs_builtin_ppx.ml | 10 ++++++++-- jscomp/test/Import.js | 2 +- jscomp/test/Import.res | 2 +- 3 files changed, 10 insertions(+), 4 deletions(-) diff --git a/jscomp/frontend/bs_builtin_ppx.ml b/jscomp/frontend/bs_builtin_ppx.ml index 5fbcf26c9a..657262f7cd 100644 --- a/jscomp/frontend/bs_builtin_ppx.ml +++ b/jscomp/frontend/bs_builtin_ppx.ml @@ -224,9 +224,15 @@ let expr_mapper ~async_context ~in_function_def (self : mapper) match Ast_attributes.has_await_payload e.pexp_attributes with | None -> result | Some _ -> - (* if !async_context = false then + (if !async_context = false then + let isJsImport (e : Parsetree.expression) = + match e with + | { pexp_desc = Pexp_apply ({ pexp_desc = Pexp_ident { txt = Ldot ( Lident "Js", "import") } }, _) } -> true + | _ -> false + in + if not (isJsImport e) then Location.raise_errorf ~loc:e.pexp_loc - "Await on expression not in an async context"; *) + "Await on expression not in an async context"); Ast_await.create_await_expression result let typ_mapper (self : mapper) (typ : Parsetree.core_type) = diff --git a/jscomp/test/Import.js b/jscomp/test/Import.js index a21d912bf1..ab767b4f3d 100644 --- a/jscomp/test/Import.js +++ b/jscomp/test/Import.js @@ -44,7 +44,7 @@ eachIntAsync({ console.log("async", n); })); -var beltAsModule = import("../../lib/js/belt_List.js"); +var beltAsModule = await import("../../lib/js/belt_List.js"); var M = await import("../../lib/js/belt_List.js"); diff --git a/jscomp/test/Import.res b/jscomp/test/Import.res index c0ac165d05..cf4436eef1 100644 --- a/jscomp/test/Import.res +++ b/jscomp/test/Import.res @@ -9,7 +9,7 @@ let _ = list{1, 2, 3}->eachIntLazy(n => Js.log2("lazy", n)) let _ = list{1, 2, 3}->eachIntAsync(n => Js.log2("async", n)) module type BeltList = module type of Belt.List -let beltAsModule = Js.import(module(Belt.List: BeltList)) +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))) From e92854f011f45be7c7a0fcc558cc950a8ec775cb Mon Sep 17 00:00:00 2001 From: Woonki Moon Date: Tue, 27 Dec 2022 00:23:32 +0900 Subject: [PATCH 03/14] avoid unintended module type name conflict --- jscomp/frontend/bs_builtin_ppx.ml | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/jscomp/frontend/bs_builtin_ppx.ml b/jscomp/frontend/bs_builtin_ppx.ml index 657262f7cd..5a76408489 100644 --- a/jscomp/frontend/bs_builtin_ppx.ml +++ b/jscomp/frontend/bs_builtin_ppx.ml @@ -434,8 +434,8 @@ 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 + "__" ^ (Longident.flatten txt |> List.fold_left (fun ll l -> ll ^ l) "") + ^ string_of_int !v ^ "__" let expand_reverse (stru : Ast_structure.t) (acc : Ast_structure.t) : Ast_structure.t = @@ -515,7 +515,7 @@ let rec structure_mapper (self : mapper) (stru : Ast_structure.t) = { txt = safe_module_type_name; loc } ~typ:(Mty.typeof_ ~loc me)) in - (* module BeltList0 = module type of Belt.List *) + (* module __BeltList1__ = module type of Belt.List *) module_type_decl :: { item with From 236f32e24126de303b386c3537611bbac1f23e18 Mon Sep 17 00:00:00 2001 From: Woonki Moon Date: Wed, 28 Dec 2022 02:30:29 +0900 Subject: [PATCH 04/14] fix getting correct module_system --- jscomp/core/js_implementation.ml | 4 +- jscomp/core/lam_compile.ml | 255 +++++++++++++------------- jscomp/core/lam_compile.mli | 4 +- jscomp/core/lam_compile_main.ml | 19 +- jscomp/core/lam_compile_main.mli | 4 +- jscomp/core/lam_compile_primitive.ml | 14 +- jscomp/core/lam_compile_primitive.mli | 1 + 7 files changed, 148 insertions(+), 153 deletions(-) diff --git a/jscomp/core/js_implementation.ml b/jscomp/core/js_implementation.ml index e20cb021a3..a6f67363f1 100644 --- a/jscomp/core/js_implementation.ml +++ b/jscomp/core/js_implementation.ml @@ -164,9 +164,9 @@ let after_parsing_impl ppf outputprefix (ast : Parsetree.structure) = let lambda, exports = Translmod.transl_implementation modulename typedtree_coercion in - let js_program = + let js_program module_system = print_if_pipe ppf Clflags.dump_rawlambda Printlambda.lambda lambda - |> Lam_compile_main.compile outputprefix exports + |> Lam_compile_main.compile outputprefix module_system exports in if not !Js_config.cmj_only then Lam_compile_main.lambda_as_module js_program outputprefix); diff --git a/jscomp/core/lam_compile.ml b/jscomp/core/lam_compile.ml index 7bb358379c..596ae6548f 100644 --- a/jscomp/core/lam_compile.ml +++ b/jscomp/core/lam_compile.ml @@ -225,10 +225,10 @@ type initialization = J.block non-toplevel, it will explode code very quickly *) let rec compile_external_field (* Like [List.empty]*) - output_prefix (lamba_cxt : Lam_compile_context.t) (id : Ident.t) name : Js_output.t = + output_prefix module_system (lamba_cxt : Lam_compile_context.t) (id : Ident.t) name : Js_output.t = match Lam_compile_env.query_external_id_info id name with | { persistent_closed_lambda = Some lam } when Lam_util.not_function lam -> - compile_lambda output_prefix lamba_cxt lam + compile_lambda output_prefix module_system lamba_cxt lam | _ -> Js_output.output_of_expression lamba_cxt.continuation ~no_effects:no_effects_const (E.ml_var_dot id name) @@ -260,7 +260,7 @@ let rec compile_external_field (* Like [List.empty]*) for the function, generative module or functor can be a function, however it can not be global -- global can only module *) -and compile_external_field_apply output_prefix (appinfo : Lam.apply) (module_id : Ident.t) +and compile_external_field_apply output_prefix module_system (appinfo : Lam.apply) (module_id : Ident.t) (field_name : string) (lambda_cxt : Lam_compile_context.t) : Js_output.t = let ident_info = Lam_compile_env.query_external_id_info module_id field_name @@ -273,7 +273,7 @@ and compile_external_field_apply output_prefix (appinfo : Lam.apply) (module_id let _, param_map = Lam_closure.is_closed_with_map Set_ident.empty params body in - compile_lambda output_prefix lambda_cxt + compile_lambda output_prefix module_system lambda_cxt (Lam_beta_reduce.propagate_beta_reduce_with_map lambda_cxt.meta param_map params body ap_args) | _ -> @@ -283,7 +283,7 @@ and compile_external_field_apply output_prefix (appinfo : Lam.apply) (module_id else let arg_cxt = { lambda_cxt with continuation = NeedValue Not_tail } in Ext_list.fold_right ap_args dummy (fun arg_lambda (args_code, args) -> - match compile_lambda output_prefix arg_cxt arg_lambda with + match compile_lambda output_prefix module_system arg_cxt arg_lambda with | { block; value = Some b } -> (Ext_list.append block args_code, b :: args) | _ -> assert false) @@ -312,7 +312,7 @@ and compile_external_field_apply output_prefix (appinfo : Lam.apply) (module_id here we share env *) -and compile_recursive_let output_prefix ~all_bindings (cxt : Lam_compile_context.t) +and compile_recursive_let output_prefix module_system ~all_bindings (cxt : Lam_compile_context.t) (id : Ident.t) (arg : Lam.t) : Js_output.t * initialization = match arg with | Lfunction { params; body; attr = { return_unit; async; oneUnitArg } } -> @@ -337,6 +337,7 @@ and compile_recursive_let output_prefix ~all_bindings (cxt : Lam_compile_context let output = compile_lambda output_prefix + module_system { cxt with continuation = @@ -376,7 +377,7 @@ and compile_recursive_let output_prefix ~all_bindings (cxt : Lam_compile_context [] ) | Lprim { primitive = Pmakeblock (_, _, _); args } when args_either_function_or_const args -> - (compile_lambda output_prefix { cxt with continuation = Declare (Alias, id) } arg, []) + (compile_lambda output_prefix module_system { cxt with continuation = Declare (Alias, id) } arg, []) (* case of lazy blocks, treat it as usual *) | Lprim { @@ -434,7 +435,7 @@ and compile_recursive_let output_prefix ~all_bindings (cxt : Lam_compile_context however it would affect scope issues, we have to declare it first *) match - compile_lambda output_prefix { cxt with continuation = NeedValue Not_tail } arg + compile_lambda output_prefix module_system { cxt with continuation = NeedValue Not_tail } arg with | { block = b; value = Some v } -> (* TODO: check recursive value .. @@ -471,15 +472,15 @@ and compile_recursive_let output_prefix ~all_bindings (cxt : Lam_compile_context fun _-> print_endline "hey"; v () ]} *) - (compile_lambda output_prefix { cxt with continuation = Declare (Alias, id) } arg, []) + (compile_lambda output_prefix module_system { cxt with continuation = Declare (Alias, id) } arg, []) -and compile_recursive_lets_aux output_prefix cxt (id_args : Lam_scc.bindings) : Js_output.t = +and compile_recursive_lets_aux output_prefix module_system cxt (id_args : Lam_scc.bindings) : Js_output.t = (* #1716 *) let output_code, ids = Ext_list.fold_right id_args (Js_output.dummy, []) (fun (ident, arg) (acc, ids) -> let code, declare_ids = - compile_recursive_let output_prefix ~all_bindings:id_args cxt ident arg + compile_recursive_let output_prefix module_system ~all_bindings:id_args cxt ident arg in (Js_output.append_output code acc, Ext_list.append declare_ids ids)) in @@ -487,7 +488,7 @@ and compile_recursive_lets_aux output_prefix cxt (id_args : Lam_scc.bindings) : | [] -> output_code | _ -> Js_output.append_output (Js_output.make ids) output_code -and compile_recursive_lets output_prefix cxt id_args : Js_output.t = +and compile_recursive_lets output_prefix module_system cxt id_args : Js_output.t = match id_args with | [] -> Js_output.dummy | _ -> ( @@ -495,14 +496,15 @@ and compile_recursive_lets output_prefix cxt id_args : Js_output.t = match id_args_group with | [] -> assert false | first :: rest -> - let acc = compile_recursive_lets_aux output_prefix cxt first in + let acc = compile_recursive_lets_aux output_prefix module_system cxt first in Ext_list.fold_left rest acc (fun acc x -> - Js_output.append_output acc (compile_recursive_lets_aux output_prefix cxt x))) + Js_output.append_output acc (compile_recursive_lets_aux output_prefix module_system cxt x))) and compile_general_cases : 'a . string -> - ('a -> Ast_untagged_variants.literal option) -> + Js_packages_info.module_system -> + ('a -> Ast_untagged_variants.literal option) -> ('a -> J.expression) -> ('a option -> J.expression -> 'a option -> J.expression -> J.expression) -> Lam_compile_context.t -> @@ -515,7 +517,7 @@ and compile_general_cases : ('a * Lam.t) list -> default_case -> J.block = - fun (output_prefix: string) (get_cstr_name : _ -> Ast_untagged_variants.literal option) (make_exp : _ -> J.expression) + fun (output_prefix: string) (module_system: Js_packages_info.module_system) (get_cstr_name : _ -> Ast_untagged_variants.literal option) (make_exp : _ -> J.expression) (eq_exp : 'a option -> J.expression -> 'a option -> J.expression -> J.expression) (cxt : Lam_compile_context.t) (switch : @@ -526,7 +528,7 @@ and compile_general_cases : J.statement) (switch_exp : J.expression) (cases : (_ * Lam.t) list) (default : default_case) -> match (cases, default) with - | [], Default lam -> Js_output.output_as_block (compile_lambda output_prefix cxt lam) + | [], Default lam -> Js_output.output_as_block (compile_lambda output_prefix module_system cxt lam) | [], (Complete | NonComplete) -> [] | [ (_, lam) ], Complete -> (* To take advantage of such optimizations, @@ -535,19 +537,19 @@ and compile_general_cases : otherwise the compiler engine would think that it's also complete *) - Js_output.output_as_block (compile_lambda output_prefix cxt lam) + Js_output.output_as_block (compile_lambda output_prefix module_system cxt lam) | [ (id, lam) ], NonComplete -> morph_declare_to_assign cxt (fun cxt define -> [ S.if_ ?declaration:define (eq_exp None switch_exp (Some id) (make_exp id)) - (Js_output.output_as_block (compile_lambda output_prefix cxt lam)); + (Js_output.output_as_block (compile_lambda output_prefix module_system cxt lam)); ]) | [ (id, lam) ], Default x | [ (id, lam); (_, x) ], Complete -> morph_declare_to_assign cxt (fun cxt define -> - let else_block = Js_output.output_as_block (compile_lambda output_prefix cxt x) in - let then_block = Js_output.output_as_block (compile_lambda output_prefix cxt lam) in + let else_block = Js_output.output_as_block (compile_lambda output_prefix module_system cxt x) in + let then_block = Js_output.output_as_block (compile_lambda output_prefix module_system cxt lam) in [ S.if_ ?declaration:define (eq_exp None switch_exp (Some id) (make_exp id)) @@ -578,7 +580,7 @@ and compile_general_cases : | Complete -> None | NonComplete -> None | Default lam -> - Some (Js_output.output_as_block (compile_lambda output_prefix cxt lam)) + Some (Js_output.output_as_block (compile_lambda output_prefix module_system cxt lam)) in let make_comment i = match get_cstr_name i with | None -> None @@ -588,7 +590,7 @@ and compile_general_cases : if last then (* merge and shared *) let switch_body, should_break = - Js_output.to_break_block (compile_lambda output_prefix cxt lam) + Js_output.to_break_block (compile_lambda output_prefix module_system cxt lam) in let should_break = if @@ -627,14 +629,14 @@ and use_compile_literal_cases table get_name = | Some {name; literal_type = None}, Some string_table -> Some ((String name, lam) :: string_table) | _, _ -> None ) table (Some []) -and compile_cases ?(untagged=false) output_prefix cxt (switch_exp : E.t) table default get_name = +and compile_cases ?(untagged=false) output_prefix module_system cxt (switch_exp : E.t) table default get_name = match use_compile_literal_cases table get_name with | Some string_table -> if untagged then compile_untagged_cases cxt switch_exp string_table default else compile_string_cases cxt switch_exp string_table default | None -> - compile_general_cases output_prefix get_name + compile_general_cases output_prefix module_system get_name (fun i -> match get_name i with | None -> E.small_int i | Some {literal_type = Some(String s)} -> E.str s @@ -681,16 +683,16 @@ and compile_switch (switch_arg : Lam.t) (sw : Lam.lambda_switch) let untagged = block_cases <> [] in let compile_whole (cxt : Lam_compile_context.t) = match - compile_lambda output_prefix { cxt with continuation = NeedValue Not_tail } switch_arg + compile_lambda output_prefix module_system { cxt with continuation = NeedValue Not_tail } switch_arg with | { value = None; _ } -> assert false | { block; value = Some e } -> ( block @ if sw_consts_full && sw_consts = [] then - compile_cases ~untagged output_prefix cxt (if untagged then e else E.tag ~name:tag_name e) sw_blocks sw_blocks_default get_block_name + compile_cases ~untagged output_prefix module_system cxt (if untagged then e else E.tag ~name:tag_name e) sw_blocks sw_blocks_default get_block_name else if sw_blocks_full && sw_blocks = [] then - compile_cases output_prefix cxt e sw_consts sw_num_default get_const_name + compile_cases output_prefix module_system cxt e sw_consts sw_num_default get_const_name else (* [e] will be used twice *) let dispatch e = @@ -702,9 +704,9 @@ and compile_switch (switch_arg : Lam.t) (sw : Lam.lambda_switch) else E.is_int_tag ~has_null_undefined_other:(has_null_undefined_other sw_names) e in S.if_ is_a_literal_case - (compile_cases output_prefix cxt e sw_consts sw_num_default get_const_name) + (compile_cases output_prefix module_system cxt e sw_consts sw_num_default get_const_name) ~else_: - (compile_cases ~untagged output_prefix cxt (if untagged then e else E.tag ~name:tag_name e) sw_blocks sw_blocks_default + (compile_cases ~untagged output_prefix module_system cxt (if untagged then e else E.tag ~name:tag_name e) sw_blocks sw_blocks_default get_block_name) in match e.expression_desc with @@ -733,12 +735,13 @@ and compile_switch (switch_arg : Lam.t) (sw : Lam.lambda_switch) | EffectCall _ | Assign _ -> Js_output.make (compile_whole lambda_cxt) - and compile_string_cases output_prefix cxt switch_exp table default = + and compile_string_cases output_prefix module_system cxt switch_exp table default = let literal = function | literal -> E.literal literal in compile_general_cases output_prefix + module_system (fun _ -> None) literal (fun _ x _ y -> E.string_equal x y) @@ -787,14 +790,14 @@ and compile_untagged_cases cxt switch_exp table default = body switch_exp table default -and compile_stringswitch output_prefix l cases default (lambda_cxt : Lam_compile_context.t) = +and compile_stringswitch output_prefix module_system l cases default (lambda_cxt : Lam_compile_context.t) = (* TODO might better optimization according to the number of cases Be careful: we should avoid multiple evaluation of l, The [gen] can be elimiated when number of [cases] is less than 3 *) let cases = cases |> List.map (fun (s,l) -> Ast_untagged_variants.String s, l) in match - compile_lambda output_prefix { lambda_cxt with continuation = NeedValue Not_tail } l + compile_lambda output_prefix module_system { lambda_cxt with continuation = NeedValue Not_tail } l with | { value = None } -> assert false | { block; value = Some e } -> ( @@ -809,14 +812,14 @@ and compile_stringswitch output_prefix l cases default (lambda_cxt : Lam_compile let v = Ext_ident.create_tmp () in Js_output.make (Ext_list.append block - (compile_string_cases output_prefix + (compile_string_cases output_prefix module_system { lambda_cxt with continuation = Declare (Variable, v) } e cases default)) ~value:(E.var v) | _ -> Js_output.make (Ext_list.append block - (compile_string_cases output_prefix lambda_cxt e cases default))) + (compile_string_cases output_prefix module_system lambda_cxt e cases default))) (* This should be optimized in lambda layer @@ -828,7 +831,7 @@ and compile_stringswitch output_prefix l cases default (lambda_cxt : Lam_compile default: (exit 1)) with (1) 2)) *) -and compile_staticraise output_prefix i (largs : Lam.t list) +and compile_staticraise output_prefix module_system i (largs : Lam.t list) (lambda_cxt : Lam_compile_context.t) = (* [i] is the jump table, [largs] is the arguments passed to [Lstaticcatch]*) match Lam_compile_context.find_exn lambda_cxt i with @@ -843,7 +846,7 @@ and compile_staticraise output_prefix i (largs : Lam.t list) | Lvar id -> Js_output.make [ S.assign bind (E.var id) ] | _ -> (* TODO: should be Assign -- Assign is an optimization *) - compile_lambda output_prefix + compile_lambda output_prefix module_system { lambda_cxt with continuation = Assign bind } larg in @@ -878,7 +881,7 @@ and compile_staticraise output_prefix i (largs : Lam.t list) ]} *) -and compile_staticcatch output_prefix (lam : Lam.t) (lambda_cxt : Lam_compile_context.t) = +and compile_staticcatch output_prefix module_system (lam : Lam.t) (lambda_cxt : Lam_compile_context.t) = let code_table, body = flatten_nested_caches lam in let exit_id = Ext_ident.create_tmp ~name:"exit" () in match (lambda_cxt.continuation, code_table) with @@ -900,13 +903,13 @@ and compile_staticcatch output_prefix (lam : Lam.t) (lambda_cxt : Lam_compile_co } in - let lbody = compile_lambda output_prefix new_cxt body in + let lbody = compile_lambda output_prefix module_system new_cxt body in let declares = Ext_list.map code_table.bindings (fun x -> S.declare_variable ~kind:Variable x) in Js_output.append_output (Js_output.make declares) - (Js_output.append_output lbody (compile_lambda output_prefix lambda_cxt handler)) + (Js_output.append_output lbody (compile_lambda output_prefix module_system lambda_cxt handler)) | _ -> ( let exit_expr = E.var exit_id in let jmp_table, handlers = @@ -928,12 +931,12 @@ and compile_staticcatch output_prefix (lam : Lam.t) (lambda_cxt : Lam_compile_co let new_cxt = { lambda_cxt with jmp_table; continuation = Assign v } in - let lbody = compile_lambda output_prefix new_cxt body in + let lbody = compile_lambda output_prefix module_system new_cxt body in Js_output.append_output (Js_output.make (S.declare_variable ~kind:Variable v :: declares)) (Js_output.append_output lbody (Js_output.make - (compile_cases output_prefix new_cxt exit_expr handlers NonComplete + (compile_cases output_prefix module_system new_cxt exit_expr handlers NonComplete (fun _ -> None)) ~value:(E.var v))) | Declare (kind, id) (* declare first this we will do branching*) -> @@ -941,11 +944,11 @@ and compile_staticcatch output_prefix (lam : Lam.t) (lambda_cxt : Lam_compile_co let new_cxt = { lambda_cxt with jmp_table; continuation = Assign id } in - let lbody = compile_lambda output_prefix new_cxt body in + let lbody = compile_lambda output_prefix module_system new_cxt body in Js_output.append_output (Js_output.make declares) (Js_output.append_output lbody (Js_output.make - (compile_cases output_prefix new_cxt exit_expr handlers NonComplete + (compile_cases output_prefix module_system new_cxt exit_expr handlers NonComplete (fun _ -> None)))) (* place holder -- tell the compiler that we don't know if it's complete @@ -957,31 +960,31 @@ and compile_staticcatch output_prefix (lam : Lam.t) (lambda_cxt : Lam_compile_co else EffectCall new_tail_type in let new_cxt = { lambda_cxt with jmp_table; continuation } in - let lbody = compile_lambda output_prefix new_cxt body in + let lbody = compile_lambda output_prefix module_system new_cxt body in Js_output.append_output (Js_output.make declares) (Js_output.append_output lbody (Js_output.make - (compile_cases output_prefix new_cxt exit_expr handlers NonComplete + (compile_cases output_prefix module_system new_cxt exit_expr handlers NonComplete (fun _ -> None)))) | Assign _ -> let new_cxt = { lambda_cxt with jmp_table } in - let lbody = compile_lambda output_prefix new_cxt body in + let lbody = compile_lambda output_prefix module_system new_cxt body in Js_output.append_output (Js_output.make declares) (Js_output.append_output lbody (Js_output.make - (compile_cases output_prefix new_cxt exit_expr handlers NonComplete + (compile_cases output_prefix module_system new_cxt exit_expr handlers NonComplete (fun _ -> None))))) -and compile_sequand output_prefix (l : Lam.t) (r : Lam.t) (lambda_cxt : Lam_compile_context.t) +and compile_sequand output_prefix module_system (l : Lam.t) (r : Lam.t) (lambda_cxt : Lam_compile_context.t) = if Lam_compile_context.continuation_is_return lambda_cxt.continuation then - compile_lambda output_prefix lambda_cxt (Lam.sequand l r) + compile_lambda output_prefix module_system lambda_cxt (Lam.sequand l r) else let new_cxt = { lambda_cxt with continuation = NeedValue Not_tail } in - match compile_lambda output_prefix new_cxt l with + match compile_lambda output_prefix module_system new_cxt l with | { value = None } -> assert false | { block = l_block; value = Some l_expr } -> ( - match compile_lambda output_prefix new_cxt r with + match compile_lambda output_prefix module_system new_cxt r with | { value = None } -> assert false | { block = []; value = Some r_expr } -> Js_output.output_of_block_and_expression lambda_cxt.continuation @@ -1012,16 +1015,16 @@ and compile_sequand output_prefix (l : Lam.t) (r : Lam.t) (lambda_cxt : Lam_comp @ [ S.if_ l_expr (r_block @ [ S.assign v r_expr ]) ]) ~value:(E.var v))) -and compile_sequor output_prefix (l : Lam.t) (r : Lam.t) (lambda_cxt : Lam_compile_context.t) +and compile_sequor output_prefix module_system (l : Lam.t) (r : Lam.t) (lambda_cxt : Lam_compile_context.t) = if Lam_compile_context.continuation_is_return lambda_cxt.continuation then - compile_lambda output_prefix lambda_cxt (Lam.sequor l r) + compile_lambda output_prefix module_system lambda_cxt (Lam.sequor l r) else let new_cxt = { lambda_cxt with continuation = NeedValue Not_tail } in - match compile_lambda output_prefix new_cxt l with + match compile_lambda output_prefix module_system new_cxt l with | { value = None } -> assert false | { block = l_block; value = Some l_expr } -> ( - match compile_lambda output_prefix new_cxt r with + match compile_lambda output_prefix module_system new_cxt r with | { value = None } -> assert false | { block = []; value = Some r_expr } -> let exp = E.or_ l_expr r_expr in @@ -1060,10 +1063,10 @@ and compile_sequor output_prefix (l : Lam.t) (r : Lam.t) (lambda_cxt : Lam_compi while expression, here we generate for statement, leave optimization later. (Sine OCaml expression can be really complex..) *) -and compile_while output_prefix (predicate : Lam.t) (body : Lam.t) +and compile_while output_prefix module_system (predicate : Lam.t) (body : Lam.t) (lambda_cxt : Lam_compile_context.t) = match - compile_lambda output_prefix + compile_lambda output_prefix module_system { lambda_cxt with continuation = NeedValue Not_tail } predicate with @@ -1075,7 +1078,7 @@ and compile_while output_prefix (predicate : Lam.t) (body : Lam.t) [ S.while_ e (Js_output.output_as_block - @@ compile_lambda output_prefix + @@ compile_lambda output_prefix module_system { lambda_cxt with continuation = EffectCall Not_tail } body); ] @@ -1095,12 +1098,12 @@ and compile_while output_prefix (predicate : Lam.t) (body : Lam.t) print i each time, so they are different semantics... *) -and compile_for output_prefix (id : J.for_ident) (start : Lam.t) (finish : Lam.t) +and compile_for output_prefix module_system (id : J.for_ident) (start : Lam.t) (finish : Lam.t) (direction : Js_op.direction_flag) (body : Lam.t) (lambda_cxt : Lam_compile_context.t) = let new_cxt = { lambda_cxt with continuation = NeedValue Not_tail } in let block = - match (compile_lambda output_prefix new_cxt start, compile_lambda output_prefix new_cxt finish) with + match (compile_lambda output_prefix module_system new_cxt start, compile_lambda output_prefix module_system new_cxt finish) with | { value = None }, _ | _, { value = None } -> assert false | { block = b1; value = Some e1 }, { block = b2; value = Some e2 } -> ( (* order b1 -- (e1 -- b2 -- e2) @@ -1113,7 +1116,7 @@ and compile_for output_prefix (id : J.for_ident) (start : Lam.t) (finish : Lam.t *) let block_body = Js_output.output_as_block - (compile_lambda output_prefix + (compile_lambda output_prefix module_system { lambda_cxt with continuation = EffectCall Not_tail } body) in @@ -1139,7 +1142,7 @@ and compile_for output_prefix (id : J.for_ident) (start : Lam.t) (finish : Lam.t in Js_output.output_of_block_and_expression lambda_cxt.continuation block E.unit -and compile_assign output_prefix id (lambda : Lam.t) (lambda_cxt : Lam_compile_context.t) = +and compile_assign output_prefix module_system id (lambda : Lam.t) (lambda_cxt : Lam_compile_context.t) = let block = match lambda with | Lprim { primitive = Poffsetint v; args = [ Lvar bid ] } @@ -1147,7 +1150,7 @@ and compile_assign output_prefix id (lambda : Lam.t) (lambda_cxt : Lam_compile_c [ S.exp (E.assign (E.var id) (E.int32_add (E.var id) (E.small_int v))) ] | _ -> ( match - compile_lambda output_prefix + compile_lambda output_prefix module_system { lambda_cxt with continuation = NeedValue Not_tail } lambda with @@ -1170,16 +1173,16 @@ and compile_assign output_prefix id (lambda : Lam.t) (lambda_cxt : Lam_compile_c } ]} *) -and compile_trywith output_prefix lam id catch (lambda_cxt : Lam_compile_context.t) = +and compile_trywith output_prefix module_system lam id catch (lambda_cxt : Lam_compile_context.t) = let aux (with_context : Lam_compile_context.t) (body_context : Lam_compile_context.t) = (* should_return is passed down #1701, try should prevent tailcall *) [ S.try_ - (Js_output.output_as_block (compile_lambda output_prefix body_context lam)) + (Js_output.output_as_block (compile_lambda output_prefix module_system body_context lam)) ~with_: - (id, Js_output.output_as_block (compile_lambda output_prefix with_context catch)); + (id, Js_output.output_as_block (compile_lambda output_prefix module_system with_context catch)); ] in match lambda_cxt.continuation with @@ -1246,10 +1249,10 @@ and compile_trywith output_prefix lam id catch (lambda_cxt : Lam_compile_context mutable initializers: (obj -> unit) list } ]} *) -and compile_ifthenelse output_prefix (predicate : Lam.t) (t_branch : Lam.t) (f_branch : Lam.t) +and compile_ifthenelse output_prefix module_system (predicate : Lam.t) (t_branch : Lam.t) (f_branch : Lam.t) (lambda_cxt : Lam_compile_context.t) = match - compile_lambda output_prefix + compile_lambda output_prefix module_system { lambda_cxt with continuation = NeedValue Not_tail } predicate with @@ -1258,8 +1261,8 @@ and compile_ifthenelse output_prefix (predicate : Lam.t) (t_branch : Lam.t) (f_b match lambda_cxt.continuation with | NeedValue _ -> ( match - ( compile_lambda output_prefix lambda_cxt t_branch, - compile_lambda output_prefix lambda_cxt f_branch ) + ( compile_lambda output_prefix module_system lambda_cxt t_branch, + compile_lambda output_prefix module_system lambda_cxt f_branch ) with | { block = []; value = Some out1 }, { block = []; value = Some out2 } -> @@ -1271,8 +1274,8 @@ and compile_ifthenelse output_prefix (predicate : Lam.t) (t_branch : Lam.t) (f_b let id = Ext_ident.create_tmp () in let assign_cxt = { lambda_cxt with continuation = Assign id } in match - ( compile_lambda output_prefix assign_cxt t_branch, - compile_lambda output_prefix assign_cxt f_branch ) + ( compile_lambda output_prefix module_system assign_cxt t_branch, + compile_lambda output_prefix module_system assign_cxt f_branch ) with | out1, out2 -> Js_output.make @@ -1289,8 +1292,8 @@ and compile_ifthenelse output_prefix (predicate : Lam.t) (t_branch : Lam.t) (f_b { lambda_cxt with continuation = NeedValue Not_tail } in match - ( compile_lambda output_prefix declare_cxt t_branch, - compile_lambda output_prefix declare_cxt f_branch ) + ( compile_lambda output_prefix module_system declare_cxt t_branch, + compile_lambda output_prefix module_system declare_cxt f_branch ) with | { block = []; value = Some out1 }, { block = []; value = Some out2 } -> @@ -1303,20 +1306,20 @@ and compile_ifthenelse output_prefix (predicate : Lam.t) (t_branch : Lam.t) (f_b (Ext_list.append_one b (S.if_ ~declaration:(kind, id) e (Js_output.output_as_block - @@ compile_lambda output_prefix + @@ compile_lambda output_prefix module_system { lambda_cxt with continuation = Assign id } t_branch) ~else_: (Js_output.output_as_block - @@ compile_lambda output_prefix + @@ compile_lambda output_prefix module_system { lambda_cxt with continuation = Assign id } f_branch)))) | Assign _ -> let then_output = - Js_output.output_as_block (compile_lambda output_prefix lambda_cxt t_branch) + Js_output.output_as_block (compile_lambda output_prefix module_system lambda_cxt t_branch) in let else_output = - Js_output.output_as_block (compile_lambda output_prefix lambda_cxt f_branch) + Js_output.output_as_block (compile_lambda output_prefix module_system lambda_cxt f_branch) in Js_output.make (Ext_list.append_one b (S.if_ e then_output ~else_:else_output)) @@ -1326,8 +1329,8 @@ and compile_ifthenelse output_prefix (predicate : Lam.t) (t_branch : Lam.t) (f_b in match ( should_return, - compile_lambda output_prefix context1 t_branch, - compile_lambda output_prefix context1 f_branch ) + compile_lambda output_prefix module_system context1 t_branch, + compile_lambda output_prefix module_system context1 f_branch ) with (* see PR#83 *) | ( Not_tail, @@ -1358,7 +1361,7 @@ and compile_ifthenelse output_prefix (predicate : Lam.t) (t_branch : Lam.t) (f_b [ S.if_ (E.not e) (Js_output.output_as_block - @@ compile_lambda output_prefix lambda_cxt f_branch); + @@ compile_lambda output_prefix module_system lambda_cxt f_branch); ]) else Js_output.make @@ -1366,10 +1369,10 @@ and compile_ifthenelse output_prefix (predicate : Lam.t) (t_branch : Lam.t) (f_b [ S.if_ e (Js_output.output_as_block - @@ compile_lambda output_prefix lambda_cxt t_branch) + @@ compile_lambda output_prefix module_system lambda_cxt t_branch) ~else_: (Js_output.output_as_block - @@ compile_lambda output_prefix lambda_cxt f_branch); + @@ compile_lambda output_prefix module_system lambda_cxt f_branch); ]) | Not_tail, _, { block = []; value = Some out2 } -> let else_ = @@ -1377,13 +1380,13 @@ and compile_ifthenelse output_prefix (predicate : Lam.t) (t_branch : Lam.t) (f_b else Some (Js_output.output_as_block - (compile_lambda output_prefix lambda_cxt f_branch)) + (compile_lambda output_prefix module_system lambda_cxt f_branch)) in Js_output.make (Ext_list.append_one b (S.if_ e (Js_output.output_as_block - (compile_lambda output_prefix lambda_cxt t_branch)) + (compile_lambda output_prefix module_system lambda_cxt t_branch)) ?else_)) | ( Maybe_tail_is_return _, { block = []; value = Some out1 }, @@ -1393,16 +1396,16 @@ and compile_ifthenelse output_prefix (predicate : Lam.t) (t_branch : Lam.t) (f_b ~output_finished:True | _, _, _ -> let then_output = - Js_output.output_as_block (compile_lambda output_prefix lambda_cxt t_branch) + Js_output.output_as_block (compile_lambda output_prefix module_system lambda_cxt t_branch) in let else_output = - Js_output.output_as_block (compile_lambda output_prefix lambda_cxt f_branch) + Js_output.output_as_block (compile_lambda output_prefix module_system lambda_cxt f_branch) in Js_output.make (Ext_list.append_one b (S.if_ e then_output ~else_:else_output)) )) -and compile_apply output_prefix (appinfo : Lam.apply) (lambda_cxt : Lam_compile_context.t) = +and compile_apply output_prefix module_system (appinfo : Lam.apply) (lambda_cxt : Lam_compile_context.t) = match appinfo with | { ap_func = @@ -1414,7 +1417,7 @@ and compile_apply output_prefix (appinfo : Lam.apply) (lambda_cxt : Lam_compile_ if outer_ap_info.ap_inlined = ap_inlined then outer_ap_info else { outer_ap_info with ap_inlined } in - compile_lambda output_prefix lambda_cxt + compile_lambda output_prefix module_system lambda_cxt (Lam.apply ap_func (Ext_list.append ap_args appinfo.ap_args) ap_info) (* External function call: it can not be tailcall in this case*) | { @@ -1423,7 +1426,7 @@ and compile_apply output_prefix (appinfo : Lam.apply) (lambda_cxt : Lam_compile_ } -> ( match fld_info with | Fld_module { name } -> - compile_external_field_apply output_prefix appinfo id name lambda_cxt + compile_external_field_apply output_prefix module_system appinfo id name lambda_cxt | _ -> assert false) | _ -> ( (* TODO: --- @@ -1436,7 +1439,7 @@ and compile_apply output_prefix (appinfo : Lam.apply) (lambda_cxt : Lam_compile_ = Ext_list.fold_right (ap_func :: appinfo.ap_args) ([], []) (fun x (args_code, fn_code) -> - match compile_lambda output_prefix new_cxt x with + match compile_lambda output_prefix module_system new_cxt x with | { block; value = Some b } -> (Ext_list.append block args_code, b :: fn_code) | { value = None } -> assert false) @@ -1497,18 +1500,18 @@ and compile_apply output_prefix (appinfo : Lam.apply) (lambda_cxt : Lam_compile_ ~info:(call_info_of_ap_status appinfo.ap_info.ap_status) fn_code args)) -and compile_prim output_prefix (prim_info : Lam.prim_info) +and compile_prim output_prefix module_system (prim_info : Lam.prim_info) (lambda_cxt : Lam_compile_context.t) = match prim_info with | { primitive = Pfield (_, fld_info); args = [ Lglobal_module id ]; _ } -> ( (* should be before Lglobal_global *) match fld_info with | Fld_module { name = field } -> - compile_external_field output_prefix lambda_cxt id field + compile_external_field output_prefix module_system lambda_cxt id field | _ -> assert false) | { primitive = Praise; args = [ e ]; _ } -> ( match - compile_lambda output_prefix { lambda_cxt with continuation = NeedValue Not_tail } e + compile_lambda output_prefix module_system { lambda_cxt with continuation = NeedValue Not_tail } e with | { block; value = Some v } -> Js_output.make @@ -1519,8 +1522,8 @@ and compile_prim output_prefix (prim_info : Lam.prim_info) *) | { value = None } -> assert false) | { primitive = Psequand; args = [ l; r ]; _ } -> - compile_sequand output_prefix l r lambda_cxt - | { primitive = Psequor; args = [ l; r ] } -> compile_sequor output_prefix l r lambda_cxt + compile_sequand output_prefix module_system l r lambda_cxt + | { primitive = Psequor; args = [ l; r ] } -> compile_sequor output_prefix module_system l r lambda_cxt | { primitive = Pdebugger; _ } -> (* [%bs.debugger] guarantees that the expression does not matter TODO: make it even safer *) @@ -1540,7 +1543,7 @@ and compile_prim output_prefix (prim_info : Lam.prim_info) assert (not setter); match - compile_lambda output_prefix { lambda_cxt with continuation = NeedValue Not_tail } obj + compile_lambda output_prefix module_system { lambda_cxt with continuation = NeedValue Not_tail } obj with | { value = None } -> assert false | { block; value = Some b } -> @@ -1569,8 +1572,8 @@ and compile_prim output_prefix (prim_info : Lam.prim_info) let need_value_no_return_cxt = { lambda_cxt with continuation = NeedValue Not_tail } in - let obj_output = compile_lambda output_prefix need_value_no_return_cxt obj in - let arg_output = compile_lambda output_prefix need_value_no_return_cxt setter_val in + let obj_output = compile_lambda output_prefix module_system need_value_no_return_cxt obj in + let arg_output = compile_lambda output_prefix module_system need_value_no_return_cxt setter_val in let cont obj_block arg_block obj_code = Js_output.output_of_block_and_expression lambda_cxt.continuation (match obj_code with @@ -1602,7 +1605,7 @@ and compile_prim output_prefix (prim_info : Lam.prim_info) *) match args with | fn :: rest -> - compile_lambda output_prefix lambda_cxt + compile_lambda output_prefix module_system lambda_cxt (Lam.apply fn rest { ap_loc = loc; @@ -1620,7 +1623,7 @@ and compile_prim output_prefix (prim_info : Lam.prim_info) here we share env *) (Js_output.output_as_block - (compile_lambda output_prefix + (compile_lambda output_prefix module_system { lambda_cxt with continuation = @@ -1633,7 +1636,7 @@ and compile_prim output_prefix (prim_info : Lam.prim_info) body))) | _ -> assert false) | { primitive = Pjs_fn_make arity; args = [ fn ]; loc } -> - compile_lambda output_prefix lambda_cxt + compile_lambda output_prefix module_system lambda_cxt (Lam_eta_conversion.unsafe_adjust_to_arity loc ~to_:arity ?from:None fn) | { primitive = Pjs_fn_make_unit; args = [ fn ]; loc } -> compile_lambda lambda_cxt fn @@ -1644,7 +1647,7 @@ and compile_prim output_prefix (prim_info : Lam.prim_info) else let new_cxt = { lambda_cxt with continuation = NeedValue Not_tail } in Ext_list.split_map args (fun x -> - match compile_lambda output_prefix new_cxt x with + match compile_lambda output_prefix module_system new_cxt x with | { block; value = Some b } -> (block, b) | { value = None } -> assert false) in @@ -1660,19 +1663,19 @@ and compile_prim output_prefix (prim_info : Lam.prim_info) else let new_cxt = { lambda_cxt with continuation = NeedValue Not_tail } in Ext_list.split_map args (fun x -> - match compile_lambda output_prefix new_cxt x with + match compile_lambda output_prefix module_system new_cxt x with | { block; value = Some b } -> (block, b) | { value = None } -> assert false) in let args_code : J.block = List.concat args_block in let exp = (* TODO: all can be done in [compile_primitive] *) - Lam_compile_primitive.translate output_prefix loc lambda_cxt primitive args_expr + Lam_compile_primitive.translate output_prefix module_system loc lambda_cxt primitive args_expr in Js_output.output_of_block_and_expression lambda_cxt.continuation args_code exp -and compile_lambda output_prefix (lambda_cxt : Lam_compile_context.t) (cur_lam : Lam.t) : +and compile_lambda output_prefix module_system (lambda_cxt : Lam_compile_context.t) (cur_lam : Lam.t) : Js_output.t = match cur_lam with | Lfunction { params; body; attr = { return_unit; async; oneUnitArg } } -> @@ -1683,7 +1686,7 @@ and compile_lambda output_prefix (lambda_cxt : Lam_compile_context.t) (cur_lam : here we share env *) (Js_output.output_as_block - (compile_lambda output_prefix + (compile_lambda output_prefix module_system { lambda_cxt with continuation = @@ -1694,15 +1697,15 @@ and compile_lambda output_prefix (lambda_cxt : Lam_compile_context.t) (cur_lam : jmp_table = Lam_compile_context.empty_handler_map; } body))) - | Lapply appinfo -> compile_apply output_prefix appinfo lambda_cxt + | Lapply appinfo -> compile_apply output_prefix module_system appinfo lambda_cxt | Llet (let_kind, id, arg, body) -> (* Order matters.. see comment below in [Lletrec] *) let args_code = - compile_lambda output_prefix + compile_lambda output_prefix module_system { lambda_cxt with continuation = Declare (let_kind, id) } arg in - Js_output.append_output args_code (compile_lambda output_prefix lambda_cxt body) + Js_output.append_output args_code (compile_lambda output_prefix module_system lambda_cxt body) | Lletrec (id_args, body) -> (* There is a bug in our current design, it requires compile args first (register that some objects are jsidentifiers) @@ -1715,8 +1718,8 @@ and compile_lambda output_prefix (lambda_cxt : Lam_compile_context.t) (cur_lam : 1. scan the lambda layer first, register js identifier before proceeding 2. delay the method call into javascript ast *) - let v = compile_recursive_lets output_prefix lambda_cxt id_args in - Js_output.append_output v (compile_lambda output_prefix lambda_cxt body) + let v = compile_recursive_lets output_prefix module_system lambda_cxt id_args in + Js_output.append_output v (compile_lambda output_prefix module_system lambda_cxt body) | Lvar id -> Js_output.output_of_expression lambda_cxt.continuation ~no_effects:no_effects_const (E.var id) @@ -1731,21 +1734,21 @@ and compile_lambda output_prefix (lambda_cxt : Lam_compile_context.t) (cur_lam : *) Js_output.output_of_block_and_expression lambda_cxt.continuation [] (E.ml_module_as_var i) - | Lprim prim_info -> compile_prim output_prefix prim_info lambda_cxt + | Lprim prim_info -> compile_prim output_prefix module_system prim_info lambda_cxt | Lsequence (l1, l2) -> let output_l1 = - compile_lambda output_prefix { lambda_cxt with continuation = EffectCall Not_tail } l1 + compile_lambda output_prefix module_system { lambda_cxt with continuation = EffectCall Not_tail } l1 in - let output_l2 = compile_lambda output_prefix lambda_cxt l2 in + let output_l2 = compile_lambda output_prefix module_system lambda_cxt l2 in Js_output.append_output output_l1 output_l2 | Lifthenelse (predicate, t_branch, f_branch) -> - compile_ifthenelse output_prefix predicate t_branch f_branch lambda_cxt + compile_ifthenelse output_prefix module_system predicate t_branch f_branch lambda_cxt | Lstringswitch (l, cases, default) -> - compile_stringswitch output_prefix l cases default lambda_cxt - | Lswitch (switch_arg, sw) -> compile_switch output_prefix switch_arg sw lambda_cxt - | Lstaticraise (i, largs) -> compile_staticraise output_prefix i largs lambda_cxt - | Lstaticcatch _ -> compile_staticcatch output_prefix cur_lam lambda_cxt - | Lwhile (p, body) -> compile_while output_prefix p body lambda_cxt + compile_stringswitch output_prefix module_system l cases default lambda_cxt + | Lswitch (switch_arg, sw) -> compile_switch output_prefix module_system switch_arg sw lambda_cxt + | Lstaticraise (i, largs) -> compile_staticraise output_prefix module_system i largs lambda_cxt + | Lstaticcatch _ -> compile_staticcatch output_prefix module_system cur_lam lambda_cxt + | Lwhile (p, body) -> compile_while output_prefix module_system p body lambda_cxt | Lfor (id, start, finish, direction, body) -> ( match (direction, finish) with | ( Upto, @@ -1755,12 +1758,12 @@ and compile_lambda output_prefix (lambda_cxt : Lam_compile_context.t) (cur_lam : args = [ new_finish; Lconst (Const_int { i = 1l }) ]; } | Lprim { primitive = Poffsetint -1; args = [ new_finish ] } ) ) -> - compile_for output_prefix id start new_finish Up body lambda_cxt + compile_for output_prefix module_system id start new_finish Up body lambda_cxt | _ -> - compile_for output_prefix id start finish + compile_for output_prefix module_system id start finish (if direction = Upto then Upto else Downto) body lambda_cxt) - | Lassign (id, lambda) -> compile_assign output_prefix id lambda lambda_cxt + | Lassign (id, lambda) -> compile_assign output_prefix module_system id lambda lambda_cxt | Ltrywith (lam, id, catch) -> (* generate documentation *) - compile_trywith output_prefix lam id catch lambda_cxt + compile_trywith output_prefix module_system lam id catch lambda_cxt diff --git a/jscomp/core/lam_compile.mli b/jscomp/core/lam_compile.mli index ad12c5a015..a2f4ca0cb2 100644 --- a/jscomp/core/lam_compile.mli +++ b/jscomp/core/lam_compile.mli @@ -25,6 +25,6 @@ (** Compile single lambda IR to JS IR *) val compile_recursive_lets : - string -> Lam_compile_context.t -> (Ident.t * Lam.t) list -> Js_output.t + string -> Js_packages_info.module_system -> Lam_compile_context.t -> (Ident.t * Lam.t) list -> Js_output.t -val compile_lambda : string -> Lam_compile_context.t -> Lam.t -> Js_output.t +val compile_lambda : string -> Js_packages_info.module_system -> Lam_compile_context.t -> Lam.t -> Js_output.t diff --git a/jscomp/core/lam_compile_main.ml b/jscomp/core/lam_compile_main.ml index a0e2c8b1e1..e1996997e6 100644 --- a/jscomp/core/lam_compile_main.ml +++ b/jscomp/core/lam_compile_main.ml @@ -33,7 +33,7 @@ (* module S = Js_stmt_make *) -let compile_group output_prefix (meta : Lam_stats.t) +let compile_group output_prefix module_system (meta : Lam_stats.t) (x : Lam_group.t) : Js_output.t = match x with (* @@ -60,20 +60,20 @@ let compile_group output_prefix (meta : Lam_stats.t) (* let lam = Optimizer.simplify_lets [] lam in *) (* can not apply again, it's wrong USE it with care*) (* ([Js_stmt_make.comment (Gen_of_env.query_type id env )], None) ++ *) - Lam_compile.compile_lambda output_prefix { continuation = Declare (kind, id); + Lam_compile.compile_lambda output_prefix module_system { continuation = Declare (kind, id); jmp_table = Lam_compile_context.empty_handler_map; meta } lam | Recursive id_lams -> - Lam_compile.compile_recursive_lets output_prefix + Lam_compile.compile_recursive_lets output_prefix module_system { continuation = EffectCall Not_tail; jmp_table = Lam_compile_context.empty_handler_map; meta } id_lams | Nop lam -> (* TODO: Side effect callls, log and see statistics *) - Lam_compile.compile_lambda output_prefix {continuation = EffectCall Not_tail; + Lam_compile.compile_lambda output_prefix module_system {continuation = EffectCall Not_tail; jmp_table = Lam_compile_context.empty_handler_map; meta } lam @@ -122,7 +122,8 @@ let _j = Js_pass_debug.dump it's used or not *) let compile - (output_prefix : string) + (output_prefix : string) + (module_system : Js_packages_info.module_system) export_idents (lam : Lambda.lambda) = let export_ident_sets = Set_ident.of_list export_idents in @@ -222,7 +223,7 @@ let maybe_pure = no_side_effects groups in let () = Ext_log.dwarn ~__POS__ "\n@[[TIME:]Pre-compile: %f@]@." (Sys.time () *. 1000.) in #endif let body = - Ext_list.map groups (fun group -> compile_group output_prefix meta group) + Ext_list.map groups (fun group -> compile_group output_prefix module_system meta group) |> Js_output.concat |> Js_output.output_as_block in @@ -287,18 +288,18 @@ js let (//) = Filename.concat let lambda_as_module - (lambda_output : J.deps_program) + (lambda_output : Js_packages_info.module_system -> J.deps_program) (output_prefix : string) : unit = let package_info = Js_packages_state.get_packages_info () in if Js_packages_info.is_empty package_info && !Js_config.js_stdout then begin - Js_dump_program.dump_deps_program ~output_prefix NodeJS lambda_output stdout + Js_dump_program.dump_deps_program ~output_prefix NodeJS (lambda_output NodeJS) stdout end else Js_packages_info.iter package_info (fun {module_system; path; suffix} -> let output_chan chan = Js_dump_program.dump_deps_program ~output_prefix module_system - lambda_output + (lambda_output module_system) chan in let basename = Ext_namespace.change_ext_ns_suffix diff --git a/jscomp/core/lam_compile_main.mli b/jscomp/core/lam_compile_main.mli index fcd298ce3a..0f6bed598d 100644 --- a/jscomp/core/lam_compile_main.mli +++ b/jscomp/core/lam_compile_main.mli @@ -27,9 +27,9 @@ (** Compile and register the hook of function to compile a lambda to JS IR *) -val compile : string -> Ident.t list -> Lambda.lambda -> J.deps_program +val compile : string -> Js_packages_info.module_system -> Ident.t list -> Lambda.lambda -> J.deps_program (** For toplevel, [filename] is [""] which is the same as {!Env.get_unit_name ()} *) -val lambda_as_module : J.deps_program -> string -> unit +val lambda_as_module : (Js_packages_info.module_system -> J.deps_program) -> string -> unit diff --git a/jscomp/core/lam_compile_primitive.ml b/jscomp/core/lam_compile_primitive.ml index d8eb181943..044080374a 100644 --- a/jscomp/core/lam_compile_primitive.ml +++ b/jscomp/core/lam_compile_primitive.ml @@ -40,16 +40,6 @@ let module_of_expression = function | J.Var (J.Qualified (module_id, value)) -> [ (module_id, value) ] | _ -> [] -let get_module_system () = - let packages_info = Js_packages_state.get_packages_info () in - let module_systems = - Js_packages_info.map packages_info (fun { module_system } -> module_system) - in - match module_systems with - (* fixme: test mode where the module system is empty *) - | [] -> assert false - | module_system :: _rest -> module_system - let import_of_path path = E.call ~info:{ arity = Full; call_info = Call_na } @@ -71,7 +61,7 @@ let wrap_then import value = ]; ] -let translate output_prefix loc (cxt : Lam_compile_context.t) +let translate output_prefix module_system loc (cxt : Lam_compile_context.t) (prim : Lam_primitive.t) (args : J.expression list) : J.expression = match prim with | Pis_not_none -> Js_of_lam_option.is_not_none (Ext_list.singleton_exn args) @@ -127,7 +117,7 @@ let translate output_prefix loc (cxt : Lam_compile_context.t) let path = Js_name_of_module_id.string_of_module_id module_id ~output_dir - (get_module_system ()) + module_system in match module_value with diff --git a/jscomp/core/lam_compile_primitive.mli b/jscomp/core/lam_compile_primitive.mli index b507f63b1c..937a207e47 100644 --- a/jscomp/core/lam_compile_primitive.mli +++ b/jscomp/core/lam_compile_primitive.mli @@ -30,6 +30,7 @@ val translate : string -> + Js_packages_info.module_system -> Location.t -> Lam_compile_context.t -> Lam_primitive.t -> From b3279506592c2172e74ff2b28e47b5b598a99af6 Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Tue, 18 Apr 2023 05:22:05 +0200 Subject: [PATCH 05/14] rebase on master --- jscomp/core/lam_compile.ml | 22 ++++---- jscomp/core/lam_compile_primitive.ml | 2 +- jscomp/frontend/ast_await.ml | 4 +- jscomp/frontend/bs_builtin_ppx.ml | 84 +++++++++++++++------------- jscomp/test/build.ninja | 3 +- 5 files changed, 60 insertions(+), 55 deletions(-) diff --git a/jscomp/core/lam_compile.ml b/jscomp/core/lam_compile.ml index 596ae6548f..22d9a93837 100644 --- a/jscomp/core/lam_compile.ml +++ b/jscomp/core/lam_compile.ml @@ -503,8 +503,8 @@ and compile_recursive_lets output_prefix module_system cxt id_args : Js_output.t and compile_general_cases : 'a . string -> - Js_packages_info.module_system -> - ('a -> Ast_untagged_variants.literal option) -> + Js_packages_info.module_system -> + ('a -> Ast_untagged_variants.literal option) -> ('a -> J.expression) -> ('a option -> J.expression -> 'a option -> J.expression -> J.expression) -> Lam_compile_context.t -> @@ -629,12 +629,12 @@ and use_compile_literal_cases table get_name = | Some {name; literal_type = None}, Some string_table -> Some ((String name, lam) :: string_table) | _, _ -> None ) table (Some []) -and compile_cases ?(untagged=false) output_prefix module_system cxt (switch_exp : E.t) table default get_name = +and compile_cases ?(untagged=false) output_prefix module_system cxt (switch_exp : E.t) table default get_name : initialization = match use_compile_literal_cases table get_name with | Some string_table -> if untagged - then compile_untagged_cases cxt switch_exp string_table default - else compile_string_cases cxt switch_exp string_table default + then compile_untagged_cases output_prefix module_system cxt switch_exp string_table default + else compile_string_cases output_prefix module_system cxt switch_exp string_table default | None -> compile_general_cases output_prefix module_system get_name (fun i -> match get_name i with @@ -646,7 +646,7 @@ and compile_cases ?(untagged=false) output_prefix module_system cxt (switch_exp S.int_switch ?default ?declaration e clauses) switch_exp table default -and compile_switch (switch_arg : Lam.t) (sw : Lam.lambda_switch) +and compile_switch output_prefix module_system (switch_arg : Lam.t) (sw : Lam.lambda_switch) (lambda_cxt : Lam_compile_context.t) = (* TODO: if default is None, we can do some optimizations Use switch vs if/then/else @@ -735,8 +735,8 @@ and compile_switch (switch_arg : Lam.t) (sw : Lam.lambda_switch) | EffectCall _ | Assign _ -> Js_output.make (compile_whole lambda_cxt) - and compile_string_cases output_prefix module_system cxt switch_exp table default = - let literal = function +and compile_string_cases output_prefix module_system cxt switch_exp table default : initialization = + let literal = function | literal -> E.literal literal in compile_general_cases @@ -749,7 +749,7 @@ and compile_switch (switch_arg : Lam.t) (sw : Lam.lambda_switch) (fun ?default ?declaration e clauses -> S.string_switch ?default ?declaration e clauses) switch_exp table default -and compile_untagged_cases cxt switch_exp table default = +and compile_untagged_cases output_prefix module_system cxt switch_exp table default = let literal = function | literal -> E.literal literal in @@ -782,7 +782,7 @@ and compile_untagged_cases cxt switch_exp table default = | _ :: _ :: _ -> assert false (* at most 1 array case *) | _ -> S.string_switch ?default ?declaration (E.typeof e) clauses in - compile_general_cases + compile_general_cases output_prefix module_system (fun _ -> None) literal mk_eq @@ -1639,7 +1639,7 @@ and compile_prim output_prefix module_system (prim_info : Lam.prim_info) compile_lambda output_prefix module_system lambda_cxt (Lam_eta_conversion.unsafe_adjust_to_arity loc ~to_:arity ?from:None fn) | { primitive = Pjs_fn_make_unit; args = [ fn ]; loc } -> - compile_lambda lambda_cxt fn + compile_lambda output_prefix module_system lambda_cxt fn | { primitive = Pjs_fn_make _; args = [] | _ :: _ :: _ } -> assert false | { primitive = Pjs_object_create labels; args } -> let args_block, args_expr = diff --git a/jscomp/core/lam_compile_primitive.ml b/jscomp/core/lam_compile_primitive.ml index 044080374a..8fba5aa2da 100644 --- a/jscomp/core/lam_compile_primitive.ml +++ b/jscomp/core/lam_compile_primitive.ml @@ -52,7 +52,7 @@ let wrap_then import value = ~info:{ arity = Full; call_info = Call_na } (E.dot import "then") [ - E.ocaml_fun ~return_unit:false ~async:false [ arg ] + E.ocaml_fun ~return_unit:false ~async:false ~oneUnitArg:false [ arg ] [ { statement_desc = J.Return (E.dot (E.var arg) value); diff --git a/jscomp/frontend/ast_await.ml b/jscomp/frontend/ast_await.ml index bebc327ccd..9647a28161 100644 --- a/jscomp/frontend/ast_await.ml +++ b/jscomp/frontend/ast_await.ml @@ -4,7 +4,7 @@ let create_await_expression (e : Parsetree.expression) = Ast_helper.Exp.ident ~loc {txt = Ldot (Ldot (Lident "Js", "Promise"), "unsafe_await"); loc} in - Ast_helper.Exp.apply ~loc unsafe_await [ (Nolabel, e) ] + Ast_helper.Exp.apply ~loc unsafe_await [(Nolabel, e)] let create_await_module_expression ~module_type_name (e : Parsetree.module_expr) = @@ -25,7 +25,7 @@ let create_await_module_expression ~module_type_name (e : Parsetree.module_expr) Exp.constraint_ ~loc:e.pmod_loc (Exp.pack ~loc:e.pmod_loc e) (Typ.package ~loc:e.pmod_loc - { txt = Lident module_type_name; loc = e.pmod_loc } + {txt = Lident module_type_name; loc = e.pmod_loc} []) ); ])); } diff --git a/jscomp/frontend/bs_builtin_ppx.ml b/jscomp/frontend/bs_builtin_ppx.ml index 5a76408489..9cfb5634d3 100644 --- a/jscomp/frontend/bs_builtin_ppx.ml +++ b/jscomp/frontend/bs_builtin_ppx.ml @@ -224,16 +224,21 @@ let expr_mapper ~async_context ~in_function_def (self : mapper) match Ast_attributes.has_await_payload e.pexp_attributes with | None -> result | Some _ -> - (if !async_context = false then - let isJsImport (e : Parsetree.expression) = - match e with - | { pexp_desc = Pexp_apply ({ pexp_desc = Pexp_ident { txt = Ldot ( Lident "Js", "import") } }, _) } -> true - | _ -> false - in - if not (isJsImport e) then - Location.raise_errorf ~loc:e.pexp_loc - "Await on expression not in an async context"); - Ast_await.create_await_expression result + (if !async_context = false then + let isJsImport (e : Parsetree.expression) = + match e with + | { + pexp_desc = + Pexp_apply + ({pexp_desc = Pexp_ident {txt = Ldot (Lident "Js", "import")}}, _); + } -> + true + | _ -> false + in + if not (isJsImport e) then + Location.raise_errorf ~loc:e.pexp_loc + "Await on expression not in an async context"); + Ast_await.create_await_expression result let typ_mapper (self : mapper) (typ : Parsetree.core_type) = Ast_core_type_class_type.typ_mapper self typ @@ -432,9 +437,10 @@ let local_module_name = let local_module_type_name = let v = ref 0 in - fun ({ txt } : Longident.t Location.loc) -> + fun ({txt} : Longident.t Location.loc) -> incr v; - "__" ^ (Longident.flatten txt |> List.fold_left (fun ll l -> ll ^ l) "") + "__" + ^ (Longident.flatten txt |> List.fold_left (fun ll l -> ll ^ l) "") ^ string_of_int !v ^ "__" let expand_reverse (stru : Ast_structure.t) (acc : Ast_structure.t) : @@ -500,36 +506,34 @@ let rec structure_mapper (self : mapper) (stru : Ast_structure.t) = in aux [] stru | Pstr_module - ({ - pmb_expr = - { pmod_desc = Pmod_ident { txt; loc }; pmod_attributes } as me; - } as mb) + ({pmb_expr = {pmod_desc = Pmod_ident {txt; loc}; pmod_attributes} as me} + as mb) (* module M = @res.await Belt.List *) 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 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)) - 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 + let item = self.structure_item self item in + let safe_module_type_name = local_module_type_name {txt; loc} in + 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)) + 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) let mapper : mapper = diff --git a/jscomp/test/build.ninja b/jscomp/test/build.ninja index 94e919a52d..87fc79e24f 100644 --- a/jscomp/test/build.ninja +++ b/jscomp/test/build.ninja @@ -21,6 +21,7 @@ o test/simple_lexer_test.ml : mll test/simple_lexer_test.mll o test/406_primitive_test.cmi test/406_primitive_test.cmj : cc test/406_primitive_test.res | test/mt.cmj $bsc $stdlib runtime o test/DotDotDot.cmi test/DotDotDot.cmj : cc test/DotDotDot.res | $bsc $stdlib runtime o test/EmptyRecord.cmi test/EmptyRecord.cmj : cc test/EmptyRecord.res | $bsc $stdlib runtime +o test/Import.cmi test/Import.cmj : cc test/Import.res | $bsc $stdlib runtime o test/RecordCoercion.cmi test/RecordCoercion.cmj : cc test/RecordCoercion.res | $bsc $stdlib runtime o test/RecordOrObject.cmi test/RecordOrObject.cmj : cc test/RecordOrObject.res | $bsc $stdlib runtime o test/SafePromises.cmi test/SafePromises.cmj : cc test/SafePromises.res | $bsc $stdlib runtime @@ -711,4 +712,4 @@ o test/variant.cmi test/variant.cmj : cc test/variant.res | $bsc $stdlib runtime o test/variantsMatching.cmi test/variantsMatching.cmj : cc test/variantsMatching.res | $bsc $stdlib runtime o test/watch_test.cmi test/watch_test.cmj : cc test/watch_test.res | $bsc $stdlib runtime o test/webpack_config.cmi test/webpack_config.cmj : cc test/webpack_config.res | $bsc $stdlib runtime -o test : phony test/406_primitive_test.cmi test/406_primitive_test.cmj test/DotDotDot.cmi test/DotDotDot.cmj test/EmptyRecord.cmi test/EmptyRecord.cmj test/RecordCoercion.cmi test/RecordCoercion.cmj test/RecordOrObject.cmi test/RecordOrObject.cmj test/SafePromises.cmi test/SafePromises.cmj test/UncurriedAlways.cmi test/UncurriedAlways.cmj test/UncurriedExternals.cmi test/UncurriedExternals.cmj test/UncurriedPervasives.cmi test/UncurriedPervasives.cmj test/UntaggedVariants.cmi test/UntaggedVariants.cmj test/a.cmi test/a.cmj test/a_filename_test.cmi test/a_filename_test.cmj test/a_list_test.cmi test/a_list_test.cmj test/a_recursive_type.cmi test/a_recursive_type.cmj test/a_scope_bug.cmi test/a_scope_bug.cmj test/a_string_test.cmi test/a_string_test.cmj test/abstract_type.cmi test/abstract_type.cmj test/adt_optimize_test.cmi test/adt_optimize_test.cmj test/alias_default_value_test.cmi test/alias_default_value_test.cmj test/alias_test.cmi test/alias_test.cmj test/and_or_tailcall_test.cmi test/and_or_tailcall_test.cmj test/app_root_finder.cmi test/app_root_finder.cmj test/argv_test.cmi test/argv_test.cmj test/ari_regress_test.cmi test/ari_regress_test.cmj test/arith_lexer.cmi test/arith_lexer.cmj test/arith_parser.cmi test/arith_parser.cmj test/arith_syntax.cmi test/arith_syntax.cmj test/arity.cmi test/arity.cmj test/arity_deopt.cmi test/arity_deopt.cmj test/arity_infer.cmi test/arity_infer.cmj test/array_data_util.cmi test/array_data_util.cmj test/array_safe_get.cmi test/array_safe_get.cmj test/array_subtle_test.cmi test/array_subtle_test.cmj test/array_test.cmi test/array_test.cmj test/ast_abstract_test.cmi test/ast_abstract_test.cmj test/ast_mapper_unused_warning_test.cmi test/ast_mapper_unused_warning_test.cmj test/async_await.cmi test/async_await.cmj test/async_ideas.cmi test/async_ideas.cmj test/async_inline.cmi test/async_inline.cmj test/attr_test.cmi test/attr_test.cmj test/b.cmi test/b.cmj test/bal_set_mini.cmi test/bal_set_mini.cmj test/bang_primitive.cmi test/bang_primitive.cmj test/basic_module_test.cmi test/basic_module_test.cmj test/bb.cmi test/bb.cmj test/bdd.cmi test/bdd.cmj test/belt_internal_test.cmi test/belt_internal_test.cmj test/belt_result_alias_test.cmi test/belt_result_alias_test.cmj test/bench.cmi test/bench.cmj test/big_enum.cmi test/big_enum.cmj test/big_polyvar_test.cmi test/big_polyvar_test.cmj test/block_alias_test.cmi test/block_alias_test.cmj test/boolean_test.cmi test/boolean_test.cmj test/bs_MapInt_test.cmi test/bs_MapInt_test.cmj test/bs_abstract_test.cmi test/bs_abstract_test.cmj test/bs_array_test.cmi test/bs_array_test.cmj test/bs_auto_uncurry.cmi test/bs_auto_uncurry.cmj test/bs_auto_uncurry_test.cmi test/bs_auto_uncurry_test.cmj test/bs_float_test.cmi test/bs_float_test.cmj test/bs_hashmap_test.cmi test/bs_hashmap_test.cmj test/bs_hashset_int_test.cmi test/bs_hashset_int_test.cmj test/bs_hashtbl_string_test.cmi test/bs_hashtbl_string_test.cmj test/bs_ignore_effect.cmi test/bs_ignore_effect.cmj test/bs_ignore_test.cmi test/bs_ignore_test.cmj test/bs_int_test.cmi test/bs_int_test.cmj test/bs_list_test.cmi test/bs_list_test.cmj test/bs_map_set_dict_test.cmi test/bs_map_set_dict_test.cmj test/bs_map_test.cmi test/bs_map_test.cmj test/bs_min_max_test.cmi test/bs_min_max_test.cmj test/bs_mutable_set_test.cmi test/bs_mutable_set_test.cmj test/bs_node_string_buffer_test.cmi test/bs_node_string_buffer_test.cmj test/bs_poly_map_test.cmi test/bs_poly_map_test.cmj test/bs_poly_mutable_map_test.cmi test/bs_poly_mutable_map_test.cmj test/bs_poly_mutable_set_test.cmi test/bs_poly_mutable_set_test.cmj test/bs_poly_set_test.cmi test/bs_poly_set_test.cmj test/bs_qualified.cmi test/bs_qualified.cmj test/bs_queue_test.cmi test/bs_queue_test.cmj test/bs_rbset_int_bench.cmi test/bs_rbset_int_bench.cmj test/bs_rest_test.cmi test/bs_rest_test.cmj test/bs_set_bench.cmi test/bs_set_bench.cmj test/bs_set_int_test.cmi test/bs_set_int_test.cmj test/bs_sort_test.cmi test/bs_sort_test.cmj test/bs_splice_partial.cmi test/bs_splice_partial.cmj test/bs_stack_test.cmi test/bs_stack_test.cmj test/bs_string_test.cmi test/bs_string_test.cmj test/bs_unwrap_test.cmi test/bs_unwrap_test.cmj test/buffer_test.cmi test/buffer_test.cmj test/bytes_split_gpr_743_test.cmi test/bytes_split_gpr_743_test.cmj test/caml_compare_bigint_test.cmi test/caml_compare_bigint_test.cmj test/caml_compare_test.cmi test/caml_compare_test.cmj test/caml_format_test.cmi test/caml_format_test.cmj test/caml_sys_poly_fill_test.cmi test/caml_sys_poly_fill_test.cmj test/chain_code_test.cmi test/chain_code_test.cmj test/chn_test.cmi test/chn_test.cmj test/class_type_ffi_test.cmi test/class_type_ffi_test.cmj test/coercion_module_alias_test.cmi test/coercion_module_alias_test.cmj test/compare_test.cmi test/compare_test.cmj test/complete_parmatch_test.cmi test/complete_parmatch_test.cmj test/complex_if_test.cmi test/complex_if_test.cmj test/complex_test.cmi test/complex_test.cmj test/complex_while_loop.cmi test/complex_while_loop.cmj test/condition_compilation_test.cmi test/condition_compilation_test.cmj test/config1_test.cmi test/config1_test.cmj test/console_log_test.cmi test/console_log_test.cmj test/const_block_test.cmi test/const_block_test.cmj test/const_defs.cmi test/const_defs.cmj test/const_defs_test.cmi test/const_defs_test.cmj test/const_test.cmi test/const_test.cmj test/cont_int_fold_test.cmi test/cont_int_fold_test.cmj test/cps_test.cmi test/cps_test.cmj test/cross_module_inline_test.cmi test/cross_module_inline_test.cmj test/custom_error_test.cmi test/custom_error_test.cmj test/debug_keep_test.cmi test/debug_keep_test.cmj test/debug_mode_value.cmi test/debug_mode_value.cmj test/debug_tmp.cmi test/debug_tmp.cmj test/debugger_test.cmi test/debugger_test.cmj test/default_export_test.cmi test/default_export_test.cmj test/defunctor_make_test.cmi test/defunctor_make_test.cmj test/demo_int_map.cmi test/demo_int_map.cmj test/demo_page.cmi test/demo_page.cmj test/demo_pipe.cmi test/demo_pipe.cmj test/derive_dyntype.cmi test/derive_dyntype.cmj test/derive_projector_test.cmi test/derive_projector_test.cmj test/derive_type_test.cmi test/derive_type_test.cmj test/digest_test.cmi test/digest_test.cmj test/directives.cmi test/directives.cmj test/div_by_zero_test.cmi test/div_by_zero_test.cmj test/dollar_escape_test.cmi test/dollar_escape_test.cmj test/earger_curry_test.cmi test/earger_curry_test.cmj test/effect.cmi test/effect.cmj test/epsilon_test.cmi test/epsilon_test.cmj test/equal_box_test.cmi test/equal_box_test.cmj test/equal_exception_test.cmi test/equal_exception_test.cmj test/equal_test.cmi test/equal_test.cmj test/es6_export.cmi test/es6_export.cmj test/es6_import.cmi test/es6_import.cmj test/es6_module_test.cmi test/es6_module_test.cmj test/escape_esmodule.cmi test/escape_esmodule.cmj test/esmodule_ref.cmi test/esmodule_ref.cmj test/event_ffi.cmi test/event_ffi.cmj test/exception_alias.cmi test/exception_alias.cmj test/exception_raise_test.cmi test/exception_raise_test.cmj test/exception_rebound_err_test.cmi test/exception_rebound_err_test.cmj test/exception_value_test.cmi test/exception_value_test.cmj test/exponentiation_precedence_test.cmi test/exponentiation_precedence_test.cmj test/export_keyword.cmi test/export_keyword.cmj test/ext_array_test.cmi test/ext_array_test.cmj test/ext_bytes_test.cmi test/ext_bytes_test.cmj test/ext_filename_test.cmi test/ext_filename_test.cmj test/ext_list_test.cmi test/ext_list_test.cmj test/ext_pervasives_test.cmi test/ext_pervasives_test.cmj test/ext_string_test.cmi test/ext_string_test.cmj test/ext_sys_test.cmi test/ext_sys_test.cmj test/extensible_variant_test.cmi test/extensible_variant_test.cmj test/external_polyfill_test.cmi test/external_polyfill_test.cmj test/external_ppx.cmi test/external_ppx.cmj test/external_ppx2.cmi test/external_ppx2.cmj test/fail_comp.cmi test/fail_comp.cmj test/ffi_arity_test.cmi test/ffi_arity_test.cmj test/ffi_array_test.cmi test/ffi_array_test.cmj test/ffi_js_test.cmi test/ffi_js_test.cmj test/ffi_splice_test.cmi test/ffi_splice_test.cmj test/ffi_test.cmi test/ffi_test.cmj test/fib.cmi test/fib.cmj test/flattern_order_test.cmi test/flattern_order_test.cmj test/flexible_array_test.cmi test/flexible_array_test.cmj test/float_array.cmi test/float_array.cmj test/float_of_bits_test.cmi test/float_of_bits_test.cmj test/float_record.cmi test/float_record.cmj test/float_test.cmi test/float_test.cmj test/floatarray_test.cmi test/floatarray_test.cmj test/for_loop_test.cmi test/for_loop_test.cmj test/for_side_effect_test.cmi test/for_side_effect_test.cmj test/format_regression.cmi test/format_regression.cmj test/format_test.cmi test/format_test.cmj test/fs_test.cmi test/fs_test.cmj test/fun_pattern_match.cmi test/fun_pattern_match.cmj test/functor_app_test.cmi test/functor_app_test.cmj test/functor_def.cmi test/functor_def.cmj test/functor_ffi.cmi test/functor_ffi.cmj test/functor_inst.cmi test/functor_inst.cmj test/functors.cmi test/functors.cmj test/gbk.cmi test/gbk.cmj test/genlex_test.cmi test/genlex_test.cmj test/gentTypeReTest.cmi test/gentTypeReTest.cmj test/global_exception_regression_test.cmi test/global_exception_regression_test.cmj test/global_mangles.cmi test/global_mangles.cmj test/global_module_alias_test.cmi test/global_module_alias_test.cmj test/google_closure_test.cmi test/google_closure_test.cmj test/gpr496_test.cmi test/gpr496_test.cmj test/gpr_1072.cmi test/gpr_1072.cmj test/gpr_1072_reg.cmi test/gpr_1072_reg.cmj test/gpr_1150.cmi test/gpr_1150.cmj test/gpr_1154_test.cmi test/gpr_1154_test.cmj test/gpr_1170.cmi test/gpr_1170.cmj test/gpr_1240_missing_unbox.cmi test/gpr_1240_missing_unbox.cmj test/gpr_1245_test.cmi test/gpr_1245_test.cmj test/gpr_1268.cmi test/gpr_1268.cmj test/gpr_1409_test.cmi test/gpr_1409_test.cmj test/gpr_1423_app_test.cmi test/gpr_1423_app_test.cmj test/gpr_1423_nav.cmi test/gpr_1423_nav.cmj test/gpr_1438.cmi test/gpr_1438.cmj test/gpr_1481.cmi test/gpr_1481.cmj test/gpr_1484.cmi test/gpr_1484.cmj test/gpr_1503_test.cmi test/gpr_1503_test.cmj test/gpr_1539_test.cmi test/gpr_1539_test.cmj test/gpr_1658_test.cmi test/gpr_1658_test.cmj test/gpr_1667_test.cmi test/gpr_1667_test.cmj test/gpr_1692_test.cmi test/gpr_1692_test.cmj test/gpr_1698_test.cmi test/gpr_1698_test.cmj test/gpr_1701_test.cmi test/gpr_1701_test.cmj test/gpr_1716_test.cmi test/gpr_1716_test.cmj test/gpr_1717_test.cmi test/gpr_1717_test.cmj test/gpr_1728_test.cmi test/gpr_1728_test.cmj test/gpr_1749_test.cmi test/gpr_1749_test.cmj test/gpr_1759_test.cmi test/gpr_1759_test.cmj test/gpr_1760_test.cmi test/gpr_1760_test.cmj test/gpr_1762_test.cmi test/gpr_1762_test.cmj test/gpr_1817_test.cmi test/gpr_1817_test.cmj test/gpr_1822_test.cmi test/gpr_1822_test.cmj test/gpr_1891_test.cmi test/gpr_1891_test.cmj test/gpr_1943_test.cmi test/gpr_1943_test.cmj test/gpr_1946_test.cmi test/gpr_1946_test.cmj test/gpr_2316_test.cmi test/gpr_2316_test.cmj test/gpr_2352_test.cmi test/gpr_2352_test.cmj test/gpr_2413_test.cmi test/gpr_2413_test.cmj test/gpr_2474.cmi test/gpr_2474.cmj test/gpr_2487.cmi test/gpr_2487.cmj test/gpr_2503_test.cmi test/gpr_2503_test.cmj test/gpr_2608_test.cmi test/gpr_2608_test.cmj test/gpr_2614_test.cmi test/gpr_2614_test.cmj test/gpr_2633_test.cmi test/gpr_2633_test.cmj test/gpr_2642_test.cmi test/gpr_2642_test.cmj test/gpr_2652_test.cmi test/gpr_2652_test.cmj test/gpr_2682_test.cmi test/gpr_2682_test.cmj test/gpr_2700_test.cmi test/gpr_2700_test.cmj test/gpr_2731_test.cmi test/gpr_2731_test.cmj test/gpr_2789_test.cmi test/gpr_2789_test.cmj test/gpr_2931_test.cmi test/gpr_2931_test.cmj test/gpr_3142_test.cmi test/gpr_3142_test.cmj test/gpr_3154_test.cmi test/gpr_3154_test.cmj test/gpr_3209_test.cmi test/gpr_3209_test.cmj test/gpr_3492_test.cmi test/gpr_3492_test.cmj test/gpr_3519_jsx_test.cmi test/gpr_3519_jsx_test.cmj test/gpr_3519_test.cmi test/gpr_3519_test.cmj test/gpr_3536_test.cmi test/gpr_3536_test.cmj test/gpr_3546_test.cmi test/gpr_3546_test.cmj test/gpr_3548_test.cmi test/gpr_3548_test.cmj test/gpr_3549_test.cmi test/gpr_3549_test.cmj test/gpr_3566_drive_test.cmi test/gpr_3566_drive_test.cmj test/gpr_3566_test.cmi test/gpr_3566_test.cmj test/gpr_3595_test.cmi test/gpr_3595_test.cmj test/gpr_3609_test.cmi test/gpr_3609_test.cmj test/gpr_3697_test.cmi test/gpr_3697_test.cmj test/gpr_373_test.cmi test/gpr_373_test.cmj test/gpr_3770_test.cmi test/gpr_3770_test.cmj test/gpr_3852_alias.cmi test/gpr_3852_alias.cmj test/gpr_3852_alias_reify.cmi test/gpr_3852_alias_reify.cmj test/gpr_3852_effect.cmi test/gpr_3852_effect.cmj test/gpr_3865.cmi test/gpr_3865.cmj test/gpr_3865_bar.cmi test/gpr_3865_bar.cmj test/gpr_3865_foo.cmi test/gpr_3865_foo.cmj test/gpr_3875_test.cmi test/gpr_3875_test.cmj test/gpr_3877_test.cmi test/gpr_3877_test.cmj test/gpr_3895_test.cmi test/gpr_3895_test.cmj test/gpr_3897_test.cmi test/gpr_3897_test.cmj test/gpr_3931_test.cmi test/gpr_3931_test.cmj test/gpr_3980_test.cmi test/gpr_3980_test.cmj test/gpr_4025_test.cmi test/gpr_4025_test.cmj test/gpr_405_test.cmi test/gpr_405_test.cmj test/gpr_4069_test.cmi test/gpr_4069_test.cmj test/gpr_4265_test.cmi test/gpr_4265_test.cmj test/gpr_4274_test.cmi test/gpr_4274_test.cmj test/gpr_4280_test.cmi test/gpr_4280_test.cmj test/gpr_4407_test.cmi test/gpr_4407_test.cmj test/gpr_441.cmi test/gpr_441.cmj test/gpr_4442_test.cmi test/gpr_4442_test.cmj test/gpr_4491_test.cmi test/gpr_4491_test.cmj test/gpr_4494_test.cmi test/gpr_4494_test.cmj test/gpr_4519_test.cmi test/gpr_4519_test.cmj test/gpr_459_test.cmi test/gpr_459_test.cmj test/gpr_4632.cmi test/gpr_4632.cmj test/gpr_4639_test.cmi test/gpr_4639_test.cmj test/gpr_4900_test.cmi test/gpr_4900_test.cmj test/gpr_4924_test.cmi test/gpr_4924_test.cmj test/gpr_4931.cmi test/gpr_4931.cmj test/gpr_4931_allow.cmi test/gpr_4931_allow.cmj test/gpr_5071_test.cmi test/gpr_5071_test.cmj test/gpr_5169_test.cmi test/gpr_5169_test.cmj test/gpr_5218_test.cmi test/gpr_5218_test.cmj test/gpr_5280_optimize_test.cmi test/gpr_5280_optimize_test.cmj test/gpr_5312.cmi test/gpr_5312.cmj test/gpr_5557.cmi test/gpr_5557.cmj test/gpr_5753.cmi test/gpr_5753.cmj test/gpr_658.cmi test/gpr_658.cmj test/gpr_858_test.cmi test/gpr_858_test.cmj test/gpr_858_unit2_test.cmi test/gpr_858_unit2_test.cmj test/gpr_904_test.cmi test/gpr_904_test.cmj test/gpr_974_test.cmi test/gpr_974_test.cmj test/gpr_977_test.cmi test/gpr_977_test.cmj test/gpr_return_type_unused_attribute.cmi test/gpr_return_type_unused_attribute.cmj test/gray_code_test.cmi test/gray_code_test.cmj test/guide_for_ext.cmi test/guide_for_ext.cmj test/hamming_test.cmi test/hamming_test.cmj test/hash_collision_test.cmi test/hash_collision_test.cmj test/hash_sugar_desugar.cmi test/hash_sugar_desugar.cmj test/hash_test.cmi test/hash_test.cmj test/hashtbl_test.cmi test/hashtbl_test.cmj test/hello.foo.cmi test/hello.foo.cmj test/hello_res.cmi test/hello_res.cmj test/ignore_test.cmi test/ignore_test.cmj test/imm_map_bench.cmi test/imm_map_bench.cmj test/include_side_effect.cmi test/include_side_effect.cmj test/include_side_effect_free.cmi test/include_side_effect_free.cmj test/incomplete_toplevel_test.cmi test/incomplete_toplevel_test.cmj test/infer_type_test.cmi test/infer_type_test.cmj test/inline_const.cmi test/inline_const.cmj test/inline_const_test.cmi test/inline_const_test.cmj test/inline_edge_cases.cmi test/inline_edge_cases.cmj test/inline_map2_test.cmi test/inline_map2_test.cmj test/inline_map_demo.cmi test/inline_map_demo.cmj test/inline_map_test.cmi test/inline_map_test.cmj test/inline_record_test.cmi test/inline_record_test.cmj test/inline_regression_test.cmi test/inline_regression_test.cmj test/inline_string_test.cmi test/inline_string_test.cmj test/inner_call.cmi test/inner_call.cmj test/inner_define.cmi test/inner_define.cmj test/inner_unused.cmi test/inner_unused.cmj test/installation_test.cmi test/installation_test.cmj test/int32_test.cmi test/int32_test.cmj test/int64_mul_div_test.cmi test/int64_mul_div_test.cmj test/int64_string_bench.cmi test/int64_string_bench.cmj test/int64_string_test.cmi test/int64_string_test.cmj test/int64_test.cmi test/int64_test.cmj test/int_hashtbl_test.cmi test/int_hashtbl_test.cmj test/int_map.cmi test/int_map.cmj test/int_overflow_test.cmi test/int_overflow_test.cmj test/int_poly_var.cmi test/int_poly_var.cmj test/int_switch_test.cmi test/int_switch_test.cmj test/internal_unused_test.cmi test/internal_unused_test.cmj test/io_test.cmi test/io_test.cmj test/js_array_test.cmi test/js_array_test.cmj test/js_bool_test.cmi test/js_bool_test.cmj test/js_cast_test.cmi test/js_cast_test.cmj test/js_date_test.cmi test/js_date_test.cmj test/js_dict_test.cmi test/js_dict_test.cmj test/js_exception_catch_test.cmi test/js_exception_catch_test.cmj test/js_float_test.cmi test/js_float_test.cmj test/js_global_test.cmi test/js_global_test.cmj test/js_int_test.cmi test/js_int_test.cmj test/js_json_test.cmi test/js_json_test.cmj test/js_list_test.cmi test/js_list_test.cmj test/js_math_test.cmi test/js_math_test.cmj test/js_null_test.cmi test/js_null_test.cmj test/js_null_undefined_test.cmi test/js_null_undefined_test.cmj test/js_nullable_test.cmi test/js_nullable_test.cmj test/js_obj_test.cmi test/js_obj_test.cmj test/js_option_test.cmi test/js_option_test.cmj test/js_re_test.cmi test/js_re_test.cmj test/js_string_test.cmi test/js_string_test.cmj test/js_typed_array_test.cmi test/js_typed_array_test.cmj test/js_undefined_test.cmi test/js_undefined_test.cmj test/js_val.cmi test/js_val.cmj test/jsoo_400_test.cmi test/jsoo_400_test.cmj test/jsoo_485_test.cmi test/jsoo_485_test.cmj test/jsxv4_newtype.cmi test/jsxv4_newtype.cmj test/key_word_property.cmi test/key_word_property.cmj test/key_word_property2.cmi test/key_word_property2.cmj test/key_word_property_plus_test.cmi test/key_word_property_plus_test.cmj test/label_uncurry.cmi test/label_uncurry.cmj test/large_integer_pat.cmi test/large_integer_pat.cmj test/large_record_duplication_test.cmi test/large_record_duplication_test.cmj test/largest_int_flow.cmi test/largest_int_flow.cmj test/lazy_demo.cmi test/lazy_demo.cmj test/lazy_test.cmi test/lazy_test.cmj test/lib_js_test.cmi test/lib_js_test.cmj test/libarg_test.cmi test/libarg_test.cmj test/libqueue_test.cmi test/libqueue_test.cmj test/limits_test.cmi test/limits_test.cmj test/list_stack.cmi test/list_stack.cmj test/list_test.cmi test/list_test.cmj test/local_exception_test.cmi test/local_exception_test.cmj test/loop_regression_test.cmi test/loop_regression_test.cmj test/loop_suites_test.cmi test/loop_suites_test.cmj test/map_find_test.cmi test/map_find_test.cmj test/map_test.cmi test/map_test.cmj test/mario_game.cmi test/mario_game.cmj test/marshal.cmi test/marshal.cmj test/meth_annotation.cmi test/meth_annotation.cmj test/method_name_test.cmi test/method_name_test.cmj test/method_string_name.cmi test/method_string_name.cmj test/minimal_test.cmi test/minimal_test.cmj test/miss_colon_test.cmi test/miss_colon_test.cmj test/mock_mt.cmi test/mock_mt.cmj test/module_alias_test.cmi test/module_alias_test.cmj test/module_as_class_ffi.cmi test/module_as_class_ffi.cmj test/module_as_function.cmi test/module_as_function.cmj test/module_missing_conversion.cmi test/module_missing_conversion.cmj test/module_parameter_test.cmi test/module_parameter_test.cmj test/module_splice_test.cmi test/module_splice_test.cmj test/more_poly_variant_test.cmi test/more_poly_variant_test.cmj test/more_uncurry.cmi test/more_uncurry.cmj test/mpr_6033_test.cmi test/mpr_6033_test.cmj test/mt.cmi test/mt.cmj test/mt_global.cmi test/mt_global.cmj test/mutable_obj_test.cmi test/mutable_obj_test.cmj test/mutable_uncurry_test.cmi test/mutable_uncurry_test.cmj test/mutual_non_recursive_type.cmi test/mutual_non_recursive_type.cmj test/name_mangle_test.cmi test/name_mangle_test.cmj test/nested_include.cmi test/nested_include.cmj test/nested_module_alias.cmi test/nested_module_alias.cmj test/nested_obj_literal.cmi test/nested_obj_literal.cmj test/nested_obj_test.cmi test/nested_obj_test.cmj test/nested_pattern_match_test.cmi test/nested_pattern_match_test.cmj test/noassert.cmi test/noassert.cmj test/node_fs_test.cmi test/node_fs_test.cmj test/node_path_test.cmi test/node_path_test.cmj test/null_list_test.cmi test/null_list_test.cmj test/number_lexer.cmi test/number_lexer.cmj test/obj_literal_ppx.cmi test/obj_literal_ppx.cmj test/obj_literal_ppx_test.cmi test/obj_literal_ppx_test.cmj test/obj_magic_test.cmi test/obj_magic_test.cmj test/obj_type_test.cmi test/obj_type_test.cmj test/ocaml_re_test.cmi test/ocaml_re_test.cmj test/of_string_test.cmi test/of_string_test.cmj test/offset.cmi test/offset.cmj test/option_encoding_test.cmi test/option_encoding_test.cmj test/option_record_none_test.cmi test/option_record_none_test.cmj test/option_repr_test.cmi test/option_repr_test.cmj test/optional_ffi_test.cmi test/optional_ffi_test.cmj test/optional_regression_test.cmi test/optional_regression_test.cmj test/pipe_send_readline.cmi test/pipe_send_readline.cmj test/pipe_syntax.cmi test/pipe_syntax.cmj test/poly_empty_array.cmi test/poly_empty_array.cmj test/poly_variant_test.cmi test/poly_variant_test.cmj test/polymorphic_raw_test.cmi test/polymorphic_raw_test.cmj test/polymorphism_test.cmi test/polymorphism_test.cmj test/polyvar_convert.cmi test/polyvar_convert.cmj test/polyvar_test.cmi test/polyvar_test.cmj test/ppx_apply_test.cmi test/ppx_apply_test.cmj test/pq_test.cmi test/pq_test.cmj test/pr6726.cmi test/pr6726.cmj test/pr_regression_test.cmi test/pr_regression_test.cmj test/prepend_data_ffi.cmi test/prepend_data_ffi.cmj test/primitive_reg_test.cmi test/primitive_reg_test.cmj test/print_alpha_test.cmi test/print_alpha_test.cmj test/queue_402.cmi test/queue_402.cmj test/queue_test.cmi test/queue_test.cmj test/random_test.cmi test/random_test.cmj test/raw_hash_tbl_bench.cmi test/raw_hash_tbl_bench.cmj test/raw_output_test.cmi test/raw_output_test.cmj test/raw_pure_test.cmi test/raw_pure_test.cmj test/rbset.cmi test/rbset.cmj test/react.cmi test/react.cmj test/reactDOMRe.cmi test/reactDOMRe.cmj test/reactDOMServerRe.cmi test/reactDOMServerRe.cmj test/reactEvent.cmi test/reactEvent.cmj test/reactTestUtils.cmi test/reactTestUtils.cmj test/reasonReact.cmi test/reasonReact.cmj test/reasonReactCompat.cmi test/reasonReactCompat.cmj test/reasonReactOptimizedCreateClass.cmi test/reasonReactOptimizedCreateClass.cmj test/reasonReactRouter.cmi test/reasonReactRouter.cmj test/rebind_module.cmi test/rebind_module.cmj test/rebind_module_test.cmi test/rebind_module_test.cmj test/rec_array_test.cmi test/rec_array_test.cmj test/rec_fun_test.cmi test/rec_fun_test.cmj test/rec_module_opt.cmi test/rec_module_opt.cmj test/rec_module_test.cmi test/rec_module_test.cmj test/record_debug_test.cmi test/record_debug_test.cmj test/record_extension_test.cmi test/record_extension_test.cmj test/record_name_test.cmi test/record_name_test.cmj test/record_regression.cmi test/record_regression.cmj test/record_with_test.cmi test/record_with_test.cmj test/recursive_module.cmi test/recursive_module.cmj test/recursive_module_test.cmi test/recursive_module_test.cmj test/recursive_react_component.cmi test/recursive_react_component.cmj test/recursive_records_test.cmi test/recursive_records_test.cmj test/recursive_unbound_module_test.cmi test/recursive_unbound_module_test.cmj test/regression_print.cmi test/regression_print.cmj test/relative_path.cmi test/relative_path.cmj test/res_debug.cmi test/res_debug.cmj test/return_check.cmi test/return_check.cmj test/runtime_encoding_test.cmi test/runtime_encoding_test.cmj test/set_annotation.cmi test/set_annotation.cmj test/set_gen.cmi test/set_gen.cmj test/sexp.cmi test/sexp.cmj test/sexpm.cmi test/sexpm.cmj test/sexpm_test.cmi test/sexpm_test.cmj test/side_effect.cmi test/side_effect.cmj test/side_effect_free.cmi test/side_effect_free.cmj test/simple_derive_test.cmi test/simple_derive_test.cmj test/simple_derive_use.cmi test/simple_derive_use.cmj test/simplify_lambda_632o.cmi test/simplify_lambda_632o.cmj test/single_module_alias.cmi test/single_module_alias.cmj test/singular_unit_test.cmi test/singular_unit_test.cmj test/small_inline_test.cmi test/small_inline_test.cmj test/splice_test.cmi test/splice_test.cmj test/stack_comp_test.cmi test/stack_comp_test.cmj test/stack_test.cmi test/stack_test.cmj test/stream_parser_test.cmi test/stream_parser_test.cmj test/string_bound_get_test.cmi test/string_bound_get_test.cmj test/string_constant_compare.cmi test/string_constant_compare.cmj test/string_get_set_test.cmi test/string_get_set_test.cmj test/string_runtime_test.cmi test/string_runtime_test.cmj test/string_set.cmi test/string_set.cmj test/string_set_test.cmi test/string_set_test.cmj test/string_test.cmi test/string_test.cmj test/string_unicode_test.cmi test/string_unicode_test.cmj test/stringmatch_test.cmi test/stringmatch_test.cmj test/submodule.cmi test/submodule.cmj test/submodule_call.cmi test/submodule_call.cmj test/switch_case_test.cmi test/switch_case_test.cmj test/switch_string.cmi test/switch_string.cmj test/tailcall_inline_test.cmi test/tailcall_inline_test.cmj test/template.cmi test/template.cmj test/test.cmi test/test.cmj test/test2.cmi test/test2.cmj test/test_alias.cmi test/test_alias.cmj test/test_ari.cmi test/test_ari.cmj test/test_array.cmi test/test_array.cmj test/test_array_append.cmi test/test_array_append.cmj test/test_array_primitive.cmi test/test_array_primitive.cmj test/test_bool_equal.cmi test/test_bool_equal.cmj test/test_bs_this.cmi test/test_bs_this.cmj test/test_bug.cmi test/test_bug.cmj test/test_bytes.cmi test/test_bytes.cmj test/test_case_opt_collision.cmi test/test_case_opt_collision.cmj test/test_case_set.cmi test/test_case_set.cmj test/test_char.cmi test/test_char.cmj test/test_closure.cmi test/test_closure.cmj test/test_common.cmi test/test_common.cmj test/test_const_elim.cmi test/test_const_elim.cmj test/test_const_propogate.cmi test/test_const_propogate.cmj test/test_cpp.cmi test/test_cpp.cmj test/test_cps.cmi test/test_cps.cmj test/test_demo.cmi test/test_demo.cmj test/test_dup_param.cmi test/test_dup_param.cmj test/test_eq.cmi test/test_eq.cmj test/test_exception.cmi test/test_exception.cmj test/test_exception_escape.cmi test/test_exception_escape.cmj test/test_export2.cmi test/test_export2.cmj test/test_external.cmi test/test_external.cmj test/test_external_unit.cmi test/test_external_unit.cmj test/test_ffi.cmi test/test_ffi.cmj test/test_fib.cmi test/test_fib.cmj test/test_filename.cmi test/test_filename.cmj test/test_for_loop.cmi test/test_for_loop.cmj test/test_for_map.cmi test/test_for_map.cmj test/test_for_map2.cmi test/test_for_map2.cmj test/test_format.cmi test/test_format.cmj test/test_formatter.cmi test/test_formatter.cmj test/test_functor_dead_code.cmi test/test_functor_dead_code.cmj test/test_generative_module.cmi test/test_generative_module.cmj test/test_global_print.cmi test/test_global_print.cmj test/test_google_closure.cmi test/test_google_closure.cmj test/test_include.cmi test/test_include.cmj test/test_incomplete.cmi test/test_incomplete.cmj test/test_incr_ref.cmi test/test_incr_ref.cmj test/test_int_map_find.cmi test/test_int_map_find.cmj test/test_internalOO.cmi test/test_internalOO.cmj test/test_is_js.cmi test/test_is_js.cmj test/test_js_ffi.cmi test/test_js_ffi.cmj test/test_let.cmi test/test_let.cmj test/test_list.cmi test/test_list.cmj test/test_literal.cmi test/test_literal.cmj test/test_literals.cmi test/test_literals.cmj test/test_match_exception.cmi test/test_match_exception.cmj test/test_mutliple.cmi test/test_mutliple.cmj test/test_nat64.cmi test/test_nat64.cmj test/test_nested_let.cmi test/test_nested_let.cmj test/test_nested_print.cmi test/test_nested_print.cmj test/test_non_export.cmi test/test_non_export.cmj test/test_nullary.cmi test/test_nullary.cmj test/test_obj.cmi test/test_obj.cmj test/test_order.cmi test/test_order.cmj test/test_order_tailcall.cmi test/test_order_tailcall.cmj test/test_other_exn.cmi test/test_other_exn.cmj test/test_pack.cmi test/test_pack.cmj test/test_per.cmi test/test_per.cmj test/test_pervasive.cmi test/test_pervasive.cmj test/test_pervasives2.cmi test/test_pervasives2.cmj test/test_pervasives3.cmi test/test_pervasives3.cmj test/test_primitive.cmi test/test_primitive.cmj test/test_ramification.cmi test/test_ramification.cmj test/test_react.cmi test/test_react.cmj test/test_react_case.cmi test/test_react_case.cmj test/test_regex.cmi test/test_regex.cmj test/test_require.cmi test/test_require.cmj test/test_runtime_encoding.cmi test/test_runtime_encoding.cmj test/test_scope.cmi test/test_scope.cmj test/test_seq.cmi test/test_seq.cmj test/test_set.cmi test/test_set.cmj test/test_side_effect_functor.cmi test/test_side_effect_functor.cmj test/test_simple_include.cmi test/test_simple_include.cmj test/test_simple_pattern_match.cmi test/test_simple_pattern_match.cmj test/test_simple_ref.cmi test/test_simple_ref.cmj test/test_simple_tailcall.cmi test/test_simple_tailcall.cmj test/test_small.cmi test/test_small.cmj test/test_sprintf.cmi test/test_sprintf.cmj test/test_stack.cmi test/test_stack.cmj test/test_static_catch_ident.cmi test/test_static_catch_ident.cmj test/test_string.cmi test/test_string.cmj test/test_string_case.cmi test/test_string_case.cmj test/test_string_const.cmi test/test_string_const.cmj test/test_string_map.cmi test/test_string_map.cmj test/test_string_switch.cmi test/test_string_switch.cmj test/test_switch.cmi test/test_switch.cmj test/test_trywith.cmi test/test_trywith.cmj test/test_tuple.cmi test/test_tuple.cmj test/test_tuple_destructring.cmi test/test_tuple_destructring.cmj test/test_type_based_arity.cmi test/test_type_based_arity.cmj test/test_u.cmi test/test_u.cmj test/test_unknown.cmi test/test_unknown.cmj test/test_unsafe_cmp.cmi test/test_unsafe_cmp.cmj test/test_unsafe_obj_ffi.cmi test/test_unsafe_obj_ffi.cmj test/test_unsafe_obj_ffi_ppx.cmi test/test_unsafe_obj_ffi_ppx.cmj test/test_unsupported_primitive.cmi test/test_unsupported_primitive.cmj test/test_while_closure.cmi test/test_while_closure.cmj test/test_while_side_effect.cmi test/test_while_side_effect.cmj test/test_zero_nullable.cmi test/test_zero_nullable.cmj test/then_mangle_test.cmi test/then_mangle_test.cmj test/ticker.cmi test/ticker.cmj test/to_string_test.cmi test/to_string_test.cmj test/topsort_test.cmi test/topsort_test.cmj test/tramp_fib.cmi test/tramp_fib.cmj test/tuple_alloc.cmi test/tuple_alloc.cmj test/type_disambiguate.cmi test/type_disambiguate.cmj test/typeof_test.cmi test/typeof_test.cmj test/unboxed_attribute.cmi test/unboxed_attribute.cmj test/unboxed_attribute_test.cmi test/unboxed_attribute_test.cmj test/unboxed_crash.cmi test/unboxed_crash.cmj test/unboxed_use_case.cmi test/unboxed_use_case.cmj test/uncurried_cast.cmi test/uncurried_cast.cmj test/uncurried_default.args.cmi test/uncurried_default.args.cmj test/uncurried_pipe.cmi test/uncurried_pipe.cmj test/uncurry_external_test.cmi test/uncurry_external_test.cmj test/uncurry_glob_test.cmi test/uncurry_glob_test.cmj test/uncurry_test.cmi test/uncurry_test.cmj test/undef_regression2_test.cmi test/undef_regression2_test.cmj test/undef_regression_test.cmi test/undef_regression_test.cmj test/undefine_conditional.cmi test/undefine_conditional.cmj test/unicode_type_error.cmi test/unicode_type_error.cmj test/unit_undefined_test.cmi test/unit_undefined_test.cmj test/unitest_string.cmi test/unitest_string.cmj test/unsafe_full_apply_primitive.cmi test/unsafe_full_apply_primitive.cmj test/unsafe_ppx_test.cmi test/unsafe_ppx_test.cmj test/update_record_test.cmi test/update_record_test.cmj test/variant.cmi test/variant.cmj test/variantsMatching.cmi test/variantsMatching.cmj test/watch_test.cmi test/watch_test.cmj test/webpack_config.cmi test/webpack_config.cmj +o test : phony test/406_primitive_test.cmi test/406_primitive_test.cmj test/DotDotDot.cmi test/DotDotDot.cmj test/EmptyRecord.cmi test/EmptyRecord.cmj test/Import.cmi test/Import.cmj test/RecordCoercion.cmi test/RecordCoercion.cmj test/RecordOrObject.cmi test/RecordOrObject.cmj test/SafePromises.cmi test/SafePromises.cmj test/UncurriedAlways.cmi test/UncurriedAlways.cmj test/UncurriedExternals.cmi test/UncurriedExternals.cmj test/UncurriedPervasives.cmi test/UncurriedPervasives.cmj test/UntaggedVariants.cmi test/UntaggedVariants.cmj test/a.cmi test/a.cmj test/a_filename_test.cmi test/a_filename_test.cmj test/a_list_test.cmi test/a_list_test.cmj test/a_recursive_type.cmi test/a_recursive_type.cmj test/a_scope_bug.cmi test/a_scope_bug.cmj test/a_string_test.cmi test/a_string_test.cmj test/abstract_type.cmi test/abstract_type.cmj test/adt_optimize_test.cmi test/adt_optimize_test.cmj test/alias_default_value_test.cmi test/alias_default_value_test.cmj test/alias_test.cmi test/alias_test.cmj test/and_or_tailcall_test.cmi test/and_or_tailcall_test.cmj test/app_root_finder.cmi test/app_root_finder.cmj test/argv_test.cmi test/argv_test.cmj test/ari_regress_test.cmi test/ari_regress_test.cmj test/arith_lexer.cmi test/arith_lexer.cmj test/arith_parser.cmi test/arith_parser.cmj test/arith_syntax.cmi test/arith_syntax.cmj test/arity.cmi test/arity.cmj test/arity_deopt.cmi test/arity_deopt.cmj test/arity_infer.cmi test/arity_infer.cmj test/array_data_util.cmi test/array_data_util.cmj test/array_safe_get.cmi test/array_safe_get.cmj test/array_subtle_test.cmi test/array_subtle_test.cmj test/array_test.cmi test/array_test.cmj test/ast_abstract_test.cmi test/ast_abstract_test.cmj test/ast_mapper_unused_warning_test.cmi test/ast_mapper_unused_warning_test.cmj test/async_await.cmi test/async_await.cmj test/async_ideas.cmi test/async_ideas.cmj test/async_inline.cmi test/async_inline.cmj test/attr_test.cmi test/attr_test.cmj test/b.cmi test/b.cmj test/bal_set_mini.cmi test/bal_set_mini.cmj test/bang_primitive.cmi test/bang_primitive.cmj test/basic_module_test.cmi test/basic_module_test.cmj test/bb.cmi test/bb.cmj test/bdd.cmi test/bdd.cmj test/belt_internal_test.cmi test/belt_internal_test.cmj test/belt_result_alias_test.cmi test/belt_result_alias_test.cmj test/bench.cmi test/bench.cmj test/big_enum.cmi test/big_enum.cmj test/big_polyvar_test.cmi test/big_polyvar_test.cmj test/block_alias_test.cmi test/block_alias_test.cmj test/boolean_test.cmi test/boolean_test.cmj test/bs_MapInt_test.cmi test/bs_MapInt_test.cmj test/bs_abstract_test.cmi test/bs_abstract_test.cmj test/bs_array_test.cmi test/bs_array_test.cmj test/bs_auto_uncurry.cmi test/bs_auto_uncurry.cmj test/bs_auto_uncurry_test.cmi test/bs_auto_uncurry_test.cmj test/bs_float_test.cmi test/bs_float_test.cmj test/bs_hashmap_test.cmi test/bs_hashmap_test.cmj test/bs_hashset_int_test.cmi test/bs_hashset_int_test.cmj test/bs_hashtbl_string_test.cmi test/bs_hashtbl_string_test.cmj test/bs_ignore_effect.cmi test/bs_ignore_effect.cmj test/bs_ignore_test.cmi test/bs_ignore_test.cmj test/bs_int_test.cmi test/bs_int_test.cmj test/bs_list_test.cmi test/bs_list_test.cmj test/bs_map_set_dict_test.cmi test/bs_map_set_dict_test.cmj test/bs_map_test.cmi test/bs_map_test.cmj test/bs_min_max_test.cmi test/bs_min_max_test.cmj test/bs_mutable_set_test.cmi test/bs_mutable_set_test.cmj test/bs_node_string_buffer_test.cmi test/bs_node_string_buffer_test.cmj test/bs_poly_map_test.cmi test/bs_poly_map_test.cmj test/bs_poly_mutable_map_test.cmi test/bs_poly_mutable_map_test.cmj test/bs_poly_mutable_set_test.cmi test/bs_poly_mutable_set_test.cmj test/bs_poly_set_test.cmi test/bs_poly_set_test.cmj test/bs_qualified.cmi test/bs_qualified.cmj test/bs_queue_test.cmi test/bs_queue_test.cmj test/bs_rbset_int_bench.cmi test/bs_rbset_int_bench.cmj test/bs_rest_test.cmi test/bs_rest_test.cmj test/bs_set_bench.cmi test/bs_set_bench.cmj test/bs_set_int_test.cmi test/bs_set_int_test.cmj test/bs_sort_test.cmi test/bs_sort_test.cmj test/bs_splice_partial.cmi test/bs_splice_partial.cmj test/bs_stack_test.cmi test/bs_stack_test.cmj test/bs_string_test.cmi test/bs_string_test.cmj test/bs_unwrap_test.cmi test/bs_unwrap_test.cmj test/buffer_test.cmi test/buffer_test.cmj test/bytes_split_gpr_743_test.cmi test/bytes_split_gpr_743_test.cmj test/caml_compare_bigint_test.cmi test/caml_compare_bigint_test.cmj test/caml_compare_test.cmi test/caml_compare_test.cmj test/caml_format_test.cmi test/caml_format_test.cmj test/caml_sys_poly_fill_test.cmi test/caml_sys_poly_fill_test.cmj test/chain_code_test.cmi test/chain_code_test.cmj test/chn_test.cmi test/chn_test.cmj test/class_type_ffi_test.cmi test/class_type_ffi_test.cmj test/coercion_module_alias_test.cmi test/coercion_module_alias_test.cmj test/compare_test.cmi test/compare_test.cmj test/complete_parmatch_test.cmi test/complete_parmatch_test.cmj test/complex_if_test.cmi test/complex_if_test.cmj test/complex_test.cmi test/complex_test.cmj test/complex_while_loop.cmi test/complex_while_loop.cmj test/condition_compilation_test.cmi test/condition_compilation_test.cmj test/config1_test.cmi test/config1_test.cmj test/console_log_test.cmi test/console_log_test.cmj test/const_block_test.cmi test/const_block_test.cmj test/const_defs.cmi test/const_defs.cmj test/const_defs_test.cmi test/const_defs_test.cmj test/const_test.cmi test/const_test.cmj test/cont_int_fold_test.cmi test/cont_int_fold_test.cmj test/cps_test.cmi test/cps_test.cmj test/cross_module_inline_test.cmi test/cross_module_inline_test.cmj test/custom_error_test.cmi test/custom_error_test.cmj test/debug_keep_test.cmi test/debug_keep_test.cmj test/debug_mode_value.cmi test/debug_mode_value.cmj test/debug_tmp.cmi test/debug_tmp.cmj test/debugger_test.cmi test/debugger_test.cmj test/default_export_test.cmi test/default_export_test.cmj test/defunctor_make_test.cmi test/defunctor_make_test.cmj test/demo_int_map.cmi test/demo_int_map.cmj test/demo_page.cmi test/demo_page.cmj test/demo_pipe.cmi test/demo_pipe.cmj test/derive_dyntype.cmi test/derive_dyntype.cmj test/derive_projector_test.cmi test/derive_projector_test.cmj test/derive_type_test.cmi test/derive_type_test.cmj test/digest_test.cmi test/digest_test.cmj test/directives.cmi test/directives.cmj test/div_by_zero_test.cmi test/div_by_zero_test.cmj test/dollar_escape_test.cmi test/dollar_escape_test.cmj test/earger_curry_test.cmi test/earger_curry_test.cmj test/effect.cmi test/effect.cmj test/epsilon_test.cmi test/epsilon_test.cmj test/equal_box_test.cmi test/equal_box_test.cmj test/equal_exception_test.cmi test/equal_exception_test.cmj test/equal_test.cmi test/equal_test.cmj test/es6_export.cmi test/es6_export.cmj test/es6_import.cmi test/es6_import.cmj test/es6_module_test.cmi test/es6_module_test.cmj test/escape_esmodule.cmi test/escape_esmodule.cmj test/esmodule_ref.cmi test/esmodule_ref.cmj test/event_ffi.cmi test/event_ffi.cmj test/exception_alias.cmi test/exception_alias.cmj test/exception_raise_test.cmi test/exception_raise_test.cmj test/exception_rebound_err_test.cmi test/exception_rebound_err_test.cmj test/exception_value_test.cmi test/exception_value_test.cmj test/exponentiation_precedence_test.cmi test/exponentiation_precedence_test.cmj test/export_keyword.cmi test/export_keyword.cmj test/ext_array_test.cmi test/ext_array_test.cmj test/ext_bytes_test.cmi test/ext_bytes_test.cmj test/ext_filename_test.cmi test/ext_filename_test.cmj test/ext_list_test.cmi test/ext_list_test.cmj test/ext_pervasives_test.cmi test/ext_pervasives_test.cmj test/ext_string_test.cmi test/ext_string_test.cmj test/ext_sys_test.cmi test/ext_sys_test.cmj test/extensible_variant_test.cmi test/extensible_variant_test.cmj test/external_polyfill_test.cmi test/external_polyfill_test.cmj test/external_ppx.cmi test/external_ppx.cmj test/external_ppx2.cmi test/external_ppx2.cmj test/fail_comp.cmi test/fail_comp.cmj test/ffi_arity_test.cmi test/ffi_arity_test.cmj test/ffi_array_test.cmi test/ffi_array_test.cmj test/ffi_js_test.cmi test/ffi_js_test.cmj test/ffi_splice_test.cmi test/ffi_splice_test.cmj test/ffi_test.cmi test/ffi_test.cmj test/fib.cmi test/fib.cmj test/flattern_order_test.cmi test/flattern_order_test.cmj test/flexible_array_test.cmi test/flexible_array_test.cmj test/float_array.cmi test/float_array.cmj test/float_of_bits_test.cmi test/float_of_bits_test.cmj test/float_record.cmi test/float_record.cmj test/float_test.cmi test/float_test.cmj test/floatarray_test.cmi test/floatarray_test.cmj test/for_loop_test.cmi test/for_loop_test.cmj test/for_side_effect_test.cmi test/for_side_effect_test.cmj test/format_regression.cmi test/format_regression.cmj test/format_test.cmi test/format_test.cmj test/fs_test.cmi test/fs_test.cmj test/fun_pattern_match.cmi test/fun_pattern_match.cmj test/functor_app_test.cmi test/functor_app_test.cmj test/functor_def.cmi test/functor_def.cmj test/functor_ffi.cmi test/functor_ffi.cmj test/functor_inst.cmi test/functor_inst.cmj test/functors.cmi test/functors.cmj test/gbk.cmi test/gbk.cmj test/genlex_test.cmi test/genlex_test.cmj test/gentTypeReTest.cmi test/gentTypeReTest.cmj test/global_exception_regression_test.cmi test/global_exception_regression_test.cmj test/global_mangles.cmi test/global_mangles.cmj test/global_module_alias_test.cmi test/global_module_alias_test.cmj test/google_closure_test.cmi test/google_closure_test.cmj test/gpr496_test.cmi test/gpr496_test.cmj test/gpr_1072.cmi test/gpr_1072.cmj test/gpr_1072_reg.cmi test/gpr_1072_reg.cmj test/gpr_1150.cmi test/gpr_1150.cmj test/gpr_1154_test.cmi test/gpr_1154_test.cmj test/gpr_1170.cmi test/gpr_1170.cmj test/gpr_1240_missing_unbox.cmi test/gpr_1240_missing_unbox.cmj test/gpr_1245_test.cmi test/gpr_1245_test.cmj test/gpr_1268.cmi test/gpr_1268.cmj test/gpr_1409_test.cmi test/gpr_1409_test.cmj test/gpr_1423_app_test.cmi test/gpr_1423_app_test.cmj test/gpr_1423_nav.cmi test/gpr_1423_nav.cmj test/gpr_1438.cmi test/gpr_1438.cmj test/gpr_1481.cmi test/gpr_1481.cmj test/gpr_1484.cmi test/gpr_1484.cmj test/gpr_1503_test.cmi test/gpr_1503_test.cmj test/gpr_1539_test.cmi test/gpr_1539_test.cmj test/gpr_1658_test.cmi test/gpr_1658_test.cmj test/gpr_1667_test.cmi test/gpr_1667_test.cmj test/gpr_1692_test.cmi test/gpr_1692_test.cmj test/gpr_1698_test.cmi test/gpr_1698_test.cmj test/gpr_1701_test.cmi test/gpr_1701_test.cmj test/gpr_1716_test.cmi test/gpr_1716_test.cmj test/gpr_1717_test.cmi test/gpr_1717_test.cmj test/gpr_1728_test.cmi test/gpr_1728_test.cmj test/gpr_1749_test.cmi test/gpr_1749_test.cmj test/gpr_1759_test.cmi test/gpr_1759_test.cmj test/gpr_1760_test.cmi test/gpr_1760_test.cmj test/gpr_1762_test.cmi test/gpr_1762_test.cmj test/gpr_1817_test.cmi test/gpr_1817_test.cmj test/gpr_1822_test.cmi test/gpr_1822_test.cmj test/gpr_1891_test.cmi test/gpr_1891_test.cmj test/gpr_1943_test.cmi test/gpr_1943_test.cmj test/gpr_1946_test.cmi test/gpr_1946_test.cmj test/gpr_2316_test.cmi test/gpr_2316_test.cmj test/gpr_2352_test.cmi test/gpr_2352_test.cmj test/gpr_2413_test.cmi test/gpr_2413_test.cmj test/gpr_2474.cmi test/gpr_2474.cmj test/gpr_2487.cmi test/gpr_2487.cmj test/gpr_2503_test.cmi test/gpr_2503_test.cmj test/gpr_2608_test.cmi test/gpr_2608_test.cmj test/gpr_2614_test.cmi test/gpr_2614_test.cmj test/gpr_2633_test.cmi test/gpr_2633_test.cmj test/gpr_2642_test.cmi test/gpr_2642_test.cmj test/gpr_2652_test.cmi test/gpr_2652_test.cmj test/gpr_2682_test.cmi test/gpr_2682_test.cmj test/gpr_2700_test.cmi test/gpr_2700_test.cmj test/gpr_2731_test.cmi test/gpr_2731_test.cmj test/gpr_2789_test.cmi test/gpr_2789_test.cmj test/gpr_2931_test.cmi test/gpr_2931_test.cmj test/gpr_3142_test.cmi test/gpr_3142_test.cmj test/gpr_3154_test.cmi test/gpr_3154_test.cmj test/gpr_3209_test.cmi test/gpr_3209_test.cmj test/gpr_3492_test.cmi test/gpr_3492_test.cmj test/gpr_3519_jsx_test.cmi test/gpr_3519_jsx_test.cmj test/gpr_3519_test.cmi test/gpr_3519_test.cmj test/gpr_3536_test.cmi test/gpr_3536_test.cmj test/gpr_3546_test.cmi test/gpr_3546_test.cmj test/gpr_3548_test.cmi test/gpr_3548_test.cmj test/gpr_3549_test.cmi test/gpr_3549_test.cmj test/gpr_3566_drive_test.cmi test/gpr_3566_drive_test.cmj test/gpr_3566_test.cmi test/gpr_3566_test.cmj test/gpr_3595_test.cmi test/gpr_3595_test.cmj test/gpr_3609_test.cmi test/gpr_3609_test.cmj test/gpr_3697_test.cmi test/gpr_3697_test.cmj test/gpr_373_test.cmi test/gpr_373_test.cmj test/gpr_3770_test.cmi test/gpr_3770_test.cmj test/gpr_3852_alias.cmi test/gpr_3852_alias.cmj test/gpr_3852_alias_reify.cmi test/gpr_3852_alias_reify.cmj test/gpr_3852_effect.cmi test/gpr_3852_effect.cmj test/gpr_3865.cmi test/gpr_3865.cmj test/gpr_3865_bar.cmi test/gpr_3865_bar.cmj test/gpr_3865_foo.cmi test/gpr_3865_foo.cmj test/gpr_3875_test.cmi test/gpr_3875_test.cmj test/gpr_3877_test.cmi test/gpr_3877_test.cmj test/gpr_3895_test.cmi test/gpr_3895_test.cmj test/gpr_3897_test.cmi test/gpr_3897_test.cmj test/gpr_3931_test.cmi test/gpr_3931_test.cmj test/gpr_3980_test.cmi test/gpr_3980_test.cmj test/gpr_4025_test.cmi test/gpr_4025_test.cmj test/gpr_405_test.cmi test/gpr_405_test.cmj test/gpr_4069_test.cmi test/gpr_4069_test.cmj test/gpr_4265_test.cmi test/gpr_4265_test.cmj test/gpr_4274_test.cmi test/gpr_4274_test.cmj test/gpr_4280_test.cmi test/gpr_4280_test.cmj test/gpr_4407_test.cmi test/gpr_4407_test.cmj test/gpr_441.cmi test/gpr_441.cmj test/gpr_4442_test.cmi test/gpr_4442_test.cmj test/gpr_4491_test.cmi test/gpr_4491_test.cmj test/gpr_4494_test.cmi test/gpr_4494_test.cmj test/gpr_4519_test.cmi test/gpr_4519_test.cmj test/gpr_459_test.cmi test/gpr_459_test.cmj test/gpr_4632.cmi test/gpr_4632.cmj test/gpr_4639_test.cmi test/gpr_4639_test.cmj test/gpr_4900_test.cmi test/gpr_4900_test.cmj test/gpr_4924_test.cmi test/gpr_4924_test.cmj test/gpr_4931.cmi test/gpr_4931.cmj test/gpr_4931_allow.cmi test/gpr_4931_allow.cmj test/gpr_5071_test.cmi test/gpr_5071_test.cmj test/gpr_5169_test.cmi test/gpr_5169_test.cmj test/gpr_5218_test.cmi test/gpr_5218_test.cmj test/gpr_5280_optimize_test.cmi test/gpr_5280_optimize_test.cmj test/gpr_5312.cmi test/gpr_5312.cmj test/gpr_5557.cmi test/gpr_5557.cmj test/gpr_5753.cmi test/gpr_5753.cmj test/gpr_658.cmi test/gpr_658.cmj test/gpr_858_test.cmi test/gpr_858_test.cmj test/gpr_858_unit2_test.cmi test/gpr_858_unit2_test.cmj test/gpr_904_test.cmi test/gpr_904_test.cmj test/gpr_974_test.cmi test/gpr_974_test.cmj test/gpr_977_test.cmi test/gpr_977_test.cmj test/gpr_return_type_unused_attribute.cmi test/gpr_return_type_unused_attribute.cmj test/gray_code_test.cmi test/gray_code_test.cmj test/guide_for_ext.cmi test/guide_for_ext.cmj test/hamming_test.cmi test/hamming_test.cmj test/hash_collision_test.cmi test/hash_collision_test.cmj test/hash_sugar_desugar.cmi test/hash_sugar_desugar.cmj test/hash_test.cmi test/hash_test.cmj test/hashtbl_test.cmi test/hashtbl_test.cmj test/hello.foo.cmi test/hello.foo.cmj test/hello_res.cmi test/hello_res.cmj test/ignore_test.cmi test/ignore_test.cmj test/imm_map_bench.cmi test/imm_map_bench.cmj test/include_side_effect.cmi test/include_side_effect.cmj test/include_side_effect_free.cmi test/include_side_effect_free.cmj test/incomplete_toplevel_test.cmi test/incomplete_toplevel_test.cmj test/infer_type_test.cmi test/infer_type_test.cmj test/inline_const.cmi test/inline_const.cmj test/inline_const_test.cmi test/inline_const_test.cmj test/inline_edge_cases.cmi test/inline_edge_cases.cmj test/inline_map2_test.cmi test/inline_map2_test.cmj test/inline_map_demo.cmi test/inline_map_demo.cmj test/inline_map_test.cmi test/inline_map_test.cmj test/inline_record_test.cmi test/inline_record_test.cmj test/inline_regression_test.cmi test/inline_regression_test.cmj test/inline_string_test.cmi test/inline_string_test.cmj test/inner_call.cmi test/inner_call.cmj test/inner_define.cmi test/inner_define.cmj test/inner_unused.cmi test/inner_unused.cmj test/installation_test.cmi test/installation_test.cmj test/int32_test.cmi test/int32_test.cmj test/int64_mul_div_test.cmi test/int64_mul_div_test.cmj test/int64_string_bench.cmi test/int64_string_bench.cmj test/int64_string_test.cmi test/int64_string_test.cmj test/int64_test.cmi test/int64_test.cmj test/int_hashtbl_test.cmi test/int_hashtbl_test.cmj test/int_map.cmi test/int_map.cmj test/int_overflow_test.cmi test/int_overflow_test.cmj test/int_poly_var.cmi test/int_poly_var.cmj test/int_switch_test.cmi test/int_switch_test.cmj test/internal_unused_test.cmi test/internal_unused_test.cmj test/io_test.cmi test/io_test.cmj test/js_array_test.cmi test/js_array_test.cmj test/js_bool_test.cmi test/js_bool_test.cmj test/js_cast_test.cmi test/js_cast_test.cmj test/js_date_test.cmi test/js_date_test.cmj test/js_dict_test.cmi test/js_dict_test.cmj test/js_exception_catch_test.cmi test/js_exception_catch_test.cmj test/js_float_test.cmi test/js_float_test.cmj test/js_global_test.cmi test/js_global_test.cmj test/js_int_test.cmi test/js_int_test.cmj test/js_json_test.cmi test/js_json_test.cmj test/js_list_test.cmi test/js_list_test.cmj test/js_math_test.cmi test/js_math_test.cmj test/js_null_test.cmi test/js_null_test.cmj test/js_null_undefined_test.cmi test/js_null_undefined_test.cmj test/js_nullable_test.cmi test/js_nullable_test.cmj test/js_obj_test.cmi test/js_obj_test.cmj test/js_option_test.cmi test/js_option_test.cmj test/js_re_test.cmi test/js_re_test.cmj test/js_string_test.cmi test/js_string_test.cmj test/js_typed_array_test.cmi test/js_typed_array_test.cmj test/js_undefined_test.cmi test/js_undefined_test.cmj test/js_val.cmi test/js_val.cmj test/jsoo_400_test.cmi test/jsoo_400_test.cmj test/jsoo_485_test.cmi test/jsoo_485_test.cmj test/jsxv4_newtype.cmi test/jsxv4_newtype.cmj test/key_word_property.cmi test/key_word_property.cmj test/key_word_property2.cmi test/key_word_property2.cmj test/key_word_property_plus_test.cmi test/key_word_property_plus_test.cmj test/label_uncurry.cmi test/label_uncurry.cmj test/large_integer_pat.cmi test/large_integer_pat.cmj test/large_record_duplication_test.cmi test/large_record_duplication_test.cmj test/largest_int_flow.cmi test/largest_int_flow.cmj test/lazy_demo.cmi test/lazy_demo.cmj test/lazy_test.cmi test/lazy_test.cmj test/lib_js_test.cmi test/lib_js_test.cmj test/libarg_test.cmi test/libarg_test.cmj test/libqueue_test.cmi test/libqueue_test.cmj test/limits_test.cmi test/limits_test.cmj test/list_stack.cmi test/list_stack.cmj test/list_test.cmi test/list_test.cmj test/local_exception_test.cmi test/local_exception_test.cmj test/loop_regression_test.cmi test/loop_regression_test.cmj test/loop_suites_test.cmi test/loop_suites_test.cmj test/map_find_test.cmi test/map_find_test.cmj test/map_test.cmi test/map_test.cmj test/mario_game.cmi test/mario_game.cmj test/marshal.cmi test/marshal.cmj test/meth_annotation.cmi test/meth_annotation.cmj test/method_name_test.cmi test/method_name_test.cmj test/method_string_name.cmi test/method_string_name.cmj test/minimal_test.cmi test/minimal_test.cmj test/miss_colon_test.cmi test/miss_colon_test.cmj test/mock_mt.cmi test/mock_mt.cmj test/module_alias_test.cmi test/module_alias_test.cmj test/module_as_class_ffi.cmi test/module_as_class_ffi.cmj test/module_as_function.cmi test/module_as_function.cmj test/module_missing_conversion.cmi test/module_missing_conversion.cmj test/module_parameter_test.cmi test/module_parameter_test.cmj test/module_splice_test.cmi test/module_splice_test.cmj test/more_poly_variant_test.cmi test/more_poly_variant_test.cmj test/more_uncurry.cmi test/more_uncurry.cmj test/mpr_6033_test.cmi test/mpr_6033_test.cmj test/mt.cmi test/mt.cmj test/mt_global.cmi test/mt_global.cmj test/mutable_obj_test.cmi test/mutable_obj_test.cmj test/mutable_uncurry_test.cmi test/mutable_uncurry_test.cmj test/mutual_non_recursive_type.cmi test/mutual_non_recursive_type.cmj test/name_mangle_test.cmi test/name_mangle_test.cmj test/nested_include.cmi test/nested_include.cmj test/nested_module_alias.cmi test/nested_module_alias.cmj test/nested_obj_literal.cmi test/nested_obj_literal.cmj test/nested_obj_test.cmi test/nested_obj_test.cmj test/nested_pattern_match_test.cmi test/nested_pattern_match_test.cmj test/noassert.cmi test/noassert.cmj test/node_fs_test.cmi test/node_fs_test.cmj test/node_path_test.cmi test/node_path_test.cmj test/null_list_test.cmi test/null_list_test.cmj test/number_lexer.cmi test/number_lexer.cmj test/obj_literal_ppx.cmi test/obj_literal_ppx.cmj test/obj_literal_ppx_test.cmi test/obj_literal_ppx_test.cmj test/obj_magic_test.cmi test/obj_magic_test.cmj test/obj_type_test.cmi test/obj_type_test.cmj test/ocaml_re_test.cmi test/ocaml_re_test.cmj test/of_string_test.cmi test/of_string_test.cmj test/offset.cmi test/offset.cmj test/option_encoding_test.cmi test/option_encoding_test.cmj test/option_record_none_test.cmi test/option_record_none_test.cmj test/option_repr_test.cmi test/option_repr_test.cmj test/optional_ffi_test.cmi test/optional_ffi_test.cmj test/optional_regression_test.cmi test/optional_regression_test.cmj test/pipe_send_readline.cmi test/pipe_send_readline.cmj test/pipe_syntax.cmi test/pipe_syntax.cmj test/poly_empty_array.cmi test/poly_empty_array.cmj test/poly_variant_test.cmi test/poly_variant_test.cmj test/polymorphic_raw_test.cmi test/polymorphic_raw_test.cmj test/polymorphism_test.cmi test/polymorphism_test.cmj test/polyvar_convert.cmi test/polyvar_convert.cmj test/polyvar_test.cmi test/polyvar_test.cmj test/ppx_apply_test.cmi test/ppx_apply_test.cmj test/pq_test.cmi test/pq_test.cmj test/pr6726.cmi test/pr6726.cmj test/pr_regression_test.cmi test/pr_regression_test.cmj test/prepend_data_ffi.cmi test/prepend_data_ffi.cmj test/primitive_reg_test.cmi test/primitive_reg_test.cmj test/print_alpha_test.cmi test/print_alpha_test.cmj test/queue_402.cmi test/queue_402.cmj test/queue_test.cmi test/queue_test.cmj test/random_test.cmi test/random_test.cmj test/raw_hash_tbl_bench.cmi test/raw_hash_tbl_bench.cmj test/raw_output_test.cmi test/raw_output_test.cmj test/raw_pure_test.cmi test/raw_pure_test.cmj test/rbset.cmi test/rbset.cmj test/react.cmi test/react.cmj test/reactDOMRe.cmi test/reactDOMRe.cmj test/reactDOMServerRe.cmi test/reactDOMServerRe.cmj test/reactEvent.cmi test/reactEvent.cmj test/reactTestUtils.cmi test/reactTestUtils.cmj test/reasonReact.cmi test/reasonReact.cmj test/reasonReactCompat.cmi test/reasonReactCompat.cmj test/reasonReactOptimizedCreateClass.cmi test/reasonReactOptimizedCreateClass.cmj test/reasonReactRouter.cmi test/reasonReactRouter.cmj test/rebind_module.cmi test/rebind_module.cmj test/rebind_module_test.cmi test/rebind_module_test.cmj test/rec_array_test.cmi test/rec_array_test.cmj test/rec_fun_test.cmi test/rec_fun_test.cmj test/rec_module_opt.cmi test/rec_module_opt.cmj test/rec_module_test.cmi test/rec_module_test.cmj test/record_debug_test.cmi test/record_debug_test.cmj test/record_extension_test.cmi test/record_extension_test.cmj test/record_name_test.cmi test/record_name_test.cmj test/record_regression.cmi test/record_regression.cmj test/record_with_test.cmi test/record_with_test.cmj test/recursive_module.cmi test/recursive_module.cmj test/recursive_module_test.cmi test/recursive_module_test.cmj test/recursive_react_component.cmi test/recursive_react_component.cmj test/recursive_records_test.cmi test/recursive_records_test.cmj test/recursive_unbound_module_test.cmi test/recursive_unbound_module_test.cmj test/regression_print.cmi test/regression_print.cmj test/relative_path.cmi test/relative_path.cmj test/res_debug.cmi test/res_debug.cmj test/return_check.cmi test/return_check.cmj test/runtime_encoding_test.cmi test/runtime_encoding_test.cmj test/set_annotation.cmi test/set_annotation.cmj test/set_gen.cmi test/set_gen.cmj test/sexp.cmi test/sexp.cmj test/sexpm.cmi test/sexpm.cmj test/sexpm_test.cmi test/sexpm_test.cmj test/side_effect.cmi test/side_effect.cmj test/side_effect_free.cmi test/side_effect_free.cmj test/simple_derive_test.cmi test/simple_derive_test.cmj test/simple_derive_use.cmi test/simple_derive_use.cmj test/simplify_lambda_632o.cmi test/simplify_lambda_632o.cmj test/single_module_alias.cmi test/single_module_alias.cmj test/singular_unit_test.cmi test/singular_unit_test.cmj test/small_inline_test.cmi test/small_inline_test.cmj test/splice_test.cmi test/splice_test.cmj test/stack_comp_test.cmi test/stack_comp_test.cmj test/stack_test.cmi test/stack_test.cmj test/stream_parser_test.cmi test/stream_parser_test.cmj test/string_bound_get_test.cmi test/string_bound_get_test.cmj test/string_constant_compare.cmi test/string_constant_compare.cmj test/string_get_set_test.cmi test/string_get_set_test.cmj test/string_runtime_test.cmi test/string_runtime_test.cmj test/string_set.cmi test/string_set.cmj test/string_set_test.cmi test/string_set_test.cmj test/string_test.cmi test/string_test.cmj test/string_unicode_test.cmi test/string_unicode_test.cmj test/stringmatch_test.cmi test/stringmatch_test.cmj test/submodule.cmi test/submodule.cmj test/submodule_call.cmi test/submodule_call.cmj test/switch_case_test.cmi test/switch_case_test.cmj test/switch_string.cmi test/switch_string.cmj test/tailcall_inline_test.cmi test/tailcall_inline_test.cmj test/template.cmi test/template.cmj test/test.cmi test/test.cmj test/test2.cmi test/test2.cmj test/test_alias.cmi test/test_alias.cmj test/test_ari.cmi test/test_ari.cmj test/test_array.cmi test/test_array.cmj test/test_array_append.cmi test/test_array_append.cmj test/test_array_primitive.cmi test/test_array_primitive.cmj test/test_bool_equal.cmi test/test_bool_equal.cmj test/test_bs_this.cmi test/test_bs_this.cmj test/test_bug.cmi test/test_bug.cmj test/test_bytes.cmi test/test_bytes.cmj test/test_case_opt_collision.cmi test/test_case_opt_collision.cmj test/test_case_set.cmi test/test_case_set.cmj test/test_char.cmi test/test_char.cmj test/test_closure.cmi test/test_closure.cmj test/test_common.cmi test/test_common.cmj test/test_const_elim.cmi test/test_const_elim.cmj test/test_const_propogate.cmi test/test_const_propogate.cmj test/test_cpp.cmi test/test_cpp.cmj test/test_cps.cmi test/test_cps.cmj test/test_demo.cmi test/test_demo.cmj test/test_dup_param.cmi test/test_dup_param.cmj test/test_eq.cmi test/test_eq.cmj test/test_exception.cmi test/test_exception.cmj test/test_exception_escape.cmi test/test_exception_escape.cmj test/test_export2.cmi test/test_export2.cmj test/test_external.cmi test/test_external.cmj test/test_external_unit.cmi test/test_external_unit.cmj test/test_ffi.cmi test/test_ffi.cmj test/test_fib.cmi test/test_fib.cmj test/test_filename.cmi test/test_filename.cmj test/test_for_loop.cmi test/test_for_loop.cmj test/test_for_map.cmi test/test_for_map.cmj test/test_for_map2.cmi test/test_for_map2.cmj test/test_format.cmi test/test_format.cmj test/test_formatter.cmi test/test_formatter.cmj test/test_functor_dead_code.cmi test/test_functor_dead_code.cmj test/test_generative_module.cmi test/test_generative_module.cmj test/test_global_print.cmi test/test_global_print.cmj test/test_google_closure.cmi test/test_google_closure.cmj test/test_include.cmi test/test_include.cmj test/test_incomplete.cmi test/test_incomplete.cmj test/test_incr_ref.cmi test/test_incr_ref.cmj test/test_int_map_find.cmi test/test_int_map_find.cmj test/test_internalOO.cmi test/test_internalOO.cmj test/test_is_js.cmi test/test_is_js.cmj test/test_js_ffi.cmi test/test_js_ffi.cmj test/test_let.cmi test/test_let.cmj test/test_list.cmi test/test_list.cmj test/test_literal.cmi test/test_literal.cmj test/test_literals.cmi test/test_literals.cmj test/test_match_exception.cmi test/test_match_exception.cmj test/test_mutliple.cmi test/test_mutliple.cmj test/test_nat64.cmi test/test_nat64.cmj test/test_nested_let.cmi test/test_nested_let.cmj test/test_nested_print.cmi test/test_nested_print.cmj test/test_non_export.cmi test/test_non_export.cmj test/test_nullary.cmi test/test_nullary.cmj test/test_obj.cmi test/test_obj.cmj test/test_order.cmi test/test_order.cmj test/test_order_tailcall.cmi test/test_order_tailcall.cmj test/test_other_exn.cmi test/test_other_exn.cmj test/test_pack.cmi test/test_pack.cmj test/test_per.cmi test/test_per.cmj test/test_pervasive.cmi test/test_pervasive.cmj test/test_pervasives2.cmi test/test_pervasives2.cmj test/test_pervasives3.cmi test/test_pervasives3.cmj test/test_primitive.cmi test/test_primitive.cmj test/test_ramification.cmi test/test_ramification.cmj test/test_react.cmi test/test_react.cmj test/test_react_case.cmi test/test_react_case.cmj test/test_regex.cmi test/test_regex.cmj test/test_require.cmi test/test_require.cmj test/test_runtime_encoding.cmi test/test_runtime_encoding.cmj test/test_scope.cmi test/test_scope.cmj test/test_seq.cmi test/test_seq.cmj test/test_set.cmi test/test_set.cmj test/test_side_effect_functor.cmi test/test_side_effect_functor.cmj test/test_simple_include.cmi test/test_simple_include.cmj test/test_simple_pattern_match.cmi test/test_simple_pattern_match.cmj test/test_simple_ref.cmi test/test_simple_ref.cmj test/test_simple_tailcall.cmi test/test_simple_tailcall.cmj test/test_small.cmi test/test_small.cmj test/test_sprintf.cmi test/test_sprintf.cmj test/test_stack.cmi test/test_stack.cmj test/test_static_catch_ident.cmi test/test_static_catch_ident.cmj test/test_string.cmi test/test_string.cmj test/test_string_case.cmi test/test_string_case.cmj test/test_string_const.cmi test/test_string_const.cmj test/test_string_map.cmi test/test_string_map.cmj test/test_string_switch.cmi test/test_string_switch.cmj test/test_switch.cmi test/test_switch.cmj test/test_trywith.cmi test/test_trywith.cmj test/test_tuple.cmi test/test_tuple.cmj test/test_tuple_destructring.cmi test/test_tuple_destructring.cmj test/test_type_based_arity.cmi test/test_type_based_arity.cmj test/test_u.cmi test/test_u.cmj test/test_unknown.cmi test/test_unknown.cmj test/test_unsafe_cmp.cmi test/test_unsafe_cmp.cmj test/test_unsafe_obj_ffi.cmi test/test_unsafe_obj_ffi.cmj test/test_unsafe_obj_ffi_ppx.cmi test/test_unsafe_obj_ffi_ppx.cmj test/test_unsupported_primitive.cmi test/test_unsupported_primitive.cmj test/test_while_closure.cmi test/test_while_closure.cmj test/test_while_side_effect.cmi test/test_while_side_effect.cmj test/test_zero_nullable.cmi test/test_zero_nullable.cmj test/then_mangle_test.cmi test/then_mangle_test.cmj test/ticker.cmi test/ticker.cmj test/to_string_test.cmi test/to_string_test.cmj test/topsort_test.cmi test/topsort_test.cmj test/tramp_fib.cmi test/tramp_fib.cmj test/tuple_alloc.cmi test/tuple_alloc.cmj test/type_disambiguate.cmi test/type_disambiguate.cmj test/typeof_test.cmi test/typeof_test.cmj test/unboxed_attribute.cmi test/unboxed_attribute.cmj test/unboxed_attribute_test.cmi test/unboxed_attribute_test.cmj test/unboxed_crash.cmi test/unboxed_crash.cmj test/unboxed_use_case.cmi test/unboxed_use_case.cmj test/uncurried_cast.cmi test/uncurried_cast.cmj test/uncurried_default.args.cmi test/uncurried_default.args.cmj test/uncurried_pipe.cmi test/uncurried_pipe.cmj test/uncurry_external_test.cmi test/uncurry_external_test.cmj test/uncurry_glob_test.cmi test/uncurry_glob_test.cmj test/uncurry_test.cmi test/uncurry_test.cmj test/undef_regression2_test.cmi test/undef_regression2_test.cmj test/undef_regression_test.cmi test/undef_regression_test.cmj test/undefine_conditional.cmi test/undefine_conditional.cmj test/unicode_type_error.cmi test/unicode_type_error.cmj test/unit_undefined_test.cmi test/unit_undefined_test.cmj test/unitest_string.cmi test/unitest_string.cmj test/unsafe_full_apply_primitive.cmi test/unsafe_full_apply_primitive.cmj test/unsafe_ppx_test.cmi test/unsafe_ppx_test.cmj test/update_record_test.cmi test/update_record_test.cmj test/variant.cmi test/variant.cmj test/variantsMatching.cmi test/variantsMatching.cmj test/watch_test.cmi test/watch_test.cmj test/webpack_config.cmi test/webpack_config.cmj From 18abaf8d5d24cc6b21b628bea4809490f5d474f2 Mon Sep 17 00:00:00 2001 From: Woonki Moon Date: Fri, 21 Apr 2023 03:11:23 +0900 Subject: [PATCH 06/14] add comments, using labeled argument --- jscomp/core/js_implementation.ml | 2 +- jscomp/core/lam_compile.ml | 158 +++++++++++++-------------- jscomp/core/lam_compile.mli | 4 +- jscomp/core/lam_compile_main.ml | 12 +- jscomp/core/lam_compile_main.mli | 2 +- jscomp/core/lam_compile_primitive.ml | 10 +- jscomp/frontend/ast_await.ml | 1 + jscomp/frontend/bs_builtin_ppx.ml | 4 +- 8 files changed, 100 insertions(+), 93 deletions(-) diff --git a/jscomp/core/js_implementation.ml b/jscomp/core/js_implementation.ml index a6f67363f1..fc36725f0c 100644 --- a/jscomp/core/js_implementation.ml +++ b/jscomp/core/js_implementation.ml @@ -164,7 +164,7 @@ let after_parsing_impl ppf outputprefix (ast : Parsetree.structure) = let lambda, exports = Translmod.transl_implementation modulename typedtree_coercion in - let js_program module_system = + let js_program ~module_system = print_if_pipe ppf Clflags.dump_rawlambda Printlambda.lambda lambda |> Lam_compile_main.compile outputprefix module_system exports in diff --git a/jscomp/core/lam_compile.ml b/jscomp/core/lam_compile.ml index 22d9a93837..0155a334c2 100644 --- a/jscomp/core/lam_compile.ml +++ b/jscomp/core/lam_compile.ml @@ -228,7 +228,7 @@ let rec compile_external_field (* Like [List.empty]*) output_prefix module_system (lamba_cxt : Lam_compile_context.t) (id : Ident.t) name : Js_output.t = match Lam_compile_env.query_external_id_info id name with | { persistent_closed_lambda = Some lam } when Lam_util.not_function lam -> - compile_lambda output_prefix module_system lamba_cxt lam + compile_lambda ~output_prefix module_system lamba_cxt lam | _ -> Js_output.output_of_expression lamba_cxt.continuation ~no_effects:no_effects_const (E.ml_var_dot id name) @@ -273,7 +273,7 @@ and compile_external_field_apply output_prefix module_system (appinfo : Lam.appl let _, param_map = Lam_closure.is_closed_with_map Set_ident.empty params body in - compile_lambda output_prefix module_system lambda_cxt + compile_lambda ~output_prefix module_system lambda_cxt (Lam_beta_reduce.propagate_beta_reduce_with_map lambda_cxt.meta param_map params body ap_args) | _ -> @@ -283,7 +283,7 @@ and compile_external_field_apply output_prefix module_system (appinfo : Lam.appl else let arg_cxt = { lambda_cxt with continuation = NeedValue Not_tail } in Ext_list.fold_right ap_args dummy (fun arg_lambda (args_code, args) -> - match compile_lambda output_prefix module_system arg_cxt arg_lambda with + match compile_lambda ~output_prefix module_system arg_cxt arg_lambda with | { block; value = Some b } -> (Ext_list.append block args_code, b :: args) | _ -> assert false) @@ -312,7 +312,7 @@ and compile_external_field_apply output_prefix module_system (appinfo : Lam.appl here we share env *) -and compile_recursive_let output_prefix module_system ~all_bindings (cxt : Lam_compile_context.t) +and compile_recursive_let ~output_prefix module_system ~all_bindings (cxt : Lam_compile_context.t) (id : Ident.t) (arg : Lam.t) : Js_output.t * initialization = match arg with | Lfunction { params; body; attr = { return_unit; async; oneUnitArg } } -> @@ -336,7 +336,7 @@ and compile_recursive_let output_prefix module_system ~all_bindings (cxt : Lam_c in let output = compile_lambda - output_prefix + ~output_prefix module_system { cxt with @@ -377,7 +377,7 @@ and compile_recursive_let output_prefix module_system ~all_bindings (cxt : Lam_c [] ) | Lprim { primitive = Pmakeblock (_, _, _); args } when args_either_function_or_const args -> - (compile_lambda output_prefix module_system { cxt with continuation = Declare (Alias, id) } arg, []) + (compile_lambda ~output_prefix module_system { cxt with continuation = Declare (Alias, id) } arg, []) (* case of lazy blocks, treat it as usual *) | Lprim { @@ -435,7 +435,7 @@ and compile_recursive_let output_prefix module_system ~all_bindings (cxt : Lam_c however it would affect scope issues, we have to declare it first *) match - compile_lambda output_prefix module_system { cxt with continuation = NeedValue Not_tail } arg + compile_lambda ~output_prefix module_system { cxt with continuation = NeedValue Not_tail } arg with | { block = b; value = Some v } -> (* TODO: check recursive value .. @@ -472,7 +472,7 @@ and compile_recursive_let output_prefix module_system ~all_bindings (cxt : Lam_c fun _-> print_endline "hey"; v () ]} *) - (compile_lambda output_prefix module_system { cxt with continuation = Declare (Alias, id) } arg, []) + (compile_lambda ~output_prefix module_system { cxt with continuation = Declare (Alias, id) } arg, []) and compile_recursive_lets_aux output_prefix module_system cxt (id_args : Lam_scc.bindings) : Js_output.t = (* #1716 *) @@ -480,7 +480,7 @@ and compile_recursive_lets_aux output_prefix module_system cxt (id_args : Lam_sc Ext_list.fold_right id_args (Js_output.dummy, []) (fun (ident, arg) (acc, ids) -> let code, declare_ids = - compile_recursive_let output_prefix module_system ~all_bindings:id_args cxt ident arg + compile_recursive_let ~output_prefix module_system ~all_bindings:id_args cxt ident arg in (Js_output.append_output code acc, Ext_list.append declare_ids ids)) in @@ -488,7 +488,7 @@ and compile_recursive_lets_aux output_prefix module_system cxt (id_args : Lam_sc | [] -> output_code | _ -> Js_output.append_output (Js_output.make ids) output_code -and compile_recursive_lets output_prefix module_system cxt id_args : Js_output.t = +and compile_recursive_lets ~output_prefix module_system cxt id_args : Js_output.t = match id_args with | [] -> Js_output.dummy | _ -> ( @@ -528,7 +528,7 @@ and compile_general_cases : J.statement) (switch_exp : J.expression) (cases : (_ * Lam.t) list) (default : default_case) -> match (cases, default) with - | [], Default lam -> Js_output.output_as_block (compile_lambda output_prefix module_system cxt lam) + | [], Default lam -> Js_output.output_as_block (compile_lambda ~output_prefix module_system cxt lam) | [], (Complete | NonComplete) -> [] | [ (_, lam) ], Complete -> (* To take advantage of such optimizations, @@ -537,19 +537,19 @@ and compile_general_cases : otherwise the compiler engine would think that it's also complete *) - Js_output.output_as_block (compile_lambda output_prefix module_system cxt lam) + Js_output.output_as_block (compile_lambda ~output_prefix module_system cxt lam) | [ (id, lam) ], NonComplete -> morph_declare_to_assign cxt (fun cxt define -> [ S.if_ ?declaration:define (eq_exp None switch_exp (Some id) (make_exp id)) - (Js_output.output_as_block (compile_lambda output_prefix module_system cxt lam)); + (Js_output.output_as_block (compile_lambda ~output_prefix module_system cxt lam)); ]) | [ (id, lam) ], Default x | [ (id, lam); (_, x) ], Complete -> morph_declare_to_assign cxt (fun cxt define -> - let else_block = Js_output.output_as_block (compile_lambda output_prefix module_system cxt x) in - let then_block = Js_output.output_as_block (compile_lambda output_prefix module_system cxt lam) in + let else_block = Js_output.output_as_block (compile_lambda ~output_prefix module_system cxt x) in + let then_block = Js_output.output_as_block (compile_lambda ~output_prefix module_system cxt lam) in [ S.if_ ?declaration:define (eq_exp None switch_exp (Some id) (make_exp id)) @@ -580,7 +580,7 @@ and compile_general_cases : | Complete -> None | NonComplete -> None | Default lam -> - Some (Js_output.output_as_block (compile_lambda output_prefix module_system cxt lam)) + Some (Js_output.output_as_block (compile_lambda ~output_prefix module_system cxt lam)) in let make_comment i = match get_cstr_name i with | None -> None @@ -590,7 +590,7 @@ and compile_general_cases : if last then (* merge and shared *) let switch_body, should_break = - Js_output.to_break_block (compile_lambda output_prefix module_system cxt lam) + Js_output.to_break_block (compile_lambda ~output_prefix module_system cxt lam) in let should_break = if @@ -683,7 +683,7 @@ and compile_switch output_prefix module_system (switch_arg : Lam.t) (sw : Lam.la let untagged = block_cases <> [] in let compile_whole (cxt : Lam_compile_context.t) = match - compile_lambda output_prefix module_system { cxt with continuation = NeedValue Not_tail } switch_arg + compile_lambda ~output_prefix module_system { cxt with continuation = NeedValue Not_tail } switch_arg with | { value = None; _ } -> assert false | { block; value = Some e } -> ( @@ -797,7 +797,7 @@ and compile_stringswitch output_prefix module_system l cases default (lambda_cxt *) let cases = cases |> List.map (fun (s,l) -> Ast_untagged_variants.String s, l) in match - compile_lambda output_prefix module_system { lambda_cxt with continuation = NeedValue Not_tail } l + compile_lambda ~output_prefix module_system { lambda_cxt with continuation = NeedValue Not_tail } l with | { value = None } -> assert false | { block; value = Some e } -> ( @@ -846,7 +846,7 @@ and compile_staticraise output_prefix module_system i (largs : Lam.t list) | Lvar id -> Js_output.make [ S.assign bind (E.var id) ] | _ -> (* TODO: should be Assign -- Assign is an optimization *) - compile_lambda output_prefix module_system + compile_lambda ~output_prefix module_system { lambda_cxt with continuation = Assign bind } larg in @@ -903,13 +903,13 @@ and compile_staticcatch output_prefix module_system (lam : Lam.t) (lambda_cxt : } in - let lbody = compile_lambda output_prefix module_system new_cxt body in + let lbody = compile_lambda ~output_prefix module_system new_cxt body in let declares = Ext_list.map code_table.bindings (fun x -> S.declare_variable ~kind:Variable x) in Js_output.append_output (Js_output.make declares) - (Js_output.append_output lbody (compile_lambda output_prefix module_system lambda_cxt handler)) + (Js_output.append_output lbody (compile_lambda ~output_prefix module_system lambda_cxt handler)) | _ -> ( let exit_expr = E.var exit_id in let jmp_table, handlers = @@ -931,7 +931,7 @@ and compile_staticcatch output_prefix module_system (lam : Lam.t) (lambda_cxt : let new_cxt = { lambda_cxt with jmp_table; continuation = Assign v } in - let lbody = compile_lambda output_prefix module_system new_cxt body in + let lbody = compile_lambda ~output_prefix module_system new_cxt body in Js_output.append_output (Js_output.make (S.declare_variable ~kind:Variable v :: declares)) (Js_output.append_output lbody @@ -944,7 +944,7 @@ and compile_staticcatch output_prefix module_system (lam : Lam.t) (lambda_cxt : let new_cxt = { lambda_cxt with jmp_table; continuation = Assign id } in - let lbody = compile_lambda output_prefix module_system new_cxt body in + let lbody = compile_lambda ~output_prefix module_system new_cxt body in Js_output.append_output (Js_output.make declares) (Js_output.append_output lbody (Js_output.make @@ -960,7 +960,7 @@ and compile_staticcatch output_prefix module_system (lam : Lam.t) (lambda_cxt : else EffectCall new_tail_type in let new_cxt = { lambda_cxt with jmp_table; continuation } in - let lbody = compile_lambda output_prefix module_system new_cxt body in + let lbody = compile_lambda ~output_prefix module_system new_cxt body in Js_output.append_output (Js_output.make declares) (Js_output.append_output lbody (Js_output.make @@ -968,7 +968,7 @@ and compile_staticcatch output_prefix module_system (lam : Lam.t) (lambda_cxt : (fun _ -> None)))) | Assign _ -> let new_cxt = { lambda_cxt with jmp_table } in - let lbody = compile_lambda output_prefix module_system new_cxt body in + let lbody = compile_lambda ~output_prefix module_system new_cxt body in Js_output.append_output (Js_output.make declares) (Js_output.append_output lbody (Js_output.make @@ -978,13 +978,13 @@ and compile_staticcatch output_prefix module_system (lam : Lam.t) (lambda_cxt : and compile_sequand output_prefix module_system (l : Lam.t) (r : Lam.t) (lambda_cxt : Lam_compile_context.t) = if Lam_compile_context.continuation_is_return lambda_cxt.continuation then - compile_lambda output_prefix module_system lambda_cxt (Lam.sequand l r) + compile_lambda ~output_prefix module_system lambda_cxt (Lam.sequand l r) else let new_cxt = { lambda_cxt with continuation = NeedValue Not_tail } in - match compile_lambda output_prefix module_system new_cxt l with + match compile_lambda ~output_prefix module_system new_cxt l with | { value = None } -> assert false | { block = l_block; value = Some l_expr } -> ( - match compile_lambda output_prefix module_system new_cxt r with + match compile_lambda ~output_prefix module_system new_cxt r with | { value = None } -> assert false | { block = []; value = Some r_expr } -> Js_output.output_of_block_and_expression lambda_cxt.continuation @@ -1018,13 +1018,13 @@ and compile_sequand output_prefix module_system (l : Lam.t) (r : Lam.t) (lambda_ and compile_sequor output_prefix module_system (l : Lam.t) (r : Lam.t) (lambda_cxt : Lam_compile_context.t) = if Lam_compile_context.continuation_is_return lambda_cxt.continuation then - compile_lambda output_prefix module_system lambda_cxt (Lam.sequor l r) + compile_lambda ~output_prefix module_system lambda_cxt (Lam.sequor l r) else let new_cxt = { lambda_cxt with continuation = NeedValue Not_tail } in - match compile_lambda output_prefix module_system new_cxt l with + match compile_lambda ~output_prefix module_system new_cxt l with | { value = None } -> assert false | { block = l_block; value = Some l_expr } -> ( - match compile_lambda output_prefix module_system new_cxt r with + match compile_lambda ~output_prefix module_system new_cxt r with | { value = None } -> assert false | { block = []; value = Some r_expr } -> let exp = E.or_ l_expr r_expr in @@ -1066,7 +1066,7 @@ and compile_sequor output_prefix module_system (l : Lam.t) (r : Lam.t) (lambda_c and compile_while output_prefix module_system (predicate : Lam.t) (body : Lam.t) (lambda_cxt : Lam_compile_context.t) = match - compile_lambda output_prefix module_system + compile_lambda ~output_prefix module_system { lambda_cxt with continuation = NeedValue Not_tail } predicate with @@ -1078,7 +1078,7 @@ and compile_while output_prefix module_system (predicate : Lam.t) (body : Lam.t) [ S.while_ e (Js_output.output_as_block - @@ compile_lambda output_prefix module_system + @@ compile_lambda ~output_prefix module_system { lambda_cxt with continuation = EffectCall Not_tail } body); ] @@ -1103,7 +1103,7 @@ and compile_for output_prefix module_system (id : J.for_ident) (start : Lam.t) ( (lambda_cxt : Lam_compile_context.t) = let new_cxt = { lambda_cxt with continuation = NeedValue Not_tail } in let block = - match (compile_lambda output_prefix module_system new_cxt start, compile_lambda output_prefix module_system new_cxt finish) with + match (compile_lambda ~output_prefix module_system new_cxt start, compile_lambda ~output_prefix module_system new_cxt finish) with | { value = None }, _ | _, { value = None } -> assert false | { block = b1; value = Some e1 }, { block = b2; value = Some e2 } -> ( (* order b1 -- (e1 -- b2 -- e2) @@ -1116,7 +1116,7 @@ and compile_for output_prefix module_system (id : J.for_ident) (start : Lam.t) ( *) let block_body = Js_output.output_as_block - (compile_lambda output_prefix module_system + (compile_lambda ~output_prefix module_system { lambda_cxt with continuation = EffectCall Not_tail } body) in @@ -1150,7 +1150,7 @@ and compile_assign output_prefix module_system id (lambda : Lam.t) (lambda_cxt : [ S.exp (E.assign (E.var id) (E.int32_add (E.var id) (E.small_int v))) ] | _ -> ( match - compile_lambda output_prefix module_system + compile_lambda ~output_prefix module_system { lambda_cxt with continuation = NeedValue Not_tail } lambda with @@ -1180,9 +1180,9 @@ and compile_trywith output_prefix module_system lam id catch (lambda_cxt : Lam_c #1701, try should prevent tailcall *) [ S.try_ - (Js_output.output_as_block (compile_lambda output_prefix module_system body_context lam)) + (Js_output.output_as_block (compile_lambda ~output_prefix module_system body_context lam)) ~with_: - (id, Js_output.output_as_block (compile_lambda output_prefix module_system with_context catch)); + (id, Js_output.output_as_block (compile_lambda ~output_prefix module_system with_context catch)); ] in match lambda_cxt.continuation with @@ -1252,7 +1252,7 @@ and compile_trywith output_prefix module_system lam id catch (lambda_cxt : Lam_c and compile_ifthenelse output_prefix module_system (predicate : Lam.t) (t_branch : Lam.t) (f_branch : Lam.t) (lambda_cxt : Lam_compile_context.t) = match - compile_lambda output_prefix module_system + compile_lambda ~output_prefix module_system { lambda_cxt with continuation = NeedValue Not_tail } predicate with @@ -1261,8 +1261,8 @@ and compile_ifthenelse output_prefix module_system (predicate : Lam.t) (t_branch match lambda_cxt.continuation with | NeedValue _ -> ( match - ( compile_lambda output_prefix module_system lambda_cxt t_branch, - compile_lambda output_prefix module_system lambda_cxt f_branch ) + ( compile_lambda ~output_prefix module_system lambda_cxt t_branch, + compile_lambda ~output_prefix module_system lambda_cxt f_branch ) with | { block = []; value = Some out1 }, { block = []; value = Some out2 } -> @@ -1274,8 +1274,8 @@ and compile_ifthenelse output_prefix module_system (predicate : Lam.t) (t_branch let id = Ext_ident.create_tmp () in let assign_cxt = { lambda_cxt with continuation = Assign id } in match - ( compile_lambda output_prefix module_system assign_cxt t_branch, - compile_lambda output_prefix module_system assign_cxt f_branch ) + ( compile_lambda ~output_prefix module_system assign_cxt t_branch, + compile_lambda ~output_prefix module_system assign_cxt f_branch ) with | out1, out2 -> Js_output.make @@ -1292,8 +1292,8 @@ and compile_ifthenelse output_prefix module_system (predicate : Lam.t) (t_branch { lambda_cxt with continuation = NeedValue Not_tail } in match - ( compile_lambda output_prefix module_system declare_cxt t_branch, - compile_lambda output_prefix module_system declare_cxt f_branch ) + ( compile_lambda ~output_prefix module_system declare_cxt t_branch, + compile_lambda ~output_prefix module_system declare_cxt f_branch ) with | { block = []; value = Some out1 }, { block = []; value = Some out2 } -> @@ -1306,20 +1306,20 @@ and compile_ifthenelse output_prefix module_system (predicate : Lam.t) (t_branch (Ext_list.append_one b (S.if_ ~declaration:(kind, id) e (Js_output.output_as_block - @@ compile_lambda output_prefix module_system + @@ compile_lambda ~output_prefix module_system { lambda_cxt with continuation = Assign id } t_branch) ~else_: (Js_output.output_as_block - @@ compile_lambda output_prefix module_system + @@ compile_lambda ~output_prefix module_system { lambda_cxt with continuation = Assign id } f_branch)))) | Assign _ -> let then_output = - Js_output.output_as_block (compile_lambda output_prefix module_system lambda_cxt t_branch) + Js_output.output_as_block (compile_lambda ~output_prefix module_system lambda_cxt t_branch) in let else_output = - Js_output.output_as_block (compile_lambda output_prefix module_system lambda_cxt f_branch) + Js_output.output_as_block (compile_lambda ~output_prefix module_system lambda_cxt f_branch) in Js_output.make (Ext_list.append_one b (S.if_ e then_output ~else_:else_output)) @@ -1329,8 +1329,8 @@ and compile_ifthenelse output_prefix module_system (predicate : Lam.t) (t_branch in match ( should_return, - compile_lambda output_prefix module_system context1 t_branch, - compile_lambda output_prefix module_system context1 f_branch ) + compile_lambda ~output_prefix module_system context1 t_branch, + compile_lambda ~output_prefix module_system context1 f_branch ) with (* see PR#83 *) | ( Not_tail, @@ -1361,7 +1361,7 @@ and compile_ifthenelse output_prefix module_system (predicate : Lam.t) (t_branch [ S.if_ (E.not e) (Js_output.output_as_block - @@ compile_lambda output_prefix module_system lambda_cxt f_branch); + @@ compile_lambda ~output_prefix module_system lambda_cxt f_branch); ]) else Js_output.make @@ -1369,10 +1369,10 @@ and compile_ifthenelse output_prefix module_system (predicate : Lam.t) (t_branch [ S.if_ e (Js_output.output_as_block - @@ compile_lambda output_prefix module_system lambda_cxt t_branch) + @@ compile_lambda ~output_prefix module_system lambda_cxt t_branch) ~else_: (Js_output.output_as_block - @@ compile_lambda output_prefix module_system lambda_cxt f_branch); + @@ compile_lambda ~output_prefix module_system lambda_cxt f_branch); ]) | Not_tail, _, { block = []; value = Some out2 } -> let else_ = @@ -1380,13 +1380,13 @@ and compile_ifthenelse output_prefix module_system (predicate : Lam.t) (t_branch else Some (Js_output.output_as_block - (compile_lambda output_prefix module_system lambda_cxt f_branch)) + (compile_lambda ~output_prefix module_system lambda_cxt f_branch)) in Js_output.make (Ext_list.append_one b (S.if_ e (Js_output.output_as_block - (compile_lambda output_prefix module_system lambda_cxt t_branch)) + (compile_lambda ~output_prefix module_system lambda_cxt t_branch)) ?else_)) | ( Maybe_tail_is_return _, { block = []; value = Some out1 }, @@ -1396,10 +1396,10 @@ and compile_ifthenelse output_prefix module_system (predicate : Lam.t) (t_branch ~output_finished:True | _, _, _ -> let then_output = - Js_output.output_as_block (compile_lambda output_prefix module_system lambda_cxt t_branch) + Js_output.output_as_block (compile_lambda ~output_prefix module_system lambda_cxt t_branch) in let else_output = - Js_output.output_as_block (compile_lambda output_prefix module_system lambda_cxt f_branch) + Js_output.output_as_block (compile_lambda ~output_prefix module_system lambda_cxt f_branch) in Js_output.make (Ext_list.append_one b (S.if_ e then_output ~else_:else_output)) @@ -1417,7 +1417,7 @@ and compile_apply output_prefix module_system (appinfo : Lam.apply) (lambda_cxt if outer_ap_info.ap_inlined = ap_inlined then outer_ap_info else { outer_ap_info with ap_inlined } in - compile_lambda output_prefix module_system lambda_cxt + compile_lambda ~output_prefix module_system lambda_cxt (Lam.apply ap_func (Ext_list.append ap_args appinfo.ap_args) ap_info) (* External function call: it can not be tailcall in this case*) | { @@ -1439,7 +1439,7 @@ and compile_apply output_prefix module_system (appinfo : Lam.apply) (lambda_cxt = Ext_list.fold_right (ap_func :: appinfo.ap_args) ([], []) (fun x (args_code, fn_code) -> - match compile_lambda output_prefix module_system new_cxt x with + match compile_lambda ~output_prefix module_system new_cxt x with | { block; value = Some b } -> (Ext_list.append block args_code, b :: fn_code) | { value = None } -> assert false) @@ -1511,7 +1511,7 @@ and compile_prim output_prefix module_system (prim_info : Lam.prim_info) | _ -> assert false) | { primitive = Praise; args = [ e ]; _ } -> ( match - compile_lambda output_prefix module_system { lambda_cxt with continuation = NeedValue Not_tail } e + compile_lambda ~output_prefix module_system { lambda_cxt with continuation = NeedValue Not_tail } e with | { block; value = Some v } -> Js_output.make @@ -1543,7 +1543,7 @@ and compile_prim output_prefix module_system (prim_info : Lam.prim_info) assert (not setter); match - compile_lambda output_prefix module_system { lambda_cxt with continuation = NeedValue Not_tail } obj + compile_lambda ~output_prefix module_system { lambda_cxt with continuation = NeedValue Not_tail } obj with | { value = None } -> assert false | { block; value = Some b } -> @@ -1572,8 +1572,8 @@ and compile_prim output_prefix module_system (prim_info : Lam.prim_info) let need_value_no_return_cxt = { lambda_cxt with continuation = NeedValue Not_tail } in - let obj_output = compile_lambda output_prefix module_system need_value_no_return_cxt obj in - let arg_output = compile_lambda output_prefix module_system need_value_no_return_cxt setter_val in + let obj_output = compile_lambda ~output_prefix module_system need_value_no_return_cxt obj in + let arg_output = compile_lambda ~output_prefix module_system need_value_no_return_cxt setter_val in let cont obj_block arg_block obj_code = Js_output.output_of_block_and_expression lambda_cxt.continuation (match obj_code with @@ -1605,7 +1605,7 @@ and compile_prim output_prefix module_system (prim_info : Lam.prim_info) *) match args with | fn :: rest -> - compile_lambda output_prefix module_system lambda_cxt + compile_lambda ~output_prefix module_system lambda_cxt (Lam.apply fn rest { ap_loc = loc; @@ -1623,7 +1623,7 @@ and compile_prim output_prefix module_system (prim_info : Lam.prim_info) here we share env *) (Js_output.output_as_block - (compile_lambda output_prefix module_system + (compile_lambda ~output_prefix module_system { lambda_cxt with continuation = @@ -1636,10 +1636,10 @@ and compile_prim output_prefix module_system (prim_info : Lam.prim_info) body))) | _ -> assert false) | { primitive = Pjs_fn_make arity; args = [ fn ]; loc } -> - compile_lambda output_prefix module_system lambda_cxt + compile_lambda ~output_prefix module_system lambda_cxt (Lam_eta_conversion.unsafe_adjust_to_arity loc ~to_:arity ?from:None fn) | { primitive = Pjs_fn_make_unit; args = [ fn ]; loc } -> - compile_lambda output_prefix module_system lambda_cxt fn + compile_lambda ~output_prefix module_system lambda_cxt fn | { primitive = Pjs_fn_make _; args = [] | _ :: _ :: _ } -> assert false | { primitive = Pjs_object_create labels; args } -> let args_block, args_expr = @@ -1647,7 +1647,7 @@ and compile_prim output_prefix module_system (prim_info : Lam.prim_info) else let new_cxt = { lambda_cxt with continuation = NeedValue Not_tail } in Ext_list.split_map args (fun x -> - match compile_lambda output_prefix module_system new_cxt x with + match compile_lambda ~output_prefix module_system new_cxt x with | { block; value = Some b } -> (block, b) | { value = None } -> assert false) in @@ -1663,7 +1663,7 @@ and compile_prim output_prefix module_system (prim_info : Lam.prim_info) else let new_cxt = { lambda_cxt with continuation = NeedValue Not_tail } in Ext_list.split_map args (fun x -> - match compile_lambda output_prefix module_system new_cxt x with + match compile_lambda ~output_prefix module_system new_cxt x with | { block; value = Some b } -> (block, b) | { value = None } -> assert false) in @@ -1675,7 +1675,7 @@ and compile_prim output_prefix module_system (prim_info : Lam.prim_info) Js_output.output_of_block_and_expression lambda_cxt.continuation args_code exp -and compile_lambda output_prefix module_system (lambda_cxt : Lam_compile_context.t) (cur_lam : Lam.t) : +and compile_lambda ~output_prefix module_system (lambda_cxt : Lam_compile_context.t) (cur_lam : Lam.t) : Js_output.t = match cur_lam with | Lfunction { params; body; attr = { return_unit; async; oneUnitArg } } -> @@ -1686,7 +1686,7 @@ and compile_lambda output_prefix module_system (lambda_cxt : Lam_compile_context here we share env *) (Js_output.output_as_block - (compile_lambda output_prefix module_system + (compile_lambda ~output_prefix module_system { lambda_cxt with continuation = @@ -1701,11 +1701,11 @@ and compile_lambda output_prefix module_system (lambda_cxt : Lam_compile_context | Llet (let_kind, id, arg, body) -> (* Order matters.. see comment below in [Lletrec] *) let args_code = - compile_lambda output_prefix module_system + compile_lambda ~output_prefix module_system { lambda_cxt with continuation = Declare (let_kind, id) } arg in - Js_output.append_output args_code (compile_lambda output_prefix module_system lambda_cxt body) + Js_output.append_output args_code (compile_lambda ~output_prefix module_system lambda_cxt body) | Lletrec (id_args, body) -> (* There is a bug in our current design, it requires compile args first (register that some objects are jsidentifiers) @@ -1718,8 +1718,8 @@ and compile_lambda output_prefix module_system (lambda_cxt : Lam_compile_context 1. scan the lambda layer first, register js identifier before proceeding 2. delay the method call into javascript ast *) - let v = compile_recursive_lets output_prefix module_system lambda_cxt id_args in - Js_output.append_output v (compile_lambda output_prefix module_system lambda_cxt body) + let v = compile_recursive_lets ~output_prefix module_system lambda_cxt id_args in + Js_output.append_output v (compile_lambda ~output_prefix module_system lambda_cxt body) | Lvar id -> Js_output.output_of_expression lambda_cxt.continuation ~no_effects:no_effects_const (E.var id) @@ -1737,9 +1737,9 @@ and compile_lambda output_prefix module_system (lambda_cxt : Lam_compile_context | Lprim prim_info -> compile_prim output_prefix module_system prim_info lambda_cxt | Lsequence (l1, l2) -> let output_l1 = - compile_lambda output_prefix module_system { lambda_cxt with continuation = EffectCall Not_tail } l1 + compile_lambda ~output_prefix module_system { lambda_cxt with continuation = EffectCall Not_tail } l1 in - let output_l2 = compile_lambda output_prefix module_system lambda_cxt l2 in + let output_l2 = compile_lambda ~output_prefix module_system lambda_cxt l2 in Js_output.append_output output_l1 output_l2 | Lifthenelse (predicate, t_branch, f_branch) -> compile_ifthenelse output_prefix module_system predicate t_branch f_branch lambda_cxt diff --git a/jscomp/core/lam_compile.mli b/jscomp/core/lam_compile.mli index a2f4ca0cb2..881a23a85d 100644 --- a/jscomp/core/lam_compile.mli +++ b/jscomp/core/lam_compile.mli @@ -25,6 +25,6 @@ (** Compile single lambda IR to JS IR *) val compile_recursive_lets : - string -> Js_packages_info.module_system -> Lam_compile_context.t -> (Ident.t * Lam.t) list -> Js_output.t + output_prefix:string -> Js_packages_info.module_system -> Lam_compile_context.t -> (Ident.t * Lam.t) list -> Js_output.t -val compile_lambda : string -> Js_packages_info.module_system -> Lam_compile_context.t -> Lam.t -> Js_output.t +val compile_lambda : output_prefix:string -> Js_packages_info.module_system -> Lam_compile_context.t -> Lam.t -> Js_output.t diff --git a/jscomp/core/lam_compile_main.ml b/jscomp/core/lam_compile_main.ml index e1996997e6..14efd1e77a 100644 --- a/jscomp/core/lam_compile_main.ml +++ b/jscomp/core/lam_compile_main.ml @@ -60,20 +60,20 @@ let compile_group output_prefix module_system (meta : Lam_stats.t) (* let lam = Optimizer.simplify_lets [] lam in *) (* can not apply again, it's wrong USE it with care*) (* ([Js_stmt_make.comment (Gen_of_env.query_type id env )], None) ++ *) - Lam_compile.compile_lambda output_prefix module_system { continuation = Declare (kind, id); + Lam_compile.compile_lambda ~output_prefix module_system { continuation = Declare (kind, id); jmp_table = Lam_compile_context.empty_handler_map; meta } lam | Recursive id_lams -> - Lam_compile.compile_recursive_lets output_prefix module_system + Lam_compile.compile_recursive_lets ~output_prefix module_system { continuation = EffectCall Not_tail; jmp_table = Lam_compile_context.empty_handler_map; meta } id_lams | Nop lam -> (* TODO: Side effect callls, log and see statistics *) - Lam_compile.compile_lambda output_prefix module_system {continuation = EffectCall Not_tail; + Lam_compile.compile_lambda ~output_prefix module_system {continuation = EffectCall Not_tail; jmp_table = Lam_compile_context.empty_handler_map; meta } lam @@ -288,18 +288,18 @@ js let (//) = Filename.concat let lambda_as_module - (lambda_output : Js_packages_info.module_system -> J.deps_program) + (lambda_output : module_system: Js_packages_info.module_system -> J.deps_program) (output_prefix : string) : unit = let package_info = Js_packages_state.get_packages_info () in if Js_packages_info.is_empty package_info && !Js_config.js_stdout then begin - Js_dump_program.dump_deps_program ~output_prefix NodeJS (lambda_output NodeJS) stdout + Js_dump_program.dump_deps_program ~output_prefix NodeJS (lambda_output ~module_system: NodeJS) stdout end else Js_packages_info.iter package_info (fun {module_system; path; suffix} -> let output_chan chan = Js_dump_program.dump_deps_program ~output_prefix module_system - (lambda_output module_system) + (lambda_output ~module_system) chan in let basename = Ext_namespace.change_ext_ns_suffix diff --git a/jscomp/core/lam_compile_main.mli b/jscomp/core/lam_compile_main.mli index 0f6bed598d..c1cb299307 100644 --- a/jscomp/core/lam_compile_main.mli +++ b/jscomp/core/lam_compile_main.mli @@ -32,4 +32,4 @@ val compile : string -> Js_packages_info.module_system -> Ident.t list -> Lambda {!Env.get_unit_name ()} *) -val lambda_as_module : (Js_packages_info.module_system -> J.deps_program) -> string -> unit +val lambda_as_module : (module_system: Js_packages_info.module_system -> J.deps_program) -> string -> unit diff --git a/jscomp/core/lam_compile_primitive.ml b/jscomp/core/lam_compile_primitive.ml index 8fba5aa2da..1d6a513559 100644 --- a/jscomp/core/lam_compile_primitive.ml +++ b/jscomp/core/lam_compile_primitive.ml @@ -103,6 +103,8 @@ let translate output_prefix module_system loc (cxt : Lam_compile_context.t) | _ -> E.runtime_call Js_runtime_modules.option "nullable_to_opt" args ) | _ -> assert false) + (* Compile #import: The module argument for dynamic import is represented as a path, + and the module value is expressed through wrapping it with promise.then *) | Pimport -> ( match args with | [ e ] -> ( @@ -111,8 +113,8 @@ let translate output_prefix module_system loc (cxt : Lam_compile_context.t) let module_id, module_value = match module_of_expression e.expression_desc with | [ module_ ] -> module_ - | _ -> assert false - (* TODO: graceful error message here *) + | _ -> Location.raise_errorf ~loc + "Invalid argument: Dynamic import requires a module or a module value as its argument. Passing a value or local module is not allowed." in let path = @@ -123,7 +125,9 @@ let translate output_prefix module_system loc (cxt : Lam_compile_context.t) match module_value with | Some value -> wrap_then (import_of_path path) value | None -> import_of_path path) - | _ -> assert false) + | [] | _ -> + Location.raise_errorf ~loc + "Invalid argument: Dynamic import must take a single module or module value as its argument.") | Pjs_function_length -> E.function_length (Ext_list.singleton_exn args) | Pcaml_obj_length -> E.obj_length (Ext_list.singleton_exn args) | Pis_null -> E.is_null (Ext_list.singleton_exn args) diff --git a/jscomp/frontend/ast_await.ml b/jscomp/frontend/ast_await.ml index 9647a28161..d15bfd4532 100644 --- a/jscomp/frontend/ast_await.ml +++ b/jscomp/frontend/ast_await.ml @@ -6,6 +6,7 @@ let create_await_expression (e : Parsetree.expression) = in 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 open Ast_helper in diff --git a/jscomp/frontend/bs_builtin_ppx.ml b/jscomp/frontend/bs_builtin_ppx.ml index 9cfb5634d3..b47593b47a 100644 --- a/jscomp/frontend/bs_builtin_ppx.ml +++ b/jscomp/frontend/bs_builtin_ppx.ml @@ -435,6 +435,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. *) let local_module_type_name = let v = ref 0 in fun ({txt} : Longident.t Location.loc) -> @@ -505,10 +507,10 @@ let rec structure_mapper (self : mapper) (stru : Ast_structure.t) = | _ -> expand_reverse acc (structure_mapper self rest) in aux [] stru + (* Dynamic import of module transformation: module M = @res.await Belt.List *) | Pstr_module ({pmb_expr = {pmod_desc = Pmod_ident {txt; loc}; pmod_attributes} as me} as mb) - (* module M = @res.await Belt.List *) 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 From d55047992be1820f3e4b7ff92dec3ec7fc089d67 Mon Sep 17 00:00:00 2001 From: Woonki Moon Date: Sat, 22 Apr 2023 12:43:31 +0900 Subject: [PATCH 07/14] add missing loc, remove unecessary res.await attribute --- jscomp/frontend/ast_await.ml | 12 ++++++++++-- 1 file changed, 10 insertions(+), 2 deletions(-) diff --git a/jscomp/frontend/ast_await.ml b/jscomp/frontend/ast_await.ml index d15bfd4532..4e023d440d 100644 --- a/jscomp/frontend/ast_await.ml +++ b/jscomp/frontend/ast_await.ml @@ -10,12 +10,15 @@ let create_await_expression (e : Parsetree.expression) = let create_await_module_expression ~module_type_name (e : Parsetree.module_expr) = let open Ast_helper in + let remove_await_attribute = + List.filter (fun ((loc, _) : Parsetree.attribute) -> loc.txt != "res.await") + in { e with pmod_desc = Pmod_unpack (create_await_expression - (Exp.apply + (Exp.apply ~loc:e.pmod_loc (Exp.ident ~loc:e.pmod_loc { txt = Longident.Ldot (Lident "Js", "import"); @@ -24,7 +27,12 @@ let create_await_module_expression ~module_type_name (e : Parsetree.module_expr) [ ( Nolabel, Exp.constraint_ ~loc:e.pmod_loc - (Exp.pack ~loc:e.pmod_loc e) + (Exp.pack ~loc:e.pmod_loc + { + e with + pmod_attributes = + remove_await_attribute e.pmod_attributes; + }) (Typ.package ~loc:e.pmod_loc {txt = Lident module_type_name; loc = e.pmod_loc} []) ); From 738043fa775d7c662f3b87c9838195db3427a431 Mon Sep 17 00:00:00 2001 From: Woonki Moon Date: Sat, 22 Apr 2023 12:54:12 +0900 Subject: [PATCH 08/14] restoring to check async context --- jscomp/frontend/bs_builtin_ppx.ml | 17 +++-------------- 1 file changed, 3 insertions(+), 14 deletions(-) diff --git a/jscomp/frontend/bs_builtin_ppx.ml b/jscomp/frontend/bs_builtin_ppx.ml index b47593b47a..a07ded3fea 100644 --- a/jscomp/frontend/bs_builtin_ppx.ml +++ b/jscomp/frontend/bs_builtin_ppx.ml @@ -224,20 +224,9 @@ let expr_mapper ~async_context ~in_function_def (self : mapper) match Ast_attributes.has_await_payload e.pexp_attributes with | None -> result | Some _ -> - (if !async_context = false then - let isJsImport (e : Parsetree.expression) = - match e with - | { - pexp_desc = - Pexp_apply - ({pexp_desc = Pexp_ident {txt = Ldot (Lident "Js", "import")}}, _); - } -> - true - | _ -> false - in - if not (isJsImport e) then - Location.raise_errorf ~loc:e.pexp_loc - "Await on expression not in an async context"); + if !async_context = false then + Location.raise_errorf ~loc:e.pexp_loc + "Await on expression not in an async context"; Ast_await.create_await_expression result let typ_mapper (self : mapper) (typ : Parsetree.core_type) = From feeaa73e7c327f6764db17774c7c8a035be72ace Mon Sep 17 00:00:00 2001 From: Woonki Moon Date: Sat, 22 Apr 2023 13:24:20 +0900 Subject: [PATCH 09/14] better error message to understand --- jscomp/core/lam_compile_primitive.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/jscomp/core/lam_compile_primitive.ml b/jscomp/core/lam_compile_primitive.ml index 1d6a513559..1211c7d5bd 100644 --- a/jscomp/core/lam_compile_primitive.ml +++ b/jscomp/core/lam_compile_primitive.ml @@ -114,7 +114,7 @@ let translate output_prefix module_system loc (cxt : Lam_compile_context.t) match module_of_expression e.expression_desc with | [ module_ ] -> module_ | _ -> Location.raise_errorf ~loc - "Invalid argument: Dynamic import requires a module or a module value as its argument. Passing a value or local module is not allowed." + "Invalid argument: Dynamic import requires a module or module value that is a file as argument. Passing a value or local module is not allowed." in let path = From faf65be2b2db0e9565df2753b482869d56dd3e0b Mon Sep 17 00:00:00 2001 From: Woonki Moon Date: Sat, 22 Apr 2023 13:52:50 +0900 Subject: [PATCH 10/14] comment out duplicated symlinked, transitive package tests --- .../duplicated_symlinked_packages/input.js | 57 ++++++++++--------- .../transitive_pinned_dependency1/input.js | 15 ++--- .../transitive_pinned_dependency2/input.js | 15 ++--- 3 files changed, 45 insertions(+), 42 deletions(-) diff --git a/jscomp/build_tests/duplicated_symlinked_packages/input.js b/jscomp/build_tests/duplicated_symlinked_packages/input.js index ad80c4849f..c46338825a 100644 --- a/jscomp/build_tests/duplicated_symlinked_packages/input.js +++ b/jscomp/build_tests/duplicated_symlinked_packages/input.js @@ -1,33 +1,34 @@ -const fs = require('fs') -const path = require('path') -const child_process = require('child_process') -const rescript_exe = require("../../../scripts/bin_path").rescript_exe +// https://github.com/rescript-lang/rescript-compiler/pull/5703#issuecomment-1518507161 +// const fs = require('fs') +// const path = require('path') +// const child_process = require('child_process') +// const rescript_exe = require("../../../scripts/bin_path").rescript_exe -const expectedFilePath = path.join(__dirname, 'out.expected') +// const expectedFilePath = path.join(__dirname, 'out.expected') -const updateTests = process.argv[2] === 'update' +// const updateTests = process.argv[2] === 'update' -function postProcessErrorOutput (output) { - output = output.trimRight() - output = output.replace(new RegExp(__dirname, 'gi'), '.') - return output -} -child_process.execSync(`${rescript_exe} clean -with-deps`,{cwd:__dirname}) -child_process.exec(rescript_exe, {cwd: __dirname}, (err, stdout, stderr) => { - const actualErrorOutput = postProcessErrorOutput(stderr.toString()) - if (updateTests) { - fs.writeFileSync(expectedFilePath, actualErrorOutput) - } else { - const expectedErrorOutput = postProcessErrorOutput(fs.readFileSync(expectedFilePath, {encoding: 'utf-8'})) - if (expectedErrorOutput !== actualErrorOutput) { - console.error(`The old and new error output aren't the same`) - console.error('\n=== Old:') - console.error(expectedErrorOutput) - console.error('\n=== New:') - console.error(actualErrorOutput) - process.exit(1) - } - } -}) +// function postProcessErrorOutput (output) { +// output = output.trimRight() +// output = output.replace(new RegExp(__dirname, 'gi'), '.') +// return output +// } +// child_process.execSync(`${rescript_exe} clean -with-deps`,{cwd:__dirname}) +// child_process.exec(rescript_exe, {cwd: __dirname}, (err, stdout, stderr) => { +// const actualErrorOutput = postProcessErrorOutput(stderr.toString()) +// if (updateTests) { +// fs.writeFileSync(expectedFilePath, actualErrorOutput) +// } else { +// const expectedErrorOutput = postProcessErrorOutput(fs.readFileSync(expectedFilePath, {encoding: 'utf-8'})) +// if (expectedErrorOutput !== actualErrorOutput) { +// console.error(`The old and new error output aren't the same`) +// console.error('\n=== Old:') +// console.error(expectedErrorOutput) +// console.error('\n=== New:') +// console.error(actualErrorOutput) +// process.exit(1) +// } +// } +// }) diff --git a/jscomp/build_tests/transitive_pinned_dependency1/input.js b/jscomp/build_tests/transitive_pinned_dependency1/input.js index 841f52ddcf..6c3d790704 100644 --- a/jscomp/build_tests/transitive_pinned_dependency1/input.js +++ b/jscomp/build_tests/transitive_pinned_dependency1/input.js @@ -1,9 +1,10 @@ -//@ts-check -var child_process = require("child_process"); -var assert = require("assert"); -var fs = require("fs") -var rescript_exe = require("../../../scripts/bin_path").rescript_exe; +// https://github.com/rescript-lang/rescript-compiler/pull/5703#issuecomment-1518507161 +// //@ts-check +// var child_process = require("child_process"); +// var assert = require("assert"); +// var fs = require("fs") +// var rescript_exe = require("../../../scripts/bin_path").rescript_exe; -console.log(child_process.execSync(rescript_exe, { encoding: "utf8", cwd: "./a" })); +// console.log(child_process.execSync(rescript_exe, { encoding: "utf8", cwd: "./a" })); -assert(fs.existsSync("./node_modules/c/lib/js/tests/test.mjs"), "dev files of module 'c' were not built by 'a' even though 'c' is a transitive pinned dependency of 'a' through 'b'") +// assert(fs.existsSync("./node_modules/c/lib/js/tests/test.mjs"), "dev files of module 'c' were not built by 'a' even though 'c' is a transitive pinned dependency of 'a' through 'b'") diff --git a/jscomp/build_tests/transitive_pinned_dependency2/input.js b/jscomp/build_tests/transitive_pinned_dependency2/input.js index 2ed725e214..6ec7c8a5c3 100644 --- a/jscomp/build_tests/transitive_pinned_dependency2/input.js +++ b/jscomp/build_tests/transitive_pinned_dependency2/input.js @@ -1,9 +1,10 @@ -//@ts-check -var child_process = require("child_process"); -var assert = require("assert"); -var fs = require("fs") -var rescript_exe = require("../../../scripts/bin_path").rescript_exe; +// https://github.com/rescript-lang/rescript-compiler/pull/5703#issuecomment-1518507161 +// //@ts-check +// var child_process = require("child_process"); +// var assert = require("assert"); +// var fs = require("fs") +// var rescript_exe = require("../../../scripts/bin_path").rescript_exe; -console.log(child_process.execSync(rescript_exe, { encoding: "utf8", cwd: "./a" })); +// console.log(child_process.execSync(rescript_exe, { encoding: "utf8", cwd: "./a" })); -assert(!fs.existsSync("./node_modules/c/lib/js/tests/test.mjs"), "dev files of module 'c' were built by 'a' even though 'c' is not a pinned dependency of 'a'") +// assert(!fs.existsSync("./node_modules/c/lib/js/tests/test.mjs"), "dev files of module 'c' were built by 'a' even though 'c' is not a pinned dependency of 'a'") From b5aec264b583c0601e09ab12d4997286493fa1fa Mon Sep 17 00:00:00 2001 From: woonki Date: Sun, 23 Apr 2023 13:38:43 +0900 Subject: [PATCH 11/14] eager evaluate js_program (#6191) --- .../duplicated_symlinked_packages/input.js | 57 +++++++++---------- .../transitive_pinned_dependency1/input.js | 15 +++-- .../transitive_pinned_dependency2/input.js | 15 +++-- jscomp/core/js_implementation.ml | 4 +- jscomp/core/lam_compile_main.ml | 6 +- jscomp/core/lam_compile_main.mli | 2 +- jscomp/test/Import.js | 1 + 7 files changed, 49 insertions(+), 51 deletions(-) diff --git a/jscomp/build_tests/duplicated_symlinked_packages/input.js b/jscomp/build_tests/duplicated_symlinked_packages/input.js index c46338825a..ad80c4849f 100644 --- a/jscomp/build_tests/duplicated_symlinked_packages/input.js +++ b/jscomp/build_tests/duplicated_symlinked_packages/input.js @@ -1,34 +1,33 @@ -// https://github.com/rescript-lang/rescript-compiler/pull/5703#issuecomment-1518507161 -// const fs = require('fs') -// const path = require('path') -// const child_process = require('child_process') -// const rescript_exe = require("../../../scripts/bin_path").rescript_exe +const fs = require('fs') +const path = require('path') +const child_process = require('child_process') +const rescript_exe = require("../../../scripts/bin_path").rescript_exe -// const expectedFilePath = path.join(__dirname, 'out.expected') +const expectedFilePath = path.join(__dirname, 'out.expected') -// const updateTests = process.argv[2] === 'update' +const updateTests = process.argv[2] === 'update' -// function postProcessErrorOutput (output) { -// output = output.trimRight() -// output = output.replace(new RegExp(__dirname, 'gi'), '.') -// return output -// } -// child_process.execSync(`${rescript_exe} clean -with-deps`,{cwd:__dirname}) -// child_process.exec(rescript_exe, {cwd: __dirname}, (err, stdout, stderr) => { -// const actualErrorOutput = postProcessErrorOutput(stderr.toString()) -// if (updateTests) { -// fs.writeFileSync(expectedFilePath, actualErrorOutput) -// } else { -// const expectedErrorOutput = postProcessErrorOutput(fs.readFileSync(expectedFilePath, {encoding: 'utf-8'})) -// if (expectedErrorOutput !== actualErrorOutput) { -// console.error(`The old and new error output aren't the same`) -// console.error('\n=== Old:') -// console.error(expectedErrorOutput) -// console.error('\n=== New:') -// console.error(actualErrorOutput) -// process.exit(1) -// } -// } -// }) +function postProcessErrorOutput (output) { + output = output.trimRight() + output = output.replace(new RegExp(__dirname, 'gi'), '.') + return output +} +child_process.execSync(`${rescript_exe} clean -with-deps`,{cwd:__dirname}) +child_process.exec(rescript_exe, {cwd: __dirname}, (err, stdout, stderr) => { + const actualErrorOutput = postProcessErrorOutput(stderr.toString()) + if (updateTests) { + fs.writeFileSync(expectedFilePath, actualErrorOutput) + } else { + const expectedErrorOutput = postProcessErrorOutput(fs.readFileSync(expectedFilePath, {encoding: 'utf-8'})) + if (expectedErrorOutput !== actualErrorOutput) { + console.error(`The old and new error output aren't the same`) + console.error('\n=== Old:') + console.error(expectedErrorOutput) + console.error('\n=== New:') + console.error(actualErrorOutput) + process.exit(1) + } + } +}) diff --git a/jscomp/build_tests/transitive_pinned_dependency1/input.js b/jscomp/build_tests/transitive_pinned_dependency1/input.js index 6c3d790704..841f52ddcf 100644 --- a/jscomp/build_tests/transitive_pinned_dependency1/input.js +++ b/jscomp/build_tests/transitive_pinned_dependency1/input.js @@ -1,10 +1,9 @@ -// https://github.com/rescript-lang/rescript-compiler/pull/5703#issuecomment-1518507161 -// //@ts-check -// var child_process = require("child_process"); -// var assert = require("assert"); -// var fs = require("fs") -// var rescript_exe = require("../../../scripts/bin_path").rescript_exe; +//@ts-check +var child_process = require("child_process"); +var assert = require("assert"); +var fs = require("fs") +var rescript_exe = require("../../../scripts/bin_path").rescript_exe; -// console.log(child_process.execSync(rescript_exe, { encoding: "utf8", cwd: "./a" })); +console.log(child_process.execSync(rescript_exe, { encoding: "utf8", cwd: "./a" })); -// assert(fs.existsSync("./node_modules/c/lib/js/tests/test.mjs"), "dev files of module 'c' were not built by 'a' even though 'c' is a transitive pinned dependency of 'a' through 'b'") +assert(fs.existsSync("./node_modules/c/lib/js/tests/test.mjs"), "dev files of module 'c' were not built by 'a' even though 'c' is a transitive pinned dependency of 'a' through 'b'") diff --git a/jscomp/build_tests/transitive_pinned_dependency2/input.js b/jscomp/build_tests/transitive_pinned_dependency2/input.js index 6ec7c8a5c3..2ed725e214 100644 --- a/jscomp/build_tests/transitive_pinned_dependency2/input.js +++ b/jscomp/build_tests/transitive_pinned_dependency2/input.js @@ -1,10 +1,9 @@ -// https://github.com/rescript-lang/rescript-compiler/pull/5703#issuecomment-1518507161 -// //@ts-check -// var child_process = require("child_process"); -// var assert = require("assert"); -// var fs = require("fs") -// var rescript_exe = require("../../../scripts/bin_path").rescript_exe; +//@ts-check +var child_process = require("child_process"); +var assert = require("assert"); +var fs = require("fs") +var rescript_exe = require("../../../scripts/bin_path").rescript_exe; -// console.log(child_process.execSync(rescript_exe, { encoding: "utf8", cwd: "./a" })); +console.log(child_process.execSync(rescript_exe, { encoding: "utf8", cwd: "./a" })); -// assert(!fs.existsSync("./node_modules/c/lib/js/tests/test.mjs"), "dev files of module 'c' were built by 'a' even though 'c' is not a pinned dependency of 'a'") +assert(!fs.existsSync("./node_modules/c/lib/js/tests/test.mjs"), "dev files of module 'c' were built by 'a' even though 'c' is not a pinned dependency of 'a'") diff --git a/jscomp/core/js_implementation.ml b/jscomp/core/js_implementation.ml index fc36725f0c..cc08a0cbd3 100644 --- a/jscomp/core/js_implementation.ml +++ b/jscomp/core/js_implementation.ml @@ -164,9 +164,9 @@ let after_parsing_impl ppf outputprefix (ast : Parsetree.structure) = let lambda, exports = Translmod.transl_implementation modulename typedtree_coercion in - let js_program ~module_system = + let js_program = print_if_pipe ppf Clflags.dump_rawlambda Printlambda.lambda lambda - |> Lam_compile_main.compile outputprefix module_system exports + |> Lam_compile_main.compile outputprefix NodeJS exports in if not !Js_config.cmj_only then Lam_compile_main.lambda_as_module js_program outputprefix); diff --git a/jscomp/core/lam_compile_main.ml b/jscomp/core/lam_compile_main.ml index 14efd1e77a..b519006447 100644 --- a/jscomp/core/lam_compile_main.ml +++ b/jscomp/core/lam_compile_main.ml @@ -288,18 +288,18 @@ js let (//) = Filename.concat let lambda_as_module - (lambda_output : module_system: Js_packages_info.module_system -> J.deps_program) + (lambda_output : J.deps_program) (output_prefix : string) : unit = let package_info = Js_packages_state.get_packages_info () in if Js_packages_info.is_empty package_info && !Js_config.js_stdout then begin - Js_dump_program.dump_deps_program ~output_prefix NodeJS (lambda_output ~module_system: NodeJS) stdout + Js_dump_program.dump_deps_program ~output_prefix NodeJS (lambda_output) stdout end else Js_packages_info.iter package_info (fun {module_system; path; suffix} -> let output_chan chan = Js_dump_program.dump_deps_program ~output_prefix module_system - (lambda_output ~module_system) + (lambda_output) chan in let basename = Ext_namespace.change_ext_ns_suffix diff --git a/jscomp/core/lam_compile_main.mli b/jscomp/core/lam_compile_main.mli index c1cb299307..ee35f02cb8 100644 --- a/jscomp/core/lam_compile_main.mli +++ b/jscomp/core/lam_compile_main.mli @@ -32,4 +32,4 @@ val compile : string -> Js_packages_info.module_system -> Ident.t list -> Lambda {!Env.get_unit_name ()} *) -val lambda_as_module : (module_system: Js_packages_info.module_system -> J.deps_program) -> string -> unit +val lambda_as_module : J.deps_program -> string -> unit diff --git a/jscomp/test/Import.js b/jscomp/test/Import.js index ab767b4f3d..e559af2e98 100644 --- a/jscomp/test/Import.js +++ b/jscomp/test/Import.js @@ -1,3 +1,4 @@ +// Generated by ReScript, PLEASE EDIT WITH CARE 'use strict'; var Curry = require("../../lib/js/curry.js"); From ae62547a649ee9df44a9e803b5e21027c4007d6b Mon Sep 17 00:00:00 2001 From: Woonki Moon Date: Sun, 23 Apr 2023 17:39:51 +0900 Subject: [PATCH 12/14] remove drilling module_system arg - get module_system inside compiling Pimport primitive --- jscomp/core/js_implementation.ml | 2 +- jscomp/core/lam_compile.ml | 265 +++++++++++++------------- jscomp/core/lam_compile.mli | 4 +- jscomp/core/lam_compile_main.ml | 11 +- jscomp/core/lam_compile_main.mli | 2 +- jscomp/core/lam_compile_primitive.ml | 17 +- jscomp/core/lam_compile_primitive.mli | 1 - 7 files changed, 154 insertions(+), 148 deletions(-) diff --git a/jscomp/core/js_implementation.ml b/jscomp/core/js_implementation.ml index cc08a0cbd3..e20cb021a3 100644 --- a/jscomp/core/js_implementation.ml +++ b/jscomp/core/js_implementation.ml @@ -166,7 +166,7 @@ let after_parsing_impl ppf outputprefix (ast : Parsetree.structure) = in let js_program = print_if_pipe ppf Clflags.dump_rawlambda Printlambda.lambda lambda - |> Lam_compile_main.compile outputprefix NodeJS exports + |> Lam_compile_main.compile outputprefix exports in if not !Js_config.cmj_only then Lam_compile_main.lambda_as_module js_program outputprefix); diff --git a/jscomp/core/lam_compile.ml b/jscomp/core/lam_compile.ml index 0155a334c2..d6fc324b83 100644 --- a/jscomp/core/lam_compile.ml +++ b/jscomp/core/lam_compile.ml @@ -225,10 +225,10 @@ type initialization = J.block non-toplevel, it will explode code very quickly *) let rec compile_external_field (* Like [List.empty]*) - output_prefix module_system (lamba_cxt : Lam_compile_context.t) (id : Ident.t) name : Js_output.t = + output_prefix (lamba_cxt : Lam_compile_context.t) (id : Ident.t) name : Js_output.t = match Lam_compile_env.query_external_id_info id name with | { persistent_closed_lambda = Some lam } when Lam_util.not_function lam -> - compile_lambda ~output_prefix module_system lamba_cxt lam + compile_lambda ~output_prefix lamba_cxt lam | _ -> Js_output.output_of_expression lamba_cxt.continuation ~no_effects:no_effects_const (E.ml_var_dot id name) @@ -260,7 +260,7 @@ let rec compile_external_field (* Like [List.empty]*) for the function, generative module or functor can be a function, however it can not be global -- global can only module *) -and compile_external_field_apply output_prefix module_system (appinfo : Lam.apply) (module_id : Ident.t) +and compile_external_field_apply output_prefix (appinfo : Lam.apply) (module_id : Ident.t) (field_name : string) (lambda_cxt : Lam_compile_context.t) : Js_output.t = let ident_info = Lam_compile_env.query_external_id_info module_id field_name @@ -273,7 +273,7 @@ and compile_external_field_apply output_prefix module_system (appinfo : Lam.appl let _, param_map = Lam_closure.is_closed_with_map Set_ident.empty params body in - compile_lambda ~output_prefix module_system lambda_cxt + compile_lambda ~output_prefix lambda_cxt (Lam_beta_reduce.propagate_beta_reduce_with_map lambda_cxt.meta param_map params body ap_args) | _ -> @@ -283,7 +283,7 @@ and compile_external_field_apply output_prefix module_system (appinfo : Lam.appl else let arg_cxt = { lambda_cxt with continuation = NeedValue Not_tail } in Ext_list.fold_right ap_args dummy (fun arg_lambda (args_code, args) -> - match compile_lambda ~output_prefix module_system arg_cxt arg_lambda with + match compile_lambda ~output_prefix arg_cxt arg_lambda with | { block; value = Some b } -> (Ext_list.append block args_code, b :: args) | _ -> assert false) @@ -312,7 +312,7 @@ and compile_external_field_apply output_prefix module_system (appinfo : Lam.appl here we share env *) -and compile_recursive_let ~output_prefix module_system ~all_bindings (cxt : Lam_compile_context.t) +and compile_recursive_let ~output_prefix ~all_bindings (cxt : Lam_compile_context.t) (id : Ident.t) (arg : Lam.t) : Js_output.t * initialization = match arg with | Lfunction { params; body; attr = { return_unit; async; oneUnitArg } } -> @@ -337,7 +337,6 @@ and compile_recursive_let ~output_prefix module_system ~all_bindings (cxt : Lam_ let output = compile_lambda ~output_prefix - module_system { cxt with continuation = @@ -377,7 +376,7 @@ and compile_recursive_let ~output_prefix module_system ~all_bindings (cxt : Lam_ [] ) | Lprim { primitive = Pmakeblock (_, _, _); args } when args_either_function_or_const args -> - (compile_lambda ~output_prefix module_system { cxt with continuation = Declare (Alias, id) } arg, []) + (compile_lambda ~output_prefix { cxt with continuation = Declare (Alias, id) } arg, []) (* case of lazy blocks, treat it as usual *) | Lprim { @@ -435,7 +434,7 @@ and compile_recursive_let ~output_prefix module_system ~all_bindings (cxt : Lam_ however it would affect scope issues, we have to declare it first *) match - compile_lambda ~output_prefix module_system { cxt with continuation = NeedValue Not_tail } arg + compile_lambda ~output_prefix { cxt with continuation = NeedValue Not_tail } arg with | { block = b; value = Some v } -> (* TODO: check recursive value .. @@ -472,15 +471,15 @@ and compile_recursive_let ~output_prefix module_system ~all_bindings (cxt : Lam_ fun _-> print_endline "hey"; v () ]} *) - (compile_lambda ~output_prefix module_system { cxt with continuation = Declare (Alias, id) } arg, []) + (compile_lambda ~output_prefix { cxt with continuation = Declare (Alias, id) } arg, []) -and compile_recursive_lets_aux output_prefix module_system cxt (id_args : Lam_scc.bindings) : Js_output.t = +and compile_recursive_lets_aux output_prefix cxt (id_args : Lam_scc.bindings) : Js_output.t = (* #1716 *) let output_code, ids = Ext_list.fold_right id_args (Js_output.dummy, []) (fun (ident, arg) (acc, ids) -> let code, declare_ids = - compile_recursive_let ~output_prefix module_system ~all_bindings:id_args cxt ident arg + compile_recursive_let ~output_prefix ~all_bindings:id_args cxt ident arg in (Js_output.append_output code acc, Ext_list.append declare_ids ids)) in @@ -488,7 +487,7 @@ and compile_recursive_lets_aux output_prefix module_system cxt (id_args : Lam_sc | [] -> output_code | _ -> Js_output.append_output (Js_output.make ids) output_code -and compile_recursive_lets ~output_prefix module_system cxt id_args : Js_output.t = +and compile_recursive_lets ~output_prefix cxt id_args : Js_output.t = match id_args with | [] -> Js_output.dummy | _ -> ( @@ -496,14 +495,13 @@ and compile_recursive_lets ~output_prefix module_system cxt id_args : Js_output. match id_args_group with | [] -> assert false | first :: rest -> - let acc = compile_recursive_lets_aux output_prefix module_system cxt first in + let acc = compile_recursive_lets_aux output_prefix cxt first in Ext_list.fold_left rest acc (fun acc x -> - Js_output.append_output acc (compile_recursive_lets_aux output_prefix module_system cxt x))) + Js_output.append_output acc (compile_recursive_lets_aux output_prefix cxt x))) and compile_general_cases : 'a . string -> - Js_packages_info.module_system -> ('a -> Ast_untagged_variants.literal option) -> ('a -> J.expression) -> ('a option -> J.expression -> 'a option -> J.expression -> J.expression) -> @@ -517,7 +515,7 @@ and compile_general_cases : ('a * Lam.t) list -> default_case -> J.block = - fun (output_prefix: string) (module_system: Js_packages_info.module_system) (get_cstr_name : _ -> Ast_untagged_variants.literal option) (make_exp : _ -> J.expression) + fun (output_prefix: string) (get_cstr_name : _ -> Ast_untagged_variants.literal option) (make_exp : _ -> J.expression) (eq_exp : 'a option -> J.expression -> 'a option -> J.expression -> J.expression) (cxt : Lam_compile_context.t) (switch : @@ -528,7 +526,7 @@ and compile_general_cases : J.statement) (switch_exp : J.expression) (cases : (_ * Lam.t) list) (default : default_case) -> match (cases, default) with - | [], Default lam -> Js_output.output_as_block (compile_lambda ~output_prefix module_system cxt lam) + | [], Default lam -> Js_output.output_as_block (compile_lambda ~output_prefix cxt lam) | [], (Complete | NonComplete) -> [] | [ (_, lam) ], Complete -> (* To take advantage of such optimizations, @@ -537,19 +535,19 @@ and compile_general_cases : otherwise the compiler engine would think that it's also complete *) - Js_output.output_as_block (compile_lambda ~output_prefix module_system cxt lam) + Js_output.output_as_block (compile_lambda ~output_prefix cxt lam) | [ (id, lam) ], NonComplete -> morph_declare_to_assign cxt (fun cxt define -> [ S.if_ ?declaration:define (eq_exp None switch_exp (Some id) (make_exp id)) - (Js_output.output_as_block (compile_lambda ~output_prefix module_system cxt lam)); + (Js_output.output_as_block (compile_lambda ~output_prefix cxt lam)); ]) | [ (id, lam) ], Default x | [ (id, lam); (_, x) ], Complete -> morph_declare_to_assign cxt (fun cxt define -> - let else_block = Js_output.output_as_block (compile_lambda ~output_prefix module_system cxt x) in - let then_block = Js_output.output_as_block (compile_lambda ~output_prefix module_system cxt lam) in + let else_block = Js_output.output_as_block (compile_lambda ~output_prefix cxt x) in + let then_block = Js_output.output_as_block (compile_lambda ~output_prefix cxt lam) in [ S.if_ ?declaration:define (eq_exp None switch_exp (Some id) (make_exp id)) @@ -580,7 +578,7 @@ and compile_general_cases : | Complete -> None | NonComplete -> None | Default lam -> - Some (Js_output.output_as_block (compile_lambda ~output_prefix module_system cxt lam)) + Some (Js_output.output_as_block (compile_lambda ~output_prefix cxt lam)) in let make_comment i = match get_cstr_name i with | None -> None @@ -590,7 +588,7 @@ and compile_general_cases : if last then (* merge and shared *) let switch_body, should_break = - Js_output.to_break_block (compile_lambda ~output_prefix module_system cxt lam) + Js_output.to_break_block (compile_lambda ~output_prefix cxt lam) in let should_break = if @@ -629,14 +627,14 @@ and use_compile_literal_cases table get_name = | Some {name; literal_type = None}, Some string_table -> Some ((String name, lam) :: string_table) | _, _ -> None ) table (Some []) -and compile_cases ?(untagged=false) output_prefix module_system cxt (switch_exp : E.t) table default get_name : initialization = +and compile_cases ?(untagged=false) output_prefix cxt (switch_exp : E.t) table default get_name : initialization = match use_compile_literal_cases table get_name with | Some string_table -> if untagged - then compile_untagged_cases output_prefix module_system cxt switch_exp string_table default - else compile_string_cases output_prefix module_system cxt switch_exp string_table default + then compile_untagged_cases output_prefix cxt switch_exp string_table default + else compile_string_cases output_prefix cxt switch_exp string_table default | None -> - compile_general_cases output_prefix module_system get_name + compile_general_cases output_prefix get_name (fun i -> match get_name i with | None -> E.small_int i | Some {literal_type = Some(String s)} -> E.str s @@ -646,7 +644,7 @@ and compile_cases ?(untagged=false) output_prefix module_system cxt (switch_exp S.int_switch ?default ?declaration e clauses) switch_exp table default -and compile_switch output_prefix module_system (switch_arg : Lam.t) (sw : Lam.lambda_switch) +and compile_switch output_prefix (switch_arg : Lam.t) (sw : Lam.lambda_switch) (lambda_cxt : Lam_compile_context.t) = (* TODO: if default is None, we can do some optimizations Use switch vs if/then/else @@ -683,16 +681,16 @@ and compile_switch output_prefix module_system (switch_arg : Lam.t) (sw : Lam.la let untagged = block_cases <> [] in let compile_whole (cxt : Lam_compile_context.t) = match - compile_lambda ~output_prefix module_system { cxt with continuation = NeedValue Not_tail } switch_arg + compile_lambda ~output_prefix { cxt with continuation = NeedValue Not_tail } switch_arg with | { value = None; _ } -> assert false | { block; value = Some e } -> ( block @ if sw_consts_full && sw_consts = [] then - compile_cases ~untagged output_prefix module_system cxt (if untagged then e else E.tag ~name:tag_name e) sw_blocks sw_blocks_default get_block_name + compile_cases ~untagged output_prefix cxt (if untagged then e else E.tag ~name:tag_name e) sw_blocks sw_blocks_default get_block_name else if sw_blocks_full && sw_blocks = [] then - compile_cases output_prefix module_system cxt e sw_consts sw_num_default get_const_name + compile_cases output_prefix cxt e sw_consts sw_num_default get_const_name else (* [e] will be used twice *) let dispatch e = @@ -704,9 +702,9 @@ and compile_switch output_prefix module_system (switch_arg : Lam.t) (sw : Lam.la else E.is_int_tag ~has_null_undefined_other:(has_null_undefined_other sw_names) e in S.if_ is_a_literal_case - (compile_cases output_prefix module_system cxt e sw_consts sw_num_default get_const_name) + (compile_cases output_prefix cxt e sw_consts sw_num_default get_const_name) ~else_: - (compile_cases ~untagged output_prefix module_system cxt (if untagged then e else E.tag ~name:tag_name e) sw_blocks sw_blocks_default + (compile_cases ~untagged output_prefix cxt (if untagged then e else E.tag ~name:tag_name e) sw_blocks sw_blocks_default get_block_name) in match e.expression_desc with @@ -735,13 +733,12 @@ and compile_switch output_prefix module_system (switch_arg : Lam.t) (sw : Lam.la | EffectCall _ | Assign _ -> Js_output.make (compile_whole lambda_cxt) -and compile_string_cases output_prefix module_system cxt switch_exp table default : initialization = +and compile_string_cases output_prefix cxt switch_exp table default : initialization = let literal = function | literal -> E.literal literal in compile_general_cases output_prefix - module_system (fun _ -> None) literal (fun _ x _ y -> E.string_equal x y) @@ -749,7 +746,7 @@ and compile_string_cases output_prefix module_system cxt switch_exp table defaul (fun ?default ?declaration e clauses -> S.string_switch ?default ?declaration e clauses) switch_exp table default -and compile_untagged_cases output_prefix module_system cxt switch_exp table default = +and compile_untagged_cases output_prefix cxt switch_exp table default = let literal = function | literal -> E.literal literal in @@ -782,7 +779,7 @@ and compile_untagged_cases output_prefix module_system cxt switch_exp table defa | _ :: _ :: _ -> assert false (* at most 1 array case *) | _ -> S.string_switch ?default ?declaration (E.typeof e) clauses in - compile_general_cases output_prefix module_system + compile_general_cases output_prefix (fun _ -> None) literal mk_eq @@ -790,14 +787,14 @@ and compile_untagged_cases output_prefix module_system cxt switch_exp table defa body switch_exp table default -and compile_stringswitch output_prefix module_system l cases default (lambda_cxt : Lam_compile_context.t) = +and compile_stringswitch output_prefix l cases default (lambda_cxt : Lam_compile_context.t) = (* TODO might better optimization according to the number of cases Be careful: we should avoid multiple evaluation of l, The [gen] can be elimiated when number of [cases] is less than 3 *) let cases = cases |> List.map (fun (s,l) -> Ast_untagged_variants.String s, l) in match - compile_lambda ~output_prefix module_system { lambda_cxt with continuation = NeedValue Not_tail } l + compile_lambda ~output_prefix { lambda_cxt with continuation = NeedValue Not_tail } l with | { value = None } -> assert false | { block; value = Some e } -> ( @@ -812,14 +809,14 @@ and compile_stringswitch output_prefix module_system l cases default (lambda_cxt let v = Ext_ident.create_tmp () in Js_output.make (Ext_list.append block - (compile_string_cases output_prefix module_system + (compile_string_cases output_prefix { lambda_cxt with continuation = Declare (Variable, v) } e cases default)) ~value:(E.var v) | _ -> Js_output.make (Ext_list.append block - (compile_string_cases output_prefix module_system lambda_cxt e cases default))) + (compile_string_cases output_prefix lambda_cxt e cases default))) (* This should be optimized in lambda layer @@ -831,7 +828,7 @@ and compile_stringswitch output_prefix module_system l cases default (lambda_cxt default: (exit 1)) with (1) 2)) *) -and compile_staticraise output_prefix module_system i (largs : Lam.t list) +and compile_staticraise output_prefix i (largs : Lam.t list) (lambda_cxt : Lam_compile_context.t) = (* [i] is the jump table, [largs] is the arguments passed to [Lstaticcatch]*) match Lam_compile_context.find_exn lambda_cxt i with @@ -846,7 +843,7 @@ and compile_staticraise output_prefix module_system i (largs : Lam.t list) | Lvar id -> Js_output.make [ S.assign bind (E.var id) ] | _ -> (* TODO: should be Assign -- Assign is an optimization *) - compile_lambda ~output_prefix module_system + compile_lambda ~output_prefix { lambda_cxt with continuation = Assign bind } larg in @@ -881,7 +878,7 @@ and compile_staticraise output_prefix module_system i (largs : Lam.t list) ]} *) -and compile_staticcatch output_prefix module_system (lam : Lam.t) (lambda_cxt : Lam_compile_context.t) = +and compile_staticcatch output_prefix (lam : Lam.t) (lambda_cxt : Lam_compile_context.t) = let code_table, body = flatten_nested_caches lam in let exit_id = Ext_ident.create_tmp ~name:"exit" () in match (lambda_cxt.continuation, code_table) with @@ -903,13 +900,13 @@ and compile_staticcatch output_prefix module_system (lam : Lam.t) (lambda_cxt : } in - let lbody = compile_lambda ~output_prefix module_system new_cxt body in + let lbody = compile_lambda ~output_prefix new_cxt body in let declares = Ext_list.map code_table.bindings (fun x -> S.declare_variable ~kind:Variable x) in Js_output.append_output (Js_output.make declares) - (Js_output.append_output lbody (compile_lambda ~output_prefix module_system lambda_cxt handler)) + (Js_output.append_output lbody (compile_lambda ~output_prefix lambda_cxt handler)) | _ -> ( let exit_expr = E.var exit_id in let jmp_table, handlers = @@ -931,12 +928,12 @@ and compile_staticcatch output_prefix module_system (lam : Lam.t) (lambda_cxt : let new_cxt = { lambda_cxt with jmp_table; continuation = Assign v } in - let lbody = compile_lambda ~output_prefix module_system new_cxt body in + let lbody = compile_lambda ~output_prefix new_cxt body in Js_output.append_output (Js_output.make (S.declare_variable ~kind:Variable v :: declares)) (Js_output.append_output lbody (Js_output.make - (compile_cases output_prefix module_system new_cxt exit_expr handlers NonComplete + (compile_cases output_prefix new_cxt exit_expr handlers NonComplete (fun _ -> None)) ~value:(E.var v))) | Declare (kind, id) (* declare first this we will do branching*) -> @@ -944,11 +941,11 @@ and compile_staticcatch output_prefix module_system (lam : Lam.t) (lambda_cxt : let new_cxt = { lambda_cxt with jmp_table; continuation = Assign id } in - let lbody = compile_lambda ~output_prefix module_system new_cxt body in + let lbody = compile_lambda ~output_prefix new_cxt body in Js_output.append_output (Js_output.make declares) (Js_output.append_output lbody (Js_output.make - (compile_cases output_prefix module_system new_cxt exit_expr handlers NonComplete + (compile_cases output_prefix new_cxt exit_expr handlers NonComplete (fun _ -> None)))) (* place holder -- tell the compiler that we don't know if it's complete @@ -960,31 +957,31 @@ and compile_staticcatch output_prefix module_system (lam : Lam.t) (lambda_cxt : else EffectCall new_tail_type in let new_cxt = { lambda_cxt with jmp_table; continuation } in - let lbody = compile_lambda ~output_prefix module_system new_cxt body in + let lbody = compile_lambda ~output_prefix new_cxt body in Js_output.append_output (Js_output.make declares) (Js_output.append_output lbody (Js_output.make - (compile_cases output_prefix module_system new_cxt exit_expr handlers NonComplete + (compile_cases output_prefix new_cxt exit_expr handlers NonComplete (fun _ -> None)))) | Assign _ -> let new_cxt = { lambda_cxt with jmp_table } in - let lbody = compile_lambda ~output_prefix module_system new_cxt body in + let lbody = compile_lambda ~output_prefix new_cxt body in Js_output.append_output (Js_output.make declares) (Js_output.append_output lbody (Js_output.make - (compile_cases output_prefix module_system new_cxt exit_expr handlers NonComplete + (compile_cases output_prefix new_cxt exit_expr handlers NonComplete (fun _ -> None))))) -and compile_sequand output_prefix module_system (l : Lam.t) (r : Lam.t) (lambda_cxt : Lam_compile_context.t) +and compile_sequand output_prefix (l : Lam.t) (r : Lam.t) (lambda_cxt : Lam_compile_context.t) = if Lam_compile_context.continuation_is_return lambda_cxt.continuation then - compile_lambda ~output_prefix module_system lambda_cxt (Lam.sequand l r) + compile_lambda ~output_prefix lambda_cxt (Lam.sequand l r) else let new_cxt = { lambda_cxt with continuation = NeedValue Not_tail } in - match compile_lambda ~output_prefix module_system new_cxt l with + match compile_lambda ~output_prefix new_cxt l with | { value = None } -> assert false | { block = l_block; value = Some l_expr } -> ( - match compile_lambda ~output_prefix module_system new_cxt r with + match compile_lambda ~output_prefix new_cxt r with | { value = None } -> assert false | { block = []; value = Some r_expr } -> Js_output.output_of_block_and_expression lambda_cxt.continuation @@ -1015,16 +1012,16 @@ and compile_sequand output_prefix module_system (l : Lam.t) (r : Lam.t) (lambda_ @ [ S.if_ l_expr (r_block @ [ S.assign v r_expr ]) ]) ~value:(E.var v))) -and compile_sequor output_prefix module_system (l : Lam.t) (r : Lam.t) (lambda_cxt : Lam_compile_context.t) +and compile_sequor output_prefix (l : Lam.t) (r : Lam.t) (lambda_cxt : Lam_compile_context.t) = if Lam_compile_context.continuation_is_return lambda_cxt.continuation then - compile_lambda ~output_prefix module_system lambda_cxt (Lam.sequor l r) + compile_lambda ~output_prefix lambda_cxt (Lam.sequor l r) else let new_cxt = { lambda_cxt with continuation = NeedValue Not_tail } in - match compile_lambda ~output_prefix module_system new_cxt l with + match compile_lambda ~output_prefix new_cxt l with | { value = None } -> assert false | { block = l_block; value = Some l_expr } -> ( - match compile_lambda ~output_prefix module_system new_cxt r with + match compile_lambda ~output_prefix new_cxt r with | { value = None } -> assert false | { block = []; value = Some r_expr } -> let exp = E.or_ l_expr r_expr in @@ -1063,10 +1060,10 @@ and compile_sequor output_prefix module_system (l : Lam.t) (r : Lam.t) (lambda_c while expression, here we generate for statement, leave optimization later. (Sine OCaml expression can be really complex..) *) -and compile_while output_prefix module_system (predicate : Lam.t) (body : Lam.t) +and compile_while output_prefix (predicate : Lam.t) (body : Lam.t) (lambda_cxt : Lam_compile_context.t) = match - compile_lambda ~output_prefix module_system + compile_lambda ~output_prefix { lambda_cxt with continuation = NeedValue Not_tail } predicate with @@ -1078,7 +1075,7 @@ and compile_while output_prefix module_system (predicate : Lam.t) (body : Lam.t) [ S.while_ e (Js_output.output_as_block - @@ compile_lambda ~output_prefix module_system + @@ compile_lambda ~output_prefix { lambda_cxt with continuation = EffectCall Not_tail } body); ] @@ -1098,12 +1095,12 @@ and compile_while output_prefix module_system (predicate : Lam.t) (body : Lam.t) print i each time, so they are different semantics... *) -and compile_for output_prefix module_system (id : J.for_ident) (start : Lam.t) (finish : Lam.t) +and compile_for output_prefix (id : J.for_ident) (start : Lam.t) (finish : Lam.t) (direction : Js_op.direction_flag) (body : Lam.t) (lambda_cxt : Lam_compile_context.t) = let new_cxt = { lambda_cxt with continuation = NeedValue Not_tail } in let block = - match (compile_lambda ~output_prefix module_system new_cxt start, compile_lambda ~output_prefix module_system new_cxt finish) with + match (compile_lambda ~output_prefix new_cxt start, compile_lambda ~output_prefix new_cxt finish) with | { value = None }, _ | _, { value = None } -> assert false | { block = b1; value = Some e1 }, { block = b2; value = Some e2 } -> ( (* order b1 -- (e1 -- b2 -- e2) @@ -1116,7 +1113,7 @@ and compile_for output_prefix module_system (id : J.for_ident) (start : Lam.t) ( *) let block_body = Js_output.output_as_block - (compile_lambda ~output_prefix module_system + (compile_lambda ~output_prefix { lambda_cxt with continuation = EffectCall Not_tail } body) in @@ -1142,7 +1139,7 @@ and compile_for output_prefix module_system (id : J.for_ident) (start : Lam.t) ( in Js_output.output_of_block_and_expression lambda_cxt.continuation block E.unit -and compile_assign output_prefix module_system id (lambda : Lam.t) (lambda_cxt : Lam_compile_context.t) = +and compile_assign output_prefix id (lambda : Lam.t) (lambda_cxt : Lam_compile_context.t) = let block = match lambda with | Lprim { primitive = Poffsetint v; args = [ Lvar bid ] } @@ -1150,7 +1147,7 @@ and compile_assign output_prefix module_system id (lambda : Lam.t) (lambda_cxt : [ S.exp (E.assign (E.var id) (E.int32_add (E.var id) (E.small_int v))) ] | _ -> ( match - compile_lambda ~output_prefix module_system + compile_lambda ~output_prefix { lambda_cxt with continuation = NeedValue Not_tail } lambda with @@ -1173,16 +1170,16 @@ and compile_assign output_prefix module_system id (lambda : Lam.t) (lambda_cxt : } ]} *) -and compile_trywith output_prefix module_system lam id catch (lambda_cxt : Lam_compile_context.t) = +and compile_trywith output_prefix lam id catch (lambda_cxt : Lam_compile_context.t) = let aux (with_context : Lam_compile_context.t) (body_context : Lam_compile_context.t) = (* should_return is passed down #1701, try should prevent tailcall *) [ S.try_ - (Js_output.output_as_block (compile_lambda ~output_prefix module_system body_context lam)) + (Js_output.output_as_block (compile_lambda ~output_prefix body_context lam)) ~with_: - (id, Js_output.output_as_block (compile_lambda ~output_prefix module_system with_context catch)); + (id, Js_output.output_as_block (compile_lambda ~output_prefix with_context catch)); ] in match lambda_cxt.continuation with @@ -1249,10 +1246,10 @@ and compile_trywith output_prefix module_system lam id catch (lambda_cxt : Lam_c mutable initializers: (obj -> unit) list } ]} *) -and compile_ifthenelse output_prefix module_system (predicate : Lam.t) (t_branch : Lam.t) (f_branch : Lam.t) +and compile_ifthenelse output_prefix (predicate : Lam.t) (t_branch : Lam.t) (f_branch : Lam.t) (lambda_cxt : Lam_compile_context.t) = match - compile_lambda ~output_prefix module_system + compile_lambda ~output_prefix { lambda_cxt with continuation = NeedValue Not_tail } predicate with @@ -1261,8 +1258,8 @@ and compile_ifthenelse output_prefix module_system (predicate : Lam.t) (t_branch match lambda_cxt.continuation with | NeedValue _ -> ( match - ( compile_lambda ~output_prefix module_system lambda_cxt t_branch, - compile_lambda ~output_prefix module_system lambda_cxt f_branch ) + ( compile_lambda ~output_prefix lambda_cxt t_branch, + compile_lambda ~output_prefix lambda_cxt f_branch ) with | { block = []; value = Some out1 }, { block = []; value = Some out2 } -> @@ -1274,8 +1271,8 @@ and compile_ifthenelse output_prefix module_system (predicate : Lam.t) (t_branch let id = Ext_ident.create_tmp () in let assign_cxt = { lambda_cxt with continuation = Assign id } in match - ( compile_lambda ~output_prefix module_system assign_cxt t_branch, - compile_lambda ~output_prefix module_system assign_cxt f_branch ) + ( compile_lambda ~output_prefix assign_cxt t_branch, + compile_lambda ~output_prefix assign_cxt f_branch ) with | out1, out2 -> Js_output.make @@ -1292,8 +1289,8 @@ and compile_ifthenelse output_prefix module_system (predicate : Lam.t) (t_branch { lambda_cxt with continuation = NeedValue Not_tail } in match - ( compile_lambda ~output_prefix module_system declare_cxt t_branch, - compile_lambda ~output_prefix module_system declare_cxt f_branch ) + ( compile_lambda ~output_prefix declare_cxt t_branch, + compile_lambda ~output_prefix declare_cxt f_branch ) with | { block = []; value = Some out1 }, { block = []; value = Some out2 } -> @@ -1306,20 +1303,20 @@ and compile_ifthenelse output_prefix module_system (predicate : Lam.t) (t_branch (Ext_list.append_one b (S.if_ ~declaration:(kind, id) e (Js_output.output_as_block - @@ compile_lambda ~output_prefix module_system + @@ compile_lambda ~output_prefix { lambda_cxt with continuation = Assign id } t_branch) ~else_: (Js_output.output_as_block - @@ compile_lambda ~output_prefix module_system + @@ compile_lambda ~output_prefix { lambda_cxt with continuation = Assign id } f_branch)))) | Assign _ -> let then_output = - Js_output.output_as_block (compile_lambda ~output_prefix module_system lambda_cxt t_branch) + Js_output.output_as_block (compile_lambda ~output_prefix lambda_cxt t_branch) in let else_output = - Js_output.output_as_block (compile_lambda ~output_prefix module_system lambda_cxt f_branch) + Js_output.output_as_block (compile_lambda ~output_prefix lambda_cxt f_branch) in Js_output.make (Ext_list.append_one b (S.if_ e then_output ~else_:else_output)) @@ -1329,8 +1326,8 @@ and compile_ifthenelse output_prefix module_system (predicate : Lam.t) (t_branch in match ( should_return, - compile_lambda ~output_prefix module_system context1 t_branch, - compile_lambda ~output_prefix module_system context1 f_branch ) + compile_lambda ~output_prefix context1 t_branch, + compile_lambda ~output_prefix context1 f_branch ) with (* see PR#83 *) | ( Not_tail, @@ -1361,7 +1358,7 @@ and compile_ifthenelse output_prefix module_system (predicate : Lam.t) (t_branch [ S.if_ (E.not e) (Js_output.output_as_block - @@ compile_lambda ~output_prefix module_system lambda_cxt f_branch); + @@ compile_lambda ~output_prefix lambda_cxt f_branch); ]) else Js_output.make @@ -1369,10 +1366,10 @@ and compile_ifthenelse output_prefix module_system (predicate : Lam.t) (t_branch [ S.if_ e (Js_output.output_as_block - @@ compile_lambda ~output_prefix module_system lambda_cxt t_branch) + @@ compile_lambda ~output_prefix lambda_cxt t_branch) ~else_: (Js_output.output_as_block - @@ compile_lambda ~output_prefix module_system lambda_cxt f_branch); + @@ compile_lambda ~output_prefix lambda_cxt f_branch); ]) | Not_tail, _, { block = []; value = Some out2 } -> let else_ = @@ -1380,13 +1377,13 @@ and compile_ifthenelse output_prefix module_system (predicate : Lam.t) (t_branch else Some (Js_output.output_as_block - (compile_lambda ~output_prefix module_system lambda_cxt f_branch)) + (compile_lambda ~output_prefix lambda_cxt f_branch)) in Js_output.make (Ext_list.append_one b (S.if_ e (Js_output.output_as_block - (compile_lambda ~output_prefix module_system lambda_cxt t_branch)) + (compile_lambda ~output_prefix lambda_cxt t_branch)) ?else_)) | ( Maybe_tail_is_return _, { block = []; value = Some out1 }, @@ -1396,16 +1393,16 @@ and compile_ifthenelse output_prefix module_system (predicate : Lam.t) (t_branch ~output_finished:True | _, _, _ -> let then_output = - Js_output.output_as_block (compile_lambda ~output_prefix module_system lambda_cxt t_branch) + Js_output.output_as_block (compile_lambda ~output_prefix lambda_cxt t_branch) in let else_output = - Js_output.output_as_block (compile_lambda ~output_prefix module_system lambda_cxt f_branch) + Js_output.output_as_block (compile_lambda ~output_prefix lambda_cxt f_branch) in Js_output.make (Ext_list.append_one b (S.if_ e then_output ~else_:else_output)) )) -and compile_apply output_prefix module_system (appinfo : Lam.apply) (lambda_cxt : Lam_compile_context.t) = +and compile_apply output_prefix (appinfo : Lam.apply) (lambda_cxt : Lam_compile_context.t) = match appinfo with | { ap_func = @@ -1417,7 +1414,7 @@ and compile_apply output_prefix module_system (appinfo : Lam.apply) (lambda_cxt if outer_ap_info.ap_inlined = ap_inlined then outer_ap_info else { outer_ap_info with ap_inlined } in - compile_lambda ~output_prefix module_system lambda_cxt + compile_lambda ~output_prefix lambda_cxt (Lam.apply ap_func (Ext_list.append ap_args appinfo.ap_args) ap_info) (* External function call: it can not be tailcall in this case*) | { @@ -1426,7 +1423,7 @@ and compile_apply output_prefix module_system (appinfo : Lam.apply) (lambda_cxt } -> ( match fld_info with | Fld_module { name } -> - compile_external_field_apply output_prefix module_system appinfo id name lambda_cxt + compile_external_field_apply output_prefix appinfo id name lambda_cxt | _ -> assert false) | _ -> ( (* TODO: --- @@ -1439,7 +1436,7 @@ and compile_apply output_prefix module_system (appinfo : Lam.apply) (lambda_cxt = Ext_list.fold_right (ap_func :: appinfo.ap_args) ([], []) (fun x (args_code, fn_code) -> - match compile_lambda ~output_prefix module_system new_cxt x with + match compile_lambda ~output_prefix new_cxt x with | { block; value = Some b } -> (Ext_list.append block args_code, b :: fn_code) | { value = None } -> assert false) @@ -1500,18 +1497,18 @@ and compile_apply output_prefix module_system (appinfo : Lam.apply) (lambda_cxt ~info:(call_info_of_ap_status appinfo.ap_info.ap_status) fn_code args)) -and compile_prim output_prefix module_system (prim_info : Lam.prim_info) +and compile_prim output_prefix (prim_info : Lam.prim_info) (lambda_cxt : Lam_compile_context.t) = match prim_info with | { primitive = Pfield (_, fld_info); args = [ Lglobal_module id ]; _ } -> ( (* should be before Lglobal_global *) match fld_info with | Fld_module { name = field } -> - compile_external_field output_prefix module_system lambda_cxt id field + compile_external_field output_prefix lambda_cxt id field | _ -> assert false) | { primitive = Praise; args = [ e ]; _ } -> ( match - compile_lambda ~output_prefix module_system { lambda_cxt with continuation = NeedValue Not_tail } e + compile_lambda ~output_prefix { lambda_cxt with continuation = NeedValue Not_tail } e with | { block; value = Some v } -> Js_output.make @@ -1522,8 +1519,8 @@ and compile_prim output_prefix module_system (prim_info : Lam.prim_info) *) | { value = None } -> assert false) | { primitive = Psequand; args = [ l; r ]; _ } -> - compile_sequand output_prefix module_system l r lambda_cxt - | { primitive = Psequor; args = [ l; r ] } -> compile_sequor output_prefix module_system l r lambda_cxt + compile_sequand output_prefix l r lambda_cxt + | { primitive = Psequor; args = [ l; r ] } -> compile_sequor output_prefix l r lambda_cxt | { primitive = Pdebugger; _ } -> (* [%bs.debugger] guarantees that the expression does not matter TODO: make it even safer *) @@ -1543,7 +1540,7 @@ and compile_prim output_prefix module_system (prim_info : Lam.prim_info) assert (not setter); match - compile_lambda ~output_prefix module_system { lambda_cxt with continuation = NeedValue Not_tail } obj + compile_lambda ~output_prefix { lambda_cxt with continuation = NeedValue Not_tail } obj with | { value = None } -> assert false | { block; value = Some b } -> @@ -1572,8 +1569,8 @@ and compile_prim output_prefix module_system (prim_info : Lam.prim_info) let need_value_no_return_cxt = { lambda_cxt with continuation = NeedValue Not_tail } in - let obj_output = compile_lambda ~output_prefix module_system need_value_no_return_cxt obj in - let arg_output = compile_lambda ~output_prefix module_system need_value_no_return_cxt setter_val in + let obj_output = compile_lambda ~output_prefix need_value_no_return_cxt obj in + let arg_output = compile_lambda ~output_prefix need_value_no_return_cxt setter_val in let cont obj_block arg_block obj_code = Js_output.output_of_block_and_expression lambda_cxt.continuation (match obj_code with @@ -1605,7 +1602,7 @@ and compile_prim output_prefix module_system (prim_info : Lam.prim_info) *) match args with | fn :: rest -> - compile_lambda ~output_prefix module_system lambda_cxt + compile_lambda ~output_prefix lambda_cxt (Lam.apply fn rest { ap_loc = loc; @@ -1623,7 +1620,7 @@ and compile_prim output_prefix module_system (prim_info : Lam.prim_info) here we share env *) (Js_output.output_as_block - (compile_lambda ~output_prefix module_system + (compile_lambda ~output_prefix { lambda_cxt with continuation = @@ -1636,10 +1633,10 @@ and compile_prim output_prefix module_system (prim_info : Lam.prim_info) body))) | _ -> assert false) | { primitive = Pjs_fn_make arity; args = [ fn ]; loc } -> - compile_lambda ~output_prefix module_system lambda_cxt + compile_lambda ~output_prefix lambda_cxt (Lam_eta_conversion.unsafe_adjust_to_arity loc ~to_:arity ?from:None fn) | { primitive = Pjs_fn_make_unit; args = [ fn ]; loc } -> - compile_lambda ~output_prefix module_system lambda_cxt fn + compile_lambda ~output_prefix lambda_cxt fn | { primitive = Pjs_fn_make _; args = [] | _ :: _ :: _ } -> assert false | { primitive = Pjs_object_create labels; args } -> let args_block, args_expr = @@ -1647,7 +1644,7 @@ and compile_prim output_prefix module_system (prim_info : Lam.prim_info) else let new_cxt = { lambda_cxt with continuation = NeedValue Not_tail } in Ext_list.split_map args (fun x -> - match compile_lambda ~output_prefix module_system new_cxt x with + match compile_lambda ~output_prefix new_cxt x with | { block; value = Some b } -> (block, b) | { value = None } -> assert false) in @@ -1663,19 +1660,19 @@ and compile_prim output_prefix module_system (prim_info : Lam.prim_info) else let new_cxt = { lambda_cxt with continuation = NeedValue Not_tail } in Ext_list.split_map args (fun x -> - match compile_lambda ~output_prefix module_system new_cxt x with + match compile_lambda ~output_prefix new_cxt x with | { block; value = Some b } -> (block, b) | { value = None } -> assert false) in let args_code : J.block = List.concat args_block in let exp = (* TODO: all can be done in [compile_primitive] *) - Lam_compile_primitive.translate output_prefix module_system loc lambda_cxt primitive args_expr + Lam_compile_primitive.translate output_prefix loc lambda_cxt primitive args_expr in Js_output.output_of_block_and_expression lambda_cxt.continuation args_code exp -and compile_lambda ~output_prefix module_system (lambda_cxt : Lam_compile_context.t) (cur_lam : Lam.t) : +and compile_lambda ~output_prefix (lambda_cxt : Lam_compile_context.t) (cur_lam : Lam.t) : Js_output.t = match cur_lam with | Lfunction { params; body; attr = { return_unit; async; oneUnitArg } } -> @@ -1686,7 +1683,7 @@ and compile_lambda ~output_prefix module_system (lambda_cxt : Lam_compile_contex here we share env *) (Js_output.output_as_block - (compile_lambda ~output_prefix module_system + (compile_lambda ~output_prefix { lambda_cxt with continuation = @@ -1697,15 +1694,15 @@ and compile_lambda ~output_prefix module_system (lambda_cxt : Lam_compile_contex jmp_table = Lam_compile_context.empty_handler_map; } body))) - | Lapply appinfo -> compile_apply output_prefix module_system appinfo lambda_cxt + | Lapply appinfo -> compile_apply output_prefix appinfo lambda_cxt | Llet (let_kind, id, arg, body) -> (* Order matters.. see comment below in [Lletrec] *) let args_code = - compile_lambda ~output_prefix module_system + compile_lambda ~output_prefix { lambda_cxt with continuation = Declare (let_kind, id) } arg in - Js_output.append_output args_code (compile_lambda ~output_prefix module_system lambda_cxt body) + Js_output.append_output args_code (compile_lambda ~output_prefix lambda_cxt body) | Lletrec (id_args, body) -> (* There is a bug in our current design, it requires compile args first (register that some objects are jsidentifiers) @@ -1718,8 +1715,8 @@ and compile_lambda ~output_prefix module_system (lambda_cxt : Lam_compile_contex 1. scan the lambda layer first, register js identifier before proceeding 2. delay the method call into javascript ast *) - let v = compile_recursive_lets ~output_prefix module_system lambda_cxt id_args in - Js_output.append_output v (compile_lambda ~output_prefix module_system lambda_cxt body) + let v = compile_recursive_lets ~output_prefix lambda_cxt id_args in + Js_output.append_output v (compile_lambda ~output_prefix lambda_cxt body) | Lvar id -> Js_output.output_of_expression lambda_cxt.continuation ~no_effects:no_effects_const (E.var id) @@ -1734,21 +1731,21 @@ and compile_lambda ~output_prefix module_system (lambda_cxt : Lam_compile_contex *) Js_output.output_of_block_and_expression lambda_cxt.continuation [] (E.ml_module_as_var i) - | Lprim prim_info -> compile_prim output_prefix module_system prim_info lambda_cxt + | Lprim prim_info -> compile_prim output_prefix prim_info lambda_cxt | Lsequence (l1, l2) -> let output_l1 = - compile_lambda ~output_prefix module_system { lambda_cxt with continuation = EffectCall Not_tail } l1 + compile_lambda ~output_prefix { lambda_cxt with continuation = EffectCall Not_tail } l1 in - let output_l2 = compile_lambda ~output_prefix module_system lambda_cxt l2 in + let output_l2 = compile_lambda ~output_prefix lambda_cxt l2 in Js_output.append_output output_l1 output_l2 | Lifthenelse (predicate, t_branch, f_branch) -> - compile_ifthenelse output_prefix module_system predicate t_branch f_branch lambda_cxt + compile_ifthenelse output_prefix predicate t_branch f_branch lambda_cxt | Lstringswitch (l, cases, default) -> - compile_stringswitch output_prefix module_system l cases default lambda_cxt - | Lswitch (switch_arg, sw) -> compile_switch output_prefix module_system switch_arg sw lambda_cxt - | Lstaticraise (i, largs) -> compile_staticraise output_prefix module_system i largs lambda_cxt - | Lstaticcatch _ -> compile_staticcatch output_prefix module_system cur_lam lambda_cxt - | Lwhile (p, body) -> compile_while output_prefix module_system p body lambda_cxt + compile_stringswitch output_prefix l cases default lambda_cxt + | Lswitch (switch_arg, sw) -> compile_switch output_prefix switch_arg sw lambda_cxt + | Lstaticraise (i, largs) -> compile_staticraise output_prefix i largs lambda_cxt + | Lstaticcatch _ -> compile_staticcatch output_prefix cur_lam lambda_cxt + | Lwhile (p, body) -> compile_while output_prefix p body lambda_cxt | Lfor (id, start, finish, direction, body) -> ( match (direction, finish) with | ( Upto, @@ -1758,12 +1755,12 @@ and compile_lambda ~output_prefix module_system (lambda_cxt : Lam_compile_contex args = [ new_finish; Lconst (Const_int { i = 1l }) ]; } | Lprim { primitive = Poffsetint -1; args = [ new_finish ] } ) ) -> - compile_for output_prefix module_system id start new_finish Up body lambda_cxt + compile_for output_prefix id start new_finish Up body lambda_cxt | _ -> - compile_for output_prefix module_system id start finish + compile_for output_prefix id start finish (if direction = Upto then Upto else Downto) body lambda_cxt) - | Lassign (id, lambda) -> compile_assign output_prefix module_system id lambda lambda_cxt + | Lassign (id, lambda) -> compile_assign output_prefix id lambda lambda_cxt | Ltrywith (lam, id, catch) -> (* generate documentation *) - compile_trywith output_prefix module_system lam id catch lambda_cxt + compile_trywith output_prefix lam id catch lambda_cxt diff --git a/jscomp/core/lam_compile.mli b/jscomp/core/lam_compile.mli index 881a23a85d..f3d00c621a 100644 --- a/jscomp/core/lam_compile.mli +++ b/jscomp/core/lam_compile.mli @@ -25,6 +25,6 @@ (** Compile single lambda IR to JS IR *) val compile_recursive_lets : - output_prefix:string -> Js_packages_info.module_system -> Lam_compile_context.t -> (Ident.t * Lam.t) list -> Js_output.t + output_prefix:string -> Lam_compile_context.t -> (Ident.t * Lam.t) list -> Js_output.t -val compile_lambda : output_prefix:string -> Js_packages_info.module_system -> Lam_compile_context.t -> Lam.t -> Js_output.t +val compile_lambda : output_prefix:string -> Lam_compile_context.t -> Lam.t -> Js_output.t diff --git a/jscomp/core/lam_compile_main.ml b/jscomp/core/lam_compile_main.ml index b519006447..ec7153b380 100644 --- a/jscomp/core/lam_compile_main.ml +++ b/jscomp/core/lam_compile_main.ml @@ -33,7 +33,7 @@ (* module S = Js_stmt_make *) -let compile_group output_prefix module_system (meta : Lam_stats.t) +let compile_group output_prefix (meta : Lam_stats.t) (x : Lam_group.t) : Js_output.t = match x with (* @@ -60,20 +60,20 @@ let compile_group output_prefix module_system (meta : Lam_stats.t) (* let lam = Optimizer.simplify_lets [] lam in *) (* can not apply again, it's wrong USE it with care*) (* ([Js_stmt_make.comment (Gen_of_env.query_type id env )], None) ++ *) - Lam_compile.compile_lambda ~output_prefix module_system { continuation = Declare (kind, id); + Lam_compile.compile_lambda ~output_prefix { continuation = Declare (kind, id); jmp_table = Lam_compile_context.empty_handler_map; meta } lam | Recursive id_lams -> - Lam_compile.compile_recursive_lets ~output_prefix module_system + Lam_compile.compile_recursive_lets ~output_prefix { continuation = EffectCall Not_tail; jmp_table = Lam_compile_context.empty_handler_map; meta } id_lams | Nop lam -> (* TODO: Side effect callls, log and see statistics *) - Lam_compile.compile_lambda ~output_prefix module_system {continuation = EffectCall Not_tail; + Lam_compile.compile_lambda ~output_prefix {continuation = EffectCall Not_tail; jmp_table = Lam_compile_context.empty_handler_map; meta } lam @@ -123,7 +123,6 @@ let _j = Js_pass_debug.dump *) let compile (output_prefix : string) - (module_system : Js_packages_info.module_system) export_idents (lam : Lambda.lambda) = let export_ident_sets = Set_ident.of_list export_idents in @@ -223,7 +222,7 @@ let maybe_pure = no_side_effects groups in let () = Ext_log.dwarn ~__POS__ "\n@[[TIME:]Pre-compile: %f@]@." (Sys.time () *. 1000.) in #endif let body = - Ext_list.map groups (fun group -> compile_group output_prefix module_system meta group) + Ext_list.map groups (fun group -> compile_group output_prefix meta group) |> Js_output.concat |> Js_output.output_as_block in diff --git a/jscomp/core/lam_compile_main.mli b/jscomp/core/lam_compile_main.mli index ee35f02cb8..fcd298ce3a 100644 --- a/jscomp/core/lam_compile_main.mli +++ b/jscomp/core/lam_compile_main.mli @@ -27,7 +27,7 @@ (** Compile and register the hook of function to compile a lambda to JS IR *) -val compile : string -> Js_packages_info.module_system -> Ident.t list -> Lambda.lambda -> J.deps_program +val compile : string -> Ident.t list -> Lambda.lambda -> J.deps_program (** For toplevel, [filename] is [""] which is the same as {!Env.get_unit_name ()} *) diff --git a/jscomp/core/lam_compile_primitive.ml b/jscomp/core/lam_compile_primitive.ml index 1211c7d5bd..909ef29372 100644 --- a/jscomp/core/lam_compile_primitive.ml +++ b/jscomp/core/lam_compile_primitive.ml @@ -40,6 +40,17 @@ let module_of_expression = function | J.Var (J.Qualified (module_id, value)) -> [ (module_id, value) ] | _ -> [] +let get_module_system () = + let package_info = Js_packages_state.get_packages_info () in + let module_system = + if Js_packages_info.is_empty package_info && !Js_config.js_stdout then + [Js_packages_info.NodeJS] + else Js_packages_info.map package_info (fun {module_system} -> module_system) + in + match module_system with + | [module_system] -> module_system + | _ -> NodeJS + let import_of_path path = E.call ~info:{ arity = Full; call_info = Call_na } @@ -61,7 +72,7 @@ let wrap_then import value = ]; ] -let translate output_prefix module_system loc (cxt : Lam_compile_context.t) +let translate output_prefix loc (cxt : Lam_compile_context.t) (prim : Lam_primitive.t) (args : J.expression list) : J.expression = match prim with | Pis_not_none -> Js_of_lam_option.is_not_none (Ext_list.singleton_exn args) @@ -118,8 +129,8 @@ let translate output_prefix module_system loc (cxt : Lam_compile_context.t) in let path = - Js_name_of_module_id.string_of_module_id module_id ~output_dir - module_system + let module_system = get_module_system () in + Js_name_of_module_id.string_of_module_id module_id ~output_dir module_system in match module_value with diff --git a/jscomp/core/lam_compile_primitive.mli b/jscomp/core/lam_compile_primitive.mli index 937a207e47..b507f63b1c 100644 --- a/jscomp/core/lam_compile_primitive.mli +++ b/jscomp/core/lam_compile_primitive.mli @@ -30,7 +30,6 @@ val translate : string -> - Js_packages_info.module_system -> Location.t -> Lam_compile_context.t -> Lam_primitive.t -> From 6f0c22ad55040c722ee0eaa492b2fa492239a8fe Mon Sep 17 00:00:00 2001 From: woonki Date: Sun, 23 Apr 2023 17:43:27 +0900 Subject: [PATCH 13/14] Add syntax surface, module type name and tests for dynamic import (#6188) --- jscomp/frontend/bs_builtin_ppx.ml | 85 +++++++++++-------- jscomp/test/Import.js | 37 +++++++- jscomp/test/Import.res | 26 +++++- res_syntax/src/res_core.ml | 15 ++++ res_syntax/src/res_grammar.ml | 3 +- res_syntax/src/res_printer.ml | 5 ++ .../parsing/grammar/expressions/await.res | 6 +- .../expressions/expected/await.res.txt | 4 +- 8 files changed, 141 insertions(+), 40 deletions(-) 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 From 2b69527bfd5290b97f83fd3f05699c5b46b770e2 Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Sun, 23 Apr 2023 15:41:35 +0200 Subject: [PATCH 14/14] Refactor lam_compile --- jscomp/core/lam_compile.ml | 368 +++++++++++++++++++------------------ 1 file changed, 189 insertions(+), 179 deletions(-) diff --git a/jscomp/core/lam_compile.ml b/jscomp/core/lam_compile.ml index d6fc324b83..21d3f07d00 100644 --- a/jscomp/core/lam_compile.ml +++ b/jscomp/core/lam_compile.ml @@ -193,7 +193,7 @@ let has_null_undefined_other (sw_names : Ast_untagged_variants.switch_names opti let no_effects_const = lazy true (* let has_effects_const = lazy false *) -(** We drop the ability of cross-compiling +(* We drop the ability of cross-compiling the compiler has to be the same running *) @@ -224,11 +224,14 @@ type initialization = J.block -: we should not do functor application inlining in a non-toplevel, it will explode code very quickly *) + +let compile output_prefix = + let rec compile_external_field (* Like [List.empty]*) - output_prefix (lamba_cxt : Lam_compile_context.t) (id : Ident.t) name : Js_output.t = + (lamba_cxt : Lam_compile_context.t) (id : Ident.t) name : Js_output.t = match Lam_compile_env.query_external_id_info id name with | { persistent_closed_lambda = Some lam } when Lam_util.not_function lam -> - compile_lambda ~output_prefix lamba_cxt lam + compile_lambda lamba_cxt lam | _ -> Js_output.output_of_expression lamba_cxt.continuation ~no_effects:no_effects_const (E.ml_var_dot id name) @@ -249,7 +252,7 @@ let rec compile_external_field (* Like [List.empty]*) @param args arguments *) -(** This can not happen since this id should be already consulted by type checker +(* This can not happen since this id should be already consulted by type checker Worst case {[ E.array_index_by_int m pos @@ -260,7 +263,7 @@ let rec compile_external_field (* Like [List.empty]*) for the function, generative module or functor can be a function, however it can not be global -- global can only module *) -and compile_external_field_apply output_prefix (appinfo : Lam.apply) (module_id : Ident.t) +and compile_external_field_apply (appinfo : Lam.apply) (module_id : Ident.t) (field_name : string) (lambda_cxt : Lam_compile_context.t) : Js_output.t = let ident_info = Lam_compile_env.query_external_id_info module_id field_name @@ -273,7 +276,7 @@ and compile_external_field_apply output_prefix (appinfo : Lam.apply) (module_id let _, param_map = Lam_closure.is_closed_with_map Set_ident.empty params body in - compile_lambda ~output_prefix lambda_cxt + compile_lambda lambda_cxt (Lam_beta_reduce.propagate_beta_reduce_with_map lambda_cxt.meta param_map params body ap_args) | _ -> @@ -283,7 +286,7 @@ and compile_external_field_apply output_prefix (appinfo : Lam.apply) (module_id else let arg_cxt = { lambda_cxt with continuation = NeedValue Not_tail } in Ext_list.fold_right ap_args dummy (fun arg_lambda (args_code, args) -> - match compile_lambda ~output_prefix arg_cxt arg_lambda with + match compile_lambda arg_cxt arg_lambda with | { block; value = Some b } -> (Ext_list.append block args_code, b :: args) | _ -> assert false) @@ -304,7 +307,7 @@ and compile_external_field_apply output_prefix (appinfo : Lam.apply) (module_id Js_output.output_of_block_and_expression lambda_cxt.continuation args_code expression -(** +(* The second return values are values which need to be wrapped using [update_dummy] @@ -312,7 +315,7 @@ and compile_external_field_apply output_prefix (appinfo : Lam.apply) (module_id here we share env *) -and compile_recursive_let ~output_prefix ~all_bindings (cxt : Lam_compile_context.t) +and compile_recursive_let ~all_bindings (cxt : Lam_compile_context.t) (id : Ident.t) (arg : Lam.t) : Js_output.t * initialization = match arg with | Lfunction { params; body; attr = { return_unit; async; oneUnitArg } } -> @@ -336,7 +339,6 @@ and compile_recursive_let ~output_prefix ~all_bindings (cxt : Lam_compile_contex in let output = compile_lambda - ~output_prefix { cxt with continuation = @@ -376,7 +378,7 @@ and compile_recursive_let ~output_prefix ~all_bindings (cxt : Lam_compile_contex [] ) | Lprim { primitive = Pmakeblock (_, _, _); args } when args_either_function_or_const args -> - (compile_lambda ~output_prefix { cxt with continuation = Declare (Alias, id) } arg, []) + (compile_lambda { cxt with continuation = Declare (Alias, id) } arg, []) (* case of lazy blocks, treat it as usual *) | Lprim { @@ -434,7 +436,7 @@ and compile_recursive_let ~output_prefix ~all_bindings (cxt : Lam_compile_contex however it would affect scope issues, we have to declare it first *) match - compile_lambda ~output_prefix { cxt with continuation = NeedValue Not_tail } arg + compile_lambda { cxt with continuation = NeedValue Not_tail } arg with | { block = b; value = Some v } -> (* TODO: check recursive value .. @@ -471,15 +473,15 @@ and compile_recursive_let ~output_prefix ~all_bindings (cxt : Lam_compile_contex fun _-> print_endline "hey"; v () ]} *) - (compile_lambda ~output_prefix { cxt with continuation = Declare (Alias, id) } arg, []) + (compile_lambda { cxt with continuation = Declare (Alias, id) } arg, []) -and compile_recursive_lets_aux output_prefix cxt (id_args : Lam_scc.bindings) : Js_output.t = +and compile_recursive_lets_aux cxt (id_args : Lam_scc.bindings) : Js_output.t = (* #1716 *) let output_code, ids = Ext_list.fold_right id_args (Js_output.dummy, []) (fun (ident, arg) (acc, ids) -> let code, declare_ids = - compile_recursive_let ~output_prefix ~all_bindings:id_args cxt ident arg + compile_recursive_let ~all_bindings:id_args cxt ident arg in (Js_output.append_output code acc, Ext_list.append declare_ids ids)) in @@ -487,7 +489,7 @@ and compile_recursive_lets_aux output_prefix cxt (id_args : Lam_scc.bindings) : | [] -> output_code | _ -> Js_output.append_output (Js_output.make ids) output_code -and compile_recursive_lets ~output_prefix cxt id_args : Js_output.t = +and compile_recursive_lets cxt id_args : Js_output.t = match id_args with | [] -> Js_output.dummy | _ -> ( @@ -495,38 +497,37 @@ and compile_recursive_lets ~output_prefix cxt id_args : Js_output.t = match id_args_group with | [] -> assert false | first :: rest -> - let acc = compile_recursive_lets_aux output_prefix cxt first in + let acc = compile_recursive_lets_aux cxt first in Ext_list.fold_left rest acc (fun acc x -> - Js_output.append_output acc (compile_recursive_lets_aux output_prefix cxt x))) + Js_output.append_output acc (compile_recursive_lets_aux cxt x))) and compile_general_cases : 'a . - string -> - ('a -> Ast_untagged_variants.literal option) -> - ('a -> J.expression) -> - ('a option -> J.expression -> 'a option -> J.expression -> J.expression) -> - Lam_compile_context.t -> - (?default:J.block -> - ?declaration:Lam_compat.let_kind * Ident.t -> - _ -> - ('a * J.case_clause) list -> - J.statement) -> - _ -> - ('a * Lam.t) list -> - default_case -> + get_cstr_name: ('a -> Ast_untagged_variants.literal option) -> + make_exp: ('a -> J.expression) -> + eq_exp: ('a option -> J.expression -> 'a option -> J.expression -> J.expression) -> + cxt: Lam_compile_context.t -> + switch: (?default:J.block -> ?declaration:Lam_compat.let_kind * Ident.t -> + _ -> ('a * J.case_clause) list -> J.statement) -> + switch_exp: J.expression -> + cases: ('a * Lam.t) list -> + default: default_case -> J.block = - fun (output_prefix: string) (get_cstr_name : _ -> Ast_untagged_variants.literal option) (make_exp : _ -> J.expression) - (eq_exp : 'a option -> J.expression -> 'a option -> J.expression -> J.expression) - (cxt : Lam_compile_context.t) - (switch : - ?default:J.block -> - ?declaration:Lam_compat.let_kind * Ident.t -> - _ -> - (_ * J.case_clause) list -> - J.statement) (switch_exp : J.expression) (cases : (_ * Lam.t) list) - (default : default_case) -> + fun (type a) + ~(get_cstr_name : a -> Ast_untagged_variants.literal option) + ~(make_exp : a -> J.expression) + ~(eq_exp : a option -> J.expression -> a option -> J.expression -> J.expression) + ~(cxt : Lam_compile_context.t) + ~(switch : + ?default:J.block -> + ?declaration:Lam_compat.let_kind * Ident.t -> + _ -> (a * J.case_clause) list -> J.statement + ) + ~(switch_exp : J.expression) + ~(cases : (a * Lam.t) list) + ~(default : default_case) -> match (cases, default) with - | [], Default lam -> Js_output.output_as_block (compile_lambda ~output_prefix cxt lam) + | [], Default lam -> Js_output.output_as_block (compile_lambda cxt lam) | [], (Complete | NonComplete) -> [] | [ (_, lam) ], Complete -> (* To take advantage of such optimizations, @@ -535,19 +536,19 @@ and compile_general_cases : otherwise the compiler engine would think that it's also complete *) - Js_output.output_as_block (compile_lambda ~output_prefix cxt lam) + Js_output.output_as_block (compile_lambda cxt lam) | [ (id, lam) ], NonComplete -> morph_declare_to_assign cxt (fun cxt define -> [ S.if_ ?declaration:define (eq_exp None switch_exp (Some id) (make_exp id)) - (Js_output.output_as_block (compile_lambda ~output_prefix cxt lam)); + (Js_output.output_as_block (compile_lambda cxt lam)); ]) | [ (id, lam) ], Default x | [ (id, lam); (_, x) ], Complete -> morph_declare_to_assign cxt (fun cxt define -> - let else_block = Js_output.output_as_block (compile_lambda ~output_prefix cxt x) in - let then_block = Js_output.output_as_block (compile_lambda ~output_prefix cxt lam) in + let else_block = Js_output.output_as_block (compile_lambda cxt x) in + let then_block = Js_output.output_as_block (compile_lambda cxt lam) in [ S.if_ ?declaration:define (eq_exp None switch_exp (Some id) (make_exp id)) @@ -578,7 +579,7 @@ and compile_general_cases : | Complete -> None | NonComplete -> None | Default lam -> - Some (Js_output.output_as_block (compile_lambda ~output_prefix cxt lam)) + Some (Js_output.output_as_block (compile_lambda cxt lam)) in let make_comment i = match get_cstr_name i with | None -> None @@ -588,7 +589,7 @@ and compile_general_cases : if last then (* merge and shared *) let switch_body, should_break = - Js_output.to_break_block (compile_lambda ~output_prefix cxt lam) + Js_output.to_break_block (compile_lambda cxt lam) in let should_break = if @@ -627,24 +628,28 @@ and use_compile_literal_cases table get_name = | Some {name; literal_type = None}, Some string_table -> Some ((String name, lam) :: string_table) | _, _ -> None ) table (Some []) -and compile_cases ?(untagged=false) output_prefix cxt (switch_exp : E.t) table default get_name : initialization = +and compile_cases ?(untagged=false) cxt (switch_exp : E.t) table default get_name : initialization = match use_compile_literal_cases table get_name with | Some string_table -> if untagged - then compile_untagged_cases output_prefix cxt switch_exp string_table default - else compile_string_cases output_prefix cxt switch_exp string_table default + then compile_untagged_cases cxt switch_exp string_table default + else compile_string_cases cxt switch_exp string_table default | None -> - compile_general_cases output_prefix get_name - (fun i -> match get_name i with + compile_general_cases + ~get_cstr_name:get_name + ~make_exp:(fun i -> match get_name i with | None -> E.small_int i | Some {literal_type = Some(String s)} -> E.str s | Some {name} -> E.str name) - (fun _ x _ y -> E.int_equal x y) cxt - (fun ?default ?declaration e clauses -> + ~eq_exp: (fun _ x _ y -> E.int_equal x y) + ~cxt + ~switch: (fun ?default ?declaration e clauses -> S.int_switch ?default ?declaration e clauses) - switch_exp table default + ~switch_exp + ~cases:table + ~default -and compile_switch output_prefix (switch_arg : Lam.t) (sw : Lam.lambda_switch) +and compile_switch (switch_arg : Lam.t) (sw : Lam.lambda_switch) (lambda_cxt : Lam_compile_context.t) = (* TODO: if default is None, we can do some optimizations Use switch vs if/then/else @@ -681,16 +686,16 @@ and compile_switch output_prefix (switch_arg : Lam.t) (sw : Lam.lambda_switch) let untagged = block_cases <> [] in let compile_whole (cxt : Lam_compile_context.t) = match - compile_lambda ~output_prefix { cxt with continuation = NeedValue Not_tail } switch_arg + compile_lambda { cxt with continuation = NeedValue Not_tail } switch_arg with | { value = None; _ } -> assert false | { block; value = Some e } -> ( block @ if sw_consts_full && sw_consts = [] then - compile_cases ~untagged output_prefix cxt (if untagged then e else E.tag ~name:tag_name e) sw_blocks sw_blocks_default get_block_name + compile_cases ~untagged cxt (if untagged then e else E.tag ~name:tag_name e) sw_blocks sw_blocks_default get_block_name else if sw_blocks_full && sw_blocks = [] then - compile_cases output_prefix cxt e sw_consts sw_num_default get_const_name + compile_cases cxt e sw_consts sw_num_default get_const_name else (* [e] will be used twice *) let dispatch e = @@ -702,9 +707,9 @@ and compile_switch output_prefix (switch_arg : Lam.t) (sw : Lam.lambda_switch) else E.is_int_tag ~has_null_undefined_other:(has_null_undefined_other sw_names) e in S.if_ is_a_literal_case - (compile_cases output_prefix cxt e sw_consts sw_num_default get_const_name) + (compile_cases cxt e sw_consts sw_num_default get_const_name) ~else_: - (compile_cases ~untagged output_prefix cxt (if untagged then e else E.tag ~name:tag_name e) sw_blocks sw_blocks_default + (compile_cases ~untagged cxt (if untagged then e else E.tag ~name:tag_name e) sw_blocks sw_blocks_default get_block_name) in match e.expression_desc with @@ -733,23 +738,21 @@ and compile_switch output_prefix (switch_arg : Lam.t) (sw : Lam.lambda_switch) | EffectCall _ | Assign _ -> Js_output.make (compile_whole lambda_cxt) -and compile_string_cases output_prefix cxt switch_exp table default : initialization = +and compile_string_cases cxt switch_exp cases default : initialization = let literal = function | literal -> E.literal literal in compile_general_cases - output_prefix - (fun _ -> None) - literal - (fun _ x _ y -> E.string_equal x y) - cxt - (fun ?default ?declaration e clauses -> + ~get_cstr_name:(fun _ -> None) + ~make_exp:literal + ~eq_exp: (fun _ x _ y -> E.string_equal x y) + ~cxt + ~switch: (fun ?default ?declaration e clauses -> S.string_switch ?default ?declaration e clauses) - switch_exp table default -and compile_untagged_cases output_prefix cxt switch_exp table default = - let literal = function - | literal -> E.literal literal - in + ~switch_exp + ~cases + ~default +and compile_untagged_cases cxt switch_exp cases default = let add_runtime_type_check (literal: Ast_untagged_variants.literal_type) x y = match literal with | Block IntType | Block StringType @@ -768,7 +771,7 @@ and compile_untagged_cases output_prefix cxt switch_exp table default = | _ -> E.string_equal x y in let is_array (l, _) = l = Ast_untagged_variants.Block Array in - let body ?default ?declaration e clauses = + let switch ?default ?declaration e clauses = let array_clauses = Ext_list.filter clauses is_array in match array_clauses with | [(l, {J.switch_body})] when List.length clauses > 1 -> @@ -779,22 +782,24 @@ and compile_untagged_cases output_prefix cxt switch_exp table default = | _ :: _ :: _ -> assert false (* at most 1 array case *) | _ -> S.string_switch ?default ?declaration (E.typeof e) clauses in - compile_general_cases output_prefix - (fun _ -> None) - literal - mk_eq - cxt - body - switch_exp table default - -and compile_stringswitch output_prefix l cases default (lambda_cxt : Lam_compile_context.t) = + compile_general_cases + ~get_cstr_name:(fun _ -> None) + ~make_exp:E.literal + ~eq_exp: mk_eq + ~cxt + ~switch + ~switch_exp + ~cases + ~default + +and compile_stringswitch l cases default (lambda_cxt : Lam_compile_context.t) = (* TODO might better optimization according to the number of cases Be careful: we should avoid multiple evaluation of l, The [gen] can be elimiated when number of [cases] is less than 3 *) let cases = cases |> List.map (fun (s,l) -> Ast_untagged_variants.String s, l) in match - compile_lambda ~output_prefix { lambda_cxt with continuation = NeedValue Not_tail } l + compile_lambda { lambda_cxt with continuation = NeedValue Not_tail } l with | { value = None } -> assert false | { block; value = Some e } -> ( @@ -809,14 +814,14 @@ and compile_stringswitch output_prefix l cases default (lambda_cxt : Lam_compile let v = Ext_ident.create_tmp () in Js_output.make (Ext_list.append block - (compile_string_cases output_prefix + (compile_string_cases { lambda_cxt with continuation = Declare (Variable, v) } e cases default)) ~value:(E.var v) | _ -> Js_output.make (Ext_list.append block - (compile_string_cases output_prefix lambda_cxt e cases default))) + (compile_string_cases lambda_cxt e cases default))) (* This should be optimized in lambda layer @@ -828,7 +833,7 @@ and compile_stringswitch output_prefix l cases default (lambda_cxt : Lam_compile default: (exit 1)) with (1) 2)) *) -and compile_staticraise output_prefix i (largs : Lam.t list) +and compile_staticraise i (largs : Lam.t list) (lambda_cxt : Lam_compile_context.t) = (* [i] is the jump table, [largs] is the arguments passed to [Lstaticcatch]*) match Lam_compile_context.find_exn lambda_cxt i with @@ -843,7 +848,7 @@ and compile_staticraise output_prefix i (largs : Lam.t list) | Lvar id -> Js_output.make [ S.assign bind (E.var id) ] | _ -> (* TODO: should be Assign -- Assign is an optimization *) - compile_lambda ~output_prefix + compile_lambda { lambda_cxt with continuation = Assign bind } larg in @@ -878,7 +883,7 @@ and compile_staticraise output_prefix i (largs : Lam.t list) ]} *) -and compile_staticcatch output_prefix (lam : Lam.t) (lambda_cxt : Lam_compile_context.t) = +and compile_staticcatch (lam : Lam.t) (lambda_cxt : Lam_compile_context.t) = let code_table, body = flatten_nested_caches lam in let exit_id = Ext_ident.create_tmp ~name:"exit" () in match (lambda_cxt.continuation, code_table) with @@ -900,13 +905,13 @@ and compile_staticcatch output_prefix (lam : Lam.t) (lambda_cxt : Lam_compile_co } in - let lbody = compile_lambda ~output_prefix new_cxt body in + let lbody = compile_lambda new_cxt body in let declares = Ext_list.map code_table.bindings (fun x -> S.declare_variable ~kind:Variable x) in Js_output.append_output (Js_output.make declares) - (Js_output.append_output lbody (compile_lambda ~output_prefix lambda_cxt handler)) + (Js_output.append_output lbody (compile_lambda lambda_cxt handler)) | _ -> ( let exit_expr = E.var exit_id in let jmp_table, handlers = @@ -928,12 +933,12 @@ and compile_staticcatch output_prefix (lam : Lam.t) (lambda_cxt : Lam_compile_co let new_cxt = { lambda_cxt with jmp_table; continuation = Assign v } in - let lbody = compile_lambda ~output_prefix new_cxt body in + let lbody = compile_lambda new_cxt body in Js_output.append_output (Js_output.make (S.declare_variable ~kind:Variable v :: declares)) (Js_output.append_output lbody (Js_output.make - (compile_cases output_prefix new_cxt exit_expr handlers NonComplete + (compile_cases new_cxt exit_expr handlers NonComplete (fun _ -> None)) ~value:(E.var v))) | Declare (kind, id) (* declare first this we will do branching*) -> @@ -941,11 +946,11 @@ and compile_staticcatch output_prefix (lam : Lam.t) (lambda_cxt : Lam_compile_co let new_cxt = { lambda_cxt with jmp_table; continuation = Assign id } in - let lbody = compile_lambda ~output_prefix new_cxt body in + let lbody = compile_lambda new_cxt body in Js_output.append_output (Js_output.make declares) (Js_output.append_output lbody (Js_output.make - (compile_cases output_prefix new_cxt exit_expr handlers NonComplete + (compile_cases new_cxt exit_expr handlers NonComplete (fun _ -> None)))) (* place holder -- tell the compiler that we don't know if it's complete @@ -957,31 +962,31 @@ and compile_staticcatch output_prefix (lam : Lam.t) (lambda_cxt : Lam_compile_co else EffectCall new_tail_type in let new_cxt = { lambda_cxt with jmp_table; continuation } in - let lbody = compile_lambda ~output_prefix new_cxt body in + let lbody = compile_lambda new_cxt body in Js_output.append_output (Js_output.make declares) (Js_output.append_output lbody (Js_output.make - (compile_cases output_prefix new_cxt exit_expr handlers NonComplete + (compile_cases new_cxt exit_expr handlers NonComplete (fun _ -> None)))) | Assign _ -> let new_cxt = { lambda_cxt with jmp_table } in - let lbody = compile_lambda ~output_prefix new_cxt body in + let lbody = compile_lambda new_cxt body in Js_output.append_output (Js_output.make declares) (Js_output.append_output lbody (Js_output.make - (compile_cases output_prefix new_cxt exit_expr handlers NonComplete + (compile_cases new_cxt exit_expr handlers NonComplete (fun _ -> None))))) -and compile_sequand output_prefix (l : Lam.t) (r : Lam.t) (lambda_cxt : Lam_compile_context.t) +and compile_sequand (l : Lam.t) (r : Lam.t) (lambda_cxt : Lam_compile_context.t) = if Lam_compile_context.continuation_is_return lambda_cxt.continuation then - compile_lambda ~output_prefix lambda_cxt (Lam.sequand l r) + compile_lambda lambda_cxt (Lam.sequand l r) else let new_cxt = { lambda_cxt with continuation = NeedValue Not_tail } in - match compile_lambda ~output_prefix new_cxt l with + match compile_lambda new_cxt l with | { value = None } -> assert false | { block = l_block; value = Some l_expr } -> ( - match compile_lambda ~output_prefix new_cxt r with + match compile_lambda new_cxt r with | { value = None } -> assert false | { block = []; value = Some r_expr } -> Js_output.output_of_block_and_expression lambda_cxt.continuation @@ -1012,16 +1017,16 @@ and compile_sequand output_prefix (l : Lam.t) (r : Lam.t) (lambda_cxt : Lam_comp @ [ S.if_ l_expr (r_block @ [ S.assign v r_expr ]) ]) ~value:(E.var v))) -and compile_sequor output_prefix (l : Lam.t) (r : Lam.t) (lambda_cxt : Lam_compile_context.t) +and compile_sequor (l : Lam.t) (r : Lam.t) (lambda_cxt : Lam_compile_context.t) = if Lam_compile_context.continuation_is_return lambda_cxt.continuation then - compile_lambda ~output_prefix lambda_cxt (Lam.sequor l r) + compile_lambda lambda_cxt (Lam.sequor l r) else let new_cxt = { lambda_cxt with continuation = NeedValue Not_tail } in - match compile_lambda ~output_prefix new_cxt l with + match compile_lambda new_cxt l with | { value = None } -> assert false | { block = l_block; value = Some l_expr } -> ( - match compile_lambda ~output_prefix new_cxt r with + match compile_lambda new_cxt r with | { value = None } -> assert false | { block = []; value = Some r_expr } -> let exp = E.or_ l_expr r_expr in @@ -1060,10 +1065,10 @@ and compile_sequor output_prefix (l : Lam.t) (r : Lam.t) (lambda_cxt : Lam_compi while expression, here we generate for statement, leave optimization later. (Sine OCaml expression can be really complex..) *) -and compile_while output_prefix (predicate : Lam.t) (body : Lam.t) +and compile_while (predicate : Lam.t) (body : Lam.t) (lambda_cxt : Lam_compile_context.t) = match - compile_lambda ~output_prefix + compile_lambda { lambda_cxt with continuation = NeedValue Not_tail } predicate with @@ -1075,7 +1080,7 @@ and compile_while output_prefix (predicate : Lam.t) (body : Lam.t) [ S.while_ e (Js_output.output_as_block - @@ compile_lambda ~output_prefix + @@ compile_lambda { lambda_cxt with continuation = EffectCall Not_tail } body); ] @@ -1083,7 +1088,7 @@ and compile_while output_prefix (predicate : Lam.t) (body : Lam.t) Js_output.output_of_block_and_expression lambda_cxt.continuation block E.unit -(** all non-tail +(* all non-tail TODO: check semantics should start, finish be executed each time in both ocaml and js?, also check evaluation order.. in ocaml id is not in the scope of finish, so it should be safe here @@ -1095,12 +1100,12 @@ and compile_while output_prefix (predicate : Lam.t) (body : Lam.t) print i each time, so they are different semantics... *) -and compile_for output_prefix (id : J.for_ident) (start : Lam.t) (finish : Lam.t) +and compile_for (id : J.for_ident) (start : Lam.t) (finish : Lam.t) (direction : Js_op.direction_flag) (body : Lam.t) (lambda_cxt : Lam_compile_context.t) = let new_cxt = { lambda_cxt with continuation = NeedValue Not_tail } in let block = - match (compile_lambda ~output_prefix new_cxt start, compile_lambda ~output_prefix new_cxt finish) with + match (compile_lambda new_cxt start, compile_lambda new_cxt finish) with | { value = None }, _ | _, { value = None } -> assert false | { block = b1; value = Some e1 }, { block = b2; value = Some e2 } -> ( (* order b1 -- (e1 -- b2 -- e2) @@ -1113,7 +1118,7 @@ and compile_for output_prefix (id : J.for_ident) (start : Lam.t) (finish : Lam.t *) let block_body = Js_output.output_as_block - (compile_lambda ~output_prefix + (compile_lambda { lambda_cxt with continuation = EffectCall Not_tail } body) in @@ -1139,7 +1144,7 @@ and compile_for output_prefix (id : J.for_ident) (start : Lam.t) (finish : Lam.t in Js_output.output_of_block_and_expression lambda_cxt.continuation block E.unit -and compile_assign output_prefix id (lambda : Lam.t) (lambda_cxt : Lam_compile_context.t) = +and compile_assign id (lambda : Lam.t) (lambda_cxt : Lam_compile_context.t) = let block = match lambda with | Lprim { primitive = Poffsetint v; args = [ Lvar bid ] } @@ -1147,7 +1152,7 @@ and compile_assign output_prefix id (lambda : Lam.t) (lambda_cxt : Lam_compile_c [ S.exp (E.assign (E.var id) (E.int32_add (E.var id) (E.small_int v))) ] | _ -> ( match - compile_lambda ~output_prefix + compile_lambda { lambda_cxt with continuation = NeedValue Not_tail } lambda with @@ -1170,16 +1175,16 @@ and compile_assign output_prefix id (lambda : Lam.t) (lambda_cxt : Lam_compile_c } ]} *) -and compile_trywith output_prefix lam id catch (lambda_cxt : Lam_compile_context.t) = +and compile_trywith lam id catch (lambda_cxt : Lam_compile_context.t) = let aux (with_context : Lam_compile_context.t) (body_context : Lam_compile_context.t) = (* should_return is passed down #1701, try should prevent tailcall *) [ S.try_ - (Js_output.output_as_block (compile_lambda ~output_prefix body_context lam)) + (Js_output.output_as_block (compile_lambda body_context lam)) ~with_: - (id, Js_output.output_as_block (compile_lambda ~output_prefix with_context catch)); + (id, Js_output.output_as_block (compile_lambda with_context catch)); ] in match lambda_cxt.continuation with @@ -1246,10 +1251,10 @@ and compile_trywith output_prefix lam id catch (lambda_cxt : Lam_compile_context mutable initializers: (obj -> unit) list } ]} *) -and compile_ifthenelse output_prefix (predicate : Lam.t) (t_branch : Lam.t) (f_branch : Lam.t) +and compile_ifthenelse (predicate : Lam.t) (t_branch : Lam.t) (f_branch : Lam.t) (lambda_cxt : Lam_compile_context.t) = match - compile_lambda ~output_prefix + compile_lambda { lambda_cxt with continuation = NeedValue Not_tail } predicate with @@ -1258,8 +1263,8 @@ and compile_ifthenelse output_prefix (predicate : Lam.t) (t_branch : Lam.t) (f_b match lambda_cxt.continuation with | NeedValue _ -> ( match - ( compile_lambda ~output_prefix lambda_cxt t_branch, - compile_lambda ~output_prefix lambda_cxt f_branch ) + ( compile_lambda lambda_cxt t_branch, + compile_lambda lambda_cxt f_branch ) with | { block = []; value = Some out1 }, { block = []; value = Some out2 } -> @@ -1271,8 +1276,8 @@ and compile_ifthenelse output_prefix (predicate : Lam.t) (t_branch : Lam.t) (f_b let id = Ext_ident.create_tmp () in let assign_cxt = { lambda_cxt with continuation = Assign id } in match - ( compile_lambda ~output_prefix assign_cxt t_branch, - compile_lambda ~output_prefix assign_cxt f_branch ) + ( compile_lambda assign_cxt t_branch, + compile_lambda assign_cxt f_branch ) with | out1, out2 -> Js_output.make @@ -1289,8 +1294,8 @@ and compile_ifthenelse output_prefix (predicate : Lam.t) (t_branch : Lam.t) (f_b { lambda_cxt with continuation = NeedValue Not_tail } in match - ( compile_lambda ~output_prefix declare_cxt t_branch, - compile_lambda ~output_prefix declare_cxt f_branch ) + ( compile_lambda declare_cxt t_branch, + compile_lambda declare_cxt f_branch ) with | { block = []; value = Some out1 }, { block = []; value = Some out2 } -> @@ -1303,20 +1308,20 @@ and compile_ifthenelse output_prefix (predicate : Lam.t) (t_branch : Lam.t) (f_b (Ext_list.append_one b (S.if_ ~declaration:(kind, id) e (Js_output.output_as_block - @@ compile_lambda ~output_prefix + @@ compile_lambda { lambda_cxt with continuation = Assign id } t_branch) ~else_: (Js_output.output_as_block - @@ compile_lambda ~output_prefix + @@ compile_lambda { lambda_cxt with continuation = Assign id } f_branch)))) | Assign _ -> let then_output = - Js_output.output_as_block (compile_lambda ~output_prefix lambda_cxt t_branch) + Js_output.output_as_block (compile_lambda lambda_cxt t_branch) in let else_output = - Js_output.output_as_block (compile_lambda ~output_prefix lambda_cxt f_branch) + Js_output.output_as_block (compile_lambda lambda_cxt f_branch) in Js_output.make (Ext_list.append_one b (S.if_ e then_output ~else_:else_output)) @@ -1326,8 +1331,8 @@ and compile_ifthenelse output_prefix (predicate : Lam.t) (t_branch : Lam.t) (f_b in match ( should_return, - compile_lambda ~output_prefix context1 t_branch, - compile_lambda ~output_prefix context1 f_branch ) + compile_lambda context1 t_branch, + compile_lambda context1 f_branch ) with (* see PR#83 *) | ( Not_tail, @@ -1358,7 +1363,7 @@ and compile_ifthenelse output_prefix (predicate : Lam.t) (t_branch : Lam.t) (f_b [ S.if_ (E.not e) (Js_output.output_as_block - @@ compile_lambda ~output_prefix lambda_cxt f_branch); + @@ compile_lambda lambda_cxt f_branch); ]) else Js_output.make @@ -1366,10 +1371,10 @@ and compile_ifthenelse output_prefix (predicate : Lam.t) (t_branch : Lam.t) (f_b [ S.if_ e (Js_output.output_as_block - @@ compile_lambda ~output_prefix lambda_cxt t_branch) + @@ compile_lambda lambda_cxt t_branch) ~else_: (Js_output.output_as_block - @@ compile_lambda ~output_prefix lambda_cxt f_branch); + @@ compile_lambda lambda_cxt f_branch); ]) | Not_tail, _, { block = []; value = Some out2 } -> let else_ = @@ -1377,13 +1382,13 @@ and compile_ifthenelse output_prefix (predicate : Lam.t) (t_branch : Lam.t) (f_b else Some (Js_output.output_as_block - (compile_lambda ~output_prefix lambda_cxt f_branch)) + (compile_lambda lambda_cxt f_branch)) in Js_output.make (Ext_list.append_one b (S.if_ e (Js_output.output_as_block - (compile_lambda ~output_prefix lambda_cxt t_branch)) + (compile_lambda lambda_cxt t_branch)) ?else_)) | ( Maybe_tail_is_return _, { block = []; value = Some out1 }, @@ -1393,16 +1398,16 @@ and compile_ifthenelse output_prefix (predicate : Lam.t) (t_branch : Lam.t) (f_b ~output_finished:True | _, _, _ -> let then_output = - Js_output.output_as_block (compile_lambda ~output_prefix lambda_cxt t_branch) + Js_output.output_as_block (compile_lambda lambda_cxt t_branch) in let else_output = - Js_output.output_as_block (compile_lambda ~output_prefix lambda_cxt f_branch) + Js_output.output_as_block (compile_lambda lambda_cxt f_branch) in Js_output.make (Ext_list.append_one b (S.if_ e then_output ~else_:else_output)) )) -and compile_apply output_prefix (appinfo : Lam.apply) (lambda_cxt : Lam_compile_context.t) = +and compile_apply (appinfo : Lam.apply) (lambda_cxt : Lam_compile_context.t) = match appinfo with | { ap_func = @@ -1414,7 +1419,7 @@ and compile_apply output_prefix (appinfo : Lam.apply) (lambda_cxt : Lam_compile_ if outer_ap_info.ap_inlined = ap_inlined then outer_ap_info else { outer_ap_info with ap_inlined } in - compile_lambda ~output_prefix lambda_cxt + compile_lambda lambda_cxt (Lam.apply ap_func (Ext_list.append ap_args appinfo.ap_args) ap_info) (* External function call: it can not be tailcall in this case*) | { @@ -1423,7 +1428,7 @@ and compile_apply output_prefix (appinfo : Lam.apply) (lambda_cxt : Lam_compile_ } -> ( match fld_info with | Fld_module { name } -> - compile_external_field_apply output_prefix appinfo id name lambda_cxt + compile_external_field_apply appinfo id name lambda_cxt | _ -> assert false) | _ -> ( (* TODO: --- @@ -1436,7 +1441,7 @@ and compile_apply output_prefix (appinfo : Lam.apply) (lambda_cxt : Lam_compile_ = Ext_list.fold_right (ap_func :: appinfo.ap_args) ([], []) (fun x (args_code, fn_code) -> - match compile_lambda ~output_prefix new_cxt x with + match compile_lambda new_cxt x with | { block; value = Some b } -> (Ext_list.append block args_code, b :: fn_code) | { value = None } -> assert false) @@ -1497,18 +1502,18 @@ and compile_apply output_prefix (appinfo : Lam.apply) (lambda_cxt : Lam_compile_ ~info:(call_info_of_ap_status appinfo.ap_info.ap_status) fn_code args)) -and compile_prim output_prefix (prim_info : Lam.prim_info) +and compile_prim (prim_info : Lam.prim_info) (lambda_cxt : Lam_compile_context.t) = match prim_info with | { primitive = Pfield (_, fld_info); args = [ Lglobal_module id ]; _ } -> ( (* should be before Lglobal_global *) match fld_info with | Fld_module { name = field } -> - compile_external_field output_prefix lambda_cxt id field + compile_external_field lambda_cxt id field | _ -> assert false) | { primitive = Praise; args = [ e ]; _ } -> ( match - compile_lambda ~output_prefix { lambda_cxt with continuation = NeedValue Not_tail } e + compile_lambda { lambda_cxt with continuation = NeedValue Not_tail } e with | { block; value = Some v } -> Js_output.make @@ -1519,8 +1524,8 @@ and compile_prim output_prefix (prim_info : Lam.prim_info) *) | { value = None } -> assert false) | { primitive = Psequand; args = [ l; r ]; _ } -> - compile_sequand output_prefix l r lambda_cxt - | { primitive = Psequor; args = [ l; r ] } -> compile_sequor output_prefix l r lambda_cxt + compile_sequand l r lambda_cxt + | { primitive = Psequor; args = [ l; r ] } -> compile_sequor l r lambda_cxt | { primitive = Pdebugger; _ } -> (* [%bs.debugger] guarantees that the expression does not matter TODO: make it even safer *) @@ -1540,7 +1545,7 @@ and compile_prim output_prefix (prim_info : Lam.prim_info) assert (not setter); match - compile_lambda ~output_prefix { lambda_cxt with continuation = NeedValue Not_tail } obj + compile_lambda { lambda_cxt with continuation = NeedValue Not_tail } obj with | { value = None } -> assert false | { block; value = Some b } -> @@ -1569,8 +1574,8 @@ and compile_prim output_prefix (prim_info : Lam.prim_info) let need_value_no_return_cxt = { lambda_cxt with continuation = NeedValue Not_tail } in - let obj_output = compile_lambda ~output_prefix need_value_no_return_cxt obj in - let arg_output = compile_lambda ~output_prefix need_value_no_return_cxt setter_val in + let obj_output = compile_lambda need_value_no_return_cxt obj in + let arg_output = compile_lambda need_value_no_return_cxt setter_val in let cont obj_block arg_block obj_code = Js_output.output_of_block_and_expression lambda_cxt.continuation (match obj_code with @@ -1602,7 +1607,7 @@ and compile_prim output_prefix (prim_info : Lam.prim_info) *) match args with | fn :: rest -> - compile_lambda ~output_prefix lambda_cxt + compile_lambda lambda_cxt (Lam.apply fn rest { ap_loc = loc; @@ -1620,7 +1625,7 @@ and compile_prim output_prefix (prim_info : Lam.prim_info) here we share env *) (Js_output.output_as_block - (compile_lambda ~output_prefix + (compile_lambda { lambda_cxt with continuation = @@ -1633,10 +1638,10 @@ and compile_prim output_prefix (prim_info : Lam.prim_info) body))) | _ -> assert false) | { primitive = Pjs_fn_make arity; args = [ fn ]; loc } -> - compile_lambda ~output_prefix lambda_cxt + compile_lambda lambda_cxt (Lam_eta_conversion.unsafe_adjust_to_arity loc ~to_:arity ?from:None fn) | { primitive = Pjs_fn_make_unit; args = [ fn ]; loc } -> - compile_lambda ~output_prefix lambda_cxt fn + compile_lambda lambda_cxt fn | { primitive = Pjs_fn_make _; args = [] | _ :: _ :: _ } -> assert false | { primitive = Pjs_object_create labels; args } -> let args_block, args_expr = @@ -1644,7 +1649,7 @@ and compile_prim output_prefix (prim_info : Lam.prim_info) else let new_cxt = { lambda_cxt with continuation = NeedValue Not_tail } in Ext_list.split_map args (fun x -> - match compile_lambda ~output_prefix new_cxt x with + match compile_lambda new_cxt x with | { block; value = Some b } -> (block, b) | { value = None } -> assert false) in @@ -1660,7 +1665,7 @@ and compile_prim output_prefix (prim_info : Lam.prim_info) else let new_cxt = { lambda_cxt with continuation = NeedValue Not_tail } in Ext_list.split_map args (fun x -> - match compile_lambda ~output_prefix new_cxt x with + match compile_lambda new_cxt x with | { block; value = Some b } -> (block, b) | { value = None } -> assert false) in @@ -1672,7 +1677,7 @@ and compile_prim output_prefix (prim_info : Lam.prim_info) Js_output.output_of_block_and_expression lambda_cxt.continuation args_code exp -and compile_lambda ~output_prefix (lambda_cxt : Lam_compile_context.t) (cur_lam : Lam.t) : +and compile_lambda (lambda_cxt : Lam_compile_context.t) (cur_lam : Lam.t) : Js_output.t = match cur_lam with | Lfunction { params; body; attr = { return_unit; async; oneUnitArg } } -> @@ -1683,7 +1688,7 @@ and compile_lambda ~output_prefix (lambda_cxt : Lam_compile_context.t) (cur_lam here we share env *) (Js_output.output_as_block - (compile_lambda ~output_prefix + (compile_lambda { lambda_cxt with continuation = @@ -1694,15 +1699,15 @@ and compile_lambda ~output_prefix (lambda_cxt : Lam_compile_context.t) (cur_lam jmp_table = Lam_compile_context.empty_handler_map; } body))) - | Lapply appinfo -> compile_apply output_prefix appinfo lambda_cxt + | Lapply appinfo -> compile_apply appinfo lambda_cxt | Llet (let_kind, id, arg, body) -> (* Order matters.. see comment below in [Lletrec] *) let args_code = - compile_lambda ~output_prefix + compile_lambda { lambda_cxt with continuation = Declare (let_kind, id) } arg in - Js_output.append_output args_code (compile_lambda ~output_prefix lambda_cxt body) + Js_output.append_output args_code (compile_lambda lambda_cxt body) | Lletrec (id_args, body) -> (* There is a bug in our current design, it requires compile args first (register that some objects are jsidentifiers) @@ -1715,8 +1720,8 @@ and compile_lambda ~output_prefix (lambda_cxt : Lam_compile_context.t) (cur_lam 1. scan the lambda layer first, register js identifier before proceeding 2. delay the method call into javascript ast *) - let v = compile_recursive_lets ~output_prefix lambda_cxt id_args in - Js_output.append_output v (compile_lambda ~output_prefix lambda_cxt body) + let v = compile_recursive_lets lambda_cxt id_args in + Js_output.append_output v (compile_lambda lambda_cxt body) | Lvar id -> Js_output.output_of_expression lambda_cxt.continuation ~no_effects:no_effects_const (E.var id) @@ -1731,21 +1736,21 @@ and compile_lambda ~output_prefix (lambda_cxt : Lam_compile_context.t) (cur_lam *) Js_output.output_of_block_and_expression lambda_cxt.continuation [] (E.ml_module_as_var i) - | Lprim prim_info -> compile_prim output_prefix prim_info lambda_cxt + | Lprim prim_info -> compile_prim prim_info lambda_cxt | Lsequence (l1, l2) -> let output_l1 = - compile_lambda ~output_prefix { lambda_cxt with continuation = EffectCall Not_tail } l1 + compile_lambda { lambda_cxt with continuation = EffectCall Not_tail } l1 in - let output_l2 = compile_lambda ~output_prefix lambda_cxt l2 in + let output_l2 = compile_lambda lambda_cxt l2 in Js_output.append_output output_l1 output_l2 | Lifthenelse (predicate, t_branch, f_branch) -> - compile_ifthenelse output_prefix predicate t_branch f_branch lambda_cxt + compile_ifthenelse predicate t_branch f_branch lambda_cxt | Lstringswitch (l, cases, default) -> - compile_stringswitch output_prefix l cases default lambda_cxt - | Lswitch (switch_arg, sw) -> compile_switch output_prefix switch_arg sw lambda_cxt - | Lstaticraise (i, largs) -> compile_staticraise output_prefix i largs lambda_cxt - | Lstaticcatch _ -> compile_staticcatch output_prefix cur_lam lambda_cxt - | Lwhile (p, body) -> compile_while output_prefix p body lambda_cxt + compile_stringswitch l cases default lambda_cxt + | Lswitch (switch_arg, sw) -> compile_switch switch_arg sw lambda_cxt + | Lstaticraise (i, largs) -> compile_staticraise i largs lambda_cxt + | Lstaticcatch _ -> compile_staticcatch cur_lam lambda_cxt + | Lwhile (p, body) -> compile_while p body lambda_cxt | Lfor (id, start, finish, direction, body) -> ( match (direction, finish) with | ( Upto, @@ -1755,12 +1760,17 @@ and compile_lambda ~output_prefix (lambda_cxt : Lam_compile_context.t) (cur_lam args = [ new_finish; Lconst (Const_int { i = 1l }) ]; } | Lprim { primitive = Poffsetint -1; args = [ new_finish ] } ) ) -> - compile_for output_prefix id start new_finish Up body lambda_cxt + compile_for id start new_finish Up body lambda_cxt | _ -> - compile_for output_prefix id start finish + compile_for id start finish (if direction = Upto then Upto else Downto) body lambda_cxt) - | Lassign (id, lambda) -> compile_assign output_prefix id lambda lambda_cxt + | Lassign (id, lambda) -> compile_assign id lambda lambda_cxt | Ltrywith (lam, id, catch) -> (* generate documentation *) - compile_trywith output_prefix lam id catch lambda_cxt + compile_trywith lam id catch lambda_cxt + +in compile_recursive_lets, compile_lambda + +let compile_recursive_lets ~output_prefix = fst (compile output_prefix) +let compile_lambda ~output_prefix = snd (compile output_prefix) \ No newline at end of file