WIP: directory targets with empty subdirs

Signed-off-by: Ambre Austen Suhamy <[email protected]>

boot/libs.ml

@@ -1,4 +1,4 @@
-let external_libraries = [ "unix"; "threads" ]
+let external_libraries = [ "threads.posix" ]
 
 let local_libraries =
   [ ("otherlibs/ordering", Some "Ordering", false, None)

src/dune_cache/local.ml

@@ -80,6 +80,12 @@ module Artifacts = struct
     =
     let entries =
       Targets.Produced.foldi artifacts ~init:[] ~f:(fun target file_digest entries ->
+        (if Targets.Produced.debug_out
+         then
+           let open Pp.O in
+           Pp.to_fmt
+             Format.std_formatter
+             (Pp.paragraphf "[StoreMeta %S]" (Path.Local.to_string target) ++ Pp.space));
         let entry : Metadata_entry.t =
           { file_path = Path.Local.to_string target; file_digest }
         in
@@ -103,12 +109,29 @@ module Artifacts = struct
     Result.try_with (fun () ->
       (* CR-someday rleshchinskiy: We recreate the directory structure here but it might be
          simpler to just use file digests instead of file names and no subdirectories. *)
-      Path.Local.Map.iteri targets.dirs ~f:(fun path _ ->
-        Path.mkdir_p (Path.append_local temp_dir path));
-      Targets.Produced.iteri targets ~f:(fun path _ ->
-        let path_in_build_dir = Path.build (Path.Build.append_local targets.root path) in
-        let path_in_temp_dir = Path.append_local temp_dir path in
-        portable_hardlink_or_copy ~src:path_in_build_dir ~dst:path_in_temp_dir))
+      (* The comment above seems outdated wrt. 'no subdirectories'... *)
+      Targets.Produced.iteri
+        targets
+        ~d:(fun dir _ ->
+          (if Targets.Produced.debug_out
+           then
+             let open Pp.O in
+             Pp.to_fmt
+               Format.std_formatter
+               (Pp.paragraphf "[Store_dir %S]" (Path.Local.to_string dir) ++ Pp.space));
+          Path.mkdir_p (Path.append_local temp_dir dir))
+        ~f:(fun file _ ->
+          let path_in_build_dir =
+            Path.build (Path.Build.append_local targets.root file)
+          in
+          let path_in_temp_dir = Path.append_local temp_dir file in
+          (if Targets.Produced.debug_out
+           then
+             let open Pp.O in
+             Pp.to_fmt
+               Format.std_formatter
+               (Pp.paragraphf "[Store_file: %S]" (Path.Local.to_string file) ++ Pp.space));
+          portable_hardlink_or_copy ~src:path_in_build_dir ~dst:path_in_temp_dir))
   ;;
 
   (* Step II of [store_skipping_metadata].
@@ -121,6 +144,12 @@ module Artifacts = struct
     Fiber.collect_errors (fun () ->
       Targets.Produced.parallel_map targets ~f:(fun path { Target.executable } ->
         let file = Path.append_local temp_dir path in
+        (if Targets.Produced.debug_out
+         then
+           let open Pp.O in
+           Pp.to_fmt
+             Format.std_formatter
+             (Pp.paragraphf "[CompDigests %S]" (Path.Local.to_string path) ++ Pp.space));
         compute_digest ~executable file))
     >>| Result.map_error ~f:(function
       | exn :: _ -> exn.Exn_with_backtrace.exn
@@ -135,6 +164,13 @@ module Artifacts = struct
       ~f:(fun target digest results ->
         let path_in_temp_dir = Path.append_local temp_dir target in
         let path_in_cache = file_path ~file_digest:digest in
+        (if Targets.Produced.debug_out
+         then
+           let open Pp.O in
+           Pp.to_fmt
+             Format.std_formatter
+             (Pp.paragraphf "[Store_to_cache %S]" (Path.Local.to_string target)
+              ++ Pp.space));
         let store_using_hardlinks () =
           match
             Dune_cache_storage.Util.Optimistically.link
@@ -281,10 +317,7 @@ module Artifacts = struct
          | Copy -> copy ~src ~dst);
         Unwind.push unwind (fun () -> Path.Build.unlink_no_err target)
       in
-      try
-        Path.Local.Map.iteri artifacts.dirs ~f:(fun dir _ -> mk_dir dir);
-        Targets.Produced.iteri artifacts ~f:mk_file
-      with
+      try Targets.Produced.iteri artifacts ~f:mk_file ~d:(fun dir _ -> mk_dir dir) with
       | exn ->
         Unwind.unwind unwind;
         reraise exn
@@ -297,6 +330,12 @@ module Artifacts = struct
         Path.Local.Map.of_list_map_exn
           entries
           ~f:(fun { Metadata_entry.file_path; file_digest } ->
+            (if Targets.Produced.debug_out
+             then
+               let open Pp.O in
+               Pp.to_fmt
+                 Format.std_formatter
+                 (Pp.paragraphf "[Restore: %S]" file_path ++ Pp.space));
             Path.Local.of_string file_path, file_digest)
         |> Targets.Produced.of_files target_dir
       in

src/dune_cache/shared.ml

@@ -121,7 +121,7 @@ struct
         ]
     in
     let update_cached_digests ~targets_and_digests =
-      Targets.Produced.iteri targets_and_digests ~f:(fun path digest ->
+      Targets.Produced.iter_files targets_and_digests ~f:(fun path digest ->
         Cached_digest.set (Path.Build.append_local targets_and_digests.root path) digest)
     in
     match

src/dune_engine/build_system.ml

@@ -955,6 +955,7 @@ end = struct
     | Build_under_directory_target { directory_target_ancestor = _ } ->
       (* To evaluate a glob in a generated directory, we have no choice but to build the
          whole directory and examine its contents. *)
+      (* But not the subdirectories? *)
       let+ path_map = build_dir dir in
       (match Targets.Produced.find_dir path_map (Path.as_in_build_dir_exn dir) with
        | Some files_and_digests ->

src/dune_engine/target_promotion.ml

@@ -184,7 +184,16 @@ let promote ~(targets : _ Targets.Produced.t) ~(promote : Rule.Promote.t) ~promo
   in
   (* Here we know that the promotion directory exists but we may need to create
      additional subdirectories for [targets.dirs]. *)
-  Path.Local.Map.iteri targets.dirs ~f:(fun dir (_ : Digest.t Filename.Map.t) ->
+  Targets.Produced.iter_dirs targets ~f:(fun dir _ ->
+    (if Targets.Produced.debug_out
+     then
+       let open Pp.O in
+       Pp.to_fmt
+         Format.std_formatter
+         (Pp.paragraphf
+            "[Promote: %S]"
+            (Path.Build.to_string (Path.Build.append_local targets.root dir))
+          ++ Pp.space));
     create_directory_if_needed ~dir:(Path.Build.append_local targets.root dir));
   let promote_until_clean =
     match promote.lifetime with
@@ -209,7 +218,7 @@ let promote ~(targets : _ Targets.Produced.t) ~(promote : Rule.Promote.t) ~promo
   in
   (* There can be some files or directories left over from earlier builds, so we
      need to remove them from [targets.dirs]. *)
-  let remove_stale_files_and_subdirectories ~dir ~expected_filenames =
+  let remove_stale_files_and_subdirectories ~dir =
     (* CR-someday rleshchinskiy: This can probably be made more efficient by relocating
        root once. *)
     let build_dir = Path.Build.append_local targets.root dir in
@@ -224,17 +233,16 @@ let promote ~(targets : _ Targets.Produced.t) ~(promote : Rule.Promote.t) ~promo
     | Error unix_error -> directory_target_error ~unix_error ~dst_dir []
     | Ok dir_contents ->
       Fs_cache.Dir_contents.iter dir_contents ~f:(function
-        | filename, S_REG ->
-          if not (String.Map.mem expected_filenames filename)
-          then Path.unlink_no_err (Path.relative dst_dir filename)
-        | dirname, S_DIR ->
-          let src_dir = Path.Local.relative dir dirname in
-          if not (Path.Local.Map.mem targets.dirs src_dir)
-          then Path.rm_rf (Path.relative dst_dir dirname)
+        | file_name, S_REG ->
+          if not (Targets.Produced.mem targets (Path.Build.relative build_dir file_name))
+          then Path.unlink_no_err (Path.relative dst_dir file_name)
+        | dir_name, S_DIR ->
+          if not
+               (Targets.Produced.mem_dir targets (Path.Build.relative build_dir dir_name))
+          then Path.rm_rf (Path.relative dst_dir dir_name)
         | name, _kind -> Path.unlink_no_err (Path.relative dst_dir name))
   in
   Fiber.sequential_iter_seq
-    (Path.Local.Map.to_seq targets.dirs)
-    ~f:(fun (dir, filenames) ->
-      remove_stale_files_and_subdirectories ~dir ~expected_filenames:filenames)
+    (Targets.Produced.all_dirs_seq targets)
+    ~f:(fun (dir, _contents) -> remove_stale_files_and_subdirectories ~dir)
 ;;