perf: memoise [Lib.closure] keyed on (linking, for_, libs)

doc/changes/added/14492.md

@@ -0,0 +1,7 @@
+- Filter inter-library dependencies per-module using `ocamldep` output, and
+  match the `-I`/`-H` include flags to that filter. When a dependency
+  library's cmi changes, only consumer modules that reference it get rebuilt
+  — eliminating spurious recompilations of unrelated sibling modules.
+  Applies to unwrapped dependency libraries; wrapped libraries continue to
+  use a glob over the whole library's objdir. (#14492, fixes #4572,
+  @robinbb)

src/dune_lang/lib_mode.ml

@@ -11,6 +11,12 @@ let equal x y =
   | Melange, Melange -> true
 ;;
 
+let hash = function
+  | Ocaml Byte -> 0
+  | Ocaml Native -> 1
+  | Melange -> 2
+;;
+
 let decode =
   let open Decoder in
   enum [ "byte", Ocaml Byte; "native", Ocaml Native; "melange", Melange ]

src/dune_lang/lib_mode.mli

@@ -6,6 +6,7 @@ type t =
 
 val decode : t Decoder.t
 val equal : t -> t -> bool
+val hash : t -> int
 val to_dyn : t -> Dyn.t
 
 module Cm_kind : sig

src/dune_rules/compilation_context.ml

@@ -33,6 +33,109 @@ module Includes = struct
   let empty = Lib_mode.Cm_kind.Map.make_all Command.Args.empty
 end
 
+module Raw_refs = struct
+  module Key = struct
+    type t =
+      | Consumer of
+          { obj_name : Module_name.Unique.t
+          ; ml_kind : Ml_kind.t
+          }
+      | Transitive of
+          { obj_name : Module_name.Unique.t
+          ; cm_kind : Lib_mode.Cm_kind.t
+          }
+
+    let cm_kind_tag : Lib_mode.Cm_kind.t -> int = function
+      | Ocaml Cmi -> 0
+      | Ocaml Cmo -> 1
+      | Ocaml Cmx -> 2
+      | Melange Cmi -> 3
+      | Melange Cmj -> 4
+    ;;
+
+    let ml_kind_tag : Ml_kind.t -> int = function
+      | Intf -> 0
+      | Impl -> 1
+    ;;
+
+    let equal a b =
+      match a, b with
+      | Consumer a, Consumer b ->
+        Module_name.Unique.equal a.obj_name b.obj_name
+        && ml_kind_tag a.ml_kind = ml_kind_tag b.ml_kind
+      | Transitive a, Transitive b ->
+        Module_name.Unique.equal a.obj_name b.obj_name
+        && cm_kind_tag a.cm_kind = cm_kind_tag b.cm_kind
+      | Consumer _, Transitive _ | Transitive _, Consumer _ -> false
+    ;;
+
+    let hash = function
+      | Consumer { obj_name; ml_kind } -> Poly.hash (0, obj_name, ml_kind_tag ml_kind)
+      | Transitive { obj_name; cm_kind } -> Poly.hash (1, obj_name, cm_kind_tag cm_kind)
+    ;;
+
+    let repr =
+      let open Repr in
+      let obj_name_repr = view string ~to_:Module_name.Unique.to_string in
+      let ml_kind_repr = view string ~to_:Ml_kind.to_string in
+      let cm_kind_repr = abstract Lib_mode.Cm_kind.to_dyn in
+      variant
+        "Raw_refs.Key"
+        [ case "Consumer" (pair obj_name_repr ml_kind_repr) ~proj:(function
+            | Consumer { obj_name; ml_kind } -> Some (obj_name, ml_kind)
+            | Transitive _ -> None)
+        ; case "Transitive" (pair obj_name_repr cm_kind_repr) ~proj:(function
+            | Transitive { obj_name; cm_kind } -> Some (obj_name, cm_kind)
+            | Consumer _ -> None)
+        ]
+    ;;
+
+    let to_dyn = Repr.to_dyn repr
+  end
+
+  type t = (Key.t, Module_name.Set.t Action_builder.t) Table.t
+
+  let create () : t = Table.create (module Key) 64
+end
+
+(* Key omits [t.requires_compile] / [t.requires_hidden] because they're
+   immutable on the cctx from [create]. The exception —
+   [for_module_generated_at_link_time]'s derived cctxs — takes the
+   [can_filter = false] arm in [lib_deps_for_module] and so never reaches this
+   cache. *)
+module Filtered_includes = struct
+  module Key = struct
+    type t =
+      { lib_mode : Lib_mode.t
+      ; kept_libs : Lib.Set.t
+      }
+
+    let equal a b =
+      Lib_mode.equal a.lib_mode b.lib_mode && Lib.Set.equal a.kept_libs b.kept_libs
+    ;;
+
+    let hash { lib_mode; kept_libs } =
+      Lib.Set.fold kept_libs ~init:(Lib_mode.hash lib_mode) ~f:(fun lib acc ->
+        acc lxor Lib.hash lib)
+    ;;
+
+    let repr =
+      Repr.record
+        "Filtered_includes.Key"
+        [ Repr.field "lib_mode" (Repr.abstract Lib_mode.to_dyn) ~get:(fun t -> t.lib_mode)
+        ; Repr.field "kept_libs" (Repr.abstract Lib.Set.to_dyn) ~get:(fun t ->
+            t.kept_libs)
+        ]
+    ;;
+
+    let to_dyn = Repr.to_dyn repr
+  end
+
+  type t = (Key.t, Command.Args.without_targets Command.Args.t Action_builder.t) Table.t
+
+  let create () : t = Table.create (module Key) 16
+end
+
 type opaque =
   | Explicit of bool
   | Inherit_from_settings
