From: Matthijs Kooijman <matthijs@stdin.nl>
Date: Tue, 18 May 2010 08:16:07 +0000 (+0200)
Subject: Move a part of β-reduction to application propagation.
X-Git-Url: https://git.stderr.nl/gitweb?a=commitdiff_plain;h=843e885ba4a4b88693256b62e593407a63141823;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git

Move a part of β-reduction to application propagation.
---

diff --git "a/c\316\273ash/CLasH/Normalize.hs" "b/c\316\273ash/CLasH/Normalize.hs"
index 977cc0d..dc9606c 100644
--- "a/c\316\273ash/CLasH/Normalize.hs"
+++ "b/c\316\273ash/CLasH/Normalize.hs"
@@ -72,15 +72,22 @@ beta :: Transform
 -- substitution.
 beta c (App (Lam x expr) arg) | CoreSyn.isTyVar x = setChanged >> substitute x arg c expr
                               | otherwise         = setChanged >> substitute_clone x arg c expr
+-- Leave all other expressions unchanged
+beta c expr = return expr
+
+--------------------------------
+-- Application propagation
+--------------------------------
+appprop :: Transform
 -- Propagate the application into the let
-beta c (App (Let binds expr) arg) = change $ Let binds (App expr arg)
+appprop c (App (Let binds expr) arg) = change $ Let binds (App expr arg)
 -- Propagate the application into each of the alternatives
-beta c (App (Case scrut b ty alts) arg) = change $ Case scrut b ty' alts'
+appprop c (App (Case scrut b ty alts) arg) = change $ Case scrut b ty' alts'
   where 
     alts' = map (\(con, bndrs, expr) -> (con, bndrs, (App expr arg))) alts
     ty' = CoreUtils.applyTypeToArg ty arg
 -- Leave all other expressions unchanged
-beta c expr = return expr
+appprop c expr = return expr
 
 --------------------------------
 -- Case of known constructor simplification
@@ -910,6 +917,7 @@ transforms = [ ("inlinedict", inlinedict)
              , ("funextract", funextract)
              , ("eta", eta)
              , ("beta", beta)
+             , ("appprop", appprop)
              , ("castprop", castprop)
              , ("letremovesimple", letremovesimple)
              , ("letrec", letrec)