Skip to content

Commit 545e34e

Browse files
JonoPrestJonoPrest
committed
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 <jjprest@gmail.com>
1 parent 6b58ac0 commit 545e34e

4 files changed

Lines changed: 209 additions & 22 deletions

File tree

‎changes/build-file-store-key.polish.md‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1 @@
1+
- Look up the files a build reads without normalizing paths that are already normal, so a clean build allocates about 2.5% less.

‎compiler/ext/build_file_store.ml‎

Lines changed: 48 additions & 22 deletions
Original file line numberDiff line numberDiff line change
@@ -77,35 +77,61 @@ let with_build f =
7777
state.enabled <- false;
7878
empty ()))
7979

80+
(* Whether the segment of [path] from [start] to [index] is [.] or [..]. *)
81+
let is_dot_segment path start index =
82+
match index - start with
83+
| 1 -> String.unsafe_get path start = '.'
84+
| 2 ->
85+
String.unsafe_get path start = '.'
86+
&& String.unsafe_get path (start + 1) = '.'
87+
| _ -> false
88+
89+
(* Whether [path], from the segment that starts at [start], has no [.], [..]
90+
or empty segment, nor a separator other than [/]: then [key] gives back
91+
[path] itself. Most paths are such, and checking takes no allocation. *)
92+
let rec is_normal_from path start index =
93+
if index = String.length path then
94+
index > start && not (is_dot_segment path start index)
95+
else
96+
match String.unsafe_get path index with
97+
| '/' ->
98+
(index > start || start = 0)
99+
&& (not (is_dot_segment path start index))
100+
&& is_normal_from path (index + 1) (index + 1)
101+
| '\\' when Sys.win32 -> false
102+
| _ -> is_normal_from path start (index + 1)
103+
80104
(* Requests spell paths relative to their own working directory, such as
81105
[lib/rescript/./A.cmi] or [lib/rescript/../../src/A.res], and the build
82106
system as [lib/rescript/A.cmi]. Both must find the same entry. Build
83107
directories are never symbolic links, so removing [..] lexically is sound
84108
for the paths the store sees. *)
85109
let key path =
86-
let is_separator c = c = '/' || (Sys.win32 && c = '\\') in
87-
let length = String.length path in
88-
let rec segments start index acc =
89-
if index = length then
90-
List.rev (String.sub path start (index - start) :: acc)
91-
else if is_separator path.[index] then
92-
segments (index + 1) (index + 1)
93-
(String.sub path start (index - start) :: acc)
94-
else segments start (index + 1) acc
95-
in
96-
match segments 0 0 [] with
97-
| [] -> path
98-
| first :: rest ->
99-
let rec normalize acc = function
100-
| [] -> List.rev acc
101-
| ("" | ".") :: rest -> normalize acc rest
102-
| ".." :: rest -> (
103-
match acc with
104-
| previous :: acc when previous <> ".." -> normalize acc rest
105-
| _ -> normalize (".." :: acc) rest)
106-
| segment :: rest -> normalize (segment :: acc) rest
110+
if is_normal_from path 0 0 then path
111+
else
112+
let is_separator c = c = '/' || (Sys.win32 && c = '\\') in
113+
let length = String.length path in
114+
let rec segments start index acc =
115+
if index = length then
116+
List.rev (String.sub path start (index - start) :: acc)
117+
else if is_separator path.[index] then
118+
segments (index + 1) (index + 1)
119+
(String.sub path start (index - start) :: acc)
120+
else segments start (index + 1) acc
107121
in
108-
String.concat "/" (first :: normalize [] rest)
122+
match segments 0 0 [] with
123+
| [] -> path
124+
| first :: rest ->
125+
let rec normalize acc = function
126+
| [] -> List.rev acc
127+
| ("" | ".") :: rest -> normalize acc rest
128+
| ".." :: rest -> (
129+
match acc with
130+
| previous :: acc when previous <> ".." -> normalize acc rest
131+
| _ -> normalize (".." :: acc) rest)
132+
| segment :: rest -> normalize (segment :: acc) rest
133+
in
134+
String.concat "/" (first :: normalize [] rest)
109135

110136
let find key = locked (fun () -> Hashtbl.find_opt state.entries key)
111137

‎compiler/ext/build_file_store.mli‎

Lines changed: 8 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -11,6 +11,14 @@
1111
the default and the case in [bsc], every function goes to the file
1212
system. *)
1313

14+
val key : string -> string
15+
(** [key path] is the path the store keeps [path] under: [path] with the [.]
16+
and empty segments after its first segment removed, each later [..]
17+
removed with the segment before it unless that is the first segment or
18+
[..], and on Windows backslash separators written [/]. So
19+
[lib/rescript/./A.cmi] and [lib/rescript/../rescript/A.cmi] have the key
20+
[lib/rescript/A.cmi], but [./A.cmi] keeps its first segment. *)
21+
1422
val with_build : (unit -> 'a) -> 'a
1523
(** [with_build f] enables an empty store while [f] runs, and empties and
1624
disables it afterwards. A build starts with an empty store, so that it

‎tests/ounit_tests/ounit_build_file_store_tests.ml‎

Lines changed: 152 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -83,6 +83,155 @@ let spellings_share_an_entry_tests _ =
8383
Build_file_store.write published "new";
8484
read_all "new"))
8585

