added construction of a fanin table for local variables of a node.

 could be useful for a finer variable elimination scheme at the Lustre level.
 to be continued...

src/causality.ml

@@ -135,6 +135,9 @@ let node_memory_variables nd =
 let node_input_variables nd =
  List.fold_left (fun inputs v -> ISet.add v.var_id inputs) ISet.empty nd.node_inputs
 
+let node_local_variables nd =
+ List.fold_left (fun locals v -> ISet.add v.var_id locals) ISet.empty nd.node_locals
+
 let node_output_variables nd =
  List.fold_left (fun outputs v -> ISet.add v.var_id outputs) ISet.empty nd.node_outputs
 

src/clock_calculus.ml

@@ -225,7 +225,7 @@ let unify_static_pck ck1 ck2 =
 let unify_carrier cr1 cr2 =
   let cr1 = carrier_repr cr1 in
   let cr2 = carrier_repr cr2 in
-  if cr1=cr2 then ()
+  if cr1==cr2 then ()
   else
     match cr1.carrier_desc, cr2.carrier_desc with
     | Carry_const id1, Carry_const id2 ->
@@ -257,7 +257,7 @@ let unify_carrier cr1 cr2 =
 let semi_unify_carrier cr1 cr2 =
   let cr1 = carrier_repr cr1 in
   let cr2 = carrier_repr cr2 in
-  if cr1=cr2 then ()
+  if cr1==cr2 then ()
   else
     match cr1.carrier_desc, cr2.carrier_desc with
     | Carry_const id1, Carry_const id2 ->
@@ -286,7 +286,7 @@ let semi_unify_carrier cr1 cr2 =
 let rec unify ck1 ck2 =
   let ck1 = repr ck1 in
   let ck2 = repr ck2 in
-  if ck1=ck2 then
+  if ck1==ck2 then
     ()
   else
     let left_const = is_concrete_pck ck1 in
@@ -391,7 +391,7 @@ let rec unify ck1 ck2 =
 let rec semi_unify ck1 ck2 =
   let ck1 = repr ck1 in
   let ck2 = repr ck2 in
-  if ck1=ck2 then
+  if ck1==ck2 then
     ()
   else
       match ck1.cdesc,ck2.cdesc with

src/liveness.ml

@@ -58,6 +58,22 @@ let death_table node g sort =
   end
 *)
 
+(* computes the in-degree for each local variable of node [n], according to dep graph [g].
+*)
+let compute_fanin n g =
+  let locals = ISet.diff (ExprDep.node_local_variables n) (ExprDep.node_memory_variables n) in
+  let fanin = Hashtbl.create 23 in
+  begin
+    IdentDepGraph.iter_vertex (fun v -> if ISet.mem v locals then Hashtbl.add fanin v (IdentDepGraph.in_degree g v)) g;
+    fanin
+  end
+ 
+let pp_fanin fmt fanin =
+  begin
+    Format.fprintf fmt "{ /* locals fanin: */@.";
+    Hashtbl.iter (fun s t -> Format.fprintf fmt "%s -> %d@." s t) fanin;
+    Format.fprintf fmt "}@."
+  end
 
 (* computes the cone of influence of a given [var] wrt a dependency graph [g].
 *)
