diff src/elab_env.sml @ 448:85819353a84f

First Unnest tests working
author Adam Chlipala <adamc@hcoop.net>
date Sat, 01 Nov 2008 15:58:55 -0400
parents b77863cd0be2
children 222cbc1da232
line wrap: on
line diff
--- a/src/elab_env.sml	Sat Nov 01 11:17:29 2008 -0400
+++ b/src/elab_env.sml	Sat Nov 01 15:58:55 2008 -0400
@@ -61,6 +61,20 @@
 
 val lift = liftConInCon 0
 
+val liftConInExp =
+    U.Exp.mapB {kind = fn k => k,
+                con = fn bound => fn c =>
+                                     case c of
+                                         CRel xn =>
+                                         if xn < bound then
+                                             c
+                                         else
+                                             CRel (xn + 1)
+                                       | _ => c,
+                exp = fn _ => fn e => e,
+                bind = fn (bound, U.Exp.RelC _) => bound + 1
+                        | (bound, _) => bound}
+
 val liftExpInExp =
     U.Exp.mapB {kind = fn k => k,
                 con = fn _ => fn c => c,
@@ -78,6 +92,21 @@
 
 val liftExp = liftExpInExp 0
 
+val subExpInExp =
+    U.Exp.mapB {kind = fn k => k,
+                con = fn _ => fn c => c,
+                exp = fn (xn, rep) => fn e =>
+                                  case e of
+                                      ERel xn' =>
+                                      (case Int.compare (xn', xn) of
+                                           EQUAL => #1 rep
+                                         | GREATER=> ERel (xn' - 1)
+                                         | LESS => e)
+                                    | _ => e,
+                bind = fn ((xn, rep), U.Exp.RelE _) => (xn+1, liftExpInExp 0 rep)
+                        | ((xn, rep), U.Exp.RelC _) => (xn, liftConInExp 0 rep)
+                        | (ctx, _) => ctx}
+
 (* Back to environments *)
 
 datatype 'a var' =