this repo has no description
Squashed 'odoc/' changes from 4095c1af..1c5e32e0
1c5e32e0 Fix odoc build with OCaml 5.4.1: Data_types module migration
c31be687 Site updates
c5f2c361 Fix odoc doc build warnings: Tsig_include annotation, onnxrt refs, fatal warnings
68bbb7b2 Fix PPX spurious source links and same-module value linking in odoc
e7c7d887 Merge commit '07bc534031770950e35905270cc6916f76009aa0'
e9b5ed8a Constrain lwt < 6.1.0 (6.1.1 incompatible with oxcaml)
e9636bef Add new test and blog post
b66e7262 Alternative, simpler fix
git-subtree-dir: odoc
git-subtree-split: 1c5e32e0e12f06603becf9b1394f95ce7fc5409a
+108
-83
-1
doc/odoc-bench/index.mld
-1
doc/odoc-bench/index.mld
···
1
-
{0 odoc benchmarks}
+5
-1
doc/odoc-md/index.mld
+5
-1
doc/odoc-md/index.mld
-1
dune-project
-1
dune-project
+5
-1
src/loader/implementation.cppo.ml
+5
-1
src/loader/implementation.cppo.ml
···
180
180
in
181
181
LocHashtbl.add loc_to_id loc identifier;
182
182
IdentHashtbl.add local_ident_to_loc id loc
183
+
| Typedtree_traverse.Analysis.GlobalDefinition id, loc ->
184
+
(* Track ident→loc for same-module reference resolution.
185
+
The loc→id mapping is handled by populate_global_defs. *)
186
+
IdentHashtbl.add local_ident_to_loc id loc
183
187
| _ -> ())
184
188
poses
185
189
···
380
384
process p Ident_env.Path.read_type fallback_read_type
381
385
|> Option.iter @@ fun l ->
382
386
AnnotHashtbl.replace occ_tbl (Type l, pos_of_loc loc) ()
383
-
| LocalDefinition _, _ -> ())
387
+
| LocalDefinition _, _ | GlobalDefinition _, _ -> ())
384
388
poses;
385
389
AnnotHashtbl.fold (fun k () acc -> k :: acc) occ_tbl []
386
390
+23
-9
src/loader/typedtree_traverse.cppo.ml
+23
-9
src/loader/typedtree_traverse.cppo.ml
···
3
3
module Analysis = struct
4
4
type annotation =
5
5
| LocalDefinition of Ident.t
6
+
| GlobalDefinition of Ident.t
6
7
| Value of Path.t
7
8
| Module of Path.t
8
9
| ModuleType of Path.t
9
10
| Type of Path.t
10
11
11
12
(** Extract the type path from a constructor_description's result type. *)
13
+
#if OCAML_VERSION >= (5, 4, 0)
14
+
let type_path_of_constructor_desc (cstr : Data_types.constructor_description) =
15
+
Some (Data_types.cstr_res_type_path cstr)
16
+
let type_path_of_label_desc (lbl : Data_types.label_description) =
17
+
Some (Data_types.lbl_res_type_path lbl)
18
+
#else
12
19
let type_path_of_constructor_desc (cstr : Types.constructor_description) =
13
20
match Types.get_desc cstr.cstr_res with
14
21
| Tconstr (p, _, _) -> Some p
15
22
| _ -> None
16
-
17
-
(** Extract the type path from a label_description's result type. *)
18
23
let type_path_of_label_desc (lbl : Types.label_description) =
19
24
match Types.get_desc lbl.lbl_res with
20
25
| Tconstr (p, _, _) -> Some p
21
26
| _ -> None
27
+
#endif
22
28
23
29
let expr poses expr =
24
30
let exp_loc = expr.Typedtree.exp_loc in
···
54
60
let maybe_localvalue id loc =
55
61
match Ident_env.identifier_of_loc env loc with
56
62
| None -> Some (LocalDefinition id, loc)
57
-
| Some _ -> None
63
+
| Some _ -> Some (GlobalDefinition id, loc)
58
64
in
59
65
let () =
60
66
match pat_desc with
···
101
107
| { Typedtree.mb_id = Some id; mb_loc; _ } when not mb_loc.loc_ghost -> (
102
108
match Ident_env.identifier_of_loc env mb_loc with
103
109
| None -> poses := (LocalDefinition id, mb_loc) :: !poses
104
-
| Some _ -> ())
110
+
| Some _ -> poses := (GlobalDefinition id, mb_loc) :: !poses)
105
111
| _ -> ()
106
112
107
113
let module_expr poses mod_expr =
···
157
163
#endif
158
164
match incl.incl_mod with
159
165
| { mty_desc = Tmty_ident (p, _); _ } ->
160
-
poses := (Module p, incl.incl_loc) :: !poses
166
+
poses := (ModuleType p, incl.incl_loc) :: !poses
161
167
| _ -> ())
162
168
| _ -> ()
163
169
end
···
198
204
iter.open_description iterator od
199
205
in
200
206
let structure_item iterator item =
201
-
Analysis.structure_item poses item;
202
-
iter.structure_item iterator item
207
+
(* Skip ghost structure items entirely — these are typically PPX-generated
208
+
code (e.g. [@@deriving]) wrapped by ppxlib in an include with
209
+
loc_ghost=true. Sub-expressions within may have non-ghost locations
210
+
copied from the original source, which would create spurious links. *)
211
+
if not item.Typedtree.str_loc.loc_ghost then begin
212
+
Analysis.structure_item poses item;
213
+
iter.structure_item iterator item
214
+
end
203
215
in
204
216
let signature_item iterator item =
205
-
Analysis.signature_item poses item;
206
-
iter.signature_item iterator item
217
+
if not item.Typedtree.sig_loc.loc_ghost then begin
218
+
Analysis.signature_item poses item;
219
+
iter.signature_item iterator item
220
+
end
207
221
in
208
222
let iterator =
209
223
{
+36
-55
src/xref2/tools.ml
+36
-55
src/xref2/tools.ml
···
2363
2363
let resolve_class_type_path env p =
2364
2364
resolve_class_type env p >>= fun (p, _) -> Ok p
2365
2365
2366
-
let apply_inner_substs env (sg : Component.Signature.t) : Component.Signature.t
2367
-
=
2366
+
let apply_inner_substs _env (sg : Component.Signature.t) :
2367
+
Component.Signature.t =
2368
2368
let rec inner (items : Component.Signature.item list) :
2369
2369
Component.Signature.item list =
2370
2370
match items with
2371
2371
| Component.Signature.TypeSubstitution (id, typedecl) :: rest -> (
2372
-
let subst =
2373
-
Component.ModuleType.TypeSubst
2374
-
(`Dot (`Root, Ident.Name.type_ id), typedecl.equation)
2372
+
let rest = inner rest in
2373
+
match typedecl.equation.manifest with
2374
+
| Some texpr ->
2375
+
let sub =
2376
+
Subst.add_type_replacement
2377
+
(id :> Ident.type_)
2378
+
texpr typedecl.equation Subst.identity
2379
+
in
2380
+
Subst.apply_sig_map_items sub rest
2381
+
| None -> failwith "apply_inner_substs: TypeSubstitution with no manifest")
2382
+
| Component.Signature.ModuleSubstitution (id, modsubst) :: rest ->
2383
+
let rest = inner rest in
2384
+
let rp =
2385
+
match modsubst.manifest with
2386
+
| `Resolved rp -> rp
2387
+
| `Local (local_id, _) -> (`Local local_id : Cpath.Resolved.module_)
2388
+
| p ->
2389
+
failwith
2390
+
(Format.asprintf
2391
+
"apply_inner_substs: ModuleSubstitution with unresolvable \
2392
+
manifest: %a"
2393
+
(Component.Fmt.module_path Component.Fmt.default) p)
2375
2394
in
2376
-
let rest =
2377
-
Component.Signature.Type
2378
-
(id, Ordinary, Component.Delayed.put (fun () -> typedecl))
2379
-
:: inner rest
2395
+
let sub =
2396
+
Subst.add_module
2397
+
(id :> Ident.module_)
2398
+
(`Resolved rp) rp Subst.identity
2380
2399
in
2381
-
match fragmap env subst { sg with items = rest } with
2382
-
| Ok sg' -> sg'.items
2383
-
| Error _ -> failwith "error")
2384
-
| Component.Signature.ModuleSubstitution (id, modsubst) :: rest -> (
2385
-
let subst =
2386
-
Component.ModuleType.ModuleSubst
2387
-
(`Dot (`Root, Ident.Name.module_ id), modsubst.manifest)
2400
+
Subst.apply_sig_map_items sub rest
2401
+
| Component.Signature.ModuleTypeSubstitution (id, modtypesubst) :: rest ->
2402
+
let rest = inner rest in
2403
+
let sub =
2404
+
Subst.add_module_type_replacement
2405
+
(id :> Ident.module_type)
2406
+
modtypesubst.manifest Subst.identity
2388
2407
in
2389
-
let rest =
2390
-
Component.Signature.Module
2391
-
( id,
2392
-
Ordinary,
2393
-
Component.Delayed.put (fun () ->
2394
-
{
2395
-
Component.Module.source_loc = None;
2396
-
source_loc_jane = None;
2397
-
doc = modsubst.doc;
2398
-
type_ = Alias (modsubst.manifest, None);
2399
-
canonical = None;
2400
-
hidden = false;
2401
-
}) )
2402
-
:: inner rest
2403
-
in
2404
-
match fragmap env subst { sg with items = rest } with
2405
-
| Ok sg' -> sg'.items
2406
-
| Error _ -> failwith "error")
2407
-
| Component.Signature.ModuleTypeSubstitution (id, modtypesubst) :: rest -> (
2408
-
let subst =
2409
-
Component.ModuleType.ModuleTypeSubst
2410
-
(`Dot (`Root, Ident.Name.module_type id), modtypesubst.manifest)
2411
-
in
2412
-
let rest =
2413
-
Component.Signature.ModuleType
2414
-
( id,
2415
-
Component.Delayed.put (fun () ->
2416
-
{
2417
-
Component.ModuleType.source_loc = None;
2418
-
source_loc_jane = None;
2419
-
doc = modtypesubst.doc;
2420
-
expr = Some modtypesubst.manifest;
2421
-
canonical = None;
2422
-
}) )
2423
-
:: inner rest
2424
-
in
2425
-
match fragmap env subst { sg with items = rest } with
2426
-
| Ok sg' -> sg'.items
2427
-
| Error _ -> failwith "error")
2408
+
Subst.apply_sig_map_items sub rest
2428
2409
| x :: rest -> x :: inner rest
2429
2410
| [] -> []
2430
2411
in
+13
-13
test/occurrences/double_wrapped.t/run.t
+13
-13
test/occurrences/double_wrapped.t/run.t
···
77
77
78
78
"Aliased" values are not counted since they become persistent
79
79
$ occurrences_print main__B.odoc-occurrences | sort
80
-
Main was used directly 0 times and indirectly 7 times
81
-
Main.A was used directly 2 times and indirectly 5 times
80
+
Main was used directly 0 times and indirectly 8 times
81
+
Main.A was used directly 3 times and indirectly 5 times
82
82
Main.A.(||>) was used directly 1 times and indirectly 0 times
83
83
Main.A.M was used directly 2 times and indirectly 0 times
84
84
Main.A.t was used directly 1 times and indirectly 0 times
···
101
101
102
102
$ occurrences_print aggregated.odoc-occurrences | sort > all_merged
103
103
$ cat all_merged
104
-
Main was used directly 0 times and indirectly 11 times
105
-
Main.A was used directly 4 times and indirectly 6 times
104
+
Main was used directly 0 times and indirectly 12 times
105
+
Main.A was used directly 5 times and indirectly 6 times
106
106
Main.A.(||>) was used directly 1 times and indirectly 0 times
107
107
Main.A.M was used directly 2 times and indirectly 0 times
108
108
Main.A.t was used directly 1 times and indirectly 0 times
···
119
119
120
120
$ odoc count-occurrences main__B -o b.odoc-occurrences --include-hidden
121
121
$ occurrences_print b.odoc-occurrences | sort
122
-
Main was used directly 0 times and indirectly 7 times
123
-
Main.A was used directly 2 times and indirectly 5 times
122
+
Main was used directly 0 times and indirectly 8 times
123
+
Main.A was used directly 3 times and indirectly 5 times
124
124
Main.A.(||>) was used directly 1 times and indirectly 0 times
125
125
Main.A.M was used directly 2 times and indirectly 0 times
126
126
Main.A.t was used directly 1 times and indirectly 0 times
···
128
128
129
129
$ odoc count-occurrences . -o all.odoc-occurrences --include-hidden
130
130
$ occurrences_print all.odoc-occurrences | sort
131
-
Main was used directly 0 times and indirectly 11 times
132
-
Main.A was used directly 4 times and indirectly 6 times
131
+
Main was used directly 0 times and indirectly 12 times
132
+
Main.A was used directly 5 times and indirectly 6 times
133
133
Main.A.(||>) was used directly 1 times and indirectly 0 times
134
134
Main.A.M was used directly 2 times and indirectly 0 times
135
135
Main.A.t was used directly 1 times and indirectly 0 times
···
143
143
$ odoc compile-index --json -o index.json --occurrences all.odoc-occurrences main.odocl
144
144
145
145
$ cat index.json | jq sort | jq '.[]' -c
146
-
{"id":[{"kind":"Root","name":"Main"}],"doc":"Handwritten top-level module","kind":{"kind":"Module"},"display":{"url":"Main/index.html","html":"<code class=\"entry-kind\">mod</code><code class=\"entry-title\"><span class=\"entry-name\">Main</span></code><div class=\"entry-comment\"><div><p>Handwritten top-level module</p></div></div>"},"occurrences":{"direct":0,"indirect":11}}
147
-
{"id":[{"kind":"Root","name":"Main"},{"kind":"Module","name":"A"}],"doc":"","kind":{"kind":"Module"},"display":{"url":"Main/index.html#module-A","html":"<code class=\"entry-kind\">mod</code><code class=\"entry-title\"><span class=\"prefix-name\">Main.</span><span class=\"entry-name\">A</span></code><div class=\"entry-comment\"><div></div></div>"},"occurrences":{"direct":4,"indirect":6}}
146
+
{"id":[{"kind":"Root","name":"Main"}],"doc":"Handwritten top-level module","kind":{"kind":"Module"},"display":{"url":"Main/index.html","html":"<code class=\"entry-kind\">mod</code><code class=\"entry-title\"><span class=\"entry-name\">Main</span></code><div class=\"entry-comment\"><div><p>Handwritten top-level module</p></div></div>"},"occurrences":{"direct":0,"indirect":12}}
147
+
{"id":[{"kind":"Root","name":"Main"},{"kind":"Module","name":"A"}],"doc":"","kind":{"kind":"Module"},"display":{"url":"Main/index.html#module-A","html":"<code class=\"entry-kind\">mod</code><code class=\"entry-title\"><span class=\"prefix-name\">Main.</span><span class=\"entry-name\">A</span></code><div class=\"entry-comment\"><div></div></div>"},"occurrences":{"direct":5,"indirect":6}}
148
148
{"id":[{"kind":"Root","name":"Main"},{"kind":"Module","name":"B"}],"doc":"","kind":{"kind":"Module"},"display":{"url":"Main/index.html#module-B","html":"<code class=\"entry-kind\">mod</code><code class=\"entry-title\"><span class=\"prefix-name\">Main.</span><span class=\"entry-name\">B</span></code><div class=\"entry-comment\"><div></div></div>"},"occurrences":{"direct":1,"indirect":0}}
149
149
{"id":[{"kind":"Root","name":"Main"},{"kind":"Module","name":"B"},{"kind":"Module","name":"M"}],"doc":"","kind":{"kind":"Module"},"display":{"url":"Main/B/index.html#module-M","html":"<code class=\"entry-kind\">mod</code><code class=\"entry-title\"><span class=\"prefix-name\">Main.B.</span><span class=\"entry-name\">M</span></code><div class=\"entry-comment\"><div></div></div>"},"occurrences":{"direct":0,"indirect":0}}
150
150
{"id":[{"kind":"Root","name":"Main"},{"kind":"Module","name":"B"},{"kind":"Module","name":"Y"}],"doc":"","kind":{"kind":"Module"},"display":{"url":"Main/B/index.html#module-Y","html":"<code class=\"entry-kind\">mod</code><code class=\"entry-title\"><span class=\"prefix-name\">Main.B.</span><span class=\"entry-name\">Y</span></code><div class=\"entry-comment\"><div></div></div>"},"occurrences":{"direct":0,"indirect":0}}
···
177
177
},
178
178
"occurrences": {
179
179
"direct": 0,
180
-
"indirect": 11
180
+
"indirect": 12
181
181
}
182
182
},
183
183
{
···
194
194
"doc": "",
195
195
196
196
$ cat index.json | jq -r '.[] | "\(.id | map("\(.kind)-\(.name)") | join(".")), direct: \(.occurrences.direct), indirect: \(.occurrences.indirect)"' | sort
197
-
Root-Main, direct: 0, indirect: 11
198
-
Root-Main.Module-A, direct: 4, indirect: 6
197
+
Root-Main, direct: 0, indirect: 12
198
+
Root-Main.Module-A, direct: 5, indirect: 6
199
199
Root-Main.Module-A.ModuleType-M, direct: 2, indirect: 0
200
200
Root-Main.Module-A.Type-t, direct: 1, indirect: 0
201
201
Root-Main.Module-A.Value-(||>), direct: 1, indirect: 0
+3
test/xref2/include_modsubst.t/a.mli
+3
test/xref2/include_modsubst.t/a.mli
+1
test/xref2/include_modsubst.t/b.mli
+1
test/xref2/include_modsubst.t/b.mli
···
1
+
include module type of struct include A end
+22
test/xref2/include_modsubst.t/run.t
+22
test/xref2/include_modsubst.t/run.t
···
1
+
When a module has a destructive module substitution (`:=`) and another module
2
+
includes it via `module type of struct include ... end`, odoc's `apply_inner_substs`
3
+
encounters a `Local` identifier in the substitution's manifest that it cannot resolve.
4
+
5
+
$ cat a.mli
6
+
module View : sig type t end
7
+
module Short := View
8
+
type t = Short.t
9
+
10
+
$ cat b.mli
11
+
include module type of struct include A end
12
+
13
+
14
+
$ ocamlc -c -bin-annot a.mli
15
+
$ ocamlc -c -bin-annot b.mli
16
+
17
+
$ odoc compile a.cmti
18
+
$ odoc compile -I . b.cmti
19
+
$ odoc link -I . b.odoc
20
+
$ odoc_print b.odocl --short --show-include-expansions
21
+
include module type of struct include A end
22
+
(sig : module View = A.View type t = View.t end)