Skip to content

Key a build file by its own path when it is already normal #9285

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Open
JonoPrest wants to merge 1 commit into
base: master
Choose a base branch
from
Open

Key a build file by its own path when it is already normal #9285

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
1 change: 1 addition & 0 deletions changes/build-file-store-key.polish.md
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -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.
70 changes: 48 additions & 22 deletions compiler/ext/build_file_store.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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)

Expand Down
8 changes: 8 additions & 0 deletions compiler/ext/build_file_store.mli
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
152 changes: 152 additions & 0 deletions tests/ounit_tests/ounit_build_file_store_tests.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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"
Expand Down
Loading