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