diff --git a/src/dune_engine/build_config.ml b/src/dune_engine/build_config.ml index abbd0bbe6d6f..f5c4dcade600 100644 --- a/src/dune_engine/build_config.ml +++ b/src/dune_engine/build_config.ml @@ -12,8 +12,15 @@ module Context_or_install = struct end module Rules = struct + module Build_only_sub_dirs = struct + type t = Subdir_set.t Path.Build.Map.t + + let union a b = + Path.Build.Map.union a b ~f:(fun _ a b -> Some (Subdir_set.union a b)) + end + type t = - { build_dir_only_sub_dirs : Subdir_set.t Path.Build.Map.t + { build_dir_only_sub_dirs : Build_only_sub_dirs.t ; directory_targets : Loc.t Path.Build.Map.t ; rules : Rules.t Memo.t } @@ -26,8 +33,8 @@ module Rules = struct let combine_exn r { build_dir_only_sub_dirs; directory_targets; rules } = { build_dir_only_sub_dirs = - Path.Build.Map.union r.build_dir_only_sub_dirs build_dir_only_sub_dirs - ~f:(fun _ a b -> Some (Subdir_set.union a b)) + Build_only_sub_dirs.union r.build_dir_only_sub_dirs + build_dir_only_sub_dirs ; directory_targets = Path.Build.Map.union_exn r.directory_targets directory_targets ; rules = diff --git a/src/dune_engine/build_config.mli b/src/dune_engine/build_config.mli index 409b01f8bde4..b51664ad96fa 100644 --- a/src/dune_engine/build_config.mli +++ b/src/dune_engine/build_config.mli @@ -14,13 +14,21 @@ end module Rules : sig (** Rules for a given directory. This type is structured so that all generated - sub-directories (either directory targets or internal generated + sub-directories (either directory targets or internally generated directories such as [.ppx]) are known immediately, while the actual build rules are computed in a second stage. The staging is to avoid computation cycles created during the computation of the rules. *) + module Build_only_sub_dirs : sig + (** The set of either directory targets or internally generated directories, + indexed by their parent build directory. *) + type t = Subdir_set.t Path.Build.Map.t + + val union : t -> t -> t + end + type t = - { build_dir_only_sub_dirs : Subdir_set.t Path.Build.Map.t + { build_dir_only_sub_dirs : Build_only_sub_dirs.t (** Sub-directories that don't exist in the source tree but exists in the build directory. This is for internal directories such as [.dune] or [.ppx]. *) diff --git a/src/dune_engine/load_rules.ml b/src/dune_engine/load_rules.ml index e581d93cfe7d..98abb2f56ac7 100644 --- a/src/dune_engine/load_rules.ml +++ b/src/dune_engine/load_rules.ml @@ -508,8 +508,8 @@ end = struct let combine_exn r { build_dir_only_sub_dirs; directory_targets; rules } = { build_dir_only_sub_dirs = - Path.Build.Map.union r.build_dir_only_sub_dirs build_dir_only_sub_dirs - ~f:(fun _ a b -> Some (Subdir_set.union a b)) + Build_config.Rules.Build_only_sub_dirs.union r.build_dir_only_sub_dirs + build_dir_only_sub_dirs ; directory_targets = Path.Build.Map.union_exn r.directory_targets directory_targets ; rules = diff --git a/src/dune_rules/gen_rules.ml b/src/dune_rules/gen_rules.ml index c07ee98ad2ba..842eb1fc7ea0 100644 --- a/src/dune_rules/gen_rules.ml +++ b/src/dune_rules/gen_rules.ml @@ -412,6 +412,14 @@ let rec under_melange_emit_target ~dir = | None -> under_melange_emit_target ~dir:parent | Some stanza -> Memo.return @@ Some { stanza_dir = parent; stanza })) +let rules_for ~dir rules = + { Build_config.Rules.build_dir_only_sub_dirs = + Path.Build.Map.singleton dir + (Subdir_set.These (automatic_subdirs (Path.Build.explode dir))) + ; directory_targets = Path.Build.Map.empty + ; rules + } + let melange_emit_rules sctx { stanza_dir; stanza } = let rules = Rules.collect_unit (fun () -> @@ -420,12 +428,7 @@ let melange_emit_rules sctx { stanza_dir; stanza } = Melange_rules.setup_emit_js_rules ~dir_contents ~dir:stanza_dir ~scope ~sctx stanza) in - { Build_config.Rules.build_dir_only_sub_dirs = - Path.Build.Map.singleton stanza_dir - (Subdir_set.These (automatic_subdirs (Path.Build.explode stanza_dir))) - ; directory_targets = Path.Build.Map.empty - ; rules - } + rules_for ~dir:stanza_dir rules let gen_melange_emit_rules sctx ~dir ({ stanza_dir; stanza } as for_melange) = match @@ -465,15 +468,9 @@ let gen_melange_emit_rules sctx ~dir ({ stanza_dir; stanza } as for_melange) = (Path.Source.to_string parent_melange_emit_dir) ])) -let empty_rules ~dir = - { Build_config.Rules.build_dir_only_sub_dirs = - Path.Build.Map.singleton dir - (Subdir_set.These (automatic_subdirs (Path.Build.explode dir))) - ; directory_targets = Path.Build.Map.empty - ; rules = Memo.return Rules.empty - } - -let gen_melange_emit_rules_or_empty_redirect sctx ~dir = function +let gen_melange_emit_rules_or_empty_redirect sctx ~dir under_melange_emit = + let empty_rules ~dir = rules_for ~dir (Memo.return Rules.empty) in + match under_melange_emit with | None -> Memo.return Build_config.(Redirect_to_parent (empty_rules ~dir)) | Some for_melange -> ( let+ melange_rules = gen_melange_emit_rules sctx ~dir for_melange in