feat: implement per-module library dependency filtering (issue #4572)

Use ocamldep output to filter cross-library file dependencies per module.
Instead of every module depending on all libraries, each module now depends
only on libraries whose entry modules it actually references.

- Lib_index maps library entry module names back to libraries, computed
  once per stanza and stored in Compilation_context
- read_immediate_deps_raw_of returns raw (unresolved) module names from
  ocamldep, including cross-library references previously discarded
- build_cm unions external references across transitive intra-stanza deps
  to handle transparent module aliases (module M = Mylib)
- Filtering is disabled for stanzas whose requires include virtual library
  implementations, since their requires may not include the virtual library
- deps_of_entries extended to support per-file deps for unwrapped libraries
- Dep_graph.dir accessor added for link-time module detection
- deps_with_exts removed (dead code after Includes refactor)

Signed-off-by: Robin Bate Boerop <me@robinbb.com>

Author: robinbb

src/dune_rules/compilation_context.ml

@@ -5,9 +5,9 @@ module Includes = struct
   type t = Command.Args.without_targets Command.Args.t Lib_mode.Cm_kind.Map.t
 
   (* Library file dependencies (Hidden_deps) are added per-module in
-     module_compilation.ml rather than here.
-     TODO: some of the requires can be filtered out using [ocamldep] info.
-     See issue #4572. *)
+     module_compilation.ml based on ocamldep output. Each module depends
+     only on libraries it actually references.
+     See issue #4572: Finer dependency analysis between libraries. *)
   let make ~project ~direct_requires ~hidden_requires lib_config
     : _ Lib_mode.Cm_kind.Map.t
     =
@@ -68,6 +68,7 @@ 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.Memo.t
   ; preprocessing : Pp_spec.t
   ; opaque : bool
   ; js_of_ocaml : Js_of_ocaml.In_context.t option Js_of_ocaml.Mode.Pair.t
@@ -95,6 +96,7 @@ 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 = t.lib_index
 let preprocessing t = t.preprocessing
 let opaque t = t.opaque
 let js_of_ocaml t = t.js_of_ocaml
@@ -218,6 +220,11 @@ let create
   ; implements
   ; parameters
   ; includes = Includes.make ~project ~direct_requires ~hidden_requires ocaml.lib_config
+  ; lib_index =
+      (let open Resolve.Memo.O in
+       let* direct_libs = direct_requires
+       and* hidden_libs = hidden_requires in
+       Lib_file_deps.Lib_index.create super_context (direct_libs @ hidden_libs) ~for_)
   ; preprocessing
   ; opaque
   ; js_of_ocaml
@@ -318,6 +325,7 @@ let for_module_generated_at_link_time cctx ~requires ~module_ =
   ; flags = Ocaml_flags.empty
   ; requires_link = Memo.lazy_ (fun () -> requires)
   ; requires_compile = requires
+  ; lib_index = Resolve.Memo.return Lib_file_deps.Lib_index.empty
   ; includes
   ; modules
   }

src/dune_rules/compilation_context.mli

@@ -62,6 +62,7 @@ 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
 val preprocessing : t -> Pp_spec.t
 val opaque : t -> bool
 val js_of_ocaml : t -> Js_of_ocaml.In_context.t option Js_of_ocaml.Mode.Pair.t

src/dune_rules/dep_graph.ml

@@ -7,6 +7,7 @@ type t =
   }
 
 let make ~dir ~per_module = { dir; per_module }
+let dir t = t.dir
 
 let deps_of t (m : Module.t) =
   match Module_name.Unique.Map.find t.per_module (Module.obj_name m) with

src/dune_rules/dep_graph.mli

@@ -9,6 +9,7 @@ val make
   -> per_module:Module.t list Action_builder.t Module_name.Unique.Map.t
   -> t
 
+val dir : t -> Path.Build.t
 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
 

src/dune_rules/lib_file_deps.ml

@@ -48,23 +48,39 @@ let deps_of_lib (lib : Lib.t) ~groups =
   |> Dep.Set.of_list
 ;;
 
+let deps_of_module (lib : Lib.t) (m : Module.t) ~cm_kinds =
+  let obj_dir = Lib.info lib |> Lib_info.obj_dir in
+  List.filter_map cm_kinds ~f:(fun kind ->
+    Obj_dir.Module.cm_public_file obj_dir m ~kind |> Option.map ~f:(fun p -> Dep.file p))
+  |> Dep.Set.of_list
+;;
+
 let deps libs ~groups = Dep.Set.union_map libs ~f:(deps_of_lib ~groups)
 
