ocaml · rgrinberg · Mar 25, 2023 · Mar 23, 2023 · Alizter · Mar 24, 2023
diff --git a/CHANGES.md b/CHANGES.md
@@ -1,6 +1,9 @@
 Unreleased
 ----------
 
+- Dune in watch mode no longer builds concurrent rules in serial (#7395
+  @rgrinberg, @jchavarri)
+
 - `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

diff --git a/src/dune_config/config.ml b/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
diff --git a/src/dune_config/config.mli b/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]).

diff --git a/src/dune_engine/build_system.ml b/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 ->

diff --git a/src/dune_engine/dune b/src/dune_engine/dune
@@ -6,6 +6,7 @@
   unix
   csexp
   stdune
+  dune_config
   dune_console
   dyn
   fiber
-Original file line number
+Diff line change
@@ Expand Up / @@ -6,6 +6,7 @@ @@
       unix
       csexp
       stdune
+      dune_config
       dune_console
       dyn
       fiber
@@ Expand Down @@