diff --git a/compiler/bsc/rescript_compiler_driver.ml b/compiler/bsc/rescript_compiler_driver.ml index f2b6cd152f..e467e6fe9a 100644 --- a/compiler/bsc/rescript_compiler_driver.ml +++ b/compiler/bsc/rescript_compiler_driver.ml @@ -55,48 +55,52 @@ let setup_outcome_printer () = Lazy.force Res_outcome_printer.setup let setup_runtime_path path = Runtime_package.set_path path let process_file sourcefile ?kind ppf = - (* The input name must identify the source when writing the binary AST. *) - setup_outcome_printer (); - Error_message_utils_support.setup (); - let kind = - match kind with - | None -> - Ext_file_extensions.classify_input - (Ext_filename.get_extension_maybe sourcefile) - | Some kind -> kind - in - let res = - match kind with - | Res -> - let sourcefile = set_abs_input_name sourcefile in - Js_implementation.implementation - ~parser: - (Res_driver.parse_implementation - ~ignore_parse_errors:!((Clflags.current ()).ignore_parse_errors)) - ppf sourcefile - | Resi -> - let sourcefile = set_abs_input_name sourcefile in - Js_implementation.interface - ~parser: - (Res_driver.parse_interface - ~ignore_parse_errors:!((Clflags.current ()).ignore_parse_errors)) - ppf sourcefile - | Intf_ast -> Js_implementation.interface_mliast ppf sourcefile - (* The printer setup is done in the runtime depends on + Compiler_phase_trace.section "request.other" (fun () -> + (* The input name must identify the source when writing the binary AST. *) + setup_outcome_printer (); + Error_message_utils_support.setup (); + let kind = + match kind with + | None -> + Ext_file_extensions.classify_input + (Ext_filename.get_extension_maybe sourcefile) + | Some kind -> kind + in + let res = + match kind with + | Res -> + let sourcefile = set_abs_input_name sourcefile in + Js_implementation.implementation + ~parser: + (Res_driver.parse_implementation + ~ignore_parse_errors: + !((Clflags.current ()).ignore_parse_errors)) + ppf sourcefile + | Resi -> + let sourcefile = set_abs_input_name sourcefile in + Js_implementation.interface + ~parser: + (Res_driver.parse_interface + ~ignore_parse_errors: + !((Clflags.current ()).ignore_parse_errors)) + ppf sourcefile + | Intf_ast -> Js_implementation.interface_mliast ppf sourcefile + (* The printer setup is done in the runtime depends on the content of ast *) - | Impl_ast -> Js_implementation.implementation_mlast ppf sourcefile - | Mlmap -> - Location.set_input_name sourcefile; - Js_implementation.implementation_map ppf sourcefile - | Cmi -> - let cmi_sign = (Cmi_format.read_cmi sourcefile).cmi_sign in - let output = Compiler_request_output.stdout_formatter () in - Printtyp.signature output cmi_sign; - Format.pp_print_newline output () - | Unknown -> Bsc_args.bad_arg ("don't know what to do with " ^ sourcefile) - in - res + | Impl_ast -> Js_implementation.implementation_mlast ppf sourcefile + | Mlmap -> + Location.set_input_name sourcefile; + Js_implementation.implementation_map ppf sourcefile + | Cmi -> + let cmi_sign = (Cmi_format.read_cmi sourcefile).cmi_sign in + let output = Compiler_request_output.stdout_formatter () in + Printtyp.signature output cmi_sign; + Format.pp_print_newline output () + | Unknown -> + Bsc_args.bad_arg ("don't know what to do with " ^ sourcefile) + in + res) let reprint_source_file sourcefile = let kind = @@ -597,50 +601,53 @@ let with_fresh_request_states ~cwd action = .with_fresh ~cwd action))))))))))))) let run_argv ?run_external ~cwd argv = - with_fresh_request_states ~cwd (fun () -> - reset_state ~new_request:true (); - Cmt_format.set_args argv; - let execute () = - try - Bsc_args.parse_exn ~argv (command_line_flags ()) anonymous ~usage; - 0 - with - | Request_exit code -> code - | Bsc_args.Help message -> - Compiler_request_output.write_stdout message; - 0 - | Res_driver.Already_reported -> 1 - | Bsc_args.Bad msg -> - Format.fprintf (ppf ()) "%s@." msg; - 2 - | x -> - Location.report_exception (ppf ()) x; - 2 - in - let run_with_external_owner action = - match run_external with - | None -> action () - | Some run_external -> - Ccomp.with_command_runner - (fun command -> - let status, stdout, stderr = run_external command in - Compiler_request_output.write_stdout stdout; - Format.pp_print_string (ppf ()) stderr; - status) - action - in - let exit_code, stdout, stderr = - Fun.protect - (fun () -> - Compiler_request_output.with_capture (fun () -> - Misc.Color.set_color_tag_handling - (Compiler_request_output.stdout_formatter ()); - Misc.Color.set_color_tag_handling - (Compiler_request_output.stderr_formatter ()); - run_with_external_owner execute)) - ~finally:reset_state - in - {exit_code; stdout; stderr}) + let input = argv.(Array.length argv - 1) in + Compiler_phase_trace.request ~cwd ~input (fun () -> + with_fresh_request_states ~cwd (fun () -> + Compiler_phase_trace.section "request.reset" (fun () -> + reset_state ~new_request:true ()); + Cmt_format.set_args argv; + let execute () = + try + Bsc_args.parse_exn ~argv (command_line_flags ()) anonymous ~usage; + 0 + with + | Request_exit code -> code + | Bsc_args.Help message -> + Compiler_request_output.write_stdout message; + 0 + | Res_driver.Already_reported -> 1 + | Bsc_args.Bad msg -> + Format.fprintf (ppf ()) "%s@." msg; + 2 + | x -> + Location.report_exception (ppf ()) x; + 2 + in + let run_with_external_owner action = + match run_external with + | None -> action () + | Some run_external -> + Ccomp.with_command_runner + (fun command -> + let status, stdout, stderr = run_external command in + Compiler_request_output.write_stdout stdout; + Format.pp_print_string (ppf ()) stderr; + status) + action + in + let exit_code, stdout, stderr = + Fun.protect + (fun () -> + Compiler_request_output.with_capture (fun () -> + Misc.Color.set_color_tag_handling + (Compiler_request_output.stdout_formatter ()); + Misc.Color.set_color_tag_handling + (Compiler_request_output.stderr_formatter ()); + run_with_external_owner execute)) + ~finally:reset_state + in + {exit_code; stdout; stderr})) let run_request ~run_external ~cwd ~argv ~input = let logical_argv = Array.of_list ("bsc" :: (argv @ [input])) in diff --git a/compiler/core/bs_cmi_load.ml b/compiler/core/bs_cmi_load.ml index 4e1d5e56c8..a0df4ee6b7 100644 --- a/compiler/core/bs_cmi_load.ml +++ b/compiler/core/bs_cmi_load.ml @@ -23,33 +23,36 @@ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) let load_cmi ~unit_name : Env.Persistent_signature.t option = - (* On case-insensitive filesystems a lowercase alias can remain visible to + Compiler_phase_trace.dependency ("dependency.search_open:" ^ unit_name) + (fun () -> + (* On case-insensitive filesystems a lowercase alias can remain visible to [Sys.file_exists] briefly after its CMI is removed. Open each candidate once and parse that descriptor, so a vanished CMI is a missing module. *) - let name = unit_name ^ ".cmi" in - let lower_name = String.uncapitalize_ascii name in - let rec find = function - | [] -> None - | directory :: rest -> - let rec try_names = function - | [] -> find rest - | name :: names -> ( - let filename = Filename.concat directory name in - let path = Compiler_request_state.resolve_path filename in - match Unix.openfile path [Unix.O_RDONLY] 0 with - | descriptor -> - let channel = Unix.in_channel_of_descr descriptor in - let cmi = - Fun.protect - (fun () -> Cmi_format.read_cmi_channel filename channel) - ~finally:(fun () -> close_in_noerr channel) - in - Some Env.Persistent_signature.{filename; cmi} - | exception Unix.Unix_error ((Unix.ENOENT | Unix.ENOTDIR), _, _) -> - try_names names - | exception Unix.Unix_error (error, _, _) -> - raise (Sys_error (path ^ ": " ^ Unix.error_message error))) + let name = unit_name ^ ".cmi" in + let lower_name = String.uncapitalize_ascii name in + let rec find = function + | [] -> None + | directory :: rest -> + let rec try_names = function + | [] -> find rest + | name :: names -> ( + let filename = Filename.concat directory name in + let path = Compiler_request_state.resolve_path filename in + match Unix.openfile path [Unix.O_RDONLY] 0 with + | descriptor -> + let channel = Unix.in_channel_of_descr descriptor in + let cmi = + Fun.protect + (fun () -> Cmi_format.read_cmi_channel filename channel) + ~finally:(fun () -> close_in_noerr channel) + in + Some Env.Persistent_signature.{filename; cmi} + | exception Unix.Unix_error ((Unix.ENOENT | Unix.ENOTDIR), _, _) + -> + try_names names + | exception Unix.Unix_error (error, _, _) -> + raise (Sys_error (path ^ ": " ^ Unix.error_message error))) + in + try_names (if lower_name = name then [name] else [lower_name; name]) in - try_names (if lower_name = name then [name] else [lower_name; name]) - in - find (Config.get_load_path ()) + find (Config.get_load_path ())) diff --git a/compiler/core/js_implementation.ml b/compiler/core/js_implementation.ml index 3eaab34b99..73561f1a08 100644 --- a/compiler/core/js_implementation.ml +++ b/compiler/core/js_implementation.ml @@ -54,13 +54,17 @@ let after_parsing_sig ppf outputprefix ast = Lam_compile_env.reset (); let initial_env = Res_compmisc.initial_env ~modulename () in Env.set_unit_name modulename; - let tsg = Typemod.transl_signature initial_env ast in + let tsg = + Compiler_phase_trace.section "source.check" (fun () -> + Typemod.transl_signature initial_env ast) + in if !((Clflags.current ()).dump_typedtree) then fprintf ppf "%a@." Printtyped.interface tsg; let sg = tsg.sig_type in - ignore (Includemod.signatures initial_env sg sg); - Delayed_checks.force_delayed_checks (); - Warnings.check_fatal (); + Compiler_phase_trace.section "source.check" (fun () -> + ignore (Includemod.signatures initial_env sg sg); + Delayed_checks.force_delayed_checks (); + Warnings.check_fatal ()); let deprecated = Builtin_attributes.deprecated_of_sig ast in let sg = Env.save_signature ~deprecated sg modulename (outputprefix ^ ".cmi") @@ -76,7 +80,7 @@ let interface ~parser ppf ?outputprefix fname = | None -> Config_util.output_prefix fname | Some x -> x in - Res_compmisc.init_path (); + Compiler_phase_trace.section "setup.path" Res_compmisc.init_path; parser fname |> Cmd_ppx_apply.apply_rewriters ~restore:false ~tool_name:Js_config.tool_name Mli @@ -86,7 +90,7 @@ let interface ~parser ppf ?outputprefix fname = |> after_parsing_sig ppf outputprefix let interface_mliast ppf fname = - Res_compmisc.init_path (); + Compiler_phase_trace.section "setup.path" Res_compmisc.init_path; Binary_ast.read_ast_exn ~fname Mli |> print_if_pipe ppf (Clflags.current ()).dump_parsetree Printast.interface |> print_if_pipe ppf (Clflags.current ()).dump_source Pprintast.signature @@ -170,7 +174,7 @@ let implementation ~parser ppf ?outputprefix fname = | None -> Config_util.output_prefix fname | Some x -> x in - Res_compmisc.init_path (); + Compiler_phase_trace.section "setup.path" Res_compmisc.init_path; parser fname |> Cmd_ppx_apply.apply_rewriters ~restore:false ~tool_name:Js_config.tool_name Ml @@ -181,7 +185,7 @@ let implementation ~parser ppf ?outputprefix fname = |> after_parsing_impl ppf outputprefix let implementation_mlast ppf fname = - Res_compmisc.init_path (); + Compiler_phase_trace.section "setup.path" Res_compmisc.init_path; Binary_ast.read_ast_exn ~fname Ml |> print_if_pipe ppf (Clflags.current ()).dump_parsetree Printast.implementation diff --git a/compiler/core/res_compmisc.ml b/compiler/core/res_compmisc.ml index 7f117a2ad2..9da31a2eff 100644 --- a/compiler/core/res_compmisc.ml +++ b/compiler/core/res_compmisc.ml @@ -46,22 +46,23 @@ let open_implicit_module m env = snd (Typemod.type_open_ Override env lid.loc lid) let initial_env ?modulename () = - Ident.reinit (); - let open_modules = - match modulename with - | None -> !((Clflags.current ()).open_modules) - | Some modulename -> - !((Clflags.current ()).open_modules) - |> List.filter (fun m -> m <> modulename) - in - let initial = Env.initial_safe_string () in - let env = - if !((Clflags.current ()).nopervasives) then initial - else - initial - |> open_implicit_module "Pervasives" - |> open_implicit_module "Stdlib" - in - List.fold_left - (fun env m -> open_implicit_module m env) - env (List.rev open_modules) + Compiler_phase_trace.section "setup.initial_env" (fun () -> + Ident.reinit (); + let open_modules = + match modulename with + | None -> !((Clflags.current ()).open_modules) + | Some modulename -> + !((Clflags.current ()).open_modules) + |> List.filter (fun m -> m <> modulename) + in + let initial = Env.initial_safe_string () in + let env = + if !((Clflags.current ()).nopervasives) then initial + else + initial + |> open_implicit_module "Pervasives" + |> open_implicit_module "Stdlib" + in + List.fold_left + (fun env m -> open_implicit_module m env) + env (List.rev open_modules)) diff --git a/compiler/ext/compiler_phase_trace.ml b/compiler/ext/compiler_phase_trace.ml new file mode 100644 index 0000000000..0a3a04fd15 --- /dev/null +++ b/compiler/ext/compiler_phase_trace.ml @@ -0,0 +1,116 @@ +(* Diagnostic request timings. Sections account for their own time only: a + nested section pauses its parent. Disabled unless an output path is set. *) +type bucket = {mutable seconds: float; mutable bytes: float; mutable calls: int} + +type state = { + path: string; + cwd: string; + input: string; + buckets: (string, bucket) Hashtbl.t; + mutable phase: string; + mutable clock: float; + mutable allocation: float; + started: float; + started_allocation: float; + gc: Gc.stat; +} + +let state_key = Domain.DLS.new_key (fun () -> None) +let output_lock = Mutex.create () + +let charge state now allocation = + let bucket = Hashtbl.find state.buckets state.phase in + bucket.seconds <- bucket.seconds +. (now -. state.clock); + bucket.bytes <- bucket.bytes +. (allocation -. state.allocation); + state.clock <- now; + state.allocation <- allocation + +let section name action = + match Domain.DLS.get state_key with + | None -> action () + | Some state -> + let now = Unix.gettimeofday () in + let allocation = Gc.allocated_bytes () in + charge state now allocation; + let previous = state.phase in + state.phase <- name; + let bucket = + match Hashtbl.find_opt state.buckets name with + | Some bucket -> bucket + | None -> + let bucket = {seconds = 0.; bytes = 0.; calls = 0} in + Hashtbl.add state.buckets name bucket; + bucket + in + bucket.calls <- bucket.calls + 1; + Fun.protect action ~finally:(fun () -> + charge state (Unix.gettimeofday ()) (Gc.allocated_bytes ()); + state.phase <- previous) + +let dependency name action = + match Domain.DLS.get state_key with + | Some {phase; _} when String.starts_with ~prefix:"artifact." phase -> + action () + | _ -> section name action + +let open_signature action = + match Domain.DLS.get state_key with + | Some {phase = "setup.initial_env"; _} -> section "setup.open" action + | _ -> section "source.open" action + +let request ~cwd ~input action = + match Sys.getenv_opt "REWATCH_TYPECHECK_TRACE" with + | None | Some "" -> action () + | Some path -> + let started = Unix.gettimeofday () in + let started_allocation = Gc.allocated_bytes () in + let buckets = Hashtbl.create 23 in + Hashtbl.add buckets "request.setup" {seconds = 0.; bytes = 0.; calls = 1}; + let state = + { + path; + cwd; + input; + buckets; + phase = "request.setup"; + clock = started; + allocation = started_allocation; + started; + started_allocation; + gc = Gc.quick_stat (); + } + in + let previous = Domain.DLS.get state_key in + Domain.DLS.set state_key (Some state); + Fun.protect action ~finally:(fun () -> + let finished = Unix.gettimeofday () in + let final_allocation = Gc.allocated_bytes () in + charge state finished final_allocation; + Domain.DLS.set state_key previous; + let gc = Gc.quick_stat () in + Mutex.lock output_lock; + Fun.protect + (fun () -> + let channel = + open_out_gen [Open_creat; Open_append; Open_text] 0o644 path + in + Fun.protect + (fun () -> + let emit phase bucket = + Printf.fprintf channel + "%s\t%s\t%s\t%.6f\t%.0f\t%d\t%.6f\t%.0f\t%d\t%d\t%d\t%d\n" + state.cwd state.input phase bucket.seconds bucket.bytes + bucket.calls + (finished -. state.started) + (final_allocation -. state.started_allocation) + (gc.minor_collections - state.gc.minor_collections) + (gc.major_collections - state.gc.major_collections) + (gc.compactions - state.gc.compactions) + gc.top_heap_words + in + Hashtbl.to_seq state.buckets + |> List.of_seq + |> List.sort (fun (a, _) (b, _) -> String.compare a b) + |> List.iter (fun (phase, bucket) -> emit phase bucket)) + ~finally:(fun () -> close_out_noerr channel)) + ~finally:(fun () -> Mutex.unlock output_lock)) diff --git a/compiler/ext/dune b/compiler/ext/dune index a2daf826b7..178c998060 100644 --- a/compiler/ext/dune +++ b/compiler/ext/dune @@ -28,6 +28,7 @@ (wrapped false) (instrumentation (backend bisect_ppx)) + (libraries unix) (foreign_stubs (language c) (names ext_platform_primitives_stubs))) diff --git a/compiler/ml/cmi_format.ml b/compiler/ml/cmi_format.ml index 805b6fb14e..3c4bb76749 100644 --- a/compiler/ml/cmi_format.ml +++ b/compiler/ml/cmi_format.ml @@ -36,24 +36,27 @@ let input_cmi ic = {cmi_name = name; cmi_sign = sign; cmi_crcs = crcs; cmi_flags = flags} let read_cmi_channel filename ic = - try - let buffer = - really_input_string ic (String.length Config.cmi_magic_number) - in - (if buffer <> Config.cmi_magic_number then - let pre_len = String.length Config.cmi_magic_number - 3 in - if - String.sub buffer 0 pre_len - = String.sub Config.cmi_magic_number 0 pre_len - then - let msg = - if buffer < Config.cmi_magic_number then "an older" else "a newer" - in - raise (Error (Wrong_version_interface (filename, msg))) - else raise (Error (Not_an_interface filename))); - let cmi = input_cmi ic in - cmi - with End_of_file | Failure _ -> raise (Error (Corrupted_interface filename)) + Compiler_phase_trace.dependency "dependency.read_decode" (fun () -> + try + let buffer = + really_input_string ic (String.length Config.cmi_magic_number) + in + (if buffer <> Config.cmi_magic_number then + let pre_len = String.length Config.cmi_magic_number - 3 in + if + String.sub buffer 0 pre_len + = String.sub Config.cmi_magic_number 0 pre_len + then + let msg = + if buffer < Config.cmi_magic_number then "an older" + else "a newer" + in + raise (Error (Wrong_version_interface (filename, msg))) + else raise (Error (Not_an_interface filename))); + let cmi = input_cmi ic in + cmi + with End_of_file | Failure _ -> + raise (Error (Corrupted_interface filename))) let read_cmi filename = let ic = open_in_bin (Compiler_request_state.resolve_path filename) in @@ -76,39 +79,48 @@ let output_cmi filename oc cmi = cmt_format, so dont close the channel yet *) let create_cmi ?check_exists filename (cmi : cmi_infos) = - (* beware: the provided signature must have been substituted for saving *) - let content = - Config.cmi_magic_number ^ Marshal.to_string (cmi.cmi_name, cmi.cmi_sign) [] - (* checkout [output_value] in {!Pervasives} module *) - in - let crc = Digest.string content in - let cmi_infos = - if - check_exists <> None - && Sys.file_exists (Compiler_request_state.resolve_path filename) - then Some (read_cmi filename) - else None - in - match cmi_infos with - | Some - { - cmi_name = _; - cmi_sign = _; - cmi_crcs = (old_name, Some old_crc) :: rest; - cmi_flags; - } - (* TODO: design the cmi format so that we don't need read the whole cmi *) - when cmi.cmi_name = old_name && crc = old_crc && cmi.cmi_crcs = rest - && cmi_flags = cmi.cmi_flags -> - crc - | _ -> - let crcs = (cmi.cmi_name, Some crc) :: cmi.cmi_crcs in - let oc = open_out_bin (Compiler_request_state.resolve_path filename) in - output_string oc content; - output_value oc crcs; - output_value oc cmi.cmi_flags; - close_out oc; - crc + Compiler_phase_trace.section "artifact.cmi_persist" (fun () -> + (* beware: the provided signature must have been substituted for saving *) + let content = + Compiler_phase_trace.section "artifact.cmi_serialize" (fun () -> + Config.cmi_magic_number + ^ Marshal.to_string (cmi.cmi_name, cmi.cmi_sign) []) + (* checkout [output_value] in {!Pervasives} module *) + in + let crc = + Compiler_phase_trace.section "artifact.cmi_hash" (fun () -> + Digest.string content) + in + let cmi_infos = + if + check_exists <> None + && Sys.file_exists (Compiler_request_state.resolve_path filename) + then + Some + (Compiler_phase_trace.section "artifact.cmi_compare" (fun () -> + read_cmi filename)) + else None + in + match cmi_infos with + | Some + { + cmi_name = _; + cmi_sign = _; + cmi_crcs = (old_name, Some old_crc) :: rest; + cmi_flags; + } + (* TODO: design the cmi format so that we don't need read the whole cmi *) + when cmi.cmi_name = old_name && crc = old_crc && cmi.cmi_crcs = rest + && cmi_flags = cmi.cmi_flags -> + crc + | _ -> + let crcs = (cmi.cmi_name, Some crc) :: cmi.cmi_crcs in + let oc = open_out_bin (Compiler_request_state.resolve_path filename) in + output_string oc content; + output_value oc crcs; + output_value oc cmi.cmi_flags; + close_out oc; + crc) (* Error report *) diff --git a/compiler/ml/env.ml b/compiler/ml/env.ml index c5e072aa71..6019beade2 100644 --- a/compiler/ml/env.ml +++ b/compiler/ml/env.ml @@ -640,17 +640,18 @@ let clear_imports () = imported_units () := String_set.empty let check_consistency ps = - try - List.iter - (fun (name, crco) -> - match crco with - | None -> () - | Some crc -> - add_import name; - Consistbl.check (crc_units ()) name crc ps.ps_filename) - ps.ps_crcs - with Consistbl.Inconsistency (name, source, auth) -> - error (Inconsistent_import (name, auth, source)) + Compiler_phase_trace.dependency "dependency.consistency" (fun () -> + try + List.iter + (fun (name, crco) -> + match crco with + | None -> () + | Some crc -> + add_import name; + Consistbl.check (crc_units ()) name crc ps.ps_filename) + ps.ps_crcs + with Consistbl.Inconsistency (name, source, auth) -> + error (Inconsistent_import (name, auth, source))) (* Reading persistent structures from .cmi files *) @@ -674,36 +675,38 @@ module Persistent_signature = struct end let acknowledge_pers_struct check modname {Persistent_signature.filename; cmi} = - let name = cmi.cmi_name in - let sign = cmi.cmi_sign in - let crcs = cmi.cmi_crcs in - let flags = cmi.cmi_flags in - let deprecated = - List.fold_left - (fun _ -> function - | Deprecated s -> Some s) - None flags - in - let comps = - !components_of_module' ~deprecated ~loc:Location.none empty Subst.identity - (Pident (Ident.create_persistent name)) - (Mty_signature sign) - in - let ps = - { - ps_name = name; - ps_sig = lazy (Subst.signature Subst.identity sign); - ps_comps = comps; - ps_crcs = crcs; - ps_filename = filename; - ps_flags = flags; - } - in - if ps.ps_name <> modname then - error (Illegal_renaming (modname, ps.ps_name, filename)); - if check then check_consistency ps; - Hashtbl.add (persistent_structures ()) modname (Some ps); - ps + Compiler_phase_trace.dependency "dependency.make_available" (fun () -> + let name = cmi.cmi_name in + let sign = cmi.cmi_sign in + let crcs = cmi.cmi_crcs in + let flags = cmi.cmi_flags in + let deprecated = + List.fold_left + (fun _ -> function + | Deprecated s -> Some s) + None flags + in + let comps = + !components_of_module' ~deprecated ~loc:Location.none empty + Subst.identity + (Pident (Ident.create_persistent name)) + (Mty_signature sign) + in + let ps = + { + ps_name = name; + ps_sig = lazy (Subst.signature Subst.identity sign); + ps_comps = comps; + ps_crcs = crcs; + ps_filename = filename; + ps_flags = flags; + } + in + if ps.ps_name <> modname then + error (Illegal_renaming (modname, ps.ps_name, filename)); + if check then check_consistency ps; + Hashtbl.add (persistent_structures ()) modname (Some ps); + ps) let read_pers_struct check modname filename = add_import modname; @@ -1932,43 +1935,51 @@ let imports () = let save_signature_with_imports ?check_exists ~deprecated sg modname filename imports = - (*prerr_endline filename; + Compiler_phase_trace.section "artifact.cmi_prep" (fun () -> + (*prerr_endline filename; List.iter (fun (name, crc) -> prerr_endline name) imports;*) - Btype.cleanup_abbrev (); - Subst.reset_for_saving (); - let sg = Subst.signature (Subst.for_saving Subst.identity) sg in - let flags = - match deprecated with - | Some s -> [Deprecated s] - | None -> [] - in - try - let cmi = - {cmi_name = modname; cmi_sign = sg; cmi_crcs = imports; cmi_flags = flags} - in - let crc = create_cmi ?check_exists filename cmi in - (* Enter signature in persistent table so that imported_unit() + Btype.cleanup_abbrev (); + Subst.reset_for_saving (); + let sg = Subst.signature (Subst.for_saving Subst.identity) sg in + let flags = + match deprecated with + | Some s -> [Deprecated s] + | None -> [] + in + try + let cmi = + { + cmi_name = modname; + cmi_sign = sg; + cmi_crcs = imports; + cmi_flags = flags; + } + in + let crc = create_cmi ?check_exists filename cmi in + (* Enter signature in persistent table so that imported_unit() will also return its crc *) - let comps = - components_of_module ~deprecated ~loc:Location.none empty Subst.identity - (Pident (Ident.create_persistent modname)) - (Mty_signature sg) - in - let ps = - { - ps_name = modname; - ps_sig = lazy (Subst.signature Subst.identity sg); - ps_comps = comps; - ps_crcs = (cmi.cmi_name, Some crc) :: imports; - ps_filename = filename; - ps_flags = cmi.cmi_flags; - } - in - save_pers_struct crc ps; - cmi - with exn -> - remove_file filename; - raise exn + let comps = + Compiler_phase_trace.section "artifact.cmi_register" (fun () -> + components_of_module ~deprecated ~loc:Location.none empty + Subst.identity + (Pident (Ident.create_persistent modname)) + (Mty_signature sg)) + in + let ps = + { + ps_name = modname; + ps_sig = lazy (Subst.signature Subst.identity sg); + ps_comps = comps; + ps_crcs = (cmi.cmi_name, Some crc) :: imports; + ps_filename = filename; + ps_flags = cmi.cmi_flags; + } + in + save_pers_struct crc ps; + cmi + with exn -> + remove_file filename; + raise exn) let save_signature ?check_exists ~deprecated sg modname filename = save_signature_with_imports ?check_exists ~deprecated sg modname filename diff --git a/compiler/ml/platform/native/cmt_format_persistence.ml b/compiler/ml/platform/native/cmt_format_persistence.ml index 5289b8c1f0..1d0c9caf5e 100644 --- a/compiler/ml/platform/native/cmt_format_persistence.ml +++ b/compiler/ml/platform/native/cmt_format_persistence.ml @@ -23,36 +23,42 @@ let output_cmt output_channel cmt = let save_cmt filename modname binary_annots sourcefile initial_env cmi = if !((Clflags.current ()).binary_annotations) then - Misc.output_to_bin_file_directly filename - (fun temp_file_name output_channel -> - let interface_digest = - match cmi with - | None -> None - | Some cmi -> - Some (Cmi_format.output_cmi temp_file_name output_channel cmi) - in - let cmt = - { - cmt_modname = modname; - cmt_annots = clear_env binary_annots; - cmt_value_dependencies = value_dependencies (); - cmt_comments = []; - cmt_args = (Compiler_request_state.current ()).cmt_args; - cmt_sourcefile = sourcefile; - cmt_builddir = Compiler_request_state.cwd (); - cmt_loadpath = Config.get_load_path (); - cmt_source_digest = - Misc.may_map - (fun path -> - Digest.file (Compiler_request_state.resolve_path path)) - sourcefile; - cmt_initial_env = - (if need_to_clear_env then keep_only_summary initial_env - else initial_env); - cmt_imports = List.sort compare (Env.imports ()); - cmt_interface_digest = interface_digest; - cmt_use_summaries = need_to_clear_env; - cmt_extra_info = {deprecated_used = deprecated_uses ()}; - } - in - output_cmt output_channel cmt) + Compiler_phase_trace.section "artifact.cmt_persist" (fun () -> + Misc.output_to_bin_file_directly filename + (fun temp_file_name output_channel -> + let interface_digest = + match cmi with + | None -> None + | Some cmi -> + Some (Cmi_format.output_cmi temp_file_name output_channel cmi) + in + let cmt = + Compiler_phase_trace.section "artifact.cmt_prep" (fun () -> + { + cmt_modname = modname; + cmt_annots = clear_env binary_annots; + cmt_value_dependencies = value_dependencies (); + cmt_comments = []; + cmt_args = (Compiler_request_state.current ()).cmt_args; + cmt_sourcefile = sourcefile; + cmt_builddir = Compiler_request_state.cwd (); + cmt_loadpath = Config.get_load_path (); + cmt_source_digest = + Compiler_phase_trace.section "artifact.cmt_source_hash" + (fun () -> + Misc.may_map + (fun path -> + Digest.file + (Compiler_request_state.resolve_path path)) + sourcefile); + cmt_initial_env = + (if need_to_clear_env then keep_only_summary initial_env + else initial_env); + cmt_imports = List.sort compare (Env.imports ()); + cmt_interface_digest = interface_digest; + cmt_use_summaries = need_to_clear_env; + cmt_extra_info = {deprecated_used = deprecated_uses ()}; + }) + in + Compiler_phase_trace.section "artifact.cmt_serialize" (fun () -> + output_cmt output_channel cmt))) diff --git a/compiler/ml/typemod.ml b/compiler/ml/typemod.ml index 6f603c1170..eb0d04ba5b 100644 --- a/compiler/ml/typemod.ml +++ b/compiler/ml/typemod.ml @@ -86,13 +86,14 @@ let extract_sig_open env loc mty = (* Compute the environment after opening a module *) let type_open_ ?used_slot ?toplevel ovf env loc lid = - let path = Typetexp.lookup_module ~load:true env lid.loc lid.txt in - match Env.open_signature ~loc ?used_slot ?toplevel ovf path env with - | Some env -> (path, env) - | None -> - let md = Env.find_module path env in - ignore (extract_sig_open env lid.loc md.md_type); - assert false + Compiler_phase_trace.open_signature (fun () -> + let path = Typetexp.lookup_module ~load:true env lid.loc lid.txt in + match Env.open_signature ~loc ?used_slot ?toplevel ovf path env with + | Some env -> (path, env) + | None -> + let md = Env.find_module path env in + ignore (extract_sig_open env lid.loc md.md_type); + assert false) let type_open ?toplevel env sod = let path, newenv = @@ -1730,67 +1731,75 @@ let () = let type_implementation_more ?check_exists sourcefile outputprefix modulename initial_env ast = - Cmt_format.clear (); - try - Delayed_checks.reset_delayed_checks (); - let str, sg, finalenv = - type_structure initial_env ast (Location.in_file sourcefile) - in - let simple_sg = simplify_signature sg in - let mli_status = !((Clflags.current ()).assume_no_mli) in - if mli_status = Clflags.Mli_exists then ( - let intf_file = - try find_in_path_uncap (Config.get_load_path ()) (modulename ^ ".cmi") - with Not_found -> - let sourceintf = - Filename.remove_extension sourcefile ^ Literals.suffix_resi + Compiler_phase_trace.section "source.check" (fun () -> + Cmt_format.clear (); + try + Delayed_checks.reset_delayed_checks (); + let str, sg, finalenv = + type_structure initial_env ast (Location.in_file sourcefile) + in + let simple_sg = simplify_signature sg in + let mli_status = !((Clflags.current ()).assume_no_mli) in + if mli_status = Clflags.Mli_exists then ( + let intf_file = + Compiler_phase_trace.dependency "dependency.interface_search" + (fun () -> + try + find_in_path_uncap (Config.get_load_path ()) + (modulename ^ ".cmi") + with Not_found -> + let sourceintf = + Filename.remove_extension sourcefile ^ Literals.suffix_resi + in + raise + (Error + ( Location.in_file sourcefile, + Env.empty, + Interface_not_compiled sourceintf ))) in - raise - (Error - ( Location.in_file sourcefile, - Env.empty, - Interface_not_compiled sourceintf )) - in - let dclsig = Env.read_signature modulename intf_file in - let coercion = - Includemod.compunit initial_env sourcefile sg intf_file dclsig - in - Delayed_checks.force_delayed_checks (); - (* It is important to run these checks after the inclusion test above, + let dclsig = + Compiler_phase_trace.dependency "dependency.interface_open" + (fun () -> Env.read_signature modulename intf_file) + in + let coercion = + Includemod.compunit initial_env sourcefile sg intf_file dclsig + in + Delayed_checks.force_delayed_checks (); + (* It is important to run these checks after the inclusion test above, so that value declarations which are not used internally but exported are not reported as being unused. *) - Cmt_format.save_cmt (outputprefix ^ ".cmt") modulename - (Cmt_format.Implementation str) (Some sourcefile) initial_env None; - (str, coercion, finalenv, dclsig) - (* identifier is useless might read from serialized cmi files*)) - else - let coercion = - Includemod.compunit initial_env sourcefile sg "(inferred signature)" - simple_sg - in - check_nongen_schemes finalenv simple_sg; - normalize_signature finalenv simple_sg; - Delayed_checks.force_delayed_checks (); - (* See comment above. Here the target signature contains all + Cmt_format.save_cmt (outputprefix ^ ".cmt") modulename + (Cmt_format.Implementation str) (Some sourcefile) initial_env None; + (str, coercion, finalenv, dclsig) + (* identifier is useless might read from serialized cmi files*)) + else + let coercion = + Includemod.compunit initial_env sourcefile sg "(inferred signature)" + simple_sg + in + check_nongen_schemes finalenv simple_sg; + normalize_signature finalenv simple_sg; + Delayed_checks.force_delayed_checks (); + (* See comment above. Here the target signature contains all the value being exported. We can still capture unused declarations like "let x = true;; let x = 1;;", because in this case, the inferred signature contains only the last declaration. *) - (if not !((Clflags.current ()).dont_write_files) then - let deprecated = Builtin_attributes.deprecated_of_str ast in - let cmi = - Env.save_signature ?check_exists ~deprecated simple_sg modulename - (outputprefix ^ ".cmi") - in - Cmt_format.save_cmt (outputprefix ^ ".cmt") modulename - (Cmt_format.Implementation str) (Some sourcefile) initial_env - (Some cmi)); - (str, coercion, finalenv, simple_sg) - with e -> - Cmt_format.save_cmt (outputprefix ^ ".cmt") modulename - (Cmt_format.Partial_implementation - (Array.of_list (Cmt_format.get_saved_types ()))) - (Some sourcefile) initial_env None; - raise e + (if not !((Clflags.current ()).dont_write_files) then + let deprecated = Builtin_attributes.deprecated_of_str ast in + let cmi = + Env.save_signature ?check_exists ~deprecated simple_sg modulename + (outputprefix ^ ".cmi") + in + Cmt_format.save_cmt (outputprefix ^ ".cmt") modulename + (Cmt_format.Implementation str) (Some sourcefile) initial_env + (Some cmi)); + (str, coercion, finalenv, simple_sg) + with e -> + Cmt_format.save_cmt (outputprefix ^ ".cmt") modulename + (Cmt_format.Partial_implementation + (Array.of_list (Cmt_format.get_saved_types ()))) + (Some sourcefile) initial_env None; + raise e) let save_signature modname tsg outputprefix source_file initial_env cmi = Cmt_format.save_cmt (outputprefix ^ ".cmti") modname diff --git a/rewatch-ocaml/bench/README.md b/rewatch-ocaml/bench/README.md index e00d655782..fe9731dcaa 100644 --- a/rewatch-ocaml/bench/README.md +++ b/rewatch-ocaml/bench/README.md @@ -339,6 +339,117 @@ would save only about 0.21 s. Reusing expanded components would need to keep the mutable type graphs isolated and invalidate them when a CMI changes. The temporary instrumentation was removed after these measurements. +## Exclusive type-checking and artifact breakdown + +An opt-in trace now times nested compiler phases in one clean build. Its rows +are exclusive, so they add to the request total. This resolves the overlap in +the temporary measurements above. Set `REWATCH_TYPECHECK_TRACE` to an absolute +TSV path to enable it; otherwise the trace is disabled. + +Five interleaved pairs used eight workers, OCaml 5.5.1, and Dune's development +profile on Linux ARM64. Both executables were copied to the same `/tmp` +directory. The plain executable was built from `80eb95963` without tracing +hooks; the traced executable differed only by the diagnostic instrumentation. +Each sample cleaned Belt and testrepo in an isolated fixture. All traced +samples made 512 parse, 40 interface, 472 implementation, and seven namespace +implementation requests (1,031 total). +An additional clean baseline/traced comparison produced the same 10,029 +paths and SHA-256 hashes for files ending in `.ast`, `.iast`, `.cmi`, `.cmj`, +`.cmt`, `.cmti`, `.mjs`, `.cjs`, `.js`, or `.map`. + +`traced-3.trace.tsv` gives the following **summed worker times** in +milliseconds. The 519 compile requests sum to 8,106 ms. Parse requests add +678 ms, including 452 ms of outer setup. Elapsed build time was 1.37 s; +worker sums are not elapsed time or directly achievable wall-time savings. + +| Exclusive phase | Interfaces (40) | Implementations (472) | Namespace (7) | Compile total | +| --- | ---: | ---: | ---: | ---: | +| Request setup and initial environment | 18.1 | 553.2 | 1.5 | 572.9 | +| Obtain dependency interfaces | 70.8 | 2,511.7 | 2.2 | 2,584.7 | +| Check source and open signatures | 23.9 | 3,885.6 | 1.9 | 3,911.4 | +| Prepare CMI/CMT data | 2.4 | 60.8 | 0.3 | 63.5 | +| Serialize, hash, and write artifacts | 30.4 | 647.5 | 1.0 | 678.8 | +| AST reading, backend, and other work | 5.5 | 287.9 | 1.3 | 294.7 | +| **Total** | **151.1** | **7,946.7** | **8.2** | **8,106.0** | + +Source checking comprises 2,152 ms typing, inclusion, delayed checks, and +typed-tree construction, plus 1,759 ms opening signatures and making names +available. Nested CMI file work is charged only to dependencies. Setup +includes fresh request state, include paths, and 332 ms opening implicit and +configured modules, excluding CMI work. The outer-request timer also covers +argument parsing, output capture, and teardown. + +The dependency row comprises 1,155 ms finding and opening CMI paths, 2 ms +finding and opening the current module's explicit interface, 1,406 ms in +buffered reading and Marshal decoding, 19 ms in CRC consistency checks, +and 3 ms registering decoded persistent structures. The trace counted 2,966 +successful loader searches and 3,006 decodes; the extra 40 are explicit +interface reads. `Pervasives` and `Stdlib` were each loaded 519 times, once per +compile request, and `WebAPI` 312 times. Fresh request state repeats this work. +The current `input_value` reader interleaves I/O and decoding, so their costs +cannot be separated without changing that reader. Lazy expansion during +source `open` appears in the source row, separate from CMI file loading. + +CMI preparation copies the exported signature into saved form and registers +it for later checking; it is needed to make dependency types available. CMT +and CMTI preparation clears typed-tree environments and packages metadata for +editor tooling. The 679 ms persistence row includes 106 ms standalone CMI +serialization, 53 ms CMI hashing, 85 ms remaining standalone CMI file work, +212 ms CMT serialization, 19 ms source hashing, and 203 ms remaining CMT/CMTI +file work. The last component includes the CMI prefix embedded in CMT files. +These subtimers are exclusive and do not double-count one another. + +The compile requests allocated 4,218 MB in OCaml heaps: 2,848 MB during +source checking, 671 MB obtaining dependencies, 458 MB in setup, 75 MB in +artifact preparation, 22 MB in persistence, and 144 MB elsewhere. Parse +requests allocated another 234 MB. The largest sampled `Gc.quick_stat` +top heap was 34.5 million words (about 263 MiB). Summing request-boundary +GC counter deltas gave 3,437 minor and 355 major collections, with no +compactions; overlapping requests may observe the same global collection, +so these sums are diagnostic rather than exact build-wide counts. Allocation +counters cover OCaml allocations on worker domains, not native allocations or +retained memory. + +Across the five pairs, median elapsed build time was 1.37 s for both plain +and traced; median process user-plus-system time was 6.59 s for both. Median +GNU `time` peak RSS was 368,196 KiB plain and 352,324 KiB traced, with broad +per-run overlap (338,644–386,256 KiB across both modes). The trace showed no +resolvable wall-time, CPU, or memory penalty here. GNU `time` records the +build process's maximum RSS, not the sum +of concurrently live process trees. Each nested timer reads a clock and an +allocation counter, so tiny phase timings remain directional. + +Reproduce the comparison with the instrumented branch checked out: + +```sh +opam exec -- dune build rewatch-ocaml/rescript_ocaml.exe compiler/bsc/rescript_compiler_main.exe +git -c "safe.directory=$PWD" worktree add --detach /tmp/rescript-typecheck-base 80eb95963 +(cd /tmp/rescript-typecheck-base && opam exec -- dune build \ + rewatch-ocaml/rescript_ocaml.exe compiler/bsc/rescript_compiler_main.exe) +REWATCH_PLAIN_EXECUTABLE=/tmp/rescript-typecheck-base/_build/default/rewatch-ocaml/rescript_ocaml.exe \ +REWATCH_PLAIN_BSC=/tmp/rescript-typecheck-base/_build/default/compiler/bsc/rescript_compiler_main.exe \ + bash rewatch-ocaml/bench/typecheck_breakdown.sh /tmp/rescript-typecheck-data 5 +node rewatch-ocaml/bench/analyze_typecheck_trace.js \ + /tmp/rescript-typecheck-data/traced-1.trace.tsv +``` + +The runner records host details, binary hashes, GNU `time` results, build +output, and raw traces. Omit `REWATCH_PLAIN_*` to compare trace enabled and +disabled in the same binary. The analyzer checks that exclusive phases account +for every request. Keep worker count and fixture filesystem fixed when +comparing results. + +The next optimization experiment should test a **content-aware raw CMI byte +cache** across requests while retaining a fresh Marshal decode, consistency +check, and mutable type graph for each request. This isolates the 1.16 s of +repeated path search/open work without assuming decoded graphs can be shared. +Compare cold and warm builds, invalidate entries when CMIs change, check +stable artifacts, and measure worker and elapsed time. Eliminating that entire +lookup row has an ideal eight-worker lower bound of about 0.14 s; decoding +and signature opening remain. If the gain is small, measure a separate way to +reuse expanded signature components, especially the large WebAPI imports, +before attempting that architectural change. + ## Bulk label table checkpoint Revision `56164c19e3b0cc751301e4344cc0e4ecff46df20` builds the opened diff --git a/rewatch-ocaml/bench/analyze_typecheck_trace.js b/rewatch-ocaml/bench/analyze_typecheck_trace.js new file mode 100644 index 0000000000..007ae49773 --- /dev/null +++ b/rewatch-ocaml/bench/analyze_typecheck_trace.js @@ -0,0 +1,78 @@ +#!/usr/bin/env node + +import fs from "node:fs"; + +if (process.argv.length !== 3) { + console.error("Usage: analyze_typecheck_trace.js TRACE.tsv"); + process.exit(2); +} + +const requests = new Map(); +const imports = new Map(); +const phaseTotals = new Map(); +for (const [index, line] of fs.readFileSync(process.argv[2], "utf8").trim().split("\n").entries()) { + const fields = line.split("\t"); + if (fields.length !== 12) throw new Error(`Invalid row ${index + 1}`); + const [cwd, input, rawPhase, msText, bytesText, callsText, totalText, + totalBytesText, minorText, majorText, compactText, heapText] = fields; + const values = [msText, bytesText, callsText, totalText, totalBytesText, + minorText, majorText, compactText, heapText].map(Number); + if (values.some((value) => !Number.isFinite(value))) { + throw new Error(`Invalid number on row ${index + 1}`); + } + const [seconds, bytes, calls, total, totalBytes, minor, major, compactions, heap] = values; + const kind = input.endsWith(".iast") ? "interface" + : input.endsWith(".ast") ? "implementation" + : input.endsWith(".mlmap") ? "namespace" + : "parse"; + const key = `${cwd}\0${input}`; + const request = requests.get(key) ?? { + kind, total, totalBytes, minor, major, compactions, heap, accounted: 0, + }; + if (Math.abs(request.total - total) > 0.000001 || request.kind !== kind) { + throw new Error(`Inconsistent request on row ${index + 1}`); + } + request.accounted += seconds; + requests.set(key, request); + const phase = rawPhase.startsWith("dependency.search_open:") + ? "dependency.search_open" : rawPhase; + if (phase !== rawPhase) { + const name = rawPhase.slice("dependency.search_open:".length); + const entry = imports.get(name) ?? {calls: 0, seconds: 0}; + entry.calls += calls; + entry.seconds += seconds; + imports.set(name, entry); + } + const entry = phaseTotals.get(`${kind}\0${phase}`) ?? {calls: 0, seconds: 0, bytes: 0}; + entry.calls += calls; + entry.seconds += seconds; + entry.bytes += bytes; + phaseTotals.set(`${kind}\0${phase}`, entry); +} + +for (const [key, request] of requests) { + if (Math.abs(request.total - request.accounted) > 0.00005) { + throw new Error(`Unaccounted request time for ${key.replace("\0", "/")}`); + } +} + +for (const kind of ["parse", "interface", "implementation", "namespace"]) { + const group = [...requests.values()].filter((request) => request.kind === kind); + if (group.length === 0) continue; + const sum = (field) => group.reduce((value, request) => value + request[field], 0); + console.log(`\n${kind}: ${group.length} requests, ${(sum("total") * 1000).toFixed(1)} summed request ms, ${(sum("totalBytes") / 1e6).toFixed(1)} allocated MB`); + console.log(`GC collections during requests: ${sum("minor")} minor, ${sum("major")} major, ${sum("compactions")} compactions; largest sampled heap ${Math.max(...group.map((request) => request.heap))} words`); + console.log("phase worker_ms alloc_MB calls"); + for (const [key, entry] of [...phaseTotals].sort(([a], [b]) => a.localeCompare(b))) { + const [entryKind, phase] = key.split("\0"); + if (entryKind !== kind) continue; + console.log(`${phase.padEnd(32)} ${String((entry.seconds * 1000).toFixed(1)).padStart(9)} ${String((entry.bytes / 1e6).toFixed(1)).padStart(9)} ${String(entry.calls).padStart(6)}`); + } + const mismatch = group.reduce((value, request) => value + Math.abs(request.total - request.accounted), 0) * 1000; + console.log(`Exclusive-accounting rounding difference: ${mismatch.toFixed(2)} ms`); +} + +console.log("\nMost repeated CMI lookups:"); +for (const [name, entry] of [...imports].sort((a, b) => b[1].calls - a[1].calls).slice(0, 12)) { + console.log(`${String(entry.calls).padStart(4)} calls ${String((entry.seconds * 1000).toFixed(1)).padStart(7)} search/open ms ${name}`); +} diff --git a/rewatch-ocaml/bench/typecheck_breakdown.sh b/rewatch-ocaml/bench/typecheck_breakdown.sh new file mode 100644 index 0000000000..80e1fd5b8c --- /dev/null +++ b/rewatch-ocaml/bench/typecheck_breakdown.sh @@ -0,0 +1,85 @@ +#!/usr/bin/env bash +set -euo pipefail + +if [[ $# -lt 1 || $# -gt 2 ]]; then + echo "Usage: $0 OUTPUT_DIRECTORY [ODD_RUN_COUNT]" >&2 + exit 2 +fi + +repo_root=$(cd "$(dirname "$0")/../.." && pwd) +results=$(mkdir -p "$1" && cd "$1" && pwd) +runs=${2:-5} +if [[ ! $runs =~ ^[1-9][0-9]*$ || $((runs % 2)) -eq 0 ]]; then + echo "Run count must be positive and odd." >&2 + exit 2 +fi + +fixture_root="$results/fixture" +if [[ -e "$fixture_root" ]]; then + echo "Output directory already contains a fixture: $fixture_root" >&2 + exit 2 +fi +mkdir -p "$fixture_root" +git -c "safe.directory=$repo_root" -C "$repo_root" archive HEAD \ + rewatch/testrepo packages/@rescript/belt packages/@rescript/runtime \ + | tar -x -C "$fixture_root" +while IFS= read -r dependency_tree; do + relative_tree=${dependency_tree#"$repo_root/"} + mkdir -p "$(dirname "$fixture_root/$relative_tree")" + cp -a --reflink=auto "$dependency_tree" "$fixture_root/$relative_tree" +done < <(find "$repo_root/rewatch/testrepo" -type d -name node_modules -prune -print) +node "$repo_root/rewatch/tests/add-belt-dependencies.mjs" \ + "$fixture_root/rewatch/testrepo" + +export RESCRIPT_RUNTIME="$repo_root/packages/@rescript/runtime" +export REWATCH_COMPILER_DOMAINS=${REWATCH_COMPILER_DOMAINS:-8} +plain_executable=${REWATCH_PLAIN_EXECUTABLE:-"$repo_root/_build/default/rewatch-ocaml/rescript_ocaml.exe"} +plain_bsc=${REWATCH_PLAIN_BSC:-"$repo_root/_build/default/compiler/bsc/rescript_compiler_main.exe"} +traced_executable="$repo_root/_build/default/rewatch-ocaml/rescript_ocaml.exe" +traced_bsc="$repo_root/_build/default/compiler/bsc/rescript_compiler_main.exe" +mkdir -p "$results/bin" +cp "$plain_executable" "$results/bin/rewatch-plain" +cp "$plain_bsc" "$results/bin/bsc-plain" +cp "$traced_executable" "$results/bin/rewatch-traced" +cp "$traced_bsc" "$results/bin/bsc-traced" +fixture="$fixture_root/rewatch/testrepo" + +{ + printf 'fixture_commit=%s\n' "$(git -c "safe.directory=$repo_root" -C "$repo_root" rev-parse HEAD)" + printf 'host=%s\n' "$(uname -a)" + printf 'workers=%s\n' "$REWATCH_COMPILER_DOMAINS" + printf 'runtime=%s\n' "$RESCRIPT_RUNTIME" + sha256sum "$results/bin/rewatch-plain" "$results/bin/rewatch-traced" \ + "$results/bin/bsc-plain" "$results/bin/bsc-traced" +} >"$results/metadata.txt" + +for ((iteration = 1; iteration <= runs; iteration++)); do + for slot in 0 1; do + if (((iteration + slot) % 2 == 0)); then + mode=traced + else + mode=plain + fi + executable="$results/bin/rewatch-$mode" + export RESCRIPT_BSC_EXE="$results/bin/bsc-$mode" + # Belt lives outside testrepo and is not removed by cleaning that project. + # Clean it explicitly so every sample recompiles the same 1,031 requests. + "$executable" clean "$fixture_root/packages/@rescript/belt" \ + >"$results/$mode-$iteration.belt-clean.log" 2>&1 + "$executable" clean "$fixture" >"$results/$mode-$iteration.clean.log" 2>&1 + trace="$results/$mode-$iteration.trace.tsv" + if [[ $mode == traced ]]; then + REWATCH_TYPECHECK_TRACE="$trace" /usr/bin/time \ + -f 'elapsed_s=%e user_s=%U sys_s=%S peak_rss_kib=%M' \ + -o "$results/$mode-$iteration.time" \ + "$executable" build "$fixture" >"$results/$mode-$iteration.build.log" 2>&1 + else + env -u REWATCH_TYPECHECK_TRACE /usr/bin/time \ + -f 'elapsed_s=%e user_s=%U sys_s=%S peak_rss_kib=%M' \ + -o "$results/$mode-$iteration.time" \ + "$executable" build "$fixture" >"$results/$mode-$iteration.build.log" 2>&1 + fi + printf '%s run %d: ' "$mode" "$iteration" + cat "$results/$mode-$iteration.time" + done +done