From 995a110dd1b2de5b60bcb35f6ac77e3e7a754955 Mon Sep 17 00:00:00 2001 From: Antonio Nuno Monteiro Date: Wed, 29 Mar 2023 17:11:21 -0700 Subject: [PATCH] Revert "fix(x-compilation): find host ppx dependencies in the host context (#7415)" This reverts commit 16a7e883ef2b2283f8a636fbf2c8bade3da92754. --- CHANGES.md | 3 - src/dune_rules/buildable_rules.ml | 5 +- src/dune_rules/cinaps.ml | 2 +- src/dune_rules/expander.ml | 2 - src/dune_rules/expander.mli | 2 - src/dune_rules/jsoo/jsoo_rules.ml | 2 +- src/dune_rules/lib.ml | 22 ++--- src/dune_rules/lib.mli | 3 +- src/dune_rules/preprocessing.ml | 3 +- src/dune_rules/preprocessing.mli | 1 + src/dune_rules/scope.ml | 89 ++++++------------- src/dune_rules/toplevel.ml | 2 +- src/dune_rules/utop.ml | 2 +- .../ppx-cross-context-issue.t/run.t | 28 +++--- 14 files changed, 57 insertions(+), 109 deletions(-) diff --git a/CHANGES.md b/CHANGES.md index 3749d4cb0b67..010654a9f497 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -12,9 +12,6 @@ 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 56d7f053aa4d..7cf1ba7e5ac8 100644 --- a/src/dune_rules/buildable_rules.ml +++ b/src/dune_rules/buildable_rules.ml @@ -56,8 +56,9 @@ let modules_rules ~preprocess ~preprocessor_deps ~lint (Preprocess.Per_module.instrumentation_deps preprocess ~instrumentation_backend) in - Preprocessing.make sctx ~dir ~preprocess:preprocess_with_instrumentation - ~expander ~preprocessor_deps ~instrumentation_deps ~lint ~lib_name + Preprocessing.make sctx ~dir ~scope + ~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 eee455d5fa2a..593ac8c9ee0e 100644 --- a/src/dune_rules/cinaps.ml +++ b/src/dune_rules/cinaps.ml @@ -120,7 +120,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 + ~instrumentation_deps:[] ~lib_name:None ~scope in let* modules = Modules.singleton_exe module_ diff --git a/src/dune_rules/expander.ml b/src/dune_rules/expander.ml index ee69ad74338a..64381c9ca6f2 100644 --- a/src/dune_rules/expander.ml +++ b/src/dune_rules/expander.ml @@ -65,8 +65,6 @@ 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 7b9fe2142161..093f07082b6a 100644 --- a/src/dune_rules/expander.mli +++ b/src/dune_rules/expander.mli @@ -6,8 +6,6 @@ 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 028b2187cd7e..952bc4a9d138 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 ~host:None ctx in + let* installed_libs = Lib.DB.installed 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 635c966127a8..e651aea8e415 100644 --- a/src/dune_rules/lib.ml +++ b/src/dune_rules/lib.ml @@ -372,7 +372,6 @@ 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 @@ -1287,15 +1286,8 @@ 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_host (loc, name) ~private_deps:Allow_all - in + let* lib = resolve_dep db (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) @@ -1737,12 +1729,12 @@ module DB = struct type t = db - let create ~parent ~host ~resolve ~all ~lib_config () = - { parent; host; resolve; all = Memo.lazy_ all; lib_config } + let create ~parent ~resolve ~all ~lib_config () = + { parent; resolve; all = Memo.lazy_ all; lib_config } - let create_from_findlib ~host findlib = + let create_from_findlib findlib = let lib_config = Findlib.lib_config findlib in - create () ~parent:None ~host ~lib_config + create () ~parent:None ~lib_config ~resolve:(fun name -> let open Memo.O in Findlib.find findlib name >>| function @@ -1758,12 +1750,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) ~host = + let installed (context : Context.t) = let open Memo.O in let+ findlib = Findlib.create ~paths:context.findlib_paths ~lib_config:context.lib_config in - create_from_findlib ~host findlib + create_from_findlib 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 8561611cd2d4..83f6a0cf0359 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 -> host:t Memo.Lazy.t option -> t Memo.t + val installed : Context.t -> t Memo.t module Resolve_result : sig type db := t @@ -124,7 +124,6 @@ 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 470ec91a4b46..d1294950609e 100644 --- a/src/dune_rules/preprocessing.ml +++ b/src/dune_rules/preprocessing.ml @@ -720,8 +720,7 @@ 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 = - let scope = Expander.scope_host expander in + ~instrumentation_deps ~lib_name ~scope = 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 5f845d16c393..e15a3f64d405 100644 --- a/src/dune_rules/preprocessing.mli +++ b/src/dune_rules/preprocessing.mli @@ -16,6 +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 (** 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 4d88906a10ed..147cba2ec453 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 ~host stanzas = + let create_db_from_stanzas ~parent ~lib_config 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) ~host + Lib.DB.create () ~parent:(Some parent) ~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 ~host stanzas = + let public_libs t ~installed_libs ~lib_config 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) ~host ~resolve + Lib.DB.create ~parent:(Some installed_libs) ~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 rec scopes_by_dir ~host_context ~build_dir ~lib_config ~projects - ~public_libs ~public_theories stanzas coq_stanzas = + let scopes_by_dir ~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,20 +273,8 @@ 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 ~host - ~lib_config + create_db_from_stanzas stanzas ~parent:public_libs ~lib_config in (project, db)) in @@ -310,47 +298,27 @@ module DB = struct let coq_db = coq_db_find dir in { project; db; coq_db; root }) - and create ~(context : Context.t) ~projects stanzas coq_stanzas = + let 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, 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) + let* public_libs = + let+ installed_libs = Lib.DB.installed context in + public_libs t ~lib_config ~installed_libs stanzas in let public_theories = public_theories coq_stanzas ~find_db:(fun _ -> public_libs) in let+ by_dir = - scopes_by_dir ~host_context ~build_dir ~lib_config ~projects ~public_libs + scopes_by_dir ~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) - and from_stanzas ~projects ~(context : Context.t) stanzas = + let create_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) -> @@ -372,23 +340,22 @@ module DB = struct in create ~projects ~context stanzas coq_stanzas - 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 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 create_from_stanzas (context : Context.t) = - let* all = Memo.Lazy.force (Lazy.force all) in + let create_from_stanzas (context : Context.t) = + let* all = Memo.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 d9bb2576874d..5659027ade03 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 ~lib_name:None + Preprocessing.make sctx ~dir ~expander ~scope ~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 3102db8c54f6..3ce0f1f6b319 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 ~lib_name:None + Preprocessing.make sctx ~dir ~expander ~scope ~lib_name:None ~lint:Dune_file.Lint.no_lint ~preprocess ~preprocessor_deps:[] ~instrumentation_deps:[] in diff --git a/test/blackbox-tests/test-cases/custom-cross-compilation/ppx-cross-context-issue.t/run.t b/test/blackbox-tests/test-cases/custom-cross-compilation/ppx-cross-context-issue.t/run.t index 1ecee22e5fc2..05cf21797f8f 100644 --- a/test/blackbox-tests/test-cases/custom-cross-compilation/ppx-cross-context-issue.t/run.t +++ b/test/blackbox-tests/test-cases/custom-cross-compilation/ppx-cross-context-issue.t/run.t @@ -1,16 +1,12 @@ -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 +# 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]