diff --git a/src/dune_rules/lib_file_deps.ml b/src/dune_rules/lib_file_deps.ml index 0aa3440da59..13048f499e4 100644 --- a/src/dune_rules/lib_file_deps.ml +++ b/src/dune_rules/lib_file_deps.ml @@ -1,6 +1,13 @@ open Import open Memo.O +(* This file builds dep specs for library files (cmi/cmx/cmj/header). Per-module + tight deps apply only to local unwrapped libraries; wrapped libraries take a + directory glob over their public cmi dir. [ocamldep -modules] outputs only + top-level module names — for a consumer using [Foo.Bar.x] the output is + [Foo], not [Foo.Bar] — so the filter cannot distinguish [Foo.Bar] from + [Foo.Baz] consumers and a glob is the tightest sound dep. *) + module Group = struct type ocaml = | Cmi @@ -51,6 +58,150 @@ let deps_of_lib (lib : Lib.t) ~groups = let deps_with_exts = Dep.Set.union_map ~f:(fun (lib, groups) -> deps_of_lib lib ~groups) let deps libs ~groups = Dep.Set.union_map libs ~f:(deps_of_lib ~groups) +let groups_for_cm_kind ~opaque ~(cm_kind : Lib_mode.Cm_kind.t) lib = + match cm_kind with + | Ocaml Cmi | Ocaml Cmo -> [ Group.Ocaml Cmi ] + | Ocaml Cmx -> + if opaque && Lib.is_local lib + then [ Group.Ocaml Cmi ] + else [ Group.Ocaml Cmi; Group.Ocaml Cmx ] + | Melange Cmi -> [ Group.Melange Cmi ] + | Melange Cmj -> [ Group.Melange Cmi; Group.Melange Cmj ] +;; + +let deps_of_entries ~opaque ~cm_kind libs = + Dep.Set.union_map libs ~f:(fun lib -> + deps_of_lib lib ~groups:(groups_for_cm_kind ~opaque ~cm_kind lib)) +;; + +(* [cm_public_file] gives the cmi path consumers read via their [-I] include + path, which for libraries with a dedicated public cmi dir ([private_modules]) + differs from the internal compilation output. Using it ensures the dep + triggers the produce-public-cmi rule. *) +let deps_of_entry_modules ~opaque ~(cm_kind : Lib_mode.Cm_kind.t) lib modules = + let obj_dir = Lib.info lib |> Lib_info.obj_dir in + let cmi_kind = Lib_mode.Cm_kind.cmi cm_kind in + let want_cmx = + match cm_kind with + | Ocaml Cmx -> not (opaque && Lib.is_local lib) + | _ -> false + in + List.fold_left modules ~init:Dep.Set.empty ~f:(fun acc m -> + let acc = + match Obj_dir.Module.cm_public_file obj_dir m ~kind:cmi_kind with + | Some path -> Dep.Set.add acc (Dep.file path) + | None -> + (* Unreachable: [tight_modules] contains only public modules (consumers + can't reach private), so [cm_public_file] resolves. *) + Code_error.raise + "deps_of_entry_modules: [cm_public_file] returned [None] for cmi of a module \ + in tight_modules" + [ "module", Module.to_dyn m; "lib", Lib.to_dyn lib ] + in + if want_cmx && Module.has m ~ml_kind:Impl + then ( + match Obj_dir.Module.cm_public_file obj_dir m ~kind:(Ocaml Cmx) with + | Some path -> Dep.Set.add acc (Dep.file path) + | None -> + (* Unreachable. [cm_public_file ~kind:(Ocaml Cmx)] returns [None] only + when [not has_impl]. The enclosing [if] guarantees + [Module.has m ~ml_kind:Impl] (= [has_impl]). *) + Code_error.raise + "deps_of_entry_modules: [cm_public_file] returned [None] for cmx despite \ + [Module.has m ~ml_kind:Impl] holding" + [ "module", Module.to_dyn m ]) + else acc) +;; + +module Lib_index = struct + type t = + { 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. *) + } + + (* Tight-eligibility is encoded in the entry shape: [(_, lib, Some _)] means + the index producer has decided [lib] is tight-eligible (local + unwrapped, + every entry carries a [Module.t]). *) + let create ~no_ocamldep entries = + let by_module_name = + List.fold_left entries ~init:Module_name.Map.empty ~f:(fun map (name, lib, m) -> + Module_name.Map.update map name ~f:(function + | None -> Some [ lib, m ] + | Some xs -> Some ((lib, m) :: xs))) + in + let tight_eligible = + List.fold_left entries ~init:Lib.Set.empty ~f:(fun acc (_, lib, m_opt) -> + match m_opt with + | Some _ -> Lib.Set.add acc lib + | None -> acc) + in + { by_module_name; tight_eligible; no_ocamldep } + ;; + + type classified = + { tight : Module.t list Lib.Map.t + ; non_tight : Lib.Set.t + } + + (* Per-pair classification: each entry is independently tight (Some) or + non-tight (None). A lib whose modules have mixed entries (e.g. unwrapped + lib with per-module preprocessing where some modules are staged-pps) lands + in BOTH [tight] and [non_tight]; the caller should treat such a lib as + glob-only to avoid dropping the None entries' [.cmi]s from compile-rule + deps. *) + let filter_libs_with_modules idx ~referenced_modules = + let add_entry (tight, non_tight) (lib, m_opt) = + match m_opt with + | Some m -> + let tight = + Lib.Map.update tight lib ~f:(function + | None -> Some [ m ] + | Some ms -> Some (m :: ms)) + in + tight, non_tight + | None -> tight, Lib.Set.add non_tight lib + in + let tight, non_tight = + Module_name.Set.fold + referenced_modules + ~init:(Lib.Map.empty, Lib.Set.empty) + ~f:(fun name acc -> + match Module_name.Map.find idx.by_module_name name with + | None -> acc + | Some entries -> List.fold_left entries ~init:acc ~f:add_entry) + in + { tight; non_tight } + ;; + + let lookup_tight_entries idx name = + match Module_name.Map.find idx.by_module_name name with + | None -> [] + | Some entries -> + List.filter_map entries ~f:(fun (lib, m_opt) -> + match m_opt with + | Some m when not (Lib.Set.mem idx.no_ocamldep lib) -> Some (lib, m) + | _ -> None) + ;; + + let is_tight_eligible idx lib = Lib.Set.mem idx.tight_eligible lib + + (* Wrapped local libs land in [by_module_name] with [m_opt = None]; externals + also do, but [Lib.is_local] excludes them. *) + let wrapped_libs_referenced idx ~referenced_modules = + Module_name.Set.fold referenced_modules ~init:Lib.Set.empty ~f:(fun name acc -> + match Module_name.Map.find idx.by_module_name name with + | None -> acc + | Some entries -> + List.fold_left entries ~init:acc ~f:(fun acc (lib, m_opt) -> + match m_opt with + | None when Lib.is_local lib -> Lib.Set.add acc lib + | _ -> acc)) + ;; +end + type path_specification = | Allow_all | Disallow_external of Lib_name.t diff --git a/src/dune_rules/lib_file_deps.mli b/src/dune_rules/lib_file_deps.mli index 75a3453e64b..83ef20403c0 100644 --- a/src/dune_rules/lib_file_deps.mli +++ b/src/dune_rules/lib_file_deps.mli @@ -17,6 +17,72 @@ val deps : Lib.t list -> groups:Group.t list -> Dep.Set.t val deps_with_exts : (Lib.t * Group.t list) list -> Dep.Set.t +(** [deps_of_entries ~opaque ~cm_kind libs] computes the file dependencies (glob + deps on .cmi/.cmx files) for the given libraries. *) +val deps_of_entries : opaque:bool -> cm_kind:Lib_mode.Cm_kind.t -> Lib.t list -> Dep.Set.t + +(** Specific-file deps on the [modules] of [lib]. Only valid for local libraries + (where [Module.t] values are available). + + Currently produces complete per-module deps only for [cm_kind = Ocaml _] + (cmi + cmx); for [Melange _] only the cmi is emitted — there is no + per-module cmj arm, asymmetric with [deps_of_entries]. The sole caller + ([Module_compilation.lib_deps_for_module]) gates Melange out before + reaching this function, so this asymmetry is not observable today. If a + future Melange caller is added, extend with a [want_cmj] arm. *) +val deps_of_entry_modules + : opaque:bool + -> cm_kind:Lib_mode.Cm_kind.t + -> Lib.t + -> Module.t list + -> Dep.Set.t + +module Lib_index : sig + type t + + (** 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. *) + val create + : no_ocamldep:Lib.Set.t + -> (Module_name.t * Lib.t * Module.t option) list + -> t + + type classified = + { tight : Module.t list Lib.Map.t + (** Per-pair tight entries: libs mapped to the [Some]-entry modules + referenced. Candidates for [deps_of_entry_modules] unless the lib also + appears in [non_tight] (mixed-entry libs must glob to cover their + [None] entries). *) + ; non_tight : Lib.Set.t + (** Libs whose [None]-entry modules appear in the input (wrapped locals, + externals, or unwrapped locals with some staged-pps / + instrumentation-only entries). The caller must glob these. *) + } + + (** Classify the libraries whose entry modules appear in [referenced_modules]. + A lib with mixed [Some]/[None] entries can appear in BOTH [tight] (for its + [Some] modules) AND [non_tight] (for its [None] modules). *) + val filter_libs_with_modules : t -> referenced_modules:Module_name.Set.t -> classified + + (** [(lib, entry module)] pairs for the cross-library walk; excludes + [no_ocamldep] libs and entries with [m_opt = None]. *) + val lookup_tight_entries : t -> Module_name.t -> (Lib.t * Module.t) list + + (** True for libs with at least one tight-eligible ([Some]) entry. Used to + drop unreached libs from a consumer's compile deps: if the lib is capable + of tight-eligibility but no module of it is referenced, the link rule + still pulls it in. *) + val is_tight_eligible : t -> Lib.t -> bool + + (** Local wrapped libs whose entry name is in [referenced_modules]. The + consumer must glob the wrapped lib's [Lib.closure] (see the file-level + comment for why). *) + val wrapped_libs_referenced : t -> referenced_modules:Module_name.Set.t -> Lib.Set.t +end + type path_specification = | Allow_all | Disallow_external of Lib_name.t diff --git a/src/dune_rules/ocamldep.ml b/src/dune_rules/ocamldep.ml index a8aeb6c8252..7947b1b14a1 100644 --- a/src/dune_rules/ocamldep.ml +++ b/src/dune_rules/ocamldep.ml @@ -22,27 +22,27 @@ let parse_module_names ~dir ~(unit : Module.t) ~modules words = ]) ;; -let parse_deps_exn = - let invalid file lines = - User_error.raise - [ Pp.textf - "ocamldep returned unexpected output for %s:" - (Path.to_string_maybe_quoted file) - ; Pp.vbox - (Pp.concat_map lines ~sep:Pp.cut ~f:(fun line -> - Pp.seq (Pp.verbatim "> ") (Pp.verbatim line))) - ] - in - fun ~file lines -> - match lines with - | [] | _ :: _ :: _ -> invalid file lines - | [ line ] -> - (match String.lsplit2 line ~on:':' with - | None -> invalid file lines - | Some (basename, deps) -> - let basename = Filename.basename basename in - if basename <> Path.basename file then invalid file lines; - String.extract_blank_separated_words deps) +let invalid_ocamldep_output file lines = + User_error.raise + [ Pp.textf + "ocamldep returned unexpected output for %s:" + (Path.to_string_maybe_quoted file) + ; Pp.vbox + (Pp.concat_map lines ~sep:Pp.cut ~f:(fun line -> + Pp.seq (Pp.verbatim "> ") (Pp.verbatim line))) + ] +;; + +let parse_deps_exn ~file lines = + match lines with + | [] | _ :: _ :: _ -> invalid_ocamldep_output file lines + | [ line ] -> + (match String.lsplit2 line ~on:':' with + | None -> invalid_ocamldep_output file lines + | Some (basename, deps) -> + let basename = Filename.basename basename in + if basename <> Path.basename file then invalid_ocamldep_output file lines; + String.extract_blank_separated_words deps) ;; let ocamldep_action ~sandbox ~sctx ~dir ~ml_kind unit = @@ -79,24 +79,72 @@ let ocamldep_action ~sandbox ~sctx ~dir ~ml_kind unit = } ;; +(* Top-level cache per (source path, ml_kind). Without it, each caller's + [Action_builder.memoize] cell has a different digest (pp-flags closure + identity varies), causing ocamldep to run multiply per source. + + The key omits [sctx], [obj_dir], and [pp_flags], but suffices because + [Module.File.path] is build-dir-qualified for ocamldep'd modules (see + [ml_sources.ml]'s [modules_of_files] and Melange/OxCaml equivalents): + a build-qualified path uniquely determines its workspace context and + stanza, and therefore all closure inputs. If that invariant ever + stops holding, scope the cache per [Super_context]. *) +module Cache_key = struct + type t = + { source : Path.t + ; ml_kind : Ml_kind.t + } + + let equal = Poly.equal + let hash = Poly.hash + + let to_dyn { source; ml_kind } = + Dyn.record [ "source", Path.to_dyn source; "ml_kind", Ml_kind.to_dyn ml_kind ] + ;; +end + +let read_immediate_deps_words = + let cache = Table.create (module Cache_key) 64 in + fun ~sandbox ~sctx ~obj_dir ~ml_kind unit -> + match Module.source ~ml_kind unit with + | None -> Action_builder.return None + | Some source -> + let source_path = Module.File.path source in + let cache_key = { Cache_key.source = source_path; ml_kind } in + (match Table.find cache cache_key with + | Some builder -> builder + | None -> + let dir = Obj_dir.dir obj_dir in + let builder = + ocamldep_action ~sandbox ~sctx ~dir ~ml_kind unit + |> Build_system.execute_action_stdout + |> Memo.map ~f:(fun output -> + Some (String.split_lines output |> parse_deps_exn ~file:source_path)) + |> Action_builder.of_memo + |> Action_builder.memoize "Ocamldep.read_immediate_deps_words" + in + Table.set cache cache_key builder; + builder) +;; + let read_immediate_deps_of ~sandbox ~sctx ~obj_dir ~modules ~ml_kind unit = - match Module.source ~ml_kind unit with - | None -> Action_builder.return [] - | Some source -> + let open Action_builder.O in + let+ words = read_immediate_deps_words ~sandbox ~sctx ~obj_dir ~ml_kind unit in + match words with + | None -> [] + | Some words -> let dir = Obj_dir.dir obj_dir in - let memo_name = - sprintf - "%s.%s.ocamldep" - (Path.to_string (Module.File.path source)) - (Ml_kind.to_string ml_kind) - in - ocamldep_action ~sandbox ~sctx ~dir ~ml_kind unit - |> Build_system.execute_action_stdout - |> Memo.map ~f:(fun output -> - String.split_lines output - |> parse_deps_exn ~file:(Module.File.path source) - |> parse_module_names ~dir ~unit ~modules - |> Stdlib.( @ ) (Modules.With_vlib.implicit_deps modules ~of_:unit)) - |> Action_builder.of_memo - |> Action_builder.memoize memo_name + parse_module_names ~dir ~unit ~modules words + |> List.append (Modules.With_vlib.implicit_deps modules ~of_:unit) +;; + +(* Returns raw module names without resolving against the stanza's module set. + Preserves references to external libraries, which [parse_module_names] would + discard. Used for per-module inter-library dependency filtering (#4572). *) +let read_immediate_deps_raw_of ~sandbox ~sctx ~obj_dir ~ml_kind unit = + let open Action_builder.O in + let+ words = read_immediate_deps_words ~sandbox ~sctx ~obj_dir ~ml_kind unit in + match words with + | None -> Module_name.Set.empty + | Some words -> Module_name.Set.of_list_map words ~f:Module_name.of_checked_string ;; diff --git a/src/dune_rules/ocamldep.mli b/src/dune_rules/ocamldep.mli index bf01cca1992..564a7eb4a39 100644 --- a/src/dune_rules/ocamldep.mli +++ b/src/dune_rules/ocamldep.mli @@ -14,3 +14,15 @@ val read_immediate_deps_of -> ml_kind:Ml_kind.t -> Module.t -> Module.t list Action_builder.t + +(** [read_immediate_deps_raw_of ~sandbox ~sctx ~obj_dir ~ml_kind unit] returns + the raw module names from ocamldep output without filtering against the + stanza's module set. This preserves cross-library references that + [read_immediate_deps_of] discards. *) +val read_immediate_deps_raw_of + : sandbox:Sandbox_config.t + -> sctx:Super_context.t + -> obj_dir:Path.Build.t Obj_dir.t + -> ml_kind:Ml_kind.t + -> Module.t + -> Module_name.Set.t Action_builder.t