Revert "fix(x-compilation): find host ppx dependencies in the host co…

…ntext (ocaml#7415)"

This reverts commit 16a7e88.

CHANGES.md

@@ -27,7 +27,7 @@ Unreleased
   (#7757, @gpetiot)
 
 - Revert #7450 "Resolve `ppx_runtime_libraries` in the target context when
-  cross compiling"
+  cross compiling", #7415.
 
 3.8.0 (2023-05-23)
 ------------------
@@ -85,7 +85,7 @@ Unreleased
 - Fix `dune install` when cross compiling (#7410, fixes #6191, @anmonteiro,
   @rizo)
 
-- Find `pps` dependencies in the host context when cross-compiling,  (#7410,
+- Find `pps` dependencies in the host context when cross-compiling,  (#7415,
   fixes #4156, @anmonteiro)
 
 - Dune in watch mode no longer builds concurrent rules in serial (#7395

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

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_

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

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

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 ->

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
@@ -1284,15 +1283,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)
@@ -1733,12 +1725,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
@@ -1754,12 +1746,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

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

src/dune_rules/preprocessing.ml

@@ -715,8 +715,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 ->

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. *)

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
@@ -163,7 +163,7 @@ module DB = struct
          ~parent:(Some installed_theories)
 
   (* 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
@@ -211,7 +211,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 ()
 
@@ -241,8 +241,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 =
       Path.Source.Map.of_list_map_exn projects ~f:(fun project ->
@@ -267,20 +267,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
@@ -300,34 +288,14 @@ 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 =
       let installed_theories =
@@ -342,14 +310,14 @@ module DB = struct
             ~installed_theories coq_stanzas)
     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) ->
@@ -371,23 +339,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 =

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

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

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]