X-Git-Url: https://git.stderr.nl/gitweb?a=blobdiff_plain;f=c%CE%BBash%2FCLasH%2FNormalize.hs;h=192ed55cf0500c1655fb9b1adba6c3a79512d596;hb=60174903a7e142bf05586c24498b7e064a7118ff;hp=a7223e3d8d0433ca55f21a3c5e7a729afb63a4d2;hpb=a0c0376c707a66ac50485faab6f7e4cec2725bf4;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git diff --git "a/c\316\273ash/CLasH/Normalize.hs" "b/c\316\273ash/CLasH/Normalize.hs" index a7223e3..192ed55 100644 --- "a/c\316\273ash/CLasH/Normalize.hs" +++ "b/c\316\273ash/CLasH/Normalize.hs" @@ -248,13 +248,17 @@ letremovesimpletop = everywhere ("letremovesimple", inlinebind (\(b, e) -> Trans -- Unused let binding removal -------------------------------- letremoveunused, letremoveunusedtop :: Transform -letremoveunused expr@(Let _ _) = do +letremoveunused expr@(Let (NonRec b bound) res) = do + let used = expr_uses_binders [b] res + if used + then return expr + else change res +letremoveunused expr@(Let (Rec binds) res) = do -- Filter out all unused binds. let binds' = filter dobind binds -- Only set the changed flag if binds got removed - changeif (length binds' /= length binds) (mkNonRecLets binds' res) + changeif (length binds' /= length binds) (Let (Rec binds') res) where - (binds, res) = flattenLets expr bound_exprs = map snd binds -- For each bind check if the bind is used by res or any of the bound -- expressions @@ -263,6 +267,7 @@ letremoveunused expr@(Let _ _) = do letremoveunused expr = return expr letremoveunusedtop = everywhere ("letremoveunused", letremoveunused) +{- -------------------------------- -- Identical let binding merging -------------------------------- @@ -293,7 +298,8 @@ letmerge expr@(Let _ _) = do -- Leave all other expressions unchanged letmerge expr = return expr letmergetop = everywhere ("letmerge", letmerge) - +-} + -------------------------------- -- Function inlining -------------------------------- @@ -610,7 +616,7 @@ funextracttop = everywhere ("funextract", funextract) -- What transforms to run? -transforms = [argproptop, funextracttop, etatop, betatop, castproptop, letremovesimpletop, letderectop, letremovetop, letsimpltop, letflattop, scrutsimpltop, casesimpltop, caseremovetop, inlinenonreptop, appsimpltop, letmergetop, letremoveunusedtop, castsimpltop, lambdasimpltop] +transforms = [argproptop, funextracttop, etatop, betatop, castproptop, letremovesimpletop, letderectop, letremovetop, letsimpltop, letflattop, scrutsimpltop, casesimpltop, caseremovetop, inlinenonreptop, appsimpltop, letremoveunusedtop, castsimpltop, lambdasimpltop] -- | Returns the normalized version of the given function. getNormalized ::