refactor: specialize [Fs_cache] to [Path.Outside_build_dir.t]

otherlibs/stdune/path.ml

@@ -565,6 +565,16 @@ module Outside_build_dir = struct
       match External.parent t with
       | None -> None
       | Some s -> Some (External s))
+
+  module Table = Hashtbl.Make (struct
+    type nonrec t = t
+
+    let hash = Poly.hash
+
+    let equal = Poly.equal
+
+    let to_dyn = to_dyn
+  end)
 end
 
 module Permissions = struct

otherlibs/stdune/path.mli

@@ -152,6 +152,8 @@ module Outside_build_dir : sig
   val to_string_maybe_quoted : t -> string
 
   val parent : t -> t option
+
+  module Table : Hashtbl.S with type key = t
 end
 
 module Build : sig

src/dune_engine/fs_cache.ml

@@ -6,24 +6,31 @@ open Import
 
 type 'a t =
   { name : string (* For debugging *)
-  ; sample : Path.t -> 'a
-  ; cache : 'a Path.Table.t
+  ; sample : Path.Outside_build_dir.t -> 'a
+  ; cache : 'a Path.Outside_build_dir.Table.t
   ; equal : 'a -> 'a -> bool (* Used to implement cutoff *)
-  ; update_hook : Path.t -> unit (* Run this hook before updating an entry. *)
+  ; update_hook :
+         Path.Outside_build_dir.t
+      -> unit (* Run this hook before updating an entry. *)
   }
 
-let create ?(update_hook = fun _path -> ()) name ~sample ~equal =
-  { name; sample; equal; cache = Path.Table.create 128; update_hook }
+let create ?(update_hook = fun _path -> ()) name ~sample ~equal : 'a t =
+  { name
+  ; sample
+  ; equal
+  ; cache = Path.Outside_build_dir.Table.create 128
+  ; update_hook
+  }
 
 let read { sample; cache; _ } path =
-  match Path.Table.find cache path with
+  match Path.Outside_build_dir.Table.find cache path with
   | Some cached_result -> cached_result
   | None ->
     let result = sample path in
-    Path.Table.add_exn cache path result;
+    Path.Outside_build_dir.Table.add_exn cache path result;
     result
 
-let evict { cache; _ } path = Path.Table.remove cache path
+let evict { cache; _ } path = Path.Outside_build_dir.Table.remove cache path
 
 module Update_result = struct
   type t =
@@ -45,15 +52,15 @@ module Update_result = struct
 end
 
 let update { sample; cache; equal; update_hook; _ } path =
-  match Path.Table.find cache path with
+  match Path.Outside_build_dir.Table.find cache path with
   | None -> Update_result.Skipped
   | Some old_result -> (
     update_hook path;
     let new_result = sample path in
     match equal old_result new_result with
     | true -> Updated { changed = false }
     | false ->
-      Path.Table.set cache path new_result;
+      Path.Outside_build_dir.Table.set cache path new_result;
       Updated { changed = true })
 
 module Reduced_stats = struct
@@ -102,7 +109,9 @@ end
 module Untracked = struct
   let path_stat =
     let sample path =
-      Path.Untracked.stat path |> Result.map ~f:Reduced_stats.of_unix_stats
+      Path.outside_build_dir path
+      |> Path.Untracked.stat
+      |> Result.map ~f:Reduced_stats.of_unix_stats
     in
     create "path_stat" ~sample
       ~equal:(Result.equal Reduced_stats.equal Unix_error.Detailed.equal)
@@ -111,15 +120,20 @@ module Untracked = struct
      module and [cached_digest.ml]. In particular, digests are stored twice, in
      two separate tables. We should find a way to merge the tables into one. *)
   let file_digest =
