# HG changeset patch
# User Adam Chlipala <adam@chlipala.net>
# Date 1370635912 14400
# Node ID 0480b8f29a479b738d122da382626baa97b5b385
# Parent  bddd0ec5d3dac2b3923c5830f1026a528383b0b7
Undo 'let' inlining tweak; improve optimization of 'case' of type 'transaction'

diff -r bddd0ec5d3da -r 0480b8f29a47 src/mono_reduce.sml
--- a/src/mono_reduce.sml	Sun Jun 02 10:17:52 2013 -0400
+++ b/src/mono_reduce.sml	Fri Jun 07 16:11:52 2013 -0400
@@ -564,19 +564,16 @@
                                 #1 (reduceExp env r)
                             end
 
-                        fun trySub pure =
+                        fun trySub () =
                             ((*Print.prefaces "trySub"
                                             [("e", MonoPrint.p_exp env (e, ErrorMsg.dummySpan))];*)
                              case t of
                                  (TFfi ("Basis", "string"), _) => doSub ()
                                | (TSignal _, _) => e
                                | _ =>
-                                 if pure then
-                                     doSub ()
-                                 else
-                                     case e' of
-                                         (ECase _, _) => e
-                                       | _ => doSub ())
+                                 case e' of
+                                     (ECase _, _) => e
+                                   | _ => doSub ())
                     in
                         if impure env e' then
                             let
@@ -631,14 +628,14 @@
                                               | _ => false))
                                    andalso countFree 0 0 b = 1
                                    andalso not (freeInAbs b) then
-                                    trySub (List.null effs_e')
+                                    trySub ()
                                 else
                                     e
                             end
                         else if countFree 0 0 b > 1 andalso not (!fullMode) andalso not (passive e') then
                             e
                         else
-                            trySub true
+                            trySub ()
                     end
 
                 val r =
@@ -669,11 +666,14 @@
                                 case result of
                                     (TFun (dom, result), loc) =>
                                     let
-                                        fun safe (e, _) =
-                                            case e of
-                                                EAbs _ => true
-                                              | EError _ => true
-                                              | _ => false
+                                        fun safe e =
+                                            List.all (fn UseRel => true
+                                                       | Abort => true
+                                                       | _ => false) (summarize 0 e)
+
+                                        fun p_events' es = Print.box [Print.PD.string "{",
+                                                                      p_events es,
+                                                                      Print.PD.string "}"]
                                     in
                                         if List.all (safe o #2) pes then
                                             EAbs ("y", dom, result,
@@ -682,7 +682,10 @@
                                                                   (p, swapExpVarsPat (0, patBinds p) e)
                                                                 | (p, (EError (e, (TFun (_, t), _)), loc)) =>
                                                                   (p, (EError (e, t), loc))
-                                                                | _ => raise Fail "MonoReduce ECase") pes,
+                                                                | (p, e) =>
+                                                                  (p, (EApp (liftExpInExp (patBinds p) e,
+                                                                             (ERel (patBinds p), loc)), loc)))
+                                                              pes,
                                                           {disc = disc, result = result}), loc))
                                         else
                                             e