Reduce Uncurry when possible

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)

diff --git a/Term2Expr.hs b/Term2Expr.hs
index 0d236f0..be07e65 100644 (file)
--- a/Term2Expr.hs
+++ b/Term2Expr.hs
@@ -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