Revision ca7ff3f7
Added by Lélio Brun over 1 year ago
src/types.ml | ||
---|---|---|
6 | 6 |
(* LustreC is free software, distributed WITHOUT ANY WARRANTY *) |
7 | 7 |
(* under the terms of the GNU Lesser General Public License *) |
8 | 8 |
(* version 2.1. *) |
9 |
(* *)
|
|
9 |
(* *) |
|
10 | 10 |
(* This file was originally from the Prelude compiler *) |
11 |
(* *)
|
|
11 |
(* *) |
|
12 | 12 |
(********************************************************************) |
13 | 13 |
|
14 |
(** Types definitions and a few utility functions on types. *) |
|
15 | 14 |
open Utils |
15 |
(** Types definitions and a few utility functions on types. *) |
|
16 |
|
|
16 | 17 |
open Dimension |
17 | 18 |
|
18 |
module type BASIC_TYPES = |
|
19 |
sig |
|
19 |
module type BASIC_TYPES = sig |
|
20 | 20 |
type t |
21 |
val pp: Format.formatter -> t -> unit |
|
22 |
val pp_c: Format.formatter -> t -> unit |
|
23 |
val is_scalar_type: t -> bool |
|
24 |
val is_numeric_type: t -> bool |
|
25 |
val is_int_type: t -> bool |
|
26 |
val is_real_type: t -> bool |
|
27 |
val is_bool_type: t -> bool |
|
28 |
val is_dimension_type: t -> bool |
|
29 |
val type_int_builder: t |
|
30 |
val type_real_builder: t |
|
31 |
val type_bool_builder: t |
|
32 |
val type_string_builder: t |
|
33 |
val unify: t -> t -> unit |
|
34 |
val is_unifiable: t -> t -> bool |
|
21 |
|
|
22 |
val pp : Format.formatter -> t -> unit |
|
23 |
|
|
24 |
val pp_c : Format.formatter -> t -> unit |
|
25 |
|
|
26 |
val is_scalar_type : t -> bool |
|
27 |
|
|
28 |
val is_numeric_type : t -> bool |
|
29 |
|
|
30 |
val is_int_type : t -> bool |
|
31 |
|
|
32 |
val is_real_type : t -> bool |
|
33 |
|
|
34 |
val is_bool_type : t -> bool |
|
35 |
|
|
36 |
val is_dimension_type : t -> bool |
|
37 |
|
|
38 |
val type_int_builder : t |
|
39 |
|
|
40 |
val type_real_builder : t |
|
41 |
|
|
42 |
val type_bool_builder : t |
|
43 |
|
|
44 |
val type_string_builder : t |
|
45 |
|
|
46 |
val unify : t -> t -> unit |
|
47 |
|
|
48 |
val is_unifiable : t -> t -> bool |
|
35 | 49 |
end |
36 | 50 |
|
37 |
module Basic = |
|
38 |
struct |
|
39 |
type t = |
|
40 |
| Tstring |
|
41 |
| Tint |
|
42 |
| Treal |
|
43 |
| Tbool |
|
44 |
| Trat (* Actually unused for now. Only place where it can appear is |
|
45 |
in a clock declaration *) |
|
51 |
module Basic = struct |
|
52 |
type t = Tstring | Tint | Treal | Tbool | Trat |
|
53 |
(* Actually unused for now. Only place where it can appear is in a clock |
|
54 |
declaration *) |
|
46 | 55 |
|
47 | 56 |
let type_string_builder = Tstring |
57 |
|
|
48 | 58 |
let type_int_builder = Tint |
59 |
|
|
49 | 60 |
let type_real_builder = Treal |
61 |
|
|
50 | 62 |
let type_bool_builder = Tbool |
51 | 63 |
|
52 | 64 |
open Format |
65 |
|
|
53 | 66 |
let pp fmt t = |
54 | 67 |
match t with |
55 | 68 |
| Tint -> |
56 |
fprintf fmt "int"
|
|
69 |
fprintf fmt "int" |
|
57 | 70 |
| Treal -> |
58 |
fprintf fmt "real"
|
|
71 |
fprintf fmt "real" |
|
59 | 72 |
| Tstring -> |
60 |
fprintf fmt "string"
|
|
73 |
fprintf fmt "string" |
|
61 | 74 |
| Tbool -> |
62 |
fprintf fmt "bool"
|
|
75 |
fprintf fmt "bool" |
|
63 | 76 |
| Trat -> |
64 |
fprintf fmt "rat"
|
|
77 |
fprintf fmt "rat" |
|
65 | 78 |
|
66 | 79 |
let pp_c = pp |
67 |
|
|
68 |
let is_scalar_type t = |
|
69 |
match t with |
|
70 |
| Tbool |
|
71 |
| Tint |
|
72 |
| Treal -> true |
|
73 |
| _ -> false |
|
74 | 80 |
|
81 |
let is_scalar_type t = |
|
82 |
match t with Tbool | Tint | Treal -> true | _ -> false |
|
75 | 83 |
|
76 |
let is_numeric_type t = |
|
77 |
match t with |
|
78 |
| Tint |
|
79 |
| Treal -> true |
|
80 |
| _ -> false |
|
84 |
let is_numeric_type t = match t with Tint | Treal -> true | _ -> false |
|
81 | 85 |
|
82 | 86 |
let is_int_type t = t = Tint |
87 |
|
|
83 | 88 |
let is_real_type t = t = Treal |
89 |
|
|
84 | 90 |
let is_bool_type t = t = Tbool |
85 | 91 |
|
86 |
let is_dimension_type t = |
|
87 |
match t with |
|
88 |
| Tint |
|
89 |
| Tbool -> true |
|
90 |
| _ -> false |
|
92 |
let is_dimension_type t = match t with Tint | Tbool -> true | _ -> false |
|
91 | 93 |
|
92 | 94 |
let is_unifiable b1 b2 = b1 == b2 |
95 |
|
|
93 | 96 |
let unify _ _ = () |
94 | 97 |
end |
95 | 98 |
|
96 |
|
|
97 |
|
|
98 |
module Make(BasicT : BASIC_TYPES) = |
|
99 |
struct |
|
100 |
|
|
99 |
module Make (BasicT : BASIC_TYPES) = struct |
|
101 | 100 |
module BasicT = BasicT |
101 |
|
|
102 | 102 |
type basic_type = BasicT.t |
103 |
type type_expr = |
|
104 |
{mutable tdesc: type_desc;
|
|
105 |
tid: int} |
|
103 |
|
|
104 |
type type_expr = { mutable tdesc : type_desc; tid : int }
|
|
105 |
|
|
106 | 106 |
and type_desc = |
107 |
| Tconst of ident (* type constant *) |
|
107 |
| Tconst of ident |
|
108 |
(* type constant *) |
|
108 | 109 |
| Tbasic of basic_type |
109 |
| Tclock of type_expr (* A type expression explicitely tagged as carrying a clock *) |
|
110 |
| Tclock of type_expr |
|
111 |
(* A type expression explicitely tagged as carrying a clock *) |
|
110 | 112 |
| Tarrow of type_expr * type_expr |
111 | 113 |
| Ttuple of type_expr list |
112 | 114 |
| Tenum of ident list |
113 | 115 |
| Tstruct of (ident * type_expr) list |
114 | 116 |
| Tarray of dim_expr * type_expr |
115 |
| Tstatic of dim_expr * type_expr (* a type carried by a dimension expression *) |
|
116 |
| Tlink of type_expr (* During unification, make links instead of substitutions *) |
|
117 |
| Tvar (* Monomorphic type variable *) |
|
118 |
| Tunivar (* Polymorphic type variable *) |
|
117 |
| Tstatic of dim_expr * type_expr |
|
118 |
(* a type carried by a dimension expression *) |
|
119 |
| Tlink of type_expr |
|
120 |
(* During unification, make links instead of substitutions *) |
|
121 |
| Tvar |
|
122 |
(* Monomorphic type variable *) |
|
123 |
| Tunivar |
|
124 |
(* Polymorphic type variable *) |
|
119 | 125 |
|
120 | 126 |
(* {mutable tdesc: type_desc; *) |
121 | 127 |
(* tid: int} *) |
... | ... | |
123 | 129 |
(* and type_desc = *) |
124 | 130 |
(* | Tconst of ident (\* type constant *\) *) |
125 | 131 |
(* | Tbasic of BasicT.t *) |
126 |
(* | Tclock of type_expr (\* A type expression explicitely tagged as carrying a clock *\) *) |
|
132 |
(* | Tclock of type_expr (\* A type expression explicitely tagged as carrying |
|
133 |
a clock *\) *) |
|
127 | 134 |
(* | Tarrow of type_expr * type_expr *) |
128 | 135 |
(* | Ttuple of type_expr list *) |
129 | 136 |
(* | Tenum of ident list *) |
130 | 137 |
(* | Tstruct of (ident * type_expr) list *) |
131 | 138 |
(* | Tarray of dim_expr * type_expr *) |
132 |
(* | Tstatic of dim_expr * type_expr (\* a type carried by a dimension expression *\) *) |
|
133 |
(* | Tlink of type_expr (\* During unification, make links instead of substitutions *\) *) |
|
139 |
(* | Tstatic of dim_expr * type_expr (\* a type carried by a dimension |
|
140 |
expression *\) *) |
|
141 |
(* | Tlink of type_expr (\* During unification, make links instead of |
|
142 |
substitutions *\) *) |
|
134 | 143 |
(* | Tvar (\* Monomorphic type variable *\) *) |
135 | 144 |
(* | Tunivar (\* Polymorphic type variable *\) *) |
136 | 145 |
|
137 | 146 |
type error = |
138 |
Unbound_value of ident
|
|
147 |
| Unbound_value of ident
|
|
139 | 148 |
| Already_bound of ident |
140 | 149 |
| Already_defined of ident |
141 | 150 |
| Undefined_var of ISet.t |
... | ... | |
150 | 159 |
| Type_clash of type_expr * type_expr |
151 | 160 |
| Poly_imported_node of ident |
152 | 161 |
|
153 |
exception Unify of type_expr * type_expr |
|
154 |
exception Error of Location.t * error |
|
155 |
|
|
156 |
let mk_basic t = Tbasic t |
|
157 |
|
|
158 |
|
|
159 |
(* Pretty-print*) |
|
160 |
open Format |
|
161 |
|
|
162 |
let rec print_struct_ty_field pp_basic fmt (label, ty) = |
|
163 |
fprintf fmt "%a : %a" pp_print_string label (print_ty_param pp_basic) ty |
|
164 |
and print_ty_param pp_basic fmt ty = |
|
165 |
let print_ty = print_ty_param pp_basic in |
|
166 |
match ty.tdesc with |
|
167 |
| Tvar -> |
|
168 |
fprintf fmt "_%s" (name_of_type ty.tid) |
|
169 |
| Tbasic t -> pp_basic fmt t |
|
170 |
| Tclock t -> |
|
171 |
fprintf fmt "%a%s" print_ty t (if !Options.kind2_print then "" else " clock") |
|
172 |
| Tstatic (_, t) -> print_ty fmt t |
|
173 |
(* fprintf fmt "(%a:%a)" Dimension.pp_dimension d print_ty t *) |
|
174 |
| Tconst t -> |
|
175 |
fprintf fmt "%s" t |
|
176 |
| Tarrow (ty1,ty2) -> |
|
177 |
fprintf fmt "%a -> %a" print_ty ty1 print_ty ty2 |
|
178 |
| Ttuple tylist -> |
|
179 |
fprintf fmt "(%a)" |
|
180 |
(Utils.fprintf_list ~sep:" * " print_ty) tylist |
|
181 |
| Tenum taglist -> |
|
182 |
fprintf fmt "enum {%a }" |
|
183 |
(Utils.fprintf_list ~sep:", " pp_print_string) taglist |
|
184 |
| Tstruct fieldlist -> |
|
185 |
fprintf fmt "struct {%a }" |
|
186 |
(Utils.fprintf_list ~sep:"; " (print_struct_ty_field pp_basic)) fieldlist |
|
187 |
| Tarray (e, ty) -> |
|
188 |
fprintf fmt "%a^%a" print_ty ty Dimension.pp_dimension e |
|
189 |
| Tlink ty -> |
|
190 |
print_ty fmt ty |
|
191 |
| Tunivar -> |
|
192 |
fprintf fmt "'%s" (name_of_type ty.tid) |
|
193 |
|
|
194 |
let print_ty = print_ty_param BasicT.pp |
|
195 |
|
|
196 |
|
|
197 |
let rec print_node_struct_ty_field fmt (label, ty) = |
|
198 |
fprintf fmt "%a : %a" pp_print_string label print_node_ty ty |
|
199 |
and print_node_ty fmt ty = |
|
200 |
match ty.tdesc with |
|
201 |
| Tvar -> begin |
|
202 |
(*Format.eprintf "DEBUG:Types.print_node@.";*) |
|
203 |
fprintf fmt "_%s" (name_of_type ty.tid) |
|
204 |
end |
|
205 |
| Tbasic t -> BasicT.pp fmt t |
|
206 |
| Tclock t -> |
|
207 |
fprintf fmt "%a%s" print_node_ty t (if !Options.kind2_print then "" else " clock") |
|
208 |
| Tstatic (_, t) -> |
|
209 |
fprintf fmt "%a" print_node_ty t |
|
210 |
| Tconst t -> |
|
211 |
fprintf fmt "%s" t |
|
212 |
| Tarrow (ty1,ty2) -> |
|
213 |
fprintf fmt "%a -> %a" print_node_ty ty1 print_node_ty ty2 |
|
214 |
| Ttuple tylist -> |
|
215 |
fprintf fmt "(%a)" |
|
216 |
(Utils.fprintf_list ~sep:"*" print_node_ty) tylist |
|
217 |
| Tenum taglist -> |
|
218 |
fprintf fmt "enum {%a }" |
|
219 |
(Utils.fprintf_list ~sep:", " pp_print_string) taglist |
|
220 |
| Tstruct fieldlist -> |
|
221 |
fprintf fmt "struct {%a }" |
|
222 |
(Utils.fprintf_list ~sep:"; " print_node_struct_ty_field) fieldlist |
|
223 |
| Tarray (e, ty) -> |
|
224 |
fprintf fmt "%a^%a" print_node_ty ty Dimension.pp_dimension e |
|
225 |
| Tlink ty -> |
|
162 |
exception Unify of type_expr * type_expr |
|
163 |
|
|
164 |
exception Error of Location.t * error |
|
165 |
|
|
166 |
let mk_basic t = Tbasic t |
|
167 |
|
|
168 |
(* Pretty-print*) |
|
169 |
open Format |
|
170 |
|
|
171 |
let rec print_struct_ty_field pp_basic fmt (label, ty) = |
|
172 |
fprintf fmt "%a : %a" pp_print_string label (print_ty_param pp_basic) ty |
|
173 |
|
|
174 |
and print_ty_param pp_basic fmt ty = |
|
175 |
let print_ty = print_ty_param pp_basic in |
|
176 |
match ty.tdesc with |
|
177 |
| Tvar -> |
|
178 |
fprintf fmt "_%s" (name_of_type ty.tid) |
|
179 |
| Tbasic t -> |
|
180 |
pp_basic fmt t |
|
181 |
| Tclock t -> |
|
182 |
fprintf fmt "%a%s" print_ty t |
|
183 |
(if !Options.kind2_print then "" else " clock") |
|
184 |
| Tstatic (_, t) -> |
|
185 |
print_ty fmt t |
|
186 |
(* fprintf fmt "(%a:%a)" Dimension.pp_dimension d print_ty t *) |
|
187 |
| Tconst t -> |
|
188 |
fprintf fmt "%s" t |
|
189 |
| Tarrow (ty1, ty2) -> |
|
190 |
fprintf fmt "%a -> %a" print_ty ty1 print_ty ty2 |
|
191 |
| Ttuple tylist -> |
|
192 |
fprintf fmt "(%a)" (Utils.fprintf_list ~sep:" * " print_ty) tylist |
|
193 |
| Tenum taglist -> |
|
194 |
fprintf fmt "enum {%a }" |
|
195 |
(Utils.fprintf_list ~sep:", " pp_print_string) |
|
196 |
taglist |
|
197 |
| Tstruct fieldlist -> |
|
198 |
fprintf fmt "struct {%a }" |
|
199 |
(Utils.fprintf_list ~sep:"; " (print_struct_ty_field pp_basic)) |
|
200 |
fieldlist |
|
201 |
| Tarray (e, ty) -> |
|
202 |
fprintf fmt "%a^%a" print_ty ty Dimension.pp_dimension e |
|
203 |
| Tlink ty -> |
|
204 |
print_ty fmt ty |
|
205 |
| Tunivar -> |
|
206 |
fprintf fmt "'%s" (name_of_type ty.tid) |
|
207 |
|
|
208 |
let print_ty = print_ty_param BasicT.pp |
|
209 |
|
|
210 |
let rec print_node_struct_ty_field fmt (label, ty) = |
|
211 |
fprintf fmt "%a : %a" pp_print_string label print_node_ty ty |
|
212 |
|
|
213 |
and print_node_ty fmt ty = |
|
214 |
match ty.tdesc with |
|
215 |
| Tvar -> |
|
216 |
(*Format.eprintf "DEBUG:Types.print_node@.";*) |
|
217 |
fprintf fmt "_%s" (name_of_type ty.tid) |
|
218 |
| Tbasic t -> |
|
219 |
BasicT.pp fmt t |
|
220 |
| Tclock t -> |
|
221 |
fprintf fmt "%a%s" print_node_ty t |
|
222 |
(if !Options.kind2_print then "" else " clock") |
|
223 |
| Tstatic (_, t) -> |
|
224 |
fprintf fmt "%a" print_node_ty t |
|
225 |
| Tconst t -> |
|
226 |
fprintf fmt "%s" t |
|
227 |
| Tarrow (ty1, ty2) -> |
|
228 |
fprintf fmt "%a -> %a" print_node_ty ty1 print_node_ty ty2 |
|
229 |
| Ttuple tylist -> |
|
230 |
fprintf fmt "(%a)" (Utils.fprintf_list ~sep:"*" print_node_ty) tylist |
|
231 |
| Tenum taglist -> |
|
232 |
fprintf fmt "enum {%a }" |
|
233 |
(Utils.fprintf_list ~sep:", " pp_print_string) |
|
234 |
taglist |
|
235 |
| Tstruct fieldlist -> |
|
236 |
fprintf fmt "struct {%a }" |
|
237 |
(Utils.fprintf_list ~sep:"; " print_node_struct_ty_field) |
|
238 |
fieldlist |
|
239 |
| Tarray (e, ty) -> |
|
240 |
fprintf fmt "%a^%a" print_node_ty ty Dimension.pp_dimension e |
|
241 |
| Tlink ty -> |
|
226 | 242 |
print_node_ty fmt ty |
227 |
| Tunivar -> |
|
228 |
fprintf fmt "'%s" (name_of_type ty.tid) |
|
229 |
|
|
230 |
let pp_error fmt = function |
|
231 |
| Unbound_value id -> |
|
232 |
fprintf fmt "Unknown value %s@." id |
|
233 |
| Unbound_type id -> |
|
234 |
fprintf fmt "Unknown type %s@." id |
|
235 |
| Already_bound id -> |
|
236 |
fprintf fmt "%s is already declared@." id |
|
237 |
| Already_defined id -> |
|
238 |
fprintf fmt "Multiple definitions of variable %s@." id |
|
239 |
| Not_a_constant -> |
|
240 |
fprintf fmt "This expression is not a constant@." |
|
241 |
| Assigned_constant id -> |
|
242 |
fprintf fmt "The constant %s cannot be assigned@." id |
|
243 |
| Not_a_dimension -> |
|
244 |
fprintf fmt "This expression is not a valid dimension@." |
|
245 |
| WrongArity (ar1, ar2) -> |
|
246 |
fprintf fmt "Expecting %d argument(s), found %d@." ar1 ar2 |
|
247 |
| WrongMorphism (ar1, ar2) -> |
|
248 |
fprintf fmt "Expecting %d argument(s) for homomorphic extension, found %d@." ar1 ar2 |
|
249 |
| Type_mismatch id -> |
|
250 |
fprintf fmt "Definition and declaration of type %s don't agree@." id |
|
251 |
| Undefined_var vset -> |
|
252 |
fprintf fmt "No definition provided for variable(s): %a@." |
|
253 |
(Utils.fprintf_list ~sep:"," pp_print_string) |
|
254 |
(ISet.elements vset) |
|
255 |
| Declared_but_undefined id -> |
|
256 |
fprintf fmt "%s is declared but not defined@." id |
|
257 |
| Type_clash (ty1,ty2) -> |
|
243 |
| Tunivar -> |
|
244 |
fprintf fmt "'%s" (name_of_type ty.tid) |
|
245 |
|
|
246 |
let pp_error fmt = function |
|
247 |
| Unbound_value id -> |
|
248 |
fprintf fmt "Unknown value %s@." id |
|
249 |
| Unbound_type id -> |
|
250 |
fprintf fmt "Unknown type %s@." id |
|
251 |
| Already_bound id -> |
|
252 |
fprintf fmt "%s is already declared@." id |
|
253 |
| Already_defined id -> |
|
254 |
fprintf fmt "Multiple definitions of variable %s@." id |
|
255 |
| Not_a_constant -> |
|
256 |
fprintf fmt "This expression is not a constant@." |
|
257 |
| Assigned_constant id -> |
|
258 |
fprintf fmt "The constant %s cannot be assigned@." id |
|
259 |
| Not_a_dimension -> |
|
260 |
fprintf fmt "This expression is not a valid dimension@." |
|
261 |
| WrongArity (ar1, ar2) -> |
|
262 |
fprintf fmt "Expecting %d argument(s), found %d@." ar1 ar2 |
|
263 |
| WrongMorphism (ar1, ar2) -> |
|
264 |
fprintf fmt |
|
265 |
"Expecting %d argument(s) for homomorphic extension, found %d@." ar1 ar2 |
|
266 |
| Type_mismatch id -> |
|
267 |
fprintf fmt "Definition and declaration of type %s don't agree@." id |
|
268 |
| Undefined_var vset -> |
|
269 |
fprintf fmt "No definition provided for variable(s): %a@." |
|
270 |
(Utils.fprintf_list ~sep:"," pp_print_string) |
|
271 |
(ISet.elements vset) |
|
272 |
| Declared_but_undefined id -> |
|
273 |
fprintf fmt "%s is declared but not defined@." id |
|
274 |
| Type_clash (ty1, ty2) -> |
|
258 | 275 |
Utils.reset_names (); |
259 |
fprintf fmt "Expected type %a, got type %a@." print_ty ty1 print_ty ty2 |
|
260 |
| Poly_imported_node _ -> |
|
261 |
fprintf fmt "Imported nodes cannot have a polymorphic type@." |
|
262 |
|
|
263 |
|
|
264 |
let new_id = ref (-1) |
|
265 |
|
|
266 |
let rec bottom = |
|
267 |
{ tdesc = Tlink bottom; tid = -666 } |
|
268 |
|
|
269 |
let new_ty desc = |
|
270 |
incr new_id; {tdesc = desc; tid = !new_id } |
|
271 |
|
|
272 |
let new_var () = |
|
273 |
new_ty Tvar |
|
274 |
|
|
275 |
let new_univar () = |
|
276 |
new_ty Tunivar |
|
277 |
|
|
278 |
let rec repr = |
|
279 |
function |
|
280 |
{tdesc = Tlink t'; _} -> |
|
281 |
repr t' |
|
282 |
| t -> t |
|
283 |
|
|
284 |
let get_static_value ty = |
|
285 |
match (repr ty).tdesc with |
|
286 |
| Tstatic (d, _) -> Some d |
|
287 |
| _ -> None |
|
288 |
|
|
289 |
let get_field_type ty label = |
|
290 |
match (repr ty).tdesc with |
|
291 |
| Tstruct fl -> (try Some (List.assoc label fl) with Not_found -> None) |
|
292 |
| _ -> None |
|
293 |
|
|
294 |
let is_static_type ty = |
|
295 |
match (repr ty).tdesc with |
|
296 |
| Tstatic _ -> true |
|
297 |
| _ -> false |
|
298 |
|
|
299 |
let rec is_scalar_type ty = |
|
300 |
match (repr ty).tdesc with |
|
301 |
| Tstatic (_, ty) -> is_scalar_type ty |
|
302 |
| Tbasic t -> BasicT.is_scalar_type t |
|
303 |
| _ -> false |
|
304 |
|
|
305 |
let rec is_numeric_type ty = |
|
306 |
match (repr ty).tdesc with |
|
307 |
| Tstatic (_, ty) -> is_numeric_type ty |
|
308 |
| Tbasic t -> BasicT.is_numeric_type t |
|
309 |
| _ -> false |
|
310 |
|
|
311 |
let rec is_real_type ty = |
|
312 |
match (repr ty).tdesc with |
|
313 |
| Tstatic (_, ty) -> is_real_type ty |
|
314 |
| Tbasic t -> BasicT.is_real_type t |
|
315 |
| _ -> false |
|
316 |
|
|
317 |
let rec is_int_type ty = |
|
318 |
match (repr ty).tdesc with |
|
319 |
| Tstatic (_, ty) -> is_int_type ty |
|
320 |
| Tbasic t -> BasicT.is_int_type t |
|
321 |
| _ -> false |
|
322 |
|
|
323 |
let rec is_bool_type ty = |
|
324 |
match (repr ty).tdesc with |
|
325 |
| Tstatic (_, ty) -> is_bool_type ty |
|
326 |
| Tbasic t -> BasicT.is_bool_type t |
|
327 |
| _ -> false |
|
328 |
|
|
329 |
let rec is_const_type ty c = |
|
330 |
match (repr ty).tdesc with |
|
331 |
| Tstatic (_, ty) -> is_const_type ty c |
|
332 |
| Tconst c' -> c = c' |
|
333 |
| _ -> false |
|
334 |
|
|
335 |
let get_clock_base_type ty = |
|
336 |
match (repr ty).tdesc with |
|
337 |
| Tclock ty -> Some ty |
|
338 |
| _ -> None |
|
339 |
|
|
340 |
let unclock_type ty = |
|
341 |
let ty = repr ty in |
|
342 |
match ty.tdesc with |
|
343 |
| Tclock ty' -> ty' |
|
344 |
| _ -> ty |
|
345 |
|
|
346 |
let rec is_dimension_type ty = |
|
347 |
match (repr ty).tdesc with |
|
348 |
| Tbasic t -> BasicT.is_dimension_type t |
|
349 |
| Tclock ty' |
|
350 |
| Tstatic (_, ty') -> is_dimension_type ty' |
|
351 |
| _ -> false |
|
352 |
|
|
353 |
let dynamic_type ty = |
|
354 |
let ty = repr ty in |
|
355 |
match ty.tdesc with |
|
356 |
| Tstatic (_, ty') -> ty' |
|
357 |
| _ -> ty |
|
358 |
|
|
359 |
let is_tuple_type ty = |
|
360 |
match (repr ty).tdesc with |
|
361 |
| Ttuple _ -> true |
|
362 |
| _ -> false |
|
363 |
|
|
364 |
let map_tuple_type f ty = |
|
365 |
let ty = dynamic_type ty in |
|
366 |
match ty.tdesc with |
|
367 |
| (Ttuple ty_list) -> { ty with tdesc = Ttuple (List.map f ty_list) } |
|
368 |
| _ -> f ty |
|
369 |
|
|
370 |
let rec is_struct_type ty = |
|
371 |
match (repr ty).tdesc with |
|
372 |
| Tstruct _ -> true |
|
373 |
| Tstatic (_, ty') -> is_struct_type ty' |
|
374 |
| _ -> false |
|
375 |
|
|
376 |
let struct_field_type ty field = |
|
377 |
match (dynamic_type ty).tdesc with |
|
378 |
| Tstruct fields -> |
|
379 |
(try |
|
380 |
List.assoc field fields |
|
381 |
with Not_found -> assert false) |
|
382 |
| _ -> assert false |
|
383 |
|
|
384 |
let rec is_array_type ty = |
|
385 |
match (repr ty).tdesc with |
|
386 |
| Tarray _ -> true |
|
387 |
| Tstatic (_, ty') -> is_array_type ty' (* looks strange !? *) |
|
388 |
| _ -> false |
|
389 |
|
|
390 |
let array_type_dimension ty = |
|
391 |
match (dynamic_type ty).tdesc with |
|
392 |
| Tarray (d, _) -> d |
|
393 |
| _ -> (Format.eprintf "internal error: Types.array_type_dimension %a@." print_ty ty; assert false) |
|
394 |
|
|
395 |
let rec array_type_multi_dimension ty = |
|
396 |
match (dynamic_type ty).tdesc with |
|
397 |
| Tarray (d, ty') -> d :: array_type_multi_dimension ty' |
|
398 |
| _ -> [] |
|
399 |
|
|
400 |
let array_element_type ty = |
|
401 |
match (dynamic_type ty).tdesc with |
|
402 |
| Tarray (_, ty') -> ty' |
|
403 |
| _ -> (Format.eprintf "internal error: Types.array_element_type %a@." print_ty ty; assert false) |
|
404 |
|
|
405 |
let rec array_base_type ty = |
|
406 |
let ty = repr ty in |
|
407 |
match ty.tdesc with |
|
408 |
| Tarray (_, ty') |
|
409 |
| Tstatic (_, ty') -> array_base_type ty' |
|
410 |
| _ -> ty |
|
411 |
|
|
412 |
let is_address_type ty = |
|
413 |
is_array_type ty || is_struct_type ty || (is_real_type ty && !Options.mpfr) |
|
414 |
|
|
415 |
let rec is_generic_type ty = |
|
416 |
match (dynamic_type ty).tdesc with |
|
417 |
| Tarray (d, ty') -> |
|
418 |
(not (Dimension.is_dimension_const d)) || (is_generic_type ty') |
|
419 |
| _ -> false |
|
420 |
|
|
421 |
(** Splits [ty] into the [lhs,rhs] of an arrow type. Expects an arrow type |
|
422 |
(ensured by language syntax) *) |
|
423 |
let rec split_arrow ty = |
|
424 |
match (repr ty).tdesc with |
|
425 |
| Tarrow (tin,tout) -> tin,tout |
|
426 |
| Tstatic (_, ty') -> split_arrow ty' |
|
427 |
(* Functions are not first order, I don't think the var case |
|
428 |
needs to be considered here *) |
|
429 |
| _ -> Format.eprintf "type %a is not a map@.Unable to split@.@?" print_ty ty; assert false |
|
430 |
|
|
431 |
(** Returns the type corresponding to a type list. *) |
|
432 |
let type_of_type_list tyl = |
|
433 |
if (List.length tyl) > 1 then |
|
434 |
new_ty (Ttuple tyl) |
|
435 |
else |
|
436 |
List.hd tyl |
|
437 |
|
|
438 |
let rec type_list_of_type ty = |
|
439 |
match (repr ty).tdesc with |
|
440 |
| Tstatic (_, ty) -> type_list_of_type ty |
|
441 |
| Ttuple tl -> tl |
|
442 |
| _ -> [ty] |
|
443 |
|
|
444 |
(** [is_polymorphic ty] returns true if [ty] is polymorphic. *) |
|
445 |
let rec is_polymorphic ty = |
|
446 |
match ty.tdesc with |
|
447 |
| Tenum _ | Tvar | Tbasic _ | Tconst _ -> false |
|
448 |
| Tclock ty -> is_polymorphic ty |
|
449 |
| Tarrow (ty1,ty2) -> (is_polymorphic ty1) || (is_polymorphic ty2) |
|
450 |
| Ttuple tl -> List.exists (fun t -> is_polymorphic t) tl |
|
451 |
| Tstruct fl -> List.exists (fun (_, t) -> is_polymorphic t) fl |
|
452 |
| Tlink t' -> is_polymorphic t' |
|
453 |
| Tarray (d, ty) |
|
454 |
| Tstatic (d, ty) -> Dimension.is_polymorphic d || is_polymorphic ty |
|
455 |
| Tunivar -> true |
|
456 |
|
|
457 |
|
|
458 |
let mktyptuple nb typ = |
|
459 |
let array = Array.make nb typ in |
|
460 |
Ttuple (Array.to_list array) |
|
461 |
|
|
462 |
let type_desc t = t.tdesc |
|
463 |
|
|
464 |
|
|
465 |
|
|
466 |
let type_int = mk_basic BasicT.type_int_builder |
|
467 |
let type_real = mk_basic BasicT.type_real_builder |
|
468 |
let type_bool = mk_basic BasicT.type_bool_builder |
|
469 |
let type_string = mk_basic BasicT.type_string_builder |
|
470 |
|
|
276 |
fprintf fmt "Expected type %a, got type %a@." print_ty ty1 print_ty ty2 |
|
277 |
| Poly_imported_node _ -> |
|
278 |
fprintf fmt "Imported nodes cannot have a polymorphic type@." |
|
279 |
|
|
280 |
let new_id = ref (-1) |
|
281 |
|
|
282 |
let rec bottom = { tdesc = Tlink bottom; tid = -666 } |
|
283 |
|
|
284 |
let new_ty desc = |
|
285 |
incr new_id; |
|
286 |
{ tdesc = desc; tid = !new_id } |
|
287 |
|
|
288 |
let new_var () = new_ty Tvar |
|
289 |
|
|
290 |
let new_univar () = new_ty Tunivar |
|
291 |
|
|
292 |
let rec repr = function { tdesc = Tlink t'; _ } -> repr t' | t -> t |
|
293 |
|
|
294 |
let get_static_value ty = |
|
295 |
match (repr ty).tdesc with Tstatic (d, _) -> Some d | _ -> None |
|
296 |
|
|
297 |
let get_field_type ty label = |
|
298 |
match (repr ty).tdesc with |
|
299 |
| Tstruct fl -> ( |
|
300 |
try Some (List.assoc label fl) with Not_found -> None) |
|
301 |
| _ -> |
|
302 |
None |
|
303 |
|
|
304 |
let is_static_type ty = |
|
305 |
match (repr ty).tdesc with Tstatic _ -> true | _ -> false |
|
306 |
|
|
307 |
let rec is_scalar_type ty = |
|
308 |
match (repr ty).tdesc with |
|
309 |
| Tstatic (_, ty) -> |
|
310 |
is_scalar_type ty |
|
311 |
| Tbasic t -> |
|
312 |
BasicT.is_scalar_type t |
|
313 |
| _ -> |
|
314 |
false |
|
315 |
|
|
316 |
let rec is_numeric_type ty = |
|
317 |
match (repr ty).tdesc with |
|
318 |
| Tstatic (_, ty) -> |
|
319 |
is_numeric_type ty |
|
320 |
| Tbasic t -> |
|
321 |
BasicT.is_numeric_type t |
|
322 |
| _ -> |
|
323 |
false |
|
324 |
|
|
325 |
let rec is_real_type ty = |
|
326 |
match (repr ty).tdesc with |
|
327 |
| Tstatic (_, ty) -> |
|
328 |
is_real_type ty |
|
329 |
| Tbasic t -> |
|
330 |
BasicT.is_real_type t |
|
331 |
| _ -> |
|
332 |
false |
|
333 |
|
|
334 |
let rec is_int_type ty = |
|
335 |
match (repr ty).tdesc with |
|
336 |
| Tstatic (_, ty) -> |
|
337 |
is_int_type ty |
|
338 |
| Tbasic t -> |
|
339 |
BasicT.is_int_type t |
|
340 |
| _ -> |
|
341 |
false |
|
342 |
|
|
343 |
let rec is_bool_type ty = |
|
344 |
match (repr ty).tdesc with |
|
345 |
| Tstatic (_, ty) -> |
|
346 |
is_bool_type ty |
|
347 |
| Tbasic t -> |
|
348 |
BasicT.is_bool_type t |
|
349 |
| _ -> |
|
350 |
false |
|
351 |
|
|
352 |
let rec is_const_type ty c = |
|
353 |
match (repr ty).tdesc with |
|
354 |
| Tstatic (_, ty) -> |
|
355 |
is_const_type ty c |
|
356 |
| Tconst c' -> |
|
357 |
c = c' |
|
358 |
| _ -> |
|
359 |
false |
|
360 |
|
|
361 |
let get_clock_base_type ty = |
|
362 |
match (repr ty).tdesc with Tclock ty -> Some ty | _ -> None |
|
363 |
|
|
364 |
let unclock_type ty = |
|
365 |
let ty = repr ty in |
|
366 |
match ty.tdesc with Tclock ty' -> ty' | _ -> ty |
|
367 |
|
|
368 |
let rec is_dimension_type ty = |
|
369 |
match (repr ty).tdesc with |
|
370 |
| Tbasic t -> |
|
371 |
BasicT.is_dimension_type t |
|
372 |
| Tclock ty' | Tstatic (_, ty') -> |
|
373 |
is_dimension_type ty' |
|
374 |
| _ -> |
|
375 |
false |
|
376 |
|
|
377 |
let dynamic_type ty = |
|
378 |
let ty = repr ty in |
|
379 |
match ty.tdesc with Tstatic (_, ty') -> ty' | _ -> ty |
|
380 |
|
|
381 |
let is_tuple_type ty = |
|
382 |
match (repr ty).tdesc with Ttuple _ -> true | _ -> false |
|
383 |
|
|
384 |
let map_tuple_type f ty = |
|
385 |
let ty = dynamic_type ty in |
|
386 |
match ty.tdesc with |
|
387 |
| Ttuple ty_list -> |
|
388 |
{ ty with tdesc = Ttuple (List.map f ty_list) } |
|
389 |
| _ -> |
|
390 |
f ty |
|
391 |
|
|
392 |
let rec is_struct_type ty = |
|
393 |
match (repr ty).tdesc with |
|
394 |
| Tstruct _ -> |
|
395 |
true |
|
396 |
| Tstatic (_, ty') -> |
|
397 |
is_struct_type ty' |
|
398 |
| _ -> |
|
399 |
false |
|
400 |
|
|
401 |
let struct_field_type ty field = |
|
402 |
match (dynamic_type ty).tdesc with |
|
403 |
| Tstruct fields -> ( |
|
404 |
try List.assoc field fields with Not_found -> assert false) |
|
405 |
| _ -> |
|
406 |
assert false |
|
407 |
|
|
408 |
let rec is_array_type ty = |
|
409 |
match (repr ty).tdesc with |
|
410 |
| Tarray _ -> |
|
411 |
true |
|
412 |
| Tstatic (_, ty') -> |
|
413 |
is_array_type ty' (* looks strange !? *) |
|
414 |
| _ -> |
|
415 |
false |
|
416 |
|
|
417 |
let array_type_dimension ty = |
|
418 |
match (dynamic_type ty).tdesc with |
|
419 |
| Tarray (d, _) -> |
|
420 |
d |
|
421 |
| _ -> |
|
422 |
Format.eprintf "internal error: Types.array_type_dimension %a@." print_ty |
|
423 |
ty; |
|
424 |
assert false |
|
425 |
|
|
426 |
let rec array_type_multi_dimension ty = |
|
427 |
match (dynamic_type ty).tdesc with |
|
428 |
| Tarray (d, ty') -> |
|
429 |
d :: array_type_multi_dimension ty' |
|
430 |
| _ -> |
|
431 |
[] |
|
432 |
|
|
433 |
let array_element_type ty = |
|
434 |
match (dynamic_type ty).tdesc with |
|
435 |
| Tarray (_, ty') -> |
|
436 |
ty' |
|
437 |
| _ -> |
|
438 |
Format.eprintf "internal error: Types.array_element_type %a@." print_ty ty; |
|
439 |
assert false |
|
440 |
|
|
441 |
let rec array_base_type ty = |
|
442 |
let ty = repr ty in |
|
443 |
match ty.tdesc with |
|
444 |
| Tarray (_, ty') | Tstatic (_, ty') -> |
|
445 |
array_base_type ty' |
|
446 |
| _ -> |
|
447 |
ty |
|
448 |
|
|
449 |
let is_address_type ty = |
|
450 |
is_array_type ty || is_struct_type ty || (is_real_type ty && !Options.mpfr) |
|
451 |
|
|
452 |
let rec is_generic_type ty = |
|
453 |
match (dynamic_type ty).tdesc with |
|
454 |
| Tarray (d, ty') -> |
|
455 |
(not (Dimension.is_dimension_const d)) || is_generic_type ty' |
|
456 |
| _ -> |
|
457 |
false |
|
458 |
|
|
459 |
(** Splits [ty] into the [lhs,rhs] of an arrow type. Expects an arrow type |
|
460 |
(ensured by language syntax) *) |
|
461 |
let rec split_arrow ty = |
|
462 |
match (repr ty).tdesc with |
|
463 |
| Tarrow (tin, tout) -> |
|
464 |
tin, tout |
|
465 |
| Tstatic (_, ty') -> |
|
466 |
split_arrow ty' |
|
467 |
(* Functions are not first order, I don't think the var case needs to be |
|
468 |
considered here *) |
|
469 |
| _ -> |
|
470 |
Format.eprintf "type %a is not a map@.Unable to split@.@?" print_ty ty; |
|
471 |
assert false |
|
472 |
|
|
473 |
(** Returns the type corresponding to a type list. *) |
|
474 |
let type_of_type_list tyl = |
|
475 |
if List.length tyl > 1 then new_ty (Ttuple tyl) else List.hd tyl |
|
476 |
|
|
477 |
let rec type_list_of_type ty = |
|
478 |
match (repr ty).tdesc with |
|
479 |
| Tstatic (_, ty) -> |
|
480 |
type_list_of_type ty |
|
481 |
| Ttuple tl -> |
|
482 |
tl |
|
483 |
| _ -> |
|
484 |
[ ty ] |
|
485 |
|
|
486 |
(** [is_polymorphic ty] returns true if [ty] is polymorphic. *) |
|
487 |
let rec is_polymorphic ty = |
|
488 |
match ty.tdesc with |
|
489 |
| Tenum _ | Tvar | Tbasic _ | Tconst _ -> |
|
490 |
false |
|
491 |
| Tclock ty -> |
|
492 |
is_polymorphic ty |
|
493 |
| Tarrow (ty1, ty2) -> |
|
494 |
is_polymorphic ty1 || is_polymorphic ty2 |
|
495 |
| Ttuple tl -> |
|
496 |
List.exists (fun t -> is_polymorphic t) tl |
|
497 |
| Tstruct fl -> |
|
498 |
List.exists (fun (_, t) -> is_polymorphic t) fl |
|
499 |
| Tlink t' -> |
|
500 |
is_polymorphic t' |
|
501 |
| Tarray (d, ty) | Tstatic (d, ty) -> |
|
502 |
Dimension.is_polymorphic d || is_polymorphic ty |
|
503 |
| Tunivar -> |
|
504 |
true |
|
505 |
|
|
506 |
let mktyptuple nb typ = |
|
507 |
let array = Array.make nb typ in |
|
508 |
Ttuple (Array.to_list array) |
|
509 |
|
|
510 |
let type_desc t = t.tdesc |
|
511 |
|
|
512 |
let type_int = mk_basic BasicT.type_int_builder |
|
513 |
|
|
514 |
let type_real = mk_basic BasicT.type_real_builder |
|
515 |
|
|
516 |
let type_bool = mk_basic BasicT.type_bool_builder |
|
517 |
|
|
518 |
let type_string = mk_basic BasicT.type_string_builder |
|
471 | 519 |
end |
472 | 520 |
|
521 |
module type S = sig |
|
522 |
module BasicT : BASIC_TYPES |
|
473 | 523 |
|
474 |
module type S = |
|
475 |
sig |
|
476 |
module BasicT: BASIC_TYPES |
|
477 | 524 |
type basic_type = BasicT.t |
478 |
type type_expr = |
|
479 |
{mutable tdesc: type_desc;
|
|
480 |
tid: int} |
|
525 |
|
|
526 |
type type_expr = { mutable tdesc : type_desc; tid : int }
|
|
527 |
|
|
481 | 528 |
and type_desc = |
482 |
| Tconst of ident (* type constant *) |
|
529 |
| Tconst of ident |
|
530 |
(* type constant *) |
|
483 | 531 |
| Tbasic of basic_type |
484 |
| Tclock of type_expr (* A type expression explicitely tagged as carrying a clock *) |
|
532 |
| Tclock of type_expr |
|
533 |
(* A type expression explicitely tagged as carrying a clock *) |
|
485 | 534 |
| Tarrow of type_expr * type_expr |
486 | 535 |
| Ttuple of type_expr list |
487 | 536 |
| Tenum of ident list |
488 | 537 |
| Tstruct of (ident * type_expr) list |
489 | 538 |
| Tarray of dim_expr * type_expr |
490 |
| Tstatic of dim_expr * type_expr (* a type carried by a dimension expression *) |
|
491 |
| Tlink of type_expr (* During unification, make links instead of substitutions *) |
|
492 |
| Tvar (* Monomorphic type variable *) |
|
493 |
| Tunivar (* Polymorphic type variable *) |
|
539 |
| Tstatic of dim_expr * type_expr |
|
540 |
(* a type carried by a dimension expression *) |
|
541 |
| Tlink of type_expr |
|
542 |
(* During unification, make links instead of substitutions *) |
|
543 |
| Tvar |
|
544 |
(* Monomorphic type variable *) |
|
545 |
| Tunivar |
|
546 |
(* Polymorphic type variable *) |
|
494 | 547 |
|
495 | 548 |
type error = |
496 |
Unbound_value of ident
|
|
549 |
| Unbound_value of ident
|
|
497 | 550 |
| Already_bound of ident |
498 | 551 |
| Already_defined of ident |
499 | 552 |
| Undefined_var of ISet.t |
... | ... | |
508 | 561 |
| Type_clash of type_expr * type_expr |
509 | 562 |
| Poly_imported_node of ident |
510 | 563 |
|
511 |
exception Unify of type_expr * type_expr |
|
512 |
exception Error of Location.t * error |
|
513 |
|
|
514 |
val is_real_type: type_expr -> bool |
|
515 |
val is_int_type: type_expr -> bool |
|
516 |
val is_bool_type: type_expr -> bool |
|
517 |
val is_const_type: type_expr -> ident -> bool |
|
518 |
val is_static_type: type_expr -> bool |
|
519 |
val is_array_type: type_expr -> bool |
|
520 |
val is_dimension_type: type_expr -> bool |
|
521 |
val is_address_type: type_expr -> bool |
|
522 |
val is_generic_type: type_expr -> bool |
|
523 |
val print_ty: Format.formatter -> type_expr -> unit |
|
524 |
val repr: type_expr -> type_expr |
|
525 |
val dynamic_type: type_expr -> type_expr |
|
526 |
val type_desc: type_expr -> type_desc |
|
527 |
val new_var: unit -> type_expr |
|
528 |
val new_univar: unit -> type_expr |
|
529 |
val new_ty: type_desc -> type_expr |
|
530 |
val type_int: type_desc |
|
531 |
val type_real: type_desc |
|
532 |
val type_bool: type_desc |
|
533 |
val type_string: type_desc |
|
534 |
val array_element_type: type_expr -> type_expr |
|
535 |
val type_list_of_type: type_expr -> type_expr list |
|
536 |
val print_node_ty: Format.formatter -> type_expr -> unit |
|
537 |
val get_clock_base_type: type_expr -> type_expr option |
|
538 |
val get_static_value: type_expr -> Dimension.dim_expr option |
|
539 |
val is_tuple_type: type_expr -> bool |
|
540 |
val type_of_type_list: type_expr list -> type_expr |
|
541 |
val split_arrow: type_expr -> type_expr * type_expr |
|
542 |
val unclock_type: type_expr -> type_expr |
|
543 |
val bottom: type_expr |
|
544 |
val map_tuple_type: (type_expr -> type_expr) -> type_expr -> type_expr |
|
545 |
val array_base_type: type_expr -> type_expr |
|
546 |
val array_type_dimension: type_expr -> Dimension.dim_expr |
|
547 |
val pp_error: Format.formatter -> error -> unit |
|
548 |
val struct_field_type: type_expr -> ident -> type_expr |
|
549 |
val array_type_multi_dimension: type_expr -> Dimension.dim_expr list |
|
550 |
end (* with type type_expr = BasicT.t type_expr_gen *) |
|
551 |
|
|
552 |
module type Sbasic = S with type BasicT.t = Basic.t |
|
553 |
|
|
564 |
exception Unify of type_expr * type_expr |
|
565 |
|
|
566 |
exception Error of Location.t * error |
|
567 |
|
|
568 |
val is_real_type : type_expr -> bool |
|
569 |
|
|
570 |
val is_int_type : type_expr -> bool |
|
571 |
|
|
572 |
val is_bool_type : type_expr -> bool |
|
573 |
|
|
574 |
val is_const_type : type_expr -> ident -> bool |
|
575 |
|
|
576 |
val is_static_type : type_expr -> bool |
|
577 |
|
|
578 |
val is_array_type : type_expr -> bool |
|
579 |
|
|
580 |
val is_dimension_type : type_expr -> bool |
|
581 |
|
|
582 |
val is_address_type : type_expr -> bool |
|
583 |
|
|
584 |
val is_generic_type : type_expr -> bool |
|
585 |
|
|
586 |
val print_ty : Format.formatter -> type_expr -> unit |
|
587 |
|
|
588 |
val repr : type_expr -> type_expr |
|
589 |
|
|
590 |
val dynamic_type : type_expr -> type_expr |
|
591 |
|
|
592 |
val type_desc : type_expr -> type_desc |
|
593 |
|
|
594 |
val new_var : unit -> type_expr |
|
595 |
|
|
596 |
val new_univar : unit -> type_expr |
|
597 |
|
|
598 |
val new_ty : type_desc -> type_expr |
|
599 |
|
|
600 |
val type_int : type_desc |
|
601 |
|
|
602 |
val type_real : type_desc |
|
603 |
|
|
604 |
val type_bool : type_desc |
|
605 |
|
|
606 |
val type_string : type_desc |
|
607 |
|
|
608 |
val array_element_type : type_expr -> type_expr |
|
609 |
|
|
610 |
val type_list_of_type : type_expr -> type_expr list |
|
611 |
|
|
612 |
val print_node_ty : Format.formatter -> type_expr -> unit |
|
613 |
|
|
614 |
val get_clock_base_type : type_expr -> type_expr option |
|
615 |
|
|
616 |
val get_static_value : type_expr -> Dimension.dim_expr option |
|
617 |
|
|
618 |
val is_tuple_type : type_expr -> bool |
|
619 |
|
|
620 |
val type_of_type_list : type_expr list -> type_expr |
|
621 |
|
|
622 |
val split_arrow : type_expr -> type_expr * type_expr |
|
623 |
|
|
624 |
val unclock_type : type_expr -> type_expr |
|
625 |
|
|
626 |
val bottom : type_expr |
|
627 |
|
|
628 |
val map_tuple_type : (type_expr -> type_expr) -> type_expr -> type_expr |
|
629 |
|
|
630 |
val array_base_type : type_expr -> type_expr |
|
631 |
|
|
632 |
val array_type_dimension : type_expr -> Dimension.dim_expr |
|
633 |
|
|
634 |
val pp_error : Format.formatter -> error -> unit |
|
635 |
|
|
636 |
val struct_field_type : type_expr -> ident -> type_expr |
|
637 |
|
|
638 |
val array_type_multi_dimension : type_expr -> Dimension.dim_expr list |
|
639 |
end |
|
640 |
(* with type type_expr = BasicT.t type_expr_gen *) |
|
641 |
|
|
642 |
module type Sbasic = S with type BasicT.t = Basic.t |
|
643 |
|
|
554 | 644 |
module Main : Sbasic = Make (Basic) |
555 |
include Main |
|
556 | 645 |
|
646 |
include Main |
|
557 | 647 |
|
558 | 648 |
(* Local Variables: *) |
559 | 649 |
(* compile-command:"make -C .." *) |
Also available in: Unified diff
reformatting