@@ -169,17 +185,22 @@ let replace_in_death_table death v v' =
  Hashtbl.iter (fun k dead -> Hashtbl.replace death k (replace_in_set dead v v')) death
 
 let find_compatible_local node var dead =
- (*Format.eprintf "find_compatible_local %s %s@." node.node_id var;*)
+ (*Format.eprintf "find_compatible_local %s %s %a@." node.node_id var pp_iset dead;*)
   let typ = (Corelang.node_var var node).var_type in
   let eq_var = node_eq var node in
-  let inputs =
+  let aliasable_inputs =
     match NodeDep.get_callee eq_var.eq_rhs with
     | None           -> []
     | Some (_, args) -> List.fold_right (fun e r -> match e.expr_desc with Expr_ident id -> id::r | _ -> r) args [] in
   let filter v =
+    let res =
        ISet.mem v.var_id dead
     && Typing.eq_ground typ v.var_type
-    && not (List.mem v.var_id inputs) in
+    && not (Types.is_address_type v.var_type  && List.mem v.var_id aliasable_inputs) in
+    begin
+      (*Format.eprintf "filter %a = %s@." Printers.pp_var_name v (if res then "true" else "false");*)
+      res
+    end in
   try
     Some ((List.find filter node.node_locals).var_id)
   with Not_found -> None

src/main_lustre_compiler.ml

@@ -271,6 +271,8 @@ let rec compile basename extension =
   Log.report ~level:1 (fun fmt -> fprintf fmt ".. scheduling@,");
   let prog, node_schs = Scheduling.schedule_prog prog in
   Log.report ~level:1 (fun fmt -> fprintf fmt "@[<v 2>@ %a@]@," Scheduling.pp_warning_unused node_schs);
+  Log.report ~level:2 (fun fmt -> fprintf fmt "@[<v 2>@ %a@]@," Scheduling.pp_schedule node_schs);
+  Log.report ~level:2 (fun fmt -> fprintf fmt "@[<v 2>@ %a@]@," Scheduling.pp_fanin_table node_schs);
   Log.report ~level:2 (fun fmt -> fprintf fmt "@[<v 2>@ %a@]@," Printers.pp_prog prog);
 
  (* Optimization of prog: 

src/scheduling.ml

@@ -31,8 +31,13 @@ open Causality
 
 type schedule_report =
 {
+  (* a schedule computed wrt the dependency graph *)
   schedule : ident list;
+  (* the set of unused variables (no output or mem depends on them) *)
   unused_vars : ISet.t;
+  (* the table mapping each local var to its in-degree *)
+  fanin_table : (ident, int) Hashtbl.t;
+  (* the table mapping each assignment to a set of dead/reusable variables *)
   death_table : (ident, ISet.t) Hashtbl.t
 }
 
@@ -131,11 +136,13 @@ let schedule_node n =
     (* TODO X: extend the graph with inputs (adapt the causality analysis to deal with inputs
      compute: coi predecessors of outputs
      warning (no modification) when memories are non used (do not impact output) or when inputs are not used (do not impact output)
+       DONE !
      *)
 
     let gg = IdentDepGraph.copy g in
     let sort = topological_sort eq_equiv g in
     let unused = Liveness.compute_unused n gg in
+    let fanin = Liveness.compute_fanin n gg in
     let death = Liveness.death_table n gg sort in
     Log.report ~level:5 
       (fun fmt -> 
@@ -164,7 +171,7 @@ let schedule_node n =
 	  Liveness.pp_reuse_policy reuse
       );
  
-    n', { schedule = sort; unused_vars = unused; death_table = death }
+    n', { schedule = sort; unused_vars = unused; fanin_table = fanin; death_table = death }
   with (Causality.Cycle v) as exc ->
     pp_error Format.err_formatter v;
     raise exc
@@ -182,6 +189,20 @@ let schedule_prog prog =
     prog
     ([],IMap.empty)
 
+let pp_schedule fmt node_schs =
+ IMap.iter
+   (fun nd report ->
+     Format.fprintf fmt "%s schedule: %a@."
+       nd
+       (fprintf_list ~sep:" ; " (fun fmt v -> Format.fprintf fmt "%s" v)) report.schedule)
+   node_schs
+
+let pp_fanin_table fmt node_schs =
+  IMap.iter
+    (fun nd report ->
+      Format.fprintf fmt "%s : %a" nd Liveness.pp_fanin report.fanin_table)
+    node_schs
+
 let pp_warning_unused fmt node_schs =
  IMap.iter
    (fun nd report ->

src/types.ml

@@ -250,9 +250,10 @@ let map_tuple_type f ty =
   | (Ttuple ty_list) -> { ty with tdesc = Ttuple (List.map f ty_list) }
   | _                -> f ty
 
-let is_struct_type ty =
+let rec is_struct_type ty =
  match (repr ty).tdesc with
  | Tstruct _        -> true
+ | Tstatic (_, ty') -> is_struct_type ty'
  | _                -> false
 
 let rec is_array_type ty =

src/typing.ml

@@ -148,7 +148,7 @@ let get_type_definition tname =
 (* Should be used between local variables which must have a ground type *)
 let rec eq_ground t1 t2 =
   match t1.tdesc, t2.tdesc with
-  | Tint, Tint | Tbool, Tbool | Trat, Trat -> true
+  | Tint, Tint | Tbool, Tbool | Trat, Trat | Treal, Treal -> true
   | Tenum tl, Tenum tl' when tl == tl' -> true
   | Ttuple tl, Ttuple tl' when List.length tl = List.length tl' -> List.for_all2 eq_ground tl tl'
   | Tstruct fl, Tstruct fl' when List.map fst fl = List.map fst fl' -> List.for_all2 (fun (_, t) (_, t') -> eq_ground t t') fl fl'
@@ -177,7 +177,7 @@ let unify ?(sub=false) ?(semi=false) t1 t2 =
   let rec unif t1 t2 =
     let t1 = repr t1 in
     let t2 = repr t2 in
-    if t1=t2 then
+    if t1==t2 then
       ()
     else
       match t1.tdesc,t2.tdesc with
@@ -210,7 +210,7 @@ let unify ?(sub=false) ?(semi=false) t1 t2 =
       | Tclock _, Tstatic _
       | Tstatic _, Tclock _ -> raise (Unify (t1, t2))
       | Tclock t1', Tclock t2' -> unif t1' t2'
-      | Tint, Tint | Tbool, Tbool | Trat, Trat
+      | Tint, Tint | Tbool, Tbool | Trat, Trat | Treal, Treal
       | Tunivar, _ | _, Tunivar -> ()
       | (Tconst t, _) ->
 	let def_t = get_type_definition t in

src/utils.ml

@@ -292,6 +292,13 @@ let pp_array a pp_fun beg_str end_str sep_str =
   else
     print_string end_str
 
+let pp_iset fmt t =
+  begin
+    Format.fprintf fmt "{@ ";
+    ISet.iter (fun s -> Format.fprintf fmt "%s@ " s) t;
+    Format.fprintf fmt "}@."
+  end
+
 let pp_hashtbl t pp_fun beg_str end_str sep_str =
   if (beg_str="\n") then
     print_newline ()