Revision 21485807
Added by Xavier Thirioux almost 11 years ago
src/typing.ml | ||
---|---|---|
124 | 124 |
Type_predef.type_array d (type_coretype type_dim ty) |
125 | 125 |
end |
126 | 126 |
|
127 |
(* [coretype_type is the reciprocal of [type_typecore] *) |
|
127 |
(* [coretype_type] is the reciprocal of [type_typecore] *)
|
|
128 | 128 |
let rec coretype_type ty = |
129 | 129 |
match (repr ty).tdesc with |
130 | 130 |
| Tvar -> Tydec_any |
... | ... | |
303 | 303 |
| Dimension.Unify _ -> |
304 | 304 |
raise (Error (loc, Type_clash (ty1,ty2))) |
305 | 305 |
|
306 |
let type_struct_field loc ftyp (label, f) =
|
|
306 |
let rec type_struct_const_field loc (label, c) =
|
|
307 | 307 |
if Hashtbl.mem field_table label |
308 | 308 |
then let tydec = Hashtbl.find field_table label in |
309 | 309 |
let tydec_struct = get_struct_type_fields tydec in |
310 | 310 |
let ty_label = type_coretype (fun d -> ()) (List.assoc label tydec_struct) in |
311 | 311 |
begin |
312 |
try_unify ty_label (ftyp loc f) loc;
|
|
312 |
try_unify ty_label (type_const loc c) loc;
|
|
313 | 313 |
type_coretype (fun d -> ()) tydec |
314 | 314 |
end |
315 | 315 |
else raise (Error (loc, Unbound_value ("struct field " ^ label))) |
316 | 316 |
|
317 |
let rec type_const loc c =
|
|
317 |
and type_const loc c =
|
|
318 | 318 |
match c with |
319 | 319 |
| Const_int _ -> Type_predef.type_int |
320 | 320 |
| Const_real _ -> Type_predef.type_real |
... | ... | |
330 | 330 |
| Const_struct fl -> |
331 | 331 |
let ty_struct = new_var () in |
332 | 332 |
begin |
333 |
List.iter (fun f -> try_unify ty_struct (type_struct_field loc type_const f) loc) fl; |
|
334 |
ty_struct |
|
333 |
let used = |
|
334 |
List.fold_left |
|
335 |
(fun acc (l, c) -> |
|
336 |
if List.mem l acc |
|
337 |
then raise (Error (loc, Already_bound ("struct field " ^ l))) |
|
338 |
else try_unify ty_struct (type_struct_const_field loc (l, c)) loc; l::acc) |
|
339 |
[] fl in |
|
340 |
try |
|
341 |
let total = List.map fst (get_struct_type_fields (coretype_type ty_struct)) in |
|
342 |
(* List.iter (fun l -> Format.eprintf "total: %s@." l) total; |
|
343 |
List.iter (fun l -> Format.eprintf "used: %s@." l) used; *) |
|
344 |
let undef = List.find (fun l -> not (List.mem l used)) total |
|
345 |
in raise (Error (loc, Unbound_value ("struct field " ^ undef))) |
|
346 |
with Not_found -> |
|
347 |
ty_struct |
|
335 | 348 |
end |
336 | 349 |
|
337 | 350 |
(* The following typing functions take as parameter an environment [env] |
Also available in: Unified diff
- added struct types declaration
- added constant definition with a struct type
- added checking for multiple definitions of nodes (behavior was buggy)
- better and more uniform error messages
for undefined/already defined symbols
git-svn-id: https://cavale.enseeiht.fr/svn/lustrec/lustre_compiler/trunk@186 041b043f-8d7c-46b2-b46e-ef0dd855326e