Skip to content
Newer
Older
100644 447 lines (356 sloc) 17.2 KB
fccc685 Initial open-source release
MLstate authored Jun 21, 2011
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
b12589b @fpessaux [feature] Typer: Height of type abbreviation to balance unwinding dur…
fpessaux authored Aug 8, 2011
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
fccc685 Initial open-source release
MLstate authored Jun 21, 2011
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
fd1d3d6 [enhance] qmlTypes: add renaming possibility with refresh of typescheme
Valentin Gatien-Baron authored Jun 24, 2011
167 type renaming
fccc685 Initial open-source release
MLstate authored Jun 21, 2011
168 (* val to_string : t -> string (\** e.g : [Forall { 'a } : 'a -> int] *\) *)
169
170 (* alpha-renaming to new, fresh type vars *)
171 val refresh : t -> t
fd1d3d6 [enhance] qmlTypes: add renaming possibility with refresh of typescheme
Valentin Gatien-Baron authored Jun 24, 2011
172 val refresh_and_renaming : t -> t * renaming
173 val apply_renaming : renaming -> QmlAst.ty -> QmlAst.ty
174 val empty_renaming : renaming
fccc685 Initial open-source release
MLstate authored Jun 21, 2011
175
176 (** <<<<<<<<<<<<<<<<<<<<<<<< *)
177 (** EXPORT : can be usefull for Named-type as well (keep it in API) *)
178 val export : t -> (QmlAst.typevar list * QmlAst.rowvar list * QmlAst.colvar list) * QmlAst.ty
179 (** IMPORT : use definition *)
180 (** >>>>>>>>>>>>>>>>>>>>>>>> *)
181
182 (** introduction of a new schema, without quantification (e.g. Lambda, or LetRecIn) *)
183 (** the schema returned is : [Forall {} : 'a where 'a is a fresh typevar] *)
184 val next : QmlAst.typevar -> t
185
186 val instantiate : t -> QmlAst.ty
187 (** contain a refresh so that typescheme cannot be corrupted *)
188 (** the refresh is done only on quantified vars, to be compatible with the w algorithm *)
189
190 (**
191 ABOUT GENERALIZATION :
192 -----------------------
193
194 With the value of first level, it should not be any non-closed schema,
195 so gamma is not needed to generalize the type of such values --
196
197 so it is possible to define :
198
199 val quantify : ty -> t ( returning a closed schema )
200
201 a [generalization_with_gamma] is called only internly by the typer in a
202 w algorithm at least so it should theoreticly not be put in the API,
203 but then, since Scheme.t is private, the typer wont be able to provide
204 the implementation for it
205
206 + However, if somebody writte a typer, he should know that the generalization
207 needs the freevars of gamma and then he will use the function generalize, not the quantify
208 function
209
210 + If a human user (not a typer guy) mistakes, and call the function generalize instead of
211 quantify on a first level type of qml, it is equivalent (can just be less efficient)
212
213 Both contain a refresh on quantified variables, to be sure that any vars of
214 ty cannot appear in typescheme if ty will be corrupted later,
215 typescheme keep clean *)
216
217 val generalize : gamma -> QmlAst.ty -> t
218 val quantify : QmlAst.ty -> t
219
220 (**
221 EXTRA API FOR TYPE DEFINITION AND NAME TYPES :
222 ---------------------------------------------
223
224 given a type, with some parameters (type definition -- [type ('a, 'b) = { a : 'a ; b : 'b } ]
225 will build a schema, by verifying the well-formed property freevars(t) = params
226 It will also check that the parameters are uniq :
227 don't allow type ('a, 'a) toto = ....
228 it possibly raises an TyperException (like arity problems, unbound typevars, etc ...)
229
230 12/08/09, Adam: I add a restriction for recursive types, in the body of type t:
231 [type ('a1, ... 'an) t]
232 if there is a recursive reference to [t] it must be with _exactly the same_ parameters
233 ('a1, ... 'an). If this is not the case QmlTyperException.WrongUseOfParameters is
234 thrown
235 *)
236 val definition : ?typevar:QmlAst.typevar list -> ?ty_row:QmlAst.rowvar list -> QmlAst.typeident -> QmlAst.ty -> t
237 (** if you find a TypeName ( [ int ; float], "toto") and you want to unify it with a other type,
238 you will need to specialize the schema of your type scheme
239 it possibly raises an TyperException (like arity problems, unbound typevars, etc ...)
240 to help the error message, you must provide a TypeIdent.t (without it, the message is totally useless)
241
242 if you don't provide any vars (all default arg are []), then the function is equivalent
243 to the function [instantiate] if the schema has an empty quantification
244 but will raise an exception otherwise
245 *)
246 val specialize : typeident:QmlAst.typeident -> ?ty:(QmlAst.ty list) -> ?ty_row:(QmlAst.ty_row list) -> t -> QmlAst.ty
247
248 val id : QmlAst.ty -> t
249 val explicit_forall : t -> QmlAst.ty
250 end
251
252 module Env :
253 sig
254 type t = gamma
255
256 val empty : t
257
258 module Ident :
259 sig
260 val find_opt : QmlAst.ident -> gamma -> typescheme option
261 val find : QmlAst.ident -> gamma -> typescheme
262 val add : QmlAst.ident -> typescheme -> gamma -> gamma
263 val remove : QmlAst.ident -> gamma -> gamma
264 val mem : QmlAst.ident -> gamma -> bool
265 val iter : (QmlAst.ident -> typescheme -> unit) -> gamma -> unit
266 val fold : (QmlAst.ident -> typescheme -> 'a -> 'a) -> gamma -> 'a -> 'a
267 val map : (typescheme -> typescheme) -> gamma -> gamma
268 val fold_map : (QmlAst.ident -> typescheme -> 'acc -> 'acc * typescheme) -> gamma -> 'acc -> 'acc * gamma
269 val from_map : typescheme IdentMap.t -> gamma -> gamma
270 val to_map : gamma -> typescheme IdentMap.t
271 val pp : Format.formatter -> gamma -> unit
272 end
273
274 module TypeIdent :
275 sig
276 val find_opt :
277 visibility_applies: bool -> QmlAst.typeident -> gamma ->
b12589b @fpessaux [feature] Typer: Height of type abbreviation to balance unwinding dur…
fpessaux authored Aug 8, 2011
278 (typescheme * abbrev_height) option
fccc685 Initial open-source release
MLstate authored Jun 21, 2011
279 val findi_opt :
280 visibility_applies: bool -> QmlAst.typeident -> gamma ->
b12589b @fpessaux [feature] Typer: Height of type abbreviation to balance unwinding dur…
fpessaux authored Aug 8, 2011
281 (QmlAst.typeident * (typescheme * abbrev_height)) option
fccc685 Initial open-source release
MLstate authored Jun 21, 2011
282 val find :
b12589b @fpessaux [feature] Typer: Height of type abbreviation to balance unwinding dur…
fpessaux authored Aug 8, 2011
283 visibility_applies: bool -> QmlAst.typeident -> gamma ->
284 (typescheme * abbrev_height)
fccc685 Initial open-source release
MLstate authored Jun 21, 2011
285 val findi :
286 visibility_applies: bool -> QmlAst.typeident -> gamma ->
b12589b @fpessaux [feature] Typer: Height of type abbreviation to balance unwinding dur…
fpessaux authored Aug 8, 2011
287 (QmlAst.typeident * (typescheme * abbrev_height))
fccc685 Initial open-source release
MLstate authored Jun 21, 2011
288 (* *********************************************************************** *)
b12589b @fpessaux [feature] Typer: Height of type abbreviation to balance unwinding dur…
fpessaux authored Aug 8, 2011
289 (** {b Descr}: Lookup in the environment for the type definition bound to
fccc685 Initial open-source release
MLstate authored Jun 21, 2011
290 a type name, ignoring the visibility (i.e. scope) of this name, and
291 returning this visibility in addition to the bound definition.
292 This function is dedicated to be used by the check that no private
293 type espace by appearing in the signature of a toplevel value not marked
294 as @private. For this reason, this processing needs to know the
295 visibility of the type name. *)
296 (* *********************************************************************** *)
297 val raw_find :
b12589b @fpessaux [feature] Typer: Height of type abbreviation to balance unwinding dur…
fpessaux authored Aug 8, 2011
298 QmlAst.typeident -> gamma ->
299 (typescheme * abbrev_height * QmlAst.type_def_visibility)
fccc685 Initial open-source release
MLstate authored Jun 21, 2011
300 val add :
b12589b @fpessaux [feature] Typer: Height of type abbreviation to balance unwinding dur…
fpessaux authored Aug 8, 2011
301 QmlAst.typeident ->
302 (typescheme * abbrev_height * QmlAst.type_def_visibility) -> gamma ->
303 gamma
fccc685 Initial open-source release
MLstate authored Jun 21, 2011
304 val mem : QmlAst.typeident -> gamma -> bool
305 val iter :
b12589b @fpessaux [feature] Typer: Height of type abbreviation to balance unwinding dur…
fpessaux authored Aug 8, 2011
306 (QmlAst.typeident ->
307 (typescheme * abbrev_height * QmlAst.type_def_visibility) -> unit) ->
308 gamma -> unit
fccc685 Initial open-source release
MLstate authored Jun 21, 2011
309 val fold :
b12589b @fpessaux [feature] Typer: Height of type abbreviation to balance unwinding dur…
fpessaux authored Aug 8, 2011
310 (QmlAst.typeident ->
311 (typescheme * abbrev_height * QmlAst.type_def_visibility) ->
312 'a -> 'a) ->
313 gamma -> 'a -> 'a
fccc685 Initial open-source release
MLstate authored Jun 21, 2011
314 val to_list :
315 gamma ->
b12589b @fpessaux [feature] Typer: Height of type abbreviation to balance unwinding dur…
fpessaux authored Aug 8, 2011
316 (QmlAst.typeident *
317 (typescheme * abbrev_height * QmlAst.type_def_visibility))
318 list
fccc685 Initial open-source release
MLstate authored Jun 21, 2011
319 val fold_map :
b12589b @fpessaux [feature] Typer: Height of type abbreviation to balance unwinding dur…
fpessaux authored Aug 8, 2011
320 (QmlAst.typeident ->
321 (typescheme * abbrev_height * QmlAst.type_def_visibility) -> 'acc ->
322 'acc * (typescheme * abbrev_height * QmlAst.type_def_visibility)) ->
fccc685 Initial open-source release
MLstate authored Jun 21, 2011
323 gamma -> 'acc -> 'acc * gamma
324 val map :
b12589b @fpessaux [feature] Typer: Height of type abbreviation to balance unwinding dur…
fpessaux authored Aug 8, 2011
325 ((typescheme * abbrev_height * QmlAst.type_def_visibility) ->
326 (typescheme * abbrev_height * QmlAst.type_def_visibility)) ->
fccc685 Initial open-source release
MLstate authored Jun 21, 2011
327 gamma -> gamma
328 val pp : Format.formatter -> gamma -> unit
329 end
330
331 (** a map of field which update with every TypeIdent.add in gamma
332 Given a field, return the TypeIdentSet of every type containing such a field *)
333 module FieldMap :
334 sig
335 val find : string -> gamma -> QmlAst.typeident list
336 end
337
338 val pp : Format.formatter -> gamma -> unit
339
340 (** Appends the definition in g2 to those of g1 *)
341 val append : gamma -> gamma -> gamma
342
343 (** with let type in, gamma can be updated with abstract type *)
344 (** in fact, this module should not be here because it is possibly used
345 by the typers only, typing such expr :
346
347 [let ... =
348 let type toto = ... in <- from here the abstract type toto IS in gamma
349 ....
350 in] <-- from here the abstract type toto IS NO MORE in gamma
351
352 It brings also confusion to be able to add abstract type in gamma, for example in
353 a type definition
354
355 [type ('a, 'b) toto = abstract]
356
357 what should we do ? people would probably say, if we let an API in gamma to
358 add abstracttype, that they should probably add toto in the abstract types
359 map of gamma ! but it is not implemented in this way in our code !
360
361 we must :
362
363 1) create a new abstract type (extern)
364 2) add in gamma in the type ident map the binding "toto" -> typescheme :
365 [Forall {'a, 'b} : TypeAbstract ('a, 'b) , toto]
366
367 with :
368 [type ('a, 'b) toto = abstract]
369 you don't know the implementation of the type toto
370
371 with :
372 [let type ('a, 'b) toto = { a : 'a ; b : 'b } in ..]
373 you know the implementation, so you can both bind and a new type ident with it
374
375 *)
376
377 (**
378
379 HACKS IN GAMMA :
380 ---------------
381
382 we do not want that the typer use gamma like a set of hacks
383
384 If something typer specific is missing in gamma, as long as it is not needed to
385 be with dealed with a continuation, it is possible to have something like :
386
387 (the typer inference should use a tuned gamma)
388
389 [let w gamma expr =
390 let env = { gamma = gamma ; private_extra_env = private_extra_env_empty } in
391 let rec aux env e =
392 ... ... use env.gamma and env.private_extra_env
393 in
394 let typ = aux env e in
395 typ]
396
397 if something need continuation passing, let's talk about it, and maybe if it is
398 really typer-generic and needed then it can be added in gamma
399 (for example, let's thing about add_intypingident & is_intypingident which are not necessarly in gamma !)
400 *)
401
402 (* module Hacks : *)
403 (* sig *)
404 (* type add_your_hacks_here = unit *)
405 (* val hack_api : add_your_hacks_here -> add_your_hacks_here *)
406 (* end *)
407
408 end
409
410 (** More Common Types, needed in order that differents HighTyper could share the type env *)
411 type typed_code_elt = (QmlAst.ty, Scheme.t) QmlAst.maped_code_elt
412 (** Now the type env is public, so that we can also share it between HighTyper *)
413 (** avoid cyclic dependencies between QmlTypes and DbGen *)
414 type 'schema public_env =
415 {
416 (** The set of toplevel identifiers that are visible outside the package.
417 It will be used to raise an error if a value has a type containing a
418 @private type and this value is not marked also by a @private. This
419 is to avoid private types escaping from their scope. *)
420 exported_values_idents : IdentSet.t ;
421 gamma : gamma ;
422 schema : 'schema ;
423 annotmap : QmlAst.annotmap ;
424 bypass_typer : bypass_typer ;
425 had_error : bool ;
426 exception_handler : 'schema public_env -> exn -> unit ;
427 display : bool ; (** false by default *)
428 options : options ;
429 }
430
431 (** typedef=true -> be strict about arguments of named types *)
b12589b @fpessaux [feature] Typer: Height of type abbreviation to balance unwinding dur…
fpessaux authored Aug 8, 2011
432 val type_of_type :
433 ?typedef:bool -> ?tirec:((QmlAst.typeident * QmlAst.typevar list) list) ->
434 gamma -> QmlAst.ty -> (QmlAst.ty * int)
fccc685 Initial open-source release
MLstate authored Jun 21, 2011
435 (*This function may raises an exception if you give it garbage (e.g. incorrect gamma) *)
436 (* : ... -> TypeIdent.raw ty -> TypeIdent.processed ty *)
437
438 val process_gamma :
439 gamma:gamma (* the one that is processed and contains all types for the other one *) ->
440 gamma (* the one to process *) -> gamma
b12589b @fpessaux [feature] Typer: Height of type abbreviation to balance unwinding dur…
fpessaux authored Aug 8, 2011
441 val process_scheme : gamma -> typescheme -> (typescheme * abbrev_height)
fccc685 Initial open-source release
MLstate authored Jun 21, 2011
442 val process_annotmap : gamma:gamma -> QmlAst.annotmap -> QmlAst.annotmap
443 val process_typenames_annotmap : gamma:gamma -> QmlAst.annotmap -> QmlAst.annotmap
444
445 (** fails if there are duplicate type definitions *)
446 val check_no_duplicate_type_defs : QmlAst.code -> unit
Something went wrong with that request. Please try again.