diff --git a/src/dune_rules/buildable_rules.ml b/src/dune_rules/buildable_rules.ml index 7cf1ba7e5ac8..49b7c4880f08 100644 --- a/src/dune_rules/buildable_rules.ml +++ b/src/dune_rules/buildable_rules.ml @@ -50,15 +50,14 @@ let modules_rules ~preprocess ~preprocessor_deps ~lint (Preprocess.Per_module.with_instrumentation preprocess ~instrumentation_backend) in - let+ instrumentation_deps = + let* instrumentation_deps = (* TODO wrong and blocks loading all the rules in this directory *) Resolve.Memo.read_memo (Preprocess.Per_module.instrumentation_deps preprocess ~instrumentation_backend) in - Preprocessing.make sctx ~dir ~scope - ~preprocess:preprocess_with_instrumentation ~expander ~preprocessor_deps - ~instrumentation_deps ~lint ~lib_name + Preprocessing.make sctx ~dir ~preprocess:preprocess_with_instrumentation + ~expander ~preprocessor_deps ~instrumentation_deps ~lint ~lib_name in let add_empty_intf = let default = empty_module_interface_if_absent in diff --git a/src/dune_rules/cinaps.ml b/src/dune_rules/cinaps.ml index 17e32e837bc8..d9c93d348600 100644 --- a/src/dune_rules/cinaps.ml +++ b/src/dune_rules/cinaps.ml @@ -110,11 +110,11 @@ let gen_rules sctx t ~dir ~scope = ; Deps (List.map cinapsed_files ~f:Path.build) ]) and* expander = Super_context.expander sctx ~dir in - let preprocess = + let* preprocess = Preprocessing.make sctx ~dir ~expander ~lint:(Preprocess.Per_module.no_preprocessing ()) ~preprocess:t.preprocess ~preprocessor_deps:t.preprocessor_deps - ~instrumentation_deps:[] ~lib_name:None ~scope + ~instrumentation_deps:[] ~lib_name:None in let* modules = Modules.singleton_exe module_ diff --git a/src/dune_rules/jsoo/jsoo_rules.ml b/src/dune_rules/jsoo/jsoo_rules.ml index 952bc4a9d138..028b2187cd7e 100644 --- a/src/dune_rules/jsoo/jsoo_rules.ml +++ b/src/dune_rules/jsoo/jsoo_rules.ml @@ -355,7 +355,7 @@ let setup_separate_compilation_rules sctx components = let pkg = Lib_name.parse_string_exn (Loc.none, s_pkg) in let ctx = Super_context.context sctx in let open Memo.O in - let* installed_libs = Lib.DB.installed ctx in + let* installed_libs = Lib.DB.installed ~host:None ctx in Lib.DB.find installed_libs pkg >>= function | None -> Memo.return () | Some pkg -> diff --git a/src/dune_rules/lib.ml b/src/dune_rules/lib.ml index e651aea8e415..bf44b2815e8f 100644 --- a/src/dune_rules/lib.ml +++ b/src/dune_rules/lib.ml @@ -372,6 +372,7 @@ end type db = { parent : db option + ; db_host : db Lazy.t ; resolve : Lib_name.t -> resolve_result Memo.t ; all : Lib_name.t list Memo.Lazy.t ; lib_config : Lib_config.t @@ -1287,7 +1288,10 @@ end = struct let pps = let* pps = Resolve.Memo.List.map pps ~f:(fun (loc, name) -> - let* lib = resolve_dep db (loc, name) ~private_deps:Allow_all in + let* lib = + resolve_dep (Lazy.force db.db_host) (loc, name) + ~private_deps:Allow_all + in match (allow_only_ppx_deps, Lib_info.kind lib.info) with | true, Normal -> Error.only_ppx_deps_allowed ~loc lib.info | _ -> Resolve.Memo.return lib) @@ -1729,12 +1733,24 @@ module DB = struct type t = db - let create ~parent ~resolve ~all ~lib_config () = - { parent; resolve; all = Memo.lazy_ all; lib_config } + let create ~parent ~host ~resolve ~all ~lib_config () = + let rec t = + lazy + { parent + ; db_host = + (match host with + | Some host -> Lazy.from_val host + | None -> t) + ; resolve + ; all = Memo.lazy_ all + ; lib_config + } + in + Lazy.force t - let create_from_findlib findlib = + let create_from_findlib ~host findlib = let lib_config = Findlib.lib_config findlib in - create () ~parent:None ~lib_config + create () ~parent:None ~host ~lib_config ~resolve:(fun name -> let open Memo.O in Findlib.find findlib name >>| function @@ -1750,12 +1766,12 @@ module DB = struct let open Memo.O in Findlib.all_packages findlib >>| List.map ~f:Dune_package.Entry.name) - let installed (context : Context.t) = + let installed (context : Context.t) ~host = let open Memo.O in let+ findlib = Findlib.create ~paths:context.findlib_paths ~lib_config:context.lib_config in - create_from_findlib findlib + create_from_findlib ~host findlib let find t name = let open Memo.O in diff --git a/src/dune_rules/lib.mli b/src/dune_rules/lib.mli index 83f6a0cf0359..9f6f909af9bd 100644 --- a/src/dune_rules/lib.mli +++ b/src/dune_rules/lib.mli @@ -99,7 +99,7 @@ module DB : sig (** A database allow to resolve library names *) type t = db - val installed : Context.t -> t Memo.t + val installed : Context.t -> host:t option -> t Memo.t module Resolve_result : sig type db := t @@ -124,6 +124,7 @@ module DB : sig [all] returns the list of names of libraries available in this database. *) val create : parent:t option + -> host:t option -> resolve:(Lib_name.t -> Resolve_result.t Memo.t) -> all:(unit -> Lib_name.t list Memo.t) -> lib_config:Lib_config.t diff --git a/src/dune_rules/preprocessing.ml b/src/dune_rules/preprocessing.ml index d1294950609e..e0dee812d7db 100644 --- a/src/dune_rules/preprocessing.ml +++ b/src/dune_rules/preprocessing.ml @@ -720,7 +720,17 @@ let pp_one_module sctx ~lib_name ~scope ~preprocessor_deps >>| Action.Full.add_sandbox sandbox)))) let make sctx ~dir ~expander ~lint ~preprocess ~preprocessor_deps - ~instrumentation_deps ~lib_name ~scope = + ~instrumentation_deps ~lib_name = + let+ scope = + let ctx_dir = + let host_build_dir = + (Super_context.context sctx |> Context.host).build_dir + in + let segment = Path.Build.drop_build_context_exn dir in + Path.Build.append_source host_build_dir segment + in + Scope.DB.find_by_dir ctx_dir + in let preprocessor_deps = preprocessor_deps @ instrumentation_deps in let preprocess = Module_name.Per_item.map preprocess ~f:(fun pp -> diff --git a/src/dune_rules/preprocessing.mli b/src/dune_rules/preprocessing.mli index e15a3f64d405..8d1e6edfc6d9 100644 --- a/src/dune_rules/preprocessing.mli +++ b/src/dune_rules/preprocessing.mli @@ -16,8 +16,7 @@ val make : -> preprocessor_deps:Dep_conf.t list -> instrumentation_deps:Dep_conf.t list -> lib_name:Lib_name.Local.t option - -> scope:Scope.t - -> Pp_spec.t + -> Pp_spec.t Memo.t (** Get a path to a cached ppx driver with some extra flags for cookies. *) val get_ppx_driver : diff --git a/src/dune_rules/scope.ml b/src/dune_rules/scope.ml index 147cba2ec453..d711e3ae8e46 100644 --- a/src/dune_rules/scope.ml +++ b/src/dune_rules/scope.ml @@ -77,7 +77,7 @@ module DB = struct | Deprecated_library_name of Dune_file.Deprecated_library_name.t end - let create_db_from_stanzas ~parent ~lib_config stanzas = + let create_db_from_stanzas ~parent ~lib_config ~host stanzas = let open Memo.O in let+ (map : Found_or_redirect.t Lib_name.Map.t) = Memo.List.map stanzas ~f:(fun stanza -> @@ -132,7 +132,7 @@ module DB = struct ; Pp.textf "- %s" (Loc.to_file_colon_line loc2) ]) in - Lib.DB.create () ~parent:(Some parent) + Lib.DB.create () ~parent:(Some parent) ~host ~resolve:(fun name -> Memo.return (match Lib_name.Map.find map name with @@ -165,7 +165,7 @@ module DB = struct lazy (public_theories ~find_db coq_stanzas) (* Create a database from the public libraries defined in the stanzas *) - let public_libs t ~installed_libs ~lib_config stanzas = + let public_libs t ~installed_libs ~lib_config ~host stanzas = let public_libs = List.filter_map stanzas ~f:(fun (stanza : Library_related_stanza.t) -> match stanza with @@ -213,7 +213,7 @@ module DB = struct ]) in let resolve lib = Memo.return (resolve t public_libs lib) in - Lib.DB.create ~parent:(Some installed_libs) ~resolve + Lib.DB.create ~parent:(Some installed_libs) ~host ~resolve ~all:(fun () -> Lib_name.Map.keys public_libs |> Memo.return) ~lib_config () @@ -246,8 +246,8 @@ module DB = struct |> Coq_lib.DB.create_from_coqlib_stanzas ~parent ~find_db |> Option.some) - let scopes_by_dir ~build_dir ~lib_config ~projects ~public_libs - ~public_theories stanzas coq_stanzas = + let rec scopes_by_dir ~host_context ~build_dir ~lib_config ~projects + ~public_libs ~public_theories stanzas coq_stanzas = let open Memo.O in let projects_by_dir = List.map projects ~f:(fun (project : Dune_project.t) -> @@ -273,10 +273,24 @@ module DB = struct Some (project, stanzas)) |> Path_source_map_traversals.parallel_map ~f:(fun _dir (project, stanzas) -> - let+ db = - create_db_from_stanzas stanzas ~parent:public_libs ~lib_config - in - (project, db)) + match host_context with + | None -> + let+ db = + create_db_from_stanzas stanzas ~parent:public_libs ~host:None + ~lib_config + in + (project, db) + | Some host_context -> + let* scopes, public_libs = create_from_stanzas host_context in + let host = + let scope = find_by_project scopes project in + scope.db + in + let+ db = + create_db_from_stanzas stanzas ~parent:public_libs + ~host:(Some host) ~lib_config + in + (project, db)) in let coq_scopes_by_dir = @@ -298,27 +312,49 @@ module DB = struct let coq_db = coq_db_find dir in { project; db; coq_db; root }) - let create ~(context : Context.t) ~projects stanzas coq_stanzas = + and create ~(context : Context.t) ~projects stanzas coq_stanzas = let open Memo.O in let t = Fdecl.create Dyn.opaque in let build_dir = context.build_dir in let lib_config = Context.lib_config context in - let* public_libs = - let+ installed_libs = Lib.DB.installed context in - public_libs t ~lib_config ~installed_libs stanzas + let* public_libs, host_context = + let host_context = + let host_context = Context.host context in + match Context.equal host_context context with + | true -> None + | false -> Some host_context + in + let+ public_libs = + match host_context with + | None -> + let host = None in + let+ installed_libs = Lib.DB.installed ~host context in + public_libs t ~lib_config ~installed_libs ~host stanzas + | Some host_context -> + let* host = + let+ host = + let+ installed_libs = Lib.DB.installed ~host:None host_context in + public_libs t ~lib_config ~installed_libs ~host:None stanzas + in + Some host + in + let+ installed_libs = Lib.DB.installed ~host context in + public_libs t ~lib_config ~installed_libs ~host stanzas + in + (public_libs, host_context) in let public_theories = public_theories coq_stanzas ~find_db:(fun _ -> public_libs) in let+ by_dir = - scopes_by_dir ~build_dir ~lib_config ~projects ~public_libs + scopes_by_dir ~host_context ~build_dir ~lib_config ~projects ~public_libs ~public_theories stanzas coq_stanzas in let value = { by_dir } in Fdecl.set t value; (value, public_libs) - let create_from_stanzas ~projects ~(context : Context.t) stanzas = + and from_stanzas ~projects ~(context : Context.t) stanzas = let stanzas, coq_stanzas = Dune_file.fold_stanzas stanzas ~init:([], []) ~f:(fun dune_file stanza (acc, coq_acc) -> @@ -340,22 +376,23 @@ module DB = struct in create ~projects ~context stanzas coq_stanzas - let all = - Memo.Lazy.create @@ fun () -> - let+ contexts = Context.DB.all () in - Context_name.Map.of_list_map_exn contexts ~f:(fun context -> - let scopes = - Memo.Lazy.create @@ fun () -> - let* { Dune_load.dune_files = _; packages = _; projects } = - Dune_load.load () - in - let* stanzas = Only_packages.filtered_stanzas context in - create_from_stanzas ~projects ~context stanzas - in - (context.name, scopes)) + and all = + lazy + ( Memo.Lazy.create @@ fun () -> + let+ contexts = Context.DB.all () in + Context_name.Map.of_list_map_exn contexts ~f:(fun context -> + let scopes = + Memo.Lazy.create @@ fun () -> + let* { Dune_load.dune_files = _; packages = _; projects } = + Dune_load.load () + in + let* stanzas = Only_packages.filtered_stanzas context in + from_stanzas ~projects ~context stanzas + in + (context.name, scopes)) ) - let create_from_stanzas (context : Context.t) = - let* all = Memo.Lazy.force all in + and create_from_stanzas (context : Context.t) = + let* all = Memo.Lazy.force (Lazy.force all) in Context_name.Map.find_exn all context.name |> Memo.Lazy.force let with_all context ~f = diff --git a/src/dune_rules/toplevel.ml b/src/dune_rules/toplevel.ml index 5659027ade03..e19ed7e2bd48 100644 --- a/src/dune_rules/toplevel.ml +++ b/src/dune_rules/toplevel.ml @@ -161,9 +161,9 @@ module Stanza = struct | Action _ | Future_syntax _ -> assert false (* Error in parsing *) | No_preprocessing -> [] in - let preprocessing = + let* preprocessing = let preprocess = Module_name.Per_item.for_all toplevel.pps in - Preprocessing.make sctx ~dir ~expander ~scope ~lib_name:None + Preprocessing.make sctx ~dir ~expander ~lib_name:None ~lint:Dune_file.Lint.no_lint ~preprocess ~preprocessor_deps:[] ~instrumentation_deps:[] in diff --git a/src/dune_rules/utop.ml b/src/dune_rules/utop.ml index 3ce0f1f6b319..599aa62ffa24 100644 --- a/src/dune_rules/utop.ml +++ b/src/dune_rules/utop.ml @@ -141,9 +141,9 @@ let setup sctx ~dir = if List.is_empty pps then Preprocess.No_preprocessing else Preprocess.Pps { loc = Loc.none; pps; flags = []; staged = false } in - let preprocessing = + let* preprocessing = let preprocess = Module_name.Per_item.for_all pps in - Preprocessing.make sctx ~dir ~expander ~scope ~lib_name:None + Preprocessing.make sctx ~dir ~expander ~lib_name:None ~lint:Dune_file.Lint.no_lint ~preprocess ~preprocessor_deps:[] ~instrumentation_deps:[] in diff --git a/test/blackbox-tests/test-cases/ppx-cross-context-issue.t/ppx/dune b/test/blackbox-tests/test-cases/ppx-cross-context-issue.t/ppx/dune index ce61f561fcea..3aeaa66c6086 100644 --- a/test/blackbox-tests/test-cases/ppx-cross-context-issue.t/ppx/dune +++ b/test/blackbox-tests/test-cases/ppx-cross-context-issue.t/ppx/dune @@ -1,5 +1,6 @@ (library (name fooppx) - (enabled_if (= %{context_name} "default")) + (enabled_if + (= %{context_name} "default")) (kind ppx_rewriter) (libraries ppxlib)) diff --git a/test/blackbox-tests/test-cases/ppx-cross-context-issue.t/run.t b/test/blackbox-tests/test-cases/ppx-cross-context-issue.t/run.t index 05cf21797f8f..abe2650375d3 100644 --- a/test/blackbox-tests/test-cases/ppx-cross-context-issue.t/run.t +++ b/test/blackbox-tests/test-cases/ppx-cross-context-issue.t/run.t @@ -1,12 +1,29 @@ -# Using a ppx in a cross-compiled build context makes dune try to build the ppx -# in the target context instead of the host, then fail. - $ dune build --debug-dependency-path - File "lib/dune", line 3, characters 18-24: - 3 | (preprocess (pps fooppx))) - ^^^^^^ - Error: Library "fooppx" in _build/cross-environment/ppx is hidden - (unsatisfied 'enabled_if'). - -> required by _build/cross-environment/lib/lib.pp.ml - -> required by alias lib/all (context cross-environment) - -> required by alias default (context cross-environment) - [1] +Dune uses the host context to look up dependencies and build PPXes + + $ dune build --display=short + ocamlc lib/.foolib.objs/byte/foolib.{cmi,cmo,cmt} + ocamlc ppx/.fooppx.objs/byte/fooppx.{cmi,cmo,cmt} + ocamlc lib/.foolib.objs/byte/foolib.{cmi,cmo,cmt} [cross-environment] + ocamlopt lib/.foolib.objs/native/foolib.{cmx,o} + ocamlc .ppx/4128e43a9cfb141a37f547484cc9bf46/dune__exe___ppx.{cmi,cmo} + ocamlopt ppx/.fooppx.objs/native/fooppx.{cmx,o} + ocamlc ppx/fooppx.cma + ocamlopt lib/.foolib.objs/native/foolib.{cmx,o} [cross-environment] + ocamlopt .ppx/4128e43a9cfb141a37f547484cc9bf46/dune__exe___ppx.{cmx,o} + ocamlopt ppx/fooppx.{a,cmxa} + ocamlopt .ppx/4128e43a9cfb141a37f547484cc9bf46/ppx.exe + ocamlopt ppx/fooppx.cmxs + ppx lib/lib.pp.ml + ppx lib/lib.pp.ml [cross-environment] + ocamldep lib/.foolib.objs/foolib__Lib.impl.d + ocamldep lib/.foolib.objs/foolib__Lib.impl.d [cross-environment] + ocamlc lib/.foolib.objs/byte/foolib__Lib.{cmi,cmo,cmt} + ocamlc lib/.foolib.objs/byte/foolib__Lib.{cmi,cmo,cmt} [cross-environment] + ocamlopt lib/.foolib.objs/native/foolib__Lib.{cmx,o} + ocamlc lib/foolib.cma + ocamlopt lib/.foolib.objs/native/foolib__Lib.{cmx,o} [cross-environment] + ocamlc lib/foolib.cma [cross-environment] + ocamlopt lib/foolib.{a,cmxa} + ocamlopt lib/foolib.{a,cmxa} [cross-environment] + ocamlopt lib/foolib.cmxs + ocamlopt lib/foolib.cmxs [cross-environment]