jon.recoil.org
this repo has no description
1open Type_desc
2open Odoc_model
3
4module Root = struct
5 let t : Root.t t = To_string (fun _ -> "<root>")
6end
7
8module Names = struct
9 include Names
10
11 let modulename = To_string ModuleName.to_string
12
13 let moduletypename = To_string ModuleTypeName.to_string
14
15 let typename = To_string TypeName.to_string
16
17 let classname = To_string TypeName.to_string
18
19 let classtypename = To_string TypeName.to_string
20
21 let constructorname = To_string ConstructorName.to_string
22
23 let fieldname = To_string FieldName.to_string
24
25 let unboxedfieldname = To_string UnboxedFieldName.to_string
26
27 let exceptionname = To_string ExceptionName.to_string
28
29 let extensionname = To_string ExtensionName.to_string
30
31 let valuename = To_string ValueName.to_string
32
33 let methodname = To_string MethodName.to_string
34
35 let instancevariablename = To_string InstanceVariableName.to_string
36
37 let labelname = To_string LabelName.to_string
38
39 let pagename = To_string PageName.to_string
40
41 let assetname = To_string AssetName.to_string
42
43 let parametername = To_string ModuleName.to_string
44
45 let defname = To_string DefName.to_string
46
47 let localname = To_string LocalName.to_string
48end
49
50module General_paths = struct
51 (** Simplified paths types that can be coerced to. *)
52
53 type p = Paths.Path.t
54
55 type rp = Paths.Path.Resolved.t
56
57 type f = Paths.Fragment.t
58
59 type rf = Paths.Fragment.Resolved.t
60
61 type r = Paths.Reference.t
62
63 type rr = Paths.Reference.Resolved.t
64
65 type id_t = Paths.Identifier.t
66
67 type tag = Paths.Reference.tag_any
68
69 let rec identifier : Paths.Identifier.t t =
70 Variant
71 (fun x ->
72 match x.iv with
73 | `Page (parent, name) ->
74 C
75 ( "`Page",
76 ((parent :> id_t option), name),
77 Pair (Option identifier, Names.pagename) )
78 | `LeafPage (parent, name) ->
79 C
80 ( "`LeafPage",
81 ((parent :> id_t option), name),
82 Pair (Option identifier, Names.pagename) )
83 | `AssetFile (parent, name) ->
84 C
85 ( "`AssetFile",
86 ((parent :> id_t), name),
87 Pair (identifier, Names.assetname) )
88 | `Root (parent, name) ->
89 C
90 ( "`Root",
91 ((parent :> id_t option), name),
92 Pair (Option identifier, Names.modulename) )
93 | `Module (parent, name) ->
94 C
95 ( "`Module",
96 ((parent :> id_t), name),
97 Pair (identifier, Names.modulename) )
98 | `Parameter (parent, name) ->
99 C
100 ( "`Parameter",
101 ((parent :> id_t), name),
102 Pair (identifier, Names.parametername) )
103 | `Result r -> C ("`Result", (r :> id_t), identifier)
104 | `ModuleType (parent, name) ->
105 C
106 ( "`ModuleType",
107 ((parent :> id_t), name),
108 Pair (identifier, Names.moduletypename) )
109 | `Class (parent, name) ->
110 C
111 ( "`Class",
112 ((parent :> id_t), name),
113 Pair (identifier, Names.classname) )
114 | `ClassType (parent, name) ->
115 C
116 ( "`ClassType",
117 ((parent :> id_t), name),
118 Pair (identifier, Names.classtypename) )
119 | `Type (parent, name) ->
120 C
121 ( "`Type",
122 ((parent :> id_t), name),
123 Pair (identifier, Names.typename) )
124 | `Constructor (parent, name) ->
125 C
126 ( "`Constructor",
127 ((parent :> id_t), name),
128 Pair (identifier, Names.constructorname) )
129 | `Field (parent, name) ->
130 C
131 ( "`Field",
132 ((parent :> id_t), name),
133 Pair (identifier, Names.fieldname) )
134 | `UnboxedField (parent, name) ->
135 C
136 ( "`UnboxedField",
137 ((parent :> id_t), name),
138 Pair (identifier, Names.unboxedfieldname) )
139 | `Extension (parent, name) ->
140 C
141 ( "`Extension",
142 ((parent :> id_t), name),
143 Pair (identifier, Names.extensionname) )
144 | `ExtensionDecl (parent, name, name') ->
145 C
146 ( "`ExtensionDecl",
147 ((parent :> id_t), name, name'),
148 Triple (identifier, Names.extensionname, Names.extensionname) )
149 | `Exception (parent, name) ->
150 C
151 ( "`Exception",
152 ((parent :> id_t), name),
153 Pair (identifier, Names.exceptionname) )
154 | `Value (parent, name) ->
155 C
156 ( "`Value",
157 ((parent :> id_t), name),
158 Pair (identifier, Names.valuename) )
159 | `Method (parent, name) ->
160 C
161 ( "`Method",
162 ((parent :> id_t), name),
163 Pair (identifier, Names.methodname) )
164 | `InstanceVariable (parent, name) ->
165 C
166 ( "`InstanceVariable",
167 ((parent :> id_t), name),
168 Pair (identifier, Names.instancevariablename) )
169 | `Label (parent, name) ->
170 C
171 ( "`Label",
172 ((parent :> id_t), name),
173 Pair (identifier, Names.labelname) )
174 | `SourcePage (parent, name) ->
175 C
176 ( "`SourcePage",
177 ((parent :> id_t), name),
178 Pair (identifier, string) )
179 | `SourceLocation (parent, name) ->
180 C
181 ( "`SourceLocation",
182 ((parent :> id_t), name),
183 Pair (identifier, Names.defname) )
184 | `SourceLocationInternal (parent, name) ->
185 C
186 ( "`SourceLocationInternal",
187 ((parent :> id_t), name),
188 Pair (identifier, Names.localname) )
189 | `SourceLocationMod parent ->
190 C ("`SourceLocationMod", (parent :> id_t), identifier))
191
192 let reference_tag : tag t =
193 Variant
194 (function
195 | `TClass -> C0 "`TClass"
196 | `TClassType -> C0 "`TClassType"
197 | `TConstructor -> C0 "`TConstructor"
198 | `TException -> C0 "`TException"
199 | `TExtension -> C0 "`TExtension"
200 | `TExtensionDecl -> C0 "`TExtensionDecl"
201 | `TField -> C0 "`TField"
202 | `TUnboxedField -> C0 "`TUnboxedField"
203 | `TInstanceVariable -> C0 "`TInstanceVariable"
204 | `TLabel -> C0 "`TLabel"
205 | `TMethod -> C0 "`TMethod"
206 | `TModule -> C0 "`TModule"
207 | `TModuleType -> C0 "`TModuleType"
208 | `TPage -> C0 "`TPage"
209 | `TAsset -> C0 "`TAsset"
210 | `TType -> C0 "`TType"
211 | `TUnknown -> C0 "`TUnknown"
212 | `TValue -> C0 "`TValue"
213 | `TChildPage -> C0 "`TChildPage"
214 | `TChildModule -> C0 "`TChildModule")
215
216 let rec path : p t =
217 Variant
218 (function
219 | `Resolved x -> C ("`Resolved", x, resolved_path)
220 | `Identifier (x1, x2) ->
221 C ("`Identifier", ((x1 :> id_t), x2), Pair (identifier, bool))
222 | `Root x -> C ("`Root", x, Names.modulename)
223 | `Forward x -> C ("`Forward", x, string)
224 | `Dot (x1, x2) ->
225 C ("`Dot", ((x1 :> p), x2), Pair (path, Names.modulename))
226 | `DotT (x1, x2) ->
227 C ("`DotT", ((x1 :> p), x2), Pair (path, Names.typename))
228 | `DotMT (x1, x2) ->
229 C ("`DotMT", ((x1 :> p), x2), Pair (path, Names.moduletypename))
230 | `DotV (x1, x2) ->
231 C ("`DotV", ((x1 :> p), x2), Pair (path, Names.valuename))
232 | `Apply (x1, x2) ->
233 C ("`Apply", ((x1 :> p), (x2 :> p)), Pair (path, path))
234 | `Substituted m -> C ("`Substituted", (m :> p), path)
235 | `SubstitutedMT m -> C ("`SubstitutedMT", (m :> p), path)
236 | `SubstitutedT m -> C ("`SubstitutedT", (m :> p), path)
237 | `SubstitutedCT m -> C ("`SubstitutedCT", (m :> p), path))
238
239 and resolved_path : rp t =
240 Variant
241 (function
242 | `Identifier x -> C ("`Identifier", x, identifier)
243 | `CoreType n -> C ("`CoreType", n, Names.typename)
244 | `Subst (x1, x2) ->
245 C
246 ( "`Subst",
247 ((x1 :> rp), (x2 :> rp)),
248 Pair (resolved_path, resolved_path) )
249 | `Hidden x -> C ("`Hidden", (x :> rp), resolved_path)
250 | `Module (x1, x2) ->
251 C ("`Module", ((x1 :> rp), x2), Pair (resolved_path, Names.modulename))
252 | `Canonical (x1, x2) ->
253 C ("`Canonical", ((x1 :> rp), (x2 :> p)), Pair (resolved_path, path))
254 | `Apply (x1, x2) ->
255 C
256 ( "`Apply",
257 ((x1 :> rp), (x2 :> rp)),
258 Pair (resolved_path, resolved_path) )
259 | `Alias (dest, src) ->
260 C ("`Alias", ((dest :> rp), (src :> p)), Pair (resolved_path, path))
261 | `AliasModuleType (x1, x2) ->
262 C
263 ( "`AliasModuleType",
264 ((x1 :> rp), (x2 :> rp)),
265 Pair (resolved_path, resolved_path) )
266 | `OpaqueModule x -> C ("`OpaqueModule", (x :> rp), resolved_path)
267 | `ModuleType (x1, x2) ->
268 C
269 ( "`ModuleType",
270 ((x1 :> rp), x2),
271 Pair (resolved_path, Names.moduletypename) )
272 | `SubstT (x1, x2) ->
273 C
274 ( "`SubstT",
275 ((x1 :> rp), (x2 :> rp)),
276 Pair (resolved_path, resolved_path) )
277 | `CanonicalModuleType (x1, x2) ->
278 C
279 ( "`CanonicalModuleType",
280 ((x1 :> rp), (x2 :> p)),
281 Pair (resolved_path, path) )
282 | `CanonicalType (x1, x2) ->
283 C
284 ( "`CanonicalType",
285 ((x1 :> rp), (x2 :> p)),
286 Pair (resolved_path, path) )
287 | `OpaqueModuleType x -> C ("`OpaqueModuleType", (x :> rp), resolved_path)
288 | `Type (x1, x2) ->
289 C ("`Type", ((x1 :> rp), x2), Pair (resolved_path, Names.typename))
290 | `Value (x1, x2) ->
291 C ("`Value", ((x1 :> rp), x2), Pair (resolved_path, Names.valuename))
292 | `Class (x1, x2) ->
293 C ("`Class", ((x1 :> rp), x2), Pair (resolved_path, Names.classname))
294 | `ClassType (x1, x2) ->
295 C
296 ( "`ClassType",
297 ((x1 :> rp), x2),
298 Pair (resolved_path, Names.classtypename) )
299 | `Substituted c -> C ("`Substituted", (c :> rp), resolved_path)
300 | `SubstitutedMT c -> C ("`SubstitutedMT", (c :> rp), resolved_path)
301 | `SubstitutedT c -> C ("`SubstitutedT", (c :> rp), resolved_path)
302 | `SubstitutedCT c -> C ("`SubstitutedCT", (c :> rp), resolved_path))
303
304 and hierarchy_reference : Paths.Reference.Hierarchy.t t =
305 let tag_page_path =
306 Variant
307 (function
308 | `TRelativePath -> C0 "`TRelativePath"
309 | `TAbsolutePath -> C0 "`TAbsolutePath"
310 | `TCurrentPackage -> C0 "`TCurrentPackage")
311 in
312 Pair (tag_page_path, List string)
313
314 and reference : r t =
315 Variant
316 (function
317 | `Resolved x -> C ("`Resolved", x, resolved_reference)
318 | `Root (x1, x2) -> C ("`Root", (x1, x2), Pair (string, reference_tag))
319 | `Dot (x1, x2) -> C ("`Dot", ((x1 :> r), x2), Pair (reference, string))
320 | `Page_path x -> C ("`Page_path", x, hierarchy_reference)
321 | `Asset_path x -> C ("`Asset_path", x, hierarchy_reference)
322 | `Module_path x -> C ("`Module_path", x, hierarchy_reference)
323 | `Any_path x -> C ("`Any_path", x, hierarchy_reference)
324 | `Module (x1, x2) ->
325 C ("`Module", ((x1 :> r), x2), Pair (reference, Names.modulename))
326 | `ModuleType (x1, x2) ->
327 C
328 ( "`ModuleType",
329 ((x1 :> r), x2),
330 Pair (reference, Names.moduletypename) )
331 | `Type (x1, x2) ->
332 C ("`Type", ((x1 :> r), x2), Pair (reference, Names.typename))
333 | `Constructor (x1, x2) ->
334 C
335 ( "`Constructor",
336 ((x1 :> r), x2),
337 Pair (reference, Names.constructorname) )
338 | `Field (x1, x2) ->
339 C ("`Field", ((x1 :> r), x2), Pair (reference, Names.fieldname))
340 | `UnboxedField (x1, x2) ->
341 C ("`UnboxedField", ((x1 :> r), x2), Pair (reference, Names.unboxedfieldname))
342 | `Extension (x1, x2) ->
343 C
344 ( "`Extension",
345 ((x1 :> r), x2),
346 Pair (reference, Names.extensionname) )
347 | `ExtensionDecl (x1, x2) ->
348 C
349 ( "`ExtensionDecl",
350 ((x1 :> r), x2),
351 Pair (reference, Names.extensionname) )
352 | `Exception (x1, x2) ->
353 C
354 ( "`Exception",
355 ((x1 :> r), x2),
356 Pair (reference, Names.exceptionname) )
357 | `Value (x1, x2) ->
358 C ("`Value", ((x1 :> r), x2), Pair (reference, Names.valuename))
359 | `Class (x1, x2) ->
360 C ("`Class", ((x1 :> r), x2), Pair (reference, Names.classname))
361 | `ClassType (x1, x2) ->
362 C
363 ( "`ClassType",
364 ((x1 :> r), x2),
365 Pair (reference, Names.classtypename) )
366 | `Method (x1, x2) ->
367 C ("`Method", ((x1 :> r), x2), Pair (reference, Names.methodname))
368 | `InstanceVariable (x1, x2) ->
369 C
370 ( "`InstanceVariable",
371 ((x1 :> r), x2),
372 Pair (reference, Names.instancevariablename) )
373 | `Label (x1, x2) ->
374 C ("`Label", ((x1 :> r), x2), Pair (reference, Names.labelname)))
375
376 and resolved_reference : rr t =
377 Variant
378 (function
379 | `Class (x1, x2) ->
380 C
381 ( "`Class",
382 ((x1 :> rr), x2),
383 Pair (resolved_reference, Names.classname) )
384 | `ClassType (x1, x2) ->
385 C
386 ( "`ClassType",
387 ((x1 :> rr), x2),
388 Pair (resolved_reference, Names.classtypename) )
389 | `Constructor (x1, x2) ->
390 C
391 ( "`Constructor",
392 ((x1 :> rr), x2),
393 Pair (resolved_reference, Names.constructorname) )
394 | `PolyConstructor (x1, x2) ->
395 C
396 ( "`PolyConstructor",
397 ((x1 :> rr), x2),
398 Pair (resolved_reference, Names.constructorname) )
399 | `Exception (x1, x2) ->
400 C
401 ( "`Exception",
402 ((x1 :> rr), x2),
403 Pair (resolved_reference, Names.exceptionname) )
404 | `Extension (x1, x2) ->
405 C
406 ( "`Extension",
407 ((x1 :> rr), x2),
408 Pair (resolved_reference, Names.extensionname) )
409 | `ExtensionDecl (x1, x2, x3) ->
410 C
411 ( "`ExtensionDecl",
412 ((x1 :> rr), x2, x3),
413 Triple
414 (resolved_reference, Names.extensionname, Names.extensionname)
415 )
416 | `Field (x1, x2) ->
417 C
418 ( "`Field",
419 ((x1 :> rr), x2),
420 Pair (resolved_reference, Names.fieldname) )
421 | `UnboxedField (x1, x2) ->
422 C
423 ( "`UnboxedField",
424 ((x1 :> rr), x2),
425 Pair (resolved_reference, Names.unboxedfieldname) )
426 | `Hidden x -> C ("`Hidden", (x :> rr), resolved_reference)
427 | `Identifier x -> C ("`Identifier", (x :> id_t), identifier)
428 | `InstanceVariable (x1, x2) ->
429 C
430 ( "`InstanceVariable",
431 ((x1 :> rr), x2),
432 Pair (resolved_reference, Names.instancevariablename) )
433 | `Label (x1, x2) ->
434 C
435 ( "`Label",
436 ((x1 :> rr), x2),
437 Pair (resolved_reference, Names.labelname) )
438 | `Method (x1, x2) ->
439 C
440 ( "`Method",
441 ((x1 :> rr), x2),
442 Pair (resolved_reference, Names.methodname) )
443 | `Module (x1, x2) ->
444 C
445 ( "`Module",
446 ((x1 :> rr), x2),
447 Pair (resolved_reference, Names.modulename) )
448 | `ModuleType (x1, x2) ->
449 C
450 ( "`ModuleType",
451 ((x1 :> rr), x2),
452 Pair (resolved_reference, Names.moduletypename) )
453 | `Alias (x1, x2) ->
454 C
455 ( "`Alias",
456 ((x1 :> rp), (x2 :> rr)),
457 Pair (resolved_path, resolved_reference) )
458 | `AliasModuleType (x1, x2) ->
459 C
460 ( "`AliasModuleType",
461 ((x1 :> rp), (x2 :> rr)),
462 Pair (resolved_path, resolved_reference) )
463 | `Type (x1, x2) ->
464 C
465 ( "`Type",
466 ((x1 :> rr), x2),
467 Pair (resolved_reference, Names.typename) )
468 | `Value (x1, x2) ->
469 C
470 ( "`Value",
471 ((x1 :> rr), x2),
472 Pair (resolved_reference, Names.valuename) ))
473
474 let resolved_fragment_root : Paths.Fragment.Resolved.root t =
475 Variant
476 (function
477 | `ModuleType x -> C ("`ModuleType", (x :> rp), resolved_path)
478 | `Module x -> C ("`Module", (x :> rp), resolved_path))
479
480 let rec resolved_fragment : rf t =
481 Variant
482 (function
483 | `Root x -> C ("`Root", x, resolved_fragment_root)
484 | `Subst (x1, x2) ->
485 C
486 ( "`Subst",
487 ((x1 :> rp), (x2 :> rf)),
488 Pair (resolved_path, resolved_fragment) )
489 | `Alias (x1, x2) ->
490 C
491 ( "`Alias",
492 ((x1 :> rp), (x2 :> rf)),
493 Pair (resolved_path, resolved_fragment) )
494 | `Module (x1, x2) ->
495 C
496 ( "`Module",
497 ((x1 :> rf), x2),
498 Pair (resolved_fragment, Names.modulename) )
499 | `Module_type (x1, x2) ->
500 C
501 ( "`Module_type",
502 ((x1 :> rf), x2),
503 Pair (resolved_fragment, Names.moduletypename) )
504 | `Type (x1, x2) ->
505 C ("`Type", ((x1 :> rf), x2), Pair (resolved_fragment, Names.typename))
506 | `Class (x1, x2) ->
507 C
508 ( "`Class",
509 ((x1 :> rf), x2),
510 Pair (resolved_fragment, Names.classname) )
511 | `ClassType (x1, x2) ->
512 C
513 ( "`ClassType",
514 ((x1 :> rf), x2),
515 Pair (resolved_fragment, Names.classtypename) )
516 | `OpaqueModule x -> C ("`OpaqueModule", (x :> rf), resolved_fragment))
517
518 let rec fragment : f t =
519 Variant
520 (function
521 | `Resolved x -> C ("`Resolved", (x :> rf), resolved_fragment)
522 | `Dot (x1, x2) -> C ("`Dot", ((x1 :> f), x2), Pair (fragment, string))
523 | `Root -> C0 "`Root")
524end
525
526let root = Root.t
527
528let modulename = Names.modulename
529
530(* Indirection seems to be required to make the type open. *)
531let identifier : [< Paths.Identifier.t_pv ] Paths.Identifier.id Type_desc.t =
532 Indirect ((fun n -> (n :> Paths.Identifier.t)), General_paths.identifier)
533
534let resolved_path : [< Paths.Path.Resolved.t ] Type_desc.t =
535 Indirect ((fun n -> (n :> General_paths.rp)), General_paths.resolved_path)
536
537let path : [< Paths.Path.t ] Type_desc.t =
538 Indirect ((fun n -> (n :> General_paths.p)), General_paths.path)
539
540let resolved_fragment =
541 Indirect ((fun n -> (n :> General_paths.rf)), General_paths.resolved_fragment)
542
543let fragment =
544 Indirect ((fun n -> (n :> General_paths.f)), General_paths.fragment)
545
546let reference =
547 Indirect ((fun n -> (n :> General_paths.r)), General_paths.reference)