From dc61691db774617fa982067374554efe2731b11d Mon Sep 17 00:00:00 2001 From: Jono Prest Date: Mon, 9 Nov 2026 14:38:54 +0000 Subject: [PATCH] Key a build file by its own path when it is already normal Why: `Build_file_store.key` split every path into segments and joined them again, also when no segment was `.`, `..` or empty and the result was the path itself. The store keys every read, so a request that looks up an interface along the load path built a list and a new string for each directory it tried, about 200 words a lookup. `key` now first checks, without allocating, that the path has no `.`, `..` or empty segment (other than the leading one of an absolute path) and no separator other than `/`, and then returns the path itself. Other paths are normalized as before, so every spelling of a file keeps the same entry. `key` is now in the interface, so that a test can compare it with a copy of the previous normalization: on edge cases (`//`, trailing `/`, `.` and `..` anywhere, `...` and `.a` names, the empty path, backslashes, drive letters, UNC paths), on every path of up to 8 characters made of `/`, `.`, `\` and `a`, and on 20,000 seeded random paths. The copy reads `Sys.win32` like `key`, so the test holds on Windows too. Measured with scripts/compilerBenchmarks.js against the previous commit: allocated words -2.27% in the builds of tests/tests (build/clean -2.48%), -0.78% in the generated projects, the files compiled one by one unchanged (the store is only used in a build). On a 552 module React app (clean build) the build allocates 2.47% fewer words at one domain. Its user time is 1.2% lower at one domain (40 alternating pairs, 95% CI 0.5% to 2.1%) and 2.0% lower at the default domains (15 pairs, 1.0% to 2.8%); its wall time is unchanged within the noise. Review: Can a key change? No: a path that passes the check splits into segments that the normalization keeps in order, so joining them gives the path back; any other path takes the previous code. Review: What about Windows? There `\` is also a separator, and a path with one takes the previous code; a path with only `/` separators, such as `C:/a/b`, is split the same way on both platforms. Signed-off-by: Jono Prest --- changes/build-file-store-key.polish.md | 1 + compiler/ext/build_file_store.ml | 70 +++++--- compiler/ext/build_file_store.mli | 8 + .../ounit_build_file_store_tests.ml | 152 ++++++++++++++++++ 4 files changed, 209 insertions(+), 22 deletions(-) create mode 100644 changes/build-file-store-key.polish.md diff --git a/changes/build-file-store-key.polish.md b/changes/build-file-store-key.polish.md new file mode 100644 index 0000000000..6d914a58ae --- /dev/null +++ b/changes/build-file-store-key.polish.md @@ -0,0 +1 @@ +- Look up the files a build reads without normalizing paths that are already normal, so a clean build allocates about 2.5% less. diff --git a/compiler/ext/build_file_store.ml b/compiler/ext/build_file_store.ml index 49bee51108..85e0c83081 100644 --- a/compiler/ext/build_file_store.ml +++ b/compiler/ext/build_file_store.ml @@ -77,35 +77,61 @@ let with_build f = state.enabled <- false; empty ())) +(* Whether the segment of [path] from [start] to [index] is [.] or [..]. *) +let is_dot_segment path start index = + match index - start with + | 1 -> String.unsafe_get path start = '.' + | 2 -> + String.unsafe_get path start = '.' + && String.unsafe_get path (start + 1) = '.' + | _ -> false + +(* Whether [path], from the segment that starts at [start], has no [.], [..] + or empty segment, nor a separator other than [/]: then [key] gives back + [path] itself. Most paths are such, and checking takes no allocation. *) +let rec is_normal_from path start index = + if index = String.length path then + index > start && not (is_dot_segment path start index) + else + match String.unsafe_get path index with + | '/' -> + (index > start || start = 0) + && (not (is_dot_segment path start index)) + && is_normal_from path (index + 1) (index + 1) + | '\\' when Sys.win32 -> false + | _ -> is_normal_from path start (index + 1) + (* Requests spell paths relative to their own working directory, such as [lib/rescript/./A.cmi] or [lib/rescript/../../src/A.res], and the build system as [lib/rescript/A.cmi]. Both must find the same entry. Build directories are never symbolic links, so removing [..] lexically is sound for the paths the store sees. *) let key path = - let is_separator c = c = '/' || (Sys.win32 && c = '\\') in - let length = String.length path in - let rec segments start index acc = - if index = length then - List.rev (String.sub path start (index - start) :: acc) - else if is_separator path.[index] then - segments (index + 1) (index + 1) - (String.sub path start (index - start) :: acc) - else segments start (index + 1) acc - in - match segments 0 0 [] with - | [] -> path - | first :: rest -> - let rec normalize acc = function - | [] -> List.rev acc - | ("" | ".") :: rest -> normalize acc rest - | ".." :: rest -> ( - match acc with - | previous :: acc when previous <> ".." -> normalize acc rest - | _ -> normalize (".." :: acc) rest) - | segment :: rest -> normalize (segment :: acc) rest + if is_normal_from path 0 0 then path + else + let is_separator c = c = '/' || (Sys.win32 && c = '\\') in + let length = String.length path in + let rec segments start index acc = + if index = length then + List.rev (String.sub path start (index - start) :: acc) + else if is_separator path.[index] then + segments (index + 1) (index + 1) + (String.sub path start (index - start) :: acc) + else segments start (index + 1) acc in - String.concat "/" (first :: normalize [] rest) + match segments 0 0 [] with + | [] -> path + | first :: rest -> + let rec normalize acc = function + | [] -> List.rev acc + | ("" | ".") :: rest -> normalize acc rest + | ".." :: rest -> ( + match acc with + | previous :: acc when previous <> ".." -> normalize acc rest + | _ -> normalize (".." :: acc) rest) + | segment :: rest -> normalize (segment :: acc) rest + in + String.concat "/" (first :: normalize [] rest) let find key = locked (fun () -> Hashtbl.find_opt state.entries key) diff --git a/compiler/ext/build_file_store.mli b/compiler/ext/build_file_store.mli index 5072050af0..5036bd3bf8 100644 --- a/compiler/ext/build_file_store.mli +++ b/compiler/ext/build_file_store.mli @@ -11,6 +11,14 @@ the default and the case in [bsc], every function goes to the file system. *) +val key : string -> string +(** [key path] is the path the store keeps [path] under: [path] with the [.] + and empty segments after its first segment removed, each later [..] + removed with the segment before it unless that is the first segment or + [..], and on Windows backslash separators written [/]. So + [lib/rescript/./A.cmi] and [lib/rescript/../rescript/A.cmi] have the key + [lib/rescript/A.cmi], but [./A.cmi] keeps its first segment. *) + val with_build : (unit -> 'a) -> 'a (** [with_build f] enables an empty store while [f] runs, and empties and disables it afterwards. A build starts with an empty store, so that it diff --git a/tests/ounit_tests/ounit_build_file_store_tests.ml b/tests/ounit_tests/ounit_build_file_store_tests.ml index 67245cd50a..84fc6e6f74 100644 --- a/tests/ounit_tests/ounit_build_file_store_tests.ml +++ b/tests/ounit_tests/ounit_build_file_store_tests.ml @@ -83,6 +83,155 @@ let spellings_share_an_entry_tests _ = Build_file_store.write published "new"; read_all "new")) +(* [key] returns a path that has no [.], [..] or empty segment, nor a + backslash on Windows, as it is, without normalizing it. This is the + normalization it skips, as [key] did it for every path, so the two must + agree on every path. *) +let normalized_key path = + let is_separator c = c = '/' || (Sys.win32 && c = '\\') in + let length = String.length path in + let rec segments start index acc = + if index = length then + List.rev (String.sub path start (index - start) :: acc) + else if is_separator path.[index] then + segments (index + 1) (index + 1) + (String.sub path start (index - start) :: acc) + else segments start (index + 1) acc + in + match segments 0 0 [] with + | [] -> path + | first :: rest -> + let rec normalize acc = function + | [] -> List.rev acc + | ("" | ".") :: rest -> normalize acc rest + | ".." :: rest -> ( + match acc with + | previous :: acc when previous <> ".." -> normalize acc rest + | _ -> normalize (".." :: acc) rest) + | segment :: rest -> normalize (segment :: acc) rest + in + String.concat "/" (first :: normalize [] rest) + +let assert_key path = + assert_equal ~msg:(String.escaped path) ~printer:String.escaped + (normalized_key path) + (Build_file_store.key path) + +let key_edge_cases_tests _ = + List.iter assert_key + [ + ""; + "/"; + "//"; + "///"; + "."; + ".."; + "..."; + ".a"; + "a."; + "..a"; + "a.."; + "a"; + "A.cmi"; + "/A.cmi"; + "//A.cmi"; + "lib/rescript/A.cmi"; + "/home/user/project/lib/rescript/A.cmi"; + "lib/rescript/"; + "/lib/rescript/"; + "lib//rescript/A.cmi"; + "lib/rescript//"; + "./A.cmi"; + "./lib/rescript/A.cmi"; + "../A.cmi"; + "../../src/A.res"; + "lib/rescript/./A.cmi"; + "lib/rescript/../../src/A.res"; + "lib/rescript/.."; + "lib/rescript/."; + "a/.."; + "a/../.."; + "/.."; + "/../a"; + "/./a"; + "/a/./b/../c"; + "lib/.../A.cmi"; + "lib/.rescript/A.cmi"; + "lib/rescript./A.cmi"; + "lib/..rescript/A.cmi"; + "lib/rescript../A.cmi"; + ".../a"; + ".a/b"; + "a/..."; + "a/.b"; + "a\\b"; + "a\\.\\b"; + "a\\..\\b"; + "lib\\rescript\\A.cmi"; + "lib/rescript\\A.cmi"; + "lib\\"; + "\\"; + "\\a"; + "C:"; + "C:/"; + "C:/a/b"; + "C:/a/./b"; + "C:/a/../b"; + "C:\\a\\b"; + "C:\\a\\..\\b"; + "c:/Users/A.cmi"; + "C:a"; + "//server/share/a"; + "\\\\server\\share\\a"; + "\\\\server\\share\\..\\a"; + "\\\\?\\C:\\a"; + "//?/C:/a"; + ] + +(* Every path of up to 8 characters from the characters that matter, then + longer paths made of segments, which the first set cannot reach. *) +let key_generated_paths_tests _ = + let alphabet = "/.a\\" in + let rec all_paths prefix length = + assert_key prefix; + if length > 0 then + String.iter + (fun c -> all_paths (prefix ^ String.make 1 c) (length - 1)) + alphabet + in + all_paths "" 8; + let segments = + [| + ""; "."; ".."; "..."; ".a"; "a."; "a"; "src"; "A.cmi"; "C:"; "\\"; "a\\b"; + |] + in + let separators = [|"/"; "/"; "/"; "\\"; "//"|] in + let random = Random.State.make [|9|] in + for _ = 1 to 20_000 do + let count = Random.State.int random 9 in + let path = Buffer.create 64 in + for index = 0 to count do + if index > 0 then + Buffer.add_string path + separators.(Random.State.int random (Array.length separators)); + Buffer.add_string path + segments.(Random.State.int random (Array.length segments)) + done; + assert_key (Buffer.contents path) + done + +(* A path that is already normal is its own key, not a copy of it. *) +let key_of_normal_path_tests _ = + List.iter + (fun path -> assert_bool path (Build_file_store.key path == path)) + [ + "A.cmi"; + "lib/rescript/A.cmi"; + "/home/user/project/lib/rescript/A.cmi"; + "C:/Users/project/lib/rescript/A.cmi"; + "lib/.../.a/a./A.cmi"; + ] + let kept_and_evicted_tests _ = with_temp_dir (fun root -> let missing = Filename.concat root "Missing.cmj" in @@ -436,6 +585,9 @@ let suites = "disabled_reads_disk" >:: disabled_reads_disk_tests; "build_reads_once" >:: build_reads_once_tests; "spellings_share_an_entry" >:: spellings_share_an_entry_tests; + "key_edge_cases" >:: key_edge_cases_tests; + "key_generated_paths" >:: key_generated_paths_tests; + "key_of_normal_path" >:: key_of_normal_path_tests; "kept_and_evicted" >:: kept_and_evicted_tests; "held_writes" >:: held_writes_tests; "held_write_compares_read_contents"