fix: disable cutoff where it hurts concurrency

Make it possible to enable it with the "speculative_cutoff" internal
config option

Signed-off-by: Rudi Grinberg <[email protected]>

<!-- ps-id: fc9651ba-0bd5-401f-9568-fdddc647611e -->

CHANGES.md

@@ -1,6 +1,9 @@
 Unreleased
 ----------
 
+- Dune in watch mode no longer builds concurrent rules in serial (#7395
+  @rgrinberg, @jchavarri, @snowleopard)
+
 - `dune coq top` now correctly respects the project root when called from a
   subdirectory. However, absolute filenames passed to `dune coq top` are no
   longer supported (due to being buggy) (#7357, fixes #7344, @rlepigre and

src/dune_config/config.ml

@@ -72,3 +72,13 @@ let global_lock =
   in
   register t;
   t
+
+let cutoffs_that_reduce_concurrency_in_watch_mode =
+  let t =
+    { name = "cutoffs_that_reduce_concurrency_in_watch_mode"
+    ; of_string = Toggle.of_string
+    ; value = `Disabled
+    }
+  in
+  register t;
+  t

src/dune_config/config.mli

@@ -23,6 +23,10 @@ val get : 'a t -> 'a
 (** should dune acquire the global lock before building *)
 val global_lock : Toggle.t t
 
+(** whether dune should add cutoff to various memoized functions where it
+    reduces concurrency *)
+val cutoffs_that_reduce_concurrency_in_watch_mode : Toggle.t t
+
 (** Before any configuration value is accessed, this function must be called
     with all the configuration values from the relevant config file
     ([dune-workspace], or [dune-config]).

src/dune_engine/build_system.ml

@@ -279,7 +279,7 @@ and Exported : sig
   (* The below two definitions are useless, but if we remove them we get an
      "Undefined_recursive_module" exception. *)
 
-  val build_file_memo : (Path.t, Digest.t * target_kind) Memo.Table.t
+  val build_file_memo : (Path.t, Digest.t * target_kind) Memo.Table.t Lazy.t
     [@@warning "-32"]
 
   val build_alias_memo : (Alias.t, Dep.Fact.Files.t) Memo.Table.t
@@ -1035,13 +1035,21 @@ end = struct
   end
 
   let build_file_memo =
-    let cutoff = Tuple.T2.equal Digest.equal target_kind_equal in
-    Memo.create "build-file" ~input:(module Path) ~cutoff build_file_impl
-
-  let build_file path = Memo.exec build_file_memo path >>| fst
+    lazy
+      (let cutoff =
+         match
+           Dune_config.Config.(
+             get cutoffs_that_reduce_concurrency_in_watch_mode)
+         with
+         | `Disabled -> None
+         | `Enabled -> Some (Tuple.T2.equal Digest.equal target_kind_equal)
+       in
+       Memo.create "build-file" ~input:(module Path) ?cutoff build_file_impl)
+
+  let build_file path = Memo.exec (Lazy.force build_file_memo) path >>| fst
 
   let build_dir path =
-    let+ digest, kind = Memo.exec build_file_memo path in
+    let+ digest, kind = Memo.exec (Lazy.force build_file_memo) path in
     match kind with
     | Dir_target { generated_file_digests } -> (digest, generated_file_digests)
     | File_target ->

src/dune_engine/dune

@@ -6,6 +6,7 @@
   unix
   csexp
   stdune
+  dune_config
   dune_console
   dyn
   fiber