diff options
Diffstat (limited to 'compiler/simplCore/CSE.lhs')
| -rw-r--r-- | compiler/simplCore/CSE.lhs | 30 |
1 files changed, 1 insertions, 29 deletions
diff --git a/compiler/simplCore/CSE.lhs b/compiler/simplCore/CSE.lhs index 4a92f818d4..18c0178900 100644 --- a/compiler/simplCore/CSE.lhs +++ b/compiler/simplCore/CSE.lhs @@ -38,8 +38,7 @@ import CoreSubst import Var ( Var ) import Id ( Id, idType, idInlineActivation, zapIdOccInfo ) import CoreUtils ( mkAltExpr - , exprIsTrivial, exprIsCheap ) -import DataCon ( isUnboxedTupleCon ) + , exprIsTrivial) import Type ( tyConAppArgs ) import CoreSyn import Outputable @@ -112,19 +111,6 @@ to the reverse CSE mapping if the scrutinee is a non-trivial expression. case binder -> scrutinee to the substitution -Note [Unboxed tuple case binders] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Consider - case f x of t { (# a,b #) -> - case ... of - True -> f x - False -> 0 } - -We must not replace (f x) by t, because t is an unboxed-tuple binder. -Instead, we shoudl replace (f x) by (# a,b #). That is, the "reverse mapping" is - f x --> (# a,b #) -That is why the CSEMap has pairs of expressions. - Note [CSE for INLINE and NOINLINE] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ We are careful to do no CSE inside functions that the user has marked as @@ -258,20 +244,6 @@ cseExpr env (Case scrut bndr ty alts) = Case scrut' bndr'' ty alts' cseAlts :: CSEnv -> OutExpr -> InBndr -> InBndr -> [InAlt] -> [OutAlt] -cseAlts env scrut' bndr _bndr' [(DataAlt con, args, rhs)] - | isUnboxedTupleCon con - -- Unboxed tuples are special because the case binder isn't - -- a real value. See Note [Unboxed tuple case binders] - = [(DataAlt con, args'', tryForCSE new_env rhs)] - where - (env', args') = addBinders env args - args'' = map zapIdOccInfo args' -- They should all be ids - -- Same motivation for zapping as [Case binders 2] only this time - -- it's Note [Unboxed tuple case binders] - new_env | exprIsCheap scrut' = env' - | otherwise = extendCSEnv env' scrut' tup_value - tup_value = mkAltExpr (DataAlt con) args'' (tyConAppArgs (idType bndr)) - cseAlts env scrut' bndr bndr' alts = map cse_alt alts where |