Project

General

Profile

Revision b3f91fdb src/clocks.ml

View differences:

src/clocks.ml
72 72
exception Scope_clock of clock_expr
73 73
exception Error of Location.t * error
74 74

  
75
let print_ckset fmt s =
76
  match s with
77
  | CSet_all -> ()
78
  | CSet_pck (k,q) ->
79
      let (a,b) = simplify_rat q in
80
      if k = 1 && a = 0 then
81
        fprintf fmt "<:P"
82
      else
83
        fprintf fmt "<:P_(%i,%a)" k print_rat (a,b)
84

  
85
let rec print_carrier fmt cr =
86
 (* (if cr.carrier_scoped then fprintf fmt "[%t]" else fprintf fmt "%t") (fun fmt -> *)
87
  match cr.carrier_desc with
88
  | Carry_const id -> fprintf fmt "%s" id
89
  | Carry_name ->
90
      fprintf fmt "_%s" (name_of_carrier cr.carrier_id)
91
  | Carry_var ->
92
    fprintf fmt "'%s" (name_of_carrier cr.carrier_id)
93
  | Carry_link cr' ->
94
    print_carrier fmt cr'
95

  
96
(* Simple pretty-printing, performs no simplifications. Linear
97
   complexity. For debug mainly. *)
98
let rec print_ck_long fmt ck =
99
  match ck.cdesc with
100
  | Carrow (ck1,ck2) ->
101
      fprintf fmt "%a->%a" print_ck_long ck1 print_ck_long ck2
102
  | Ctuple cklist ->
103
    fprintf fmt "(%a)"
104
      (fprintf_list ~sep:" * " print_ck_long) cklist
105
  | Con (ck,c,l) ->
106
    fprintf fmt "%a on %s(%a)" print_ck_long ck l print_carrier c
107
  | Pck_up (ck,k) ->
108
    fprintf fmt "%a*^%i" print_ck_long ck k
109
  | Pck_down (ck,k) ->
110
    fprintf fmt "%a/^%i" print_ck_long ck k
111
  | Pck_phase (ck,q) ->
112
    fprintf fmt "%a~>%a" print_ck_long ck print_rat (simplify_rat q)
113
  | Pck_const (n,p) ->
114
    fprintf fmt "(%i,%a)" n print_rat (simplify_rat p)
115
  | Cvar cset ->
116
    fprintf fmt "'_%i%a" ck.cid print_ckset cset
117
  | Cunivar cset ->
118
    fprintf fmt "'%i%a" ck.cid print_ckset cset
119
  | Clink ck' ->
120
    fprintf fmt "link %a" print_ck_long ck'
121
  | Ccarrying (cr,ck') ->
122
    fprintf fmt "(%a:%a)" print_carrier cr print_ck_long ck'
123

  
75 124
let new_id = ref (-1)
76 125

  
77 126
let new_ck desc scoped =
......
117 166
 | Ccarrying (cr, _) -> Some cr
118 167
 | _                 -> None
119 168

  
169
let rename_carrier_static rename cr =
170
  match (carrier_repr cr).carrier_desc with
171
  | Carry_const id -> { cr with carrier_desc = Carry_const (rename id) }
172
  | _              -> (Format.eprintf "internal error: Clocks.rename_carrier_static %a@." print_carrier cr; assert false)
173

  
174
let rec rename_static rename ck =
175
 match (repr ck).cdesc with
176
 | Ccarrying (cr, ck') -> { ck with cdesc = Ccarrying (rename_carrier_static rename cr, rename_static rename ck') }
177
 | Con (ck', cr, l)    -> { ck with cdesc = Con (rename_static rename ck', rename_carrier_static rename cr, l) }
178
 | _                   -> ck
179

  
120 180
let uncarrier ck =
121 181
 match ck.cdesc with
122 182
 | Ccarrying (_, ck') -> ck'
......
257 317
  in
258 318
  aux [] ck
259 319

  
260
let print_ckset fmt s =
261
  match s with
262
  | CSet_all -> ()
263
  | CSet_pck (k,q) ->
264
      let (a,b) = simplify_rat q in
265
      if k = 1 && a = 0 then
266
        fprintf fmt "<:P"
267
      else
268
        fprintf fmt "<:P_(%i,%a)" k print_rat (a,b)
269

  
270
let rec print_carrier fmt cr =
271
 (* (if cr.carrier_scoped then fprintf fmt "[%t]" else fprintf fmt "%t") (fun fmt -> *)
272
  match cr.carrier_desc with
273
  | Carry_const id -> fprintf fmt "%s" id
274
  | Carry_name ->
275
      fprintf fmt "_%s" (name_of_carrier cr.carrier_id)
276
  | Carry_var ->
277
    fprintf fmt "'%s" (name_of_carrier cr.carrier_id)
278
  | Carry_link cr' ->
279
    print_carrier fmt cr'
280

  
281
(* Simple pretty-printing, performs no simplifications. Linear
282
   complexity. For debug mainly. *)
283
let rec print_ck_long fmt ck =
284
  match ck.cdesc with
285
  | Carrow (ck1,ck2) ->
286
      fprintf fmt "%a->%a" print_ck_long ck1 print_ck_long ck2
287
  | Ctuple cklist ->
288
    fprintf fmt "(%a)"
289
      (fprintf_list ~sep:" * " print_ck_long) cklist
290
  | Con (ck,c,l) ->
291
    fprintf fmt "%a on %s(%a)" print_ck_long ck l print_carrier c
292
  | Pck_up (ck,k) ->
293
    fprintf fmt "%a*^%i" print_ck_long ck k
294
  | Pck_down (ck,k) ->
295
    fprintf fmt "%a/^%i" print_ck_long ck k
296
  | Pck_phase (ck,q) ->
297
    fprintf fmt "%a~>%a" print_ck_long ck print_rat (simplify_rat q)
298
  | Pck_const (n,p) ->
299
    fprintf fmt "(%i,%a)" n print_rat (simplify_rat p)
300
  | Cvar cset ->
301
    fprintf fmt "'_%i%a" ck.cid print_ckset cset
302
  | Cunivar cset ->
303
    fprintf fmt "'%i%a" ck.cid print_ckset cset
304
  | Clink ck' ->
305
    fprintf fmt "link %a" print_ck_long ck'
306
  | Ccarrying (cr,ck') ->
307
    fprintf fmt "(%a:%a)" print_carrier cr print_ck_long ck'
308

  
309 320
(** [period ck] returns the period of [ck]. Expects a constant pclock
310 321
    expression belonging to the correct clock set. *)
311 322
let rec period ck =

Also available in: Unified diff