fix: run ocamldep for single-module stanzas (#4572)

src/dune_rules/compilation_context.ml

@@ -4,55 +4,32 @@ open Memo.O
 module Includes = struct
   type t = Command.Args.without_targets Command.Args.t Lib_mode.Cm_kind.Map.t
 
-  let make ~project ~opaque ~direct_requires ~hidden_requires lib_config
+  (* Library file dependencies (Hidden_deps) are added per-module in
+     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
     =
-    (* TODO: some of the requires can filtered out using [ocamldep] info *)
     let open Resolve.Memo.O in
     let iflags direct_libs hidden_libs mode =
       Lib_flags.L.include_flags ~project ~direct_libs ~hidden_libs mode lib_config
     in
-    let make_includes_args ~mode groups =
+    let make_includes_args ~mode =
       (let+ direct_libs = direct_requires
        and+ hidden_libs = hidden_requires in
-       Command.Args.S
-         [ iflags direct_libs hidden_libs mode
-         ; Hidden_deps (Lib_file_deps.deps (direct_libs @ hidden_libs) ~groups)
-         ])
+       iflags direct_libs hidden_libs mode)
       |> Resolve.Memo.args
       |> Command.Args.memo
     in
     { ocaml =
-        (let cmi_includes = make_includes_args ~mode:(Ocaml Byte) [ Ocaml Cmi ] in
+        (let cmi_includes = make_includes_args ~mode:(Ocaml Byte) in
          { cmi = cmi_includes
          ; cmo = cmi_includes
-         ; cmx =
-             (let+ direct_libs = direct_requires
-              and+ hidden_libs = hidden_requires in
-              Command.Args.S
-                [ iflags direct_libs hidden_libs (Ocaml Native)
-                ; Hidden_deps
-                    (let libs = direct_libs @ hidden_libs in
-                     if opaque
-                     then
-                       List.map libs ~f:(fun lib ->
-                         ( lib
-                         , if Lib.is_local lib
-                           then [ Lib_file_deps.Group.Ocaml Cmi ]
-                           else [ Ocaml Cmi; Ocaml Cmx ] ))
-                       |> Lib_file_deps.deps_with_exts
-                     else
-                       Lib_file_deps.deps
-                         libs
-                         ~groups:[ Lib_file_deps.Group.Ocaml Cmi; Ocaml Cmx ])
-                ])
-             |> Resolve.Memo.args
-             |> Command.Args.memo
+         ; cmx = make_includes_args ~mode:(Ocaml Native)
          })
     ; melange =
-        { cmi = make_includes_args ~mode:Melange [ Melange Cmi ]
-        ; cmj = make_includes_args ~mode:Melange [ Melange Cmi; Melange Cmj ]
-        }
+        { cmi = make_includes_args ~mode:Melange; cmj = make_includes_args ~mode:Melange }
     }
   ;;
 
@@ -91,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
@@ -118,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
@@ -240,8 +219,12 @@ let create
   ; requires_link
   ; implements
   ; parameters
-  ; includes =
-      Includes.make ~project ~opaque ~direct_requires ~hidden_requires ocaml.lib_config
+  ; 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
@@ -333,7 +316,6 @@ let for_module_generated_at_link_time cctx ~requires ~module_ =
     let direct_requires = requires in
     Includes.make
       ~project:(Scope.project cctx.scope)
-      ~opaque
       ~direct_requires
       ~hidden_requires
       cctx.ocaml.lib_config
@@ -343,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/dep_rules.ml

@@ -131,9 +131,6 @@ let deps_of_vlib_module ~obj_dir ~vimpl ~dir ~sctx ~ml_kind ~for_ sourced_module
     Ocamldep.read_deps_of ~obj_dir:vlib_obj_dir ~modules ~ml_kind ~for_ m
 ;;
 
-(** Tests whether a set of modules is a singleton *)
-let has_single_file modules = Option.is_some @@ Modules.With_vlib.as_singleton modules
-
 let rec deps_of
           ~obj_dir
           ~modules
@@ -153,7 +150,7 @@ let rec deps_of
        | Root | Alias _ -> true
        | _ -> false)
   in
-  if is_alias_or_root || has_single_file modules
+  if is_alias_or_root
   then Memo.return (Action_builder.return [])
   else (
     let skip_if_source_absent f sourced_module =
@@ -187,18 +184,15 @@ let read_deps_of_module ~modules ~obj_dir dep ~for_ =
   | Root | Alias _ -> Action_builder.return []
   | Wrapped_compat -> wrapped_compat_deps modules unit |> Action_builder.return
   | _ ->
-    if has_single_file modules
-    then Action_builder.return []
-    else (
-      match dep with
-      | Immediate (unit, ml_kind) ->
-        Ocamldep.read_immediate_deps_of ~obj_dir ~modules ~ml_kind ~for_ unit
-      | Transitive (unit, ml_kind) ->
-        let open Action_builder.O in
-        let+ deps = Ocamldep.read_deps_of ~obj_dir ~modules ~ml_kind ~for_ unit in
-        (match Modules.With_vlib.alias_for modules unit with
-         | [] -> deps
-         | aliases -> aliases @ deps))
+    (match dep with
+     | Immediate (unit, ml_kind) ->
+       Ocamldep.read_immediate_deps_of ~obj_dir ~modules ~ml_kind ~for_ unit
+     | Transitive (unit, ml_kind) ->
+       let open Action_builder.O in
+       let+ deps = Ocamldep.read_deps_of ~obj_dir ~modules ~ml_kind ~for_ unit in
+       (match Modules.With_vlib.alias_for modules unit with
+        | [] -> deps
+        | aliases -> aliases @ deps))
 ;;
 
 let read_immediate_deps_of ~obj_dir ~modules ~ml_kind ~for_ m =
@@ -223,15 +217,12 @@ let for_module ~obj_dir ~modules ~sandbox ~impl ~dir ~sctx ~for_ module_ =
 ;;
 
 let rules ~obj_dir ~modules ~sandbox ~impl ~sctx ~dir ~for_ =
-  match Modules.With_vlib.as_singleton modules with
-  | Some m -> Memo.return (Dep_graph.Ml_kind.dummy m)
-  | None ->
-    dict_of_func_concurrently (fun ~ml_kind ->
-      let+ per_module =
-        Modules.With_vlib.obj_map modules
-        |> Parallel_map.parallel_map ~f:(fun _obj_name m ->
-          deps_of ~obj_dir ~modules ~sandbox ~impl ~sctx ~dir ~ml_kind ~for_ m)
-      in
-      Dep_graph.make ~dir ~per_module)
-    |> Memo.map ~f:(Dep_graph.Ml_kind.for_module_compilation ~modules)
+  dict_of_func_concurrently (fun ~ml_kind ->
+    let+ per_module =
+      Modules.With_vlib.obj_map modules
+      |> Parallel_map.parallel_map ~f:(fun _obj_name m ->
+        deps_of ~obj_dir ~modules ~sandbox ~impl ~sctx ~dir ~ml_kind ~for_ m)
+    in
+    Dep_graph.make ~dir ~per_module)
+  |> Memo.map ~f:(Dep_graph.Ml_kind.for_module_compilation ~modules)
 ;;

src/dune_rules/lib_file_deps.ml

@@ -48,9 +48,41 @@ let deps_of_lib (lib : Lib.t) ~groups =
   |> Dep.Set.of_list
 ;;
 
-let deps_with_exts = Dep.Set.union_map ~f:(fun (lib, groups) -> deps_of_lib lib ~groups)
+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) entries =
+  let groups, cm_kinds =
+    match cm_kind with
+    | 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
+  List.map entries ~f:(fun ((lib : Lib.t), mod_opt) ->
+    let is_opaque_local =
+      match cm_kind with
+      | Ocaml Cmx -> opaque && Lib.is_local lib
+      | _ -> false
+    in
+    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 =
   | Allow_all
   | Disallow_external of Lib_name.t
@@ -82,3 +114,119 @@ 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 _ ->
+         (match Lib_info.modules info ~for_ with
+          | Lib_info.Source.External (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
+            Resolve.Memo.return (Some ((name, None) :: inner_names))
+          | _ -> 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