From 54e3bd01dcb977587ec13af6c9a187e47bddf76a Mon Sep 17 00:00:00 2001 From: Florian Hammerschmidt Date: Fri, 25 Sep 2026 16:49:31 +0200 Subject: [PATCH 1/3] Cache expanded signatures per OCaml rewatch worker Signed-off-by: Florian Hammerschmidt --- compiler/bsc/rescript_compiler_driver.ml | 7 +- compiler/ext/compiler_phase_trace.ml | 5 + compiler/ext/ident.ml | 49 +- compiler/ext/ident.mli | 8 +- compiler/ml/btype.ml | 22 +- compiler/ml/btype.mli | 4 + compiler/ml/env.ml | 822 +++++++++++++++++- compiler/ml/env.mli | 7 + compiler/ml/types.ml | 2 +- compiler/ml/types.mli | 5 +- rewatch-ocaml/bench/README.md | 156 +++- rewatch-ocaml/compiler_process.ml | 27 +- .../compiler_driver_tests.ml | 118 +++ 13 files changed, 1187 insertions(+), 45 deletions(-) diff --git a/compiler/bsc/rescript_compiler_driver.ml b/compiler/bsc/rescript_compiler_driver.ml index e467e6fe9a..703d2d6ae3 100644 --- a/compiler/bsc/rescript_compiler_driver.ml +++ b/compiler/bsc/rescript_compiler_driver.ml @@ -600,10 +600,15 @@ let with_fresh_request_states ~cwd action = Compiler_request_state .with_fresh ~cwd action))))))))))))) +let with_fresh_request_states_and_snapshot ~cwd action = + Fun.protect + (fun () -> with_fresh_request_states ~cwd action) + ~finally:Env.finalize_expanded_snapshot_cache + let run_argv ?run_external ~cwd argv = let input = argv.(Array.length argv - 1) in Compiler_phase_trace.request ~cwd ~input (fun () -> - with_fresh_request_states ~cwd (fun () -> + with_fresh_request_states_and_snapshot ~cwd (fun () -> Compiler_phase_trace.section "request.reset" (fun () -> reset_state ~new_request:true ()); Cmt_format.set_args argv; diff --git a/compiler/ext/compiler_phase_trace.ml b/compiler/ext/compiler_phase_trace.ml index 0a3a04fd15..54aabad268 100644 --- a/compiler/ext/compiler_phase_trace.ml +++ b/compiler/ext/compiler_phase_trace.ml @@ -53,6 +53,11 @@ let dependency name action = action () | _ -> section name action +let dependency_lazy name action = + match Domain.DLS.get state_key with + | None -> action () + | Some _ -> dependency (name ()) action + let open_signature action = match Domain.DLS.get state_key with | Some {phase = "setup.initial_env"; _} -> section "setup.open" action diff --git a/compiler/ext/ident.ml b/compiler/ext/ident.ml index c496fbae3f..f84aacc3c6 100644 --- a/compiler/ext/ident.ml +++ b/compiler/ext/ident.ml @@ -15,7 +15,7 @@ open Format -type t = {stamp: int; name: string; mutable flags: int} +type t = {mutable stamp: int; name: string; mutable flags: int} let[@inlnie] max (x : int) y = if x >= y then x else y let global_flag = 1 @@ -23,10 +23,15 @@ let predef_exn_flag = 2 (* A stamp of 0 denotes a persistent identifier *) -type counter_state = {mutable currentstamp: int; mutable reinit_level: int} +type counter_state = { + mutable currentstamp: int; + mutable reinit_level: int; + mutable allocation_capture: t list ref option; +} let counter_key = - Domain.DLS.new_key (fun () -> {currentstamp = 0; reinit_level = -1}) + Domain.DLS.new_key (fun () -> + {currentstamp = 0; reinit_level = -1; allocation_capture = None}) let counter () = Domain.DLS.get counter_key @@ -44,25 +49,41 @@ let with_fresh action = | Some baseline -> baseline | None -> previous.currentstamp in - Domain.DLS.set counter_key {currentstamp = baseline; reinit_level = baseline}; + Domain.DLS.set counter_key + { + currentstamp = baseline; + reinit_level = baseline; + allocation_capture = None; + }; Fun.protect action ~finally:(fun () -> Domain.DLS.set counter_key previous) +let record_allocation state id = + match state.allocation_capture with + | Some captured -> captured := id :: !captured + | None -> () + let create s = let state = counter () in state.currentstamp <- state.currentstamp + 1; - {name = s; stamp = state.currentstamp; flags = 0} + let id = {name = s; stamp = state.currentstamp; flags = 0} in + record_allocation state id; + id let create_predef_exn s = let state = counter () in state.currentstamp <- state.currentstamp + 1; - {name = s; stamp = state.currentstamp; flags = predef_exn_flag} + let id = {name = s; stamp = state.currentstamp; flags = predef_exn_flag} in + record_allocation state id; + id let create_persistent s = {name = s; stamp = 0; flags = global_flag} let rename i = let state = counter () in state.currentstamp <- state.currentstamp + 1; - {i with stamp = state.currentstamp} + let id = {i with stamp = state.currentstamp} in + record_allocation state id; + id let name i = i.name @@ -80,6 +101,20 @@ let same ({stamp; name} : t) i2 = let binding_time i = i.stamp let current_time () = (counter ()).currentstamp +let with_allocation_capture action = + let state = counter () in + let previous = state.allocation_capture in + let captured = ref [] in + state.allocation_capture <- Some captured; + Fun.protect + (fun () -> + let result = action () in + (result, Array.of_list (List.rev !captured))) + ~finally:(fun () -> + state.allocation_capture <- previous; + match previous with + | Some outer -> outer := !captured @ !outer + | None -> ()) let set_current_time t = let state = counter () in state.currentstamp <- max state.currentstamp t diff --git a/compiler/ext/ident.mli b/compiler/ext/ident.mli index d33b6a35a1..55d343b957 100644 --- a/compiler/ext/ident.mli +++ b/compiler/ext/ident.mli @@ -15,7 +15,9 @@ (* Identifiers (unique names) *) -type t = {stamp: int; name: string; mutable flags: int} +type t = {mutable stamp: int; name: string; mutable flags: int} +(** [stamp] may be relocated only on a private, freshly deserialized + dependency graph before the identifier becomes visible to typing. *) include Identifiable.S with type t := t (* Notes: @@ -52,6 +54,10 @@ val is_predef_exn : t -> bool val binding_time : t -> int val current_time : unit -> int + +(* Record fresh identifiers made during [action]. Nested captures also + contribute to their outer capture. *) +val with_allocation_capture : (unit -> 'a) -> 'a * t array val set_current_time : int -> unit val reinit : unit -> unit diff --git a/compiler/ml/btype.ml b/compiler/ml/btype.ml index db7532c087..a9152925fb 100644 --- a/compiler/ml/btype.ml +++ b/compiler/ml/btype.ml @@ -41,6 +41,22 @@ let pivot_level = (2 * lowest_level) - 1 (**** Some type creators ****) +let allocation_capture_key = Domain.DLS.new_key (fun () -> None) + +let with_allocation_capture action = + let previous = Domain.DLS.get allocation_capture_key in + let captured = ref [] in + Domain.DLS.set allocation_capture_key (Some captured); + Fun.protect + (fun () -> + let result = action () in + (result, Array.of_list (List.rev !captured))) + ~finally:(fun () -> + Domain.DLS.set allocation_capture_key previous; + match previous with + | Some outer -> outer := !captured @ !outer + | None -> ()) + let reinit () = let state = Compiler_request_state.current () in match state.type_node_reset_id with @@ -50,7 +66,11 @@ let reinit () = let newty2 level desc = let state = Compiler_request_state.current () in state.type_node_id <- state.type_node_id + 1; - {desc; level; id = state.type_node_id} + let ty = {desc; level; id = state.type_node_id} in + (match Domain.DLS.get allocation_capture_key with + | Some captured -> captured := ty :: !captured + | None -> ()); + ty let newgenty desc = newty2 generic_level desc let newgenvar ?name () = newgenty (Tvar name) (* diff --git a/compiler/ml/btype.mli b/compiler/ml/btype.mli index 6f9b51cc75..1c654aa4f4 100644 --- a/compiler/ml/btype.mli +++ b/compiler/ml/btype.mli @@ -31,6 +31,10 @@ val generic_level : int val newty2 : int -> type_desc -> type_expr (* Create a type *) +val with_allocation_capture : (unit -> 'a) -> 'a * type_expr array +(** Record fresh type nodes created by [newty2] during [action]. Nested + captures also contribute to their outer capture. *) + val newgenty : type_desc -> type_expr (* Create a generic type *) diff --git a/compiler/ml/env.ml b/compiler/ml/env.ml index 6019beade2..8942e2be02 100644 --- a/compiler/ml/env.ml +++ b/compiler/ml/env.ml @@ -605,6 +605,91 @@ let current_unit () = Domain.DLS.get current_unit_key (* Persistent structure descriptions *) +(* The three lazy expansion stages allocate identifiers at different points in + a request. Capture their nodes in allocation order so each stage can take + fresh request-local IDs without walking the large signature again. *) +type allocation_stage = { + first_type_id: int; + allocated_type_ids: int; + type_nodes: type_expr array; + first_ident_stamp: int; + allocated_ident_stamps: int; + identifiers: Ident.t array; +} + +type alias_key = { + target_name: string; + namespace_name: string; + alias_name: string; +} + +type expanded_snapshot = { + raw_signature: signature; + expanded_signature: signature; + target_components: module_components_repr option; + alias_components: module_components_repr option; + target_ids: allocation_stage; + signature_ids: allocation_stage; + alias_ids: allocation_stage; + crcs: (string * Digest.t option) list; + flags: pers_flags list; +} + +type request_snapshot = { + key: alias_key; + graph: expanded_snapshot; + mutable target_relocated: bool; + mutable signature_relocated: bool; + mutable alias_relocated: bool; +} + +let capture_allocation_stage action = + let state = Compiler_request_state.current () in + let first_type_id = state.type_node_id in + let first_ident_stamp = Ident.current_time () in + let (result, identifiers), type_nodes = + Btype.with_allocation_capture (fun () -> + Ident.with_allocation_capture action) + in + let allocated_type_ids = state.type_node_id - first_type_id in + let allocated_ident_stamps = Ident.current_time () - first_ident_stamp in + if + Array.length type_nodes <> allocated_type_ids + || Array.length identifiers <> allocated_ident_stamps + then invalid_arg "incomplete dependency allocation capture"; + ( result, + { + first_type_id; + allocated_type_ids; + type_nodes; + first_ident_stamp; + allocated_ident_stamps; + identifiers; + } ) + +(* A cache entry is exclusive to one compiler domain. The graph is visible to + only one request at a time, and its IDs are reset before it can be reused. *) +let relocate_allocation_stage stage = + let state = Compiler_request_state.current () in + let first_type_id = state.type_node_id in + let first_ident_stamp = Ident.current_time () in + Array.iteri + (fun index ty -> ty.id <- first_type_id + index + 1) + stage.type_nodes; + Array.iteri + (fun index id -> id.Ident.stamp <- first_ident_stamp + index + 1) + stage.identifiers; + state.type_node_id <- first_type_id + stage.allocated_type_ids; + Ident.set_current_time (first_ident_stamp + stage.allocated_ident_stamps) + +let reset_allocation_stage stage = + Array.iteri + (fun index ty -> ty.id <- stage.first_type_id + index + 1) + stage.type_nodes; + Array.iteri + (fun index id -> id.Ident.stamp <- stage.first_ident_stamp + index + 1) + stage.identifiers + type pers_struct = { ps_name: string; ps_sig: signature Lazy.t; @@ -612,6 +697,7 @@ type pers_struct = { ps_crcs: (string * Digest.t option) list; ps_filename: string; ps_flags: pers_flags list; + ps_snapshot: request_snapshot option; } [@@warning "-69"] @@ -674,6 +760,10 @@ module Persistent_signature = struct | exception Not_found -> None) end +let cached_pers_struct_loader : + (check:bool -> name:string -> pers_struct option) ref = + ref (fun ~check:_ ~name:_ -> None) + let acknowledge_pers_struct check modname {Persistent_signature.filename; cmi} = Compiler_phase_trace.dependency "dependency.make_available" (fun () -> let name = cmi.cmi_name in @@ -700,6 +790,7 @@ let acknowledge_pers_struct check modname {Persistent_signature.filename; cmi} = ps_crcs = crcs; ps_filename = filename; ps_flags = flags; + ps_snapshot = None; } in if ps.ps_name <> modname then @@ -721,16 +812,23 @@ let find_pers_struct check name = | exception Not_found -> ( match !(can_load_cmis ()) with | Cannot_load_cmis _ -> raise Not_found - | Can_load_cmis -> - let ps = - match !Persistent_signature.load ~unit_name:name with - | Some ps -> ps - | None -> - Hashtbl.add (persistent_structures ()) name None; - raise Not_found - in - add_import name; - acknowledge_pers_struct check name ps) + | Can_load_cmis -> ( + match !cached_pers_struct_loader ~check ~name with + | Some ps -> + add_import name; + if check then check_consistency ps; + Hashtbl.add (persistent_structures ()) name (Some ps); + ps + | None -> + let ps = + match !Persistent_signature.load ~unit_name:name with + | Some ps -> ps + | None -> + Hashtbl.add (persistent_structures ()) name None; + raise Not_found + in + add_import name; + acknowledge_pers_struct check name ps)) (* Emits a warning if there is no valid cmi for name *) let check_pers_struct name = @@ -1497,10 +1595,466 @@ let add_to_tbl id decl tbl = let decls = try Tbl.find_str id tbl with Not_found -> [] in Tbl.add id (decl :: decls) tbl +module Physical_type_table = Hashtbl.Make (struct + type t = type_expr + + let equal first second = first == second + let hash ty = ty.id +end) + +module Physical_ident_table = Hashtbl.Make (struct + type t = Ident.t + + let equal first second = first == second + let hash id = Hashtbl.hash (id.Ident.stamp, id.Ident.name) +end) + +module Physical_label_table = Hashtbl.Make (struct + type t = label_description + + let equal first second = first == second + let hash label = Hashtbl.hash (label.lbl_name, label.lbl_res.id) +end) + +type type_snapshot = { + nodes: (type_expr * type_desc * int * int) array; + identifiers: (Ident.t * int * int) array; + abbrevs: (abbrev_memo ref * abbrev_memo) array; + mutabilities: (field_mutability ref * field_mutability) array; + row_fields: (row_field option ref * row_field option) array; + label_links: (label_description * label_description array) array; + label_arrays: (label_description array * label_description array) array; + layouts: (Variant_runtime.layout_ref * Variant_runtime.layout) array; + component_checks: (unit -> bool) array; + unsupported: bool; +} + +(* Track the mutable fields reachable from the cached signature and component + tables. Unsupported memo shapes make the entry ineligible for direct reuse. *) +let snapshot_type_graph graph = + let seen = Physical_type_table.create 32768 in + let seen_identifiers = Physical_ident_table.create 8192 in + let seen_label_arrays = Physical_label_table.create 1024 in + let abbrevs = ref [] in + let mutabilities = ref [] in + let row_fields = ref [] in + let label_links = ref [] in + let label_arrays = ref [] in + let layouts = ref [] in + let component_checks = ref [] in + let unsupported = ref false in + let visit_ident id = Physical_ident_table.replace seen_identifiers id () in + let rec visit_path = function + | Pident id -> visit_ident id + | Pdot (path, _, _) -> visit_path path + | Papply (first, second) -> + visit_path first; + visit_path second + in + let visit_abbrev = function + | Mnil -> () + | Mcons _ | Mlink _ -> unsupported := true + in + let rec visit_mutability depth reference = + if depth > 128 then unsupported := true + else ( + mutabilities := (reference, !reference) :: !mutabilities; + match !reference with + | Mutability_value _ -> () + | Mutability_link next -> visit_mutability (depth + 1) next) + in + let rec visit_row_field depth field = + if depth > 128 then unsupported := true + else + match field with + | Reither (_, _, _, reference) -> + row_fields := (reference, !reference) :: !row_fields; + Option.iter (visit_row_field (depth + 1)) !reference + | Rpresent _ | Rabsent -> () + in + let visit_layout reference = + try layouts := (reference, Variant_runtime.get_layout reference) :: !layouts + with Failure _ -> unsupported := true + in + let visit_record_representation = function + | Record_inlined {representation} -> visit_layout representation.variant + | Record_regular | Record_float_unused | Record_unboxed _ | Record_extension + -> + () + in + let rec visit ty = + if not (Physical_type_table.mem seen ty) then ( + Physical_type_table.add seen ty (); + (match ty.desc with + | Tconstr (path, _, reference) -> + visit_path path; + abbrevs := (reference, !reference) :: !abbrevs; + visit_abbrev !reference + | Tfield {mutability} -> visit_mutability 0 mutability + | Tvariant row -> + List.iter (fun (_, field) -> visit_row_field 0 field) row.row_fields; + Option.iter (fun (path, _) -> visit_path path) row.row_name + | Tpackage (path, _, _) -> visit_path path + | Tvar _ | Tarrow _ | Ttuple _ | Tobject _ | Tnil | Tlink _ | Tsubst _ + | Tunivar _ | Tpoly _ -> + ()); + Btype.iter_type_expr visit ty) + in + let original = Btype.type_iterators in + let iterator = + { + original with + it_type_expr = (fun _ ty -> visit ty); + it_type_declaration = + (fun iterator declaration -> + (match declaration.type_kind with + | Type_variant (_, reference) -> visit_layout reference + | Type_abstract | Type_record _ | Type_open -> ()); + original.it_type_declaration iterator declaration); + } + in + let visit_label_declaration declaration = visit_ident declaration.ld_id in + let visit_constructor_declaration declaration = + visit_ident declaration.cd_id; + match declaration.cd_args with + | Cstr_tuple _ -> () + | Cstr_record labels -> List.iter visit_label_declaration labels + in + let visit_type_declaration declaration = + (match declaration.type_kind with + | Type_variant (constructors, _) -> + List.iter visit_constructor_declaration constructors + | Type_record (labels, representation) -> + List.iter visit_label_declaration labels; + visit_record_representation representation + | Type_abstract | Type_open -> ()); + List.iter + (function + | Record {labels} -> List.iter visit_label_declaration labels) + declaration.type_inlined_types + in + let rec visit_module_type = function + | Mty_ident path | Mty_alias (_, path) -> visit_path path + | Mty_signature signature -> List.iter visit_signature_item signature + | Mty_functor (id, argument, result) -> + visit_ident id; + Option.iter visit_module_type argument; + visit_module_type result + and visit_signature_item = function + | Sig_value (id, _) -> visit_ident id + | Sig_type (id, declaration, _) -> + visit_ident id; + visit_type_declaration declaration + | Sig_typext (id, extension, _) -> ( + visit_ident id; + visit_path extension.ext_type_path; + match extension.ext_args with + | Cstr_tuple _ -> () + | Cstr_record labels -> List.iter visit_label_declaration labels) + | Sig_module (id, declaration, _) -> + visit_ident id; + visit_module_type declaration.md_type + | Sig_modtype (id, declaration) -> + visit_ident id; + Option.iter visit_module_type declaration.mtd_type + in + iterator.it_signature iterator graph.raw_signature; + iterator.it_signature iterator graph.expanded_signature; + List.iter visit_signature_item graph.raw_signature; + List.iter visit_signature_item graph.expanded_signature; + Array.iter visit graph.target_ids.type_nodes; + Array.iter visit graph.signature_ids.type_nodes; + Array.iter visit graph.alias_ids.type_nodes; + let capture_components = function + | Some (Structure_comps components) -> + let values = components.comp_values in + let constrs = components.comp_constrs in + let labels_table = components.comp_labels in + let types = components.comp_types in + let modules = components.comp_modules in + let modtypes = components.comp_modtypes in + let nested = components.comp_components in + component_checks := + (fun () -> + components.comp_values == values + && components.comp_constrs == constrs + && components.comp_labels == labels_table + && components.comp_types == types + && components.comp_modules == modules + && components.comp_modtypes == modtypes + && components.comp_components == nested) + :: !component_checks; + Tbl.iter (fun _ (description, _) -> visit description.val_type) values; + Tbl.iter + (fun _ descriptions -> + List.iter + (fun label -> + visit label.lbl_res; + visit label.lbl_arg; + let all = label.lbl_all in + visit_record_representation label.lbl_repres; + if Array.length all = 0 then + label_links := (label, all) :: !label_links + else + let first = all.(0) in + if not (Physical_label_table.mem seen_label_arrays first) then ( + Physical_label_table.add seen_label_arrays first (); + label_arrays := (all, Array.copy all) :: !label_arrays; + Array.iter + (fun member -> + label_links := (member, member.lbl_all) :: !label_links) + all)) + descriptions) + labels_table; + Tbl.iter + (fun _ ((declaration, (constructors, labels)), _) -> + visit_type_declaration declaration; + iterator.it_type_declaration iterator declaration; + List.iter (fun description -> visit description.cstr_res) constructors; + List.iter + (fun description -> + visit description.lbl_res; + visit description.lbl_arg) + labels; + match declaration.type_kind with + | Type_variant (_, reference) -> visit_layout reference + | Type_abstract | Type_record _ | Type_open -> ()) + types; + Tbl.iter + (fun _ descriptions -> + List.iter + (fun description -> + visit description.cstr_res; + List.iter visit description.cstr_existentials; + List.iter visit description.cstr_args; + Option.iter + (fun declaration -> + iterator.it_type_declaration iterator declaration) + description.cstr_inlined; + match description.cstr_kind with + | Ordinary_constructor reference -> visit_layout reference.variant + | Extension_constructor path -> visit_path path) + descriptions) + constrs; + Tbl.iter + (fun _ (declaration, _) -> + Option.iter visit_module_type declaration.mtd_type; + Option.iter + (fun module_type -> iterator.it_module_type iterator module_type) + declaration.mtd_type) + modtypes + | Some (Functor_comps _) | None -> unsupported := true + in + capture_components graph.target_components; + capture_components graph.alias_components; + Array.iter visit_ident graph.target_ids.identifiers; + Array.iter visit_ident graph.signature_ids.identifiers; + Array.iter visit_ident graph.alias_ids.identifiers; + let identifiers = + Physical_ident_table.to_seq_keys seen_identifiers + |> Seq.map (fun id -> (id, id.Ident.stamp, id.Ident.flags)) + |> Array.of_seq + in + { + nodes = + Physical_type_table.to_seq_keys seen + |> Seq.map (fun ty -> (ty, ty.desc, ty.level, ty.id)) + |> Array.of_seq; + identifiers; + abbrevs = Array.of_list !abbrevs; + mutabilities = Array.of_list !mutabilities; + row_fields = Array.of_list !row_fields; + label_links = Array.of_list !label_links; + label_arrays = Array.of_list !label_arrays; + layouts = Array.of_list !layouts; + component_checks = Array.of_list !component_checks; + unsupported = !unsupported; + } + +let type_graph_unchanged snapshot = + (not snapshot.unsupported) + && Array.for_all + (fun (ty, desc, level, id) -> + ty.desc == desc && ty.level = level && ty.id = id) + snapshot.nodes + && Array.for_all + (fun (id, stamp, flags) -> + id.Ident.stamp = stamp && id.Ident.flags = flags) + snapshot.identifiers + && Array.for_all + (fun (reference, value) -> !reference == value) + snapshot.abbrevs + && Array.for_all + (fun (reference, value) -> !reference == value) + snapshot.mutabilities + && Array.for_all + (fun (reference, value) -> !reference == value) + snapshot.row_fields + && Array.for_all + (fun (label, array) -> label.lbl_all == array) + snapshot.label_links + && Array.for_all + (fun (array, contents) -> + Array.length array = Array.length contents + && Array.for_all2 ( == ) array contents) + snapshot.label_arrays + && Array.for_all + (fun (reference, layout) -> + Variant_runtime.get_layout reference == layout) + snapshot.layouts + && Array.for_all (fun check -> check ()) snapshot.component_checks + +type expanded_snapshot_cache_entry = { + key: alias_key; + target_filename: string; + namespace_filename: string; + target_stats: Unix.stats; + namespace_stats: Unix.stats; + bytes: bytes; + mutable graph: expanded_snapshot option; + mutable typed_integrity: type_snapshot option; + mutable in_use: bool; +} + +let expanded_snapshot_cache_key = Domain.DLS.new_key (fun () -> ref None) +let expanded_snapshot_cache () = Domain.DLS.get expanded_snapshot_cache_key + +(* Preparing a large graph costs more than one ordinary alias expansion. Wait + for a second compiler request across the process so one-off edits stay cheap. + The expanded graphs themselves remain exclusive to their compiler domains. *) +let expanded_snapshot_candidates = Hashtbl.create 8 +let expanded_snapshot_candidates_lock = Mutex.create () + +let candidate_seen_in_previous_request key filename request = + Mutex.lock expanded_snapshot_candidates_lock; + Fun.protect + (fun () -> + let candidate = (key, filename) in + let seen = + match Hashtbl.find_opt expanded_snapshot_candidates candidate with + | Some previous -> previous != request + | None -> false + in + Hashtbl.replace expanded_snapshot_candidates candidate request; + seen) + ~finally:(fun () -> Mutex.unlock expanded_snapshot_candidates_lock) + +let forget_snapshot_candidate key filename = + Mutex.lock expanded_snapshot_candidates_lock; + Fun.protect + (fun () -> Hashtbl.remove expanded_snapshot_candidates (key, filename)) + ~finally:(fun () -> Mutex.unlock expanded_snapshot_candidates_lock) + +let expanded_snapshot_enabled_key = Domain.DLS.new_key (fun () -> false) + +let with_expanded_snapshot_cache action = + let previous = Domain.DLS.get expanded_snapshot_enabled_key in + Domain.DLS.set expanded_snapshot_enabled_key true; + Fun.protect action ~finally:(fun () -> + Domain.DLS.set expanded_snapshot_enabled_key previous) + +let preparing_expanded_snapshot = Domain.DLS.new_key (fun () -> false) +let prepare_expanded_snapshot : (alias_key -> unit) ref = ref (fun _ -> ()) + +let expanded_snapshot_enabled () = + match Sys.getenv_opt "REWATCH_COMBINED_SIGNATURE_CACHE" with + | Some "0" -> false + | Some ("force" | "force_typed" | "typed" | "audit") -> true + | _ -> Domain.DLS.get expanded_snapshot_enabled_key + +let typed_expanded_snapshot_reuse () = + not (Sys.getenv_opt "REWATCH_COMBINED_SIGNATURE_CACHE" = Some "force") + +let audit_expanded_snapshot_reuse () = + Sys.getenv_opt "REWATCH_COMBINED_SIGNATURE_CACHE" = Some "audit" + +let force_fresh_expanded_snapshot () = + Sys.getenv_opt "REWATCH_COMBINED_SIGNATURE_CACHE" = Some "force" + +let same_file_stats first second = + first.Unix.st_dev = second.Unix.st_dev + && first.Unix.st_ino = second.Unix.st_ino + && first.Unix.st_size = second.Unix.st_size + && first.Unix.st_mtime = second.Unix.st_mtime + && first.Unix.st_ctime = second.Unix.st_ctime + +let is_target_path name = function + | Pident id -> Ident.persistent id && Ident.name id = name + | Pdot _ | Papply _ -> false + +let alias_key_of_module path mty = + match (path, mty) with + | Pdot (Pident root, alias_name, _), Mty_alias (_, Pident target) + when Ident.persistent root && Ident.persistent target -> + Some + { + target_name = Ident.name target; + namespace_name = Ident.name root; + alias_name; + } + | _ -> None + +let is_alias_path key path mty = alias_key_of_module path mty = Some key + let rec components_of_module ~deprecated ~loc env sub path mty = {deprecated; loc; comps = Env_lazy.create (env, sub, path, mty)} and components_of_module_maker (env, sub, path, mty) = + Compiler_phase_trace.dependency_lazy + (fun () -> + let origin = + match mty with + | Mty_alias (_, target) -> ":alias=" ^ Path.name target + | Mty_ident target -> ":ident=" ^ Path.name target + | Mty_signature _ -> ":signature" + | Mty_functor _ -> ":functor" + in + "dependency.expand_components:" ^ Path.name path ^ origin) + (fun () -> + if not (expanded_snapshot_enabled ()) then + components_of_module_maker_uncached (env, sub, path, mty) + else + let alias_key = alias_key_of_module path mty in + let target_name = + match path with + | Pident id when Ident.persistent id -> Some (Ident.name id) + | _ -> Option.map (fun key -> key.target_name) alias_key + in + let cached = + match target_name with + | Some target_name -> ( + try (find_pers_struct target_name).ps_snapshot + with Not_found -> None) + | None -> None + in + match cached with + | Some snapshot when is_target_path snapshot.key.target_name path -> + if not snapshot.target_relocated then ( + relocate_allocation_stage snapshot.graph.target_ids; + snapshot.target_relocated <- true); + snapshot.graph.target_components + | Some snapshot when is_alias_path snapshot.key path mty -> + ignore (Lazy.force (find_pers_struct snapshot.key.target_name).ps_sig); + if not snapshot.alias_relocated then ( + relocate_allocation_stage snapshot.graph.alias_ids; + snapshot.alias_relocated <- true); + snapshot.graph.alias_components + | _ -> + let result = + components_of_module_maker_uncached (env, sub, path, mty) + in + (match alias_key with + | Some key when not (Domain.DLS.get preparing_expanded_snapshot) -> ( + try !prepare_expanded_snapshot key + with + | Not_found | Sys_error _ | Unix.Unix_error _ | Cmi_format.Error _ + | Error _ | Invalid_argument _ + -> + ()) + | _ -> ()); + result) + +and components_of_module_maker_uncached (env, sub, path, mty) = match scrape_alias env mty with | Mty_signature sg -> let c = @@ -1973,6 +2527,7 @@ let save_signature_with_imports ?check_exists ~deprecated sg modname filename ps_crcs = (cmi.cmi_name, Some crc) :: imports; ps_filename = filename; ps_flags = cmi.cmi_flags; + ps_snapshot = None; } in save_pers_struct crc ps; @@ -2140,6 +2695,253 @@ let with_fresh action = (fun () -> ref empty) action)))))))))))) +let snapshot_graph_from_cmis key = + let namespace = find_pers_struct key.namespace_name in + let dependency = find_pers_struct key.target_name in + let raw_signature = + match Env_lazy.get_arg dependency.ps_comps.comps with + | Some (_, _, _, Mty_signature signature) -> signature + | _ -> raise Not_found + in + let alias_component = + match get_components namespace.ps_comps with + | Structure_comps components -> + fst (Tbl.find_str key.alias_name components.comp_components) + | Functor_comps _ -> raise Not_found + in + let env, sub, path, mty = + match Env_lazy.get_arg alias_component.comps with + | Some context -> context + | None -> raise Not_found + in + if not (is_alias_path key path mty) then raise Not_found; + let target_components, target_ids = + capture_allocation_stage (fun () -> get_components_opt dependency.ps_comps) + in + let expanded_signature, signature_ids = + capture_allocation_stage (fun () -> Lazy.force dependency.ps_sig) + in + let alias_components, alias_ids = + capture_allocation_stage (fun () -> + components_of_module_maker_uncached (env, sub, path, mty)) + in + (match alias_components with + | Some (Structure_comps components) -> + if + Tbl.fold (fun _ _ _ -> true) components.comp_modules false + || Tbl.fold (fun _ _ _ -> true) components.comp_components false + then raise Not_found + | Some (Functor_comps _) | None -> raise Not_found); + { + raw_signature; + expanded_signature; + target_components; + alias_components; + target_ids; + signature_ids; + alias_ids; + crcs = dependency.ps_crcs; + flags = dependency.ps_flags; + } + +let prepare_expanded_snapshot_now key = + let cache = expanded_snapshot_cache () in + if !cache = None then + let namespace = find_pers_struct key.namespace_name in + let dependency = find_pers_struct key.target_name in + let namespace_filename = + Compiler_request_state.resolve_path namespace.ps_filename + in + let target_filename = + Compiler_request_state.resolve_path dependency.ps_filename + in + let namespace_stats = Unix.stat namespace_filename in + let target_stats = Unix.stat target_filename in + let forced = + match Sys.getenv_opt "REWATCH_COMBINED_SIGNATURE_CACHE" with + | Some ("force" | "force_typed") -> true + | _ -> false + in + if target_stats.Unix.st_size >= 256 * 1024 || forced then + let request = Compiler_request_state.current () in + let seen_in_previous_request = + candidate_seen_in_previous_request key target_filename request + in + if forced || seen_in_previous_request then ( + let cwd = Compiler_request_state.cwd () in + let load_path = Config.get_load_path () in + let previous = Domain.DLS.get preparing_expanded_snapshot in + Domain.DLS.set preparing_expanded_snapshot true; + let graph = + Fun.protect + (fun () -> + Ident.with_fresh (fun () -> + with_fresh (fun () -> + Btype.with_fresh (fun () -> + Compiler_request_state.with_fresh ~cwd (fun () -> + Config.set_load_path load_path; + snapshot_graph_from_cmis key))))) + ~finally:(fun () -> + Domain.DLS.set preparing_expanded_snapshot previous) + in + let bytes = Marshal.to_bytes graph [] in + if + Bytes.length bytes <= 8 * 1024 * 1024 + && same_file_stats (Unix.stat namespace_filename) namespace_stats + && same_file_stats (Unix.stat target_filename) target_stats + then + cache := + Some + { + key; + target_filename; + namespace_filename; + target_stats; + namespace_stats; + bytes; + graph = Some graph; + typed_integrity = + (if typed_expanded_snapshot_reuse () then + Some + (Compiler_phase_trace.dependency + "dependency.snapshot_capture" (fun () -> + snapshot_type_graph graph)) + else None); + in_use = false; + }) + +let load_expanded_snapshot ~check:_ ~name = + if + (not (expanded_snapshot_enabled ())) + || Domain.DLS.get preparing_expanded_snapshot + then None + else + let cached = !(expanded_snapshot_cache ()) in + match cached with + | Some entry when name = entry.key.target_name -> + let valid = + Compiler_phase_trace.dependency "dependency.snapshot_validate" + (fun () -> + try + let path name = + find_in_path_uncap (Config.get_load_path ()) (name ^ ".cmi") + |> Compiler_request_state.resolve_path + in + path entry.key.target_name = entry.target_filename + && path entry.key.namespace_name = entry.namespace_filename + && same_file_stats + (Unix.stat entry.target_filename) + entry.target_stats + && same_file_stats + (Unix.stat entry.namespace_filename) + entry.namespace_stats + with Not_found | Sys_error _ | Unix.Unix_error _ -> false) + in + if not valid then ( + forget_snapshot_candidate entry.key entry.target_filename; + expanded_snapshot_cache () := None; + None) + else + Some + (Compiler_phase_trace.dependency "dependency.snapshot_reuse" + (fun () -> + let graph : expanded_snapshot = + match entry.graph with + | Some graph when not (force_fresh_expanded_snapshot ()) -> + graph + | Some _ | None -> + let graph = + Compiler_phase_trace.dependency + "dependency.snapshot_restore" (fun () -> + Marshal.from_bytes entry.bytes 0) + in + entry.graph <- Some graph; + entry.typed_integrity <- + (if typed_expanded_snapshot_reuse () then + Some + (Compiler_phase_trace.dependency + "dependency.snapshot_capture" (fun () -> + snapshot_type_graph graph)) + else None); + graph + in + entry.in_use <- true; + let snapshot = + { + key = entry.key; + graph; + target_relocated = false; + signature_relocated = false; + alias_relocated = false; + } + in + let deprecated = + List.fold_left + (fun _ -> function + | Deprecated s -> Some s) + None graph.flags + in + let ps_comps = + components_of_module ~deprecated ~loc:Location.none empty + Subst.identity + (Pident (Ident.create_persistent name)) + (Mty_signature graph.raw_signature) + in + let ps_sig = + lazy + (if not snapshot.signature_relocated then ( + relocate_allocation_stage graph.signature_ids; + snapshot.signature_relocated <- true); + graph.expanded_signature) + in + { + ps_name = name; + ps_sig; + ps_comps; + ps_crcs = graph.crcs; + ps_filename = entry.target_filename; + ps_flags = graph.flags; + ps_snapshot = Some snapshot; + })) + | _ -> None + +let finalize_expanded_snapshot_cache () = + match !(expanded_snapshot_cache ()) with + | Some entry when entry.in_use -> ( + entry.in_use <- false; + match entry.graph with + | Some _ when force_fresh_expanded_snapshot () -> + entry.graph <- None; + entry.typed_integrity <- None + | Some graph -> + let pristine = + Compiler_phase_trace.dependency "dependency.snapshot_verify" (fun () -> + reset_allocation_stage graph.target_ids; + reset_allocation_stage graph.signature_ids; + reset_allocation_stage graph.alias_ids; + let typed = + match entry.typed_integrity with + | Some snapshot -> type_graph_unchanged snapshot + | None -> false + in + (if audit_expanded_snapshot_reuse () then + let full = Marshal.to_bytes graph [] = entry.bytes in + if typed && not full then + failwith "typed dependency integrity check missed mutation"); + typed) + in + if not pristine then ( + Compiler_phase_trace.dependency "dependency.snapshot_dirty" (fun () -> + ()); + entry.graph <- None; + entry.typed_integrity <- None) + | None -> ()) + | _ -> () + +let () = + prepare_expanded_snapshot := prepare_expanded_snapshot_now; + cached_pers_struct_loader := load_expanded_snapshot + let keep_only_summary env = if !(last_env ()) == env then !(last_reduced_env ()) else diff --git a/compiler/ml/env.mli b/compiler/ml/env.mli index 04411ac872..0d48df9bd7 100644 --- a/compiler/ml/env.mli +++ b/compiler/ml/env.mli @@ -215,6 +215,13 @@ val crc_units : unit -> Consistbl.t val add_import : string -> unit val with_fresh : (unit -> 'a) -> 'a + +(* Finish the exclusive cache lease after a compiler request, resetting + allocated IDs and discarding a graph if typing changed it. *) +val finalize_expanded_snapshot_cache : unit -> unit + +(* Enable the per-domain expanded CMI cache for Rewatch requests. *) +val with_expanded_snapshot_cache : (unit -> 'a) -> 'a (* Keep persistent modules, imports, usage callbacks, and memoized summaries local to a compiler request. *) diff --git a/compiler/ml/types.ml b/compiler/ml/types.ml index 94147e9034..318bfcc950 100644 --- a/compiler/ml/types.ml +++ b/compiler/ml/types.ml @@ -19,7 +19,7 @@ open Asttypes (* Type expressions for the core language *) -type type_expr = {mutable desc: type_desc; mutable level: int; id: int} +type type_expr = {mutable desc: type_desc; mutable level: int; mutable id: int} and arg = {lbl: arg_label; typ: type_expr} diff --git a/compiler/ml/types.mli b/compiler/ml/types.mli index 47c2aaf147..ed8102235d 100644 --- a/compiler/ml/types.mli +++ b/compiler/ml/types.mli @@ -24,7 +24,7 @@ open Asttypes (** Asttypes exposes basic definitions shared both by Parsetree and Types. *) -type type_expr = {mutable desc: type_desc; mutable level: int; id: int} +type type_expr = {mutable desc: type_desc; mutable level: int; mutable id: int} (** Type expressions for the core language. The [type_desc] variant defines all the possible type expressions one can @@ -32,6 +32,9 @@ type type_expr = {mutable desc: type_desc; mutable level: int; id: int} The [level] field tracks the level of polymorphism associated to a type, guiding the generalization algorithm. + [id] may be relocated only while a cached dependency graph is exclusive + to one compiler request and before it is exposed to typing or used as a + map key. Put shortly, when referring to a type in a given environment, both the type and the environment have a level. If the type has an higher level, then it can be considered fully polymorphic (type variables will be printed as diff --git a/rewatch-ocaml/bench/README.md b/rewatch-ocaml/bench/README.md index fe9731dcaa..da51c5547b 100644 --- a/rewatch-ocaml/bench/README.md +++ b/rewatch-ocaml/bench/README.md @@ -439,16 +439,152 @@ 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. +A separate 64 MiB raw CMI byte-cache prototype kept file bytes across +requests, checked file metadata before reuse, and decoded a fresh signature +on every read. Three interleaved eight-worker clean-build pairs gave median +elapsed times of 1.46 s without the cache and 1.42 s with it; median peak +RSS was 363,916 and 355,588 KiB, respectively, within the run-to-run +spread. It left path lookup, Marshal decoding, and signature opening in place, +so this gain was too small to justify another cache and invalidation path. +The prototype was removed. The combined experiment below tested CMI loading +and expansion together while preserving fresh mutable type graphs. + +### Expanded WebAPI component cache experiment + +A later release-profile experiment tried caching the expanded +`WebAPI.DOMAPI` alias and its forced `DOMAPI-WebAPI` signature. The cache +serialized one expanded graph, then deserialized and relocated its generated +type and identifier IDs for each fresh compiler request. It did not share +mutable type nodes between requests. The snapshot was 1.74 MB. Tracing +`components_of_module_maker` with the +`dependency.expand_components::alias=` phase found 137 +`WebAPI.DOMAPI` expansions in the +isolated testrepo clean build, taking 1.724 s and allocating 1.034 GB of +summed worker work. Preparing the snapshot took about 29 ms once; 136 copies +took 0.780 s and allocated 785 MB. These phase totals include tracing and +do not predict elapsed build savings by themselves. + +Three interleaved eight-worker clean builds with the same fixture and +release-profile executable gave median elapsed times of 1.57 s without the +cache and 1.52 s with it. Median peak process RSS rose from 344,176 to +466,916 KiB. Two single-worker pairs gave 4.30 and 4.27 s without the cache, +versus 3.73 and 3.75 s with it; peak RSS rose from about 91 to 118 MiB. +In one retained watcher edit, the cached compiler request took 8.78 ms versus +11.32 ms without the cache. The build-level gain with eight workers was too +small for the memory cost and the extra type-graph relocation machinery, so +the prototype was removed. + +A follow-up replaced the graph-wide ID search with allocation capture while +expanding the alias. It prepared the snapshot in about 17 ms, but the 136 +copies still took 885 ms of summed worker time. Three eight-worker pairs had +the same 1.46 s median elapsed time with and without this cache; median peak +RSS was 489,628 KiB with it and 347,792 KiB without it. Lowering the OCaml +major-heap space overhead to 10% reduced some peaks but did not produce a +consistent elapsed-time gain. Its 14,739 selected artifacts matched the +same-binary uncached build byte for byte. This simpler implementation was +also removed. + +The experiment also checked correctness. An isolated compiler-driver fixture +confirmed that fresh requests received distinct mutable type nodes and that +rebuilding `DOMAPI-WebAPI.cmi` from an `int` signature to a `string` signature +invalidated the cache. All 14,739 selected generated artifacts in the full +clean build had identical SHA-256 hashes with and without caching. The target +CMI was already loaded before every alias expansion in this fixture, so this +cache did not avoid its per-request CMI decode. + +### Combined CMI and expansion snapshot experiment + +A further prototype stored the raw target CMI signature, its expanded +signature, and the target and `WebAPI.DOMAPI` component tables in one 2.58 MB +snapshot. Each request deserialized the snapshot into a fresh graph and +relocated generated IDs when each lazy stage was first forced. The target and +namespace CMI paths and file identity, size, modification time, and change +time guarded reuse. A separate prototype hashed both files on every hit, but +that validation alone cost 0.71 s of summed worker time across 134 hits; file +metadata checks took about 0.01 s. A focused compiler-driver test passed +request graph isolation and target-CMI invalidation, and all 14,739 selected +artifacts matched the same-binary uncached build byte for byte. + +The snapshot clone itself took about 1.45 s and allocated 1.30 GB of summed +worker work across 134 hits. One traced eight-worker clean build took 1.48 s +and peaked at 578,340 KiB RSS, versus roughly 1.46 s and 350,000 KiB in the +uncached runs. Two interleaved single-worker pairs took 4.45 and 4.58 s +uncached versus 3.64 and 3.68 s cached; peak RSS rose from about 92 to 145 +MiB. A retained watcher edit took 10.94 ms of compiler request time cached +versus 11.29 ms uncached. Splitting the target components into a separate +lazy clone raised eight-worker peak RSS to 765,876 KiB and elapsed time to +1.78 s, though its artifacts still matched. These are small samples and the +watcher comparison is one edit per mode. + +The combined cache made the single-worker clean build about 19% faster, but +it did not improve the default eight-worker build and substantially increased +its peak memory. It was removed. Further work needs to reduce the allocation +cost of fresh mutable graphs or shorten the build's critical path, rather than +only eliminating summed worker work. + +A later two-pair sweep of the same opt-in prototype across worker counts showed +where the gain disappears. Each pair cleaned the same fixture and interleaved +uncached and cached builds with the same release executable. Elapsed times and +peak RSS (KiB) were: + +| workers | uncached elapsed | cached elapsed | uncached RSS | cached RSS | +| ---: | ---: | ---: | ---: | ---: | +| 2 | 3.90 / 3.74 s | 2.83 / 2.86 s | 134,436 / 135,312 | 214,708 / 240,496 | +| 4 | 2.16 / 2.15 s | 1.98 / 1.92 s | 203,464 / 205,520 | 328,904 / 346,148 | +| 6 | 1.65 / 1.66 s | 1.58 / 1.57 s | 281,580 / 280,672 | 469,440 / 476,992 | +| 8 | 1.61 / 1.44 s | 1.50 / 1.45 s | 344,468 / 356,152 | 633,676 / 600,740 | + +The two-worker gain is substantial, but this implementation hard-codes one +WebAPI alias and is not suitable as a general compiler cache. The eight-worker +elapsed differences remain within the observed uncached spread. + +### Per-domain in-memory graph reuse + +The retained implementation keeps one expanded alias graph per compiler domain. A +domain never compiles two requests at once, so the graph is exclusive while a +request runs. The cache relocates generated type and identifier IDs when +the graph enters each request, then checks that mutable graph state is +restored before the next request. A full serialization check on one eight-worker +clean build found no retained mutation across 129 reuses. A cheaper typed +check covered type nodes, captured identifiers, abbreviation and object-field +references, row-field references, variant layouts, label arrays, and component +tables; an audit mode compared it with the full serialization check on every +reuse without a disagreement in that fixture. Cache entries still checked the +target and namespace CMI paths and file metadata before use. + +Three interleaved eight-worker pairs with the typed check took 1.48, 1.49, +and 1.51 s uncached versus 1.31, 1.27, and 1.25 s cached. Peak RSS ranged from +347–357 MiB uncached and 520–541 MiB cached. All 14,739 selected artifacts +matched byte for byte in a same-binary cached/uncached comparison. An +upper-bound trial without the request-boundary check took 1.19–1.26 s cached +versus 1.45–1.52 s uncached. That unchecked mode was removed. The checked +cache is enabled by default for Rewatch compiler workers. It reuses mutable +nodes sequentially on one domain after verifying that the previous request +left the graph clean. A dirty graph is restored from the saved snapshot. + +A first same-binary release-profile comparison used three interleaved +eight-worker clean testrepo pairs. Setting +`REWATCH_COMBINED_SIGNATURE_CACHE=0` disabled the cache for the baseline. +Elapsed times were 1.64, 1.54, and 1.51 s without the cache versus 1.35, +1.27, and 1.30 s with it: medians of 1.54 and 1.30 s. A cold two-module +incremental build was slower with eager snapshot preparation, however: +0.16 s cached versus 0.09 s uncached. It compiled one WebAPI source that +opened the large DOMAPI signature only once. + +The retained cache waits until two distinct compiler requests have expanded +the same large alias before preparing a snapshot. A small process-wide table +tracks that first encounter; expanded graphs remain private to each domain. +Six further interleaved eight-worker clean pairs took 1.48, 1.43, 1.43, +1.46, 1.43, and 1.46 s uncached versus 1.23, 1.27, 1.21, 1.28, 1.27, and +1.26 s cached. Median elapsed time fell from 1.45 to 1.27 s, about 12%. +Median peak RSS rose from 349 to 523 MiB. Both selected-artifact comparisons +matched all 14,741 files byte for byte. Three cold incremental pairs after +this change took 0.08–0.09 s uncached and 0.09 s cached, rebuilt the same +two modules, and produced identical selected artifacts. The compiler test +suite, Rewatch integration suite, and a focused test for sequential reuse, +cross-domain separation, dirty-graph recovery, and CMI invalidation passed. +A final audit build checked 128 cached request boundaries against full graph +serialization without a disagreement. ## Bulk label table checkpoint diff --git a/rewatch-ocaml/compiler_process.ml b/rewatch-ocaml/compiler_process.ml index 84eaa669b8..4644fe948c 100644 --- a/rewatch-ocaml/compiler_process.ml +++ b/rewatch-ocaml/compiler_process.ml @@ -69,19 +69,20 @@ let run_in_process ?poll (job : Process.job) = | input :: reversed_argv -> let result = time_compiler_request job (fun () -> - Rescript_compiler_driver.run_request ~cwd:job.cwd - ~argv:(List.rev reversed_argv) ~input - ~run_external: - (Some - (fun command -> - let command = Platform.shell_command command in - (* Signal handlers are process-wide; domain workers launch - PPXs without replacing the scheduler domain's handlers. *) - let result = - Process.run ?poll ~defer_signals:false ~cwd:job.cwd - command.program command.args - in - (exit_code result.status, result.stdout, result.stderr)))) + Env.with_expanded_snapshot_cache (fun () -> + Rescript_compiler_driver.run_request ~cwd:job.cwd + ~argv:(List.rev reversed_argv) ~input + ~run_external: + (Some + (fun command -> + let command = Platform.shell_command command in + (* Signal handlers are process-wide; domain workers launch + PPXs without replacing the scheduler domain's handlers. *) + let result = + Process.run ?poll ~defer_signals:false ~cwd:job.cwd + command.program command.args + in + (exit_code result.status, result.stdout, result.stderr))))) in { Process.status = Unix.WEXITED result.exit_code; diff --git a/tests/rewatch_ounit_tests/compiler_driver_tests.ml b/tests/rewatch_ounit_tests/compiler_driver_tests.ml index b04b1cf2bf..df1cdeddb5 100644 --- a/tests/rewatch_ounit_tests/compiler_driver_tests.ml +++ b/tests/rewatch_ounit_tests/compiler_driver_tests.ml @@ -981,6 +981,123 @@ let interface_namespace_and_load_path_tests _context = ("namespace output is retained: " ^ extension)) ["cmi"; "cmj"; "cmt"]) +let combined_dependency_cache_tests _context = + Test_support.with_temp_dir "rewatch-combined-dependency-" (fun root -> + let previous_cache = Sys.getenv_opt "REWATCH_COMBINED_SIGNATURE_CACHE" in + let previous_trace = Sys.getenv_opt "REWATCH_TYPECHECK_TRACE" in + Fun.protect + (fun () -> + Unix.putenv "REWATCH_COMBINED_SIGNATURE_CACHE" "force"; + let trace = Filename.concat root "dependency-trace.tsv" in + Unix.putenv "REWATCH_TYPECHECK_TRACE" trace; + let compile ?(extra = []) input = + let _, result = run root ~extra:(["-I"; root] @ extra) input in + expect_code 0 result + in + let compile_dependency () = + compile ~extra:["-bs-ns"; "Shapes"] "Circle.resi"; + compile ~extra:["-bs-ns"; "Shapes"; "-bs-read-cmi"] "Circle.res"; + compile ~extra:["-no-alias-deps"] "Shapes.mlmap" + in + write root "Shapes.mlmap" "randjbuildsystem\nCircle\n"; + write root "Circle.resi" "let value: int\n"; + write root "Circle.res" "let value = 1\n"; + compile ~extra:["-no-alias-deps"] "Shapes.mlmap"; + compile_dependency (); + write root "Consumer.res" + "open Shapes.Circle\nlet result: int = value\n"; + compile "Consumer.res"; + let first_cmi = + File_util.read_file (Filename.concat root "Consumer.cmi") + in + let first_cmt = + File_util.read_file (Filename.concat root "Consumer.cmt") + in + compile "Consumer.res"; + check + (Test_support.contains_text + (File_util.read_file trace) + "dependency.snapshot_restore") + "a repeated namespace open copies the combined snapshot"; + Unix.putenv "REWATCH_COMBINED_SIGNATURE_CACHE" "0"; + compile "Consumer.res"; + assert_equal + ~printer:(fun _ -> "") + first_cmi + (File_util.read_file (Filename.concat root "Consumer.cmi")); + assert_equal + ~printer:(fun _ -> "") + first_cmt + (File_util.read_file (Filename.concat root "Consumer.cmt")); + Unix.putenv "REWATCH_COMBINED_SIGNATURE_CACHE" "force"; + let value_path = + let module_path = + Path.Pdot + ( Path.Pident (Ident.create_persistent "Shapes"), + "Circle", + Path.nopos ) + in + Path.Pdot (module_path, "value", Path.nopos) + in + let with_loaded_type action = + Fun.protect + (fun () -> + Compiler_request_state.with_fresh ~cwd:root (fun () -> + Env.with_fresh (fun () -> + (Compiler_request_state.current ()).load_path <- [root]; + action + (Env.find_value value_path Env.empty).Types.val_type))) + ~finally:Env.finalize_expanded_snapshot_cache + in + let loaded_type () = with_loaded_type Fun.id in + let first = loaded_type () in + let second = loaded_type () in + check (first != second) + "cached dependency types belong to each request"; + first.Types.desc <- Types.Tvar (Some "changed"); + check + (match second.Types.desc with + | Types.Tvar (Some "changed") -> false + | _ -> true) + "mutating one request's dependency graph does not affect another"; + Unix.putenv "REWATCH_COMBINED_SIGNATURE_CACHE" "force_typed"; + compile "Consumer.res"; + compile "Consumer.res"; + let reused_first = loaded_type () in + let reused_second = loaded_type () in + check + (reused_first == reused_second) + "one compiler domain reuses its verified-clean dependency graph"; + let other_domain_type = Domain.join (Domain.spawn loaded_type) in + check + (reused_second != other_domain_type) + "different compiler domains have separate dependency graphs"; + with_loaded_type (fun ty -> + ty.Types.desc <- Types.Tvar (Some "changed")); + let restored = loaded_type () in + check (restored != reused_first) + "a changed dependency graph is restored before reuse"; + check + (match restored.Types.desc with + | Types.Tvar (Some "changed") -> false + | _ -> true) + "the restored dependency graph keeps the original type"; + write root "Circle.resi" "let value: string\n"; + write root "Circle.res" {|let value = "updated"|}; + compile_dependency (); + write root "ConsumerString.res" + "open Shapes.Circle\nlet result: string = value\n"; + compile "ConsumerString.res"; + let _, stale = run root ~extra:["-I"; root] "Consumer.res" in + expect_code 2 stale) + ~finally:(fun () -> + (match previous_trace with + | Some value -> Unix.putenv "REWATCH_TYPECHECK_TRACE" value + | None -> Unix.unsetenv "REWATCH_TYPECHECK_TRACE"); + match previous_cache with + | Some value -> Unix.putenv "REWATCH_COMBINED_SIGNATURE_CACHE" value + | None -> Unix.unsetenv "REWATCH_COMBINED_SIGNATURE_CACHE")) + let concurrent_diagnostic_recovery_tests _context = Test_support.with_temp_dir "rewatch-driver-errors-" (fun root -> let first = Filename.concat root "first" in @@ -1257,6 +1374,7 @@ let tests = "generated_name_isolation" >:: generated_name_isolation_tests; "interfaces_namespaces_load_paths" >:: interface_namespace_and_load_path_tests; + "combined_dependency_cache" >:: combined_dependency_cache_tests; "concurrent_diagnostic_recovery" >:: concurrent_diagnostic_recovery_tests; "concurrent_jsx_diagnostic" >:: concurrent_jsx_diagnostic_tests; From d1c43a0c07ab7dda2bee05ec32c11d16dcbb0058 Mon Sep 17 00:00:00 2001 From: Florian Hammerschmidt Date: Fri, 25 Sep 2026 16:50:18 +0200 Subject: [PATCH 2/3] Document OCaml rewatch signature cache in changelog Signed-off-by: Florian Hammerschmidt --- CHANGELOG.md | 1 + 1 file changed, 1 insertion(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index 35f5a71ba7..5b5241857d 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -28,6 +28,7 @@ #### :nail_care: Polish +- Speed up OCaml rewatch builds that repeatedly open large signatures by reusing verified expanded signature graphs per compiler worker. https://github.com/rescript-lang/rescript/pull/8673 - Avoid running `rescript-schema-ppx` and `sury-ppx` on source files without an `@schema` annotation. https://github.com/rescript-lang/rescript/pull/8662 #### :house: Internal From 5d68298a9d54f0ad98f1b1de1e2ead4853845f63 Mon Sep 17 00:00:00 2001 From: Florian Hammerschmidt Date: Fri, 25 Sep 2026 18:51:49 +0200 Subject: [PATCH 3/3] Reuse runtime CMIs and shared signature snapshots Signed-off-by: Florian Hammerschmidt --- CHANGELOG.md | 1 + compiler/ml/env.ml | 240 ++++++++++++++---- rewatch-ocaml/bench/README.md | 118 +++++++++ .../compiler_driver_tests.ml | 78 +++++- 4 files changed, 390 insertions(+), 47 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 5b5241857d..ae40edbb74 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -29,6 +29,7 @@ #### :nail_care: Polish - Speed up OCaml rewatch builds that repeatedly open large signatures by reusing verified expanded signature graphs per compiler worker. https://github.com/rescript-lang/rescript/pull/8673 +- Reuse decoded standard-library interfaces and share prepared signature images across OCaml rewatch workers for faster clean builds. https://github.com/rescript-lang/rescript/pull/8673 - Avoid running `rescript-schema-ppx` and `sury-ppx` on source files without an `@schema` annotation. https://github.com/rescript-lang/rescript/pull/8662 #### :house: Internal diff --git a/compiler/ml/env.ml b/compiler/ml/env.ml index 8942e2be02..0803fd1a75 100644 --- a/compiler/ml/env.ml +++ b/compiler/ml/env.ml @@ -764,6 +764,10 @@ let cached_pers_struct_loader : (check:bool -> name:string -> pers_struct option) ref = ref (fun ~check:_ ~name:_ -> None) +let cached_cmi_loader : + (name:string -> Persistent_signature.t option option) ref = + ref (fun ~name:_ -> None) + let acknowledge_pers_struct check modname {Persistent_signature.filename; cmi} = Compiler_phase_trace.dependency "dependency.make_available" (fun () -> let name = cmi.cmi_name in @@ -821,7 +825,11 @@ let find_pers_struct check name = ps | None -> let ps = - match !Persistent_signature.load ~unit_name:name with + match + match !cached_cmi_loader ~name with + | Some cached -> cached + | None -> !Persistent_signature.load ~unit_name:name + with | Some ps -> ps | None -> Hashtbl.add (persistent_structures ()) name None; @@ -1908,9 +1916,10 @@ type expanded_snapshot_cache_entry = { key: alias_key; target_filename: string; namespace_filename: string; + resolved_load_path: string list; target_stats: Unix.stats; namespace_stats: Unix.stats; - bytes: bytes; + bytes: string; mutable graph: expanded_snapshot option; mutable typed_integrity: type_snapshot option; mutable in_use: bool; @@ -1919,6 +1928,23 @@ type expanded_snapshot_cache_entry = { let expanded_snapshot_cache_key = Domain.DLS.new_key (fun () -> ref None) let expanded_snapshot_cache () = Domain.DLS.get expanded_snapshot_cache_key +(* Only the marshaled image crosses domain boundaries. Each compiler domain + decodes its own graph, so type inference never mutates another worker's + imported types. The lock also lets one worker prepare a shared image while + other workers wait to decode it. *) +type shared_expanded_snapshot = { + key: alias_key; + target_filename: string; + namespace_filename: string; + resolved_load_path: string list; + target_stats: Unix.stats; + namespace_stats: Unix.stats; + bytes: string; +} + +let shared_expanded_snapshot = ref None +let shared_expanded_snapshot_lock = Mutex.create () + (* Preparing a large graph costs more than one ordinary alias expansion. Wait for a second compiler request across the process so one-off edits stay cheap. The expanded graphs themselves remain exclusive to their compiler domains. *) @@ -1978,6 +2004,82 @@ let same_file_stats first second = && first.Unix.st_mtime = second.Unix.st_mtime && first.Unix.st_ctime = second.Unix.st_ctime +type cmi_cache_entry = { + resolved_filename: string; + stats: Unix.stats; + bytes: bytes; + mutable cmi: Cmi_format.cmi_infos; + mutable used: bool; +} + +let cmi_cache_key = Domain.DLS.new_key (fun () -> Hashtbl.create 2) +let cmi_cache () = Domain.DLS.get cmi_cache_key + +(* These two runtime interfaces are loaded by nearly every compile request. + Their decoded graphs stay private to one compiler domain. A request may + mutate them, so [finalize_cmi_cache] restores the saved image if needed. + Resolve the path on every hit to notice newly shadowing or replaced CMIs. *) +let load_cached_cmi ~name = + if + (not (expanded_snapshot_enabled ())) + || Domain.DLS.get preparing_expanded_snapshot + || (name <> "Stdlib" && name <> "Pervasives") + then None + else + let cache = cmi_cache () in + let load_fresh () = + let loaded = !Persistent_signature.load ~unit_name:name in + (match loaded with + | None -> () + | Some {filename; cmi} -> ( + let resolved_filename = Compiler_request_state.resolve_path filename in + try + let stats = Unix.stat resolved_filename in + let bytes = Marshal.to_bytes cmi [] in + if same_file_stats (Unix.stat resolved_filename) stats then + Hashtbl.replace cache name + {resolved_filename; stats; bytes; cmi; used = true} + with Sys_error _ | Unix.Unix_error _ | Invalid_argument _ -> ())); + Some loaded + in + match Hashtbl.find_opt cache name with + | Some entry -> ( + try + let filename = + Compiler_phase_trace.dependency "dependency.cmi_cache_validate" + (fun () -> + find_in_path_uncap (Config.get_load_path ()) (name ^ ".cmi")) + in + if + Compiler_request_state.resolve_path filename = entry.resolved_filename + && same_file_stats (Unix.stat entry.resolved_filename) entry.stats + then ( + entry.used <- true; + Some (Some Persistent_signature.{filename; cmi = entry.cmi})) + else ( + Hashtbl.remove cache name; + load_fresh ()) + with Not_found | Sys_error _ | Unix.Unix_error _ -> + Hashtbl.remove cache name; + load_fresh ()) + | None -> load_fresh () + +let finalize_cmi_cache () = + Hashtbl.iter + (fun _ entry -> + if entry.used then ( + entry.used <- false; + let pristine = + Compiler_phase_trace.dependency "dependency.cmi_cache_verify" + (fun () -> + try Bytes.equal (Marshal.to_bytes entry.cmi []) entry.bytes + with Invalid_argument _ -> false) + in + if not pristine then entry.cmi <- Marshal.from_bytes entry.bytes 0)) + (cmi_cache ()) + +let () = cached_cmi_loader := load_cached_cmi + let is_target_path name = function | Pident id -> Ident.persistent id && Ident.name id = name | Pdot _ | Papply _ -> false @@ -2755,6 +2857,9 @@ let prepare_expanded_snapshot_now key = let target_filename = Compiler_request_state.resolve_path dependency.ps_filename in + let resolved_load_path = + List.map Compiler_request_state.resolve_path (Config.get_load_path ()) + in let namespace_stats = Unix.stat namespace_filename in let target_stats = Unix.stat target_filename in let forced = @@ -2767,48 +2872,91 @@ let prepare_expanded_snapshot_now key = let seen_in_previous_request = candidate_seen_in_previous_request key target_filename request in - if forced || seen_in_previous_request then ( - let cwd = Compiler_request_state.cwd () in - let load_path = Config.get_load_path () in - let previous = Domain.DLS.get preparing_expanded_snapshot in - Domain.DLS.set preparing_expanded_snapshot true; + let prepared = + Mutex.lock shared_expanded_snapshot_lock; + Fun.protect + (fun () -> + match !shared_expanded_snapshot with + | Some shared + when shared.key = key + && shared.target_filename = target_filename + && shared.namespace_filename = namespace_filename + && shared.resolved_load_path = resolved_load_path + && same_file_stats shared.target_stats target_stats + && same_file_stats shared.namespace_stats namespace_stats -> + Some (shared.bytes, None) + | _ when forced || seen_in_previous_request -> + let cwd = Compiler_request_state.cwd () in + let load_path = Config.get_load_path () in + let previous = Domain.DLS.get preparing_expanded_snapshot in + Domain.DLS.set preparing_expanded_snapshot true; + let graph = + Fun.protect + (fun () -> + Ident.with_fresh (fun () -> + with_fresh (fun () -> + Btype.with_fresh (fun () -> + Compiler_request_state.with_fresh ~cwd + (fun () -> + Config.set_load_path load_path; + snapshot_graph_from_cmis key))))) + ~finally:(fun () -> + Domain.DLS.set preparing_expanded_snapshot previous) + in + let bytes = Marshal.to_string graph [] in + if + String.length bytes <= 8 * 1024 * 1024 + && same_file_stats + (Unix.stat namespace_filename) + namespace_stats + && same_file_stats (Unix.stat target_filename) target_stats + then ( + shared_expanded_snapshot := + Some + { + key; + target_filename; + namespace_filename; + resolved_load_path; + target_stats; + namespace_stats; + bytes; + }; + Some (bytes, Some graph)) + else None + | _ -> None) + ~finally:(fun () -> Mutex.unlock shared_expanded_snapshot_lock) + in + match prepared with + | None -> () + | Some (bytes, prepared_graph) -> let graph = - Fun.protect - (fun () -> - Ident.with_fresh (fun () -> - with_fresh (fun () -> - Btype.with_fresh (fun () -> - Compiler_request_state.with_fresh ~cwd (fun () -> - Config.set_load_path load_path; - snapshot_graph_from_cmis key))))) - ~finally:(fun () -> - Domain.DLS.set preparing_expanded_snapshot previous) + match prepared_graph with + | Some graph -> graph + | None -> + Compiler_phase_trace.dependency "dependency.snapshot_shared_restore" + (fun () -> Marshal.from_string bytes 0) in - let bytes = Marshal.to_bytes graph [] in - if - Bytes.length bytes <= 8 * 1024 * 1024 - && same_file_stats (Unix.stat namespace_filename) namespace_stats - && same_file_stats (Unix.stat target_filename) target_stats - then - cache := - Some - { - key; - target_filename; - namespace_filename; - target_stats; - namespace_stats; - bytes; - graph = Some graph; - typed_integrity = - (if typed_expanded_snapshot_reuse () then - Some - (Compiler_phase_trace.dependency - "dependency.snapshot_capture" (fun () -> - snapshot_type_graph graph)) - else None); - in_use = false; - }) + cache := + Some + { + key; + target_filename; + namespace_filename; + resolved_load_path; + target_stats; + namespace_stats; + bytes; + graph = Some graph; + typed_integrity = + (if typed_expanded_snapshot_reuse () then + Some + (Compiler_phase_trace.dependency + "dependency.snapshot_capture" (fun () -> + snapshot_type_graph graph)) + else None); + in_use = false; + } let load_expanded_snapshot ~check:_ ~name = if @@ -2829,6 +2977,9 @@ let load_expanded_snapshot ~check:_ ~name = in path entry.key.target_name = entry.target_filename && path entry.key.namespace_name = entry.namespace_filename + && List.map Compiler_request_state.resolve_path + (Config.get_load_path ()) + = entry.resolved_load_path && same_file_stats (Unix.stat entry.target_filename) entry.target_stats @@ -2853,7 +3004,7 @@ let load_expanded_snapshot ~check:_ ~name = let graph = Compiler_phase_trace.dependency "dependency.snapshot_restore" (fun () -> - Marshal.from_bytes entry.bytes 0) + Marshal.from_string entry.bytes 0) in entry.graph <- Some graph; entry.typed_integrity <- @@ -2906,6 +3057,7 @@ let load_expanded_snapshot ~check:_ ~name = | _ -> None let finalize_expanded_snapshot_cache () = + finalize_cmi_cache (); match !(expanded_snapshot_cache ()) with | Some entry when entry.in_use -> ( entry.in_use <- false; @@ -2925,7 +3077,7 @@ let finalize_expanded_snapshot_cache () = | None -> false in (if audit_expanded_snapshot_reuse () then - let full = Marshal.to_bytes graph [] = entry.bytes in + let full = Marshal.to_string graph [] = entry.bytes in if typed && not full then failwith "typed dependency integrity check missed mutation"); typed) diff --git a/rewatch-ocaml/bench/README.md b/rewatch-ocaml/bench/README.md index da51c5547b..d68fd26b55 100644 --- a/rewatch-ocaml/bench/README.md +++ b/rewatch-ocaml/bench/README.md @@ -586,6 +586,124 @@ cross-domain separation, dirty-graph recovery, and CMI invalidation passed. A final audit build checked 128 cached request boundaries against full graph serialization without a disagreement. +### Reusing decoded runtime interfaces + +An eight-worker release-profile trace with the expanded WebAPI cache enabled +showed that the 519 compile requests each decoded `Stdlib.cmi` and +`Pervasives.cmi`. Those two files cost 477 ms of summed worker time in CMI +reading and decoding, plus 695 ms searching and opening their paths. The +remaining implementation requests spent about 1,071 ms searching and opening +all CMIs and 849 ms reading and decoding them, including these two runtime +interfaces. Source checking took 1,183 ms; expanded `WebAPI.DOMAPI` work still +accounted for 434 ms. These are exclusive traced worker totals from one build, +not expected elapsed savings. The temporary per-file decode labels used for +this diagnosis were removed afterward. + +The retained compiler cache keeps the decoded `Stdlib` and `Pervasives` CMI +graphs private to each worker domain. Each hit resolves the current load path +and checks the file's identity, size, modification time, and change time. At +the end of a request it compares the graph with a saved serialized image and +restores the image if the request changed it. The nested fresh request used to +prepare an expanded WebAPI snapshot bypasses this cache, so the two caches do +not share mutable input graphs. The cache is active only with the existing +Rewatch signature cache; `REWATCH_COMBINED_SIGNATURE_CACHE=0` disables both. + +A follow-up traced build decoded each runtime CMI nine times rather than 519 +times. Path re-resolution across 1,020 hits took 31 ms of summed worker time, and +1,038 request-boundary graph checks took 64 ms. The one-run trace includes +instrumentation overhead. A focused test changes and shadows `Stdlib.cmi` +between requests, mutates a loaded type, and loads it from another domain. +Another traced clean build found no changed cached runtime CMI graph among +1,038 request-boundary checks. This observation covers these two interfaces +in this fixture; it is not a proof that arbitrary imported type graphs can be +shared concurrently between compiler domains. + +The same testrepo fixture, standalone `bsc`, runtime, and release-profile +toolchain were used for each pair of executables, placed in one directory. +After a warm-up, the gate interleaved the default eight-worker builds. Its +20 ms process-tree sampler measured memory; wall time stopped when each build +process exited. The first seven pairs had clean medians of 1,184 ms before +versus 1,118 ms after. Eleven further pairs, after the nested-request guard +and final code cleanup, had clean medians of 1,203 versus 1,154 ms. Ten of +those eleven paired runs favored the change. Median sampled peak tree RSS was +557,196 KiB before and 566,480 KiB after in the final run, within the +run-to-run spread. Unchanged medians were 44 ms in both versions; single-edit +medians were 45 and 44 ms. Both builds made the same 1,031 clean, four +unchanged, and six edit compiler requests. Complete post-build file sets and +stable generated artifact bytes matched exactly. + +A broader prototype cached frequently loaded CMIs up to 64 KiB, with 32 entries +per domain. Seven pairs found a 26 ms clean median gain beyond the narrow +cache; fifteen further pairs found 19 ms, with overlapping samples and a 1 ms +slower single-edit median. That extra gain was within benchmark variation, so +the broader prototype was removed. The retained change avoids roughly 4–6% +of clean-build wall time on this host and fixture; it does not establish the +same gain for other projects. `make test`, `make test-rewatch`, the OCaml +Rewatch integration script, and the focused Rewatch OUnit suite passed. + +One more temporary trace split the remaining WebAPI cache-hit work. Across 128 +hits, forcing the cached target signature took under 1 ms, alias-ID relocation +took 17 ms, and target-signature-ID relocation took 11 ms in summed worker +time. The larger `WebAPI.DOMAPI` phase also contains the uncached expansions +and snapshot preparation on each domain. Optimizing hit relocation alone has +little elapsed-time headroom. The temporary subtimers were removed. + +To repeat the gate, build the parent revision and this revision with Dune's +`release` profile, copy both embedded executables into one directory, and set +`REWATCH_FIRST_EMBEDDED=1` when invoking `performance_gate.sh`. Use the same +`RESCRIPT_BSC_EXE` and `RESCRIPT_RUNTIME` for both and retain the default eight +compiler domains. The gate archives the same committed testrepo fixture for +each executable and compares work counts and all generated artifact bytes. + +### Sharing a prepared signature image across workers + +The expanded WebAPI snapshot previously had to be prepared separately by each +compiler domain. The compiler now publishes one immutable marshaled image after +the first preparation. Other domains decode private graphs from that image; +fresh inference variables and request-local type and identifier IDs remain +private to each compile job. A mutex serializes the first preparation, while +the existing per-domain graph verifier continues to check for mutations after +each job. The shared image is keyed by the alias, both CMI paths and file +metadata, and the resolved load path. The per-domain cache also checks the +resolved load path, so a job with different import resolution prepares its own +graph. `REWATCH_COMBINED_SIGNATURE_CACHE=0` disables this reuse. + +One traced clean build restored the shared image on seven domains and captured +eight private graph integrity snapshots. It made the same 128 expanded-snapshot +cache hits as the previous implementation. Decoding the seven private graphs +took 72 ms of summed worker time in that trace. The trace is diagnostic and +includes instrumentation overhead. + +Eleven interleaved release-profile pairs compared the decoded-runtime-CMI +version with and without cross-domain image sharing. Clean median wall time +fell from 1,145 to 1,051 ms, and all eleven pairs favored sharing. Median +sampled peak tree RSS fell from 543,976 to 472,236 KiB. Unchanged and +single-edit medians were 44 versus 45 ms and 44 versus 45 ms, respectively. + +A separate eleven-pair gate compared the complete change directly with the +original per-worker WebAPI cache at revision `d1c43a0c0`: + +| scenario | original median wall | new median wall | original peak tree RSS | new peak tree RSS | +| --- | ---: | ---: | ---: | ---: | +| Clean, eight workers | 1,199 ms | 1,014 ms | 545,312 KiB | 457,660 KiB | +| Unchanged | 45 ms | 44 ms | 26,744 KiB | 26,888 KiB | +| One source edit | 44 ms | 45 ms | 26,796 KiB | 27,076 KiB | + +The clean median improved by 15% and all eleven paired runs favored the +change. An earlier eleven-pair comparison of the same source change measured +1,190 versus 1,032 ms; ten pairs favored the change and one new-build run was +an outlier at 1,485 ms. Both executables in the final gate used +the same release-profile standalone `bsc`, runtime, fixture, and eight-worker +setting. They made identical 1,031 clean, four unchanged, and six edit compiler +requests. Complete post-build file sets and generated artifact bytes matched. +The 20 ms process-tree memory sampler is directional. The load-path guard was +included in this final gate. +An additional clean build with full graph-integrity auditing checked all 128 +reused snapshots, restored the shared image on seven domains, and reported no +dirty snapshots. +`make test`, `make test-rewatch`, the OCaml Rewatch integration script, the +focused Rewatch OUnit suite, and `make checkformat` passed. + ## Bulk label table checkpoint Revision `56164c19e3b0cc751301e4344cc0e4ecff46df20` builds the opened diff --git a/tests/rewatch_ounit_tests/compiler_driver_tests.ml b/tests/rewatch_ounit_tests/compiler_driver_tests.ml index df1cdeddb5..67a86c87b7 100644 --- a/tests/rewatch_ounit_tests/compiler_driver_tests.ml +++ b/tests/rewatch_ounit_tests/compiler_driver_tests.ml @@ -1039,12 +1039,13 @@ let combined_dependency_cache_tests _context = in Path.Pdot (module_path, "value", Path.nopos) in - let with_loaded_type action = + let with_loaded_type ?(load_path = [root]) action = Fun.protect (fun () -> Compiler_request_state.with_fresh ~cwd:root (fun () -> Env.with_fresh (fun () -> - (Compiler_request_state.current ()).load_path <- [root]; + (Compiler_request_state.current ()).load_path <- + load_path; action (Env.find_value value_path Env.empty).Types.val_type))) ~finally:Env.finalize_expanded_snapshot_cache @@ -1082,6 +1083,14 @@ let combined_dependency_cache_tests _context = | Types.Tvar (Some "changed") -> false | _ -> true) "the restored dependency graph keeps the original type"; + let extra_load_directory = Filename.concat root "extra-load-path" in + File_util.ensure_dir extra_load_directory; + let alternate = + with_loaded_type ~load_path:[extra_load_directory; root] Fun.id + in + check + (alternate != loaded_type ()) + "a different load path does not reuse the prepared dependency graph"; write root "Circle.resi" "let value: string\n"; write root "Circle.res" {|let value = "updated"|}; compile_dependency (); @@ -1089,7 +1098,15 @@ let combined_dependency_cache_tests _context = "open Shapes.Circle\nlet result: string = value\n"; compile "ConsumerString.res"; let _, stale = run root ~extra:["-I"; root] "Consumer.res" in - expect_code 2 stale) + expect_code 2 stale; + let updated_on_another_domain = + Domain.spawn loaded_type |> Domain.join + in + check + (match updated_on_another_domain.Types.desc with + | Types.Tconstr (path, _, _) -> Path.name path = "string" + | _ -> false) + "a new domain sees the updated dependency interface") ~finally:(fun () -> (match previous_trace with | Some value -> Unix.putenv "REWATCH_TYPECHECK_TRACE" value @@ -1098,6 +1115,60 @@ let combined_dependency_cache_tests _context = | Some value -> Unix.putenv "REWATCH_COMBINED_SIGNATURE_CACHE" value | None -> Unix.unsetenv "REWATCH_COMBINED_SIGNATURE_CACHE")) +let runtime_cmi_cache_tests _context = + Test_support.with_temp_dir "rewatch-runtime-cmi-cache-" (fun root -> + let first = Filename.concat root "first" in + let second = Filename.concat root "second" in + File_util.ensure_dir first; + File_util.ensure_dir second; + let install directory kind = + write directory "Api.resi" ("let value: " ^ kind ^ "\n"); + expect_code 0 (snd (run directory "Api.resi")); + let cmi = Cmi_format.read_cmi (Filename.concat directory "Api.cmi") in + ignore + (Cmi_format.create_cmi + (Filename.concat directory "Stdlib.cmi") + {cmi with cmi_name = "Stdlib"; cmi_crcs = []}) + in + install second "int"; + let path = + Path.Pdot + (Path.Pident (Ident.create_persistent "Stdlib"), "value", Path.nopos) + in + let load ?(mutate = false) directories = + Env.with_expanded_snapshot_cache (fun () -> + Fun.protect + (fun () -> + Compiler_request_state.with_fresh ~cwd:root (fun () -> + Env.with_fresh (fun () -> + (Compiler_request_state.current ()).load_path <- + directories; + let value = Env.find_value path Env.empty in + let type_name = + match value.Types.val_type.desc with + | Types.Tconstr (type_path, _, _) -> + Path.name type_path + | _ -> assert_failure "expected a named value type" + in + if mutate then + value.Types.val_type.desc <- + Types.Tvar (Some "changed"); + type_name))) + ~finally:Env.finalize_expanded_snapshot_cache) + in + assert_equal "int" (load [first; second]); + assert_equal "int" (load [first; second]); + assert_equal "int" (load ~mutate:true [first; second]); + assert_equal "int" (load [first; second]); + assert_equal "int" + (Domain.spawn (fun () -> load [first; second]) |> Domain.join); + install first "string"; + assert_equal "string" (load [first; second]); + install first "int"; + assert_equal "int" (load [first; second]); + install second "string"; + assert_equal "string" (load [second; first])) + let concurrent_diagnostic_recovery_tests _context = Test_support.with_temp_dir "rewatch-driver-errors-" (fun root -> let first = Filename.concat root "first" in @@ -1375,6 +1446,7 @@ let tests = "interfaces_namespaces_load_paths" >:: interface_namespace_and_load_path_tests; "combined_dependency_cache" >:: combined_dependency_cache_tests; + "runtime_cmi_cache" >:: runtime_cmi_cache_tests; "concurrent_diagnostic_recovery" >:: concurrent_diagnostic_recovery_tests; "concurrent_jsx_diagnostic" >:: concurrent_jsx_diagnostic_tests;