Reduce Uncurry when possible
authorJoachim Breitner <mail@joachim-breitner.de>
Fri, 14 Nov 2008 17:06:51 +0000 (17:06 +0000)
committerJoachim Breitner <mail@joachim-breitner.de>
Fri, 14 Nov 2008 17:06:51 +0000 (17:06 +0000)
Expr.hs
Term2Expr.hs

diff --git a/Expr.hs b/Expr.hs
index 33e4c1a..5c77715 100644 (file)
--- a/Expr.hs
+++ b/Expr.hs
@@ -299,6 +299,8 @@ app te1 te2 | otherwise                          = error $ "Type mismatch in app
 app' :: Expr -> Expr -> Expr
 app' (App HeadMap f) Bottom                 = Bottom
 app' (App HeadMap f) (Singleton e)          = app' f e
+app' (App Uncurry _) Bottom                 = Bottom
+app' (App Uncurry f) (Pair v1 v2)           = f `app'` v1 `app'` v2
 app' (App (App EitherMap f1) f2) Bottom     = Bottom
 app' (App (App EitherMap f1) f2) (ELeft v)  = ELeft (app' f1 v)
 app' (App (App EitherMap f1) f2) (ERight v) = ERight (app' f2 v)
index 0d236f0..be07e65 100644 (file)
@@ -78,11 +78,12 @@ absTerm2Expr ex (T.ECase e vl el vr er)
                                    (absTerm2Expr ex e)
 absTerm2Expr ex (T.Right t)     = ERight (absTerm2Expr ex t)
 absTerm2Expr ex (T.Left  t)     = ELeft (absTerm2Expr ex t)
-absTerm2Expr ex (T.PCase pt v1 v2 e) = Uncurry `app'`
+absTerm2Expr ex (T.PCase pt v1 v2 e) = app' (app'
+                               Uncurry
                                (lambda' (E.Var (termVar2EVar v1))
                                          (lambda' (E.Var (termVar2EVar v2))
-                                                  (absTerm2Expr ex e)))
-                                `app'` (absTerm2Expr ex pt)
+                                                  (absTerm2Expr ex e))))
+                                (absTerm2Expr ex pt)
 
 termVar2EVar (T.TermVar i) = E.FromTypVar i