refactor(stdune): improve path tables

Use a more memory efficient path table. Instead of using the variant for
the key, combine 3 tables all for the individual paths.

This makes the empty table a little more bloated (3x bigger), but gives
us a saving of 2 words for every single key we store.

Signed-off-by: Rudi Grinberg <[email protected]>

<!-- ps-id: e86dc1fe-0661-4897-9444-2dfd5f99f050 -->

otherlibs/stdune/src/path.ml

@@ -290,6 +290,8 @@ module Local : sig
 
   include Path_intf.S with type t := t
 
+  module Table : Hashtbl.S with type key = t
+
   val root : t
 
   val is_root : t -> bool
@@ -369,6 +371,8 @@ end
 module External : sig
   include Path_intf.S
 
+  module Table : Hashtbl.S with type key = t
+
   val relative : t -> string -> t
 
   val mkdir_p : ?perms:int -> t -> unit
@@ -741,8 +745,6 @@ module T : sig
       Path of the same kind are compared using the standard lexical order *)
   val compare : t -> t -> Ordering.t
 
-  val equal : t -> t -> bool
-
   val hash : t -> int
 
   val in_build_dir : Local.t -> t
@@ -766,8 +768,6 @@ end = struct
     | In_build_dir _, In_source_tree _ -> Gt
     | In_build_dir x, In_build_dir y -> Local.compare x y
 
-  let equal (x : t) (y : t) = x = y
-
   let hash = Poly.hash
 
   let in_build_dir s = In_build_dir s
@@ -784,8 +784,6 @@ end
 
 include T
 
-let hash (t : t) = Poly.hash t
-
 let build_dir = in_build_dir Local.root
 
 let is_root = function
