Skip to content

Commit 93a528b

Browse files
committed
perf: cache the per-(dep_m, ml_kind, cm_kind, is_consumer) raw-refs builder
In [module_compilation.ml]'s [lib_deps_for_module], each consumer module iterates over [m :: trans_deps] and calls [read_dep_m_raw] per dep. Sibling consumers in the same stanza share large parts of [trans_deps] but used to reconstruct fresh [Action_builder.t] trees per call — the inner [ocamldep] result is shared via [Ocamldep]'s path-keyed cache, but the wrapping [need_impl_deps_of] / [Module_name.Set.union] logic was rebuilt N×K times per stanza. Add a per-cctx [Raw_refs.t = (Key.t, _ Action_builder.t) Table.t] in [Compilation_context], keyed on (obj_name, ml_kind, cm_kind, is_consumer). [Table.find] short-circuits before allocating, mirroring the pattern used by [Ocamldep.read_immediate_deps_words]'s top-level cache. Two prior attempts at this memoisation failed: * Apr 21 (`e1b638664`, reverted): recursive memo across direct module deps; infinite loop on module-level cycles (`alias/check-alias/ocamldep-cycles.t`). * Apr 25 (`3a70bfaa0`, dropped): seen-set shape; OOM-killed CI because [Action_builder.memoize] dedupes evaluation by string key but does NOT dedupe construction. With N modules × M consumers, each call still allocated a fresh [Action_builder.t] tree before the memoize wrapper saw the key. This third attempt avoids both failure modes: the [Table.find] short-circuit prevents construction-time blowup, and the cache is intra-stanza only (the cross-library walk has its own [seen]-set termination), so module-level cycles are not visited by this loop. Addresses art-w's review concern at https://github.com/ocaml/dune/pull/14116/files#r3116025155 Signed-off-by: Robin Bate Boerop <me@robinbb.com>
1 parent 1e0dfeb commit 93a528b

3 files changed

Lines changed: 121 additions & 15 deletions

File tree

src/dune_rules/compilation_context.ml

Lines changed: 74 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -37,6 +37,66 @@ end
3737
kept_libs). Two consumer modules with the same kept-libs share one [Args.t].
3838
Cache is per-cctx, so regenerating the cctx (e.g. on a [(libraries ...)]
3939
edit) discards it — the requires-split need not be in the key. *)
40+
(* Cache the raw-refs Action_builder built for each [(dep_m,
41+
ml_kind, cm_kind, is_consumer)] tuple within a single cctx.
42+
Sibling consumers iterate over overlapping [trans_deps] sets;
43+
without this cache each call reconstructs a fresh
44+
[Action_builder.t] tree (the inner [ocamldep] result is shared,
45+
but the wrapping per-module logic is rebuilt N times per
46+
stanza). [Table.find] short-circuits before allocating. *)
47+
module Raw_refs = struct
48+
module Key = struct
49+
type t =
50+
{ obj_name : Module_name.Unique.t
51+
; ml_kind : Ml_kind.t
52+
; cm_kind : Lib_mode.Cm_kind.t
53+
; is_consumer : bool
54+
}
55+
56+
let cm_kind_tag : Lib_mode.Cm_kind.t -> int = function
57+
| Ocaml Cmi -> 0
58+
| Ocaml Cmo -> 1
59+
| Ocaml Cmx -> 2
60+
| Melange Cmi -> 3
61+
| Melange Cmj -> 4
62+
;;
63+
64+
let ml_kind_tag : Ml_kind.t -> int = function
65+
| Intf -> 0
66+
| Impl -> 1
67+
;;
68+
69+
let equal a b =
70+
Module_name.Unique.equal a.obj_name b.obj_name
71+
&& ml_kind_tag a.ml_kind = ml_kind_tag b.ml_kind
72+
&& cm_kind_tag a.cm_kind = cm_kind_tag b.cm_kind
73+
&& Bool.equal a.is_consumer b.is_consumer
74+
;;
75+
76+
let hash { obj_name; ml_kind; cm_kind; is_consumer } =
77+
Poly.hash
78+
( Module_name.Unique.to_string obj_name
79+
, ml_kind_tag ml_kind
80+
, cm_kind_tag cm_kind
81+
, is_consumer )
82+
;;
83+
84+
let to_dyn { obj_name; ml_kind; cm_kind; is_consumer } =
85+
let open Dyn in
86+
record
87+
[ "obj_name", Module_name.Unique.to_dyn obj_name
88+
; "ml_kind", string (Ml_kind.to_string ml_kind)
89+
; "cm_kind", Lib_mode.Cm_kind.to_dyn cm_kind
90+
; "is_consumer", bool is_consumer
91+
]
92+
;;
93+
end
94+
95+
type t = (Key.t, Module_name.Set.t Action_builder.t) Table.t
96+
97+
let create () : t = Table.create (module Key) 64
98+
end
99+
40100
module Filtered_includes = struct
41101
module Key = struct
42102
type t =
@@ -113,6 +173,7 @@ type t =
113173
; ocaml : Ocaml_toolchain.t
114174
; for_ : Compilation_mode.t
115175
; filtered_includes : Filtered_includes.t
176+
; raw_refs : Raw_refs.t
116177
}
117178

