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}
we'd still like foo to be inlined if rhs is small. This won't happen
with foo = bar.
-Not CSE-ing inside INLLINE also solves an annoying bug in CSE. Consider
+Not CSE-ing inside INLINE also solves an annoying bug in CSE. Consider
a worker/wrapper, in which the worker has turned into a single variable:
$wf = h
f = \x -> ...$wf...
cseExpr env (App f a) = App (cseExpr env f) (tryForCSE env a)
cseExpr evn (Note InlineMe e) = Note InlineMe e -- See Note [INLINE and NOINLINE]
cseExpr env (Note n e) = Note n (cseExpr env e)
+cseExpr env (Cast e co) = Cast (cseExpr env e) co
cseExpr env (Lam b e) = let (env', b') = addBinder env b
in Lam b' (cseExpr env' e)
cseExpr env (Let bind e) = let (env', bind') = cseBind env bind
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:" <+> 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