From 77df19a617df40ff862c1cd20ff8a13b00b725dd Mon Sep 17 00:00:00 2001 From: Christoph Knittel Date: Thu, 15 Oct 2026 20:45:17 +0000 Subject: [PATCH] Reuse read interfaces across compiler requests on a domain Each module re-read the interfaces it uses, which for the large Stdlib ones is a sizable part of compiling a small module. Entries are checked against the file's identity, size and modification time. Co-Authored-By: Claude Opus 5.5 Claude-Session: https://claude.ai/code/session_01WZbCuRQ1Tn31bnKzLj5e72 Signed-off-by: Christoph Knittel --- .../ocaml-rewatch-cmi-read-cache.polish.md | 1 + compiler/core/bs_cmi_load.ml | 59 ++++++++++++++++++- rewatch-ocaml/compiler_process.ml | 3 + .../ounit_compiler_request_tests.ml | 29 +++++++++ 4 files changed, 91 insertions(+), 1 deletion(-) create mode 100644 changes/ocaml-rewatch-cmi-read-cache.polish.md diff --git a/changes/ocaml-rewatch-cmi-read-cache.polish.md b/changes/ocaml-rewatch-cmi-read-cache.polish.md new file mode 100644 index 0000000000..6cb32644ea --- /dev/null +++ b/changes/ocaml-rewatch-cmi-read-cache.polish.md @@ -0,0 +1 @@ +- OCaml rewatch: reuse the interfaces a worker has read for later modules while their files are unchanged, which makes builds of projects using the standard library faster. https://github.com/rescript-lang/rescript/pull/8874 diff --git a/compiler/core/bs_cmi_load.ml b/compiler/core/bs_cmi_load.ml index 063a85a668..587a66f8f6 100644 --- a/compiler/core/bs_cmi_load.ml +++ b/compiler/core/bs_cmi_load.ml @@ -22,6 +22,59 @@ * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) +(* A host that compiles many modules in one process, such as rewatch, would + otherwise read the same interfaces again for every module, and reading the + large Stdlib ones is a sizable part of compiling a small module. With the + cache enabled, each domain keeps the interfaces it reads. Domains can't share + them: copying a signature (Subst) marks its types in place until the copy is + done. + + An entry is used only while the file's identity, size and modification time + are unchanged. Like Git with racily clean files, a file modified in the last + two seconds is always read again: a rewrite of the same size within one tick + of a coarse file system clock leaves all of these unchanged. *) +let cache_enabled = Atomic.make false +let enable_cache () = Atomic.set cache_enabled true + +let recently_modified_seconds = 2. + +(* Bytes of interface files a domain keeps at most: the runtime's are about + 1.5 MB. Past the limit, the domain starts over. *) +let max_cached_bytes = 16 * 1024 * 1024 + +type cache = { + entries: (string, (int * int * int * float) * Cmi_format.cmi_infos) Hashtbl.t; + mutable cached_bytes: int; +} + +let cache = + Domain.DLS.new_key (fun () -> {entries = Hashtbl.create 64; cached_bytes = 0}) + +let read_cmi_channel filename path descriptor channel = + if not (Atomic.get cache_enabled) then + Cmi_format.read_cmi_channel filename channel + else + let {Unix.st_dev; st_ino; st_size; st_mtime} = Unix.fstat descriptor in + if Unix.gettimeofday () -. st_mtime < recently_modified_seconds then + Cmi_format.read_cmi_channel filename channel + else + let file_id = (st_dev, st_ino, st_size, st_mtime) in + let cache = Domain.DLS.get cache in + match Hashtbl.find_opt cache.entries path with + | Some (cached_id, cmi) when cached_id = file_id -> cmi + | previous -> + let cmi = Cmi_format.read_cmi_channel filename channel in + (match previous with + | Some ((_, _, size, _), _) -> + cache.cached_bytes <- cache.cached_bytes - size + | None -> ()); + if cache.cached_bytes + st_size > max_cached_bytes then ( + Hashtbl.reset cache.entries; + cache.cached_bytes <- 0); + Hashtbl.replace cache.entries path (file_id, cmi); + cache.cached_bytes <- cache.cached_bytes + st_size; + cmi + let load_cmi ~unit_name : Env.Persistent_signature.t option = (* On case-insensitive filesystems a lowercase alias can remain visible to [Sys.file_exists] briefly after its CMI is removed. Open each candidate @@ -41,7 +94,7 @@ let load_cmi ~unit_name : Env.Persistent_signature.t option = let channel = Unix.in_channel_of_descr descriptor in let cmi = Fun.protect - (fun () -> Cmi_format.read_cmi_channel filename channel) + (fun () -> read_cmi_channel filename path descriptor channel) ~finally:(fun () -> close_in_noerr channel) in Some Env.Persistent_signature.{filename; cmi} @@ -53,3 +106,7 @@ let load_cmi ~unit_name : Env.Persistent_signature.t option = try_names (if lower_name = name then [name] else [lower_name; name]) in find (Config.get_load_path ()) + +module For_test = struct + let cached_interfaces () = Hashtbl.length (Domain.DLS.get cache).entries +end diff --git a/rewatch-ocaml/compiler_process.ml b/rewatch-ocaml/compiler_process.ml index fb4117fd7d..756d07cb8a 100644 --- a/rewatch-ocaml/compiler_process.ml +++ b/rewatch-ocaml/compiler_process.ml @@ -10,6 +10,9 @@ let retain_critical_external_warnings stderr = let build_identity = Rescript_compiler_driver.build_identity +(* Later modules compiled on a domain reuse the interfaces earlier ones read. *) +let () = Bs_cmi_load.enable_cache () + type request = {args: string list; cwd: string} let compiler_phase args = diff --git a/tests/ounit_tests/ounit_compiler_request_tests.ml b/tests/ounit_tests/ounit_compiler_request_tests.ml index eb7a815689..117b787696 100644 --- a/tests/ounit_tests/ounit_compiler_request_tests.ml +++ b/tests/ounit_tests/ounit_compiler_request_tests.ml @@ -1200,6 +1200,34 @@ let ctype_memo_reset_tests _context = (Ctype.For_test.previous_env_is_empty ()) "the expansion environment does not outlive its request") +(* Requests reuse interfaces read by earlier ones while their files are + unchanged. *) +let cmi_read_cache_tests _context = + Bs_cmi_load.enable_cache (); + with_temp_dir "rewatch-driver-cmi-cache-" (fun root -> + let compile input = snd (run root ~extra:["-I"; root] input) in + let lib_cmi = Filename.concat root "Lib.cmi" in + let age seconds = + let time = Unix.gettimeofday () -. seconds in + Unix.utimes lib_cmi time time + in + let cached = Bs_cmi_load.For_test.cached_interfaces in + write root "Lib.res" "type t = int\n"; + expect_code 0 (compile "Lib.res"); + write root "Use.res" "let value: Lib.t = 1\n"; + let before = cached () in + expect_code 0 (compile "Use.res"); + check (cached () = before) "a just-written interface is not kept"; + age 60.; + expect_code 0 (compile "Use.res"); + check (cached () = before + 1) "an older interface is kept"; + expect_code 0 (compile "Use.res"); + (* The same size, so only the file's time tells it changed. *) + write root "Lib.res" "type u = int\n"; + expect_code 0 (compile "Lib.res"); + age 30.; + expect_code 2 (compile "Use.res")) + let package_and_load_path_isolation_tests _context = with_temp_dir "rewatch-driver-load-roots-" (fun root -> let first = Filename.concat root "first" in @@ -1560,6 +1588,7 @@ let suites = "ctype_level_isolation" >:: ctype_level_isolation_tests; "free_variable_isolation" >:: free_variable_isolation_tests; "ctype_memo_reset" >:: ctype_memo_reset_tests; + "cmi_read_cache" >:: cmi_read_cache_tests; "shared_type_graph_isolation" >:: shared_type_graph_isolation_tests; "dependency_extraction_isolation" >:: dependency_extraction_isolation_tests;