From 2b9d3828b1298588c45c76cecb86272971d1d53f Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?L=C3=A9onard=20G=C3=A9rard?= <leonard.gerard@ens.fr>
Date: Mon, 28 Nov 2011 22:18:03 +0100
Subject: [PATCH] debut de la correction du when.

test :

node f(c :bool) returns (out :int)
let
  out = (0 fby 1) when c
tel


et

node f(x :int) returns (out : int)
let
  out = 0 fby x
tel

node g(c :bool) returns (out :int)
let
  out = f(0) when c
tel
---
 compiler/minils/analysis/clocking.ml |  9 ++++++++-
 compiler/minils/mls_utils.ml         | 10 ++++++----
 2 files changed, 14 insertions(+), 5 deletions(-)

diff --git a/compiler/minils/analysis/clocking.ml b/compiler/minils/analysis/clocking.ml
index 0529843..238f009 100644
--- a/compiler/minils/analysis/clocking.ml
+++ b/compiler/minils/analysis/clocking.ml
@@ -131,6 +131,12 @@ let typing_app h base pat op w_list = match op with
       Clocks.prod (List.map (fun a -> sigck_to_ck a.a_clock) node.node_outputs)
 
 
+let rec stateful e = match e.e_desc with
+  | Efby _ -> true
+  | Ewhen (e,_,_) -> stateful e
+  | Eapp({a_unsafe = unsafe}, _, _) when unsafe -> true
+  | Eapp({a_op = Enode _}, _, _) -> true
+  | _ -> false
 
 
 let typing_eq h { eq_lhs = pat; eq_rhs = e; eq_loc = loc } =
@@ -144,7 +150,8 @@ let typing_eq h { eq_lhs = pat; eq_rhs = e; eq_loc = loc } =
       | Ewhen (e,c,n) ->
           let ck_n = ck_of_name h n in
           let base = expect (skeleton ck_n e.e_ty) e in
-          skeleton (Con (ck_n, c, n)) e.e_ty, Con (ck_n, c, n)
+          let base_ck = if stateful e then ck_n else Con (ck_n, c, n) in
+          skeleton (Con (ck_n, c, n)) e.e_ty, base_ck
       | Emerge (x, c_e_list) ->
           let ck = ck_of_name h x in
           List.iter (fun (c,e) -> expect_extvalue h (Con (ck,c,x)) e) c_e_list;
diff --git a/compiler/minils/mls_utils.ml b/compiler/minils/mls_utils.ml
index 649c475..b44794a 100644
--- a/compiler/minils/mls_utils.ml
+++ b/compiler/minils/mls_utils.ml
@@ -166,8 +166,9 @@ struct
 
   (** Returns a list of memory vars (x in x = v fby e)
       appearing in an equation. *)
-  let memory_vars ({ eq_lhs = _; eq_rhs = e } as eq) = match e.e_desc with
+  let rec memory_vars ({ eq_lhs = _; eq_rhs = e } as eq) = match e.e_desc with
     | Efby(_, _) -> def [] eq
+    | Ewhen(e,_,_) -> memory_vars {eq with eq_rhs = e}
     | _ -> []
 
   let linear_read e =
@@ -189,12 +190,13 @@ end
 
 (* Assumes normal form, all fby are solo rhs *)
 let node_memory_vars n =
-  let eq _ acc ({ eq_lhs = pat; eq_rhs = e } as eq) =
+  let rec eq funs acc ({ eq_lhs = pat; eq_rhs = e } as equ) =
     match pat, e.e_desc with
+    | Evarpat x, Ewhen(e,_,_) -> eq funs acc {equ with eq_rhs = e}
     | Evarpat x, Efby(_, _) ->
         let acc = (x, e.e_ty) :: acc in
-          eq, acc
-    | _, _ -> eq, acc
+        equ, acc
+    | _, _ -> equ, acc
   in
   let funs = { Mls_mapfold.defaults with eq = eq } in
   let _, acc = node_dec_it funs [] n in