[commit: ghc] master: Remember to substitute for type and coercion variables in the CSE pass (ff47403)

[Simon Peyton Jones]

Repository : ssh://darcs.haskell.org//srv/darcs/ghc

On branch  : master

http://hackage.haskell.org/trac/ghc/changeset/ff47403f2b2bac335c7ca8a79cec1381f7482e20

>---------------------------------------------------------------

commit ff47403f2b2bac335c7ca8a79cec1381f7482e20
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date:   Wed Jul 27 12:34:48 2011 +0100

    Remember to substitute for type and coercion variables in the CSE pass

>---------------------------------------------------------------

 compiler/simplCore/CSE.lhs |   25 ++++++++++++++-----------
 1 files changed, 14 insertions(+), 11 deletions(-)

diff --git a/compiler/simplCore/CSE.lhs b/compiler/simplCore/CSE.lhs
index 1f615cb..6a287f4 100644
--- a/compiler/simplCore/CSE.lhs
+++ b/compiler/simplCore/CSE.lhs
@@ -13,7 +13,8 @@ module CSE (
 import CoreSubst
 import Var		( Var )
 import Id		( Id, idType, idInlineActivation, zapIdOccInfo )
-import CoreUtils	( hashExpr, eqExpr, exprIsBig, mkAltExpr, exprIsCheap )
+import CoreUtils	( hashExpr, eqExpr, exprIsBig, mkAltExpr
+                        , exprIsTrivial, exprIsCheap )
 import DataCon		( isUnboxedTupleCon )
 import Type		( tyConAppArgs )
 import CoreSyn
@@ -206,22 +207,21 @@ cseRhs env (id',rhs)
 		-- See Note [CSE for INLINE and NOINLINE]
 
 tryForCSE :: CSEnv -> InExpr -> OutExpr
-tryForCSE _   (Type t) = Type t
-tryForCSE _   (Coercion c) = Coercion c
-tryForCSE env expr     = case lookupCSEnv env expr' of
-			    Just smaller_expr -> smaller_expr
- 			    Nothing  	      -> expr'
-		       where
-	 	         expr' = cseExpr env expr
+tryForCSE env expr
+  | exprIsTrivial expr'                   = expr'	-- No point
+  | Just smaller <- lookupCSEnv env expr' = smaller
+  | otherwise                             = expr'
+  where
+    expr' = cseExpr env expr
 
 cseExpr :: CSEnv -> InExpr -> OutExpr
-cseExpr _   (Type t)               = Type t
-cseExpr _   (Coercion co)          = Coercion co
+cseExpr env (Type t)               = Type (substTy (csEnvSubst env) t)
+cseExpr env (Coercion c)           = Coercion (substCo (csEnvSubst env) c)
 cseExpr _   (Lit lit)              = Lit lit
 cseExpr env (Var v)		   = lookupSubst env v
 cseExpr env (App f a)        	   = App (cseExpr env f) (tryForCSE env a)
 cseExpr env (Note n e)       	   = Note n (cseExpr env e)
-cseExpr env (Cast e co)            = Cast (cseExpr env e) co
+cseExpr env (Cast e co)            = Cast (cseExpr env e) (substCo (csEnvSubst env) co)
 cseExpr env (Lam b e)	     	   = let (env', b') = addBinder env b
 				     in Lam b' (cseExpr env' e)
 cseExpr env (Let bind e)    	   = let (env', bind') = cseBind env bind
@@ -309,6 +309,9 @@ type CSEMap = UniqFM [(OutExpr, OutExpr)]	-- This is the reverse mapping
 emptyCSEnv :: CSEnv
 emptyCSEnv = CS emptyUFM emptySubst
 
+csEnvSubst :: CSEnv -> Subst
+csEnvSubst (CS _ subst) = subst
+
 lookupCSEnv :: CSEnv -> OutExpr -> Maybe OutExpr
 lookupCSEnv (CS cs sub) expr
   = case lookupUFM cs (hashExpr expr) of