From 30089e7d0f0b0201599da18027693e44986e590f Mon Sep 17 00:00:00 2001
From: Adrien Guatto <adrien@ludics.eu>
Date: Wed, 5 Oct 2011 17:43:43 +0200
Subject: [PATCH] Fixed extvalue inlining w.r.t. linear copy

---
 .../transformations/inline_extvalues.ml       | 23 ++++++++++++++++++-
 1 file changed, 22 insertions(+), 1 deletion(-)

diff --git a/compiler/minils/transformations/inline_extvalues.ml b/compiler/minils/transformations/inline_extvalues.ml
index c83d669..77beda2 100644
--- a/compiler/minils/transformations/inline_extvalues.ml
+++ b/compiler/minils/transformations/inline_extvalues.ml
@@ -32,10 +32,31 @@ open Mls_compare
   4. If no new extended value was formed, stop ; else, go back to 1.
 *)
 
+
 let gather_extvalues_node nd =
+  let ty_env =
+    let add env vd = Env.add vd.v_ident vd.v_type env in
+    let add_l env vd_list = List.fold_left add env vd_list in
+    (add_l (add_l (add_l Env.empty nd.n_output) nd.n_local) nd.n_input)
+  in
+
+  let changed_type w =
+    let rec var_of_extvalue w = match w.w_desc with
+      | Wvar _ -> Some w
+      | Wfield(w, _) -> var_of_extvalue w
+      | Wwhen(w, _, _) -> var_of_extvalue w
+      | Wconst _ -> None
+    in
+    match var_of_extvalue w with
+      | Some { w_ty = ty; w_desc = Wvar x; } ->
+        let ty' = Env.find x ty_env in
+        Global_compare.type_compare ty' ty = 0
+      | _ -> false
+  in
+
   let gather_extvalues_eq _ env eq =
     let env = match eq.eq_lhs, eq.eq_rhs.e_desc with
-      | Evarpat x, Eextvalue w -> Env.add x w env
+      | Evarpat x, Eextvalue w when not (changed_type w) -> Env.add x w env
       | _ -> env
     in
     eq, env