From c6f6a629256d7292ae7c18428656eda4130391bd Mon Sep 17 00:00:00 2001
From: Adam Chlipala <adamc@hcoop.net>
Date: Thu, 30 Oct 2008 15:39:06 -0400
Subject: Don't inline case expressions

---
 src/mono_reduce.sml | 91 ++++++++++++++++++++++++++++-------------------------
 1 file changed, 49 insertions(+), 42 deletions(-)

(limited to 'src')

diff --git a/src/mono_reduce.sml b/src/mono_reduce.sml
index f88bea8f..07c7c5f5 100644
--- a/src/mono_reduce.sml
+++ b/src/mono_reduce.sml
@@ -351,49 +351,56 @@ fun exp env e =
                 EAbs (x', t', ran, (ELet (x, t, liftExpInExp 0 e, swapExpVars 0 e'), loc))
 
               | ELet (x, t, e', b) =>
-                if impure e' then
-                    let
-                        val effs_e' = summarize 0 e'
-                        val effs_b = summarize 0 b
-
-                        fun does eff = List.exists (fn eff' => eff' = eff) effs_e'
-                        val writesPage = does WritePage
-                        val readsDb = does ReadDb
-                        val writesDb = does WriteDb
-
-                        fun verifyUnused eff =
-                            case eff of
-                                UseRel r => r <> 0
-                              | Unsure => false
-                              | _ => true
-
-                        fun verifyCompatible effs =
-                            case effs of
-                                [] => false
-                              | eff :: effs =>
+                let
+                    fun trySub () =
+                        case e' of
+                            (ECase _, _) => e
+                          | _ => #1 (reduceExp env (subExpInExp (0, e') b))
+                in
+                    if impure e' then
+                        let
+                            val effs_e' = summarize 0 e'
+                            val effs_b = summarize 0 b
+
+                            fun does eff = List.exists (fn eff' => eff' = eff) effs_e'
+                            val writesPage = does WritePage
+                            val readsDb = does ReadDb
+                            val writesDb = does WriteDb
+
+                            fun verifyUnused eff =
                                 case eff of
-                                    Unsure => false
-                                  | UseRel r =>
-                                    if r = 0 then
-                                        List.all verifyUnused effs
-                                    else
-                                        verifyCompatible effs
-                                  | WritePage => not writesPage andalso verifyCompatible effs
-                                  | ReadDb => not writesDb andalso verifyCompatible effs
-                                  | WriteDb => not writesDb andalso not readsDb andalso verifyCompatible effs
-                    in
-                        (*Print.prefaces "verifyCompatible"
-                                         [("e'", MonoPrint.p_exp env e'),
-                                          ("b", MonoPrint.p_exp (E.pushERel env x t NONE) b),
-                                          ("effs_e'", Print.p_list p_event effs_e'),
-                                          ("effs_b", Print.p_list p_event effs_b)];*)
-                        if verifyCompatible effs_b then
-                            #1 (reduceExp env (subExpInExp (0, e') b))
-                        else
-                            e
-                    end
-                else
-                    #1 (reduceExp env (subExpInExp (0, e') b))
+                                    UseRel r => r <> 0
+                                  | Unsure => false
+                                  | _ => true
+
+                            fun verifyCompatible effs =
+                                case effs of
+                                    [] => false
+                                  | eff :: effs =>
+                                    case eff of
+                                        Unsure => false
+                                      | UseRel r =>
+                                        if r = 0 then
+                                            List.all verifyUnused effs
+                                        else
+                                            verifyCompatible effs
+                                      | WritePage => not writesPage andalso verifyCompatible effs
+                                      | ReadDb => not writesDb andalso verifyCompatible effs
+                                      | WriteDb => not writesDb andalso not readsDb andalso verifyCompatible effs
+                        in
+                            (*Print.prefaces "verifyCompatible"
+                                             [("e'", MonoPrint.p_exp env e'),
+                                              ("b", MonoPrint.p_exp (E.pushERel env x t NONE) b),
+                                              ("effs_e'", Print.p_list p_event effs_e'),
+                                              ("effs_b", Print.p_list p_event effs_b)];*)
+                            if verifyCompatible effs_b then
+                                trySub ()
+                            else
+                                e
+                        end
+                    else
+                        trySub ()
+                end
 
               | EStrcat ((EPrim (Prim.String s1), _), (EPrim (Prim.String s2), _)) =>
                 EPrim (Prim.String (s1 ^ s2))
-- 
cgit v1.2.3