From c69e0c432107906261ab4c56cd88a8cfab3191fb Mon Sep 17 00:00:00 2001
From: Adam Chlipala <adamc@hcoop.net>
Date: Thu, 14 May 2009 13:18:31 -0400
Subject: Proper lifting of MonoEnv stored expressions; avoidance of onchange
 clobbering

---
 src/mono_env.sml | 18 ++++++++++++++++--
 1 file changed, 16 insertions(+), 2 deletions(-)

(limited to 'src/mono_env.sml')

diff --git a/src/mono_env.sml b/src/mono_env.sml
index 739f2f89..2397637a 100644
--- a/src/mono_env.sml
+++ b/src/mono_env.sml
@@ -70,11 +70,25 @@ fun lookupConstructor (env : env) n =
         NONE => raise UnboundNamed n
       | SOME x => x
 
+structure U = MonoUtil
+
+val liftExpInExp =
+    U.Exp.mapB {typ = fn t => t,
+                exp = fn bound => fn e =>
+                                     case e of
+                                         ERel xn =>
+                                         if xn < bound then
+                                             e
+                                         else
+                                             ERel (xn + 1)
+                                       | _ => e,
+                bind = fn (bound, U.Exp.RelE _) => bound + 1
+                        | (bound, _) => bound}
+
 fun pushERel (env : env) x t eo =
     {datatypes = #datatypes env,
      constructors = #constructors env,
-
-     relE = (x, t, eo) :: #relE env,
+     relE = (x, t, eo) :: map (fn (x, t, eo) => (x, t, Option.map (liftExpInExp 0) eo)) (#relE env),
      namedE = #namedE env}
 
 fun lookupERel (env : env) n =
-- 
cgit v1.2.3