@@ -81,6 +184,8 @@ type t =
   ; loc : Loc.t option
   ; ocaml : Ocaml_toolchain.t
   ; for_ : Compilation_mode.t
+  ; filtered_includes : Filtered_includes.t
+  ; raw_refs : Raw_refs.t
   }
 
 let loc t = t.loc
@@ -335,11 +440,54 @@ let create
   ; ocaml
   ; instances
   ; for_
+  ; filtered_includes = Filtered_includes.create ()
+  ; raw_refs = Raw_refs.create ()
   }
 ;;
 
 let for_ t = t.for_
 
+let cached_raw_refs t ~key ~compute =
+  match Table.find t.raw_refs key with
+  | Some builder -> builder
+  | None ->
+    let builder = compute () in
+    Table.set t.raw_refs key builder;
+    builder
+;;
+
+let filtered_include_flags t ~cm_kind ~kept_libs =
+  let lib_mode = Lib_mode.of_cm_kind cm_kind in
+  let cache_key = { Filtered_includes.Key.lib_mode; kept_libs } in
+  match Table.find t.filtered_includes cache_key with
+  | Some builder -> builder
+  | None ->
+    (* Cache the [Action_builder.t] (not the resolved args) up-front at
+       rule-construction time so all compile rules sharing this
+       [(lib_mode, kept_libs)] share one builder; [Action_builder.memoize] then
+       dedupes its evaluation. Mirrors the cache pattern in
+       [Ocamldep.read_immediate_deps_words]. *)
+    let builder =
+      let open Action_builder.O in
+      let* direct_requires = Resolve.Memo.read t.requires_compile in
+      let+ hidden_requires = Resolve.Memo.read t.requires_hidden in
+      let direct_filtered = List.filter direct_requires ~f:(Lib.Set.mem kept_libs) in
+      let hidden_filtered = List.filter hidden_requires ~f:(Lib.Set.mem kept_libs) in
+      let project = Scope.project t.scope in
+      let lib_config = t.ocaml.lib_config in
+      Lib_flags.L.include_flags
+        ~project
+        ~direct_libs:direct_filtered
+        ~hidden_libs:hidden_filtered
+        lib_mode
+        lib_config
+      |> Command.Args.memo
+    in
+    let builder = Action_builder.memoize "filtered_include_flags" builder in
+    Table.set t.filtered_includes cache_key builder;
+    builder
+;;
+
 let alias_and_root_module_flags =
   let extra = [ "-w"; "-49" ] in
   fun base -> Ocaml_flags.append_common base extra |> Ocaml_flags.append_nostdlib

