diff --git a/CHANGES.md b/CHANGES.md index 9b4c3b98f63a..f6e01bc05330 100644 --- 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, @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 diff --git a/src/dune_config/config.ml b/src/dune_config/config.ml index cb5ca2c97996..fe4805d74f27 100644 --- 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 index 23483903de10..63cfa019626b 100644 --- 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 index c0fa1668b596..c87ec4d7a356 100644 --- 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 index 5714f74e7aa6..52eb687d3a86 100644 --- a/src/dune_engine/dune +++ b/src/dune_engine/dune @@ -6,6 +6,7 @@ unix csexp stdune + dune_config dune_console dyn fiber