diff --git a/src/dune_rules/dune_file.ml b/src/dune_rules/dune_file.ml index 0308d09290fc..1ecfc84d6d46 100644 --- a/src/dune_rules/dune_file.ml +++ b/src/dune_rules/dune_file.ml @@ -2074,14 +2074,6 @@ module Generate_sites_module = struct { loc; module_; sourceroot; relocatable; sites; plugins }) end -module Package_proxy = struct - type Stanza.t += - | T of - { package : Package.t option - ; stanza : Stanza.t - } -end - type Stanza.t += | Library of Library.t | Foreign_library of Foreign.Library.t @@ -2272,7 +2264,6 @@ let stanza_package = function | Tests { package = Some package; _ } -> Some package | Coq_stanza.Theory.T { package = Some package; _ } -> Some package - | Package_proxy.T { package; _ } -> package | _ -> None type t = diff --git a/src/dune_rules/dune_file.mli b/src/dune_rules/dune_file.mli index 31a0c5ddcaa6..773395d55fe0 100644 --- a/src/dune_rules/dune_file.mli +++ b/src/dune_rules/dune_file.mli @@ -405,19 +405,6 @@ module Generate_sites_module : sig } end -module Package_proxy : sig - (** A wrapper to implement the (package) field on a stanza that does not - support it. This also helps with dependency cycles since [stanza_package] - (used to filter irrelevant stanzas) is part of [Dune_file] and can not - depend on all stanzas. *) - - type Stanza.t += - | T of - { package : Package.t option - ; stanza : Stanza.t - } -end - type Stanza.t += | Library of Library.t | Foreign_library of Foreign.Library.t diff --git a/src/dune_rules/gen_rules.ml b/src/dune_rules/gen_rules.ml index 0bdf533424ff..757660a5936e 100644 --- a/src/dune_rules/gen_rules.ml +++ b/src/dune_rules/gen_rules.ml @@ -68,90 +68,86 @@ end = struct let of_stanza stanza ~sctx ~src_dir ~ctx_dir ~scope ~dir_contents ~expander ~files_to_install = let dir = ctx_dir in - let rec go stanza = - match stanza with - | Toplevel toplevel -> - let+ () = Toplevel_rules.setup ~sctx ~dir ~toplevel in - empty_none - | Library lib - when Lib.DB.available (Scope.libs scope) - (Dune_file.Library.best_name lib) -> - let+ cctx, merlin = - Lib_rules.rules lib ~sctx ~dir ~scope ~dir_contents ~expander - in - { merlin = Some merlin - ; cctx = Some (lib.buildable.loc, cctx) - ; js = None - ; source_dirs = None - } - | Foreign_library lib -> - let+ () = - Lib_rules.foreign_rules lib ~sctx ~dir ~dir_contents ~expander + match stanza with + | Toplevel toplevel -> + let+ () = Toplevel_rules.setup ~sctx ~dir ~toplevel in + empty_none + | Library lib + when Lib.DB.available (Scope.libs scope) (Dune_file.Library.best_name lib) + -> + let+ cctx, merlin = + Lib_rules.rules lib ~sctx ~dir ~scope ~dir_contents ~expander + in + { merlin = Some merlin + ; cctx = Some (lib.buildable.loc, cctx) + ; js = None + ; source_dirs = None + } + | Foreign_library lib -> + let+ () = + Lib_rules.foreign_rules lib ~sctx ~dir ~dir_contents ~expander + in + empty_none + | Executables exes -> ( + Expander.eval_blang expander exes.enabled_if >>= function + | false -> Memo.Build.return empty_none + | true -> + let* () = + Memo.Build.Option.iter exes.install_conf ~f:files_to_install in - empty_none - | Executables exes -> ( - Expander.eval_blang expander exes.enabled_if >>= function - | false -> Memo.Build.return empty_none - | true -> - let* () = - Memo.Build.Option.iter exes.install_conf ~f:files_to_install - in - let+ cctx, merlin = - Exe_rules.rules exes ~sctx ~dir ~scope ~expander ~dir_contents - in - { merlin = Some merlin - ; cctx = Some (exes.buildable.loc, cctx) - ; js = - Some - (List.concat_map exes.names ~f:(fun (_, exe) -> - List.map - [ exe ^ ".bc.js"; exe ^ ".bc.runtime.js" ] - ~f:(Path.Build.relative dir))) - ; source_dirs = None - }) - | Alias alias -> - let+ () = Simple_rules.alias sctx alias ~dir ~expander in - empty_none - | Tests tests -> let+ cctx, merlin = - Test_rules.rules tests ~sctx ~dir ~scope ~expander ~dir_contents + Exe_rules.rules exes ~sctx ~dir ~scope ~expander ~dir_contents in { merlin = Some merlin - ; cctx = Some (tests.exes.buildable.loc, cctx) - ; js = None - ; source_dirs = None - } - | Copy_files { files = glob; _ } -> - let* source_dirs = - let loc = String_with_vars.loc glob in - let+ src_glob = Expander.No_deps.expand_str expander glob in - if Filename.is_relative src_glob then + ; cctx = Some (exes.buildable.loc, cctx) + ; js = Some - (Path.Source.relative src_dir src_glob ~error_loc:loc - |> Path.Source.parent_exn) - else - None - in - Memo.Build.return { merlin = None; cctx = None; js = None; source_dirs } - | Install i -> - let+ () = files_to_install i in - empty_none - | Plugin p -> - let+ () = Plugin_rules.setup_rules ~sctx ~dir p in - empty_none - | Cinaps.T cinaps -> - let+ () = Cinaps.gen_rules sctx cinaps ~dir ~scope in - empty_none - | Mdx.T mdx -> ( - Expander.eval_blang expander (Mdx.enabled_if mdx) >>= function - | false -> Memo.Build.return empty_none - | true -> - let+ () = Mdx.gen_rules ~sctx ~dir ~expander mdx in - empty_none) - | Package_proxy.T { stanza; _ } -> go stanza - | _ -> Memo.Build.return empty_none - in - go stanza + (List.concat_map exes.names ~f:(fun (_, exe) -> + List.map + [ exe ^ ".bc.js"; exe ^ ".bc.runtime.js" ] + ~f:(Path.Build.relative dir))) + ; source_dirs = None + }) + | Alias alias -> + let+ () = Simple_rules.alias sctx alias ~dir ~expander in + empty_none + | Tests tests -> + let+ cctx, merlin = + Test_rules.rules tests ~sctx ~dir ~scope ~expander ~dir_contents + in + { merlin = Some merlin + ; cctx = Some (tests.exes.buildable.loc, cctx) + ; js = None + ; source_dirs = None + } + | Copy_files { files = glob; _ } -> + let* source_dirs = + let loc = String_with_vars.loc glob in + let+ src_glob = Expander.No_deps.expand_str expander glob in + if Filename.is_relative src_glob then + Some + (Path.Source.relative src_dir src_glob ~error_loc:loc + |> Path.Source.parent_exn) + else + None + in + Memo.Build.return { merlin = None; cctx = None; js = None; source_dirs } + | Install i -> + let+ () = files_to_install i in + empty_none + | Plugin p -> + let+ () = Plugin_rules.setup_rules ~sctx ~dir p in + empty_none + | Cinaps.T cinaps -> + let+ () = Cinaps.gen_rules sctx cinaps ~dir ~scope in + empty_none + | Mdx.T mdx -> ( + Expander.eval_blang expander (Mdx.enabled_if mdx) >>= function + | false -> Memo.Build.return empty_none + | true -> + let+ () = Mdx.gen_rules ~sctx ~dir ~expander mdx in + empty_none) + | _ -> Memo.Build.return empty_none let of_stanzas stanzas ~cctxs ~sctx ~src_dir ~ctx_dir ~scope ~dir_contents ~expander ~files_to_install = diff --git a/src/dune_rules/mdx.ml b/src/dune_rules/mdx.ml index 7f57dfd043d3..371c85184cc3 100644 --- a/src/dune_rules/mdx.ml +++ b/src/dune_rules/mdx.ml @@ -127,6 +127,7 @@ type t = ; packages : (Loc.t * Package.Name.t) list ; preludes : Prelude.t list ; enabled_if : Blang.t + ; package : Package.t option } let enabled_if t = t.enabled_if @@ -157,17 +158,13 @@ let decode = Stanza_common.Pkg.field_opt () ~check:(Dune_lang.Syntax.since Stanza.syntax (2, 9)) in - (package, { loc; files; packages; preludes; enabled_if })) + { loc; files; packages; preludes; enabled_if; package }) let () = let open Dune_lang.Decoder in let decode = Dune_lang.Syntax.since Stanza.syntax (2, 4) >>> decode in Dune_project.Extension.register_simple syntax - (return - [ ( "mdx" - , decode >>| fun (package, x) -> - [ Dune_file.Package_proxy.T { package; stanza = T x } ] ) - ]) + (return [ ("mdx", decode >>| fun x -> [ T x ]) ]) (** Returns the list of files (in _build) to be passed to mdx for the given stanza and context *) @@ -235,10 +232,22 @@ let gen_rules_for_single_file stanza ~sctx ~dir ~expander ~mdx_prog src = (** Generates the rules for a given mdx stanza *) let gen_rules t ~sctx ~dir ~expander = let open Memo.Build.O in - let* files_to_mdx = files_to_mdx t ~sctx ~dir - and* mdx_prog = - Super_context.resolve_program sctx ~dir ~loc:(Some t.loc) - ~hint:"opam install mdx" "ocaml-mdx" + let register_rules () = + let* files_to_mdx = files_to_mdx t ~sctx ~dir + and* mdx_prog = + Super_context.resolve_program sctx ~dir ~loc:(Some t.loc) + ~hint:"opam install mdx" "ocaml-mdx" + in + Memo.Build.parallel_iter files_to_mdx + ~f:(gen_rules_for_single_file t ~sctx ~dir ~expander ~mdx_prog) + in + let* only_packages = Only_packages.get () in + let do_it = + match (only_packages, t.package) with + | None, _ + | Some _, None -> + true + | Some only, Some stanza_package -> + Package.Name.Map.mem only (Package.name stanza_package) in - Memo.Build.parallel_iter files_to_mdx - ~f:(gen_rules_for_single_file t ~sctx ~dir ~expander ~mdx_prog) + Memo.Build.if_ do_it register_rules