diff --git a/CHANGES.md b/CHANGES.md index d2003a50782..442d9d0ca5e 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -4,6 +4,9 @@ Unreleased - Fix `dune install` when cross compiling (#7410, fixes #6191, @anmonteiro, @rizo) +- Find `pps` dependencies in the host context when cross-compiling, (#7410, + fixes #4156, @anmonteiro) + - Dune in watch mode no longer builds concurrent rules in serial (#7395 @rgrinberg, @jchavarri) diff --git a/src/dune_rules/buildable_rules.ml b/src/dune_rules/buildable_rules.ml index 7cf1ba7e5ac..56d7f053aa4 100644 --- a/src/dune_rules/buildable_rules.ml +++ b/src/dune_rules/buildable_rules.ml @@ -56,9 +56,8 @@ let modules_rules ~preprocess ~preprocessor_deps ~lint (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 17e32e837bc..0aee7b16eda 100644 --- a/src/dune_rules/cinaps.ml +++ b/src/dune_rules/cinaps.ml @@ -114,7 +114,7 @@ let gen_rules sctx t ~dir ~scope = 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/expander.ml b/src/dune_rules/expander.ml index 64381c9ca6f..ee69ad74338 100644 --- a/src/dune_rules/expander.ml +++ b/src/dune_rules/expander.ml @@ -65,6 +65,8 @@ type t = let scope t = t.scope +let scope_host t = t.scope_host + let artifacts t = t.bin_artifacts_host let dir t = t.dir diff --git a/src/dune_rules/expander.mli b/src/dune_rules/expander.mli index 093f07082b6..7b9fe214216 100644 --- a/src/dune_rules/expander.mli +++ b/src/dune_rules/expander.mli @@ -6,6 +6,8 @@ type t val scope : t -> Scope.t +val scope_host : t -> Scope.t + val dir : t -> Path.Build.t val context : t -> Context.t diff --git a/src/dune_rules/jsoo/jsoo_rules.ml b/src/dune_rules/jsoo/jsoo_rules.ml index 952bc4a9d13..028b2187cd7 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 e651aea8e41..635c966127a 100644 --- a/src/dune_rules/lib.ml +++ b/src/dune_rules/lib.ml @@ -372,6 +372,7 @@ end type db = { parent : db option + ; host : db Memo.Lazy.t option ; resolve : Lib_name.t -> resolve_result Memo.t ; all : Lib_name.t list Memo.Lazy.t ; lib_config : Lib_config.t @@ -1286,8 +1287,15 @@ end = struct in let pps = let* pps = + let* db_host = + match db.host with + | None -> Resolve.Memo.return db + | Some host -> Resolve.Memo.lift_memo (Memo.Lazy.force host) + in 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 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 +1737,12 @@ 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 () = + { parent; host; resolve; all = Memo.lazy_ all; lib_config } - 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 +1758,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 83f6a0cf035..8561611cd2d 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 Memo.Lazy.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 Memo.Lazy.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 d1294950609..470ec91a4b4 100644 --- a/src/dune_rules/preprocessing.ml +++ b/src/dune_rules/preprocessing.ml @@ -720,7 +720,8 @@ 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 = Expander.scope_host expander 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 e15a3f64d40..5f845d16c39 100644 --- a/src/dune_rules/preprocessing.mli +++ b/src/dune_rules/preprocessing.mli @@ -16,7 +16,6 @@ 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 (** Get a path to a cached ppx driver with some extra flags for cookies. *) diff --git a/src/dune_rules/scope.ml b/src/dune_rules/scope.ml index 147cba2ec45..4d88906a10e 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,8 +273,20 @@ module DB = struct Some (project, stanzas)) |> Path_source_map_traversals.parallel_map ~f:(fun _dir (project, stanzas) -> + let host = + Option.map host_context ~f:(fun host_context -> + Memo.Lazy.create @@ fun () -> + let+ scope = + let+ scopes, _public_libs_host = + create_from_stanzas host_context + in + find_by_project scopes project + in + scope.db) + in let+ db = - create_db_from_stanzas stanzas ~parent:public_libs ~lib_config + create_db_from_stanzas stanzas ~parent:public_libs ~host + ~lib_config in (project, db)) in @@ -298,27 +310,47 @@ 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 + Option.some_if (not (Context.equal context host_context)) host_context + in + let+ public_libs = + match host_context with + | None -> + let+ installed_libs = Lib.DB.installed ~host:None context in + public_libs t ~lib_config ~installed_libs ~host:None stanzas + | Some host_context -> + let host = + let host = + Memo.Lazy.create @@ fun () -> + 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 +372,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 5659027ade0..d9bb2576874 100644 --- a/src/dune_rules/toplevel.ml +++ b/src/dune_rules/toplevel.ml @@ -163,7 +163,7 @@ module Stanza = struct in 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 3ce0f1f6b31..3102db8c54f 100644 --- a/src/dune_rules/utop.ml +++ b/src/dune_rules/utop.ml @@ -143,7 +143,7 @@ let setup sctx ~dir = in 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/run.t b/test/blackbox-tests/test-cases/ppx-cross-context-issue.t/run.t index 05cf21797f8..1ecee22e5fc 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,16 @@ -# 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 + +PPX is only built in the host context + + $ ls _build/cross-environment/ppx + dune + fooppx.ml + $ ls _build/default/ppx + dune + fooppx.a + fooppx.cma + fooppx.cmxa + fooppx.cmxs + fooppx.ml