jon.recoil.org
Odoc docs
driver: find virtual libraries' interfaces by probing the cone
A virtual library's implementation ships its modules as .cmt only; the
.mli and its documentation live with the virtual library, whose
directory is on the implementation's dependency cone (dune's
[implements] emits the META requires). So for each module documented
from a .cmt, probe the cone's directories for a same-name .cmti with
the same interface digest (odoc compile-deps reports it) and use that
as the input. The probe needs only the installed cmti file — not a
documented unit and not another package's partial — so it covers, in
one rule: implementations shipped with their virtual library
(digestif, checkseum — for which the old machinery found nothing,
because dune declares such virtual libraries with an empty archive
string and their cmtis never became units), implementations in other
opam packages, and the voodoo-era input_copy stash.
This replaces both remap_virtual (within-package, hash-map based) and
Odoc_unit.fix_virtual (cross-package, partial-fed), and with the
latter goes find_partials — compile scheduling only ever needed this
run's own units, since dependencies' units are found through -I — and
the input_copy field and stashing. Removing the field changes the
marshalled shape of Odoc_unit.t: partial format bumped to v3.
Partials are now written for a single reader: extra_paths_of_partials.
Verified: digestif and checkseum implementations now document from
the virtual cmti under their own ids; astring, fpath, tyxml, logs,
mirage-clock-unix unchanged.
Co-Authored-By: Claude Fable 5 <noreply@anthropic.com>
author
Jon Ludlam
co-author
Claude Fable 5
date
(Jul 15, 2026, 1:27 PM +0100)
commit
095bc334
095bc3349f8175d07beb4ce2320054123bc96157
parent
6c0740ec
6c0740ecc464aecb28d24b7931c0b6d15e9918f1
+104
-219
+2
-2
driver/bin/odd_driver.ml
+2
-2
driver/bin/odd_driver.ml
···
50
50
(all, extra_paths, actions, true, occurrence_file, odocl_dirs)
51
51
in
52
52
53
-
let all = Packages.remap_virtual [ all ] in
53
+
let all = Packages.use_virtual_interfaces [ all ] in
54
54
55
55
(* No digest-based dependency recovery ([Packages.fix_missing_deps]) here:
56
56
the [-I] search path is the library's transitive findlib cone — the same
···
76
76
| LinkAndGen -> units
77
77
| CompileOnly | All ->
78
78
Compile.clean_previous ~odoc_dir all;
79
-
Compile.compile ?partial ~partial_dir:odoc_dir units
79
+
Compile.compile ?partial units
80
80
in
81
81
let () =
82
82
match actions with
+11
-48
driver/compile.ml
+11
-48
driver/compile.ml
···
10
10
their packages are treated as not yet compiled. Bump the version whenever
11
11
[Odoc_unit.t] (or anything it references) changes shape, or when the
12
12
meaning of the recorded paths changes. v2: units are placed next to their
13
-
source cmt/cmti files. *)
14
-
let odoc_partial_filename = "__odoc_partial.v2.m"
15
-
let old_partial_filenames = [ "__odoc_partial.m" ]
13
+
source cmt/cmti files. v3: [input_copy] removed from [Odoc_unit.t]. *)
14
+
let odoc_partial_filename = "__odoc_partial.v3.m"
15
+
let old_partial_filenames = [ "__odoc_partial.m"; "__odoc_partial.v2.m" ]
16
16
17
17
let mk_byhash (pkgs : Odoc_unit.any list) =
18
18
List.fold_left
···
84
84
~finally:(fun () -> close_out oc)
85
85
(fun () -> Marshal.to_channel oc v [])
86
86
87
-
let find_partials odoc_dir :
88
-
Odoc_unit.intf Odoc_unit.t list Util.StringMap.t * _ =
89
-
let tbl = Hashtbl.create 1000 in
90
-
let hashes_result =
91
-
OS.Dir.fold_contents ~dotfiles:false ~elements:`Dirs
92
-
(fun p hashes ->
93
-
let index_m = Fpath.( / ) p odoc_partial_filename in
94
-
match OS.File.exists index_m with
95
-
| Ok true ->
96
-
let hashes' = unmarshal index_m in
97
-
Util.StringMap.iter
98
-
(fun h units ->
99
-
List.iter
100
-
(fun u ->
101
-
Hashtbl.replace tbl
102
-
(h, Odoc.Id.to_string u.Odoc_unit.parent_id)
103
-
(Promise.create_resolved ()))
104
-
units)
105
-
hashes';
106
-
Util.StringMap.union (fun _x o1 _o2 -> Some o1) hashes hashes'
107
-
| _ -> hashes)
108
-
Util.StringMap.empty odoc_dir
109
-
in
110
-
match hashes_result with
111
-
| Ok h -> (h, tbl)
112
-
| Error _ -> (* odoc_dir doesn't exist...? *) (Util.StringMap.empty, tbl)
113
-
114
87
(* The partials written by earlier runs are the driver's record of what has
115
88
been built and where: each unit carries its library name, its package and
116
89
its odoc file (whose directory, with units co-located with their sources,
···
207
180
(odoc_partial_filename :: old_partial_filenames))
208
181
pkgs
209
182
210
-
let compile ?partial ~partial_dir (all : Odoc_unit.any list) =
183
+
let compile ?partial (all : Odoc_unit.any list) =
211
184
let hashes = mk_byhash all in
212
-
let other_hashes, tbl =
213
-
match partial with
214
-
| Some _ -> find_partials partial_dir
215
-
| None -> (Util.StringMap.empty, Hashtbl.create 10)
216
-
in
217
-
let hashes =
218
-
Odoc_unit.fix_virtual ~precompiled_units:other_hashes ~units:hashes
219
-
in
220
-
let all_hashes =
221
-
Util.StringMap.union (fun _x o1 o2 -> Some (o1 @ o2)) hashes other_hashes
222
-
in
185
+
(* Scheduling state: a promise per (hash, parent id) being compiled in this
186
+
run. Dependencies outside the run aren't scheduled — their units are
187
+
already installed next to their sources and are found through [-I]. *)
188
+
let tbl = Hashtbl.create 10 in
189
+
let all_hashes = hashes in
223
190
(* Include set for compiling a unit: its library's transitive findlib cone,
224
191
carried in [pkg_args] — the same search path the compiler used to build
225
192
the library, so every import's [.odoc] file is present, next to the
···
229
196
Fpath.Set.of_list (Odoc_unit.Pkg_args.includes unit.Odoc_unit.pkg_args)
230
197
in
231
198
let compile_mod =
232
-
(* Modules have a more complicated compilation because:
233
-
- They have dependencies and must be compiled in the right order
234
-
- In Voodoo mode, there might exists already compiled parts *)
199
+
(* Modules have dependencies and must be compiled in the right
200
+
order; same-hash units under distinct parent ids compile once each. *)
235
201
let compile_one compile_other (unit : Odoc_unit.intf Odoc_unit.t) =
236
202
let (`Intf ({ deps; _ } : Odoc_unit.intf_extra)) = unit.kind in
237
203
let _fibers =
···
253
219
Odoc.compile ~output_dir:unit.output_dir ~input_file:unit.input_file
254
220
~output_file:unit.odoc_file ~includes ~warnings_tag:unit.pkgname
255
221
~parent_id:unit.parent_id ~ignore_output:(not unit.enable_warnings);
256
-
(match unit.input_copy with
257
-
| None -> ()
258
-
| Some p -> Util.cp (Fpath.to_string unit.input_file) (Fpath.to_string p));
259
222
Atomic.incr Stats.stats.compiled_units
260
223
in
261
224
let rec compile_mod : string -> ('a list, [> `Msg of string ]) Result.t =
+4
-7
driver/compile.mli
+4
-7
driver/compile.mli
···
16
16
so that {!compile} rebuilds them from scratch. Artifacts belonging to
17
17
other packages are untouched. *)
18
18
19
-
val compile :
20
-
?partial:Fpath.t -> partial_dir:Fpath.t -> Odoc_unit.any list -> compiled list
21
-
(** Use [partial] to reuse the output of a previous call to [compile]. Useful in
22
-
the voodoo context.
23
-
24
-
[output_dir] is the directory for [odoc] file, [linked_dir] is the one for
25
-
[odocl] files (defaulting to [output_dir] when absent). *)
19
+
val compile : ?partial:Fpath.t -> Odoc_unit.any list -> compiled list
20
+
(** [partial] names the directory in which to record this run's units (the
21
+
package's partial), read back by {!extra_paths_of_partials} in later
22
+
runs. *)
26
23
27
24
type linked
28
25
-1
driver/landing_pages.ml
-1
driver/landing_pages.ml
-70
driver/odoc_unit.ml
-70
driver/odoc_unit.ml
···
84
84
type 'a t = {
85
85
parent_id : Odoc.Id.t;
86
86
input_file : Fpath.t;
87
-
input_copy : Fpath.t option;
88
-
(* Used to stash cmtis from virtual libraries into the odoc dir for voodoo mode.
89
-
See https://github.com/ocaml/odoc/pull/1309 *)
90
87
output_dir : Fpath.t;
91
88
odoc_file : Fpath.t;
92
89
odocl_file : Fpath.t;
···
181
178
index_dir : Fpath.t;
182
179
mld_dir : Fpath.t;
183
180
}
184
-
185
-
let fix_virtual ~(precompiled_units : intf t list Util.StringMap.t)
186
-
~(units : intf t list Util.StringMap.t) =
187
-
Logs.debug (fun m ->
188
-
m "Fixing virtual libraries: %d precompiled units, %d other units"
189
-
(Util.StringMap.cardinal precompiled_units)
190
-
(Util.StringMap.cardinal units));
191
-
let all =
192
-
Util.StringMap.union
193
-
(fun h x y ->
194
-
Logs.debug (fun m ->
195
-
m "Unifying hash %s (%d, %d)" h (List.length x) (List.length y));
196
-
Some (x @ y))
197
-
precompiled_units units
198
-
in
199
-
Util.StringMap.map
200
-
(fun units ->
201
-
List.map
202
-
(fun unit ->
203
-
let uhash = match unit.kind with `Intf { hash; _ } -> hash in
204
-
if not (Fpath.has_ext "cmt" unit.input_file) then unit
205
-
else
206
-
match Util.StringMap.find uhash all with
207
-
| [ _ ] -> unit
208
-
| xs -> (
209
-
let unit_name =
210
-
Fpath.rem_ext unit.input_file |> Fpath.basename
211
-
in
212
-
match
213
-
List.filter
214
-
(fun (x : intf t) ->
215
-
(match x.kind with `Intf { hash; _ } -> uhash = hash)
216
-
&& Fpath.has_ext "cmti" x.input_file
217
-
&& Fpath.rem_ext x.input_file |> Fpath.basename
218
-
= unit_name)
219
-
xs
220
-
with
221
-
| [ x ] -> { unit with input_file = x.input_file }
222
-
| xs -> (
223
-
Logs.debug (fun m ->
224
-
m
225
-
"Duplicate hash found, but multiple (%d) matching \
226
-
cmti found for %a"
227
-
(List.length xs) Fpath.pp unit.input_file);
228
-
let possibles =
229
-
List.find_map
230
-
(fun x ->
231
-
match x.input_copy with
232
-
| Some x ->
233
-
if
234
-
x |> Bos.OS.File.exists
235
-
|> Result.value ~default:false
236
-
then Some x
237
-
else None
238
-
| None -> None)
239
-
xs
240
-
in
241
-
match possibles with
242
-
| None ->
243
-
Logs.debug (fun m -> m "Not replacing input file");
244
-
unit
245
-
| Some x ->
246
-
Logs.debug (fun m ->
247
-
m "Replacing input_file of unit with %a" Fpath.pp x);
248
-
{ unit with input_file = x })))
249
-
units)
250
-
units
-20
driver/odoc_unit.mli
-20
driver/odoc_unit.mli
···
38
38
type 'a t = {
39
39
parent_id : Odoc.Id.t;
40
40
input_file : Fpath.t;
41
-
input_copy : Fpath.t option;
42
-
(* Used to stash cmtis from virtual libraries into the odoc dir for voodoo mode *)
43
41
output_dir : Fpath.t;
44
42
odoc_file : Fpath.t;
45
43
odocl_file : Fpath.t;
···
87
85
index_dir : Fpath.t;
88
86
mld_dir : Fpath.t;
89
87
}
90
-
91
-
val fix_virtual :
92
-
precompiled_units:intf t list Util.StringMap.t ->
93
-
units:intf t list Util.StringMap.t ->
94
-
intf t list Util.StringMap.t
95
-
(** [fix_virtual ~precompiled_units ~units] replaces the input file in units
96
-
representing implementations of virtual libraries. Implementation units have
97
-
a [cmt] but no [cmti], even though the interface is actually constrained by
98
-
a [mli]. The [cmi] file for the implementation is actually taken from the
99
-
virtual library, so this function replaces the [cmt] used for the interface
100
-
rendering of the implemenetation library units with the [cmti] taken from
101
-
the virtual library. [units] should contain all the units that might be
102
-
changed by this function. [precompiled_units] should be empty if this is
103
-
being called before any compilation has taken place - ie. in monorepo or
104
-
opam mode. In voodoo mode if the virtual library is in a different package
105
-
it will have already been compiled. and thus should not be changed. The
106
-
types of the inputs and outputs are hashtbls of units, where the hashtable
107
-
key is the interface hash. *)
+8
-19
driver/odoc_units_of.ml
+8
-19
driver/odoc_units_of.ml
···
17
17
its cmt/cmti files, which is where the .odoc/.odocl files are placed (the
18
18
URL-space directory is [lib_dir], used for parent ids). For libraries
19
19
outside [pkgs] — already-compiled dependencies — [extra_libs_paths]
20
-
supplies the same information, recovered from the lib markers. *)
20
+
supplies the same information, recovered from their partials. *)
21
21
let lib_dirs =
22
22
let open Packages in
23
23
let lds = extra_libs_paths in
···
107
107
the documented convention it is the direct scope, not a transitive
108
108
closure: the package's own libraries, their directly-declared META
109
109
dependencies, and anything named in [odoc-config.sexp] (directly, or via
110
-
a named package). Dependencies the META files omit entirely are recovered
111
-
beforehand by digest ([Packages.fix_missing_deps]). [-P] is every package
110
+
a named package). [-P] is every package
112
111
that provides one of those libraries, plus the package itself and any
113
112
package named in [odoc-config.sexp].
114
113
···
205
204
in
206
205
207
206
let make_unit ?unit_dir ~name ~kind ~rel_dir ~input_file ~pkg ~lib_deps
208
-
~enable_warnings ~to_output ~stash_input () : _ t =
207
+
~enable_warnings ~to_output () : _ t =
209
208
let to_output = to_output || not remap in
210
209
(* If we haven't got active remapping, we output everything *)
211
210
let ( // ) = Fpath.( // ) in
···
224
223
let odoc_file = odoc_base / (String.uncapitalize_ascii name ^ ".odoc") in
225
224
(* odoc will uncapitalise the output filename *)
226
225
let odocl_file = odocl_base / (String.uncapitalize_ascii name ^ ".odocl") in
227
-
let input_copy =
228
-
if stash_input then
229
-
Some (odoc_dir // rel_dir / (String.uncapitalize_ascii name ^ ".cmti"))
230
-
else None
231
-
in
232
226
{
233
227
output_dir = odoc_dir;
234
228
pkgname = Some pkg.Packages.name;
235
229
pkg_args;
236
230
parent_id;
237
231
input_file;
238
-
input_copy;
239
232
odoc_file;
240
233
odocl_file;
241
234
kind;
···
256
249
kind
257
250
in
258
251
let name = intf.mif_path |> Fpath.rem_ext |> Fpath.basename in
259
-
let stash_input = lib.archive_name = None in
260
252
(* Anchor the output in this library's own directory, not the input
261
253
file's: for a virtual library's implementation, [mif_path] is the
262
254
virtual library's cmti ([Packages.remap_virtual]) — anchoring on it
···
265
257
[input_file] later; the output stays put either way.) *)
266
258
make_unit ~unit_dir:lib.Packages.dir ~name ~kind ~rel_dir
267
259
~input_file:intf.mif_path ~pkg ~lib_deps ~enable_warnings:pkg.selected
268
-
~to_output:pkg.selected ~stash_input ()
260
+
~to_output:pkg.selected ()
269
261
in
270
262
let of_impl pkg lib lib_deps (impl : Packages.impl) : impl t option =
271
263
match impl.mip_src_info with
···
286
278
let unit =
287
279
make_unit ~unit_dir:lib.Packages.dir ~name ~kind ~rel_dir
288
280
~input_file:impl.mip_path ~pkg ~lib_deps ~enable_warnings:false
289
-
~to_output:pkg.selected ~stash_input:false ()
281
+
~to_output:pkg.selected ()
290
282
in
291
283
Some unit
292
284
in
···
321
313
in
322
314
let unit =
323
315
make_unit ~name ~kind ~rel_dir ~input_file:mld_path ~pkg ~lib_deps
324
-
~enable_warnings:pkg.selected ~to_output:pkg.selected ~stash_input:false
325
-
()
316
+
~enable_warnings:pkg.selected ~to_output:pkg.selected ()
326
317
in
327
318
[ unit ]
328
319
in
···
342
333
let lib_deps = Util.StringSet.empty in
343
334
let unit =
344
335
make_unit ~name ~kind ~rel_dir ~input_file:md_path ~pkg ~lib_deps
345
-
~enable_warnings:pkg.selected ~to_output:pkg.selected
346
-
~stash_input:false ()
336
+
~enable_warnings:pkg.selected ~to_output:pkg.selected ()
347
337
in
348
338
[ unit ]
349
339
| _ ->
···
361
351
let unit =
362
352
let name = asset_path |> Fpath.basename |> ( ^ ) "asset-" in
363
353
make_unit ~name ~kind ~rel_dir ~input_file:asset_path ~pkg
364
-
~lib_deps:Util.StringSet.empty ~enable_warnings:false ~to_output:true
365
-
~stash_input:false ()
354
+
~lib_deps:Util.StringSet.empty ~enable_warnings:false ~to_output:true ()
366
355
in
367
356
[ unit ]
368
357
in
+72
-51
driver/packages.ml
+72
-51
driver/packages.ml
···
553
553
Logs.debug (fun m -> m "Packages: %a" Fmt.Dump.(list pp) res);
554
554
res
555
555
556
-
let remap_virtual_interfaces duplicate_hashes pkgs =
556
+
(* A virtual library's implementation ships its modules as .cmt only: the
557
+
.mli — and its documentation — belong to the virtual library, whose
558
+
directory is on the implementation's dependency cone (dune's [implements]
559
+
puts the virtual library in the implementation's META [requires]). For
560
+
each module documented from a .cmt, look for a same-name .cmti with the
561
+
same interface digest in the cone's directories and use it as the input
562
+
instead. This covers both a package shipping the virtual library together
563
+
with its implementations (digestif, checkseum) and implementations living
564
+
in a different opam package from their virtual library; the probe needs
565
+
only the installed cmti file, not a documented unit. *)
566
+
let use_virtual_interfaces pkgs =
567
+
(* Several implementations typically probe the same cmti. *)
568
+
let deps_of_cmti = Hashtbl.create 8 in
569
+
let cmti_deps path =
570
+
match Hashtbl.find_opt deps_of_cmti path with
571
+
| Some r -> r
572
+
| None ->
573
+
let r = Odoc.compile_deps path in
574
+
Hashtbl.add deps_of_cmti path r;
575
+
r
576
+
in
577
+
let cone_dirs =
578
+
let cache = Hashtbl.create 8 in
579
+
fun lib_deps ->
580
+
let key = String.concat " " (Util.StringSet.elements lib_deps) in
581
+
match Hashtbl.find_opt cache key with
582
+
| Some r -> r
583
+
| None ->
584
+
let cone =
585
+
match Ocamlfind.deps (Util.StringSet.elements lib_deps) with
586
+
| Ok deep -> Util.StringSet.union lib_deps deep
587
+
| Error _ -> lib_deps
588
+
in
589
+
let r =
590
+
Util.StringSet.fold
591
+
(fun name acc ->
592
+
match Ocamlfind.get_dir name with
593
+
| Ok dir -> Fpath.Set.add dir acc
594
+
| Error _ -> acc)
595
+
cone Fpath.Set.empty
596
+
|> Fpath.Set.elements
597
+
in
598
+
Hashtbl.add cache key r;
599
+
r
600
+
in
601
+
let swap lib m =
602
+
let { mif_path; mif_hash; _ } = m.m_intf in
603
+
if not (Fpath.has_ext "cmt" mif_path) then m
604
+
else
605
+
let cmti_name = Fpath.(basename (set_ext "cmti" mif_path)) in
606
+
let candidate =
607
+
List.find_map
608
+
(fun dir ->
609
+
let path = Fpath.(dir / cmti_name) in
610
+
if Bos.OS.File.exists path |> Result.value ~default:false then
611
+
match cmti_deps path with
612
+
| Ok { Odoc.digest; deps } when digest = mif_hash ->
613
+
Some { mif_path = path; mif_hash; mif_deps = deps }
614
+
| _ -> None
615
+
else None)
616
+
(cone_dirs lib.lib_deps)
617
+
in
618
+
match candidate with
619
+
| None -> m
620
+
| Some m_intf ->
621
+
Logs.debug (fun f ->
622
+
f "Documenting %s from %a" m.m_name Fpath.pp m_intf.mif_path);
623
+
{ m with m_intf }
624
+
in
557
625
List.map
558
626
(fun pkg ->
559
627
{
560
628
pkg with
561
629
libraries =
562
-
pkg.libraries
563
-
|> List.map (fun lib ->
564
-
{
565
-
lib with
566
-
modules =
567
-
lib.modules
568
-
|> List.map (fun m ->
569
-
let m_intf =
570
-
if
571
-
Util.StringMap.mem m.m_intf.mif_hash
572
-
duplicate_hashes
573
-
&& Fpath.has_ext "cmt" m.m_intf.mif_path
574
-
then
575
-
match
576
-
List.filter
577
-
(fun intf ->
578
-
Fpath.has_ext "cmti" intf.mif_path)
579
-
(Util.StringMap.find m.m_intf.mif_hash
580
-
duplicate_hashes)
581
-
with
582
-
| [ x ] -> x
583
-
| _ -> m.m_intf
584
-
else m.m_intf
585
-
in
586
-
{ m with m_intf });
587
-
});
630
+
List.map
631
+
(fun lib -> { lib with modules = List.map (swap lib) lib.modules })
632
+
pkg.libraries;
588
633
})
589
634
pkgs
590
-
591
-
let remap_virtual all =
592
-
let virtual_check =
593
-
let hashes =
594
-
List.fold_left
595
-
(fun acc pkg ->
596
-
List.fold_left
597
-
(fun acc lib ->
598
-
List.fold_left
599
-
(fun acc m ->
600
-
let hash = m.m_intf.mif_hash in
601
-
Util.StringMap.update hash
602
-
(function
603
-
| None -> Some [ m.m_intf ]
604
-
| Some l -> Some (m.m_intf :: l))
605
-
acc)
606
-
acc lib.modules)
607
-
acc pkg.libraries)
608
-
Util.StringMap.empty all
609
-
in
610
-
Util.StringMap.filter (fun _hash intfs -> List.length intfs > 1) hashes
611
-
in
612
-
613
-
remap_virtual_interfaces virtual_check all
+7
-1
driver/packages.mli
+7
-1
driver/packages.mli
···
109
109
110
110
val of_packages : packages_dir:Fpath.t option -> string list -> t list
111
111
112
-
val remap_virtual : t list -> t list
112
+
val use_virtual_interfaces : t list -> t list
113
+
(** For each module documented from a [.cmt], look for a same-name [.cmti]
114
+
with the same interface digest in the directories of its library's
115
+
findlib dependency cone, and swap it in as the input: a virtual library's
116
+
implementation ships only the [.cmt], while the [.mli] and its
117
+
documentation live with the virtual library, which the implementation's
118
+
META requires. *)