feature(engine): file async operations (#7838)

This moves over some remaining file operations in the engine into background
threads.

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

src/dune_config/config.ml

@@ -126,3 +126,13 @@ let background_sandboxes =
   in
   register t;
   t
+
+let background_file_system_operations_in_rule_execution =
+  let t =
+    { name = "background_file_system_operations_in_rule_execution"
+    ; of_string = Toggle.of_string
+    ; value = `Disabled
+    }
+  in
+  register t;
+  t

src/dune_config/config.mli

@@ -47,4 +47,7 @@ val background_digests : Toggle.t t
 (** Build and destroy sandboxes in background threads *)
 val background_sandboxes : Toggle.t t
 
+(** Run file operations when executing rules in background threads *)
+val background_file_system_operations_in_rule_execution : Toggle.t t
+
 val init : (Loc.t * string) String.Map.t -> unit

src/dune_engine/build_system.ml

@@ -471,8 +471,11 @@ end = struct
         if capture_stdout then Action.with_stdout_to stamp_file action
         else Action.progn [ action; Action.write_file stamp_file "" ]
     in
-    Action.chdirs action
-    |> Path.Build.Set.iter ~f:(fun p -> Path.mkdir_p (Path.build p));
+    let* () =
+      Targets.maybe_async (fun () ->
+          Action.chdirs action
+          |> Path.Build.Set.iter ~f:(fun p -> Path.mkdir_p (Path.build p)))
+    in
     let root =
       match context with
       | None -> Path.Build.root
@@ -505,8 +508,7 @@ end = struct
           let+ produced_targets =
             match sandbox with
             | None ->
-              Fiber.return
-                (Targets.Produced.produced_after_rule_executed_exn ~loc targets)
+              Targets.Produced.produced_after_rule_executed_exn ~loc targets
             | Some sandbox ->
               (* The stamp file for anonymous actions is always created outside
                  the sandbox, so we can't move it. *)
@@ -577,7 +579,9 @@ end = struct
     wrap_fiber (fun () ->
         let open Fiber.O in
         report_evaluated_rule_exn config;
-        Path.mkdir_p (Path.build dir);
+        let* () =
+          Targets.maybe_async (fun () -> Path.mkdir_p (Path.build dir))
+        in
         let is_action_dynamic = Action.is_dynamic action.action in
         let sandbox_mode =
           match Action.is_useful_to_sandbox action.action with
@@ -646,12 +650,16 @@ end = struct
           | None ->
             (* Step II. Remove stale targets both from the digest table and from
                the build directory. *)
-            Path.Build.Set.iter targets.files ~f:(fun file ->
-                Cached_digest.remove file;
-                Path.Build.unlink_no_err file);
-            Path.Build.Set.iter targets.dirs ~f:(fun dir ->
-                Cached_digest.remove dir;
-                Path.rm_rf (Path.build dir));
+            let () =
+              Path.Build.Set.iter targets.files ~f:Cached_digest.remove;
+              Path.Build.Set.iter targets.dirs ~f:Cached_digest.remove
+            in
+            let* () =
+              Targets.maybe_async (fun () ->
+                  Path.Build.Set.iter targets.files ~f:Path.Build.unlink_no_err;
+                  Path.Build.Set.iter targets.dirs ~f:(fun dir ->
+                      Path.rm_rf (Path.build dir)))
+            in
             let* produced_targets, dynamic_deps_stages =
               (* Step III. Try to restore artifacts from the shared cache. *)
               match

src/dune_engine/targets.ml

@@ -9,6 +9,14 @@ type t =
   ; dirs : Path.Build.Set.t
   }
 
+let maybe_async f =
+  (* It would be nice to do this check only once and return a function, but the
+     type of this function would need to be polymorphic which is forbidden by
+     the relaxed value restriction. *)
+  match Config.(get background_file_system_operations_in_rule_execution) with
+  | `Enabled -> Scheduler.async_exn f
+  | `Disabled -> Fiber.return (f ())
+
 module File = struct
   let create file =
     { files = Path.Build.Set.singleton file; dirs = Path.Build.Set.empty }
@@ -150,7 +158,8 @@ module Produced = struct
         Ok { files; dirs }
 
   let produced_after_rule_executed_exn ~loc targets =
-    match of_validated targets with
+    let open Fiber.O in
+    maybe_async (fun () -> of_validated targets) >>| function
     | Ok t -> t
     | Error (`Directory dir, (Unix.ENOENT, _, _)) ->
       User_error.raise ~loc

src/dune_engine/targets.mli

@@ -88,7 +88,8 @@ module Produced : sig
 
   (** Like [of_validated] but assumes the targets have been just produced by a
       rule. If some directory targets aren't readable, an error is raised *)
-  val produced_after_rule_executed_exn : loc:Loc.t -> Validated.t -> unit t
+  val produced_after_rule_executed_exn :
+    loc:Loc.t -> Validated.t -> unit t Fiber.t
 
   (** Populates only the [files] field, leaving [dirs] empty. Raises a code
       error if the list contains duplicates. *)
@@ -114,3 +115,7 @@ module Produced : sig
 
   val to_dyn : _ t -> Dyn.t
 end
+
+(** will run in a background thread if
+    [background_file_system_operations_in_rule_execution] is set *)
+val maybe_async : (unit -> 'a) -> 'a Fiber.t