From 1231afdbb15cd120e4eab1b85bff931c0091849c Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?C=C3=A9dric=20Pasteur?= <cedric.pasteur@ens.fr>
Date: Thu, 15 Sep 2011 13:28:41 +0200
Subject: [PATCH] Fixed inlining

Inlining is now recursive.
---
 compiler/heptagon/transformations/inline.ml | 34 +++++++++------------
 1 file changed, 14 insertions(+), 20 deletions(-)

diff --git a/compiler/heptagon/transformations/inline.ml b/compiler/heptagon/transformations/inline.ml
index 1899ff0..9288e9b 100644
--- a/compiler/heptagon/transformations/inline.ml
+++ b/compiler/heptagon/transformations/inline.ml
@@ -49,7 +49,9 @@ let mk_unique_node nd =
                  edesc = subst_edesc; } in
   fst (Hept_mapfold.node_dec funs () nd)
 
-let exp funs (env, newvars, newequs) exp = match exp.e_desc with
+let exp funs (env, newvars, newequs) exp =
+  let exp, (env, newvars, newequs) = Hept_mapfold.exp funs (env, newvars, newequs) exp in
+  match exp.e_desc with
   | Eiterator (it, { a_op = Enode nn; }, _, _, _, _) when to_be_inlined nn ->
       Format.eprintf
         "WARN: inlining iterators (\"%s %s\" here) is unsupported.@."
@@ -62,7 +64,7 @@ let exp funs (env, newvars, newequs) exp = match exp.e_desc with
         | None -> eq
         | Some x -> mk_equation (Ereset (mk_block [eq], x)) in
 
-      let ni = mk_unique_node (env nn) in
+      let ni = mk_unique_node (QualEnv.find nn env) in
 
       let static_subst =
         List.combine (List.map (fun p -> (local_qn p.p_name)) ni.n_params)
@@ -101,12 +103,13 @@ let exp funs (env, newvars, newequs) exp = match exp.e_desc with
       (res_e, (env, newvars, newequs))
 
     with
-      | Not_found -> exp, (env, newvars, newequs)
+      | Not_found -> Format.eprintf "Could not inline %s@." (fullname nn);
+        exp, (env, newvars, newequs)
     end
-  | _ -> Hept_mapfold.exp funs (env, newvars, newequs) exp
+  | _ -> exp, (env, newvars, newequs)
 
 let block funs (env, newvars, newequs) blk =
-  let (_, (env, newvars, newequs)) =
+  let (blk, (env, newvars, newequs)) =
     Hept_mapfold.block funs (env, newvars, newequs) blk in
   ({ blk with b_local = newvars @ blk.b_local; b_equs = newequs @ blk.b_equs; },
    (env, [], []))
@@ -114,25 +117,16 @@ let block funs (env, newvars, newequs) blk =
 let node_dec funs (env, newvars, newequs) nd =
   let nd, (env, newvars, newequs) =
     Hept_mapfold.node_dec funs (env, newvars, newequs) nd in
-  ({ nd with n_block =
-       { nd.n_block with b_local = newvars @ nd.n_block.b_local;
-           b_equs = newequs @ nd.n_block.b_equs } },
-   (env, [], []))
+  let nd = { nd with n_block =
+      { nd.n_block with b_local = newvars @ nd.n_block.b_local;
+        b_equs = newequs @ nd.n_block.b_equs } } in
+  let env = QualEnv.add nd.n_name nd env in
+   nd, (env, [], [])
 
 let program p =
-  let env n =
-    let d =
-      List.find
-  (function
-     | Pnode nd -> nd.n_name = n
-     | _ -> false)
-  p.p_desc in
-    match d with
-    | Pnode nd -> nd
-    | _ -> assert false in
   let funs =
     { defaults with exp = exp; block = block; node_dec = node_dec; eq = eq; } in
-  let (p, (_, newvars, newequs)) = Hept_mapfold.program funs (env, [], []) p in
+  let (p, (_, newvars, newequs)) = Hept_mapfold.program funs (QualEnv.empty, [], []) p in
   assert (newvars = []);
   assert (newequs = []);
   p