Dirty commit before the weekend

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

@@ -103,12 +103,15 @@ 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))
+      Targets.Produced.iteri
+        targets
+        ~d:(fun dir _ -> 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
+          portable_hardlink_or_copy ~src:path_in_build_dir ~dst:path_in_temp_dir))
   ;;
 
   (* Step II of [store_skipping_metadata].
@@ -281,10 +284,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

src/dune_cache/shared.ml

@@ -121,8 +121,12 @@ struct
         ]
     in
     let update_cached_digests ~targets_and_digests =
-      Targets.Produced.iteri targets_and_digests ~f:(fun path digest ->
-        Cached_digest.set (Path.Build.append_local targets_and_digests.root path) digest)
+      Targets.Produced.iteri
+        targets_and_digests
+        ~f:(fun path digest ->
+          Cached_digest.set (Path.Build.append_local targets_and_digests.root path) digest)
+          (* Why ignore? *)
+        ~d:(fun dirname _contents -> ignore dirname)
     in
     match
       Targets.Produced.map_with_errors

src/dune_engine/target_promotion.ml

@@ -184,8 +184,12 @@ 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) ->
-    create_directory_if_needed ~dir:(Path.Build.append_local targets.root dir));
+  Targets.Produced.iteri
+    targets
+    ~d:(fun dir _ ->
+      create_directory_if_needed ~dir:(Path.Build.append_local targets.root dir))
+      (* sure about that? *)
+    ~f:(fun file (_ : Dune_digest.t) -> ignore file);
   let promote_until_clean =
     match promote.lifetime with
     | Until_clean -> true
@@ -209,7 +213,10 @@ 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
+    ~(contents : 'a Targets.Produced.dir_contents)
+    =
     (* 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
@@ -225,16 +232,15 @@ let promote ~(targets : _ Targets.Produced.t) ~(promote : Rule.Promote.t) ~promo
     | Ok dir_contents ->
       Fs_cache.Dir_contents.iter dir_contents ~f:(function
         | filename, S_REG ->
-          if not (String.Map.mem expected_filenames filename)
+          if not (Filename.Map.mem contents.files 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)
+          if not (Path.Local.Map.mem contents.subdirs src_dir)
           then Path.rm_rf (Path.relative dst_dir dirname)
         | 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 ~contents)
 ;;