From db5f55b221101ff387a4f1852ad61aa4d8c4fca0 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ce=CC=81dric=20Pasteur?= <cedric.pasteur@ens.fr>
Date: Wed, 25 Jan 2012 09:32:52 +0100
Subject: [PATCH] Fixed when of stateful exp with memalloc

As the expression inside the when will be called
on a faster rhythm, we have to make sure not to
share it with a variable on the slow clock.
We do this by creating a new equation for the
stateful exp.
---
 compiler/heptagon/analysis/stateful.ml        |  4 ++++
 .../heptagon/transformations/normalize.ml     | 23 +++++++++++++++----
 2 files changed, 22 insertions(+), 5 deletions(-)

diff --git a/compiler/heptagon/analysis/stateful.ml b/compiler/heptagon/analysis/stateful.ml
index dacb65c..bd3c21c 100644
--- a/compiler/heptagon/analysis/stateful.ml
+++ b/compiler/heptagon/analysis/stateful.ml
@@ -105,6 +105,10 @@ let funs =
       block = block;
       node_dec = node_dec; }
 
+let exp_is_stateful e =
+  let _, res = Hept_mapfold.edesc_it funs false e.e_desc in
+  res
+
 let program p =
   let p, _ = Hept_mapfold.program_it funs false p in
   p
diff --git a/compiler/heptagon/transformations/normalize.ml b/compiler/heptagon/transformations/normalize.ml
index f2e5e3a..5033bb3 100644
--- a/compiler/heptagon/transformations/normalize.ml
+++ b/compiler/heptagon/transformations/normalize.ml
@@ -90,14 +90,27 @@ let equation (d_list, eq_list) e =
 
 (* [(e1,...,ek) when C(n) = (e1 when C(n),...,ek when C(n))] *)
 let rec whenc context e c n e_orig =
-  let when_on_c c n e =
-    { e_orig with e_desc = Ewhen(e, c, n); }
+  let when_on_c c n context e =
+    (* If memalloc is activated, there cannot be a stateful exp inside a when. Indeed,
+       the expression inside the when will be called on a fast rhythm and write its result
+       in a variable that is slow because of the when. Although this value won't be used,
+       we have to be careful not to share this variable with another on the same clock as
+       the value of the latter will be overwritten.  *)
+    let context, e =
+      if !Compiler_options.do_mem_alloc && Stateful.exp_is_stateful e then
+        let context, n = equation context e in
+        context, { e with e_desc = n }
+      else
+        context, e
+    in
+    { e_orig with e_desc = Ewhen(e, c, n) }, context
   in
     if is_list e then (
-      let e_list = List.map (when_on_c c n) (e_to_e_list e) in
+      let e_list, context = Misc.mapfold (when_on_c c n) context (e_to_e_list e) in
           context, { e_orig with e_desc = Eapp(mk_app Etuple, e_list, None) }
     ) else
-      context, when_on_c c n e
+      let e, context = when_on_c c n context e in
+      context, e
 
 type kind = ExtValue | Any
 
@@ -138,7 +151,7 @@ let rec translate kind context e =
           context, { e with e_desc = Estruct l }
     | Ewhen(e1, c, n) ->
         let context, e1 = translate kind context e1 in
-          whenc context e1 c n e
+        whenc context e1 c n e
     | Emerge(n, tag_e_list) ->
         merge context e n tag_e_list
     | Eapp({ a_op = Eifthenelse }, [e1; e2; e3], _) ->