Project

General

Profile

Revision 8f1c7e91 src/clocks.ml

View differences:

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