Revision 6aeb3388 src/corelang.ml
src/corelang.ml | ||
---|---|---|
193 | 193 |
let typ_def = Hashtbl.find type_table typ in |
194 | 194 |
if is_user_type typ_def then typ else typ_def |
195 | 195 |
|
196 |
let rec coretype_equal ty1 ty2 = |
|
197 |
let res = |
|
198 |
match ty1, ty2 with |
|
199 |
| Tydec_any , _ |
|
200 |
| _ , Tydec_any -> assert false |
|
201 |
| Tydec_const _ , Tydec_const _ -> get_repr_type ty1 = get_repr_type ty2 |
|
202 |
| Tydec_const _ , _ -> let ty1' = Hashtbl.find type_table ty1 |
|
203 |
in (not (is_user_type ty1')) && coretype_equal ty1' ty2 |
|
204 |
| _ , Tydec_const _ -> coretype_equal ty2 ty1 |
|
205 |
| Tydec_int , Tydec_int |
|
206 |
| Tydec_real , Tydec_real |
|
207 |
| Tydec_float , Tydec_float |
|
208 |
| Tydec_bool , Tydec_bool -> true |
|
209 |
| Tydec_clock ty1 , Tydec_clock ty2 -> coretype_equal ty1 ty2 |
|
210 |
| Tydec_enum tl1 , Tydec_enum tl2 -> List.sort compare tl1 = List.sort compare tl2 |
|
211 |
| Tydec_struct fl1, Tydec_struct fl2 -> |
|
212 |
List.length fl1 = List.length fl2 |
|
213 |
&& List.for_all2 (fun (f1, t1) (f2, t2) -> f1 = f2 && coretype_equal t1 t2) |
|
214 |
(List.sort (fun (f1,_) (f2,_) -> compare f1 f2) fl1) |
|
215 |
(List.sort (fun (f1,_) (f2,_) -> compare f1 f2) fl2) |
|
216 |
| _ -> false |
|
217 |
in ((*Format.eprint "coretype_equal %a %a = %B@." Printers.pp_var_type_dec_desc ty1 Printers.pp_var_type_dec_desc ty2 res;*) res) |
|
218 |
|
|
196 | 219 |
let tag_true = "true" |
197 | 220 |
let tag_false = "false" |
198 | 221 |
|
... | ... | |
380 | 403 |
fun nodes decl -> |
381 | 404 |
match decl.top_decl_desc with |
382 | 405 |
| Node nd -> nd::nodes |
383 |
| Consts _ | ImportedNode _ | Open _ -> nodes |
|
406 |
| Consts _ | ImportedNode _ | Open _ | Type _ -> nodes
|
|
384 | 407 |
) [] prog |
385 | 408 |
|
386 | 409 |
let get_consts prog = |
... | ... | |
388 | 411 |
fun consts decl -> |
389 | 412 |
match decl.top_decl_desc with |
390 | 413 |
| Consts clist -> clist@consts |
391 |
| Node _ | ImportedNode _ | Open _ -> consts |
|
414 |
| Node _ | ImportedNode _ | Open _ | Type _ -> consts
|
|
392 | 415 |
) [] prog |
393 | 416 |
|
394 |
|
|
417 |
let get_types prog = |
|
418 |
List.fold_left ( |
|
419 |
fun types decl -> |
|
420 |
match decl.top_decl_desc with |
|
421 |
| Type typ -> typ::types |
|
422 |
| Node _ | ImportedNode _ | Open _ | Consts _ -> types |
|
423 |
) [] prog |
|
395 | 424 |
|
396 | 425 |
(************************************************************************) |
397 | 426 |
(* Renaming *) |
... | ... | |
543 | 572 |
| Consts c -> |
544 | 573 |
{ top with top_decl_desc = Consts (List.map (rename_const f_const) c) } |
545 | 574 |
| ImportedNode _ |
546 |
| Open _ -> top) |
|
575 |
| Open _ |
|
576 |
| Type _ -> top) |
|
547 | 577 |
::accu |
548 | 578 |
) [] prog |
549 | 579 |
) |
... | ... | |
561 | 591 |
fprintf fmt "%s: " ind.nodei_id; |
562 | 592 |
Utils.reset_names (); |
563 | 593 |
fprintf fmt "%a@ " Types.print_ty ind.nodei_type |
564 |
| Consts _ | Open _ -> () |
|
594 |
| Consts _ | Open _ | Type _ -> ()
|
|
565 | 595 |
|
566 | 596 |
let pp_prog_type fmt tdecl_list = |
567 | 597 |
Utils.fprintf_list ~sep:"" pp_decl_type fmt tdecl_list |
... | ... | |
576 | 606 |
fprintf fmt "%s: " ind.nodei_id; |
577 | 607 |
Utils.reset_names (); |
578 | 608 |
fprintf fmt "%a@ " Clocks.print_ck ind.nodei_clock |
579 |
| Consts _ | Open _ -> () |
|
609 |
| Consts _ | Open _ | Type _ -> ()
|
|
580 | 610 |
|
581 | 611 |
let pp_prog_clock fmt prog = |
582 | 612 |
Utils.fprintf_list ~sep:"" pp_decl_clock fmt prog |
Also available in: Unified diff