[commit: ghc] wip/spj-early-inline2: Combine identical case alterantives in CSE (46b6ac6)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : wip/spj-early-inline2
Link       : http://ghc.haskell.org/trac/ghc/changeset/46b6ac610237c696b9a77c329c7746324330ab9d/ghc

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

commit 46b6ac610237c696b9a77c329c7746324330ab9d
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date:   Tue Feb 14 13:59:04 2017 +0000

    Combine identical case alterantives in CSE
    
    See Note [Combine case alternatives] in CSE.  This opportunity
    surfaced when I was was studying early inlining.  It's easy (and
    cheap) to exploit, and sometimes makes a worthwhile saving.


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

46b6ac610237c696b9a77c329c7746324330ab9d
 compiler/simplCore/CSE.hs | 41 +++++++++++++++++++++++++++++++++++++++--
 1 file changed, 39 insertions(+), 2 deletions(-)

diff --git a/compiler/simplCore/CSE.hs b/compiler/simplCore/CSE.hs
index 80013a3..31532af 100644
--- a/compiler/simplCore/CSE.hs
+++ b/compiler/simplCore/CSE.hs
@@ -392,7 +392,8 @@ cseExpr env (Case e bndr ty alts) = cseCase env e bndr ty alts
 
 cseCase :: CSEnv -> InExpr -> InId -> InType -> [InAlt] -> OutExpr
 cseCase env scrut bndr ty alts
-  = Case scrut1 bndr3 ty' (map cse_alt alts)
+  = Case scrut1 bndr3 ty' $
+    combineAlts alt_env (map cse_alt alts)
   where
     ty' = substTy (csEnvSubst env) ty
     scrut1 = tryForCSE False env scrut
@@ -429,7 +430,43 @@ cseCase env scrut bndr ty alts
         where
           (env', args') = addBinders alt_env args
 
-{-
+combineAlts :: CSEnv -> [InAlt] -> [InAlt]
+-- See Note [Combine case alternatives]
+combineAlts env ((_,bndrs1,rhs1) : rest_alts)
+  | all isDeadBinder bndrs1
+  , LT <- filtered_alts `compareLength` rest_alts
+  = (DEFAULT, [], rhs1) : filtered_alts
+  where
+    in_scope = substInScope (csEnvSubst env)
+    filtered_alts = filterOut identical rest_alts
+    identical (_con, bndrs, rhs) = all ok bndrs && eqExpr in_scope rhs1 rhs
+    ok bndr = isDeadBinder bndr || not (bndr `elemInScopeSet` in_scope)
+
+combineAlts _ alts = alts  -- Default case
+
+{- Note [Combine case alternatives]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+combineCaseAlts is just a more heavyweight version of the use of
+combineIdentialAlts in SimplUtils.prepareAlts.  The basic idea is
+to transform
+
+    DEFAULT -> e1
+    K x     -> e1
+    W y z   -> e2
+===>
+   DEFAULT -> e1
+   W y z   -> e2
+
+In the simplifier we use cheapEqExpr, because it is called a lot.
+But here in CSE we use the full eqExpr.  After all, two alterantives usually
+differ near the root, so it probably isn't expensive to compare the full
+alternative.  It seems like the the same kind of thing that CSE is supposed
+to be doing, which is why I put it here.
+
+I acutally saw some examples in the wild, where some inlining made e1 too
+big for cheapEqExpr to catch it.
+
+
 ************************************************************************
 *                                                                      *
 \section{The CSE envt}