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