#include "HsVersions.h"
-import CmdLineOpts ( DynFlag(..), DynFlags, dopt )
+import CmdLineOpts ( DynFlag(..), DynFlags )
import Id ( Id, idType )
import CoreUtils ( hashExpr, cheapEqExpr, exprIsBig, mkAltExpr )
import DataCon ( isUnboxedTupleCon )
-import Type ( splitTyConApp_maybe )
+import Type ( tyConAppArgs )
import Subst ( InScopeSet, uniqAway, emptyInScopeSet,
extendInScopeSet, elemInScopeSet )
import CoreSyn
import VarEnv
-import CoreLint ( beginPass, endPass )
+import CoreLint ( showPass, endPass )
import Outputable
-import Util ( mapAccumL )
+import Util ( mapAccumL, lengthExceeds )
import UniqFM
\end{code}
cseProgram dflags binds
= do {
- beginPass dflags "Common sub-expression";
+ showPass dflags "Common sub-expression";
let { binds' = cseBinds emptyCSEnv binds };
- endPass dflags "Common sub-expression"
- (dopt Opt_D_dump_cse dflags || dopt Opt_D_verbose_core2core dflags)
- binds'
+ endPass dflags "Common sub-expression" Opt_D_dump_cse binds'
}
cseBinds :: CSEnv -> [CoreBind] -> [CoreBind]
other -> (bndr', extendCSEnv env bndr' scrut') -- See "yet another wrinkle"
-- map: scrut' -> bndr'
- arg_tys = case splitTyConApp_maybe (idType bndr) of
- Just (_, arg_tys) -> arg_tys
- other -> pprPanic "cseAlts" (ppr bndr)
+ arg_tys = tyConAppArgs (idType bndr)
cse_alt (DataAlt con, args, rhs)
| not (null args || isUnboxedTupleCon con)
addCSEnvItem env id expr | exprIsBig expr = env
| otherwise = extendCSEnv env id expr
+ -- We don't try to CSE big expressions, because they are expensive to compare
+ -- (and are unlikely to be the same anyway)
extendCSEnv (CS cs in_scope sub) id expr
= CS (addToUFM_C combine cs hash [(id, expr)]) in_scope sub
where
hash = hashExpr expr
- combine old new = WARN( length result > 4, text "extendCSEnv: long list:" <+> ppr result )
+ combine old new = WARN( result `lengthExceeds` 4, text "extendCSEnv: long list:" <+> ppr result )
result
where
result = new ++ old