infra: Lib_index, deps_of_entries, deps_of_entry_modules, raw ocamldep

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

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

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

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