-let deps_of_entries ~opaque ~(cm_kind : Lib_mode.Cm_kind.t) (libs : Lib.t list) =
-  let groups =
+let deps_of_entries ~opaque ~(cm_kind : Lib_mode.Cm_kind.t) entries =
+  let groups, cm_kinds =
     match cm_kind with
-    | Ocaml Cmi | Ocaml Cmo -> [ Group.Ocaml Cmi ]
-    | Melange Cmi -> [ Group.Melange Cmi ]
-    | Melange Cmj -> [ Group.Melange Cmi; Melange Cmj ]
-    | Ocaml Cmx -> [ Group.Ocaml Cmi; Ocaml Cmx ]
+    | Ocaml Cmi | Ocaml Cmo -> [ Group.Ocaml Cmi ], [ Lib_mode.Cm_kind.Ocaml Cmi ]
+    | Melange Cmi -> [ Group.Melange Cmi ], [ Melange Cmi ]
+    | Melange Cmj -> [ Group.Melange Cmi; Melange Cmj ], [ Melange Cmi; Melange Cmj ]
+    | Ocaml Cmx -> [ Group.Ocaml Cmi; Ocaml Cmx ], [ Ocaml Cmi; Ocaml Cmx ]
   in
-  Dep.Set.union_map libs ~f:(fun lib ->
-    let groups =
+  List.map entries ~f:(fun ((lib : Lib.t), mod_opt) ->
+    let is_opaque_local =
       match cm_kind with
-      | Ocaml Cmx when opaque && Lib.is_local lib -> [ Group.Ocaml Cmi ]
-      | _ -> groups
+      | Ocaml Cmx -> opaque && Lib.is_local lib
+      | _ -> false
     in
-    deps_of_lib lib ~groups)
+    match mod_opt with
+    | Some m ->
+      let cm_kinds =
+        if is_opaque_local then [ Lib_mode.Cm_kind.Ocaml Cmi ] else cm_kinds
+      in
+      deps_of_module lib m ~cm_kinds
+    | None ->
+      let groups = if is_opaque_local then [ Group.Ocaml Cmi ] else groups in
+      deps_of_lib lib ~groups)
+  |> List.fold_left ~init:Dep.Set.empty ~f:Dep.Set.union
 ;;
 
 type path_specification =
@@ -98,3 +114,112 @@ let eval ~loc ~expander ~paths:path_spec (deps : Dep_conf.t list) =
        | Some _ -> raise_disallowed_external_path ~loc lib_name path));
   paths
 ;;
