diff src/mono_reduce.sml @ 800:e92cfac1608f

Proper lifting of MonoEnv stored expressions; avoidance of onchange clobbering
author Adam Chlipala <adamc@hcoop.net>
date Thu, 14 May 2009 13:18:31 -0400
parents a28982de5645
children 5f49a6b759cb
line wrap: on
line diff
--- a/src/mono_reduce.sml	Thu May 14 11:04:56 2009 -0400
+++ b/src/mono_reduce.sml	Thu May 14 13:18:31 2009 -0400
@@ -409,7 +409,15 @@
                                     case match (env, p, e') of
                                         No => search pes
                                       | Maybe => push ()
-                                      | Yes env => #1 (reduceExp env body)
+                                      | Yes env' =>
+                                        let
+                                            val r = reduceExp env' body
+                                        in
+                                            (*Print.prefaces "ECase"
+                                                           [("body", MonoPrint.p_exp env' body),
+                                                            ("r", MonoPrint.p_exp env r)];*)
+                                            #1 r
+                                        end
                         in
                             search pes
                         end
@@ -443,7 +451,14 @@
                       | ELet (x, t, e', b) =>
                         let
                             fun doSub () =
-                                #1 (reduceExp env (subExpInExp (0, e') b))
+                                let
+                                    val r = subExpInExp (0, e') b
+                                in
+                                    (*Print.prefaces "doSub" [("e'", MonoPrint.p_exp env e'),
+                                                            ("b", MonoPrint.p_exp (E.pushERel env x t NONE) b),
+                                                            ("r", MonoPrint.p_exp env r)];*)
+                                    #1 (reduceExp env r)
+                                end
 
                             fun trySub () =
                                 case t of