diff --git a/src/dune_rules/context.ml b/src/dune_rules/context.ml index 6aa847c0fe2..05ffa499587 100644 --- a/src/dune_rules/context.ml +++ b/src/dune_rules/context.ml @@ -97,16 +97,14 @@ module T = struct ; supports_shared_libraries : Dynlink_supported.By_the_os.t ; which : string -> Path.t option ; lib_config : Lib_config.t + ; build_context : Build_context.t } let equal x y = Context_name.equal x.name y.name let hash t = Context_name.hash t.name - let rec to_build_context - { name; build_dir; env; for_host; stdlib_dir; default_ocamlpath; _ } = - Build_context.create ~name ~build_dir ~env ~stdlib_dir ~default_ocamlpath - ~host:(Option.map ~f:to_build_context for_host) + let build_context t = t.build_context let to_dyn t : Dyn.t = let open Dyn.Encoder in @@ -419,7 +417,7 @@ let create ~(kind : Kind.t) ~path ~env ~env_nodes ~name ~merlin ~targets | Error (Makefile_config file, msg) -> User_error.raise ~loc:(Loc.in_file file) [ Pp.text msg ] in - let* default_findlib_paths, (ocaml_config_vars, ocfg) = + let* default_ocamlpath, (ocaml_config_vars, ocfg) = Fiber.fork_and_join default_findlib_paths (fun () -> let+ lines = Process.run_capture_lines ~env Strict ocamlc [ "-config" ] @@ -432,7 +430,7 @@ let create ~(kind : Kind.t) ~path ~env ~env_nodes ~name ~merlin ~targets (vars, ocfg) | Error msg -> Error (Ocamlc_config, msg) )) in - let findlib_paths = ocamlpath @ default_findlib_paths in + let findlib_paths = ocamlpath @ default_ocamlpath in let version = Ocaml_version.of_ocaml_config ocfg in let env = (* See comment in ansi_color.ml for setup_env_for_colors. For versions @@ -473,7 +471,7 @@ let create ~(kind : Kind.t) ~path ~env ~env_nodes ~name ~merlin ~targets ; ( "DUNE_OCAML_HARDCODED" , String.concat ~sep:(Char.escaped ocamlpath_sep) - (List.map ~f:Path.to_string default_findlib_paths) ) + (List.map ~f:Path.to_string default_ocamlpath) ) ; extend_var "OCAMLTOP_INCLUDE_PATH" (Path.Build.relative local_lib_root "toplevel") ; extend_var "OCAMLFIND_IGNORE_DUPS_IN" ~path_sep:ocamlpath_sep @@ -545,6 +543,11 @@ let create ~(kind : Kind.t) ~path ~env ~env_nodes ~name ~merlin ~targets supports_shared_libraries && dynamically_linked_foreign_archives in let t = + let build_context = + Build_context.create ~name ~build_dir ~env ~stdlib_dir + ~default_ocamlpath + ~host:(Option.map host ~f:(fun c -> c.build_context)) + in { name ; implicit ; kind @@ -570,7 +573,7 @@ let create ~(kind : Kind.t) ~path ~env ~env_nodes ~name ~merlin ~targets ; env ; findlib = Findlib.create ~paths:findlib_paths ~lib_config ; findlib_toolchain - ; default_ocamlpath = default_findlib_paths + ; default_ocamlpath ; arch_sixtyfour ; install_prefix ; stdlib_dir @@ -581,6 +584,7 @@ let create ~(kind : Kind.t) ~path ~env ~env_nodes ~name ~merlin ~targets Dynlink_supported.By_the_os.of_bool supports_shared_libraries ; which ; lib_config + ; build_context } in if Ocaml_version.supports_response_file version then ( diff --git a/src/dune_rules/context.mli b/src/dune_rules/context.mli index 1ee014c0a7c..be8c29e78d5 100644 --- a/src/dune_rules/context.mli +++ b/src/dune_rules/context.mli @@ -94,6 +94,7 @@ type t = private (** Given a program name, e.g. ["ocaml"], find the path to a preferred executable in PATH, e.g. [Some "/path/to/ocaml.opt.exe"]. *) ; lib_config : Lib_config.t + ; build_context : Build_context.t } val equal : t -> t -> bool @@ -130,7 +131,7 @@ val lib_config : t -> Lib_config.t the host build context. Otherwise, it just returns [exe]. *) val map_exe : t -> Path.t -> Path.t -val to_build_context : t -> Build_context.t +val build_context : t -> Build_context.t val init_configurator : t -> unit diff --git a/src/dune_rules/dep_conf_eval.ml b/src/dune_rules/dep_conf_eval.ml index 1ae25cd7a84..824b73fff60 100644 --- a/src/dune_rules/dep_conf_eval.ml +++ b/src/dune_rules/dep_conf_eval.ml @@ -50,7 +50,7 @@ let dep expander = function | Some pkg -> Build.alias (Build_system.Alias.package_install - ~context:(Context.to_build_context context) + ~context:(Context.build_context context) ~pkg) | None -> Build.fail diff --git a/src/dune_rules/install_rules.ml b/src/dune_rules/install_rules.ml index 3d571e5d06c..a56732deaff 100644 --- a/src/dune_rules/install_rules.ml +++ b/src/dune_rules/install_rules.ml @@ -741,23 +741,20 @@ let install_rules sctx (package : Package.t) = ] in let () = + let context = Context.build_context ctx in let target_alias = - Build_system.Alias.package_install - ~context:(Context.to_build_context ctx) - ~pkg:package + Build_system.Alias.package_install ~context ~pkg:package in Rules.Produce.Alias.add_deps target_alias files ~dyn_deps: (let+ packages = packages in Package.Id.Set.to_list packages |> Path.Set.of_list_map ~f:(fun (pkg : Package.Id.t) -> - let name = Package.Id.name pkg in let pkg = + let name = Package.Id.name pkg in Package.Name.Map.find_exn (Super_context.packages sctx) name in - Build_system.Alias.package_install - ~context:(Context.to_build_context ctx) - ~pkg + Build_system.Alias.package_install ~context ~pkg |> Alias.stamp_file |> Path.build)) in let action = diff --git a/src/dune_rules/main.ml b/src/dune_rules/main.ml index 4529d8cbd72..de4dc2ce36b 100644 --- a/src/dune_rules/main.ml +++ b/src/dune_rules/main.ml @@ -80,7 +80,7 @@ let init_build_system ?only_packages ~sandboxing_preference ?caching w = Artifact_substitution.copy_file ?chmod ~src ~dst ~conf () in Build_system.init ~sandboxing_preference ~promote_source - ~contexts:(List.map ~f:Context.to_build_context w.contexts) + ~contexts:(List.map ~f:Context.build_context w.contexts) ?caching (); List.iter w.contexts ~f:Context.init_configurator; let+ scontexts = Gen_rules.gen w.conf ~contexts:w.contexts ?only_packages in diff --git a/src/dune_rules/super_context.ml b/src/dune_rules/super_context.ml index d8061e73bfe..1174e4ee0bd 100644 --- a/src/dune_rules/super_context.ml +++ b/src/dune_rules/super_context.ml @@ -292,7 +292,7 @@ let make_rule t ?sandbox ?mode ?locks ?loc ~dir build = let build = chdir_to_build_context_root t build in let env = get_node t.env_tree ~dir |> Env_node.external_env in Rule.make ?sandbox ?mode ?locks ~info:(Rule.Info.of_loc_opt loc) - ~context:(Some (Context.to_build_context t.context)) + ~context:(Some (Context.build_context t.context)) ~env:(Some env) build let add_rule t ?sandbox ?mode ?locks ?loc ~dir build = @@ -310,7 +310,7 @@ let add_rules t ?sandbox ~dir builds = let add_alias_action t alias ~dir ~loc ?locks ~stamp action = let env = Some (get_node t.env_tree ~dir |> Env_node.external_env) in Rules.Produce.Alias.add_action - ~context:(Context.to_build_context t.context) + ~context:(Context.build_context t.context) ~env alias ~loc ?locks ~stamp action let build_dir_is_vendored build_dir =