+
+module Lib_index = struct
+  (** Each entry pairs a library with an optional Module.t: None means use
+      glob deps (wrapped libs, external unwrapped), Some m means use
+      per-file deps via Obj_dir.Module.cm_file (local unwrapped). *)
+  type entry = Lib.t * Module.t option
+
+  type t =
+    { by_module_name : entry list Module_name.Map.t
+    ; unresolved : Lib.t list
+    }
+
+  let module_names_of_lib sctx (lib : Lib.t) ~for_
+    : (Module_name.t * Module.t option) list option Resolve.Memo.t
+    =
+    let open Resolve.Memo.O in
+    let* main_module = Lib.main_module_name lib in
+    match main_module with
+    | Some name ->
+      (* Wrapped library: index the wrapper name plus all inner module
+         names so that references via -open flags are resolved. All map
+         to None (glob deps) since the wrapper exposes the whole lib. *)
+      let info = Lib.info lib in
+      (match Lib_info.entry_modules info ~for_ with
+       | Lib_info.Source.External _ ->
+         Resolve.Memo.return (Some [ name, None ])
+       | Lib_info.Source.Local ->
+         Resolve.Memo.lift_memo
+           (let open Memo.O in
+            let+ modules_opt = Dir_contents.modules_of_lib sctx lib ~for_ in
+            match modules_opt with
+            | None -> Some [ name, None ]
+            | Some modules_with_vlib ->
+              let modules = Modules.With_vlib.drop_vlib modules_with_vlib in
+              let inner_names =
+                Modules.fold modules ~init:[] ~f:(fun m acc ->
+                  (Module.name m, None) :: acc)
+              in
+              Some ((name, None) :: inner_names)))
+    | None ->
+      let info = Lib.info lib in
+      (match Lib_info.entry_modules info ~for_ with
+       | Lib_info.Source.External (Ok names) ->
+         Resolve.Memo.return (Some (List.map names ~f:(fun n -> n, None)))
+       | Lib_info.Source.External (Error _) -> Resolve.Memo.return None
+       | Lib_info.Source.Local ->
+         Resolve.Memo.lift_memo
+           (let open Memo.O in
+            let+ modules_opt = Dir_contents.modules_of_lib sctx lib ~for_ in
+            match modules_opt with
+            | None -> None
+            | Some modules_with_vlib ->
+              let modules = Modules.With_vlib.drop_vlib modules_with_vlib in
+              let entry_modules = Modules.entry_modules modules in
+              Some (List.map entry_modules ~f:(fun m -> Module.name m, Some m))))
+  ;;
+
+  let empty = { by_module_name = Module_name.Map.empty; unresolved = [] }
+
+  let create sctx (libs : Lib.t list) ~for_ : t Resolve.Memo.t =
+    let open Resolve.Memo.O in
+    let+ entries =
+      Resolve.Memo.List.map libs ~f:(fun lib ->
+        let+ names_opt = module_names_of_lib sctx lib ~for_ in
+        lib, names_opt)
+    in
+    let by_module_name, unresolved =
+      List.fold_left
+        entries
+        ~init:(Module_name.Map.empty, [])
+        ~f:(fun (by_name, unresolved) (lib, names_opt) ->
+          match names_opt with
+          | None -> by_name, lib :: unresolved
+          | Some named_modules ->
+            let by_name =
+              List.fold_left named_modules ~init:by_name ~f:(fun acc (name, mod_opt) ->
+                Module_name.Map.update acc name ~f:(function
+                  | None -> Some [ lib, mod_opt ]
+                  | Some entries -> Some ((lib, mod_opt) :: entries)))
+            in
+            by_name, unresolved)
+    in
+    { by_module_name; unresolved }
+  ;;
+
+  let filter_libs (index : t) ~(referenced_modules : Module_name.Set.t) : entry list =
+    let from_refs =
+      Module_name.Set.fold referenced_modules ~init:[] ~f:(fun name acc ->
+        match Module_name.Map.find index.by_module_name name with
+        | None -> acc
+        | Some entries -> List.rev_append entries acc)
+    in
+    let unresolved = List.map index.unresolved ~f:(fun lib -> lib, None) in
+    (* Entries are unique per (lib, module name). Two modules with the
+       same name can't appear for the same library since module names are
+       unique within a library's entry modules. *)
+    let compare (a_lib, a_mod) (b_lib, b_mod) =
+      match Lib.compare a_lib b_lib with
+      | (Lt | Gt) as c -> c
+      | Eq ->
+        (match a_mod, b_mod with
+         | None, None -> Eq
+         | None, Some _ -> Lt
+         | Some _, None -> Gt
+         | Some a, Some b -> Module_name.compare (Module.name a) (Module.name b))
+    in
+    List.rev_append unresolved from_refs |> List.sort_uniq ~compare
+  ;;
+end

src/dune_rules/lib_file_deps.mli

@@ -15,10 +15,6 @@ end
     with extension [files] of libraries [libs]. *)
 val deps : Lib.t list -> groups:Group.t list -> Dep.Set.t
 
-(** Compute library file dependencies for all [libs] for the given [cm_kind].
-    When [opaque] is true, local libraries only depend on .cmi (not .cmx). *)
-val deps_of_entries : opaque:bool -> cm_kind:Lib_mode.Cm_kind.t -> Lib.t list -> Dep.Set.t
-
 type path_specification =
   | Allow_all
   | Disallow_external of Lib_name.t
@@ -31,3 +27,27 @@ val eval
   -> paths:path_specification
   -> Dep_conf.t list
   -> Path.Set.t Memo.t
+
+module Lib_index : sig
+  type entry = Lib.t * Module.t option
+  type t
+
+  val empty : t
+
+  val create
+    :  Super_context.t
+    -> Lib.t list
+    -> for_:Compilation_mode.t
+    -> t Resolve.Memo.t
+
+  val filter_libs : t -> referenced_modules:Module_name.Set.t -> entry list
+end
+
+(** Compute library file dependencies for the given entries and cm_kind.
+    Entries with [Some module_] use per-file deps; [None] uses glob deps.
+    When [opaque] is true, local libraries only depend on .cmi (not .cmx). *)
+val deps_of_entries
+  :  opaque:bool
+  -> cm_kind:Lib_mode.Cm_kind.t
+  -> Lib_index.entry list
+  -> Dep.Set.t