118179
let loc t = t.loc
@@ -377,11 +438,24 @@ let create
377438
; instances
378439
; for_
379440
; filtered_includes = Filtered_includes.create ()
441+
; raw_refs = Raw_refs.create ()
380442
}
381443
;;
382444

383445
let for_ t = t.for_
384446

447+
let cached_raw_refs t ~dep_m ~ml_kind ~cm_kind ~is_consumer compute =
448+
let cache_key =
449+
{ Raw_refs.Key.obj_name = Module.obj_name dep_m; ml_kind; cm_kind; is_consumer }
450+
in
451+
match Table.find t.raw_refs cache_key with
452+
| Some builder -> builder
453+
| None ->
454+
let builder = compute () in
455+
Table.set t.raw_refs cache_key builder;
456+
builder
457+
;;
458+
385459
let filtered_include_flags t ~cm_kind ~kept_libs =
386460
let lib_mode = Lib_mode.of_cm_kind cm_kind in
387461
let cache_key =

src/dune_rules/compilation_context.mli

Lines changed: 15 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -64,6 +64,21 @@ val requires_compile : t -> Lib.t list Resolve.Memo.t
6464
val parameters : t -> Module_name.t list Resolve.Memo.t
6565
val includes : t -> Command.Args.without_targets Command.Args.t Lib_mode.Cm_kind.Map.t
6666

67+
(** Memoise the raw-refs [Action_builder.t] computed for each
68+
[(dep_m, ml_kind, cm_kind, is_consumer)] tuple within this
69+
cctx. [compute ()] is invoked only on cache miss; subsequent
70+
callers with the same key get the cached builder back. The
71+
cache short-circuits before allocating, so siblings sharing
72+
[trans_deps] don't redo construction. *)
73+
val cached_raw_refs
74+
: t
75+
-> dep_m:Module.t
76+
-> ml_kind:Ml_kind.t
77+
-> cm_kind:Lib_mode.Cm_kind.t
78+
-> is_consumer:bool
79+
-> (unit -> Module_name.Set.t Action_builder.t)
80+
-> Module_name.Set.t Action_builder.t
81+
6782
(** Include flags ([-I]/[-H]) filtered to a [kept_libs] subset of
6883
the cctx's [requires_compile] / [requires_hidden] (direct +
6984
hidden split preserved). Cached per

src/dune_rules/module_compilation.ml

Lines changed: 32 additions & 15 deletions
Original file line numberDiff line numberDiff line change
@@ -122,21 +122,38 @@ let lib_deps_for_module ~cctx ~obj_dir ~for_ ~dep_graph ~opaque ~cm_kind ~ml_kin
122122
| Ocaml (Cmi | Cmo) | Melange _ -> false
123123
in
124124
let read_dep_m_raw dep_m ~is_consumer =
125-
let* impl_deps =
126-
if need_impl_deps_of dep_m ~is_consumer
127-
then
128-
Ocamldep.read_immediate_deps_raw_of
129-
~sandbox
130-
~sctx
131-
~obj_dir
132-
~ml_kind:Impl
133-
dep_m
134-
else Action_builder.return Module_name.Set.empty
135-
in
136-
let+ intf_deps =
137-
Ocamldep.read_immediate_deps_raw_of ~sandbox ~sctx ~obj_dir ~ml_kind:Intf dep_m
138-
in
139-
Module_name.Set.union impl_deps intf_deps
125+
(* For trans_deps ([is_consumer = false]) [need_impl_deps_of]
126+
does not read [ml_kind], so the cached builder is the same
127+
for [Impl] and [Intf] passes. Normalising keeps the cache
128+
shareable across both passes. *)
129+
let cache_ml_kind = if is_consumer then ml_kind else Ml_kind.Impl in
130+
Compilation_context.cached_raw_refs
131+
cctx
132+
~dep_m
133+
~ml_kind:cache_ml_kind
134+
~cm_kind
135+
~is_consumer
136+
(fun () ->
137+
let* impl_deps =
138+
if need_impl_deps_of dep_m ~is_consumer
139+
then
140+
Ocamldep.read_immediate_deps_raw_of
141+
~sandbox
142+
~sctx
143+
~obj_dir
144+
~ml_kind:Impl
145+
dep_m
146+
else Action_builder.return Module_name.Set.empty
147+
in
148+
let+ intf_deps =
149+
Ocamldep.read_immediate_deps_raw_of
150+
~sandbox
151+
~sctx
152+
~obj_dir
153+
~ml_kind:Intf
154+
dep_m
155+
in
156+
Module_name.Set.union impl_deps intf_deps)
140157
in
141158
let* m_raw = read_dep_m_raw m ~is_consumer:true in
142159
let* trans_raw =

0 commit comments

Comments
 (0)