X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FsimplCore%2FCSE.lhs;h=54490f4aff52bcac0d8df1fc513971f9fe18c0b8;hb=63f6b0868f4948232f87bc4df52c9d3a2ec8f184;hp=8b5825bf6a9d9f37eda8da1b02efe71e20546c8f;hpb=9bcd95bad83ee937c178970e8b729732e680fe1e;p=ghc-hetmet.git diff --git a/compiler/simplCore/CSE.lhs b/compiler/simplCore/CSE.lhs index 8b5825b..54490f4 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 @@ -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 @@ -239,7 +239,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 +342,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