Skip to content
This repository
Newer
Older
100644 442 lines (352 sloc) 17.487 kb
fccc6851 » MLstate
2011-06-21 Initial open-source release
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
b12589bd » fpessaux
2011-08-08 [feature] Typer: Height of type abbreviation to balance unwinding dur…
63
64 (* ************************************************************************** *)
65 (** {b Descr}: Represents the number of chained type abbreviations this
66 constructor leads to. For instance:
67 - [int] : being a basic type, its height is 0.
68 - [type t1 = int] : t1's height is 1 + int's height = 1.
69 - [type t2 = t1] : 1 + t2's height = 2.
70
71 Can also be negative. In this case, it represents the position (numbered
72 from 1) of the definition's variable that will give (once the constructor
73 of the definition will be used) the height of the resulting type expression.
74 For instance:
75 - [type u('a, 'b) = 'b] : The height of a type expression using [u] is
76 the height of the effective argument provided to instantiate ['b]. Hence,
77 u's height is -2 (minus of the second argument).
78 Then, using [t2] above in the espression [u(t2, int)] will give a height
79 of 0 ([int] has height 0) and [u(int, t2)] will give a height of 2
80 ([t2] has height 2).
81 {b Visibility}: Transparently visible outside this module. We do not hid
82 its implementation since manipulations of heights are very frequent and
83 we prefer to avoid some overhead induced by wrapping functions.
84 In effect, such information is used by [QmlMakeTyper] on the QML side and
85 its better to have it seeing the implementation. This information is also
86 used by the low-level typer W. *)
87 (* ************************************************************************** *)
88 type abbrev_height = int
89
fccc6851 » MLstate
2011-06-21 Initial open-source release
90 type bypass_typer = BslKey.t -> QmlAst.ty option
91
92 (** the options are orthogonal; first three off give max speed *)
93 type options =
94 {
95 (*** general options about the behaviour of the typer *)
96 (** see the OPA option --explicit-instantiation *)
97 explicit_instantiation : bool;
98
99 (** see the OPA option --value-restriction *)
100 value_restriction : [`disabled|`normal|`strict];
101 }
102
103 (** the safest, most complete (and slowest) set of options *)
104 val default_options : options
105
106 (** definition of annot moved to qmlAst *)
107
108 module type QML_LOW_LEVEL_TYPER =
109 sig
110 val type_of_expr :
111 ?options : options ->
112 ?annotmap : QmlAst.annotmap ->
113 bypass_typer : bypass_typer ->
114 gamma : gamma ->
115 QmlAst.expr ->
116 gamma * QmlAst.annotmap * QmlAst.ty
117 end
118
119
120
121 (** Todo : Thing about a possible type for exportation (not necessary) *)
122 module FreeVars :
123 sig
124 type t = QmlTypeVars.quantif
125
126 val union : t -> t -> t
127 val diff : t -> t -> t
128 val inter : t -> t -> t
129 val subset : t -> t -> bool
130 val equal : t -> t -> bool
131
132 val map : (QmlAst.typevar -> QmlAst.typevar) -> (QmlAst.rowvar -> QmlAst.rowvar) -> (QmlAst.colvar -> QmlAst.colvar) -> t -> t
133
134 val empty : t
135 val is_empty : t -> bool
136 val is_type_empty : t -> bool
137 val is_row_empty : t -> bool
138 val is_col_empty : t -> bool
139
140 val compare : t -> t -> int
141
142 val mem_typevar : QmlAst.typevar -> t -> bool
143 val mem_rowvar : QmlAst.rowvar -> t -> bool
144 val mem_colvar : QmlAst.colvar -> t -> bool
145
146 val add_ty : QmlAst.typevar -> t -> t
147 val add_row : QmlAst.rowvar -> t -> t
148 val add_col : QmlAst.colvar -> t -> t
149
150 val refresh : t -> t
151 val export_as_lists : t -> (QmlAst.typevar list * QmlAst.rowvar list * QmlAst.colvar list) (* TODO: remove when we use Scheme in HMX *)
152 val import_from_sets : QmlTypeVars.TypeVarSet.t -> QmlTypeVars.RowVarSet.t -> QmlTypeVars.ColVarSet.t -> t (* TODO: remove when we use Scheme in HMX *)
153
154 val to_string : t -> string
155 end
156
157 val freevars_of_ty :
158 ?with_forall:bool -> ?free:FreeVars.t -> QmlAst.ty -> FreeVars.t
159 val freevars_of_row :
160 ?with_forall:bool -> ?free:FreeVars.t -> QmlAst.ty_row -> FreeVars.t
161 val freevars_of_col :
162 ?with_forall:bool -> ?free:FreeVars.t -> QmlAst.ty_col -> FreeVars.t
163
164 module Scheme :
165 sig
166 type t = typescheme
167 (* val to_string : t -> string (\** e.g : [Forall { 'a } : 'a -> int] *\) *)
168
169 (* alpha-renaming to new, fresh type vars *)
170 val refresh : t -> t
171
172 (** <<<<<<<<<<<<<<<<<<<<<<<< *)
173 (** EXPORT : can be usefull for Named-type as well (keep it in API) *)
174 val export : t -> (QmlAst.typevar list * QmlAst.rowvar list * QmlAst.colvar list) * QmlAst.ty
175 (** IMPORT : use definition *)
176 (** >>>>>>>>>>>>>>>>>>>>>>>> *)
177
178 (** introduction of a new schema, without quantification (e.g. Lambda, or LetRecIn) *)
179 (** the schema returned is : [Forall {} : 'a where 'a is a fresh typevar] *)
180 val next : QmlAst.typevar -> t
181
182 val instantiate : t -> QmlAst.ty
183 (** contain a refresh so that typescheme cannot be corrupted *)
184 (** the refresh is done only on quantified vars, to be compatible with the w algorithm *)
185
186 (**
187 ABOUT GENERALIZATION :
188 -----------------------
189
190 With the value of first level, it should not be any non-closed schema,
191 so gamma is not needed to generalize the type of such values --
192
193 so it is possible to define :
194
195 val quantify : ty -> t ( returning a closed schema )
196
197 a [generalization_with_gamma] is called only internly by the typer in a
198 w algorithm at least so it should theoreticly not be put in the API,
199 but then, since Scheme.t is private, the typer wont be able to provide
200 the implementation for it
201
202 + However, if somebody writte a typer, he should know that the generalization
203 needs the freevars of gamma and then he will use the function generalize, not the quantify
204 function
205
206 + If a human user (not a typer guy) mistakes, and call the function generalize instead of
207 quantify on a first level type of qml, it is equivalent (can just be less efficient)
208
209 Both contain a refresh on quantified variables, to be sure that any vars of
210 ty cannot appear in typescheme if ty will be corrupted later,
211 typescheme keep clean *)
212
213 val generalize : gamma -> QmlAst.ty -> t
214 val quantify : QmlAst.ty -> t
215
216 (**
217 EXTRA API FOR TYPE DEFINITION AND NAME TYPES :
218 ---------------------------------------------
219
220 given a type, with some parameters (type definition -- [type ('a, 'b) = { a : 'a ; b : 'b } ]
221 will build a schema, by verifying the well-formed property freevars(t) = params
222 It will also check that the parameters are uniq :
223 don't allow type ('a, 'a) toto = ....
224 it possibly raises an TyperException (like arity problems, unbound typevars, etc ...)
225
226 12/08/09, Adam: I add a restriction for recursive types, in the body of type t:
227 [type ('a1, ... 'an) t]
228 if there is a recursive reference to [t] it must be with _exactly the same_ parameters
229 ('a1, ... 'an). If this is not the case QmlTyperException.WrongUseOfParameters is
230 thrown
231 *)
232 val definition : ?typevar:QmlAst.typevar list -> ?ty_row:QmlAst.rowvar list -> QmlAst.typeident -> QmlAst.ty -> t
233 (** if you find a TypeName ( [ int ; float], "toto") and you want to unify it with a other type,
234 you will need to specialize the schema of your type scheme
235 it possibly raises an TyperException (like arity problems, unbound typevars, etc ...)
236 to help the error message, you must provide a TypeIdent.t (without it, the message is totally useless)
237
238 if you don't provide any vars (all default arg are []), then the function is equivalent
239 to the function [instantiate] if the schema has an empty quantification
240 but will raise an exception otherwise
241 *)
242 val specialize : typeident:QmlAst.typeident -> ?ty:(QmlAst.ty list) -> ?ty_row:(QmlAst.ty_row list) -> t -> QmlAst.ty
243
244 val id : QmlAst.ty -> t
245 val explicit_forall : t -> QmlAst.ty
246 end
247
248 module Env :
249 sig
250 type t = gamma
251
252 val empty : t
253
254 module Ident :
255 sig
256 val find_opt : QmlAst.ident -> gamma -> typescheme option
257 val find : QmlAst.ident -> gamma -> typescheme
258 val add : QmlAst.ident -> typescheme -> gamma -> gamma
259 val remove : QmlAst.ident -> gamma -> gamma
260 val mem : QmlAst.ident -> gamma -> bool
261 val iter : (QmlAst.ident -> typescheme -> unit) -> gamma -> unit
262 val fold : (QmlAst.ident -> typescheme -> 'a -> 'a) -> gamma -> 'a -> 'a
263 val map : (typescheme -> typescheme) -> gamma -> gamma
264 val fold_map : (QmlAst.ident -> typescheme -> 'acc -> 'acc * typescheme) -> gamma -> 'acc -> 'acc * gamma
265 val from_map : typescheme IdentMap.t -> gamma -> gamma
266 val to_map : gamma -> typescheme IdentMap.t
267 val pp : Format.formatter -> gamma -> unit
268 end
269
270 module TypeIdent :
271 sig
272 val find_opt :
273 visibility_applies: bool -> QmlAst.typeident -> gamma ->
b12589bd » fpessaux
2011-08-08 [feature] Typer: Height of type abbreviation to balance unwinding dur…
274 (typescheme * abbrev_height) option
fccc6851 » MLstate
2011-06-21 Initial open-source release
275 val findi_opt :
276 visibility_applies: bool -> QmlAst.typeident -> gamma ->
b12589bd » fpessaux
2011-08-08 [feature] Typer: Height of type abbreviation to balance unwinding dur…
277 (QmlAst.typeident * (typescheme * abbrev_height)) option
fccc6851 » MLstate
2011-06-21 Initial open-source release
278 val find :
b12589bd » fpessaux
2011-08-08 [feature] Typer: Height of type abbreviation to balance unwinding dur…
279 visibility_applies: bool -> QmlAst.typeident -> gamma ->
280 (typescheme * abbrev_height)
fccc6851 » MLstate
2011-06-21 Initial open-source release
281 val findi :
282 visibility_applies: bool -> QmlAst.typeident -> gamma ->
b12589bd » fpessaux
2011-08-08 [feature] Typer: Height of type abbreviation to balance unwinding dur…
283 (QmlAst.typeident * (typescheme * abbrev_height))
fccc6851 » MLstate
2011-06-21 Initial open-source release
284 (* *********************************************************************** *)
b12589bd » fpessaux
2011-08-08 [feature] Typer: Height of type abbreviation to balance unwinding dur…
285 (** {b Descr}: Lookup in the environment for the type definition bound to
fccc6851 » MLstate
2011-06-21 Initial open-source release
286 a type name, ignoring the visibility (i.e. scope) of this name, and
287 returning this visibility in addition to the bound definition.
288 This function is dedicated to be used by the check that no private
289 type espace by appearing in the signature of a toplevel value not marked
290 as @private. For this reason, this processing needs to know the
291 visibility of the type name. *)
292 (* *********************************************************************** *)
293 val raw_find :
b12589bd » fpessaux
2011-08-08 [feature] Typer: Height of type abbreviation to balance unwinding dur…
294 QmlAst.typeident -> gamma ->
295 (typescheme * abbrev_height * QmlAst.type_def_visibility)
fccc6851 » MLstate
2011-06-21 Initial open-source release
296 val add :
b12589bd » fpessaux
2011-08-08 [feature] Typer: Height of type abbreviation to balance unwinding dur…
297 QmlAst.typeident ->
298 (typescheme * abbrev_height * QmlAst.type_def_visibility) -> gamma ->
299 gamma
fccc6851 » MLstate
2011-06-21 Initial open-source release
300 val mem : QmlAst.typeident -> gamma -> bool
301 val iter :
b12589bd » fpessaux
2011-08-08 [feature] Typer: Height of type abbreviation to balance unwinding dur…
302 (QmlAst.typeident ->
303 (typescheme * abbrev_height * QmlAst.type_def_visibility) -> unit) ->
304 gamma -> unit
fccc6851 » MLstate
2011-06-21 Initial open-source release
305 val fold :
b12589bd » fpessaux
2011-08-08 [feature] Typer: Height of type abbreviation to balance unwinding dur…
306 (QmlAst.typeident ->
307 (typescheme * abbrev_height * QmlAst.type_def_visibility) ->
308 'a -> 'a) ->
309 gamma -> 'a -> 'a
fccc6851 » MLstate
2011-06-21 Initial open-source release
310 val to_list :
311 gamma ->
b12589bd » fpessaux
2011-08-08 [feature] Typer: Height of type abbreviation to balance unwinding dur…
312 (QmlAst.typeident *
313 (typescheme * abbrev_height * QmlAst.type_def_visibility))
314 list
fccc6851 » MLstate
2011-06-21 Initial open-source release
315 val fold_map :
b12589bd » fpessaux
2011-08-08 [feature] Typer: Height of type abbreviation to balance unwinding dur…
316 (QmlAst.typeident ->
317 (typescheme * abbrev_height * QmlAst.type_def_visibility) -> 'acc ->
318 'acc * (typescheme * abbrev_height * QmlAst.type_def_visibility)) ->
fccc6851 » MLstate
2011-06-21 Initial open-source release
319 gamma -> 'acc -> 'acc * gamma
320 val map :
b12589bd » fpessaux
2011-08-08 [feature] Typer: Height of type abbreviation to balance unwinding dur…
321 ((typescheme * abbrev_height * QmlAst.type_def_visibility) ->
322 (typescheme * abbrev_height * QmlAst.type_def_visibility)) ->
fccc6851 » MLstate
2011-06-21 Initial open-source release
323 gamma -> gamma
324 val pp : Format.formatter -> gamma -> unit
325 end
326
327 (** a map of field which update with every TypeIdent.add in gamma
328 Given a field, return the TypeIdentSet of every type containing such a field *)
329 module FieldMap :
330 sig
331 val find : string -> gamma -> QmlAst.typeident list
332 end
333
334 val pp : Format.formatter -> gamma -> unit
335
336 (** Appends the definition in g2 to those of g1 *)
337 val append : gamma -> gamma -> gamma
338
339 (** with let type in, gamma can be updated with abstract type *)
340 (** in fact, this module should not be here because it is possibly used
341 by the typers only, typing such expr :
342
343 [let ... =
344 let type toto = ... in <- from here the abstract type toto IS in gamma
345 ....
346 in] <-- from here the abstract type toto IS NO MORE in gamma
347
348 It brings also confusion to be able to add abstract type in gamma, for example in
349 a type definition
350
351 [type ('a, 'b) toto = abstract]
352
353 what should we do ? people would probably say, if we let an API in gamma to
354 add abstracttype, that they should probably add toto in the abstract types
355 map of gamma ! but it is not implemented in this way in our code !
356
357 we must :
358
359 1) create a new abstract type (extern)
360 2) add in gamma in the type ident map the binding "toto" -> typescheme :
361 [Forall {'a, 'b} : TypeAbstract ('a, 'b) , toto]
362
363 with :
364 [type ('a, 'b) toto = abstract]
365 you don't know the implementation of the type toto
366
367 with :
368 [let type ('a, 'b) toto = { a : 'a ; b : 'b } in ..]
369 you know the implementation, so you can both bind and a new type ident with it
370
371 *)
372
373 (**
374
375 HACKS IN GAMMA :
376 ---------------
377
378 we do not want that the typer use gamma like a set of hacks
379
380 If something typer specific is missing in gamma, as long as it is not needed to
381 be with dealed with a continuation, it is possible to have something like :
382
383 (the typer inference should use a tuned gamma)
384
385 [let w gamma expr =
386 let env = { gamma = gamma ; private_extra_env = private_extra_env_empty } in
387 let rec aux env e =
388 ... ... use env.gamma and env.private_extra_env
389 in
390 let typ = aux env e in
391 typ]
392
393 if something need continuation passing, let's talk about it, and maybe if it is
394 really typer-generic and needed then it can be added in gamma
395 (for example, let's thing about add_intypingident & is_intypingident which are not necessarly in gamma !)
396 *)
397
398 (* module Hacks : *)
399 (* sig *)
400 (* type add_your_hacks_here = unit *)
401 (* val hack_api : add_your_hacks_here -> add_your_hacks_here *)
402 (* end *)
403
404 end
405
406 (** More Common Types, needed in order that differents HighTyper could share the type env *)
407 type typed_code_elt = (QmlAst.ty, Scheme.t) QmlAst.maped_code_elt
408 (** Now the type env is public, so that we can also share it between HighTyper *)
409 (** avoid cyclic dependencies between QmlTypes and DbGen *)
410 type 'schema public_env =
411 {
412 (** The set of toplevel identifiers that are visible outside the package.
413 It will be used to raise an error if a value has a type containing a
414 @private type and this value is not marked also by a @private. This
415 is to avoid private types escaping from their scope. *)
416 exported_values_idents : IdentSet.t ;
417 gamma : gamma ;
418 schema : 'schema ;
419 annotmap : QmlAst.annotmap ;
420 bypass_typer : bypass_typer ;
421 had_error : bool ;
422 exception_handler : 'schema public_env -> exn -> unit ;
423 display : bool ; (** false by default *)
424 options : options ;
425 }
426
427 (** typedef=true -> be strict about arguments of named types *)
b12589bd » fpessaux
2011-08-08 [feature] Typer: Height of type abbreviation to balance unwinding dur…
428 val type_of_type :
429 ?typedef:bool -> ?tirec:((QmlAst.typeident * QmlAst.typevar list) list) ->
430 gamma -> QmlAst.ty -> (QmlAst.ty * int)
fccc6851 » MLstate
2011-06-21 Initial open-source release
431 (*This function may raises an exception if you give it garbage (e.g. incorrect gamma) *)
432 (* : ... -> TypeIdent.raw ty -> TypeIdent.processed ty *)
433
434 val process_gamma :
435 gamma:gamma (* the one that is processed and contains all types for the other one *) ->
436 gamma (* the one to process *) -> gamma
b12589bd » fpessaux
2011-08-08 [feature] Typer: Height of type abbreviation to balance unwinding dur…
437 val process_scheme : gamma -> typescheme -> (typescheme * abbrev_height)
fccc6851 » MLstate
2011-06-21 Initial open-source release
438 val process_annotmap : gamma:gamma -> QmlAst.annotmap -> QmlAst.annotmap
439 val process_typenames_annotmap : gamma:gamma -> QmlAst.annotmap -> QmlAst.annotmap
440
441 (** fails if there are duplicate type definitions *)
442 val check_no_duplicate_type_defs : QmlAst.code -> unit
Something went wrong with that request. Please try again.