#include "HsVersions.h"
-import DynFlags ( DynFlag(..), DynFlags )
import Id ( Id, idType, idInlinePragma, zapIdOccInfo )
import CoreUtils ( hashExpr, cheapEqExpr, exprIsBig, mkAltExpr, exprIsCheap )
import DataCon ( isUnboxedTupleCon )
import Type ( tyConAppArgs )
import CoreSyn
import VarEnv
-import CoreLint ( showPass, endPass )
import Outputable
import StaticFlags ( opt_PprStyle_Debug )
import BasicTypes ( isAlwaysActive )
reverse mapping.
-[Note: SHADOWING]
-~~~~~~~~~~~~~~~~~
+Note [Shadowing]
+~~~~~~~~~~~~~~~~
We have to be careful about shadowing.
For example, consider
f = \x -> let y = x+x in
%************************************************************************
\begin{code}
-cseProgram :: DynFlags -> [CoreBind] -> IO [CoreBind]
-
-cseProgram dflags binds
- = do {
- showPass dflags "Common sub-expression";
- let { binds' = cseBinds emptyCSEnv binds };
- endPass dflags "Common sub-expression" Opt_D_dump_cse binds'
- }
+cseProgram :: [CoreBind] -> [CoreBind]
+cseProgram binds = cseBinds emptyCSEnv binds
cseBinds :: CSEnv -> [CoreBind] -> [CoreBind]
cseBinds _ [] = []
cseAlts env scrut' bndr _bndr' [(DataAlt con, args, rhs)]
| isUnboxedTupleCon con
-- Unboxed tuples are special because the case binder isn't
- -- a real values. See Note [Unboxed tuple case binders]
+ -- a real value. See Note [Unboxed tuple case binders]
= [(DataAlt con, args'', tryForCSE new_env rhs)]
where
(env', args') = addBinders env args
addBinder :: CSEnv -> Id -> (CSEnv, Id)
addBinder (CS cs in_scope sub) v
| not (v `elemInScopeSet` in_scope) = (CS cs (extendInScopeSet in_scope v) sub, v)
- | isIdVar v = (CS cs (extendInScopeSet in_scope v') (extendVarEnv sub v v'), v')
+ | isId v = (CS cs (extendInScopeSet in_scope v') (extendVarEnv sub v v'), 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
- -- See "IMPORTANT NOTE" at the top
+ -- See Note [Shadowing]
where
v' = uniqAway in_scope v