diff --git a/compiler/bin-js_of_ocaml/build_fs.ml b/compiler/bin-js_of_ocaml/build_fs.ml index 84ed7fb55d..16ac22a23d 100644 --- a/compiler/bin-js_of_ocaml/build_fs.ml +++ b/compiler/bin-js_of_ocaml/build_fs.ml @@ -75,10 +75,10 @@ function jsoo_create_file_extern(name,content){ let pfs_fmt = Pretty_print.to_out_channel chan in let (_ : Source_map.t option) = Driver.f - ~target:(JavaScript pfs_fmt) ~standalone:true ~wrap_with_fun:`Iife ~link:`Needed + ~formatter:pfs_fmt (Parse_bytecode.Debug.create ~include_cmis:false false) code in diff --git a/compiler/bin-js_of_ocaml/compile.ml b/compiler/bin-js_of_ocaml/compile.ml index 8e2f1b812a..d3e924e807 100644 --- a/compiler/bin-js_of_ocaml/compile.ml +++ b/compiler/bin-js_of_ocaml/compile.ml @@ -186,7 +186,7 @@ let run let init_pseudo_fs = fs_external && standalone in let sm = match output_file with - | `Stdout, fmt -> + | `Stdout, formatter -> let instr = List.concat [ pseudo_fs_instr `create_file one.debug one.cmis @@ -196,15 +196,15 @@ let run in let code = Code.prepend one.code instr in Driver.f - ~target:(JavaScript fmt) ~standalone ?profile ~link ~wrap_with_fun ?source_map + ~formatter one.debug code - | `File, fmt -> + | `File, formatter -> let fs_instr1, fs_instr2 = match fs_output with | None -> pseudo_fs_instr `create_file one.debug one.cmis, [] @@ -220,12 +220,12 @@ let run let code = Code.prepend one.code instr in let res = Driver.f - ~target:(JavaScript fmt) ~standalone ?profile ~link ~wrap_with_fun ?source_map + ~formatter one.debug code in diff --git a/compiler/lib/driver.ml b/compiler/lib/driver.ml index 5dfbfcab51..b50df74d65 100644 --- a/compiler/lib/driver.ml +++ b/compiler/lib/driver.ml @@ -658,12 +658,6 @@ let configure formatter = Code.Var.set_pretty (pretty && not (Config.Flag.shortvar ())); Code.Var.set_stable (Config.Flag.stable_var ()) -type 'a target = - | JavaScript : Pretty_print.t -> Source_map.t option target - | Wasm - : (Deadcode.variable_uses * Effects.in_cps * Code.program * Parse_bytecode.Debug.t) - target - let link_and_pack ?(standalone = true) ?(wrap_with_fun = `Iife) ?(link = `No) p = let export_runtime = match link with @@ -676,20 +670,7 @@ let link_and_pack ?(standalone = true) ?(wrap_with_fun = `Iife) ?(link = `No) p |> coloring |> check_js -let full - (type result) - ~(target : result target) - ~standalone - ~wrap_with_fun - ~profile - ~link - ~source_map - d - p : result = - let deadcode_sentinal = - (* If deadcode is disabled, this field is just fresh variable *) - Code.Var.fresh_n "undef" - in +let optimize ~profile ~deadcode_sentinal p = let opt = specialize_js_once +> (match profile with @@ -699,58 +680,53 @@ let full +> exact_calls ~deadcode_sentinal profile +> effects ~deadcode_sentinal +> map_fst - (match target with - | JavaScript _ -> if Config.Flag.effects () then Fun.id else Generate_closure.f - | Wasm -> Fun.id) + (match Config.target () with + | `JavaScript -> if Config.Flag.effects () then Fun.id else Generate_closure.f + | `Wasm -> Fun.id) +> map_fst deadcode' in if times () then Format.eprintf "Start Optimizing...@."; let t = Timer.make () in let r = opt p in let () = if times () then Format.eprintf " optimizations : %a@." Timer.print t in - match target with - | JavaScript formatter -> - let exported_runtime = not standalone in - let emit formatter = - generate - d - ~exported_runtime - ~wrap_with_fun - ~warn_on_unhandled_effect:standalone - ~deadcode_sentinal - +> link_and_pack ~standalone ~wrap_with_fun ~link - +> output formatter ~source_map () - in - let source_map = emit formatter r in - source_map - | Wasm -> - let (p, live_vars), _, in_cps = r in - live_vars, in_cps, p, d + r + +let full ~standalone ~wrap_with_fun ~profile ~link ~source_map ~formatter d p = + let deadcode_sentinal = + (* If deadcode is disabled, this field is just fresh variable *) + Code.Var.fresh_n "undef" + in + let r = optimize ~profile ~deadcode_sentinal p in + let exported_runtime = not standalone in + let emit formatter = + generate + d + ~exported_runtime + ~wrap_with_fun + ~warn_on_unhandled_effect:standalone + ~deadcode_sentinal + +> link_and_pack ~standalone ~wrap_with_fun ~link + +> output formatter ~source_map () + in + let source_map = emit formatter r in + source_map let full_no_source_map ~formatter ~standalone ~wrap_with_fun ~profile ~link d p = let (_ : Source_map.t option) = - full - ~target:(JavaScript formatter) - ~standalone - ~wrap_with_fun - ~profile - ~link - ~source_map:None - d - p + full ~standalone ~wrap_with_fun ~profile ~link ~source_map:None ~formatter d p in () let f - ~target ?(standalone = true) ?(wrap_with_fun = `Iife) ?(profile = O1) ~link ?source_map + ~formatter d p = - full ~target ~standalone ~wrap_with_fun ~profile ~link ~source_map d p + full ~standalone ~wrap_with_fun ~profile ~link ~source_map ~formatter d p let f' ?(standalone = true) ?(wrap_with_fun = `Iife) ?(profile = O1) ~link formatter d p = full_no_source_map ~formatter ~standalone ~wrap_with_fun ~profile ~link d p diff --git a/compiler/lib/driver.mli b/compiler/lib/driver.mli index 1b9eaa616a..7f3e16bb4f 100644 --- a/compiler/lib/driver.mli +++ b/compiler/lib/driver.mli @@ -20,22 +20,24 @@ type profile -type 'a target = - | JavaScript : Pretty_print.t -> Source_map.t option target - | Wasm - : (Deadcode.variable_uses * Effects.in_cps * Code.program * Parse_bytecode.Debug.t) - target +val optimize : + profile:profile + -> deadcode_sentinal:Code.Var.t + -> Code.program + -> (Code.program * Deadcode.variable_uses) + * Effects.trampolined_calls + * Effects.trampolined_calls val f : - target:'result target - -> ?standalone:bool + ?standalone:bool -> ?wrap_with_fun:[ `Iife | `Anonymous | `Named of string ] -> ?profile:profile -> link:[ `All | `All_from of string list | `Needed | `No ] -> ?source_map:Source_map.t + -> formatter:Pretty_print.t -> Parse_bytecode.Debug.t -> Code.program - -> 'result + -> Source_map.t option val f' : ?standalone:bool