From 2b97b0151146f25847dff3bf335fadcff9d8a149 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Tue, 14 Nov 2023 02:36:14 -0600 Subject: [PATCH] refactor(engine): optimize sandbox config storage (#8035) We store a sandbox configuration set for every single action we create. For a large build, this can add up. Our old representation was taking 6 words to represent this. This PR changes it to use only a single word. Moreover, this new set now opaque to the GC, speeds up comparison, hashing, etc. Signed-off-by: Rudi Grinberg --- src/dune_engine/build_system.ml | 2 +- src/dune_engine/sandbox_config.ml | 2 +- src/dune_engine/sandbox_mode.ml | 73 +++++++------------ src/dune_engine/sandbox_mode.mli | 4 +- .../test-cases/dune-cache/mode-copy.t | 4 +- .../test-cases/dune-cache/mode-hardlink.t | 4 +- .../test-cases/dune-cache/repro-check.t | 6 +- .../test-cases/dune-cache/trim.t | 4 +- .../test-cases/patch-back-source-tree.t | 2 +- 9 files changed, 41 insertions(+), 60 deletions(-) diff --git a/src/dune_engine/build_system.ml b/src/dune_engine/build_system.ml index d3158e2d075..f1f276d7ea4 100644 --- a/src/dune_engine/build_system.ml +++ b/src/dune_engine/build_system.ml @@ -235,7 +235,7 @@ end = struct (* The current version of the rule digest scheme. We should increment it when making any changes to the scheme, to avoid collisions. *) - let rule_digest_version = 19 + let rule_digest_version = 20 let compute_rule_digest (rule : Rule.t) diff --git a/src/dune_engine/sandbox_config.ml b/src/dune_engine/sandbox_config.ml index 9f251e7a65f..4569037273f 100644 --- a/src/dune_engine/sandbox_config.ml +++ b/src/dune_engine/sandbox_config.ml @@ -70,5 +70,5 @@ module Partial = struct end let disallow (mode : Sandbox_mode.t) = - Sandbox_mode.Dict.of_func (fun mode' -> not (Sandbox_mode.equal mode mode')) + Sandbox_mode.Set.of_func (fun mode' -> not (Sandbox_mode.equal mode mode')) ;; diff --git a/src/dune_engine/sandbox_mode.ml b/src/dune_engine/sandbox_mode.ml index 62e293abf9e..5507fbc88c5 100644 --- a/src/dune_engine/sandbox_mode.ml +++ b/src/dune_engine/sandbox_mode.ml @@ -30,6 +30,14 @@ let equal a b = | Lt | Gt -> false ;; +let to_dyn = + Dyn.option (function + | Symlink -> Variant ("Symlink", []) + | Copy -> Variant ("Copy", []) + | Hardlink -> Variant ("Hardlink", []) + | Patch_back_source_tree -> Variant ("Patch_back_source_tree", [])) +;; + module Dict = struct type key = t @@ -70,51 +78,32 @@ module Dict = struct end module Set = struct - type key = t - type t = bool Dict.t + module T = struct + type nonrec t = t + + let to_int = function + | None -> 0 + | Some Copy -> 1 + | Some Symlink -> 2 + | Some Hardlink -> 3 + | Some Patch_back_source_tree -> 4 + ;; + + let all = + [ None; Some Copy; Some Symlink; Some Hardlink; Some Patch_back_source_tree ] + ;; + + let to_dyn = to_dyn + end - let compare = Dict.compare Bool.compare - let of_func = Dict.of_func - let singleton k = of_func (equal k) + include Bit_set.Make (T) (* CR-someday amokhov: [Patch_back_source_tree] is a bit special in that it can only appear as a singleton. Perhaps, it should be treated differently than other sandboxing modes to make meaningless states non-representable. *) let patch_back_source_tree_only = singleton (Some Patch_back_source_tree) - - let is_patch_back_source_tree_only t = - match compare t patch_back_source_tree_only with - | Eq -> true - | Lt | Gt -> false - ;; - - let equal a b = - match compare a b with - | Eq -> true - | Lt | Gt -> false - ;; - - let mem = Dict.get - - let inter (x : t) (y : t) : t = - { none = x.none && y.none - ; copy = x.copy && y.copy - ; symlink = x.symlink && y.symlink - ; hardlink = x.hardlink && y.hardlink - ; patch_back_source_tree = x.patch_back_source_tree && y.patch_back_source_tree - } - ;; - - let to_dyn { Dict.none; copy; symlink; hardlink; patch_back_source_tree } = - Dyn.Record - [ "none", Bool none - ; "copy", Bool copy - ; "symlink", Bool symlink - ; "hardlink", Bool hardlink - ; "patch_back_source_tree", Bool patch_back_source_tree - ] - ;; + let is_patch_back_source_tree_only t = t = patch_back_source_tree_only end (* The order of sandboxing modes in this list determines the order in which Dune @@ -148,11 +137,3 @@ let to_string = function | Some Hardlink -> "hardlink" | Some Patch_back_source_tree -> "patch_back_source_tree" ;; - -let to_dyn = - Dyn.option (function - | Symlink -> Variant ("Symlink", []) - | Copy -> Variant ("Copy", []) - | Hardlink -> Variant ("Hardlink", []) - | Patch_back_source_tree -> Variant ("Patch_back_source_tree", [])) -;; diff --git a/src/dune_engine/sandbox_mode.mli b/src/dune_engine/sandbox_mode.mli index efe0cca7294..47a313c0574 100644 --- a/src/dune_engine/sandbox_mode.mli +++ b/src/dune_engine/sandbox_mode.mli @@ -53,8 +53,8 @@ module Dict : sig end module Set : sig - type key = t - type t = bool Dict.t + type key := t + type t val singleton : key -> t diff --git a/test/blackbox-tests/test-cases/dune-cache/mode-copy.t b/test/blackbox-tests/test-cases/dune-cache/mode-copy.t index c28308fc6d9..49f82e81a1f 100644 --- a/test/blackbox-tests/test-cases/dune-cache/mode-copy.t +++ b/test/blackbox-tests/test-cases/dune-cache/mode-copy.t @@ -40,9 +40,9 @@ never built [target1] before. $ dune build --config-file=config target1 --debug-cache=shared,workspace-local \ > 2>&1 | grep '_build/default/source\|_build/default/target' Workspace-local cache miss: _build/default/source: never seen this target before - Shared cache miss [4c8aba9580c271d7ac111bf2d72a147a] (_build/default/source): not found in cache + Shared cache miss [790009feab9e691c98ad47625fd7047a] (_build/default/source): not found in cache Workspace-local cache miss: _build/default/target1: never seen this target before - Shared cache miss [68e477811b0e612a0cc0bb83c205420a] (_build/default/target1): not found in cache + Shared cache miss [3aa5494f9cb89c79b5f41e9c6123a666] (_build/default/target1): not found in cache $ dune_cmd stat hardlinks _build/default/source 1 diff --git a/test/blackbox-tests/test-cases/dune-cache/mode-hardlink.t b/test/blackbox-tests/test-cases/dune-cache/mode-hardlink.t index 87b9dc76a39..ca951b0721f 100644 --- a/test/blackbox-tests/test-cases/dune-cache/mode-hardlink.t +++ b/test/blackbox-tests/test-cases/dune-cache/mode-hardlink.t @@ -35,9 +35,9 @@ never built [target1] before. $ dune build --config-file=config target1 --debug-cache=shared,workspace-local \ > 2>&1 | grep '_build/default/source\|_build/default/target' Workspace-local cache miss: _build/default/source: never seen this target before - Shared cache miss [4a1c82562ca4c3348fe36436814a9842] (_build/default/source): not found in cache + Shared cache miss [1b443618b766306bf5c4846b19349675] (_build/default/source): not found in cache Workspace-local cache miss: _build/default/target1: never seen this target before - Shared cache miss [3ffbc9519f4ca5e44997bf8ba62de0bb] (_build/default/target1): not found in cache + Shared cache miss [44158ca8448d6bb0366c050c668a168c] (_build/default/target1): not found in cache $ dune_cmd stat hardlinks _build/default/source 3 diff --git a/test/blackbox-tests/test-cases/dune-cache/repro-check.t b/test/blackbox-tests/test-cases/dune-cache/repro-check.t index 7523d91b923..58603728fbc 100644 --- a/test/blackbox-tests/test-cases/dune-cache/repro-check.t +++ b/test/blackbox-tests/test-cases/dune-cache/repro-check.t @@ -67,7 +67,7 @@ Set 'cache-check-probability' to 1.0, which should trigger the check > EOF $ rm -rf _build $ dune build --config-file config reproducible non-reproducible - Warning: cache store error [761869532e88535d64e09b60102c4416]: ((in_cache + Warning: cache store error [016cbdcbd1b45ba2125d3738c441dd87]: ((in_cache ((non-reproducible 1c8fc4744d4cef1bd2b8f5e915b36be9))) (computed ((non-reproducible 6cfaa7a90747882bcf4ffe7252c1cf89)))) after executing (echo 'build non-reproducible';cp dep non-reproducible) @@ -119,7 +119,7 @@ Test that the environment variable and the command line flag work too $ rm -rf _build $ DUNE_CACHE_CHECK_PROBABILITY=1.0 dune build --cache=enabled reproducible non-reproducible - Warning: cache store error [761869532e88535d64e09b60102c4416]: ((in_cache + Warning: cache store error [016cbdcbd1b45ba2125d3738c441dd87]: ((in_cache ((non-reproducible 1c8fc4744d4cef1bd2b8f5e915b36be9))) (computed ((non-reproducible 6cfaa7a90747882bcf4ffe7252c1cf89)))) after executing (echo 'build non-reproducible';cp dep non-reproducible) @@ -131,7 +131,7 @@ Test that the environment variable and the command line flag work too $ rm -rf _build $ dune build --cache=enabled --cache-check-probability=1.0 reproducible non-reproducible - Warning: cache store error [761869532e88535d64e09b60102c4416]: ((in_cache + Warning: cache store error [016cbdcbd1b45ba2125d3738c441dd87]: ((in_cache ((non-reproducible 1c8fc4744d4cef1bd2b8f5e915b36be9))) (computed ((non-reproducible 6cfaa7a90747882bcf4ffe7252c1cf89)))) after executing (echo 'build non-reproducible';cp dep non-reproducible) diff --git a/test/blackbox-tests/test-cases/dune-cache/trim.t b/test/blackbox-tests/test-cases/dune-cache/trim.t index 499dbb881ca..4bc9a03e0ab 100644 --- a/test/blackbox-tests/test-cases/dune-cache/trim.t +++ b/test/blackbox-tests/test-cases/dune-cache/trim.t @@ -78,8 +78,8 @@ entries uniformly. $ (cd "$PWD/.xdg-cache/dune/db/meta/v5"; grep -rws . -e 'metadata' | sort ) > out $ cat out - ./50/50673e014878b6b71ee39f1f32ca4726:((8:metadata)(5:files(8:target_a32:5637dd9730e430c7477f52d46de3909c))) - ./8f/8f658cc1fc1f083f42e98bbcd5a6ce2f:((8:metadata)(5:files(8:target_b32:8a53bfae3829b48866079fa7f2d97781))) + ./57/572f0d07f15fafa10217f0f78d2d4f39:((8:metadata)(5:files(8:target_a32:5637dd9730e430c7477f52d46de3909c))) + ./5a/5a512ee6d64f5d7a29d7863269566506:((8:metadata)(5:files(8:target_b32:8a53bfae3829b48866079fa7f2d97781))) $ digest="$(awk -F: '/target_b/ { digest=$1 } END { print digest }' < out)" diff --git a/test/blackbox-tests/test-cases/patch-back-source-tree.t b/test/blackbox-tests/test-cases/patch-back-source-tree.t index 07222bc9633..e6854ddd2a9 100644 --- a/test/blackbox-tests/test-cases/patch-back-source-tree.t +++ b/test/blackbox-tests/test-cases/patch-back-source-tree.t @@ -201,7 +201,7 @@ produced in the sandbox and copied back: This is the internal stamp file: $ ls _build/.actions/default/blah* - _build/.actions/default/blah-e7a0efae1209023d2186a50341cd25fa + _build/.actions/default/blah-61c2a19beb7c9447302b9348604599d6 And we check that it isn't copied in the source tree: