\section{Common subexpression}
\begin{code}
+{-# OPTIONS -w #-}
+-- The above warning supression flag is a temporary kludge.
+-- While working on this module you are encouraged to remove it and fix
+-- any warnings in the module. See
+-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
+-- for details
+
module CSE (
cseProgram
) where
import VarEnv
import CoreLint ( showPass, endPass )
import Outputable
+import StaticFlags ( opt_PprStyle_Debug )
import BasicTypes ( isAlwaysActive )
-import Util ( mapAccumL, lengthExceeds )
+import Util ( lengthExceeds )
import UniqFM
+
+import Data.List
\end{code}
a worker/wrapper, in which the worker has turned into a single variable:
$wf = h
f = \x -> ...$wf...
-Now CSE may transoform to
+Now CSE may transform to
f = \x -> ...h...
But the WorkerInfo for f still says $wf, which is now dead! This won't
happen now that we don't look inside INLINEs (which wrappers are).
extendCSEnv (CS cs in_scope sub) expr expr'
= CS (addToUFM_C combine cs hash [(expr, expr')]) in_scope sub
where
- hash = hashExpr expr
- combine old new = WARN( result `lengthExceeds` 4, ((text "extendCSEnv: long list (length" <+> int (length result) <> comma
- <+> text "hash code" <+> text (show hash) <> char ')')
- $$ nest 4 (ppr result)) )
- result
- where
- result = new ++ old
+ hash = hashExpr expr
+ combine old new
+ = WARN( result `lengthExceeds` 4, short_msg $$ nest 2 long_msg ) result
+ where
+ result = new ++ old
+ short_msg = ptext SLIT("extendCSEnv: long list, length") <+> int (length result)
+ long_msg | opt_PprStyle_Debug = (text "hash code" <+> text (show hash)) $$ ppr result
+ | otherwise = empty
lookupSubst (CS _ _ sub) x = case lookupVarEnv sub x of
Just y -> y
addBinder env@(CS cs in_scope sub) v
| not (v `elemInScopeSet` in_scope) = (CS cs (extendInScopeSet in_scope v) sub, v)
| isId v = (CS cs (extendInScopeSet in_scope v') (extendVarEnv sub v v'), v')
- | not (isId v) = WARN( True, ppr v )
+ | otherwise = WARN( True, ppr v )
(CS emptyUFM in_scope sub, v)
-- This last case is the unusual situation where we have shadowing of
-- a type variable; we have to discard the CSE mapping