diff --git a/src/dune_rules/compilation_context.ml b/src/dune_rules/compilation_context.ml index de6a2e4cfc1..85d6c16a43b 100644 --- a/src/dune_rules/compilation_context.ml +++ b/src/dune_rules/compilation_context.ml @@ -91,7 +91,10 @@ type t = ; parameters : Module_name.t list Resolve.Memo.t ; instances : Parameterised_instances.t Resolve.Memo.t option ; includes : Includes.t + ; lib_index : Lib_file_deps.Lib_index.t Resolve.t Memo.Lazy.t + ; has_virtual_impl : bool Resolve.t Memo.Lazy.t ; preprocessing : Pp_spec.t + ; pps_runtime_libs : Lib.t list Resolve.Memo.t ; opaque : bool ; js_of_ocaml : Js_of_ocaml.In_context.t option Js_of_ocaml.Mode.Pair.t ; sandbox : Sandbox_config.t @@ -118,7 +121,10 @@ let requires_hidden t = t.requires_hidden let requires_link t = Memo.Lazy.force t.requires_link let parameters t = t.parameters let includes t = t.includes +let lib_index t = Memo.Lazy.force t.lib_index +let has_virtual_impl t = Memo.Lazy.force t.has_virtual_impl let preprocessing t = t.preprocessing +let pps_runtime_libs t = t.pps_runtime_libs let opaque t = t.opaque let js_of_ocaml t = t.js_of_ocaml let sandbox t = t.sandbox @@ -147,6 +153,74 @@ let parameters_main_modules parameters = [ "param", Lib.to_dyn param ]) ;; +(* Hidden libs must be indexed: otherwise unreached ones fall to the glob branch + and over-invalidate. *) +let build_lib_index ~super_context ~libs ~for_ = + let open Resolve.Memo.O in + let instrument_with = Context.instrument_with (Super_context.context super_context) in + let+ per_lib = + Resolve.Memo.List.map libs ~f:(fun lib -> + match Lib_info.entry_modules (Lib.info lib) ~for_ with + | External (Ok names) -> + Resolve.Memo.return (List.map names ~f:(fun n -> n, lib, None), None) + | External (Error e) -> Resolve.Memo.of_result (Error e) + | Local -> + let* mods = + Resolve.Memo.lift_memo + (Dir_contents.modules_of_local_lib + super_context + (Lib.Local.of_lib_exn lib) + ~for_) + in + (* [no_ocamldep_lib] tags libs that are walker-terminal: running + ocamldep on their entry module via the cross-lib walk can't + propagate anywhere, so the walker skips them. A singleton lib is + terminal only when its resolved requires are empty; otherwise the + walker must read its post-pp ocamldep to discover transitive refs + (incl. pps runtime libs added via [add_pp_runtime_deps]). *) + let+ requires_resolved = Lib.requires lib ~for_ in + (* [Some m] only for unwrapped locals (tight-eligible); wrapped locals + and externals → [None]. *) + let unwrapped = + match Lib_info.wrapped (Lib.info lib) with + | Some (This w) -> not (Wrapped.to_bool w) + | Some (From _) | None -> false + in + (* Mirror [Pp_spec.pped_modules_map] so the cross-lib walker reads + ocamldep on the source the dep lib's compile pipeline produces. *) + let preprocess = Lib_info.preprocess (Lib.info lib) ~for_ in + let post_pp_module m = + match Preprocess.Per_module.find (Module.name m) preprocess with + | No_preprocessing | Future_syntax _ -> Some (Module.ml_source m) + | Action _ -> Some (Module.ml_source (Module.pped m)) + | Pps { staged = false; pps; _ } -> + let any_active = + List.exists pps ~f:(function + | Preprocess.With_instrumentation.Ordinary _ -> true + | Instrumentation_backend { libname = _, name; _ } -> + List.mem instrument_with name ~equal:Lib_name.equal) + in + if any_active + then Some (Module.pped (Module.ml_source m)) + else Some (Module.ml_source m) + | Pps { staged = true; _ } -> None + in + let entries = + List.map (Modules.entry_modules mods) ~f:(fun m -> + Module.name m, lib, if unwrapped then post_pp_module m else None) + in + let no_ocamldep_lib = + match Modules.as_singleton mods with + | Some _ when List.is_empty requires_resolved -> Some lib + | _ -> None + in + entries, no_ocamldep_lib) + in + let entries = List.concat_map per_lib ~f:fst in + let no_ocamldep = List.filter_map per_lib ~f:snd |> Lib.Set.of_list in + Lib_file_deps.Lib_index.create ~no_ocamldep entries +;; + let create ~super_context ~scope @@ -155,6 +229,7 @@ let create ~flags ~requires_compile ~requires_link + ?(pps_runtime_libs = Resolve.Memo.return []) ?(preprocessing = Pp_spec.dummy) ~opaque ~js_of_ocaml @@ -246,7 +321,20 @@ let create ; parameters ; includes = Includes.make ~project ~opaque ~direct_requires ~hidden_requires ocaml.lib_config + ; lib_index = + Memo.lazy_ (fun () -> + let open Resolve.Memo.O in + let* d = direct_requires + and* h = hidden_requires in + build_lib_index ~super_context ~libs:(d @ h) ~for_) + ; has_virtual_impl = + Memo.lazy_ (fun () -> + let open Resolve.Memo.O in + let+ direct = direct_requires + and+ hidden = hidden_requires in + List.exists (direct @ hidden) ~f:(fun lib -> Option.is_some (Lib.implements lib))) ; preprocessing + ; pps_runtime_libs ; opaque ; js_of_ocaml ; sandbox @@ -347,7 +435,21 @@ let for_module_generated_at_link_time cctx ~requires ~module_ = ; flags = Ocaml_flags.empty ; requires_link = Memo.lazy_ (fun () -> requires) ; requires_compile = requires + ; requires_hidden = Resolve.Memo.return [] ; includes + ; lib_index = + Memo.lazy_ (fun () -> + (* Unreachable: synthesised modules use [Dep_graph.dummy] (whose [dir] + is [Path.Build.root]), so [lib_deps_for_module]'s [can_filter] + dir-equality guard fails and the non-filter fallback is taken. *) + Code_error.raise + "Compilation_context.lib_index forced for a module synthesised at link time; \ + this should be unreachable." + []) + ; (* Link-time-generated modules cannot participate in virtual-impl + relationships; override the parent's value so the accessor reflects + this cctx's [requires_compile]/[requires_link]. *) + has_virtual_impl = Memo.Lazy.of_val (Resolve.return false) ; modules } ;; diff --git a/src/dune_rules/compilation_context.mli b/src/dune_rules/compilation_context.mli index da50ceb82db..c917486e0cf 100644 --- a/src/dune_rules/compilation_context.mli +++ b/src/dune_rules/compilation_context.mli @@ -27,6 +27,7 @@ val create -> flags:Ocaml_flags.t -> requires_compile:Lib.t list Resolve.Memo.t -> requires_link:Lib.t list Resolve.t Memo.Lazy.t + -> ?pps_runtime_libs:Lib.t list Resolve.Memo.t -> ?preprocessing:Pp_spec.t -> opaque:opaque -> js_of_ocaml:Js_of_ocaml.In_context.t option Js_of_ocaml.Mode.Pair.t @@ -62,7 +63,22 @@ val requires_hidden : t -> Lib.t list Resolve.Memo.t val requires_compile : t -> Lib.t list Resolve.Memo.t val parameters : t -> Module_name.t list Resolve.Memo.t val includes : t -> Command.Args.without_targets Command.Args.t Lib_mode.Cm_kind.Map.t +val lib_index : t -> Lib_file_deps.Lib_index.t Resolve.Memo.t + +(** [true] iff any library in the compilation context's direct or hidden + requires implements a virtual library. Memoized per cctx. *) +val has_virtual_impl : t -> bool Resolve.Memo.t + val preprocessing : t -> Pp_spec.t + +(** Direct [ppx_runtime_deps] of every [pps] in this stanza's preprocessor + (a flat concatenation; not closed transitively — consumers that need + closure semantics wrap with [Lib.closure]). These libraries' modules are + visible only to ppx-rewritten output, so the per-module dependency + filter cannot reason about which of them are referenced — they must be + treated as opaque [must-glob] dependencies. *) +val pps_runtime_libs : t -> Lib.t list Resolve.Memo.t + val opaque : t -> bool val js_of_ocaml : t -> Js_of_ocaml.In_context.t option Js_of_ocaml.Mode.Pair.t val sandbox : t -> Sandbox_config.t diff --git a/src/dune_rules/dep_graph.ml b/src/dune_rules/dep_graph.ml index 8ff3f084366..dd8b8b2a8cd 100644 --- a/src/dune_rules/dep_graph.ml +++ b/src/dune_rules/dep_graph.ml @@ -7,6 +7,8 @@ type t = } let make ~dir ~per_module = { dir; per_module } +let dir t = t.dir +let mem t (m : Module.t) = Module_name.Unique.Map.mem t.per_module (Module.obj_name m) let deps_of t (m : Module.t) = match Module_name.Unique.Map.find t.per_module (Module.obj_name m) with diff --git a/src/dune_rules/dep_graph.mli b/src/dune_rules/dep_graph.mli index d5f663b222f..d8b5ff3726a 100644 --- a/src/dune_rules/dep_graph.mli +++ b/src/dune_rules/dep_graph.mli @@ -9,6 +9,8 @@ val make -> per_module:Module.t list Action_builder.t Module_name.Unique.Map.t -> t +val dir : t -> Path.Build.t +val mem : t -> Module.t -> bool val deps_of : t -> Module.t -> Module.t list Action_builder.t val top_closed_implementations : t -> Module.t list -> Module.t list Action_builder.t diff --git a/src/dune_rules/exe_rules.ml b/src/dune_rules/exe_rules.ml index e032e212171..6dbc907ead6 100644 --- a/src/dune_rules/exe_rules.ml +++ b/src/dune_rules/exe_rules.ml @@ -193,6 +193,11 @@ let executables_rules let* cctx = let requires_compile = Lib.Compile.direct_requires compile_info ~for_ in let requires_link = Lib.Compile.requires_link compile_info ~for_ in + let pps_runtime_libs = + let open Resolve.Memo.O in + let* pps = Lib.Compile.pps compile_info ~for_ in + Resolve.Memo.List.concat_map pps ~f:(Lib.ppx_runtime_deps ~for_) + in let instances = Parameterised_instances.instances ~sctx @@ -215,6 +220,7 @@ let executables_rules ~flags ~requires_link ~requires_compile + ~pps_runtime_libs ~preprocessing:pp ~js_of_ocaml ~opaque:Inherit_from_settings diff --git a/src/dune_rules/lib_file_deps.ml b/src/dune_rules/lib_file_deps.ml index 13048f499e4..c5fb609e974 100644 --- a/src/dune_rules/lib_file_deps.ml +++ b/src/dune_rules/lib_file_deps.ml @@ -118,8 +118,9 @@ module Lib_index = struct { by_module_name : (Lib.t * Module.t option) list Module_name.Map.t ; tight_eligible : Lib.Set.t ; no_ocamldep : Lib.Set.t - (* Local libs short-circuited by [Dep_rules.skip_ocamldep] — no [.d] rules - exist; the cross-library walk must skip them. *) + (* Local libs that are walker-terminal: running ocamldep on their entry + module via the cross-library walk can't propagate anywhere (no + resolved requires to chase), so the walker skips them. *) } (* Tight-eligibility is encoded in the entry shape: [(_, lib, Some _)] means diff --git a/src/dune_rules/lib_file_deps.mli b/src/dune_rules/lib_file_deps.mli index 83ef20403c0..75683ac1ec2 100644 --- a/src/dune_rules/lib_file_deps.mli +++ b/src/dune_rules/lib_file_deps.mli @@ -42,9 +42,9 @@ module Lib_index : sig (** Third tuple element is [Some m] for local + unwrapped libs (with the entry's [Module.t]) and [None] otherwise (wrapped locals, externals). - [no_ocamldep] names local libs whose [.d] files don't exist - (short-circuited by [Dep_rules.skip_ocamldep]); the cross-library walk - skips them. *) + [no_ocamldep] names local libs that are walker-terminal (singletons + with no resolved requires) — the cross-library walk would gain nothing + by running ocamldep on them, so it skips them. *) val create : no_ocamldep:Lib.Set.t -> (Module_name.t * Lib.t * Module.t option) list diff --git a/src/dune_rules/lib_rules.ml b/src/dune_rules/lib_rules.ml index d6c79a1a5e7..44a1f6de602 100644 --- a/src/dune_rules/lib_rules.ml +++ b/src/dune_rules/lib_rules.ml @@ -502,6 +502,11 @@ let cctx let modules = Virtual_rules.impl_modules implements modules in let requires_compile = Lib.Compile.direct_requires compile_info ~for_ in let requires_link = Lib.Compile.requires_link compile_info ~for_ in + let pps_runtime_libs = + let open Resolve.Memo.O in + let* pps = Lib.Compile.pps compile_info ~for_ in + Resolve.Memo.List.concat_map pps ~f:(Lib.ppx_runtime_deps ~for_) + in let instances = Parameterised_instances.instances ~sctx ~db:(Scope.libs scope) lib.buildable.libraries in @@ -532,6 +537,7 @@ let cctx ~flags ~requires_compile ~requires_link + ~pps_runtime_libs ~implements ~parameters ~preprocessing:pp diff --git a/src/dune_rules/modules.ml b/src/dune_rules/modules.ml index 6a42fed4e9a..eed14fdbd33 100644 --- a/src/dune_rules/modules.ml +++ b/src/dune_rules/modules.ml @@ -918,6 +918,12 @@ let wrapped t = | Stdlib _ -> Simple true ;; +let as_singleton t = + match t.modules with + | Singleton m -> Some m + | Unwrapped _ | Wrapped _ | Stdlib _ -> None +;; + let is_user_written m = match Module.kind m with | Root | Wrapped_compat | Alias _ -> false diff --git a/src/dune_rules/modules.mli b/src/dune_rules/modules.mli index 57ff2ed5ca2..6dc81116e0c 100644 --- a/src/dune_rules/modules.mli +++ b/src/dune_rules/modules.mli @@ -57,6 +57,13 @@ val obj_map : t -> Sourced_module.t Module_name.Unique.Map.t val virtual_module_names : t -> Module_name.Path.Set.t val wrapped : t -> Wrapped.t + +(** [Some m] iff the library's module set is a singleton — the single + user-written module [m]. This covers both unwrapped stanzas with exactly one + module and wrapped stanzas whose only module is the main module (in which + case the wrapper is elided). Mirrors [With_vlib.as_singleton]. *) +val as_singleton : t -> Module.t option + val source_dirs : t -> Path.Set.t val compat_for_exn : t -> Module.t -> Module.t