diff src/mono_reduce.sml @ 316:04ebfe929a98

Unpolyed a polymorphic function of two arguments
author Adam Chlipala <adamc@hcoop.net>
date Thu, 11 Sep 2008 10:14:59 -0400
parents 52d4c60518d4
children 60907c06b4c4
line wrap: on
line diff
--- a/src/mono_reduce.sml	Thu Sep 11 09:36:47 2008 -0400
+++ b/src/mono_reduce.sml	Thu Sep 11 10:14:59 2008 -0400
@@ -95,6 +95,21 @@
 
 fun typ c = c
 
+val swapExpVars =
+    U.Exp.mapB {typ = fn t => t,
+                exp = fn lower => fn e =>
+                                     case e of
+                                         ERel xn =>
+                                         if xn = lower then
+                                             ERel (lower + 1)
+                                         else if xn = lower + 1 then
+                                             ERel lower
+                                         else
+                                             e
+                                       | _ => e,
+                bind = fn (lower, U.Exp.RelE _) => lower+1
+                        | (lower, _) => lower}
+
 datatype result = Yes of E.env | No | Maybe
 
 fun match (env, p : pat, e : exp) =
@@ -208,6 +223,10 @@
       | EApp ((ELet (x, t, e, b), loc), e') =>
         #1 (reduceExp env (ELet (x, t, e,
                                  (EApp (b, liftExpInExp 0 e'), loc)), loc))
+
+      | ELet (x, t, e, (EAbs (x', t' as (TRecord [], _), ran, e'), loc)) =>
+        EAbs (x', t', ran, (ELet (x, t, liftExpInExp 0 e, swapExpVars 0 e'), loc))
+
       | ELet (x, t, e', b) =>
         if impure e' then
             e