Improve transferPolyIdInfo for value-arg abstraction

[ghc-hetmet.git] / compiler / simplCore / CSE.lhs

diff --git a/compiler/simplCore/CSE.lhs b/compiler/simplCore/CSE.lhs
index 90bd421..d4aef90 100644 (file)
--- a/compiler/simplCore/CSE.lhs
+++ b/compiler/simplCore/CSE.lhs
@@ -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 
 
 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 an InlineRule
+       a) we do not do CSE inside (Note InlineMe e)

 
        b) we do not do CSE on the RHS of a binding b=e
           unless b's InlinePragma is AlwaysActive
 
        b) we do not do CSE on the RHS of a binding b=e
           unless b's InlinePragma is AlwaysActive

@@ -218,6 +218,7 @@ 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 _   (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
 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

@@ -341,7 +342,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)
 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
   | otherwise                        = WARN( True, ppr v )
                                        (CS emptyUFM in_scope                 sub,                     v)
        -- This last case is the unusual situation where we have shadowing of