Project

General

Profile

Revision 1b01da98 src/causality.ml

View differences:

src/causality.ml
106 106
    match rhs.expr_desc with
107 107
    | Expr_fby _
108 108
    | Expr_pre _    -> List.fold_right ISet.add lhs mems
109
    | Expr_tuple tl -> List.fold_right2 match_mem (transpose_list [lhs]) tl mems
109
    | Expr_tuple tl -> 
110
      let lhs' = (transpose_list [lhs]) in
111
      if List.length tl <> List.length lhs' then
112
	assert false;
113
      List.fold_right2 match_mem lhs' tl mems
110 114
    | _             -> mems in
111 115
  match_mem eq.eq_lhs eq.eq_rhs mems
112 116

  
......
156 160
    match (Clocks.repr ck).Clocks.cdesc with
157 161
    | Clocks.Con (ck', cr, _)   -> add_var lhs_is_mem lhs (Clocks.const_of_carrier cr) (add_clock lhs_is_mem lhs ck' g)
158 162
    | Clocks.Ccarrying (_, ck') -> add_clock lhs_is_mem lhs ck' g
159
    | _                         -> g in
163
    | _                         -> g 
164
  in
165
  
166

  
160 167
  let rec add_dep lhs_is_mem lhs rhs g =
161
(* Add mashup dependencies for a user-defined node instance [lhs] = [f]([e]) *)
162
(* i.e every input is connected to every output, through a ghost var *)
168
    
169
    (* Add mashup dependencies for a user-defined node instance [lhs] = [f]([e]) *)
170
    (* i.e every input is connected to every output, through a ghost var *)
163 171
    let mashup_appl_dependencies f e g =
164 172
      let f_var = mk_instance_var (sprintf "%s_%d" f eq.eq_loc.Location.loc_start.Lexing.pos_lnum) in
165 173
      List.fold_right (fun rhs -> add_dep lhs_is_mem (adjust_tuple f_var rhs) rhs)
166
	(expr_list_of_expr e) (add_var lhs_is_mem lhs f_var g) in
174
	(expr_list_of_expr e) (add_var lhs_is_mem lhs f_var g) 
175
    in
167 176
    match rhs.expr_desc with
168 177
    | Expr_const _    -> g
169 178
    | Expr_fby (e1, e2)  -> add_dep true lhs e2 (add_dep false lhs e1 g)
......
172 181
    | Expr_access (e1, _)
173 182
    | Expr_power (e1, _) -> add_dep lhs_is_mem lhs e1 g
174 183
    | Expr_array a -> List.fold_right (add_dep lhs_is_mem lhs) a g
175
    | Expr_tuple t -> List.fold_right2 (fun l r -> add_dep lhs_is_mem [l] r) lhs t g
184
    | Expr_tuple t ->       
185
      if List.length t <> List.length lhs then ( 
186
	match lhs with
187
	| [l] -> List.fold_right (fun r -> add_dep lhs_is_mem [l] r) t g
188
	| _ -> 
189
	  Format.eprintf "Incompatible tuple assign: %a (%i) vs %a (%i)@.@?" 
190
	    (Utils.fprintf_list ~sep:"," (Format.pp_print_string)) lhs 
191
	    (List.length lhs)
192
	    Printers.pp_expr rhs
193
	    (List.length t)
194
	  ;
195
	  assert false
196
      ) 
197
      else
198
	List.fold_right2 (fun l r -> add_dep lhs_is_mem [l] r) lhs t g
176 199
    | Expr_merge (c, hl) -> add_var lhs_is_mem lhs c (List.fold_right (fun (_, h) -> add_dep lhs_is_mem lhs h) hl g)
177 200
    | Expr_ite   (c, t, e) -> add_dep lhs_is_mem lhs c (add_dep lhs_is_mem lhs t (add_dep lhs_is_mem lhs e g))
178 201
    | Expr_arrow (e1, e2)  -> add_dep lhs_is_mem lhs e2 (add_dep lhs_is_mem lhs e1 g)
179 202
    | Expr_when  (e, c, _)  -> add_dep lhs_is_mem lhs e (add_var lhs_is_mem lhs c g)
180 203
    | Expr_appl (f, e, None) ->
181 204
      if Basic_library.is_internal_fun f
182
    (* tuple component-wise dependency for internal operators *)
205
      (* tuple component-wise dependency for internal operators *)
183 206
      then
184 207
	List.fold_right (add_dep lhs_is_mem lhs) (expr_list_of_expr e) g
185
    (* mashed up dependency for user-defined operators *)
208
      (* mashed up dependency for user-defined operators *)
186 209
      else
187 210
	mashup_appl_dependencies f e g
188 211
    | Expr_appl (f, e, Some (r, _)) ->

Also available in: Unified diff