diff --git a/CHANGELOG.md b/CHANGELOG.md index 22c6c8ab88..ac40791f65 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 diff --git a/analysis/dune b/analysis/dune index 9b02abb4b5..9ffdb2b6c5 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 a4d273aac7..86102d0701 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 f7a8790738..ac68b678d3 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 a57d13af40..e138de34b0 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 3970aa3fbd..16bd7470a8 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 f5e63d45af..db9bc92e43 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 5522308a53..2e4b08bc6e 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 aa8677cced..59966e97b2 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 9d7334930c..6a292c241f 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 436e415967..c56cb09ead 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 b6ca94d2f4..b79f9f59b2 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" ]