Move a part of β-reduction to application propagation.

[matthijs/master-project/cλash.git] / cλash / CLasH / Normalize.hs

diff --git a/cλash/CLasH/Normalize.hs b/cλash/CLasH/Normalize.hs
index dc3c0c2052141045c09b53f6af5af42012a50d6d..dc9606c756238d312ae2f8888b57efe660d38dbe 100644 (file)
--- a/cλash/CLasH/Normalize.hs
+++ b/cλash/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)
@@ -968,13 +976,14 @@ normalizeExpr ::
 normalizeExpr what expr = do
       startcount <- MonadState.get tsTransformCounter 
       expr_uniqued <- genUniques expr
+      -- Do a debug print, if requested
+      let expr_uniqued' = Utils.traceIf (normalize_debug >= NormDbgFinal) (what ++ " before normalization:\n\n" ++ showSDoc ( ppr expr_uniqued ) ++ "\n") expr_uniqued
       -- Normalize this expression
-      trace (what ++ " before normalization:\n\n" ++ showSDoc ( ppr expr_uniqued ) ++ "\n") $ return ()
-      expr' <- dotransforms transforms expr_uniqued
+      expr' <- dotransforms transforms expr_uniqued'
       endcount <- MonadState.get tsTransformCounter 
-      trace ("\n" ++ what ++ " after normalization:\n\n" ++ showSDoc ( ppr expr')
-             ++ "\nNeeded " ++ show (endcount - startcount) ++ " transformations to normalize " ++ what) $
-       return expr'
+      -- Do a debug print, if requested
+      Utils.traceIf (normalize_debug >= NormDbgFinal)  (what ++ " after normalization:\n\n" ++ showSDoc ( ppr expr') ++ "\nNeeded " ++ show (endcount - startcount) ++ " transformations to normalize " ++ what) $
+        return expr'
 
 -- | Split a normalized expression into the argument binders, top level
 --   bindings and the result binder. This function returns an error if