Add letremoveunused transformation.
authorMatthijs Kooijman <m.kooijman@student.utwente.nl>
Thu, 6 Aug 2009 13:56:44 +0000 (15:56 +0200)
committerMatthijs Kooijman <m.kooijman@student.utwente.nl>
Thu, 6 Aug 2009 13:56:44 +0000 (15:56 +0200)
This transformation removes all unused let bindings.

cλash/CLasH/Normalize.hs

index 8b35bb986bd4265df2ec58e6988fc21f04fe64de..647bd1902592c46db67c132a9ff744901a82b971 100644 (file)
@@ -157,6 +157,24 @@ letflattop = everywhere ("letflat", letflat)
 letremovetop :: Transform
 letremovetop = everywhere ("letremove", inlinebind (\(b, e) -> Trans.lift $ is_local_var e))
 
+--------------------------------
+-- Unused let binding removal
+--------------------------------
+letremoveunused, letremoveunusedtop :: Transform
+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) (Let (Rec binds') res)
+    where
+      bound_exprs = map snd binds
+      -- For each bind check if the bind is used by res or any of the bound
+      -- expressions
+      dobind (bndr, _) = not $ any (expr_uses_binders [bndr]) (res:bound_exprs)
+-- Leave all other expressions unchanged
+letremoveunused expr = return expr
+letremoveunusedtop = everywhere ("letremoveunused", letremoveunused)
+
 --------------------------------
 -- Function inlining
 --------------------------------
@@ -473,7 +491,7 @@ funextracttop = everywhere ("funextract", funextract)
 
 
 -- What transforms to run?
-transforms = [argproptop, funextracttop, etatop, betatop, castproptop, letremovetop, letrectop, letsimpltop, letflattop, scrutsimpltop, casesimpltop, caseremovetop, inlinenonreptop, appsimpltop]
+transforms = [argproptop, funextracttop, etatop, betatop, castproptop, letremovetop, letrectop, letsimpltop, letflattop, scrutsimpltop, casesimpltop, caseremovetop, inlinenonreptop, appsimpltop, letremoveunusedtop]
 
 -- | Returns the normalized version of the given function.
 getNormalized ::