@@ -1167,16 +1165,6 @@ let touch ?(create = true) p =
     (* OCaml PR#8857 *)
     create ()
 
-let compare x y =
-  match (x, y) with
-  | External x, External y -> External.compare x y
-  | External _, _ -> Lt
-  | _, External _ -> Gt
-  | In_source_tree x, In_source_tree y -> Local.compare x y
-  | In_source_tree _, _ -> Lt
-  | _, In_source_tree _ -> Gt
-  | In_build_dir x, In_build_dir y -> Local.compare x y
-
 let extension t =
   match t with
   | External t -> External.extension t
@@ -1220,7 +1208,73 @@ let source s = in_source_tree s
 
 let build s = in_build_dir s
 
-module Table = Hashtbl.Make (T)
+module Table = struct
+  type 'a t =
+    { source : 'a Source0.Table.t
+    ; build : 'a Build.Table.t
+    ; external_ : 'a External.Table.t
+    }
+
+  let create size =
+    { source = Source0.Table.create size
+    ; build = Build.Table.create size
+    ; external_ = External.Table.create size
+    }
+
+  let clear { source; build; external_ } =
+    Source0.Table.clear source;
+    Build.Table.clear build;
+    External.Table.clear external_
+
+  let mem { source; build; external_ } key =
+    match key with
+    | In_source_tree p -> Source0.Table.mem source p
+    | In_build_dir p -> Build.Table.mem build p
+    | External p -> External.Table.mem external_ p
+
+  let set { source; build; external_ } k v =
+    match k with
+    | In_source_tree p -> Source0.Table.set source p v
+    | In_build_dir p -> Build.Table.set build p v
+    | External p -> External.Table.set external_ p v
+
+  let remove { source; build; external_ } k =
+    match k with
+    | In_source_tree p -> Source0.Table.remove source p
+    | In_build_dir p -> Build.Table.remove build p
+    | External p -> External.Table.remove external_ p
+
+  let iter { source; build; external_ } ~f =
+    Source0.Table.iter source ~f;
+    Build.Table.iter build ~f;
+    External.Table.iter external_ ~f
+
+  let find { source; build; external_ } = function
+    | In_source_tree p -> Source0.Table.find source p
+    | In_build_dir p -> Build.Table.find build p
+    | External p -> External.Table.find external_ p
+
+  let filteri_inplace { source; build; external_ } ~f =
+    Source0.Table.filteri_inplace source ~f:(fun ~key ~data ->
+        f ~key:(In_source_tree key) ~data);
+    Build.Table.filteri_inplace build ~f:(fun ~key ~data ->
+        f ~key:(In_build_dir key) ~data);
+    External.Table.filteri_inplace external_ ~f:(fun ~key ~data ->
+        f ~key:(External key) ~data)
+
+  let filter_inplace { source; build; external_ } ~f =
+    Source0.Table.filteri_inplace source ~f:(fun ~key:_ ~data -> f data);
+    Build.Table.filteri_inplace build ~f:(fun ~key:_ ~data -> f data);
+    External.Table.filteri_inplace external_ ~f:(fun ~key:_ ~data -> f data)
+
+  let to_dyn f { source; build; external_ } =
+    let open Dyn in
+    record
+      [ ("source", Source0.Table.to_dyn f source)
+      ; ("build", Build.Table.to_dyn f build)
+      ; ("external_", External.Table.to_dyn f external_)
+      ]
+end
 
 module L = struct
   (* TODO more efficient implementation *)

otherlibs/stdune/src/path.mli

@@ -84,6 +84,8 @@ module External : sig
   val of_filename_relative_to_initial_cwd : string -> t
 
   val append_local : t -> Local.t -> t
+
+  module Table : Hashtbl.S with type key = t
 end
 
 (** In the source section of the current workspace. *)
@@ -113,6 +115,8 @@ module Source : sig
   val descendant : t -> of_:t -> t option
 
   val to_local : t -> Local.t
+
+  module Table : Hashtbl.S with type key = t
 end
 
 module Permissions : sig
@@ -221,6 +225,8 @@ module Build : sig
   val lstat : t -> Unix.stats
 
   val unlink_no_err : t -> unit
+
+  module Table : Hashtbl.S with type key = t
 end
 
 type t = private
@@ -230,6 +236,37 @@ type t = private
 
 include Path_intf.S with type t := t
 
+module Table : sig
+  (** Specialized tables for path. We do implement all of [Hashtbl_intf.S] -
+      only what we use in dune. *)
+
+  type path := t
+
+  type 'a t
+
+  val create : int -> 'a t
+
+  val clear : 'a t -> unit
+
+  val mem : 'a t -> path -> bool
+
+  val set : 'a t -> path -> 'a -> unit
+
+  val remove : 'a t -> path -> unit
+
+  val iter : 'a t -> f:('a -> unit) -> unit
+
+  val find : 'a t -> path -> 'a option
+
+  val filteri_inplace : 'a t -> f:(key:path -> data:'a -> bool) -> unit
+
+  val filter_inplace : 'a t -> f:('a -> bool) -> unit
+
+  val to_dyn : ('a -> Dyn.t) -> 'a t -> Dyn.t
+end
+
+val equal : t -> t -> bool
+
 val as_outside_build_dir_exn : t -> Outside_build_dir.t
 
 val destruct_build_dir :

otherlibs/stdune/src/path_intf.ml

@@ -42,7 +42,7 @@ module type S = sig
     val of_listing : dir:elt -> filenames:string list -> t
   end
 
-  module Table : Hashtbl.S with type key = t
+  val equal : t -> t -> bool
 
   val relative : ?error_loc:Loc0.t -> t -> string -> t
 

src/dune_engine/cached_digest.ml

@@ -94,19 +94,26 @@ let delete_very_recent_entries () =
   let now = get_current_filesystem_time () in
   match Float.compare cache.max_timestamp now with
   | Lt -> ()
-  | Eq | Gt ->
-    Path.Table.filteri_inplace cache.table ~f:(fun ~key:path ~data ->
-        match Float.compare data.stats.mtime now with
-        | Lt -> true
-        | Gt | Eq ->
-          if !Clflags.debug_digests then
-            Console.print
-              [ Pp.textf
-                  "Dropping cached digest for %s because it has exactly the \
-                   same mtime as the file system clock."
-                  (Path.to_string_maybe_quoted path)
-              ];
-          false)
+  | Eq | Gt -> (
+    let filter (data : file) =
+      match Float.compare data.stats.mtime now with
+      | Lt -> true
+      | Gt | Eq -> false
+    in
+    match !Clflags.debug_digests with
+    | false -> Path.Table.filter_inplace cache.table ~f:filter
+    | true ->
+      Path.Table.filteri_inplace cache.table ~f:(fun ~key:path ~data ->
+          let filter = filter data in
+          if filter then
+            if !Clflags.debug_digests then
+              Console.print
+                [ Pp.textf
+                    "Dropping cached digest for %s because it has exactly the \
+                     same mtime as the file system clock."
+                    (Path.to_string_maybe_quoted path)
+                ];
+          filter))
 
 let dump () =
   if !needs_dumping && Path.build_dir_exists () then (