src/dune_rules/compilation_context.mli

@@ -63,6 +63,42 @@ 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
+
+module Raw_refs : sig
+  module Key : sig
+    type t =
+      | Consumer of
+          { obj_name : Module_name.Unique.t
+          ; ml_kind : Ml_kind.t
+          }
+      | Transitive of
+          { obj_name : Module_name.Unique.t
+          ; cm_kind : Lib_mode.Cm_kind.t
+          }
+  end
+end
+
+(** Memoise the raw-refs [Action_builder.t] computed for each [Raw_refs.Key.t]
+    within this cctx. [compute ()] is invoked only on cache miss; subsequent
+    callers with the same key get the cached builder back. The cache
+    short-circuits before allocating, so siblings sharing [trans_deps] don't
+    redo construction. *)
+val cached_raw_refs
+  :  t
+  -> key:Raw_refs.Key.t
+  -> compute:(unit -> Module_name.Set.t Action_builder.t)
+  -> Module_name.Set.t Action_builder.t
+
+(** Include flags ([-I]/[-H]) for compiling a module against [kept_libs]. The
+    cctx's [requires_compile] and [requires_hidden] are each restricted to
+    libraries in [kept_libs]; the kept direct entries become [-I], the kept
+    hidden entries become [-H]. *)
+val filtered_include_flags
+  :  t
+  -> cm_kind:Lib_mode.Cm_kind.t
+  -> kept_libs:Lib.Set.t
+  -> Command.Args.without_targets Command.Args.t Action_builder.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

src/dune_rules/dune_package.ml

@@ -336,6 +336,7 @@ module Lib = struct
            ~jsoo_runtime
            ~wasmoo_runtime
            ~preprocess
+           ~stanza_flags:Dune_lang.Ocaml_flags.Spec.standard
            ~enabled
            ~virtual_deps
            ~dune_version

src/dune_rules/findlib.ml

@@ -268,6 +268,7 @@ let to_dune_library (t : Findlib.Package.t) ~dir_contents ~ext_lib ~external_loc
       ~jsoo_runtime
       ~wasmoo_runtime
       ~preprocess
+      ~stanza_flags:Dune_lang.Ocaml_flags.Spec.standard
       ~enabled
       ~virtual_deps
       ~dune_version

src/dune_rules/lib.ml

@@ -2198,11 +2198,51 @@ end = struct
   ;;
 end
 
