From 2c1c662f55cd2f2ff0ef059d5ed0e4eb3934a480 Mon Sep 17 00:00:00 2001 From: Olivier Nicole Date: Fri, 14 Mar 2025 17:10:38 +0000 Subject: [PATCH 1/5] Do more aggressive lambda lifting With @vouillon we realized that the `Lambda_lifting_simple` pass that is performed by double translation makes some programs significantly faster. We measured roughly a 1.45 speedup on a large (proprietary) Bonsai benchmark. Presumably V8 is much faster with more toplevel functions and less nested closures. --- compiler/lib/driver.ml | 21 +++++++++++++++++++++ 1 file changed, 21 insertions(+) diff --git a/compiler/lib/driver.ml b/compiler/lib/driver.ml index b5cd1aa938..5526dacc3e 100644 --- a/compiler/lib/driver.ml +++ b/compiler/lib/driver.ml @@ -165,6 +165,17 @@ let effects_and_exact_calls Deadcode.f pure_fun p else Deadcode.f pure_fun p in + let p = + match Config.(target (), effects ()) with + | `JavaScript, `Disabled -> + (* If effects are disabled, we lambda-lift aggressively. While not + necessary, it results in a substantial gain in performance in some + programs in Javascript. *) + let to_lift = all_functions p in + let p, _ = Lambda_lifting_simple.f ~to_lift p in + p + | _ -> p + in match Config.effects () with | `Cps | `Double_translation -> if debug () then Format.eprintf "Effects...@."; @@ -696,6 +707,16 @@ let link_and_pack ?(standalone = true) ?(wrap_with_fun = `Iife) ?(link = `No) p |> pack ~wrap_with_fun ~standalone |> check_js +let all_functions p = + let open Code in + fold_closures + p + (fun name _ _ _ acc -> + match name with + | Some name -> Var.Set.add name acc + | None -> acc) + Var.Set.empty + let optimize ~shapes ~profile ~keep_flow_data p = let deadcode_sentinal = (* If deadcode is disabled, this field is just fresh variable *) From 85928f0e683bac04d8274ad0b5e4ca02ecd6bf4c Mon Sep 17 00:00:00 2001 From: Olivier Nicole Date: Mon, 25 Aug 2025 15:41:00 +0200 Subject: [PATCH 2/5] Make aggressive lambda lifting opt-in --- compiler/bin-js_of_ocaml/build_fs.ml | 1 + compiler/bin-js_of_ocaml/cmd_arg.ml | 13 ++++ compiler/bin-js_of_ocaml/cmd_arg.mli | 1 + compiler/bin-js_of_ocaml/compile.ml | 3 + compiler/lib/driver.ml | 99 +++++++++++++++++++++------- compiler/lib/driver.mli | 2 + 6 files changed, 95 insertions(+), 24 deletions(-) diff --git a/compiler/bin-js_of_ocaml/build_fs.ml b/compiler/bin-js_of_ocaml/build_fs.ml index 710b69ae72..65232f5d41 100644 --- a/compiler/bin-js_of_ocaml/build_fs.ml +++ b/compiler/bin-js_of_ocaml/build_fs.ml @@ -80,6 +80,7 @@ function jsoo_create_file_extern(name,content){ ~standalone:true ~wrap_with_fun:`Iife ~link:`Needed + ~lambda_lift_all:false ~formatter:pfs_fmt ~source_map:false code diff --git a/compiler/bin-js_of_ocaml/cmd_arg.ml b/compiler/bin-js_of_ocaml/cmd_arg.ml index 13367e20f0..32728f5b24 100644 --- a/compiler/bin-js_of_ocaml/cmd_arg.ml +++ b/compiler/bin-js_of_ocaml/cmd_arg.ml @@ -78,6 +78,7 @@ type t = ; fs_external : bool ; keep_unit_names : bool ; effects : Config.effects_backend + ; lambda_lift_all : bool } let set_param = @@ -306,6 +307,14 @@ let options = None & info [ "effects" ] ~docv:"KIND" ~doc) in + let lambda_lift_all = + let doc = + "Lambda-lift all functions in the compilation result. This can improve the \ + performance of some programs on some engines (such as V8). Ignored when effects \ + are enabled." + in + Arg.(value & flag & info [ "lambda-lift-all" ] ~doc) + in let build_t common set_param @@ -335,6 +344,7 @@ let options = js_files keep_unit_names effects + lambda_lift_all shape_files = let inline_source_content = not sourcemap_don't_inline_content in let chop_extension s = try Filename.chop_extension s with Invalid_argument _ -> s in @@ -406,6 +416,7 @@ let options = ; source_map ; keep_unit_names ; effects + ; lambda_lift_all ; shape_files } in @@ -440,6 +451,7 @@ let options = $ js_files $ keep_unit_names $ effects + $ lambda_lift_all $ shape_files) in Term.ret t @@ -662,6 +674,7 @@ let options_runtime_only = ; keep_unit_names = false ; effects ; shape_files = [] + ; lambda_lift_all = false } in let t = diff --git a/compiler/bin-js_of_ocaml/cmd_arg.mli b/compiler/bin-js_of_ocaml/cmd_arg.mli index 79780ec8e8..dbb33b79a5 100644 --- a/compiler/bin-js_of_ocaml/cmd_arg.mli +++ b/compiler/bin-js_of_ocaml/cmd_arg.mli @@ -51,6 +51,7 @@ type t = ; fs_external : bool ; keep_unit_names : bool ; effects : Config.effects_backend + ; lambda_lift_all : bool } val options : t Cmdliner.Term.t diff --git a/compiler/bin-js_of_ocaml/compile.ml b/compiler/bin-js_of_ocaml/compile.ml index deb995b991..dcc2a06376 100644 --- a/compiler/bin-js_of_ocaml/compile.ml +++ b/compiler/bin-js_of_ocaml/compile.ml @@ -156,6 +156,7 @@ let run ; keep_unit_names ; include_runtime ; effects + ; lambda_lift_all ; shape_files } = let source_map_base = @@ -279,6 +280,7 @@ let run ~wrap_with_fun ~source_map:(source_map_enabled source_map) ~formatter + ~lambda_lift_all code | `File, formatter -> let fs_instr1, fs_instr2 = @@ -300,6 +302,7 @@ let run ~shapes ?profile ~link + ~lambda_lift_all ~wrap_with_fun ~source_map:(source_map_enabled source_map) ~formatter diff --git a/compiler/lib/driver.ml b/compiler/lib/driver.ml index 5526dacc3e..5d4fb7d7f8 100644 --- a/compiler/lib/driver.ml +++ b/compiler/lib/driver.ml @@ -142,10 +142,21 @@ let collects_shapes ~shapes (p : Code.program) = map) else StringMap.empty +let all_functions p = + let open Code in + fold_closures + p + (fun name _ _ _ acc -> + match name with + | Some name -> Var.Set.add name acc + | None -> acc) + Var.Set.empty + let effects_and_exact_calls ~keep_flow_data ~deadcode_sentinal ~shapes + ~lambda_lift_all (profile : Profile.t) p = let fast = @@ -166,11 +177,8 @@ let effects_and_exact_calls else Deadcode.f pure_fun p in let p = - match Config.(target (), effects ()) with - | `JavaScript, `Disabled -> - (* If effects are disabled, we lambda-lift aggressively. While not - necessary, it results in a substantial gain in performance in some - programs in Javascript. *) + match lambda_lift_all, Config.target (), Config.effects () with + | true, `JavaScript, `Disabled -> let to_lift = all_functions p in let p, _ = Lambda_lifting_simple.f ~to_lift p in p @@ -707,17 +715,7 @@ let link_and_pack ?(standalone = true) ?(wrap_with_fun = `Iife) ?(link = `No) p |> pack ~wrap_with_fun ~standalone |> check_js -let all_functions p = - let open Code in - fold_closures - p - (fun name _ _ _ acc -> - match name with - | Some name -> Var.Set.add name acc - | None -> acc) - Var.Set.empty - -let optimize ~shapes ~profile ~keep_flow_data p = +let optimize ~shapes ~profile ~keep_flow_data ~lambda_lift_all p = let deadcode_sentinal = (* If deadcode is disabled, this field is just fresh variable *) Code.Var.fresh_n "dummy" @@ -730,7 +728,12 @@ let optimize ~shapes ~profile ~keep_flow_data p = | O2 -> o2 | O3 -> o3) +> specialize_js_once_after - +> effects_and_exact_calls ~keep_flow_data ~deadcode_sentinal ~shapes profile + +> effects_and_exact_calls + ~keep_flow_data + ~deadcode_sentinal + ~shapes + ~lambda_lift_all + profile +> map_fst5 (match Config.target (), Config.effects () with | `JavaScript, `Disabled -> Generate_closure.f @@ -750,15 +753,26 @@ let optimize ~shapes ~profile ~keep_flow_data p = let optimize_for_wasm ~shapes ~profile p = let optimized_code, global_flow_data = - optimize ~shapes ~profile ~keep_flow_data:true p + optimize ~shapes ~profile ~keep_flow_data:true ~lambda_lift_all:false p in ( optimized_code , match global_flow_data with | Some data -> data | None -> Global_flow.f ~fast:false optimized_code.program ) -let full ~standalone ~wrap_with_fun ~shapes ~profile ~link ~source_map ~formatter p = - let optimized_code, _ = optimize ~shapes ~profile ~keep_flow_data:false p in +let full + ~standalone + ~wrap_with_fun + ~shapes + ~profile + ~link + ~source_map + ~formatter + ~lambda_lift_all + p = + let optimized_code, _ = + optimize ~shapes ~profile ~keep_flow_data:false ~lambda_lift_all p + in let exported_runtime = not standalone in let emit formatter = generate ~exported_runtime ~wrap_with_fun ~warn_on_unhandled_effect:standalone @@ -778,9 +792,26 @@ let full ~standalone ~wrap_with_fun ~shapes ~profile ~link ~source_map ~formatte shapes_v; emit formatter optimized_code, shapes_v -let full_no_source_map ~formatter ~shapes ~standalone ~wrap_with_fun ~profile ~link p = +let full_no_source_map + ~formatter + ~shapes + ~standalone + ~wrap_with_fun + ~profile + ~link + ~lambda_lift_all + p = let (_ : Source_map.info * _) = - full ~shapes ~standalone ~wrap_with_fun ~profile ~link ~source_map:false ~formatter p + full + ~shapes + ~standalone + ~wrap_with_fun + ~profile + ~link + ~source_map:false + ~formatter + ~lambda_lift_all + p in () @@ -792,17 +823,36 @@ let f ~link ~source_map ~formatter + ~lambda_lift_all p = - full ~standalone ~wrap_with_fun ~shapes ~profile ~link ~source_map ~formatter p + full + ~standalone + ~wrap_with_fun + ~shapes + ~profile + ~link + ~source_map + ~formatter + ~lambda_lift_all + p let f' ?(standalone = true) ?(wrap_with_fun = `Iife) ?(profile = Profile.O1) + ?(lambda_lift_all = false) ~link formatter p = - full_no_source_map ~formatter ~shapes:false ~standalone ~wrap_with_fun ~profile ~link p + full_no_source_map + ~formatter + ~shapes:false + ~standalone + ~wrap_with_fun + ~profile + ~link + ~lambda_lift_all + p let from_string ~prims ~debug s formatter = let p = Parse_bytecode.from_string ~prims ~debug s in @@ -813,4 +863,5 @@ let from_string ~prims ~debug s formatter = ~wrap_with_fun:`Anonymous ~profile:O1 ~link:`No + ~lambda_lift_all:false p diff --git a/compiler/lib/driver.mli b/compiler/lib/driver.mli index 5630d18e50..3bff213d32 100644 --- a/compiler/lib/driver.mli +++ b/compiler/lib/driver.mli @@ -43,6 +43,7 @@ val f : -> link:[ `All | `All_from of string list | `Needed | `No ] -> source_map:bool -> formatter:Pretty_print.t + -> lambda_lift_all:bool -> Code.program -> Source_map.info * Shape.t StringMap.t @@ -50,6 +51,7 @@ val f' : ?standalone:bool -> ?wrap_with_fun:[ `Iife | `Anonymous | `Named of string ] -> ?profile:Profile.t + -> ?lambda_lift_all:bool -> link:[ `All | `All_from of string list | `Needed | `No ] -> Pretty_print.t -> Code.program From 4f68b8c0c178a46da48002c56a714cf6b9eb06a6 Mon Sep 17 00:00:00 2001 From: Olivier Nicole Date: Tue, 26 Aug 2025 17:18:18 +0200 Subject: [PATCH 3/5] Update changelog --- CHANGES.md | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/CHANGES.md b/CHANGES.md index 8ddb87f6d5..deb287c100 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -2,6 +2,7 @@ ## Features/Changes * Compiler/wasm: omit code pointer from closures when not used (#2059, #2093) +* Compiler: add optional full lambda lifting for the Javascript compiler (#1886) * Compiler/wasm: unbox numbers within functions (#2069) ## Bug fixes @@ -85,7 +86,7 @@ ## Bug fixes * Compiler: fix stack overflow issues with double translation (#1869) * Compiler: minifier fix (#1867) -* Compiler: fix shortvar with --enable es6 (AssignTarget was not properly handled) +* Compiler: fix shortvar with --enable es6 (AssignTarget was not properly handled) * Compiler: fix assert failure with double translation (#1870) * Compiler: fix path rewriting of Wasm source maps (#1882) * Compiler: fix global dead code in presence of dead tailcall (#2010) From d15f107647d4dbadcc520c70a539c7c01e808c4b Mon Sep 17 00:00:00 2001 From: Olivier Nicole Date: Mon, 1 Sep 2025 18:26:19 +0200 Subject: [PATCH 4/5] Harmonize command flag with the existing ones --- compiler/bin-js_of_ocaml/build_fs.ml | 1 - compiler/bin-js_of_ocaml/cmd_arg.ml | 13 ----- compiler/bin-js_of_ocaml/cmd_arg.mli | 1 - compiler/bin-js_of_ocaml/compile.ml | 3 -- compiler/lib/config.ml | 2 + compiler/lib/config.mli | 2 + compiler/lib/driver.ml | 74 ++++------------------------ compiler/lib/driver.mli | 2 - 8 files changed, 14 insertions(+), 84 deletions(-) diff --git a/compiler/bin-js_of_ocaml/build_fs.ml b/compiler/bin-js_of_ocaml/build_fs.ml index 65232f5d41..710b69ae72 100644 --- a/compiler/bin-js_of_ocaml/build_fs.ml +++ b/compiler/bin-js_of_ocaml/build_fs.ml @@ -80,7 +80,6 @@ function jsoo_create_file_extern(name,content){ ~standalone:true ~wrap_with_fun:`Iife ~link:`Needed - ~lambda_lift_all:false ~formatter:pfs_fmt ~source_map:false code diff --git a/compiler/bin-js_of_ocaml/cmd_arg.ml b/compiler/bin-js_of_ocaml/cmd_arg.ml index 32728f5b24..13367e20f0 100644 --- a/compiler/bin-js_of_ocaml/cmd_arg.ml +++ b/compiler/bin-js_of_ocaml/cmd_arg.ml @@ -78,7 +78,6 @@ type t = ; fs_external : bool ; keep_unit_names : bool ; effects : Config.effects_backend - ; lambda_lift_all : bool } let set_param = @@ -307,14 +306,6 @@ let options = None & info [ "effects" ] ~docv:"KIND" ~doc) in - let lambda_lift_all = - let doc = - "Lambda-lift all functions in the compilation result. This can improve the \ - performance of some programs on some engines (such as V8). Ignored when effects \ - are enabled." - in - Arg.(value & flag & info [ "lambda-lift-all" ] ~doc) - in let build_t common set_param @@ -344,7 +335,6 @@ let options = js_files keep_unit_names effects - lambda_lift_all shape_files = let inline_source_content = not sourcemap_don't_inline_content in let chop_extension s = try Filename.chop_extension s with Invalid_argument _ -> s in @@ -416,7 +406,6 @@ let options = ; source_map ; keep_unit_names ; effects - ; lambda_lift_all ; shape_files } in @@ -451,7 +440,6 @@ let options = $ js_files $ keep_unit_names $ effects - $ lambda_lift_all $ shape_files) in Term.ret t @@ -674,7 +662,6 @@ let options_runtime_only = ; keep_unit_names = false ; effects ; shape_files = [] - ; lambda_lift_all = false } in let t = diff --git a/compiler/bin-js_of_ocaml/cmd_arg.mli b/compiler/bin-js_of_ocaml/cmd_arg.mli index dbb33b79a5..79780ec8e8 100644 --- a/compiler/bin-js_of_ocaml/cmd_arg.mli +++ b/compiler/bin-js_of_ocaml/cmd_arg.mli @@ -51,7 +51,6 @@ type t = ; fs_external : bool ; keep_unit_names : bool ; effects : Config.effects_backend - ; lambda_lift_all : bool } val options : t Cmdliner.Term.t diff --git a/compiler/bin-js_of_ocaml/compile.ml b/compiler/bin-js_of_ocaml/compile.ml index dcc2a06376..deb995b991 100644 --- a/compiler/bin-js_of_ocaml/compile.ml +++ b/compiler/bin-js_of_ocaml/compile.ml @@ -156,7 +156,6 @@ let run ; keep_unit_names ; include_runtime ; effects - ; lambda_lift_all ; shape_files } = let source_map_base = @@ -280,7 +279,6 @@ let run ~wrap_with_fun ~source_map:(source_map_enabled source_map) ~formatter - ~lambda_lift_all code | `File, formatter -> let fs_instr1, fs_instr2 = @@ -302,7 +300,6 @@ let run ~shapes ?profile ~link - ~lambda_lift_all ~wrap_with_fun ~source_map:(source_map_enabled source_map) ~formatter diff --git a/compiler/lib/config.ml b/compiler/lib/config.ml index 65c45d39ca..9e11102a9c 100644 --- a/compiler/lib/config.ml +++ b/compiler/lib/config.ml @@ -106,6 +106,8 @@ module Flag = struct let es6 = o ~name:"es6" ~default:false let load_shapes_auto = o ~name:"load-shapes-auto" ~default:false + + let lambda_lift_all = o ~name:"lambda-lift-all" ~default:false end module Param = struct diff --git a/compiler/lib/config.mli b/compiler/lib/config.mli index fc545a3fc4..284c3a16f5 100644 --- a/compiler/lib/config.mli +++ b/compiler/lib/config.mli @@ -76,6 +76,8 @@ module Flag : sig val load_shapes_auto : unit -> bool + val lambda_lift_all : unit -> bool + val enable : string -> unit val disable : string -> unit diff --git a/compiler/lib/driver.ml b/compiler/lib/driver.ml index 5d4fb7d7f8..7b5899e46f 100644 --- a/compiler/lib/driver.ml +++ b/compiler/lib/driver.ml @@ -156,7 +156,6 @@ let effects_and_exact_calls ~keep_flow_data ~deadcode_sentinal ~shapes - ~lambda_lift_all (profile : Profile.t) p = let fast = @@ -177,7 +176,7 @@ let effects_and_exact_calls else Deadcode.f pure_fun p in let p = - match lambda_lift_all, Config.target (), Config.effects () with + match Config.(Flag.lambda_lift_all (), target (), effects ()) with | true, `JavaScript, `Disabled -> let to_lift = all_functions p in let p, _ = Lambda_lifting_simple.f ~to_lift p in @@ -715,7 +714,7 @@ let link_and_pack ?(standalone = true) ?(wrap_with_fun = `Iife) ?(link = `No) p |> pack ~wrap_with_fun ~standalone |> check_js -let optimize ~shapes ~profile ~keep_flow_data ~lambda_lift_all p = +let optimize ~shapes ~profile ~keep_flow_data p = let deadcode_sentinal = (* If deadcode is disabled, this field is just fresh variable *) Code.Var.fresh_n "dummy" @@ -728,12 +727,7 @@ let optimize ~shapes ~profile ~keep_flow_data ~lambda_lift_all p = | O2 -> o2 | O3 -> o3) +> specialize_js_once_after - +> effects_and_exact_calls - ~keep_flow_data - ~deadcode_sentinal - ~shapes - ~lambda_lift_all - profile + +> effects_and_exact_calls ~keep_flow_data ~deadcode_sentinal ~shapes profile +> map_fst5 (match Config.target (), Config.effects () with | `JavaScript, `Disabled -> Generate_closure.f @@ -753,26 +747,15 @@ let optimize ~shapes ~profile ~keep_flow_data ~lambda_lift_all p = let optimize_for_wasm ~shapes ~profile p = let optimized_code, global_flow_data = - optimize ~shapes ~profile ~keep_flow_data:true ~lambda_lift_all:false p + optimize ~shapes ~profile ~keep_flow_data:true p in ( optimized_code , match global_flow_data with | Some data -> data | None -> Global_flow.f ~fast:false optimized_code.program ) -let full - ~standalone - ~wrap_with_fun - ~shapes - ~profile - ~link - ~source_map - ~formatter - ~lambda_lift_all - p = - let optimized_code, _ = - optimize ~shapes ~profile ~keep_flow_data:false ~lambda_lift_all p - in +let full ~standalone ~wrap_with_fun ~shapes ~profile ~link ~source_map ~formatter p = + let optimized_code, _ = optimize ~shapes ~profile ~keep_flow_data:false p in let exported_runtime = not standalone in let emit formatter = generate ~exported_runtime ~wrap_with_fun ~warn_on_unhandled_effect:standalone @@ -792,26 +775,9 @@ let full shapes_v; emit formatter optimized_code, shapes_v -let full_no_source_map - ~formatter - ~shapes - ~standalone - ~wrap_with_fun - ~profile - ~link - ~lambda_lift_all - p = +let full_no_source_map ~formatter ~shapes ~standalone ~wrap_with_fun ~profile ~link p = let (_ : Source_map.info * _) = - full - ~shapes - ~standalone - ~wrap_with_fun - ~profile - ~link - ~source_map:false - ~formatter - ~lambda_lift_all - p + full ~shapes ~standalone ~wrap_with_fun ~profile ~link ~source_map:false ~formatter p in () @@ -823,36 +789,17 @@ let f ~link ~source_map ~formatter - ~lambda_lift_all p = - full - ~standalone - ~wrap_with_fun - ~shapes - ~profile - ~link - ~source_map - ~formatter - ~lambda_lift_all - p + full ~standalone ~wrap_with_fun ~shapes ~profile ~link ~source_map ~formatter p let f' ?(standalone = true) ?(wrap_with_fun = `Iife) ?(profile = Profile.O1) - ?(lambda_lift_all = false) ~link formatter p = - full_no_source_map - ~formatter - ~shapes:false - ~standalone - ~wrap_with_fun - ~profile - ~link - ~lambda_lift_all - p + full_no_source_map ~formatter ~shapes:false ~standalone ~wrap_with_fun ~profile ~link p let from_string ~prims ~debug s formatter = let p = Parse_bytecode.from_string ~prims ~debug s in @@ -863,5 +810,4 @@ let from_string ~prims ~debug s formatter = ~wrap_with_fun:`Anonymous ~profile:O1 ~link:`No - ~lambda_lift_all:false p diff --git a/compiler/lib/driver.mli b/compiler/lib/driver.mli index 3bff213d32..5630d18e50 100644 --- a/compiler/lib/driver.mli +++ b/compiler/lib/driver.mli @@ -43,7 +43,6 @@ val f : -> link:[ `All | `All_from of string list | `Needed | `No ] -> source_map:bool -> formatter:Pretty_print.t - -> lambda_lift_all:bool -> Code.program -> Source_map.info * Shape.t StringMap.t @@ -51,7 +50,6 @@ val f' : ?standalone:bool -> ?wrap_with_fun:[ `Iife | `Anonymous | `Named of string ] -> ?profile:Profile.t - -> ?lambda_lift_all:bool -> link:[ `All | `All_from of string list | `Needed | `No ] -> Pretty_print.t -> Code.program From e3c5496c67af6ee0c11ed766f6fd6528fa509e9e Mon Sep 17 00:00:00 2001 From: Olivier Nicole Date: Mon, 1 Sep 2025 18:26:57 +0200 Subject: [PATCH 5/5] Add test for --enable lambda-lift-all --- .../tests-compiler/direct_calls_lift_all.ml | 215 ++++++++++++++++++ compiler/tests-compiler/dune.inc | 15 ++ compiler/tests-compiler/util/util.ml | 29 ++- compiler/tests-compiler/util/util.mli | 4 + 4 files changed, 261 insertions(+), 2 deletions(-) create mode 100644 compiler/tests-compiler/direct_calls_lift_all.ml diff --git a/compiler/tests-compiler/direct_calls_lift_all.ml b/compiler/tests-compiler/direct_calls_lift_all.ml new file mode 100644 index 0000000000..68760a3532 --- /dev/null +++ b/compiler/tests-compiler/direct_calls_lift_all.ml @@ -0,0 +1,215 @@ +(* Js_of_ocaml compiler + * http://www.ocsigen.org/js_of_ocaml/ + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU Lesser General Public License as published by + * the Free Software Foundation, with linking exception; + * either version 2.1 of the License, or (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public License + * along with this program; if not, write to the Free Software + * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + *) + +open Util + +let%expect_test "direct calls with --effects=none --disable lambda-lift-all" = + let code = + compile_and_parse + ~lambda_lift_all:true + {| + let l = ref [] + + (* Arity of the argument of a function / direct call *) + let test1 () = + let f g x = + l := (fun () -> ()) :: !l; (* pervent inlining *) + try g x with e -> raise e in + ignore (f (fun x -> x + 1) 7); + ignore (f (fun x -> x *. 2.) 4.) + + (* Arity of the argument of a function / CPS call *) + let test2 () = + let f g x = + l := (fun () -> ()) :: !l; (* pervent inlining *) + try g x with e -> raise e in + ignore (f (fun x -> x + 1) 7); + ignore (f (fun x -> x ^ "a") "a") + + (* Arity of functions in a functor / direct call *) + let test3 x = + let module F(_ : sig end) = struct + let r = ref 0 + let () = for _ = 0 to 2 do incr r done (* pervent inlining *) + let f x = x + 1 + end in + let module M1 = F (struct end) in + let module M2 = F (struct end) in + (M1.f 1, M2.f 2) + + (* Arity of functions in a functor / CPS call *) + let test4 x = + let module F(_ : sig end) = + struct + let r = ref 0 + let () = for _ = 0 to 2 do incr r done (* pervent inlining *) + let f x = Printf.printf "%d" x + end in + let module M1 = F (struct end) in + let module M2 = F (struct end) in + M1.f 1; M2.f 2 +|} + in + print_fun_decl code (Some "test1"); + print_fun_decl code (Some "test2"); + print_fun_decl code (Some "test3"); + print_fun_decl code (Some "test4"); + [%expect + {| + function test1(param){var f = f$2(); f(_f_(), 7); f(_g_(), 4.); return 0;} + //end + function test2(param){var f = f$1(); f(_c_(), 7); f(_d_(), cst_a); return 0;} + //end + function test3(x){ + var F = F$0(), M1 = F([0]), M2 = F([0]), _g_ = M2[2].call(null, 2); + return [0, M1[2].call(null, 1), _g_]; + } + //end + function test4(x){ + var F$0 = F(), M1 = F$0([0]), M2 = F$0([0]); + M1[2].call(null, 1); + return M2[2].call(null, 2); + } + //end + |}] + +let%expect_test "direct calls with --effects=cps" = + let code = + compile_and_parse + ~lambda_lift_all:true + ~effects:`Cps + {| + let l = ref [] + + (* Arity of the argument of a function / direct call *) + let test1 () = + let f g x = + l := (fun () -> ()) :: !l; (* pervent inlining *) + try g x with e -> raise e in + ignore (f (fun x -> x + 1) 7); + ignore (f (fun x -> x *. 2.) 4.) + + (* Arity of the argument of a function / CPS call *) + let test2 () = + let f g x = + l := (fun () -> ()) :: !l; (* pervent inlining *) + try g x with e -> raise e in + ignore (f (fun x -> x + 1) 7); + ignore (f (fun x -> x ^ "a") "a") + + (* Arity of functions in a functor / direct call *) + let test3 x = + let module F(_ : sig end) = struct + let r = ref 0 + let () = for _ = 0 to 2 do incr r done (* pervent inlining *) + let f x = x + 1 + end in + let module M1 = F (struct end) in + let module M2 = F (struct end) in + (M1.f 1, M2.f 2) + + (* Arity of functions in a functor / CPS call *) + let test4 x = + let module F(_ : sig end) = + struct + let r = ref 0 + let () = for _ = 0 to 2 do incr r done (* pervent inlining *) + let f x = Printf.printf "%d" x + end in + let module M1 = F (struct end) in + let module M2 = F (struct end) in + M1.f 1; M2.f 2 +|} + in + print_fun_decl code (Some "test1"); + print_fun_decl code (Some "test2"); + print_fun_decl code (Some "test3"); + print_fun_decl code (Some "test4"); + [%expect + {| + function test1(param, cont){ + function f(g, x){ + l[1] = [0, function(param, cont){return cont(0);}, l[1]]; + try{g(); return;} + catch(e$0){ + var e = caml_wrap_exception(e$0); + throw caml_maybe_attach_backtrace(e, 0); + } + } + f(function(x){}); + f(function(x){}); + return cont(0); + } + //end + function test2(param, cont){ + function f(g, x, cont){ + l[1] = [0, function(param, cont){return cont(0);}, l[1]]; + runtime.caml_push_trap + (function(e){ + var raise = caml_pop_trap(), e$0 = caml_maybe_attach_backtrace(e, 0); + return raise(e$0); + }); + return caml_exact_trampoline_cps_call + (g, x, function(_b_){caml_pop_trap(); return cont();}); + } + return caml_exact_trampoline_cps_call$0 + (f, + function(x, cont){return cont();}, + 7, + function(_b_){ + return caml_exact_trampoline_cps_call$0 + (f, + function(x, cont){ + return caml_trampoline_cps_call3 + (Stdlib[28], x, cst_a$0, cont); + }, + cst_a, + function(_b_){return cont(0);}); + }); + } + //end + function test3(x, cont){ + function F(symbol){ + var r = [0, 0], for$ = 0; + for(;;){r[1]++; var _b_ = for$ + 1 | 0; if(2 === for$) break; for$ = _b_;} + function f(x){return x + 1 | 0;} + return [0, , f]; + } + var M1 = F(), M2 = F(), _b_ = M2[2].call(null, 2); + return cont([0, M1[2].call(null, 1), _b_]); + } + //end + function test4(x, cont){ + function F(symbol){ + var r = [0, 0], for$ = 0; + for(;;){r[1]++; var _b_ = for$ + 1 | 0; if(2 === for$) break; for$ = _b_;} + function f(x, cont){ + return caml_trampoline_cps_call3(Stdlib_Printf[2], _a_, x, cont); + } + return [0, , f]; + } + var M1 = F(), M2 = F(); + return caml_exact_trampoline_cps_call + (M1[2], + 1, + function(_a_){ + return caml_exact_trampoline_cps_call(M2[2], 2, cont); + }); + } + //end + |}] diff --git a/compiler/tests-compiler/dune.inc b/compiler/tests-compiler/dune.inc index 0d8a74e6c4..8759a17b22 100644 --- a/compiler/tests-compiler/dune.inc +++ b/compiler/tests-compiler/dune.inc @@ -89,6 +89,21 @@ (preprocess (pps ppx_expect))) +(library + ;; compiler/tests-compiler/direct_calls_lift_all.ml + (name direct_calls_lift_all_15) + (enabled_if true) + (modules direct_calls_lift_all) + (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper) + (inline_tests + (enabled_if true) + (deps + (file %{project_root}/compiler/bin-js_of_ocaml/js_of_ocaml.exe) + (file %{project_root}/compiler/bin-jsoo_minify/jsoo_minify.exe))) + (flags (:standard -open Jsoo_compiler_expect_tests_helper)) + (preprocess + (pps ppx_expect))) + (library ;; compiler/tests-compiler/effects.ml (name effects_15) diff --git a/compiler/tests-compiler/util/util.ml b/compiler/tests-compiler/util/util.ml index 97ca0acc8d..a6673124ca 100644 --- a/compiler/tests-compiler/util/util.ml +++ b/compiler/tests-compiler/util/util.ml @@ -266,6 +266,7 @@ let extract_sourcemap file = let compile_to_javascript ?(flags = []) ?(use_js_string = false) + ?(lambda_lift_all = false) ?(effects = `Disabled) ?(werror = true) ~pretty @@ -283,6 +284,9 @@ let compile_to_javascript ; (if use_js_string then [ "--enable=use-js-string" ] else [ "--disable=use-js-string" ]) + ; (if lambda_lift_all + then [ "--enable=lambda-lift-all" ] + else [ "--disable=lambda-lift-all" ]) ; flags ; (if werror then [ "--Werror" ] else []) ] @@ -324,17 +328,26 @@ let compile_bc_to_javascript ?flags ?effects ?use_js_string + ?lambda_lift_all ?(pretty = true) ?(sourcemap = true) ?werror file = Filetype.path_of_bc_file file - |> compile_to_javascript ?flags ?effects ?use_js_string ?werror ~pretty ~sourcemap + |> compile_to_javascript + ?flags + ?effects + ?use_js_string + ?lambda_lift_all + ?werror + ~pretty + ~sourcemap let compile_cmo_to_javascript ?(flags = []) ?effects ?use_js_string + ?lambda_lift_all ?(pretty = true) ?(sourcemap = true) ?werror @@ -343,6 +356,7 @@ let compile_cmo_to_javascript |> compile_to_javascript ?effects ?use_js_string + ?lambda_lift_all ?werror ~flags:([ "--disable"; "header" ] @ flags) ~pretty @@ -578,6 +592,7 @@ let compile_and_parse_whole_program ?flags ?effects ?use_js_string + ?lambda_lift_all ?unix ?werror s = @@ -591,11 +606,20 @@ let compile_and_parse_whole_program ?flags ?effects ?use_js_string + ?lambda_lift_all ?werror ~sourcemap:debug |> parse_js) -let compile_and_parse ?(debug = true) ?pretty ?flags ?effects ?use_js_string ?werror s = +let compile_and_parse + ?(debug = true) + ?pretty + ?flags + ?effects + ?use_js_string + ?lambda_lift_all + ?werror + s = with_temp_dir ~f:(fun () -> s |> Filetype.ocaml_text_of_string @@ -606,6 +630,7 @@ let compile_and_parse ?(debug = true) ?pretty ?flags ?effects ?use_js_string ?we ?flags ?effects ?use_js_string + ?lambda_lift_all ?werror ~sourcemap:debug |> parse_js) diff --git a/compiler/tests-compiler/util/util.mli b/compiler/tests-compiler/util/util.mli index ae15ec1e43..b306f3d27f 100644 --- a/compiler/tests-compiler/util/util.mli +++ b/compiler/tests-compiler/util/util.mli @@ -36,6 +36,7 @@ val compile_cmo_to_javascript : ?flags:string list -> ?effects:[ `Disabled | `Cps | `Double_translation ] -> ?use_js_string:bool + -> ?lambda_lift_all:bool -> ?pretty:bool -> ?sourcemap:bool -> ?werror:bool @@ -46,6 +47,7 @@ val compile_bc_to_javascript : ?flags:string list -> ?effects:[ `Disabled | `Cps | `Double_translation ] -> ?use_js_string:bool + -> ?lambda_lift_all:bool -> ?pretty:bool -> ?sourcemap:bool -> ?werror:bool @@ -99,6 +101,7 @@ val compile_and_parse : -> ?flags:string list -> ?effects:[ `Disabled | `Cps | `Double_translation ] -> ?use_js_string:bool + -> ?lambda_lift_all:bool -> ?werror:bool -> string -> Javascript.program @@ -109,6 +112,7 @@ val compile_and_parse_whole_program : -> ?flags:string list -> ?effects:[ `Disabled | `Cps | `Double_translation ] -> ?use_js_string:bool + -> ?lambda_lift_all:bool -> ?unix:bool -> ?werror:bool -> string