-    let sample = Cached_digest.Untracked.source_or_external_file in
-    let update_hook = Cached_digest.Untracked.invalidate_cached_timestamp in
+    let sample p =
+      Cached_digest.Untracked.source_or_external_file (Path.outside_build_dir p)
+    in
+    let update_hook p =
+      Cached_digest.Untracked.invalidate_cached_timestamp
+        (Path.outside_build_dir p)
+    in
     create "file_digest" ~sample ~update_hook
       ~equal:Cached_digest.Digest_result.equal
 
   let dir_contents =
     create "dir_contents"
       ~sample:(fun path ->
-        Path.Untracked.readdir_unsorted_with_kinds path
+        Path.Untracked.readdir_unsorted_with_kinds (Path.outside_build_dir path)
         |> Result.map ~f:Dir_contents.of_list)
       ~equal:(Result.equal Dir_contents.equal Unix_error.Detailed.equal)
 end

src/dune_engine/fs_cache.mli

@@ -1,7 +1,8 @@
 open Import
 
-(** A cached file-system operation on a [Path.t] whose result type is ['a]. For
-    example, an operation to check if a path exists returns ['a = bool].
+(** A cached file-system operation on a [Path.Outside_build_dir.t] whose result
+    type is ['a]. For example, an operation to check if a path exists returns
+    ['a = bool].
 
     Currently we do not expose a way to construct such cached operations; see
     the [Untracked] module for a few predefined ones. *)
@@ -10,10 +11,10 @@ type 'a t
 (** If the cache contains the result of applying an operation to a path, return
     it. Otherwise, perform the operation, store the result in the cache, and
     then return it. *)
-val read : 'a t -> Path.t -> 'a
+val read : 'a t -> Path.Outside_build_dir.t -> 'a
 
 (** Evict an entry from the cache. *)
-val evict : 'a t -> Path.t -> unit
+val evict : 'a t -> Path.Outside_build_dir.t -> unit
 
 (** Result of updating a cache entry. *)
 module Update_result : sig
@@ -30,7 +31,7 @@ module Update_result : sig
 end
 
 (** Perform an operation and update the result stored in the cache. *)
-val update : 'a t -> Path.t -> Update_result.t
+val update : 'a t -> Path.Outside_build_dir.t -> Update_result.t
 
 (** This module caches only a subset of fields of [Unix.stats] because other
     fields are currently unused.

src/dune_engine/fs_memo.ml

@@ -132,7 +132,8 @@ end = struct
     | false -> Memo.exec memo_for_watching_directly path
     | true -> Memo.exec memo_for_watching_via_parent path
 
-  module Update_all = Monoid.Function (Path) (Fs_cache.Update_result)
+  module Update_all =
+    Monoid.Function (Path.Outside_build_dir) (Fs_cache.Update_result)
 
   let update_all : Path.Outside_build_dir.t -> Fs_cache.Update_result.t =
     let update t path =
@@ -142,18 +143,20 @@ end = struct
           (User_message.make
              [ Pp.hbox
                  (Pp.textf "Updating %s cache for %S: %s"
-                    (Fs_cache.Debug.name t) (Path.to_string path)
+                    (Fs_cache.Debug.name t)
+                    (Path.Outside_build_dir.to_string path)
                     (Dyn.to_string (Fs_cache.Update_result.to_dyn result)))
              ]);
       result
     in
-    let all =
-      [ update Fs_cache.Untracked.path_stat
-      ; update Fs_cache.Untracked.file_digest
-      ; update Fs_cache.Untracked.dir_contents
-      ]
-    in
-    fun p -> Update_all.reduce all (Path.outside_build_dir p)
+    fun p ->
+      let all =
+        [ update Fs_cache.Untracked.path_stat
+        ; update Fs_cache.Untracked.file_digest
+        ; update Fs_cache.Untracked.dir_contents
+        ]
+      in
+      Update_all.reduce all p
 
   (* CR-someday amokhov: We share Memo tables for tracking different file-system
      operations. This saves some memory, but leads to recomputing more memoized
@@ -214,9 +217,7 @@ end
    and re-traversed/re-watched again. *)
 let path_stat path =
   let* () = Watcher.watch ~try_to_watch_via_parent:true path in
-  match
-    Fs_cache.read Fs_cache.Untracked.path_stat (Path.outside_build_dir path)
-  with
+  match Fs_cache.read Fs_cache.Untracked.path_stat path with
   | Ok { st_dev = _; st_ino = _; st_kind } as result when st_kind = S_DIR ->
     (* If [path] is a directory, we conservatively watch it directly too,
        because its stats may change in a way that doesn't trigger an event in
@@ -279,17 +280,16 @@ let dir_exists path =
    of [file_digest] seems error-prone. We may need to rethink this decision. *)
 let file_digest ?(force_update = false) path =
   if force_update then (
-    let path = Path.outside_build_dir path in
-    Cached_digest.Untracked.invalidate_cached_timestamp path;
+    Cached_digest.Untracked.invalidate_cached_timestamp
+      (Path.outside_build_dir path);
     Fs_cache.evict Fs_cache.Untracked.file_digest path);
   let+ () = Watcher.watch ~try_to_watch_via_parent:true path in
-  Fs_cache.read Fs_cache.Untracked.file_digest (Path.outside_build_dir path)
+  Fs_cache.read Fs_cache.Untracked.file_digest path
 
 let dir_contents ?(force_update = false) path =
-  if force_update then
-    Fs_cache.evict Fs_cache.Untracked.dir_contents (Path.outside_build_dir path);
+  if force_update then Fs_cache.evict Fs_cache.Untracked.dir_contents path;
   let+ () = Watcher.watch ~try_to_watch_via_parent:false path in
-  Fs_cache.read Fs_cache.Untracked.dir_contents (Path.outside_build_dir path)
+  Fs_cache.read Fs_cache.Untracked.dir_contents path
 
 (* CR-someday amokhov: For now, we do not cache the result of this operation
    because the result's type depends on [f]. There are only two call sites of
@@ -301,7 +301,7 @@ let tracking_file_digest path =
      be recorded in the [Fs_cache.Untracked.file_digest], so the build will be
      restarted if the digest changes. *)
   let (_ : Cached_digest.Digest_result.t) =
-    Fs_cache.read Fs_cache.Untracked.file_digest (Path.outside_build_dir path)
+    Fs_cache.read Fs_cache.Untracked.file_digest path
   in
   ()
 

src/dune_engine/target_promotion.ml

@@ -101,7 +101,7 @@ let promote_target_if_not_up_to_date ~src ~src_digest ~dst ~promote_source
      the tracked [Fs_memo.file_digest] to subscribe to the promotion result. *)
   let* promoted =
     match
-      Fs_cache.read Fs_cache.Untracked.file_digest (Path.source dst)
+      Fs_cache.read Fs_cache.Untracked.file_digest (In_source_dir dst)
       |> Cached_digest.Digest_result.to_option
     with
     | Some dst_digest when Digest.equal src_digest dst_digest ->
@@ -206,17 +206,18 @@ let promote ~dir ~(targets : _ Targets.Produced.t) ~promote ~promote_source =
         (User_message.Annots.singleton User_message.Annots.needs_stack_trace ())
   in
   let create_directory_if_needed ~dir =
-    let dst_dir = Path.source (relocate dir) in
+    let dst_dir = relocate dir in
     (* It is OK to use [Untracked.path_stat] on [dst_dir] here because below we
        will use [Fs_memo.dir_contents] to subscribe to [dst_dir]'s contents, so
        Dune will notice its deletion. Furthermore, if we used a tracked version,
        [Path.mkdir_p] below would generate an unnecessary file-system event. *)
-    match Fs_cache.(read Untracked.path_stat) dst_dir with
+    match Fs_cache.(read Untracked.path_stat) (In_source_dir dst_dir) with
     | Ok { st_kind; _ } when st_kind = S_DIR -> ()
-    | Error (ENOENT, _, _) -> Path.mkdir_p dst_dir
+    | Error (ENOENT, _, _) -> Path.mkdir_p (Path.source dst_dir)
     | Ok _ | Error _ -> (
       (* Try to delete any unexpected stuff out of the way. In future, we might
          want to make this aggressive cleaning behaviour conditional. *)
+      let dst_dir = Path.source dst_dir in
       match
         Unix_error.Detailed.catch
           (fun () ->