From 63d67f53d9b9b9224f6846bcba972a5245d38052 Mon Sep 17 00:00:00 2001 From: Hongbo Zhang Date: Fri, 5 Feb 2016 11:44:41 -0500 Subject: [PATCH] delay the external module dependency check, so we can decide whehter we need curry support in one pass --- jscomp/j.ml | 10 ++++-- jscomp/js_dump.ml | 12 +++---- jscomp/js_dump.mli | 4 +-- jscomp/js_fold.ml | 23 ++++++-------- jscomp/js_map.ml | 35 +++++++-------------- jscomp/js_program_loader.ml | 14 ++++----- jscomp/js_program_loader.mli | 10 ++++-- jscomp/lam_compile_group.ml | 50 +++++++++++++++++------------- jscomp/lam_compile_group.mli | 2 +- jscomp/test/string_runtime_test.js | 2 +- 10 files changed, 82 insertions(+), 80 deletions(-) diff --git a/jscomp/j.ml b/jscomp/j.ml index 31d1b05eb6..b85545228f 100644 --- a/jscomp/j.ml +++ b/jscomp/j.ml @@ -341,9 +341,15 @@ and block = statement list and program = { name : string; - modules : required_modules ; + block : block ; exports : exports ; export_set : Ident_set.t ; - side_effect : string option (* None: no, Some reason *) + } +and deps_program = + { + program : program ; + modules : required_modules ; + side_effect : string option (* None: no, Some reason *) + } diff --git a/jscomp/js_dump.ml b/jscomp/js_dump.ml index 13cb14b933..dfb529e07d 100644 --- a/jscomp/js_dump.ml +++ b/jscomp/js_dump.ml @@ -1300,7 +1300,7 @@ let exports cxt f (idents : Ident.t list) = outer_cxt -let node_program f ( program : J.program) = +let node_program f ( {program ; modules ; } : J.deps_program) = let cxt = Ext_pp_scope.empty in (* Node style *) let requires cxt f (modules : (Ident.t * string) list ) = @@ -1330,7 +1330,7 @@ let node_program f ( program : J.program) = outer_cxt in - let cxt = requires cxt f program.modules in + let cxt = requires cxt f modules in let () = P.force_newline f in let cxt = statement_list true cxt f program.block in @@ -1339,7 +1339,7 @@ let node_program f ( program : J.program) = let amd_program f - ({modules; block = b ; exports = exp ; side_effect } as program : J.program) + ( {program ; modules ; _} : J.deps_program) = P.newline f ; let cxt = Ext_pp_scope.empty in @@ -1371,7 +1371,7 @@ let amd_program f P.brace_vgroup f 1 @@ (fun _ -> let () = P.string f L.strict_directive in let () = P.newline f in - let cxt = statement_list true cxt f b in + let cxt = statement_list true cxt f program.block in (* FIXME AMD : use {[ function xx ]} or {[ var x = function ..]} *) P.newline f; P.force_newline f; @@ -1379,7 +1379,7 @@ let amd_program f P.string f ")"; ;; -let pp_program (program : J.program) (f : Ext_pp.t) = +let pp_program ( program : J.deps_program) (f : Ext_pp.t) = begin P.string f "// Generated CODE, PLEASE EDIT WITH CARE"; P.newline f; @@ -1404,6 +1404,6 @@ let pp_program (program : J.program) (f : Ext_pp.t) = P.flush f () end let dump_program - (program : J.program) + (program : J.deps_program) (oc : out_channel) = pp_program program (P.from_channel oc) diff --git a/jscomp/js_dump.mli b/jscomp/js_dump.mli index a6ced16bf9..1bfc5691e1 100644 --- a/jscomp/js_dump.mli +++ b/jscomp/js_dump.mli @@ -25,6 +25,6 @@ (** Print JS IR to vanilla Javascript code *) -val pp_program : J.program -> Ext_pp.t -> unit +val pp_program : J.deps_program -> Ext_pp.t -> unit -val dump_program : J.program -> out_channel -> unit +val dump_program : J.deps_program -> out_channel -> unit diff --git a/jscomp/js_fold.ml b/jscomp/js_fold.ml index be8b643122..2d96f9e7e7 100644 --- a/jscomp/js_fold.ml +++ b/jscomp/js_fold.ml @@ -301,21 +301,11 @@ class virtual fold = let o = o#property_name _x in let o = o#expression _x_i1 in o) method property : property -> 'self_type = o#unknown method program : program -> 'self_type = - fun - { - name = _x; - modules = _x_i1; - block = _x_i2; - exports = _x_i3; - export_set = _x_i4; - side_effect = _x_i5 - } -> + fun { name = _x; block = _x_i1; exports = _x_i2; export_set = _x_i3 } + -> let o = o#string _x in - let o = o#required_modules _x_i1 in - let o = o#block _x_i2 in - let o = o#exports _x_i3 in - let o = o#unknown _x_i4 in - let o = o#option (fun o -> o#string) _x_i5 in o + let o = o#block _x_i1 in + let o = o#exports _x_i2 in let o = o#unknown _x_i3 in o method number : number -> 'self_type = o#unknown method mutable_flag : mutable_flag -> 'self_type = o#unknown method label : label -> 'self_type = o#string @@ -397,6 +387,11 @@ class virtual fold = let o = o#option (fun o -> o#string) _x_i1 in o method exports : exports -> 'self_type = o#unknown method exception_ident : exception_ident -> 'self_type = o#ident + method deps_program : deps_program -> 'self_type = + fun { program = _x; modules = _x_i1; side_effect = _x_i2 } -> + let o = o#program _x in + let o = o#required_modules _x_i1 in + let o = o#option (fun o -> o#string) _x_i2 in o method case_clause : (* since in ocaml, it's expression oriented langauge, [return] in general has no jumps, it only happens when we do diff --git a/jscomp/js_map.ml b/jscomp/js_map.ml index e9c874878a..7d47df2d95 100644 --- a/jscomp/js_map.ml +++ b/jscomp/js_map.ml @@ -322,30 +322,13 @@ class virtual map = let _x_i1 = o#expression _x_i1 in (_x, _x_i1)) method property : property -> property = o#unknown method program : program -> program = - fun - { - name = _x; - modules = _x_i1; - block = _x_i2; - exports = _x_i3; - export_set = _x_i4; - side_effect = _x_i5 - } -> + fun { name = _x; block = _x_i1; exports = _x_i2; export_set = _x_i3 } + -> let _x = o#string _x in - let _x_i1 = o#required_modules _x_i1 in - let _x_i2 = o#block _x_i2 in - let _x_i3 = o#exports _x_i3 in - let _x_i4 = o#unknown _x_i4 in - let _x_i5 = o#option (fun o -> o#string) _x_i5 - in - { - name = _x; - modules = _x_i1; - block = _x_i2; - exports = _x_i3; - export_set = _x_i4; - side_effect = _x_i5; - } + let _x_i1 = o#block _x_i1 in + let _x_i2 = o#exports _x_i2 in + let _x_i3 = o#unknown _x_i3 + in { name = _x; block = _x_i1; exports = _x_i2; export_set = _x_i3; } method number : number -> number = o#unknown method mutable_flag : mutable_flag -> mutable_flag = o#unknown method label : label -> label = o#string @@ -444,6 +427,12 @@ class virtual map = in { expression_desc = _x; comment = _x_i1; } method exports : exports -> exports = o#unknown method exception_ident : exception_ident -> exception_ident = o#ident + method deps_program : deps_program -> deps_program = + fun { program = _x; modules = _x_i1; side_effect = _x_i2 } -> + let _x = o#program _x in + let _x_i1 = o#required_modules _x_i1 in + let _x_i2 = o#option (fun o -> o#string) _x_i2 + in { program = _x; modules = _x_i1; side_effect = _x_i2; } method case_clause : (* since in ocaml, it's expression oriented langauge, [return] in general has no jumps, it only happens when we do diff --git a/jscomp/js_program_loader.ml b/jscomp/js_program_loader.ml index 1976c8c9c4..2189aa4b3a 100644 --- a/jscomp/js_program_loader.ml +++ b/jscomp/js_program_loader.ml @@ -95,17 +95,17 @@ let string_of_module_id (x : module_id) : string = FIXME: the module order matters? *) -let make_program name side_effect export_idents external_module_ids block : J.program = - let modules = - List.map (fun id -> Lam_module_ident.id id, string_of_module_id id ) - external_module_ids in +let make_program name export_idents block : J.program = { name; - modules; + exports = export_idents ; export_set = Ident_set.of_list export_idents; block = block; - side_effect ; + } - +let decorate_deps modules side_effect program : J.deps_program = + + { program ; modules ; side_effect } + diff --git a/jscomp/js_program_loader.mli b/jscomp/js_program_loader.mli index 15624cba0d..8c8f64f7b4 100644 --- a/jscomp/js_program_loader.mli +++ b/jscomp/js_program_loader.mli @@ -30,5 +30,11 @@ val make_program : string -> - string option -> - Ident.t list -> Lam_module_ident.t list -> J.block -> J.program + Ident.t list -> J.block -> J.program + +val decorate_deps : + J.required_modules -> + string option -> + J.program -> J.deps_program + +val string_of_module_id : Lam_module_ident.t -> string diff --git a/jscomp/lam_compile_group.ml b/jscomp/lam_compile_group.ml index daee7f3c8f..5cf1c3dede 100644 --- a/jscomp/lam_compile_group.ml +++ b/jscomp/lam_compile_group.ml @@ -150,9 +150,9 @@ let compile_group ({filename = file_name; env;} as meta : Lam_stats.meta) (** Actually simplify_lets is kind of global optimization since it requires you to know whether it's used or not + [non_export] is only used in playground *) -let compile ~filename non_export env _sigs lam : J.program = - +let compile ~filename non_export env _sigs lam = let export_idents = if non_export then [] @@ -305,27 +305,12 @@ let compile ~filename non_export env _sigs lam : J.program = |> Js_output.concat |> Js_output.to_block in - let external_module_ids = - Lam_compile_env.get_requried_modules - meta.env - meta.required_modules - (Js_fold_basic.calculate_hard_dependencies body) - in - (* Exporting ... *) - let v = - Lam_stats_util.export_to_cmj meta maybe_pure external_module_ids - (if non_export then [] else lambda_exports) - in - (if not @@ Ext_string.is_empty filename then - Js_cmj_format.to_file - (Ext_filename.chop_extension ~loc:__LOC__ filename ^ ".cmj") v); - let js = - Js_program_loader.make_program filename v.pure meta.exports - external_module_ids body - in (* The file is not big at all compared with [cmo] *) (* Ext_marshal.to_file (Ext_filename.chop_extension filename ^ ".mj") js; *) - + let js = + Js_program_loader.make_program filename meta.exports + body + in js |> Js_pass_flatten.program |> Js_inline_and_eliminate.inline_and_shake @@ -333,7 +318,28 @@ let compile ~filename non_export env _sigs lam : J.program = |> Js_pass_flatten_and_mark_dead.program |> (fun js -> ignore @@ Js_pass_scope.program js ; js ) |> Js_shake.shake_program - + |> ( fun (js: J.program) -> + let external_module_ids = + Lam_compile_env.get_requried_modules + meta.env + meta.required_modules + (Js_fold_basic.calculate_hard_dependencies js.block) + in + let required_modules = + List.map + (fun id -> Lam_module_ident.id id, Js_program_loader.string_of_module_id id ) + external_module_ids in + + (* Exporting ... *) + let v = + Lam_stats_util.export_to_cmj meta maybe_pure external_module_ids + (if non_export then [] else lambda_exports) + in + (if not @@ Ext_string.is_empty filename then + Js_cmj_format.to_file + (Ext_filename.chop_extension ~loc:__LOC__ filename ^ ".cmj") v); + Js_program_loader.decorate_deps required_modules v.pure js + ) | _ -> raise Not_a_module end | _ -> raise Not_a_module end diff --git a/jscomp/lam_compile_group.mli b/jscomp/lam_compile_group.mli index 960b75f53e..6f8406e2f5 100644 --- a/jscomp/lam_compile_group.mli +++ b/jscomp/lam_compile_group.mli @@ -34,7 +34,7 @@ val compile : Env.t -> Types.signature -> Lambda.lambda -> - J.program + J.deps_program val lambda_as_module : Env.t -> diff --git a/jscomp/test/string_runtime_test.js b/jscomp/test/string_runtime_test.js index 78d349d6f0..191d105192 100644 --- a/jscomp/test/string_runtime_test.js +++ b/jscomp/test/string_runtime_test.js @@ -4,8 +4,8 @@ var Caml_string = require("../runtime/caml_string"); var Mt = require("./mt"); var $$String = require("../stdlib/string"); -var Caml_string = require("../runtime/caml_string"); var List = require("../stdlib/list"); +var Caml_string = require("../runtime/caml_string"); var suites_001 = [ /* tuple */0,