jon.recoil.org
this repo has no description
1(*
2 * Copyright (c) 2014 Leo White <lpw25@cl.cam.ac.uk>
3 *
4 * Permission to use, copy, modify, and distribute this software for any
5 * purpose with or without fee is hereby granted, provided that the above
6 * copyright notice and this permission notice appear in all copies.
7 *
8 * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
9 * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
10 * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
11 * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
12 * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
13 * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
14 * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
15 *)
16
17open Paths
18
19module Source_loc_jane = struct
20 type t = { filename: string ; line_number: int }
21
22 let of_location (build_dir : string) (loc: Location.t) =
23 let { Location.loc_start ; _ } = loc in
24 let { Lexing.pos_fname ; pos_lnum ; _ } = loc_start in
25 { filename = build_dir ^ "/" ^ pos_fname ; line_number = pos_lnum }
26end
27
28(** {3 Modules} *)
29
30module rec Module : sig
31 type decl =
32 | Alias of (Path.Module.t * ModuleType.simple_expansion option)
33 | ModuleType of ModuleType.expr
34
35 type t = {
36 id : Identifier.Module.t;
37 source_loc : Identifier.SourceLocation.t option;
38 (** Identifier.SourceLocation might not be set when the module is
39 artificially constructed from a functor argument. *)
40 source_loc_jane : Source_loc_jane.t option;
41 doc : Comment.docs;
42 type_ : decl;
43 canonical : Path.Module.t option;
44 hidden : bool;
45 }
46
47 module Equation : sig
48 type t = decl
49 end
50end =
51 Module
52
53and FunctorParameter : sig
54 type parameter = {
55 id : Identifier.FunctorParameter.t;
56 expr : ModuleType.expr;
57 }
58
59 type t = Unit | Named of parameter
60end =
61 FunctorParameter
62
63(** {3 Modules Types} *)
64
65and ModuleType : sig
66 type substitution =
67 | ModuleEq of Fragment.Module.t * Module.Equation.t
68 | ModuleTypeEq of Fragment.ModuleType.t * ModuleType.expr
69 | TypeEq of Fragment.Type.t * TypeDecl.Equation.t
70 | ModuleSubst of Fragment.Module.t * Path.Module.t
71 | ModuleTypeSubst of Fragment.ModuleType.t * ModuleType.expr
72 | TypeSubst of Fragment.Type.t * TypeDecl.Equation.t
73
74 type type_of_desc =
75 | ModPath of Path.Module.t
76 | StructInclude of Path.Module.t
77
78 type simple_expansion =
79 | Signature of Signature.t
80 | Functor of FunctorParameter.t * simple_expansion
81
82 type typeof_t = {
83 t_desc : type_of_desc;
84 t_original_path : Path.Module.t;
85 t_expansion : simple_expansion option;
86 }
87
88 module U : sig
89 (* Unexpanded (aside from Signature, obviously) *)
90
91 type expr =
92 | Path of Path.ModuleType.t
93 | Signature of Signature.t
94 | With of substitution list * expr
95 | TypeOf of type_of_desc * Path.Module.t
96 | Strengthen of expr * Path.Module.t * bool
97 end
98
99 type path_t = {
100 p_expansion : simple_expansion option;
101 p_path : Path.ModuleType.t;
102 }
103
104 type with_t = {
105 w_substitutions : substitution list;
106 w_expansion : simple_expansion option;
107 w_expr : U.expr;
108 }
109
110 type strengthen_t = {
111 s_expansion : simple_expansion option;
112 s_expr : U.expr;
113 s_path : Path.Module.t;
114 s_aliasable : bool
115 }
116
117 type expr =
118 | Path of path_t
119 | Signature of Signature.t
120 | Functor of FunctorParameter.t * expr
121 | With of with_t
122 | TypeOf of typeof_t
123 | Strengthen of strengthen_t
124
125 type t = {
126 id : Identifier.ModuleType.t;
127 source_loc : Identifier.SourceLocation.t option;
128 (** Can be [None] for module types created by a type substitution. *)
129 source_loc_jane : Source_loc_jane.t option;
130 doc : Comment.docs;
131 canonical : Path.ModuleType.t option;
132 expr : expr option;
133 }
134end =
135 ModuleType
136
137and ModuleSubstitution : sig
138 type t = {
139 id : Identifier.Module.t;
140 doc : Comment.docs;
141 manifest : Path.Module.t;
142 }
143end =
144 ModuleSubstitution
145
146and ModuleTypeSubstitution : sig
147 type t = {
148 id : Identifier.ModuleType.t;
149 doc : Comment.docs;
150 manifest : ModuleType.expr;
151 }
152end =
153 ModuleTypeSubstitution
154
155(** {3 Signatures} *)
156
157and Signature : sig
158 type recursive = Ordinary | And | Nonrec | Rec
159
160 type item =
161 | Module of recursive * Module.t
162 | ModuleType of ModuleType.t
163 | ModuleSubstitution of ModuleSubstitution.t
164 | ModuleTypeSubstitution of ModuleTypeSubstitution.t
165 | Open of Open.t
166 | Type of recursive * TypeDecl.t
167 | TypeSubstitution of TypeDecl.t
168 | TypExt of Extension.t
169 | Exception of Exception.t
170 | Value of Value.t
171 | Class of recursive * Class.t
172 | ClassType of recursive * ClassType.t
173 | Include of Include.t
174 | Comment of Comment.docs_or_stop
175
176 type removed_item =
177 | RModule of Names.ModuleName.t * Path.Module.t
178 | RType of Names.TypeName.t * TypeExpr.t * TypeDecl.Equation.t
179 | RModuleType of Names.ModuleTypeName.t * ModuleType.expr
180
181 type t = {
182 items : item list;
183 compiled : bool;
184 removed : removed_item list;
185 doc : Comment.docs; (** The top comment. *)
186 }
187end =
188 Signature
189
190and Open : sig
191 type t = { expansion : Signature.t; doc : Comment.docs }
192end =
193 Open
194
195(** {3 Includes} *)
196
197and Include : sig
198 type shadowed = {
199 s_modules : (string * Names.ModuleName.t) list;
200 s_module_types : (string * Names.ModuleTypeName.t) list;
201 s_values : (string * Names.ValueName.t) list;
202 s_types : (string * Names.TypeName.t) list;
203 s_classes : (string * Names.TypeName.t) list;
204 s_class_types : (string * Names.TypeName.t) list;
205 }
206
207 type expansion = { shadowed : shadowed; content : Signature.t }
208
209 (* Explicitly unexpanded decl *)
210 type decl = Alias of Path.Module.t | ModuleType of ModuleType.U.expr
211
212 type t = {
213 loc : Location_.span;
214 parent : Identifier.Signature.t;
215 strengthened : Path.Module.t option;
216 doc : Comment.docs;
217 status : [ `Inline | `Closed | `Open | `Default ];
218 decl : decl;
219 expansion : expansion;
220 expanded : bool;
221 }
222end =
223 Include
224
225(** {3 Type Declarations} *)
226
227and TypeDecl : sig
228 module Field : sig
229 type t = {
230 id : Identifier.Field.t;
231 doc : Comment.docs;
232 mutable_ : bool;
233 type_ : TypeExpr.t;
234 }
235 end
236
237 module UnboxedField : sig
238 type t = {
239 id : Identifier.UnboxedField.t;
240 doc : Comment.docs;
241 mutable_ : bool;
242 type_ : TypeExpr.t;
243 }
244 end
245
246 module Constructor : sig
247 type argument = Tuple of TypeExpr.t list | Record of Field.t list
248
249 type t = {
250 id : Identifier.Constructor.t;
251 doc : Comment.docs;
252 args : argument;
253 res : TypeExpr.t option;
254 }
255 end
256
257 module Representation : sig
258 type t =
259 | Variant of Constructor.t list
260 | Record of Field.t list
261 | Record_unboxed_product of UnboxedField.t list
262 | Extensible
263 end
264
265 type variance = Pos | Neg | Bivariant
266
267 type param_desc = Any | Var of string * string option
268 (** name, jkind (e.g. [Some "float64"]) *)
269
270 type param = {
271 desc : param_desc;
272 variance : variance option;
273 injectivity : bool;
274 }
275
276 module Equation : sig
277 type t = {
278 params : param list;
279 private_ : bool;
280 manifest : TypeExpr.t option;
281 constraints : (TypeExpr.t * TypeExpr.t) list;
282 }
283 end
284
285 type t = {
286 id : Identifier.Type.t;
287 source_loc : Identifier.SourceLocation.t option;
288 source_loc_jane : Source_loc_jane.t option;
289 doc : Comment.docs;
290 canonical : Path.Type.t option;
291 equation : Equation.t;
292 representation : Representation.t option;
293 }
294end =
295 TypeDecl
296
297(** {3 Type extensions} *)
298
299and Extension : sig
300 module Constructor : sig
301 type t = {
302 id : Identifier.Extension.t;
303 source_loc : Identifier.SourceLocation.t option;
304 doc : Comment.docs;
305 args : TypeDecl.Constructor.argument;
306 res : TypeExpr.t option;
307 }
308 end
309
310 type t = {
311 parent : Identifier.Signature.t;
312 type_path : Path.Type.t;
313 doc : Comment.docs;
314 type_params : TypeDecl.param list;
315 private_ : bool;
316 constructors : Constructor.t list;
317 }
318end =
319 Extension
320
321(** {3 Exception} *)
322and Exception : sig
323 type t = {
324 id : Identifier.Exception.t;
325 source_loc : Identifier.SourceLocation.t option;
326 source_loc_jane : Source_loc_jane.t option;
327 doc : Comment.docs;
328 args : TypeDecl.Constructor.argument;
329 res : TypeExpr.t option;
330 }
331end =
332 Exception
333
334(** {3 Values} *)
335
336and Value : sig
337 type value = Abstract | External of string list
338
339 type t = {
340 id : Identifier.Value.t;
341 source_loc : Identifier.SourceLocation.t option;
342 source_loc_jane : Source_loc_jane.t option;
343 value : value;
344 doc : Comment.docs;
345 type_ : TypeExpr.t;
346 modalities : string list;
347 }
348end =
349 Value
350
351(** {3 Classes} *)
352
353and Class : sig
354 type decl =
355 | ClassType of ClassType.expr
356 | Arrow of TypeExpr.label option * TypeExpr.t * decl
357
358 type t = {
359 id : Identifier.Class.t;
360 source_loc : Identifier.SourceLocation.t option;
361 source_loc_jane : Source_loc_jane.t option;
362 doc : Comment.docs;
363 virtual_ : bool;
364 params : TypeDecl.param list;
365 type_ : decl;
366 expansion : ClassSignature.t option;
367 }
368end =
369 Class
370
371(** {3 Class Types} *)
372
373and ClassType : sig
374 type expr =
375 | Constr of Path.ClassType.t * TypeExpr.t list
376 | Signature of ClassSignature.t
377
378 type t = {
379 id : Identifier.ClassType.t;
380 source_loc : Identifier.SourceLocation.t option;
381 source_loc_jane : Source_loc_jane.t option;
382 doc : Comment.docs;
383 virtual_ : bool;
384 params : TypeDecl.param list;
385 expr : expr;
386 expansion : ClassSignature.t option;
387 }
388end =
389 ClassType
390
391(** {3 Class Signatures} *)
392
393and ClassSignature : sig
394 module Constraint : sig
395 type t = { left : TypeExpr.t; right : TypeExpr.t; doc : Comment.docs }
396 end
397
398 module Inherit : sig
399 type t = { expr : ClassType.expr; doc : Comment.docs }
400 end
401
402 type item =
403 | Method of Method.t
404 | InstanceVariable of InstanceVariable.t
405 | Constraint of Constraint.t
406 | Inherit of Inherit.t
407 | Comment of Comment.docs_or_stop
408
409 type t = { self : TypeExpr.t option; items : item list; doc : Comment.docs }
410end =
411 ClassSignature
412
413(** {3 Methods} *)
414
415and Method : sig
416 type t = {
417 id : Identifier.Method.t;
418 doc : Comment.docs;
419 private_ : bool;
420 virtual_ : bool;
421 type_ : TypeExpr.t;
422 }
423end =
424 Method
425
426(** {3 Instance variables} *)
427
428and InstanceVariable : sig
429 type t = {
430 id : Identifier.InstanceVariable.t;
431 doc : Comment.docs;
432 mutable_ : bool;
433 virtual_ : bool;
434 type_ : TypeExpr.t;
435 }
436end =
437 InstanceVariable
438
439(** {3 Type expressions} *)
440
441and TypeExpr : sig
442 module Polymorphic_variant : sig
443 type kind = Fixed | Closed of string list | Open
444
445 module Constructor : sig
446 type t = {
447 name : string;
448 constant : bool;
449 arguments : TypeExpr.t list;
450 doc : Comment.docs;
451 }
452 end
453
454 type element = Type of TypeExpr.t | Constructor of Constructor.t
455
456 type t = { kind : kind; elements : element list }
457 end
458
459 module Object : sig
460 type method_ = { name : string; type_ : TypeExpr.t }
461
462 type field = Method of method_ | Inherit of TypeExpr.t
463
464 type t = { fields : field list; open_ : bool }
465 end
466
467 module Package : sig
468 type substitution = Fragment.Type.t * TypeExpr.t
469
470 type t = { path : Path.ModuleType.t; substitutions : substitution list }
471 end
472
473 type label = Label of string | RawOptional of string | Optional of string
474
475 type t =
476 | Var of string * string option (** name, jkind (e.g. [Some "float64"]) *)
477 | Any
478 | Alias of t * string
479 | Arrow of label option * t * t * string list * string list
480 (** label, arg, ret, arg_modes, ret_modes *)
481 | Tuple of (string option * t) list
482 | Unboxed_tuple of (string option * t) list
483 | Constr of Path.Type.t * t list
484 | Polymorphic_variant of TypeExpr.Polymorphic_variant.t
485 | Object of TypeExpr.Object.t
486 | Class of Path.ClassType.t * t list
487 | Poly of (string * string option) list * t
488 (** Universally quantified type variables with optional jkind
489 annotation, e.g. [("a", Some "value_or_null")] for
490 [('a : value_or_null). ...]. The jkind is [None] for the
491 default [value] layout. *)
492 | Quote of t
493 | Splice of t
494 | Package of TypeExpr.Package.t
495end =
496 TypeExpr
497
498(** {3 Compilation units} *)
499
500module rec Compilation_unit : sig
501 module Import : sig
502 type t =
503 | Unresolved of string * Digest.t option
504 | Resolved of Root.t * Names.ModuleName.t
505 end
506
507 module Source : sig
508 type t = { file : string; build_dir : string; digest : Digest.t }
509 end
510
511 module Packed : sig
512 type item = { id : Identifier.Module.t; path : Path.Module.t }
513
514 type t = item list
515 end
516
517 type content = Module of Signature.t | Pack of Packed.t
518
519 type t = {
520 id : Identifier.RootModule.t;
521 root : Root.t;
522 digest : Digest.t;
523 imports : Import.t list;
524 source : Source.t option;
525 interface : bool;
526 hidden : bool;
527 content : content;
528 expansion : Signature.t option;
529 linked : bool; (** Whether this unit has been linked. *)
530 source_loc : Identifier.SourceLocation.t option;
531 source_loc_jane : Source_loc_jane.t option;
532 canonical : Path.Module.t option;
533 }
534end =
535 Compilation_unit
536
537module rec Source_info : sig
538 type point_in_file = {
539 pos_lnum : int;
540 pos_cnum : int;
541 }
542 type location_in_file = {loc_start : point_in_file ; loc_end: point_in_file}
543
544 type 'a jump_to_impl =
545 | Unresolved of 'a
546 | Resolved of Identifier.SourceLocation.t
547
548 type 'a jump_to = {
549 documentation : 'a option;
550 implementation : 'a jump_to_impl option;
551 }
552
553 type annotation =
554 | Definition of Paths.Identifier.SourceLocation.t
555 | Value of Path.Value.t jump_to
556 | Module of Path.Module.t jump_to
557 | ModuleType of Path.ModuleType.t jump_to
558 | Type of Path.Type.t jump_to
559
560 type 'a with_pos = 'a * location_in_file
561
562 type t = annotation with_pos list
563end =
564 Source_info
565
566module rec Implementation : sig
567 type t = {
568 id : Identifier.SourcePage.t option;
569 digest : Digest.t;
570 root : Root.t;
571 linked : bool; (** Whether this unit has been linked. *)
572 imports : Compilation_unit.Import.t list;
573 source_info : Source_info.t;
574 shape_info :
575 (Compat.shape * Paths.Identifier.SourceLocation.t Compat.shape_uid_map)
576 option;
577 }
578end =
579 Implementation
580
581module rec Page : sig
582 type child = Page_child of string | Module_child of string
583
584 type t = {
585 name : Identifier.Page.t;
586 root : Root.t;
587 content : Comment.docs;
588 children : child list;
589 frontmatter : Frontmatter.t;
590 digest : Digest.t;
591 linked : bool;
592 }
593end =
594 Page
595
596module rec Asset : sig
597 type t = { name : Identifier.AssetFile.t; root : Root.t }
598end =
599 Asset
600
601let umty_of_mty : ModuleType.expr -> ModuleType.U.expr option = function
602 | Signature sg -> Some (Signature sg)
603 | Path { p_path; _ } -> Some (Path p_path)
604 | Functor _ -> None
605 | TypeOf { t_desc; t_original_path; _ } ->
606 Some (TypeOf (t_desc, t_original_path))
607 | With { w_substitutions; w_expr; _ } -> Some (With (w_substitutions, w_expr))
608 | Strengthen { s_expr; s_path; s_aliasable; _ } ->
609 Some (Strengthen (s_expr, s_path, s_aliasable))
610
611(** Query the top-comment of a signature. This is [s.doc] most of the time with
612 an exception for signature starting with an inline includes. *)
613let extract_signature_doc (s : Signature.t) =
614 let rec uexpr_considered_hidden = function
615 | ModuleType.U.Path p -> Path.is_hidden (p :> Path.t)
616 | Signature _ ->
617 true (* Hidden in some sense, we certainly want its top comment *)
618 | With (_, e)
619 | Strengthen (e, _, _) -> uexpr_considered_hidden e
620 | TypeOf (ModPath p, _) | TypeOf (StructInclude p, _) ->
621 Path.is_hidden (p :> Path.t)
622 in
623 let should_take_top = function
624 (* A signature that starts with an include may inherits the
625 top-comment from the expansion. *)
626 | { Include.status = `Inline; _ } -> true
627 | { decl = Alias p; _ } -> Paths.Path.is_hidden (p :> Path.t)
628 | { decl = ModuleType expr; _ } -> uexpr_considered_hidden expr
629 in
630 match (s.doc, s.items) with
631 | { elements = []; _ }, Include inc :: _ when should_take_top inc ->
632 inc.expansion.content.doc
633 | doc, _ -> doc