In transfer beta reduction optimization: reduce bottom-up instead of top-down.

1 files changed, 5 insertions, 5 deletions

diff --git a/src/Transfer/SyntaxToCore.hs b/src/Transfer/SyntaxToCore.hs
index 637623c83..f849bbcfb 100644
--- a/src/Transfer/SyntaxToCore.hs
+++ b/src/Transfer/SyntaxToCore.hs
@@ -200,10 +200,7 @@ replaceCons ds = mapM f ds
         -- redexes produced here.
         EVar id | isCons id -> do
                                let Just n = Map.lookup id cs
-                               -- abstract n (apply t)
-                               vs <- freshIdents n
-                               let c = apply t (map EVar vs)
-                               return $ foldr (EAbs . VVar) c vs
+                               abstract n (apply t)
         _ -> composOpM f t
 
 --
@@ -215,7 +212,10 @@ betaReduce = return . map f
  where
  f :: Tree a -> Tree a
  f t = case t of
-              EApp (EAbs (VVar x) b) e | countFreeOccur x b == 1 -> f (subst x e b)
+              EApp e1 e2 -> 
+                  case (f e1, f e2) of
+                       (EAbs (VVar x) b, e) | countFreeOccur x b == 1 -> f (subst x e b)
+                       (e1',e2') -> EApp e1' e2'
               _ -> composOp f t
 
 --