Project

General

Profile

Revision 6a1a01d2 src/clock_calculus.ml

View differences:

src/clock_calculus.ml
441 441
      (Const_int i) -> i
442 442
  | _ -> failwith "Internal error: int_factor_of_expr"
443 443

  
444
(** [clock_uncarry ck] drops the possible carrier name from clock [ck] *)
445
let clock_uncarry ck =
444
(** [clock_uncarry ck] drops the possible carrier(s) name(s) from clock [ck] *)
445
let rec clock_uncarry ck =
446 446
  let ck = repr ck in
447 447
  match ck.cdesc with
448 448
  | Ccarrying (_, ck') -> ck'
449
  | Con(ck', cr, l)    -> clock_on (clock_uncarry ck') cr l
450
  | Ctuple ckl         -> clock_of_clock_list (List.map clock_uncarry ckl)
449 451
  | _                  -> ck
450 452

  
451 453
let try_unify ck1 ck2 loc =
......
557 559
  in
558 560
  aux ck
559 561

  
562
(* Computes the root clock of a tuple or a node clock,
563
   which is not the same as the base clock.
564
   Root clock will be used as the call clock 
565
   of a given node instance *)
566
let compute_root_clock ck =
567
  let root = Clocks.root ck in
568
  let branch = ref None in
569
  let rec aux ck =
570
    match (repr ck).cdesc with
571
    | Ctuple cl ->
572
        List.iter aux cl
573
    | Carrow (ck1,ck2) ->
574
        aux ck1; aux ck2
575
    | _ ->
576
        begin
577
          match !branch with
578
          | None ->
579
              branch := Some (Clocks.branch ck)
580
          | Some br ->
581
              (* cannot fail *)
582
              branch := Some (Clocks.common_prefix br (Clocks.branch ck))
583
        end
584
  in
585
  begin
586
    aux ck;
587
    Clocks.clock_of_root_branch root (Utils.desome !branch)
588
  end
589

  
560 590
(* Clocks a list of arguments of Lustre builtin operators:
561 591
   - type each expression, remove carriers of clocks as
562 592
     carriers may only denote variables, not arbitrary expr.
......
658 688
    let cr =
659 689
      match r with
660 690
      | None        -> new_var true
661
      | Some (x, _) -> let loc_r = loc_of_cond expr.expr_loc x in
662
		       let expr_r = expr_of_ident x loc_r in
663
		       clock_expr env expr_r in
691
      | Some c      -> clock_standard_args env [c] in
664 692
    let couts = clock_appl env id args cr expr.expr_loc in
665 693
    expr.expr_clock <- couts;
666 694
    couts
......
690 718
  | Expr_merge (c,hl) ->
691 719
      let cvar = new_var true in
692 720
      let crvar = new_carrier Carry_name true in
693
      List.iter (fun (t, h) -> let ckh = clock_expr env h in unify_tuple_clock (Some (new_ck (Con (cvar,crvar,t)) true)) ckh h.expr_loc) hl;
721
      List.iter (fun (t, h) -> let ckh = clock_uncarry (clock_expr env h) in unify_tuple_clock (Some (new_ck (Con (cvar,crvar,t)) true)) ckh h.expr_loc) hl;
694 722
      let cr = clock_carrier env c expr.expr_loc cvar in
695 723
      try_unify_carrier cr crvar expr.expr_loc;
696
      expr.expr_clock <- cvar;
697
      cvar
724
      let cres = clock_current ((snd (List.hd hl)).expr_clock) in
725
      expr.expr_clock <- cres;
726
      cres
698 727
  in
699 728
  Log.report ~level:4 (fun fmt -> Format.fprintf fmt "Clock of expr %a: %a@." Printers.pp_expr expr Clocks.print_ck resulting_ck);
700 729
  resulting_ck

Also available in: Unified diff