-let closure l ~linking =
-  let forbidden_libraries = Map.empty in
-  if linking
-  then Resolve_names.linking_closure_with_overlap_checks None l ~forbidden_libraries
-  else Resolve_names.compile_closure_with_overlap_checks None l ~forbidden_libraries
+let closure =
+  let memo =
+    let module Input = struct
+      type nonrec t = bool * Compilation_mode.t * t list
+
+      let equal (l, m, libs) (l', m', libs') =
+        Bool.equal l l' && Compilation_mode.equal m m' && List.equal equal libs libs'
+      ;;
+
+      let hash_for_ = function
+        | Compilation_mode.Ocaml -> 0
+        | Melange -> 1
+      ;;
+
+      let hash (linking, for_, libs) =
+        Tuple.T3.hash
+          Bool.hash
+          hash_for_
+          (List.hash (fun lib -> Id.hash lib.unique_id))
+          (linking, for_, libs)
+      ;;
+
+      let to_dyn = Dyn.opaque
+    end
+    in
+    Memo.create
+      "lib-closure"
+      ~input:(module Input)
+      (fun (linking, for_, l) ->
+         let forbidden_libraries = Map.empty in
+         if linking
+         then
+           Resolve_names.linking_closure_with_overlap_checks
+             None
+             l
+             ~forbidden_libraries
+             ~for_
+         else
+           Resolve_names.compile_closure_with_overlap_checks
+             None
+             l
+             ~forbidden_libraries
+             ~for_)
+  in
+  fun l ~linking ~for_ -> Memo.exec memo (linking, for_, l)
 ;;
 
 let descriptive_closure (l : lib list) ~with_pps ~for_ : lib list Memo.t =

src/dune_rules/lib.mli

@@ -217,6 +217,10 @@ end
 
 (** {1 Transitive closure} *)
 
+(** Memoized. The memo key is order-sensitive on the input list, so for callers
+    that share inputs across invocations (e.g. the hot path in
+    [Module_compilation.lib_deps_for_module]), a canonical sort (by
+    [Lib.compare]) maximises cache reuse. *)
 val closure : t list -> linking:bool -> for_:Compilation_mode.t -> t list Resolve.Memo.t
 
 (** [descriptive_closure ~with_pps libs] computes the smallest set of libraries

src/dune_rules/lib_info.ml

@@ -323,6 +323,7 @@ type 'path t =
   ; allow_unused_libraries : (Loc.t * Lib_name.t) list
   ; preprocess :
       Preprocess.With_instrumentation.t Preprocess.Per_module.t Compilation_mode.By_mode.t
+  ; stanza_flags : Dune_lang.Ocaml_flags.Spec.t
   ; enabled : Enabled_status.t Memo.t
   ; virtual_deps : (Loc.t * Lib_name.t) list
   ; dune_version : Dune_lang.Syntax.Version.t option
@@ -354,6 +355,7 @@ let parameters t = t.parameters
 let requires t ~for_ = Compilation_mode.By_mode.get t.requires ~for_
 let requires_by_mode t = t.requires
 let preprocess t ~for_ = Compilation_mode.By_mode.get t.preprocess ~for_
+let stanza_flags t = t.stanza_flags
 let ppx_runtime_deps t = t.ppx_runtime_deps
 let allow_unused_libraries t = t.allow_unused_libraries
 let sub_systems t = t.sub_systems
@@ -435,6 +437,7 @@ let create
       ~jsoo_runtime
       ~wasmoo_runtime
       ~preprocess
+      ~stanza_flags
       ~enabled
       ~virtual_deps
       ~dune_version
@@ -476,6 +479,7 @@ let create
   ; jsoo_runtime
   ; wasmoo_runtime
   ; preprocess
+  ; stanza_flags
   ; enabled
   ; virtual_deps
   ; dune_version
@@ -575,6 +579,7 @@ let to_dyn
       ; jsoo_runtime
       ; wasmoo_runtime
       ; preprocess = _
+      ; stanza_flags = _
       ; enabled = _
       ; virtual_deps
       ; dune_version

src/dune_rules/lib_info.mli

@@ -170,6 +170,12 @@ val preprocess
   -> for_:Compilation_mode.t
   -> Preprocess.With_instrumentation.t Preprocess.Per_module.t
 
+(** Unexpanded [(flags ...)] from the library's stanza. [Spec.standard] for
+    libraries assembled from META / dune-package files. The per-module narrowing
+    pipeline uses this to recover [-open]-induced cross-library [.cmi] reads
+    that ocamldep cannot see. *)
+val stanza_flags : _ t -> Dune_lang.Ocaml_flags.Spec.t
+
 val sub_systems : _ t -> Sub_system_info.t Sub_system_name.Map.t
 val enabled : _ t -> Enabled_status.t Memo.t
 val orig_src_dir : 'path t -> 'path option
@@ -239,6 +245,7 @@ val create
   -> preprocess:
        Preprocess.With_instrumentation.t Preprocess.Per_module.t
          Compilation_mode.By_mode.t
+  -> stanza_flags:Dune_lang.Ocaml_flags.Spec.t
   -> enabled:Enabled_status.t Memo.t
   -> virtual_deps:(Loc.t * Lib_name.t) list
   -> dune_version:Dune_lang.Syntax.Version.t option