From cffaff9588c22f6572eaf751af4b94c1a10c0b3c Mon Sep 17 00:00:00 2001 From: bringert Date: Tue, 29 Nov 2005 15:56:35 +0000 Subject: [PATCH] In transfer beta reduction optimization: reduce bottom-up instead of top-down. --- src/Transfer/SyntaxToCore.hs | 10 +++++----- 1 file 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 --