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(* Environment handling *)
17
18open Types
19
20module PathMap : Map.S with type key = Path.t
21                        and type 'a t = 'a Map.Make(Path).t
22
23type summary =
24    Env_empty
25  | Env_value of summary * Ident.t * value_description
26  | Env_type of summary * Ident.t * type_declaration
27  | Env_extension of summary * Ident.t * extension_constructor
28  | Env_module of summary * Ident.t * module_declaration
29  | Env_modtype of summary * Ident.t * modtype_declaration
30  | Env_class of summary * Ident.t * class_declaration
31  | Env_cltype of summary * Ident.t * class_type_declaration
32  | Env_open of summary * Path.t
33  | Env_functor_arg of summary * Ident.t
34  | Env_constraints of summary * type_declaration PathMap.t
35
36type t
37
38val empty: t
39val initial_safe_string: t
40val initial_unsafe_string: t
41val diff: t -> t -> Ident.t list
42val copy_local: from:t -> t -> t
43
44type type_descriptions =
45    constructor_description list * label_description list
46
47(* For short-paths *)
48type iter_cont
49val iter_types:
50    (Path.t -> Path.t * (type_declaration * type_descriptions) -> unit) ->
51    t -> iter_cont
52val run_iter_cont: iter_cont list -> (Path.t * iter_cont) list
53val same_types: t -> t -> bool
54val used_persistent: unit -> Concr.t
55val find_shadowed_types: Path.t -> t -> Path.t list
56val without_cmis: ('a -> 'b) -> 'a -> 'b
57        (* [without_cmis f arg] applies [f] to [arg], but does not
58           allow opening cmis during its execution *)
59
60(* Lookup by paths *)
61
62val find_value: Path.t -> t -> value_description
63val find_type: Path.t -> t -> type_declaration
64val find_type_descrs: Path.t -> t -> type_descriptions
65val find_module: Path.t -> t -> module_declaration
66val find_modtype: Path.t -> t -> modtype_declaration
67val find_class: Path.t -> t -> class_declaration
68val find_cltype: Path.t -> t -> class_type_declaration
69
70val find_type_expansion:
71    Path.t -> t -> type_expr list * type_expr * int option
72val find_type_expansion_opt:
73    Path.t -> t -> type_expr list * type_expr * int option
74(* Find the manifest type information associated to a type for the sake
75   of the compiler's type-based optimisations. *)
76val find_modtype_expansion: Path.t -> t -> module_type
77val add_functor_arg: Ident.t -> t -> t
78val is_functor_arg: Path.t -> t -> bool
79val normalize_path: Location.t option -> t -> Path.t -> Path.t
80(* Normalize the path to a concrete value or module.
81   If the option is None, allow returning dangling paths.
82   Otherwise raise a Missing_module error, and may add forgotten
83   head as required global. *)
84val normalize_path_prefix: Location.t option -> t -> Path.t -> Path.t
85(* Only normalize the prefix part of the path *)
86val reset_required_globals: unit -> unit
87val get_required_globals: unit -> Ident.t list
88val add_required_global: Ident.t -> unit
89
90val has_local_constraints: t -> bool
91val add_gadt_instance_level: int -> t -> t
92val gadt_instance_level: t -> type_expr -> int option
93val add_gadt_instances: t -> int -> type_expr list -> unit
94val add_gadt_instance_chain: t -> int -> type_expr -> unit
95
96(* Lookup by long identifiers *)
97
98(* ?loc is used to report 'deprecated module' warnings *)
99
100val lookup_value:
101  ?loc:Location.t -> Longident.t -> t -> Path.t * value_description
102val lookup_constructor:
103  ?loc:Location.t -> Longident.t -> t -> constructor_description
104val lookup_all_constructors:
105  ?loc:Location.t ->
106  Longident.t -> t -> (constructor_description * (unit -> unit)) list
107val lookup_label:
108  ?loc:Location.t -> Longident.t -> t -> label_description
109val lookup_all_labels:
110  ?loc:Location.t ->
111  Longident.t -> t -> (label_description * (unit -> unit)) list
112val lookup_type:
113  ?loc:Location.t -> Longident.t -> t -> Path.t
114  (* Since 4.04, this function no longer returns [type_description].
115     To obtain it, you should either call [Env.find_type], or replace
116     it by [Typetexp.find_type] *)
117val lookup_module:
118  load:bool -> ?loc:Location.t -> Longident.t -> t -> Path.t
119val lookup_modtype:
120  ?loc:Location.t -> Longident.t -> t -> Path.t * modtype_declaration
121val lookup_class:
122  ?loc:Location.t -> Longident.t -> t -> Path.t * class_declaration
123val lookup_cltype:
124  ?loc:Location.t -> Longident.t -> t -> Path.t * class_type_declaration
125
126val update_value:
127  string -> (value_description -> value_description) -> t -> t
128  (* Used only in Typecore.duplicate_ident_types. *)
129
130exception Recmodule
131  (* Raise by lookup_module when the identifier refers
132     to one of the modules of a recursive definition
133     during the computation of its approximation (see #5965). *)
134
135(* Insertion by identifier *)
136
137val add_value:
138    ?check:(string -> Warnings.t) -> Ident.t -> value_description -> t -> t
139val add_type: check:bool -> Ident.t -> type_declaration -> t -> t
140val add_extension: check:bool -> Ident.t -> extension_constructor -> t -> t
141val add_module: ?arg:bool -> Ident.t -> module_type -> t -> t
142val add_module_declaration: ?arg:bool -> check:bool -> Ident.t ->
143  module_declaration -> t -> t
144val add_modtype: Ident.t -> modtype_declaration -> t -> t
145val add_class: Ident.t -> class_declaration -> t -> t
146val add_cltype: Ident.t -> class_type_declaration -> t -> t
147val add_local_constraint: Path.t -> type_declaration -> int -> t -> t
148val add_local_type: Path.t -> type_declaration -> t -> t
149
150(* Insertion of all fields of a signature. *)
151
152val add_item: signature_item -> t -> t
153val add_signature: signature -> t -> t
154
155(* Insertion of all fields of a signature, relative to the given path.
156   Used to implement open. *)
157
158val open_signature:
159    ?loc:Location.t -> ?toplevel:bool -> Asttypes.override_flag -> Path.t ->
160      signature -> t -> t
161val open_pers_signature: string -> t -> t
162
163(* Insertion by name *)
164
165val enter_value:
166    ?check:(string -> Warnings.t) ->
167    string -> value_description -> t -> Ident.t * t
168val enter_type: string -> type_declaration -> t -> Ident.t * t
169val enter_extension: string -> extension_constructor -> t -> Ident.t * t
170val enter_module: ?arg:bool -> string -> module_type -> t -> Ident.t * t
171val enter_module_declaration:
172    ?arg:bool -> Ident.t -> module_declaration -> t -> t
173val enter_modtype: string -> modtype_declaration -> t -> Ident.t * t
174val enter_class: string -> class_declaration -> t -> Ident.t * t
175val enter_cltype: string -> class_type_declaration -> t -> Ident.t * t
176
177(* Initialize the cache of in-core module interfaces. *)
178val reset_cache: unit -> unit
179
180(* To be called before each toplevel phrase. *)
181val reset_cache_toplevel: unit -> unit
182
183(* Remember the name of the current compilation unit. *)
184val set_unit_name: string -> unit
185val get_unit_name: unit -> string
186
187(* Read, save a signature to/from a file *)
188
189val read_signature: string -> string -> signature
190        (* Arguments: module name, file name. Results: signature. *)
191val save_signature:
192  deprecated:string option -> signature -> string -> string -> Cmi_format.cmi_infos
193        (* Arguments: signature, module name, file name. *)
194val save_signature_with_imports:
195  deprecated:string option ->
196  signature -> string -> string -> (string * Digest.t option) list
197  -> Cmi_format.cmi_infos
198        (* Arguments: signature, module name, file name,
199           imported units with their CRCs. *)
200
201(* Return the CRC of the interface of the given compilation unit *)
202
203val crc_of_unit: string -> Digest.t
204
205(* Return the set of compilation units imported, with their CRC *)
206
207val imports: unit -> (string * Digest.t option) list
208
209(* [is_imported_opaque md] returns true if [md] is an opaque imported module  *)
210val is_imported_opaque: string -> bool
211
212(* Direct access to the table of imported compilation units with their CRC *)
213
214val crc_units: Consistbl.t
215val add_import: string -> unit
216
217(* Summaries -- compact representation of an environment, to be
218   exported in debugging information. *)
219
220val summary: t -> summary
221
222(* Return an equivalent environment where all fields have been reset,
223   except the summary. The initial environment can be rebuilt from the
224   summary, using Envaux.env_of_only_summary. *)
225
226val keep_only_summary : t -> t
227val env_of_only_summary : (summary -> Subst.t -> t) -> t -> t
228
229(* Error report *)
230
231type error =
232  | Illegal_renaming of string * string * string
233  | Inconsistent_import of string * string * string
234  | Need_recursive_types of string * string
235  | Depend_on_unsafe_string_unit of string * string
236  | Missing_module of Location.t * Path.t * Path.t
237  | Illegal_value_name of Location.t * string
238
239exception Error of error
240
241open Format
242
243val report_error: formatter -> error -> unit
244
245
246val mark_value_used: t -> string -> value_description -> unit
247val mark_module_used: t -> string -> Location.t -> unit
248val mark_type_used: t -> string -> type_declaration -> unit
249
250type constructor_usage = Positive | Pattern | Privatize
251val mark_constructor_used:
252    constructor_usage -> t -> string -> type_declaration -> string -> unit
253val mark_constructor:
254    constructor_usage -> t -> string -> constructor_description -> unit
255val mark_extension_used:
256    constructor_usage -> t -> extension_constructor -> string -> unit
257
258val in_signature: bool -> t -> t
259val implicit_coercion: t -> t
260
261val is_in_signature: t -> bool
262
263val set_value_used_callback:
264    string -> value_description -> (unit -> unit) -> unit
265val set_type_used_callback:
266    string -> type_declaration -> ((unit -> unit) -> unit) -> unit
267
268(* Forward declaration to break mutual recursion with Includemod. *)
269val check_modtype_inclusion:
270      (t -> module_type -> Path.t -> module_type -> unit) ref
271(* Forward declaration to break mutual recursion with Typecore. *)
272val add_delayed_check_forward: ((unit -> unit) -> unit) ref
273(* Forward declaration to break mutual recursion with Mtype. *)
274val strengthen:
275    (aliasable:bool -> t -> module_type -> Path.t -> module_type) ref
276(* Forward declaration to break mutual recursion with Ctype. *)
277val same_constr: (t -> type_expr -> type_expr -> bool) ref
278
279(** Folding over all identifiers (for analysis purpose) *)
280
281val fold_values:
282  (string -> Path.t -> value_description -> 'a -> 'a) ->
283  Longident.t option -> t -> 'a -> 'a
284val fold_types:
285  (string -> Path.t -> type_declaration * type_descriptions -> 'a -> 'a) ->
286  Longident.t option -> t -> 'a -> 'a
287val fold_constructors:
288  (constructor_description -> 'a -> 'a) ->
289  Longident.t option -> t -> 'a -> 'a
290val fold_labels:
291  (label_description -> 'a -> 'a) ->
292  Longident.t option -> t -> 'a -> 'a
293
294(** Persistent structures are only traversed if they are already loaded. *)
295val fold_modules:
296  (string -> Path.t -> module_declaration -> 'a -> 'a) ->
297  Longident.t option -> t -> 'a -> 'a
298
299val fold_modtypes:
300  (string -> Path.t -> modtype_declaration -> 'a -> 'a) ->
301  Longident.t option -> t -> 'a -> 'a
302val fold_classs:
303  (string -> Path.t -> class_declaration -> 'a -> 'a) ->
304  Longident.t option -> t -> 'a -> 'a
305val fold_cltypes:
306  (string -> Path.t -> class_type_declaration -> 'a -> 'a) ->
307  Longident.t option -> t -> 'a -> 'a
308
309(** Utilities *)
310val scrape_alias: t -> module_type -> module_type
311val check_value_name: string -> Location.t -> unit
312
313module Persistent_signature : sig
314  type t =
315    { filename : string; (** Name of the file containing the signature. *)
316      cmi : Cmi_format.cmi_infos }
317
318  (** Function used to load a persistent signature. The default is to look for
319      the .cmi file in the load path. This function can be overridden to load
320      it from memory, for instance to build a self-contained toplevel. *)
321  val load : (unit_name:string -> t option) ref
322end
323