diff options
| author | Peter Wortmann <scpmw@leeds.ac.uk> | 2015-01-19 07:57:19 -0600 |
|---|---|---|
| committer | Austin Seipp <austin@well-typed.com> | 2015-01-19 07:57:35 -0600 |
| commit | 55199a97c020761ff4bfdc06da0042e43bede697 (patch) | |
| tree | 8636cf3aa8051cbdb8da44125dec2ccbe08b9e01 /compiler/simplCore/CSE.hs | |
| parent | d839493991e508160d416311ba47b7a7e2d62aae (diff) | |
| download | haskell-55199a97c020761ff4bfdc06da0042e43bede697.tar.gz | |
Split stripTicks into expression editing and tick collection
As with stripTicksTop, this is because we often need the stripped
expression but not the ticks (at least not right away). This makes a big
difference for CSE, see #9961.
Signed-off-by: Austin Seipp <austin@well-typed.com>
Diffstat (limited to 'compiler/simplCore/CSE.hs')
| -rw-r--r-- | compiler/simplCore/CSE.hs | 10 |
1 files changed, 6 insertions, 4 deletions
diff --git a/compiler/simplCore/CSE.hs b/compiler/simplCore/CSE.hs index a30c695181..c43cbb778e 100644 --- a/compiler/simplCore/CSE.hs +++ b/compiler/simplCore/CSE.hs @@ -15,7 +15,7 @@ import Var ( Var ) import Id ( Id, idType, idInlineActivation, zapIdOccInfo ) import CoreUtils ( mkAltExpr , exprIsTrivial - , stripTicks, stripTicksTopE, mkTick, mkTicks ) + , stripTicksE, stripTicksT, stripTicksTopE, mkTick, mkTicks ) import Type ( tyConAppArgs ) import CoreSyn import Outputable @@ -190,7 +190,8 @@ cseRhs env (id',rhs) where rhs' = cseExpr env rhs - (ticks, rhs'') = stripTicks tickishFloatable rhs' + ticks = stripTicksT tickishFloatable rhs' + rhs'' = stripTicksE tickishFloatable rhs' -- We don't want to lose the source notes when a common sub -- expression gets eliminated. Hence we push all (!) of them on -- top of the replaced sub-expression. This is probably not too @@ -206,7 +207,8 @@ tryForCSE env expr | otherwise = expr' where expr' = cseExpr env expr - (ticks, expr'') = stripTicks tickishFloatable expr' + expr'' = stripTicksE tickishFloatable expr' + ticks = stripTicksT tickishFloatable expr' cseExpr :: CSEnv -> InExpr -> OutExpr cseExpr env (Type t) = Type (substTy (csEnvSubst env) t) @@ -296,7 +298,7 @@ lookupCSEnv (CS { cs_map = csmap }) expr extendCSEnv :: CSEnv -> OutExpr -> Id -> CSEnv extendCSEnv cse expr id = cse { cs_map = extendCoreMap (cs_map cse) sexpr (sexpr,id) } - where (_, sexpr) = stripTicks tickishFloatable expr + where sexpr = stripTicksE tickishFloatable expr csEnvSubst :: CSEnv -> Subst csEnvSubst = cs_subst |