86+
(* [key] returns a path that has no [.], [..] or empty segment, nor a
87+
backslash on Windows, as it is, without normalizing it. This is the
88+
normalization it skips, as [key] did it for every path, so the two must
89+
agree on every path. *)
90+
let normalized_key path =
91+
let is_separator c = c = '/' || (Sys.win32 && c = '\\') in
92+
let length = String.length path in
93+
let rec segments start index acc =
94+
if index = length then
95+
List.rev (String.sub path start (index - start) :: acc)
96+
else if is_separator path.[index] then
97+
segments (index + 1) (index + 1)
98+
(String.sub path start (index - start) :: acc)
99+
else segments start (index + 1) acc
100+
in
101+
match segments 0 0 [] with
102+
| [] -> path
103+
| first :: rest ->
104+
let rec normalize acc = function
105+
| [] -> List.rev acc
106+
| ("" | ".") :: rest -> normalize acc rest
107+
| ".." :: rest -> (
108+
match acc with
109+
| previous :: acc when previous <> ".." -> normalize acc rest
110+
| _ -> normalize (".." :: acc) rest)
111+
| segment :: rest -> normalize (segment :: acc) rest
112+
in
113+
String.concat "/" (first :: normalize [] rest)
114+
115+
let assert_key path =
116+
assert_equal ~msg:(String.escaped path) ~printer:String.escaped
117+
(normalized_key path)
118+
(Build_file_store.key path)
119+
120+
let key_edge_cases_tests _ =
121+
List.iter assert_key
122+
[
123+
"";
124+
"/";
125+
"//";
126+
"///";
127+
".";
128+
"..";
129+
"...";
130+
".a";
131+
"a.";
132+
"..a";
133+
"a..";
134+
"a";
135+
"A.cmi";
136+
"/A.cmi";
137+
"//A.cmi";
138+
"lib/rescript/A.cmi";
139+
"/home/user/project/lib/rescript/A.cmi";
140+
"lib/rescript/";
141+
"/lib/rescript/";
142+
"lib//rescript/A.cmi";
143+
"lib/rescript//";
144+
"./A.cmi";
145+
"./lib/rescript/A.cmi";
146+
"../A.cmi";
147+
"../../src/A.res";
148+
"lib/rescript/./A.cmi";
149+
"lib/rescript/../../src/A.res";
150+
"lib/rescript/..";
151+
"lib/rescript/.";
152+
"a/..";
153+
"a/../..";
154+
"/..";
155+
"/../a";
156+
"/./a";
157+
"/a/./b/../c";
158+
"lib/.../A.cmi";
159+
"lib/.rescript/A.cmi";
160+
"lib/rescript./A.cmi";
161+
"lib/..rescript/A.cmi";
162+
"lib/rescript../A.cmi";
163+
".../a";
164+
".a/b";
165+
"a/...";
166+
"a/.b";
167+
"a\\b";
168+
"a\\.\\b";
169+
"a\\..\\b";
170+
"lib\\rescript\\A.cmi";
171+
"lib/rescript\\A.cmi";
172+
"lib\\";
173+
"\\";
174+
"\\a";
175+
"C:";
176+
"C:/";
177+
"C:/a/b";
178+
"C:/a/./b";
179+
"C:/a/../b";
180+
"C:\\a\\b";
181+
"C:\\a\\..\\b";
182+
"c:/Users/A.cmi";
183+
"C:a";
184+
"//server/share/a";
185+
"\\\\server\\share\\a";
186+
"\\\\server\\share\\..\\a";
187+
"\\\\?\\C:\\a";
188+
"//?/C:/a";
189+
]
190+
191+
(* Every path of up to 8 characters from the characters that matter, then
192+
longer paths made of segments, which the first set cannot reach. *)
193+
let key_generated_paths_tests _ =
194+
let alphabet = "/.a\\" in
195+
let rec all_paths prefix length =
196+
assert_key prefix;
197+
if length > 0 then
198+
String.iter
199+
(fun c -> all_paths (prefix ^ String.make 1 c) (length - 1))
200+
alphabet
201+
in
202+
all_paths "" 8;
203+
let segments =
204+
[|
205+
""; "."; ".."; "..."; ".a"; "a."; "a"; "src"; "A.cmi"; "C:"; "\\"; "a\\b";
206+
|]
207+
in
208+
let separators = [|"/"; "/"; "/"; "\\"; "//"|] in
209+
let random = Random.State.make [|9|] in
210+
for _ = 1 to 20_000 do
211+
let count = Random.State.int random 9 in
212+
let path = Buffer.create 64 in
213+
for index = 0 to count do
214+
if index > 0 then
215+
Buffer.add_string path
216+
separators.(Random.State.int random (Array.length separators));
217+
Buffer.add_string path
218+
segments.(Random.State.int random (Array.length segments))
219+
done;
220+
assert_key (Buffer.contents path)
221+
done
222+
223+
(* A path that is already normal is its own key, not a copy of it. *)
224+
let key_of_normal_path_tests _ =
225+
List.iter
226+
(fun path -> assert_bool path (Build_file_store.key path == path))
227+
[
228+
"A.cmi";
229+
"lib/rescript/A.cmi";
230+
"/home/user/project/lib/rescript/A.cmi";
231+
"C:/Users/project/lib/rescript/A.cmi";
232+
"lib/.../.a/a./A.cmi";
233+
]
234+
86235
let kept_and_evicted_tests _ =
87236
with_temp_dir (fun root ->
88237
let missing = Filename.concat root "Missing.cmj" in
@@ -436,6 +585,9 @@ let suites =
436585
"disabled_reads_disk" >:: disabled_reads_disk_tests;
437586
"build_reads_once" >:: build_reads_once_tests;
438587
"spellings_share_an_entry" >:: spellings_share_an_entry_tests;
588+
"key_edge_cases" >:: key_edge_cases_tests;
589+
"key_generated_paths" >:: key_generated_paths_tests;
590+
"key_of_normal_path" >:: key_of_normal_path_tests;
439591
"kept_and_evicted" >:: kept_and_evicted_tests;
440592
"held_writes" >:: held_writes_tests;
441593
"held_write_compares_read_contents"

0 commit comments

Comments
 (0)