X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FsimplCore%2FCSE.lhs;h=8c386614c6e6f05a6da186a92a48e96b0040376d;hp=8b5825bf6a9d9f37eda8da1b02efe71e20546c8f;hb=72462499b891d5779c19f3bda03f96e24f9554ae;hpb=9bcd95bad83ee937c178970e8b729732e680fe1e diff --git a/compiler/simplCore/CSE.lhs b/compiler/simplCore/CSE.lhs index 8b5825b..8c38661 100644 --- a/compiler/simplCore/CSE.lhs +++ b/compiler/simplCore/CSE.lhs @@ -10,7 +10,7 @@ module CSE ( #include "HsVersions.h" -import Id ( Id, idType, idInlinePragma, zapIdOccInfo ) +import Id ( Id, idType, idInlineActivation, zapIdOccInfo ) import CoreUtils ( hashExpr, cheapEqExpr, exprIsBig, mkAltExpr, exprIsCheap ) import DataCon ( isUnboxedTupleCon ) import Type ( tyConAppArgs ) @@ -49,8 +49,8 @@ So we carry an extra var->var substitution which we apply *before* looking up in reverse mapping. -[Note: SHADOWING] -~~~~~~~~~~~~~~~~~ +Note [Shadowing] +~~~~~~~~~~~~~~~~ We have to be careful about shadowing. For example, consider f = \x -> let y = x+x in @@ -114,7 +114,7 @@ Note [CSE for INLINE and NOINLINE] We are careful to do no CSE inside functions that the user has marked as INLINE or NOINLINE. In terms of Core, that means - a) we do not do CSE inside (Note InlineMe e) + a) we do not do CSE inside an InlineRule b) we do not do CSE on the RHS of a binding b=e unless b's InlinePragma is AlwaysActive @@ -201,8 +201,8 @@ do_one env (id, rhs) Nothing -> (addCSEnvItem env' rhs' (Var id'), (id', rhs')) where (env', id') = addBinder env id - rhs' | isAlwaysActive (idInlinePragma id) = cseExpr env' rhs - | otherwise = rhs + rhs' | isAlwaysActive (idInlineActivation id) = cseExpr env' rhs + | otherwise = rhs -- See Note [CSE for INLINE and NOINLINE] tryForCSE :: CSEnv -> CoreExpr -> CoreExpr @@ -218,7 +218,6 @@ cseExpr _ (Type t) = Type t cseExpr _ (Lit lit) = Lit lit cseExpr env (Var v) = Var (lookupSubst env v) cseExpr env (App f a) = App (cseExpr env f) (tryForCSE env a) -cseExpr _ (Note InlineMe e) = Note InlineMe e -- See Note [CSE for 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 @@ -239,7 +238,7 @@ cseAlts :: CSEnv -> CoreExpr -> CoreBndr -> CoreBndr -> [CoreAlt] -> [CoreAlt] 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 @@ -342,12 +341,12 @@ extendSubst (CS cs in_scope sub) x y = CS cs in_scope (extendVarEnv sub x y) 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