# HG changeset patch
# User Karn Kallio <kkallio@eka>
# Date 1313126757 16200
# Node ID 75d77fbe7c94f982645179c3147b7512940a36e7
# Parent  7ef09e91198b06691ecc95563c72a4bd8e5c70a5
Distribute applications of "arrow type" ECase across branches.

diff -r 7ef09e91198b -r 75d77fbe7c94 src/reduce.sml
--- a/src/reduce.sml	Wed Aug 10 18:39:27 2011 -0400
+++ b/src/reduce.sml	Fri Aug 12 00:55:57 2011 -0430
@@ -371,6 +371,15 @@
                          else
                              ()*)
 
+                fun patBinds (p, _) =
+                    case p of
+                        PWild => 0
+                      | PVar _ => 1
+                      | PPrim _ => 0
+                      | PCon (_, _, _, NONE) => 0
+                      | PCon (_, _, _, SOME p) => patBinds p
+                      | PRecord xpts => foldl (fn ((_, p, _), n) => n + patBinds p) 0 xpts
+
                 val r = case e of
                             EPrim _ => all
                           | ERel n =>
@@ -458,6 +467,20 @@
                                                                ("r", CorePrint.p_exp CoreEnv.empty r)];*)
                                         r
                                     end
+                                  | ECase (e, pes, cc as {disc, result = res as (TFun (_, c2), _)}) =>
+                                    let
+                                        val pes' = map (fn (p, body) =>
+                                                           let
+                                                               val env' = List.tabulate (patBinds p, fn _ => UnknownE) @ (deKnown env)
+                                                               val body' = exp env' (EApp (body, multiLiftExpInExp (patBinds p) e2), #2 body)
+                                                           in
+                                                               (p, body')
+                                                           end) pes
+
+                                        val cc' = {disc = disc, result = c2}
+                                    in
+                                        (ECase (e, pes', cc'), loc)
+                                    end
                                   | _ => (EApp (e1, e2), loc)
                             end
 
@@ -480,6 +503,22 @@
                                                                ("r", CorePrint.p_exp CoreEnv.empty r)];*)
                                         r
                                     end
+                                  | ECase (e, pes, cc as {disc, result = res as (TCFun (_, _, c'), _)}) =>
+                                    let
+                                        val pes' = map (fn (p, body) =>
+                                                        let
+                                                            val env' = List.tabulate (patBinds p, fn _ => UnknownE) @ (deKnown env)
+
+                                                            val body' = exp env' (ECApp (body, c), #2 body)
+                                                        in
+                                                            (p, body')
+                                                        end) pes
+
+                                        val c' = E.subConInCon (0, c) c'
+                                        val cc' = {disc = disc, result = c'}
+                                    in
+                                        (ECase (e, pes', cc'), loc)
+                                    end
                                   | _ => (ECApp (e, c), loc)
                             end
 
@@ -611,15 +650,6 @@
 
                           | ECase (e, pes, {disc, result}) =>
                             let
-                                fun patBinds (p, _) =
-                                    case p of
-                                        PWild => 0
-                                      | PVar _ => 1
-                                      | PPrim _ => 0
-                                      | PCon (_, _, _, NONE) => 0
-                                      | PCon (_, _, _, SOME p) => patBinds p
-                                      | PRecord xpts => foldl (fn ((_, p, _), n) => n + patBinds p) 0 xpts
-
                                 fun pat (all as (p, loc)) =
                                     case p of
                                         PWild => all