forked from danmey/typerex
-
Notifications
You must be signed in to change notification settings - Fork 0
/
types.ml
214 lines (175 loc) · 7.34 KB
/
types.ml
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
(***********************************************************************)
(* *)
(* OCaml *)
(* *)
(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
(* *)
(* Copyright 1996 Institut National de Recherche en Informatique et *)
(* en Automatique. All rights reserved. This file is distributed *)
(* under the terms of the Q Public License version 1.0. *)
(* *)
(***********************************************************************)
(* $Id$ *)
(* Representation of types and declarations *)
open Misc
open Asttypes
(* Type expressions for the core language *)
type type_expr =
{ mutable desc: type_desc;
mutable level: int;
mutable id: int }
and type_desc =
Tvar of string option
| Tarrow of label * type_expr * type_expr * commutable
| Ttuple of type_expr list
| Tconstr of Path.t * type_expr list * abbrev_memo ref
| Tobject of type_expr * (Path.t * type_expr list) option ref
| Tfield of string * field_kind * type_expr * type_expr
| Tnil
| Tlink of type_expr
| Tsubst of type_expr (* for copying *)
| Tvariant of row_desc
| Tunivar of string option
| Tpoly of type_expr * type_expr list
| Tpackage of Path.t * string list * type_expr list
and row_desc =
{ row_fields: (label * row_field) list;
row_more: type_expr;
row_bound: unit;
row_closed: bool;
row_fixed: bool;
row_name: (Path.t * type_expr list) option }
and row_field =
Rpresent of type_expr option
| Reither of bool * type_expr list * bool * row_field option ref
(* 1st true denotes a constant constructor *)
(* 2nd true denotes a tag in a pattern matching, and
is erased later *)
| Rabsent
and abbrev_memo =
Mnil
| Mcons of private_flag * Path.t * type_expr * type_expr * abbrev_memo
| Mlink of abbrev_memo ref
and field_kind =
Fvar of field_kind option ref
| Fpresent
| Fabsent
and commutable =
Cok
| Cunknown
| Clink of commutable ref
module TypeOps = struct
type t = type_expr
let compare t1 t2 = t1.id - t2.id
let hash t = t.id
let equal t1 t2 = t1 == t2
end
(* Maps of methods and instance variables *)
module OrderedString = struct type t = string let compare = compare end
module Meths = Map.Make(OrderedString)
module Vars = Meths
(* Value descriptions *)
type value_description =
{ val_type: type_expr; (* Type of the value *)
val_kind: value_kind }
and value_kind =
Val_reg (* Regular value *)
| Val_prim of Primitive.description (* Primitive *)
| Val_ivar of mutable_flag * string (* Instance variable (mutable ?) *)
| Val_self of (Ident.t * type_expr) Meths.t ref *
(Ident.t * Asttypes.mutable_flag *
Asttypes.virtual_flag * type_expr) Vars.t ref *
string * type_expr
(* Self *)
| Val_anc of (string * Ident.t) list * string
(* Ancestor *)
| Val_unbound (* Unbound variable *)
(* Constructor descriptions *)
type constructor_description =
{ cstr_res: type_expr; (* Type of the result *)
cstr_existentials: type_expr list; (* list of existentials *)
cstr_args: type_expr list; (* Type of the arguments *)
cstr_arity: int; (* Number of arguments *)
cstr_tag: constructor_tag; (* Tag for heap blocks *)
cstr_consts: int; (* Number of constant constructors *)
cstr_nonconsts: int; (* Number of non-const constructors *)
cstr_normal: int; (* Number of non generalized constrs *)
cstr_generalized: bool; (* Constrained return type? *)
cstr_private: private_flag } (* Read-only constructor? *)
and constructor_tag =
Cstr_constant of int (* Constant constructor (an int) *)
| Cstr_block of int (* Regular constructor (a block) *)
| Cstr_exception of Path.t (* Exception constructor *)
(* Record label descriptions *)
type label_description =
{ lbl_name: string; (* Short name *)
lbl_res: type_expr; (* Type of the result *)
lbl_arg: type_expr; (* Type of the argument *)
lbl_mut: mutable_flag; (* Is this a mutable field? *)
lbl_pos: int; (* Position in block *)
lbl_all: label_description array; (* All the labels in this type *)
lbl_repres: record_representation; (* Representation for this record *)
lbl_private: private_flag } (* Read-only field? *)
and record_representation =
Record_regular (* All fields are boxed / tagged *)
| Record_float (* All fields are floats *)
(* Type definitions *)
type type_declaration =
{ type_params: type_expr list;
type_arity: int;
type_kind: type_kind;
type_private: private_flag;
type_manifest: type_expr option;
type_variance: (bool * bool * bool) list;
type_newtype_level: int option }
(* covariant, contravariant, weakly contravariant *)
and type_kind =
Type_abstract
| Type_record of
(Ident.t * mutable_flag * type_expr) list * record_representation
| Type_variant of (Ident.t * type_expr list * type_expr option) list
type exception_declaration = type_expr list
(* Type expressions for the class language *)
module Concr = Set.Make(OrderedString)
type class_type =
Cty_constr of Path.t * type_expr list * class_type
| Cty_signature of class_signature
| Cty_fun of label * type_expr * class_type
and class_signature =
{ cty_self: type_expr;
cty_vars:
(Asttypes.mutable_flag * Asttypes.virtual_flag * type_expr) Vars.t;
cty_concr: Concr.t;
cty_inher: (Path.t * type_expr list) list }
type class_declaration =
{ cty_params: type_expr list;
mutable cty_type: class_type;
cty_path: Path.t;
cty_new: type_expr option;
cty_variance: (bool * bool) list }
type class_type_declaration =
{ clty_params: type_expr list;
clty_type: class_type;
clty_path: Path.t;
clty_variance: (bool * bool) list }
(* Type expressions for the module language *)
type module_type =
Mty_ident of Path.t
| Mty_signature of signature
| Mty_functor of Ident.t * module_type * module_type
and signature = signature_item list
and signature_item =
Sig_value of Ident.t * value_description
| Sig_type of Ident.t * type_declaration * rec_status
| Sig_exception of Ident.t * exception_declaration
| Sig_module of Ident.t * module_type * rec_status
| Sig_modtype of Ident.t * modtype_declaration
| Sig_class of Ident.t * class_declaration * rec_status
| Sig_class_type of Ident.t * class_type_declaration * rec_status
and modtype_declaration =
Modtype_abstract
| Modtype_manifest of module_type
and rec_status =
Trec_not (* not recursive *)
| Trec_first (* first in a recursive group *)
| Trec_next (* not first in a recursive group *)