refactor: use [Outside_build_dir.t]

Signed-off-by: Rudi Grinberg <me@rgrinberg.com>

ps-id: 0b6059b1-b94a-4e8a-9e1c-68f9e86ea427

otherlibs/stdune/path.ml

@@ -546,6 +546,25 @@ module Outside_build_dir = struct
     | External x -> External (External.relative x (Local.to_string y))
 
   let to_string_maybe_quoted t = String.maybe_quoted (to_string t)
+
+  let equal (x : t) (y : t) =
+    match (x, y) with
+    | External x, External y -> External.equal x y
+    | External _, In_source_dir _ -> false
+    | In_source_dir x, In_source_dir y -> Local.equal x y
+    | In_source_dir _, External _ -> false
+
+  let hash = Poly.hash
+
+  let parent = function
+    | In_source_dir t -> (
+      match Local.parent t with
+      | None -> None
+      | Some s -> Some (In_source_dir s))
+    | External t -> (
+      match External.parent t with
+      | None -> None
+      | Some s -> Some (External s))
 end
 
 module Permissions = struct
@@ -904,6 +923,22 @@ let as_in_source_tree_exn t =
       "[as_in_source_tree_exn] called on something not in source tree"
       [ ("t", to_dyn t) ]
 
+let as_outside_build_dir_exn : t -> Outside_build_dir.t = function
+  | In_source_tree s -> In_source_dir s
+  | External s -> External s
+  | In_build_dir path ->
+    Code_error.raise "as_outside_build_dir_exn" [ ("path", Build.to_dyn path) ]
+
+let destruct_build_dir :
+    t -> [ `Inside of Build.t | `Outside of Outside_build_dir.t ] = function
+  | In_source_tree p -> `Outside (In_source_dir p)
+  | External s -> `Outside (External s)
+  | In_build_dir s -> `Inside s
+
+let outside_build_dir : Outside_build_dir.t -> t = function
+  | In_source_dir d -> In_source_tree d
+  | External s -> External s
+
 let as_in_build_dir = function
   | In_build_dir b -> Some b
   | In_source_tree _ | External _ -> None

otherlibs/stdune/path.mli

@@ -139,9 +139,19 @@ module Outside_build_dir : sig
     | External of External.t
     | In_source_dir of Source.t
 
+  val hash : t -> int
+
+  val equal : t -> t -> bool
+
+  val to_dyn : t -> Dyn.t
+
   val of_string : string -> t
 
+  val to_string : t -> string
+
   val to_string_maybe_quoted : t -> string
+
+  val parent : t -> t option
 end
 
 module Build : sig
@@ -216,6 +226,13 @@ type t = private
 
 include Path_intf.S with type t := t
 
+val as_outside_build_dir_exn : t -> Outside_build_dir.t
+
+val destruct_build_dir :
+  t -> [ `Inside of Build.t | `Outside of Outside_build_dir.t ]
+
+val outside_build_dir : Outside_build_dir.t -> t
+
 val hash : t -> int
 
 (** [to_string_maybe_quoted t] is [maybe_quoted (to_string t)] *)

src/dune_engine/dune_project.ml

@@ -961,7 +961,7 @@ let load_dune_project ~dir opam_packages ~dir_status : t Memo.t =
   let file = Path.Source.relative dir filename in
   let open Memo.O in
   let* f =
-    Fs_memo.with_lexbuf_from_file (Path.source file) ~f:(fun lexbuf ->
+    Fs_memo.with_lexbuf_from_file (In_source_dir file) ~f:(fun lexbuf ->
         parse_contents lexbuf ~f:(fun lang ->
             parse ~dir ~lang ~file ~dir_status))
   in

src/dune_engine/fs_memo.ml

@@ -13,15 +13,16 @@ module Watcher : sig
      directly if there is no parent. This is an optimisation that allows us to
      reduce the number of watched paths: typically, the number of directories is
      a lot smaller than the number of files. *)
-  val watch : try_to_watch_via_parent:bool -> Path.t -> unit Memo.t
+  val watch :
+    try_to_watch_via_parent:bool -> Path.Outside_build_dir.t -> unit Memo.t
 
   (* Invalidate a path after receiving an event from the file watcher. *)
-  val invalidate : Path.t -> Memo.Invalidation.t
+  val invalidate : Path.Outside_build_dir.t -> Memo.Invalidation.t
 end = struct
   (* A record of a call to [watch] made while the file watcher was missing. *)
   type watch_record =
-    { accessed_path : Path.t
-    ; path_to_watch : Path.t
+    { accessed_path : Path.Outside_build_dir.t
+    ; path_to_watch : Path.Outside_build_dir.t
     }
 
   (* CR-someday amokhov: We should try to simplify the initialisation of the
@@ -97,6 +98,7 @@ end = struct
           ({ accessed_path; path_to_watch } :: watch_records)
     | No_file_watcher -> ()
     | File_watcher dune_file_watcher ->
+      let path_to_watch = Path.outside_build_dir path_to_watch in
       watch_path dune_file_watcher path_to_watch
 
   (* This comment applies to both memoization tables below.
@@ -108,32 +110,31 @@ end = struct
      on every computation is sometimes necessary. *)
   let memo_for_watching_directly =
     Memo.create "fs_memo_for_watching_directly"
-      ~input:(module Path)
+      ~input:(module Path.Outside_build_dir)
       (fun accessed_path ->
         watch_or_record_path ~accessed_path ~path_to_watch:accessed_path;
         Memo.return ())
 
   let memo_for_watching_via_parent =
     Memo.create "fs_memo_for_watching_via_parent"
-      ~input:(module Path)
+      ~input:(module Path.Outside_build_dir)
       (fun accessed_path ->
         let path_to_watch =
-          Option.value (Path.parent accessed_path) ~default:accessed_path
+          Option.value
+            (Path.Outside_build_dir.parent accessed_path)
+            ~default:accessed_path
         in
         watch_or_record_path ~accessed_path ~path_to_watch;
         Memo.return ())
 
   let watch ~try_to_watch_via_parent path =
-    if Path.is_in_build_dir path then
-      Code_error.raise "Fs_memo.Watcher.watch called on a build path"
-        [ ("path", Path.to_dyn path) ];
     match try_to_watch_via_parent with
     | 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)
 
-  let update_all : Path.t -> Fs_cache.Update_result.t =
+  let update_all : Path.Outside_build_dir.t -> Fs_cache.Update_result.t =
     let update t path =
       let result = Fs_cache.update t path in
       if !Clflags.debug_fs_cache then
@@ -146,11 +147,13 @@ end = struct
              ]);
       result
     in
-    Update_all.reduce
+    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)
 
   (* CR-someday amokhov: We share Memo tables for tracking different file-system
      operations. This saves some memory, but leads to recomputing more memoized
@@ -161,13 +164,16 @@ end = struct
     match update_all path with
     | Skipped | Updated { changed = false } -> Memo.Invalidation.empty
     | Updated { changed = true } ->
+      let reason : Memo.Invalidation.Reason.t =
+        Path_changed (Path.outside_build_dir path)
+      in
       Memo.Invalidation.combine
         (Memo.Cell.invalidate
            (Memo.cell memo_for_watching_directly path)
-           ~reason:(Path_changed path))
+           ~reason)
         (Memo.Cell.invalidate
            (Memo.cell memo_for_watching_via_parent path)
-           ~reason:(Path_changed path))
+           ~reason)
 
   let init ~dune_file_watcher =
     match !state with
@@ -196,6 +202,7 @@ end = struct
         state := File_watcher watcher;
         Memo.Invalidation.map_reduce watch_records
           ~f:(fun { accessed_path; path_to_watch } ->
+            let path_to_watch = Path.outside_build_dir path_to_watch in
             watch_path watcher path_to_watch;
             invalidate accessed_path))
 end
@@ -207,7 +214,9 @@ 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 with
+  match
+    Fs_cache.read Fs_cache.Untracked.path_stat (Path.outside_build_dir 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
@@ -270,15 +279,17 @@ 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;
     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
+  Fs_cache.read Fs_cache.Untracked.file_digest (Path.outside_build_dir path)
 
 let dir_contents ?(force_update = false) path =
-  if force_update then Fs_cache.evict Fs_cache.Untracked.dir_contents path;
+  if force_update then
+    Fs_cache.evict Fs_cache.Untracked.dir_contents (Path.outside_build_dir path);
   let+ () = Watcher.watch ~try_to_watch_via_parent:false path in
-  Fs_cache.read Fs_cache.Untracked.dir_contents path
+  Fs_cache.read Fs_cache.Untracked.dir_contents (Path.outside_build_dir 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
@@ -290,23 +301,23 @@ 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
+    Fs_cache.read Fs_cache.Untracked.file_digest (Path.outside_build_dir path)
   in
   ()
 
 let with_lexbuf_from_file path ~f =
   let+ () = tracking_file_digest path in
-  Io.Untracked.with_lexbuf_from_file path ~f
+  Io.Untracked.with_lexbuf_from_file (Path.outside_build_dir path) ~f
 
 let file_contents path =
   let+ () = tracking_file_digest path in
-  Io.read_file path
+  Io.read_file (Path.outside_build_dir path)
 
 (* When a file or directory is created or deleted, we need to also invalidate
    the parent directory, so that the [dir_contents] queries are re-executed. *)
 let invalidate_path_and_its_parent path =
   Memo.Invalidation.combine (Watcher.invalidate path)
-    (match Path.parent path with
+    (match Path.Outside_build_dir.parent path with
     | None -> Memo.Invalidation.empty
     | Some path -> Watcher.invalidate path)
 
@@ -326,6 +337,7 @@ let invalidate_path_and_its_parent path =
    directory should be added to or removed from the result. *)
 let handle_fs_event ({ kind; path } : Dune_file_watcher.Fs_memo_event.t) :
     Memo.Invalidation.t =
+  let path = Path.as_outside_build_dir_exn path in
   match kind with
   | File_changed -> Watcher.invalidate path
   | Created | Deleted | Unknown -> invalidate_path_and_its_parent path

src/dune_engine/fs_memo.mli

@@ -4,24 +4,24 @@ open Import
     to be invalidated because they were accessed before [init] was called. *)
 val init : dune_file_watcher:Dune_file_watcher.t option -> Memo.Invalidation.t
 
-(** All functions in this module raise a code error when given a path in the
-    build directory. *)
-
 (** Check if a source or external file exists and declare a dependency on it. *)
-val file_exists : Path.t -> bool Memo.t
+val file_exists : Path.Outside_build_dir.t -> bool Memo.t
 
 (** Check if a source or external directory exists and declare a dependency on
     it. *)
-val dir_exists : Path.t -> bool Memo.t
+val dir_exists : Path.Outside_build_dir.t -> bool Memo.t
 
-val is_directory : Path.t -> (bool, Unix_error.Detailed.t) result Memo.t
+val is_directory :
+  Path.Outside_build_dir.t -> (bool, Unix_error.Detailed.t) result Memo.t
 
 (** Call [Path.stat] on a path and declare a dependency on it. *)
 val path_stat :
-  Path.t -> (Fs_cache.Reduced_stats.t, Unix_error.Detailed.t) result Memo.t
+     Path.Outside_build_dir.t
+  -> (Fs_cache.Reduced_stats.t, Unix_error.Detailed.t) result Memo.t
 
 (** Like [path_stat] but extracts the [st_kind] field from the result. *)
-val path_kind : Path.t -> (File_kind.t, Unix_error.Detailed.t) result Memo.t
+val path_kind :
+  Path.Outside_build_dir.t -> (File_kind.t, Unix_error.Detailed.t) result Memo.t
 
 (** Digest the contents of a source or external file and declare a dependency on
     it. When [force_update = true], evict the file from all digest caches and
@@ -30,13 +30,16 @@ val path_kind : Path.t -> (File_kind.t, Unix_error.Detailed.t) result Memo.t
     is about to be invalidated by an incoming file-system event. By not using
     the cache in this situation, it's possible to avoid unnecessary restarts. *)
 val file_digest :
-  ?force_update:bool -> Path.t -> Cached_digest.Digest_result.t Memo.t
+     ?force_update:bool
+  -> Path.Outside_build_dir.t
+  -> Cached_digest.Digest_result.t Memo.t
 
 (** Like [Io.Untracked.with_lexbuf_from_file] but declares a dependency on the
     path. *)
-val with_lexbuf_from_file : Path.t -> f:(Lexing.lexbuf -> 'a) -> 'a Memo.t
+val with_lexbuf_from_file :
+  Path.Outside_build_dir.t -> f:(Lexing.lexbuf -> 'a) -> 'a Memo.t
 
-val file_contents : Path.t -> string Memo.t
+val file_contents : Path.Outside_build_dir.t -> string Memo.t
 
 (** Read the contents of a source or external directory and declare a dependency
     on it. When [force_update = true], evict the directory from the file-system
@@ -47,7 +50,7 @@ val file_contents : Path.t -> string Memo.t
     restarts. *)
 val dir_contents :
      ?force_update:bool
-  -> Path.t
+  -> Path.Outside_build_dir.t
   -> (Fs_cache.Dir_contents.t, Unix_error.Detailed.t) result Memo.t
 
 (** Handle file system event. *)

src/dune_engine/include_stanza.ml

@@ -36,7 +36,7 @@ let load_sexps ~context:{ current_file; include_stack } (loc, fn) =
   let dir = Path.Source.parent_exn current_file in
   let current_file = Path.Source.relative dir fn in
   let open Memo.O in
-  let* exists = Fs_memo.file_exists (Path.source current_file) in
+  let* exists = Fs_memo.file_exists (In_source_dir current_file) in
   if not exists then
     User_error.raise ~loc
       [ Pp.textf "File %s doesn't exist."
@@ -47,7 +47,7 @@ let load_sexps ~context:{ current_file; include_stack } (loc, fn) =
         Path.Source.equal f current_file)
   then error { current_file; include_stack };
   let+ sexps =
-    Path.source current_file
-    |> Fs_memo.with_lexbuf_from_file ~f:(Dune_lang.Parser.parse ~mode:Many)
+    Fs_memo.with_lexbuf_from_file (In_source_dir current_file)
+      ~f:(Dune_lang.Parser.parse ~mode:Many)
   in
   (sexps, { current_file; include_stack })