diff src/mono_reduce.sml @ 814:3f3b211f9bca

Fix argument ordering bug in fuse; fix case subsitution bug in MonoReduce
author Adam Chlipala <adamc@hcoop.net>
date Sun, 17 May 2009 14:36:55 -0400
parents 5f49a6b759cb
children 493f44759879
line wrap: on
line diff
--- a/src/mono_reduce.sml	Sun May 17 13:25:57 2009 -0400
+++ b/src/mono_reduce.sml	Sun May 17 14:36:55 2009 -0400
@@ -140,12 +140,12 @@
                 bind = fn ((lower, len), U.Exp.RelE _) => (lower+1, len)
                         | (st, _) => st}
 
-datatype result = Yes of E.env | No | Maybe
+datatype result = Yes of exp list | No | Maybe
 
 fun match (env, p : pat, e : exp) =
     case (#1 p, #1 e) of
         (PWild, _) => Yes env
-      | (PVar (x, t), _) => Yes (E.pushERel env x t (SOME e))
+      | (PVar (x, t), _) => Yes (e :: env)
 
       | (PPrim (Prim.String s), EStrcat ((EPrim (Prim.String s'), _), _)) =>
         if String.isPrefix s' s then
@@ -406,12 +406,13 @@
                                 case pes of
                                     [] => push ()
                                   | (p, body) :: pes =>
-                                    case match (env, p, e') of
+                                    case match ([], p, e') of
                                         No => search pes
                                       | Maybe => push ()
-                                      | Yes env' =>
+                                      | Yes subs =>
                                         let
-                                            val r = reduceExp env' body
+                                            val body = foldr (fn (e, body) => subExpInExp (0, e) body) body subs
+                                            val r = reduceExp env body
                                         in
                                             (*Print.prefaces "ECase"
                                                            [("body", MonoPrint.p_exp env' body),