Project

General

Profile

Revision 7291cb80 src/clock_calculus.ml

View differences:

src/clock_calculus.ml
100 100
    raise (Error (loc, Clock_extrusion (ck_node, ck)))
101 101

  
102 102
(* Clocks instanciation *)
103
let instanciate_carrier cr inst_cr_vars =
103
let instantiate_carrier cr inst_cr_vars =
104 104
  let cr = carrier_repr cr in
105 105
  match cr.carrier_desc with
106 106
  | Carry_const _
......
119 119
(* inst_ck_vars ensures that a polymorphic variable is instanciated with
120 120
   the same monomorphic variable if it occurs several times in the same
121 121
   type. inst_cr_vars is the same for carriers. *)
122
let rec instanciate inst_ck_vars inst_cr_vars ck =
122
let rec instantiate inst_ck_vars inst_cr_vars ck =
123 123
  match ck.cdesc with
124 124
  | Carrow (ck1,ck2) ->
125 125
      {ck with cdesc =
126
       Carrow ((instanciate inst_ck_vars inst_cr_vars ck1),
127
               (instanciate inst_ck_vars inst_cr_vars ck2))}
126
       Carrow ((instantiate inst_ck_vars inst_cr_vars ck1),
127
               (instantiate inst_ck_vars inst_cr_vars ck2))}
128 128
  | Ctuple cklist ->
129 129
      {ck with cdesc = Ctuple 
130
         (List.map (instanciate inst_ck_vars inst_cr_vars) cklist)}
130
         (List.map (instantiate inst_ck_vars inst_cr_vars) cklist)}
131 131
  | Con (ck',c,l) ->
132
      let c' = instanciate_carrier c inst_cr_vars in
133
      {ck with cdesc = Con ((instanciate inst_ck_vars inst_cr_vars ck'),c',l)}
132
      let c' = instantiate_carrier c inst_cr_vars in
133
      {ck with cdesc = Con ((instantiate inst_ck_vars inst_cr_vars ck'),c',l)}
134 134
  | Cvar _ | Pck_const (_,_) -> ck
135 135
  | Pck_up (ck',k) ->
136
      {ck with cdesc = Pck_up ((instanciate inst_ck_vars inst_cr_vars ck'),k)}
136
      {ck with cdesc = Pck_up ((instantiate inst_ck_vars inst_cr_vars ck'),k)}
137 137
  | Pck_down (ck',k) ->
138
      {ck with cdesc = Pck_down ((instanciate inst_ck_vars inst_cr_vars ck'),k)}
138
      {ck with cdesc = Pck_down ((instantiate inst_ck_vars inst_cr_vars ck'),k)}
139 139
  | Pck_phase (ck',q) ->
140
      {ck with cdesc = Pck_phase ((instanciate inst_ck_vars inst_cr_vars ck'),q)}
140
      {ck with cdesc = Pck_phase ((instantiate inst_ck_vars inst_cr_vars ck'),q)}
141 141
  | Clink ck' ->
142
      {ck with cdesc = Clink (instanciate inst_ck_vars inst_cr_vars ck')}
142
      {ck with cdesc = Clink (instantiate inst_ck_vars inst_cr_vars ck')}
143 143
  | Ccarrying (cr,ck') ->
144
      let cr' = instanciate_carrier cr inst_cr_vars in
144
      let cr' = instantiate_carrier cr inst_cr_vars in
145 145
        {ck with cdesc =
146
         Ccarrying (cr',instanciate inst_ck_vars inst_cr_vars ck')}
146
         Ccarrying (cr',instantiate inst_ck_vars inst_cr_vars ck')}
147 147
  | Cunivar cset ->
148 148
      try
149 149
        List.assoc ck.cid !inst_ck_vars
......
512 512
        with Not_found -> 
513 513
	  failwith ("Internal error, variable \""^v^"\" not found")
514 514
      in
515
      let ck = instanciate (ref []) (ref []) ckv in
515
      let ck = instantiate (ref []) (ref []) ckv in
516 516
      expr.expr_clock <- ck;
517 517
      ck
518 518
  | Expr_array elist ->
......
775 775
let clock_prog env decls =
776 776
  List.fold_left (fun e decl -> clock_top_decl e decl) env decls
777 777

  
778
let check_env_compat declared computed =
778
let check_env_compat header declared computed =
779 779
  Env.iter declared (fun k decl_clock_k -> 
780
    let computed_c = Env.lookup_value computed k in
780
    let computed_c = instantiate (ref []) (ref []) (Env.lookup_value computed k) in
781 781
    try_unify decl_clock_k computed_c Location.dummy_loc
782 782
  ) 
783 783
(* Local Variables: *)

Also available in: Unified diff