Revision c518d082
Added by Xavier Thirioux almost 9 years ago
| src/clocks.ml | ||
|---|---|---|
| 121 | 121 |
needs to be considered here *) |
| 122 | 122 |
| _ -> failwith "Internal error: not an arrow clock" |
| 123 | 123 |
|
| 124 |
let get_carrier_name ck = |
|
| 125 |
match (repr ck).cdesc with |
|
| 126 |
| Ccarrying (cr, _) -> Some cr |
|
| 127 |
| _ -> None |
|
| 128 |
|
|
| 124 | 129 |
let uncarrier ck = |
| 125 | 130 |
match ck.cdesc with |
| 126 |
| Ccarrying (cr, ck') -> ck'
|
|
| 127 |
| _ -> ck
|
|
| 131 |
| Ccarrying (_, ck') -> ck'
|
|
| 132 |
| _ -> ck |
|
| 128 | 133 |
|
| 129 | 134 |
(* Removes all links in a clock. Only used for clocks |
| 130 | 135 |
simplification though. *) |
| ... | ... | |
| 268 | 273 |
let rec print_carrier fmt cr = |
| 269 | 274 |
(* (if cr.carrier_scoped then fprintf fmt "[%t]" else fprintf fmt "%t") (fun fmt -> *) |
| 270 | 275 |
match cr.carrier_desc with |
| 271 |
| Carry_const id -> fprintf fmt "'%s'" id
|
|
| 276 |
| Carry_const id -> fprintf fmt "%s" id
|
|
| 272 | 277 |
| Carry_name -> |
| 273 |
fprintf fmt "?%s" (name_of_carrier cr.carrier_id)
|
|
| 278 |
fprintf fmt "_%s" (name_of_carrier cr.carrier_id)
|
|
| 274 | 279 |
| Carry_var -> |
| 275 |
fprintf fmt "_%s" (name_of_carrier cr.carrier_id)
|
|
| 280 |
fprintf fmt "'%s" (name_of_carrier cr.carrier_id)
|
|
| 276 | 281 |
| Carry_link cr' -> |
| 277 | 282 |
print_carrier fmt cr' |
| 278 | 283 |
|
| ... | ... | |
| 512 | 517 |
fprintf fmt " (where %a)" |
| 513 | 518 |
(fprintf_list ~sep:", " print_cvar) cvars |
| 514 | 519 |
|
| 520 |
(* prints only the Con components of a clock, useful for printing nodes *) |
|
| 521 |
let rec print_ck_suffix fmt ck = |
|
| 522 |
let ck = simplify ck in |
|
| 523 |
match ck.cdesc with |
|
| 524 |
| Carrow _ |
|
| 525 |
| Ctuple _ |
|
| 526 |
| Cvar _ |
|
| 527 |
| Cunivar _ -> () |
|
| 528 |
| Con (ck,c,l) -> |
|
| 529 |
fprintf fmt "%a when %s(%a)" print_ck_suffix ck l print_carrier c |
|
| 530 |
| Clink ck' -> |
|
| 531 |
print_ck_suffix fmt ck' |
|
| 532 |
| Ccarrying (cr,ck') -> |
|
| 533 |
fprintf fmt "%a" print_ck_suffix ck' |
|
| 534 |
| _ -> assert false |
|
| 535 |
|
|
| 515 | 536 |
let pp_error fmt = function |
| 516 | 537 |
| Clock_clash (ck1,ck2) -> |
| 517 | 538 |
reset_names (); |
| ... | ... | |
| 552 | 573 |
print_ck ck_node |
| 553 | 574 |
print_ck ck |
| 554 | 575 |
|
| 576 |
let uneval const cr = |
|
| 577 |
(*Format.printf "uneval %s %a@." const print_carrier cr;*) |
|
| 578 |
let cr = carrier_repr cr in |
|
| 579 |
match cr.carrier_desc with |
|
| 580 |
| Carry_var -> cr.carrier_desc <- Carry_const const |
|
| 581 |
| _ -> assert false |
|
| 555 | 582 |
|
| 556 | 583 |
(* Local Variables: *) |
| 557 | 584 |
(* compile-command:"make -C .." *) |
Also available in: Unified diff
- added generation of clock information in interface (.lusi) files
- added clock checking between interface and implementation files