X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FsimplCore%2FCSE.lhs;h=8c386614c6e6f05a6da186a92a48e96b0040376d;hp=9b902201555b8a4a30f765c74d2f8ad0cc267b05;hb=72462499b891d5779c19f3bda03f96e24f9554ae;hpb=e79c9ce01d0ce4412bd4bcd99c8c728a6a2ec569 diff --git a/compiler/simplCore/CSE.lhs b/compiler/simplCore/CSE.lhs index 9b90220..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 ) @@ -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 @@ -342,7 +341,7 @@ 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