1(**************************************************************************)
2(*                                                                        *)
3(*                                 OCaml                                  *)
4(*                                                                        *)
5(*             Xavier Leroy, projet Cristal, INRIA Rocquencourt           *)
6(*                                                                        *)
7(*   Copyright 1996 Institut National de Recherche en Informatique et     *)
8(*     en Automatique.                                                    *)
9(*                                                                        *)
10(*   All rights reserved.  This file is distributed under the terms of    *)
11(*   the GNU Lesser General Public License version 2.1, with the          *)
12(*   special exception on linking described in the file LICENSE.          *)
13(*                                                                        *)
14(**************************************************************************)
15
16(* Basic operations on core types *)
17
18open Asttypes
19open Types
20
21(**** Sets, maps and hashtables of types ****)
22
23module TypeSet  : Set.S with type elt = type_expr
24module TypeMap  : Map.S with type key = type_expr
25module TypeHash : Hashtbl.S with type key = type_expr
26
27(**** Levels ****)
28
29val generic_level: int
30
31val newty2: int -> type_desc -> type_expr
32        (* Create a type *)
33val newgenty: type_desc -> type_expr
34        (* Create a generic type *)
35val newgenvar: ?name:string -> unit -> type_expr
36        (* Return a fresh generic variable *)
37
38(* Use Tsubst instead
39val newmarkedvar: int -> type_expr
40        (* Return a fresh marked variable *)
41val newmarkedgenvar: unit -> type_expr
42        (* Return a fresh marked generic variable *)
43*)
44
45(**** Types ****)
46
47val is_Tvar: type_expr -> bool
48val is_Tunivar: type_expr -> bool
49val is_Tconstr: type_expr -> bool
50val dummy_method: label
51val default_mty: module_type option -> module_type
52
53val repr: type_expr -> type_expr
54        (* Return the canonical representative of a type. *)
55
56val field_kind_repr: field_kind -> field_kind
57        (* Return the canonical representative of an object field
58           kind. *)
59
60val commu_repr: commutable -> commutable
61        (* Return the canonical representative of a commutation lock *)
62
63(**** polymorphic variants ****)
64
65val row_repr: row_desc -> row_desc
66        (* Return the canonical representative of a row description *)
67val row_field_repr: row_field -> row_field
68val row_field: label -> row_desc -> row_field
69        (* Return the canonical representative of a row field *)
70val row_more: row_desc -> type_expr
71        (* Return the extension variable of the row *)
72val row_fixed: row_desc -> bool
73        (* Return whether the row should be treated as fixed or not *)
74val static_row: row_desc -> bool
75        (* Return whether the row is static or not *)
76val hash_variant: label -> int
77        (* Hash function for variant tags *)
78
79val proxy: type_expr -> type_expr
80        (* Return the proxy representative of the type: either itself
81           or a row variable *)
82
83(**** Utilities for private abbreviations with fixed rows ****)
84val row_of_type: type_expr -> type_expr
85val has_constr_row: type_expr -> bool
86val is_row_name: string -> bool
87val is_constr_row: allow_ident:bool -> type_expr -> bool
88
89(**** Utilities for type traversal ****)
90
91val iter_type_expr: (type_expr -> unit) -> type_expr -> unit
92        (* Iteration on types *)
93val iter_row: (type_expr -> unit) -> row_desc -> unit
94        (* Iteration on types in a row *)
95val iter_abbrev: (type_expr -> unit) -> abbrev_memo -> unit
96        (* Iteration on types in an abbreviation list *)
97
98type type_iterators =
99  { it_signature: type_iterators -> signature -> unit;
100    it_signature_item: type_iterators -> signature_item -> unit;
101    it_value_description: type_iterators -> value_description -> unit;
102    it_type_declaration: type_iterators -> type_declaration -> unit;
103    it_extension_constructor: type_iterators -> extension_constructor -> unit;
104    it_module_declaration: type_iterators -> module_declaration -> unit;
105    it_modtype_declaration: type_iterators -> modtype_declaration -> unit;
106    it_class_declaration: type_iterators -> class_declaration -> unit;
107    it_class_type_declaration: type_iterators -> class_type_declaration -> unit;
108    it_module_type: type_iterators -> module_type -> unit;
109    it_class_type: type_iterators -> class_type -> unit;
110    it_type_kind: type_iterators -> type_kind -> unit;
111    it_do_type_expr: type_iterators -> type_expr -> unit;
112    it_type_expr: type_iterators -> type_expr -> unit;
113    it_path: Path.t -> unit; }
114val type_iterators: type_iterators
115        (* Iteration on arbitrary type information.
116           [it_type_expr] calls [mark_type_node] to avoid loops. *)
117val unmark_iterators: type_iterators
118        (* Unmark any structure containing types. See [unmark_type] below. *)
119
120val copy_type_desc:
121    ?keep_names:bool -> (type_expr -> type_expr) -> type_desc -> type_desc
122        (* Copy on types *)
123val copy_row:
124    (type_expr -> type_expr) ->
125    bool -> row_desc -> bool -> type_expr -> row_desc
126val copy_kind: field_kind -> field_kind
127
128val save_desc: type_expr -> type_desc -> unit
129        (* Save a type description *)
130val dup_kind: field_kind option ref -> unit
131        (* Save a None field_kind, and make it point to a fresh Fvar *)
132val cleanup_types: unit -> unit
133        (* Restore type descriptions *)
134
135val lowest_level: int
136        (* Marked type: ty.level < lowest_level *)
137val pivot_level: int
138        (* Type marking: ty.level <- pivot_level - ty.level *)
139val mark_type: type_expr -> unit
140        (* Mark a type *)
141val mark_type_node: type_expr -> unit
142        (* Mark a type node (but not its sons) *)
143val mark_type_params: type_expr -> unit
144        (* Mark the sons of a type node *)
145val unmark_type: type_expr -> unit
146val unmark_type_decl: type_declaration -> unit
147val unmark_extension_constructor: extension_constructor -> unit
148val unmark_class_type: class_type -> unit
149val unmark_class_signature: class_signature -> unit
150        (* Remove marks from a type *)
151
152(**** Memorization of abbreviation expansion ****)
153
154val find_expans: private_flag -> Path.t -> abbrev_memo -> type_expr option
155        (* Look up a memorized abbreviation *)
156val cleanup_abbrev: unit -> unit
157        (* Flush the cache of abbreviation expansions.
158           When some types are saved (using [output_value]), this
159           function MUST be called just before. *)
160val memorize_abbrev:
161        abbrev_memo ref ->
162        private_flag -> Path.t -> type_expr -> type_expr -> unit
163        (* Add an expansion in the cache *)
164val forget_abbrev:
165        abbrev_memo ref -> Path.t -> unit
166        (* Remove an abbreviation from the cache *)
167
168(**** Utilities for labels ****)
169
170val is_optional : arg_label -> bool
171val label_name : arg_label -> label
172
173(* Returns the label name with first character '?' or '~' as appropriate. *)
174val prefixed_label_name : arg_label -> label
175
176val extract_label :
177    label -> (arg_label * 'a) list ->
178    arg_label * 'a * (arg_label * 'a) list * (arg_label * 'a) list
179    (* actual label, value, before list, after list *)
180
181(**** Utilities for backtracking ****)
182
183type snapshot
184        (* A snapshot for backtracking *)
185val snapshot: unit -> snapshot
186        (* Make a snapshot for later backtracking. Costs nothing *)
187val backtrack: snapshot -> unit
188        (* Backtrack to a given snapshot. Only possible if you have
189           not already backtracked to a previous snapshot.
190           Calls [cleanup_abbrev] internally *)
191val undo_compress: snapshot -> unit
192        (* Backtrack only path compression. Only meaningful if you have
193           not already backtracked to a previous snapshot.
194           Does not call [cleanup_abbrev] *)
195
196(* Functions to use when modifying a type (only Ctype?) *)
197val link_type: type_expr -> type_expr -> unit
198        (* Set the desc field of [t1] to [Tlink t2], logging the old
199           value if there is an active snapshot *)
200val set_level: type_expr -> int -> unit
201val set_name:
202    (Path.t * type_expr list) option ref ->
203    (Path.t * type_expr list) option -> unit
204val set_row_field: row_field option ref -> row_field -> unit
205val set_univar: type_expr option ref -> type_expr -> unit
206val set_kind: field_kind option ref -> field_kind -> unit
207val set_commu: commutable ref -> commutable -> unit
208val set_typeset: TypeSet.t ref -> TypeSet.t -> unit
209        (* Set references, logging the old value *)
210val log_type: type_expr -> unit
211        (* Log the old value of a type, before modifying it by hand *)
212
213(**** Forward declarations ****)
214val print_raw: (Format.formatter -> type_expr -> unit) ref
215
216val iter_type_expr_kind: (type_expr -> unit) -> (type_kind -> unit)
217
218val iter_type_expr_cstr_args: (type_expr -> unit) ->
219  (constructor_arguments -> unit)
220val map_type_expr_cstr_args: (type_expr -> type_expr) ->
221  (constructor_arguments -> constructor_arguments)
222