[commit: ghc] wip/T11731: CSE: Do not add a "trivial_scrut -> case binder" mapping (fff75a8)

[git at git.haskell.org]

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

On branch  : wip/T11731
Link       : http://ghc.haskell.org/trac/ghc/changeset/fff75a8d5873ebdf28a38aa4a3578df1443d64d3/ghc

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

commit fff75a8d5873ebdf28a38aa4a3578df1443d64d3
Author: Joachim Breitner <mail at joachim-breitner.de>
Date:   Wed Mar 30 18:00:15 2016 +0200

    CSE: Do not add a "trivial_scrut -> case binder" mapping
    
    according to the existing strategy to replace, in the body of the
    expression "case x of y in e", occurrences of y with x (and not the
    other way around with non-trivial case expressions).
    
    Previously, the mapping was added to the environment, but never used,
    due to the exprIsTrivial guard in tryForCSE. But this is fragile if
    exprIsTrivial is modified, as proposed in #11731, hence the removal of
    this code smell.


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

fff75a8d5873ebdf28a38aa4a3578df1443d64d3
 compiler/simplCore/CSE.hs | 9 +++++++--
 1 file changed, 7 insertions(+), 2 deletions(-)

diff --git a/compiler/simplCore/CSE.hs b/compiler/simplCore/CSE.hs
index b4e6e14..0a053d3 100644
--- a/compiler/simplCore/CSE.hs
+++ b/compiler/simplCore/CSE.hs
@@ -174,8 +174,13 @@ cseRhs :: CSEnv -> (OutBndr, InExpr) -> (CSEnv, (OutBndr, OutExpr))
 cseRhs env (id',rhs)
   = case lookupCSEnv env rhs'' of
         Nothing
-          | always_active -> (extendCSEnv env rhs' id', (zapped_id, rhs'))
-          | otherwise     -> (env,                      (id', rhs'))
+          | always_active -> (env', (zapped_id, rhs'))
+          | otherwise     -> (env,  (id', rhs'))
+          where
+            -- Do not add an unwanted trivial_scrut -> case binder mapping, according
+            -- to Note [Case binders 2].
+            env' | Var {} <- rhs' = env
+                 | otherwise      = extendCSEnv env rhs' id'
         Just id
           | always_active -> (extendCSSubst env id' id_expr, (id', mkTicks ticks id_expr))
           | otherwise     -> (env,                           (id', mkTicks ticks id_expr))