From 0ca6f360a476e3116a7dd336ff968633c48e470c Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Sun, 9 Aug 2026 10:31:49 +0200 Subject: [PATCH 1/2] Make Lambda invariant checking explicit Replace the compile-time RELEASE distinction with a -check-lam runtime option. This keeps dev, release, and static compilers functionally identical while leaving Dune profiles responsible only for native optimization and browser selection. Enable the option for the main compiler test project so Lambda invariants are exercised across ordinary local and CI test compilations and appear in coverage. Include the pass name in failures to make regressions actionable. Keep -bs-diagnose as the umbrella diagnostic mode: it enables Lambda checks and owns all Lambda and JavaScript dump calls. Gating dumps at their call sites makes that relationship explicit and avoids duplicated configuration checks inside the dump implementations. Remove the dump-specific BROWSER conditionals because the browser API cannot activate diagnose and js_of_ocaml eliminates the unreachable dump paths. A measured playground build had identical raw size, so retaining compile-time stubs added complexity without reducing the bundle. Signed-off-by: Cristiano Calcagno --- analysis/dune | 7 --- compiler/bsc/rescript_compiler_main.ml | 3 + compiler/common/js_config.ml | 1 + compiler/common/js_config.mli | 3 + compiler/core/js_pass_debug.cppo.ml | 27 +++------ compiler/core/lam_check.ml | 13 +++-- compiler/core/lam_check.mli | 2 +- compiler/core/lam_compile_main.cppo.ml | 80 ++++++++++++++------------ compiler/core/lam_util.cppo.ml | 23 ++------ compiler/dune | 12 ++-- tests/tests/rescript.json | 1 + 11 files changed, 78 insertions(+), 94 deletions(-) diff --git a/analysis/dune b/analysis/dune index 9b02abb4b56..9ffdb2b6c57 100644 --- a/analysis/dune +++ b/analysis/dune @@ -1,16 +1,9 @@ (dirs bin src reactive reanalyze vendor) (env - (dev - (env-vars - (CPPO_FLAGS -U=RELEASE))) (release - (env-vars - (CPPO_FLAGS -D=RELEASE)) (ocamlopt_flags (:standard -O3 -unbox-closures))) (static - (env-vars - (CPPO_FLAGS -D=RELEASE)) (ocamlopt_flags (:standard -O3 -unbox-closures)))) diff --git a/compiler/bsc/rescript_compiler_main.ml b/compiler/bsc/rescript_compiler_main.ml index a4d273aac71..86102d0701a 100644 --- a/compiler/bsc/rescript_compiler_main.ml +++ b/compiler/bsc/rescript_compiler_main.ml @@ -410,6 +410,9 @@ let command_line_flags : (string * Bsc_args.spec * string) array = clear Js_config.cross_module_inline, "*internal* Disable cross module inlining(experimental)" ); ("-bs-diagnose", set Js_config.diagnose, "*internal* More verbose output"); + ( "-check-lam", + set Js_config.check_lam, + "*internal* Check Lam invariants after optimization passes" ); ( "-bs-no-check-div-by-zero", clear Js_config.check_div_by_zero, "*internal* unsafe mode, don't check div by zero and mod by zero" ); diff --git a/compiler/common/js_config.ml b/compiler/common/js_config.ml index f7a87907387..ac68b678d3a 100644 --- a/compiler/common/js_config.ml +++ b/compiler/common/js_config.ml @@ -33,6 +33,7 @@ let no_version_header = ref false let directives = ref [] let cross_module_inline = ref false let diagnose = ref false +let check_lam = ref false (* let (//) = Filename.concat *) diff --git a/compiler/common/js_config.mli b/compiler/common/js_config.mli index a57d13af401..e138de34b00 100644 --- a/compiler/common/js_config.mli +++ b/compiler/common/js_config.mli @@ -52,6 +52,9 @@ val cross_module_inline : bool ref val diagnose : bool ref (** diagnose option *) +val check_lam : bool ref +(** check Lam invariants after optimization passes *) + val no_builtin_ppx : bool ref (** options for builtin ppx *) diff --git a/compiler/core/js_pass_debug.cppo.ml b/compiler/core/js_pass_debug.cppo.ml index 3970aa3fbd8..16bd7470a87 100644 --- a/compiler/core/js_pass_debug.cppo.ml +++ b/compiler/core/js_pass_debug.cppo.ml @@ -26,26 +26,13 @@ -#if (defined BROWSER || defined RELEASE) -let dump _ (prog : J.program) = - prog -#else let log_counter = ref 0 let dump name (prog : J.program) = - begin - let () = - if !Js_config.diagnose - then - begin - incr log_counter ; - Ext_log.dwarn ~__POS__ "\n@[[TIME:]%s: %f@]@." name (Sys.time () *. 1000.); - Ext_pervasives.with_file_as_chan - (Ext_filename.new_extension !Location.input_name - (Printf.sprintf ".%02d.%s.jsx" !log_counter name) - ) (fun chan -> Js_dump_program.dump_program prog chan ) - end in - prog - end -#endif - + incr log_counter; + Ext_log.dwarn ~__POS__ "\n@[[TIME:]%s: %f@]@." name (Sys.time () *. 1000.); + Ext_pervasives.with_file_as_chan + (Ext_filename.new_extension !Location.input_name + (Printf.sprintf ".%02d.%s.jsx" !log_counter name)) + (fun chan -> Js_dump_program.dump_program prog chan); + prog diff --git a/compiler/core/lam_check.ml b/compiler/core/lam_check.ml index f5e63d45afe..db9bc92e43c 100644 --- a/compiler/core/lam_check.ml +++ b/compiler/core/lam_check.ml @@ -27,19 +27,21 @@ 1. variables are not bound twice 2. all variables are of right scope *) -let check file lam = +let check ~file ~pass lam = let defined_variables = Hash_set_ident.create 1000 in let success = ref true in let use (id : Ident.t) = if not @@ Hash_set_ident.mem defined_variables id then ( Format.fprintf Format.err_formatter - "\n[SANITY]:%s/%d used before defined in %s@." id.name id.stamp file; + "\n[SANITY after %s]:%s/%d used before defined in %s@." pass id.name + id.stamp file; success := false) in let def (id : Ident.t) = if Hash_set_ident.mem defined_variables id then ( - Format.fprintf Format.err_formatter "\n[SANITY]:%s/%d bound twice in %s@." - id.name id.stamp file; + Format.fprintf Format.err_formatter + "\n[SANITY after %s]:%s/%d bound twice in %s@." pass id.name id.stamp + file; success := false) else Hash_set_ident.add defined_variables id in @@ -84,7 +86,8 @@ let check file lam = Ext_option.iter default (fun x -> check_staticfails x cxt) | Lstaticraise (i, args) -> if Set_int.mem cxt i then check_list args cxt - else failwith ("exit " ^ string_of_int i ^ " unbound") + else + failwith (Printf.sprintf "exit %d unbound after %s in %s" i pass file) | Lstaticcatch (e1, (j, _vars), e2) -> check_staticfails e1 (Set_int.add cxt j); check_staticfails e2 cxt diff --git a/compiler/core/lam_check.mli b/compiler/core/lam_check.mli index 5522308a53a..2e4b08bc6e0 100644 --- a/compiler/core/lam_check.mli +++ b/compiler/core/lam_check.mli @@ -22,4 +22,4 @@ * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) -val check : string -> Lam.t -> Lam.t +val check : file:string -> pass:string -> Lam.t -> Lam.t diff --git a/compiler/core/lam_compile_main.cppo.ml b/compiler/core/lam_compile_main.cppo.ml index aa8677ccedd..59966e97b27 100644 --- a/compiler/core/lam_compile_main.cppo.ml +++ b/compiler/core/lam_compile_main.cppo.ml @@ -116,16 +116,20 @@ let no_side_effects (rest : Lam_group.t list) : string option = else None (* TODO :*)) -let _d = fun s lam -> -#ifndef RELEASE - Lam_util.dump s lam ; - Ext_log.dwarn ~__POS__ "START CHECKING PASS %s@." s; - ignore @@ Lam_check.check !Location.input_name lam; - Ext_log.dwarn ~__POS__ "FINISH CHECKING PASS %s@." s; -#endif +let _d = fun s lam -> + let diagnose = !Js_config.diagnose in + if diagnose then begin + Lam_util.dump s lam; + Ext_log.dwarn ~__POS__ "START CHECKING PASS %s@." s + end; + if !Js_config.check_lam || diagnose then begin + ignore @@ Lam_check.check ~file:!Location.input_name ~pass:s lam; + if diagnose then Ext_log.dwarn ~__POS__ "FINISH CHECKING PASS %s@." s + end; lam -let _j = Js_pass_debug.dump +let _j name program = + if !Js_config.diagnose then Js_pass_debug.dump name program else program (** Actually simplify_lets is kind of global optimization since it requires you to know whether it's used or not @@ -136,13 +140,13 @@ let compile (lam : Lambda.lambda) = let export_ident_sets = Set_ident.of_list export_idents in (* To make toplevel happy - reentrant for js-demo *) - let () = -#ifndef RELEASE + let () = + if !Js_config.diagnose then begin Ext_list.iter export_idents - (fun id -> Ext_log.dwarn ~__POS__ "export idents: %s/%d" id.name id.stamp) ; -#endif - Lam_compile_env.reset () ; - in + (fun id -> Ext_log.dwarn ~__POS__ "export idents: %s/%d" id.name id.stamp) + end; + Lam_compile_env.reset () + in let lam, may_required_modules = Lam_convert.convert export_ident_sets lam in @@ -160,12 +164,12 @@ let compile |> _d "flattern1" |> Lam_pass_exits.simplify_exits |> _d "simplyf_exits" - |> (fun lam -> Lam_pass_collect.collect_info meta lam; -#ifndef RELEASE - let () = - Ext_log.dwarn ~__POS__ "Before simplify_alias: %a@." Lam_stats.print meta in -#endif - lam) + |> (fun lam -> + Lam_pass_collect.collect_info meta lam; + if !Js_config.diagnose then + Ext_log.dwarn ~__POS__ "Before simplify_alias: %a@." Lam_stats.print + meta; + lam) |> Lam_pass_remove_alias.simplify_alias meta |> _d "simplify_alias" |> Lam_pass_deep_flatten.deep_flatten @@ -201,43 +205,43 @@ let compile |> _d "scc" *) |> Lam_pass_exits.simplify_exits |> _d "simplify_lets" -#ifndef RELEASE - |> (fun lam -> - let () = - Ext_log.dwarn ~__POS__ "Before coercion: %a@." Lam_stats.print meta in - Lam_check.check !Location.input_name lam - ) -#endif + |> (fun lam -> + if !Js_config.diagnose then + Ext_log.dwarn ~__POS__ "Before coercion: %a@." Lam_stats.print meta; + lam) in let ({Lam_coercion.groups = groups } as coerced_input , meta) = Lam_coercion.coerce_and_group_big_lambda meta lam in -#ifndef RELEASE let () = - Ext_log.dwarn ~__POS__ "After coercion: %a@." Lam_stats.print meta ; - if !Js_config.diagnose then + if !Js_config.diagnose then begin + Ext_log.dwarn ~__POS__ "After coercion: %a@." Lam_stats.print meta; let f = Ext_filename.new_extension !Location.input_name ".lambda" in Ext_fmt.with_file_as_pp f begin fun fmt -> Format.pp_print_list ~pp_sep:Format.pp_print_newline Lam_group.pp_group fmt (coerced_input.groups) - end; + end + end in -#endif let maybe_pure = no_side_effects groups in -#ifndef RELEASE -let () = Ext_log.dwarn ~__POS__ "\n@[[TIME:]Pre-compile: %f@]@." (Sys.time () *. 1000.) in -#endif +let () = + if !Js_config.diagnose then + Ext_log.dwarn ~__POS__ "\n@[[TIME:]Pre-compile: %f@]@." + (Sys.time () *. 1000.) +in let body = Ext_list.map groups (fun group -> compile_group output_prefix meta group) |> Js_output.concat |> Js_output.output_as_block in -#ifndef RELEASE -let () = Ext_log.dwarn ~__POS__ "\n@[[TIME:]Post-compile: %f@]@." (Sys.time () *. 1000.) in -#endif +let () = + if !Js_config.diagnose then + Ext_log.dwarn ~__POS__ "\n@[[TIME:]Post-compile: %f@]@." + (Sys.time () *. 1000.) +in (* The file is not big at all compared with [cmo] *) (* Ext_marshal.to_file (Ext_path.chop_extension filename ^ ".mj") js; *) let meta_exports = meta.exports in diff --git a/compiler/core/lam_util.cppo.ml b/compiler/core/lam_util.cppo.ml index 9d7334930c9..6a292c241fe 100644 --- a/compiler/core/lam_util.cppo.ml +++ b/compiler/core/lam_util.cppo.ml @@ -231,25 +231,14 @@ let field_flatten_get | Some _ | None -> lam () -#if (defined BROWSER || defined RELEASE) -let dump ext lam = - () -#else let log_counter = ref 0 let dump ext lam = - if !Js_config.diagnose - then - (* ATTENTION: easy to introduce a bug during refactoring when forgeting `begin` `end`*) - begin - incr log_counter; - Ext_log.dwarn ~__POS__ "\n@[[TIME:]%s: %f@]@." ext (Sys.time () *. 1000.); - Lam_print.serialize - (Ext_filename.new_extension - !Location.input_name - (Printf.sprintf ".%02d%s.lam" !log_counter ext) - ) lam; - end -#endif + incr log_counter; + Ext_log.dwarn ~__POS__ "\n@[[TIME:]%s: %f@]@." ext (Sys.time () *. 1000.); + Lam_print.serialize + (Ext_filename.new_extension !Location.input_name + (Printf.sprintf ".%02d%s.lam" !log_counter ext)) + lam diff --git a/compiler/dune b/compiler/dune index 436e4159679..c56cb09eadf 100644 --- a/compiler/dune +++ b/compiler/dune @@ -12,21 +12,21 @@ syntax) (env - (dev - (env-vars - (CPPO_FLAGS -U=RELEASE))) (release (env-vars - (CPPO_FLAGS -D=RELEASE)) + (CPPO_FLAGS -U=BROWSER)) (ocamlopt_flags (:standard -O3 -unbox-closures))) (static (env-vars - (CPPO_FLAGS -D=RELEASE)) + (CPPO_FLAGS -U=BROWSER)) (ocamlopt_flags (:standard -O3 -unbox-closures))) (browser (env-vars (CPPO_FLAGS -D=BROWSER)) (ocamlopt_flags - (:standard -O3 -unbox-closures)))) + (:standard -O3 -unbox-closures))) + (_ + (env-vars + (CPPO_FLAGS -U=BROWSER)))) diff --git a/tests/tests/rescript.json b/tests/tests/rescript.json index b6ca94d2f48..b79f9f59b20 100644 --- a/tests/tests/rescript.json +++ b/tests/tests/rescript.json @@ -13,6 +13,7 @@ }, "dependencies": ["@rescript/react"], "compiler-flags": [ + "-check-lam", "-w -3-6-26-27-29-30-32..40-44-45-52-60-9-106+104", "-warn-error A" ] From afa22e6937d8d72e22498e9b6b16751ce4930859 Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Sun, 9 Aug 2026 11:04:50 +0200 Subject: [PATCH 2/2] Document Lambda invariant checking Signed-off-by: Cristiano Calcagno --- CHANGELOG.md | 2 ++ 1 file changed, 2 insertions(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index 22c6c8ab88c..ac40791f655 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -33,6 +33,8 @@ #### :house: Internal +- Add the `-check-lam` compiler option, enable Lambda invariant checking in compiler tests, and remove build-profile-dependent checking. https://github.com/rescript-lang/rescript/pull/8534 + # 13.0.0-alpha.5 #### :boom: Breaking Change