From 843e885ba4a4b88693256b62e593407a63141823 Mon Sep 17 00:00:00 2001 From: Matthijs Kooijman Date: Tue, 18 May 2010 10:16:07 +0200 Subject: [PATCH] =?utf8?q?Move=20a=20part=20of=20=CE=B2-reduction=20to=20a?= =?utf8?q?pplication=20propagation.?= MIME-Version: 1.0 Content-Type: text/plain; charset=utf8 Content-Transfer-Encoding: 8bit --- "c\316\273ash/CLasH/Normalize.hs" | 14 +++++++++++--- 1 file changed, 11 insertions(+), 3 deletions(-) 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) -- 2.30.2