Skip to content
Newer
Older
100644 441 lines (347 sloc) 17 KB
fccc685 Initial open-source release
MLstate authored
1 (*
2 Copyright © 2011 MLstate
3
4 This file is part of OPA.
5
6 OPA is free software: you can redistribute it and/or modify it under the
7 terms of the GNU Affero General Public License, version 3, as published by
8 the Free Software Foundation.
9
10 OPA is distributed in the hope that it will be useful, but WITHOUT ANY
11 WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
12 FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for
13 more details.
14
15 You should have received a copy of the GNU Affero General Public License
16 along with OPA. If not, see <http://www.gnu.org/licenses/>.
17 *)
18
19
20 (**)
21
22 type error = TyperError of QmlAst.code_elt * (exn * exn list) (** guard for a non empty list *)
23 exception Exception of error
24
25 (**
26 Mathieu mercredi 24 juin 2009, 23:59:05 (UTC+0100)
27
28 ABOUT GENERALIZATION and the dependancies between TypeScheme and TypeEnv
29 ------------------------------------------------------------------------
30
31 The generalization should normaly depends on gamma since the processus of
32 generalization need to access all the free-vars of gamma.
33
34 The academic type for function generalize is :
35
36 [val generalize : gamma -> ty -> typescheme]
37
38 But we don't want to have a mutuall dependancy between modules rec TypeScheme and
39 TypeEnv !!
40 (it was to difficult to get away of module rec, so let's try not to do it again)
41
42 We need just a common representation define here for the "QmlTypeVars.quantif", and then
43 provide a function in gamma :
44
45 [val freevars : gamma -> QmlTypeVars.quantif]
46
47 then TypeEnv can depend on TypeScheme.
48
49 We do not want that this type to be public, but it must be shared between
50 TypeScheme and TypeEnv
51
52 That's why we define these 2 modules in the same file : QmlTypes.ml
53
54 in the ml, the module are not coerced, implementation is shared.
55 with this mli, we abstract the implementation of it for the rest of the world
56
57 The implementation can only raise Exceptions defined in QmlTyperException
58 *)
59
60 (* public AST types and no constraints in public env: *)
61 type typescheme = (QmlAst.ty, unit) QmlGenericScheme.tsc
62 type gamma
63 type bypass_typer = BslKey.t -> QmlAst.ty option
64
65 (** the options are orthogonal; first three off give max speed *)
66 type options =
67 {
68 (*** general options about the behaviour of the typer *)
69 (** A flag to allow (if set to true) abstract (local) types to
70 be considered as concrete; useful for some passes where
71 generated code is typed; should not be used for the initial
72 typing of user code *)
73 concrete_abstract : bool;
74
75 (** see the OPA option --explicit-instantiation *)
76 explicit_instantiation : bool;
77
78 (** see the OPA option --value-restriction *)
79 value_restriction : [`disabled|`normal|`strict];
80
81 (** the list, which is the first argument of TypeArrow is used
82 for types of arguments of lambdas and each series of applications
83 is checked to exactly match the arity of TypeArrow of the function
84 (that is the length of the list) *)
85 multiargument_arrow : bool;
86 }
87
88 (** the safest, most complete (and slowest) set of options *)
89 val default_options : options
90
91 (** definition of annot moved to qmlAst *)
92
93 module type QML_LOW_LEVEL_TYPER =
94 sig
95 val type_of_expr :
96 ?options : options ->
97 ?annotmap : QmlAst.annotmap ->
98 bypass_typer : bypass_typer ->
99 gamma : gamma ->
100 QmlAst.expr ->
101 gamma * QmlAst.annotmap * QmlAst.ty
102 end
103
104
105
106 (** Todo : Thing about a possible type for exportation (not necessary) *)
107 module FreeVars :
108 sig
109 type t = QmlTypeVars.quantif
110
111 val union : t -> t -> t
112 val diff : t -> t -> t
113 val inter : t -> t -> t
114 val subset : t -> t -> bool
115 val equal : t -> t -> bool
116
117 val map : (QmlAst.typevar -> QmlAst.typevar) -> (QmlAst.rowvar -> QmlAst.rowvar) -> (QmlAst.colvar -> QmlAst.colvar) -> t -> t
118
119 val empty : t
120 val is_empty : t -> bool
121 val is_type_empty : t -> bool
122 val is_row_empty : t -> bool
123 val is_col_empty : t -> bool
124
125 val compare : t -> t -> int
126
127 val mem_typevar : QmlAst.typevar -> t -> bool
128 val mem_rowvar : QmlAst.rowvar -> t -> bool
129 val mem_colvar : QmlAst.colvar -> t -> bool
130
131 val add_ty : QmlAst.typevar -> t -> t
132 val add_row : QmlAst.rowvar -> t -> t
133 val add_col : QmlAst.colvar -> t -> t
134
135 val refresh : t -> t
136 val export_as_lists : t -> (QmlAst.typevar list * QmlAst.rowvar list * QmlAst.colvar list) (* TODO: remove when we use Scheme in HMX *)
137 val import_from_sets : QmlTypeVars.TypeVarSet.t -> QmlTypeVars.RowVarSet.t -> QmlTypeVars.ColVarSet.t -> t (* TODO: remove when we use Scheme in HMX *)
138
139 val to_string : t -> string
140 end
141
142 val freevars_of_ty :
143 ?with_forall:bool -> ?free:FreeVars.t -> QmlAst.ty -> FreeVars.t
144 val freevars_of_row :
145 ?with_forall:bool -> ?free:FreeVars.t -> QmlAst.ty_row -> FreeVars.t
146 val freevars_of_col :
147 ?with_forall:bool -> ?free:FreeVars.t -> QmlAst.ty_col -> FreeVars.t
148
149 module Scheme :
150 sig
151 type t = typescheme
152 (* val to_string : t -> string (\** e.g : [Forall { 'a } : 'a -> int] *\) *)
153
154 (* alpha-renaming to new, fresh type vars *)
155 val refresh : t -> t
156
157 (** <<<<<<<<<<<<<<<<<<<<<<<< *)
158 (** EXPORT : can be usefull for Named-type as well (keep it in API) *)
159 val export : t -> (QmlAst.typevar list * QmlAst.rowvar list * QmlAst.colvar list) * QmlAst.ty
160 (** IMPORT : use definition *)
161 (** >>>>>>>>>>>>>>>>>>>>>>>> *)
162
163 (** introduction of a new schema, without quantification (e.g. Lambda, or LetRecIn) *)
164 (** the schema returned is : [Forall {} : 'a where 'a is a fresh typevar] *)
165 val next : QmlAst.typevar -> t
166
167 val instantiate : t -> QmlAst.ty
168 (** contain a refresh so that typescheme cannot be corrupted *)
169 (** the refresh is done only on quantified vars, to be compatible with the w algorithm *)
170
171 (**
172 ABOUT GENERALIZATION :
173 -----------------------
174
175 With the value of first level, it should not be any non-closed schema,
176 so gamma is not needed to generalize the type of such values --
177
178 so it is possible to define :
179
180 val quantify : ty -> t ( returning a closed schema )
181
182 a [generalization_with_gamma] is called only internly by the typer in a
183 w algorithm at least so it should theoreticly not be put in the API,
184 but then, since Scheme.t is private, the typer wont be able to provide
185 the implementation for it
186
187 + However, if somebody writte a typer, he should know that the generalization
188 needs the freevars of gamma and then he will use the function generalize, not the quantify
189 function
190
191 + If a human user (not a typer guy) mistakes, and call the function generalize instead of
192 quantify on a first level type of qml, it is equivalent (can just be less efficient)
193
194 Both contain a refresh on quantified variables, to be sure that any vars of
195 ty cannot appear in typescheme if ty will be corrupted later,
196 typescheme keep clean *)
197
198 val export_with_quantif_as_ordered_set : t -> QmlTypeVars.quantif * QmlAst.ty (* TODO: remove when we use Scheme.refresh in HMX *)
199
200 val generalize : gamma -> QmlAst.ty -> t
201 val quantify : QmlAst.ty -> t
202
203 (**
204 EXTRA API FOR TYPE DEFINITION AND NAME TYPES :
205 ---------------------------------------------
206
207 given a type, with some parameters (type definition -- [type ('a, 'b) = { a : 'a ; b : 'b } ]
208 will build a schema, by verifying the well-formed property freevars(t) = params
209 It will also check that the parameters are uniq :
210 don't allow type ('a, 'a) toto = ....
211 it possibly raises an TyperException (like arity problems, unbound typevars, etc ...)
212
213 12/08/09, Adam: I add a restriction for recursive types, in the body of type t:
214 [type ('a1, ... 'an) t]
215 if there is a recursive reference to [t] it must be with _exactly the same_ parameters
216 ('a1, ... 'an). If this is not the case QmlTyperException.WrongUseOfParameters is
217 thrown
218 *)
219 val definition : ?typevar:QmlAst.typevar list -> ?ty_row:QmlAst.rowvar list -> QmlAst.typeident -> QmlAst.ty -> t
220 (** if you find a TypeName ( [ int ; float], "toto") and you want to unify it with a other type,
221 you will need to specialize the schema of your type scheme
222 it possibly raises an TyperException (like arity problems, unbound typevars, etc ...)
223 to help the error message, you must provide a TypeIdent.t (without it, the message is totally useless)
224
225 if you don't provide any vars (all default arg are []), then the function is equivalent
226 to the function [instantiate] if the schema has an empty quantification
227 but will raise an exception otherwise
228 *)
229 val specialize : typeident:QmlAst.typeident -> ?ty:(QmlAst.ty list) -> ?ty_row:(QmlAst.ty_row list) -> t -> QmlAst.ty
230
231 val id : QmlAst.ty -> t
232 val explicit_forall : t -> QmlAst.ty
233 end
234
235 module Env :
236 sig
237 type t = gamma
238
239 val empty : t
240
241 module Ident :
242 sig
243 val find_opt : QmlAst.ident -> gamma -> typescheme option
244 val find : QmlAst.ident -> gamma -> typescheme
245 val add : QmlAst.ident -> typescheme -> gamma -> gamma
246 val remove : QmlAst.ident -> gamma -> gamma
247 val mem : QmlAst.ident -> gamma -> bool
248 val iter : (QmlAst.ident -> typescheme -> unit) -> gamma -> unit
249 val fold : (QmlAst.ident -> typescheme -> 'a -> 'a) -> gamma -> 'a -> 'a
250 val map : (typescheme -> typescheme) -> gamma -> gamma
251 val fold_map : (QmlAst.ident -> typescheme -> 'acc -> 'acc * typescheme) -> gamma -> 'acc -> 'acc * gamma
252 val from_map : typescheme IdentMap.t -> gamma -> gamma
253 val to_map : gamma -> typescheme IdentMap.t
254 val pp : Format.formatter -> gamma -> unit
255 end
256
257 module TypeIdent :
258 sig
259 val find_opt :
260 visibility_applies: bool -> QmlAst.typeident -> gamma ->
261 typescheme option
262 val findi_opt :
263 visibility_applies: bool -> QmlAst.typeident -> gamma ->
264 (QmlAst.typeident * typescheme) option
265 val find :
266 visibility_applies: bool -> QmlAst.typeident -> gamma -> typescheme
267 val findi :
268 visibility_applies: bool -> QmlAst.typeident -> gamma ->
269 QmlAst.typeident * typescheme
270 (* *********************************************************************** *)
271 (** {b Descr}: Lookup in the environment for the type definition bound to
272 a type name, ignoring the visibility (i.e. scope) of this name, and
273 returning this visibility in addition to the bound definition.
274 This function is dedicated to be used by the check that no private
275 type espace by appearing in the signature of a toplevel value not marked
276 as @private. For this reason, this processing needs to know the
277 visibility of the type name. *)
278 (* *********************************************************************** *)
279 val raw_find :
280 QmlAst.typeident -> gamma -> typescheme * QmlAst.type_def_visibility
281 val add :
282 QmlAst.typeident -> (typescheme * QmlAst.type_def_visibility) -> gamma ->
283 gamma
284 val remove : QmlAst.typeident -> gamma -> gamma
285 val mem : QmlAst.typeident -> gamma -> bool
286 val iter :
287 (QmlAst.typeident -> (typescheme * QmlAst.type_def_visibility) -> unit) ->
288 gamma -> unit
289 val fold :
290 (QmlAst.typeident -> (typescheme * QmlAst.type_def_visibility) -> 'a ->
291 'a) -> gamma -> 'a -> 'a
292 val to_list :
293 gamma ->
294 (QmlAst.typeident * (typescheme * QmlAst.type_def_visibility)) list
295 val fold_map :
296 (QmlAst.typeident -> (typescheme * QmlAst.type_def_visibility) -> 'acc ->
297 'acc * (typescheme * QmlAst.type_def_visibility)) ->
298 gamma -> 'acc -> 'acc * gamma
299 val map :
300 ((typescheme * QmlAst.type_def_visibility) ->
301 (typescheme * QmlAst.type_def_visibility)) ->
302 gamma -> gamma
303 val pp : Format.formatter -> gamma -> unit
304 end
305
306 (** a map of field which update with every TypeIdent.add in gamma
307 Given a field, return the TypeIdentSet of every type containing such a field *)
308 module FieldMap :
309 sig
310 val find : string -> gamma -> QmlAst.typeident list
311 val find_inter : string list -> gamma -> QmlAst.typeident list
312 end
313
314 (* considers whole lists of fields of component records and if a named type
315 has any extra fields, the named type is ignored *)
316 module FieldMapQuick :
317 sig
318 val find : string list -> gamma -> QmlAst.typeident list
319 val find_inter : string list list -> gamma -> QmlAst.typeident list
320 end
321
322 val pp : Format.formatter -> gamma -> unit
323
324 (** Appends the definition in g2 to those of g1 *)
325 val append : gamma -> gamma -> gamma
326
327 (** with let type in, gamma can be updated with abstract type *)
328 (** in fact, this module should not be here because it is possibly used
329 by the typers only, typing such expr :
330
331 [let ... =
332 let type toto = ... in <- from here the abstract type toto IS in gamma
333 ....
334 in] <-- from here the abstract type toto IS NO MORE in gamma
335
336 It brings also confusion to be able to add abstract type in gamma, for example in
337 a type definition
338
339 [type ('a, 'b) toto = abstract]
340
341 what should we do ? people would probably say, if we let an API in gamma to
342 add abstracttype, that they should probably add toto in the abstract types
343 map of gamma ! but it is not implemented in this way in our code !
344
345 we must :
346
347 1) create a new abstract type (extern)
348 2) add in gamma in the type ident map the binding "toto" -> typescheme :
349 [Forall {'a, 'b} : TypeAbstract ('a, 'b) , toto]
350
351 with :
352 [type ('a, 'b) toto = abstract]
353 you don't know the implementation of the type toto
354
355 with :
356 [let type ('a, 'b) toto = { a : 'a ; b : 'b } in ..]
357 you know the implementation, so you can both bind and a new type ident with it
358
359 *)
360
361 (**
362
363 HACKS IN GAMMA :
364 ---------------
365
366 we do not want that the typer use gamma like a set of hacks
367
368 If something typer specific is missing in gamma, as long as it is not needed to
369 be with dealed with a continuation, it is possible to have something like :
370
371 (the typer inference should use a tuned gamma)
372
373 [let w gamma expr =
374 let env = { gamma = gamma ; private_extra_env = private_extra_env_empty } in
375 let rec aux env e =
376 ... ... use env.gamma and env.private_extra_env
377 in
378 let typ = aux env e in
379 typ]
380
381 if something need continuation passing, let's talk about it, and maybe if it is
382 really typer-generic and needed then it can be added in gamma
383 (for example, let's thing about add_intypingident & is_intypingident which are not necessarly in gamma !)
384 *)
385
386 (* module Hacks : *)
387 (* sig *)
388 (* type add_your_hacks_here = unit *)
389 (* val hack_api : add_your_hacks_here -> add_your_hacks_here *)
390 (* end *)
391
392 end
393
394 (** More Common Types, needed in order that differents HighTyper could share the type env *)
395 type typed_code_elt = (QmlAst.ty, Scheme.t) QmlAst.maped_code_elt
396 (** Now the type env is public, so that we can also share it between HighTyper *)
397 (** avoid cyclic dependencies between QmlTypes and DbGen *)
398 type 'schema public_env =
399 {
400 (** The set of toplevel identifiers that are visible outside the package.
401 It will be used to raise an error if a value has a type containing a
402 @private type and this value is not marked also by a @private. This
403 is to avoid private types escaping from their scope. *)
404 exported_values_idents : IdentSet.t ;
405 gamma : gamma ;
406 schema : 'schema ;
407 annotmap : QmlAst.annotmap ;
408 bypass_typer : bypass_typer ;
409 fatal_mode : bool ; (** true by default *)
410 handle_exception : bool ; (** true by default *)
411 unique_types : bool ; (** false by default; if true means that type redefinitions
412 overwrite old types; dangerous, but useful for OPA *)
413 had_error : bool ;
414 exception_handler : 'schema public_env -> exn -> unit ;
415 display : bool ; (** false by default *)
416 options : options ;
417 }
418
419 (** typedef=true -> be strict about arguments of named types *)
420 val type_of_type : ?typedef:bool -> ?tirec:((QmlAst.typeident * QmlAst.typevar list) list) -> gamma -> QmlAst.ty -> QmlAst.ty
421 (*This function may raises an exception if you give it garbage (e.g. incorrect gamma) *)
422 (* : ... -> TypeIdent.raw ty -> TypeIdent.processed ty *)
423
424 val process_gamma :
425 gamma:gamma (* the one that is processed and contains all types for the other one *) ->
426 gamma (* the one to process *) -> gamma
427 val process_scheme : gamma -> typescheme -> typescheme
428 val process_annotmap : gamma:gamma -> QmlAst.annotmap -> QmlAst.annotmap
429 val process_typenames_annotmap : gamma:gamma -> QmlAst.annotmap -> QmlAst.annotmap
430
431 (** place-holder for a finer dependency analysis of type definitions, used in the Blender;
432 for the moment, assumes dependency is maximal and returns a single mutually-recursive
433 definition of all types *)
434 val dependency : QmlAst.code -> QmlAst.code
435
436 (** fails if there are duplicate type definitions *)
437 val check_no_duplicate_type_defs : QmlAst.code -> unit
438
439 (** check is a type is processed (e.g. as a result of type_of_type) *)
440 val is_processed : QmlAst.ty -> bool
Something went wrong with that request. Please try again.