[commit: ghc] new-demand-to-merge: Make CSE work for case expressions too (7b64905)

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

On branch  : new-demand-to-merge

http://hackage.haskell.org/trac/ghc/changeset/7b64905a38ffed5e2d57d9c2f68f6be286a80f93

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

commit 7b64905a38ffed5e2d57d9c2f68f6be286a80f93
Author: Simon Peyton Jones <[email protected]>
Date:   Wed Jan 9 17:44:27 2013 +0000

    Make CSE work for case expressions too
    
    See Note [CSE for case expressions] in CSE.
    Seldom makes a difference, but a very simple change.

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

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

diff --git a/compiler/simplCore/CSE.lhs b/compiler/simplCore/CSE.lhs
index 18c0178..55976a2 100644
--- a/compiler/simplCore/CSE.lhs
+++ b/compiler/simplCore/CSE.lhs
@@ -170,6 +170,12 @@ Now CSE may transform to
 But the WorkerInfo for f still says $wf, which is now dead!  This won't
 happen now that we don't look inside INLINEs (which wrappers are).
 
+Note [CSE for case expressions]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Consider
+  case f x of y { pat -> ...let y = f x in ... }
+Then we can CSE the inner (f x) to y.  In fact 'case' is like a strict
+let-binding, and we can use cseRhs for dealing with the scrutinee.
 
 %************************************************************************
 %*									*
@@ -226,7 +232,7 @@ 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 (Tick t e)           = Tick t (cseExpr env e)
+cseExpr env (Tick t e)             = Tick t (cseExpr env e)
 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)
@@ -234,9 +240,10 @@ cseExpr env (Let bind e)    	   = let (env', bind') = cseBind env bind
 				     in Let bind' (cseExpr env' e)
 cseExpr env (Case scrut bndr ty alts) = Case scrut' bndr'' ty alts'
 				   where
-                                     alts' = cseAlts env' scrut' bndr bndr'' alts
-				     scrut' = tryForCSE env scrut
-				     (env', bndr') = addBinder env bndr
+                                     alts' = cseAlts env2 scrut' bndr bndr'' alts
+				     (env1, bndr') = addBinder env bndr
+                                     (env2, scrut') = cseRhs env1 (bndr', scrut)
+                                        -- Note [CSE for case expressions]
 				     bndr'' = zapIdOccInfo bndr'
 					-- The swizzling from Note [Case binders 2] may
 					-- cause a dead case binder to be alive, so we