[commit: ghc] wip/T9291: Stg CSE: Try handle trivial cases less intrusively (49664e9)

[git at git.haskell.org]

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

On branch  : wip/T9291
Link       : http://ghc.haskell.org/trac/ghc/changeset/49664e9699c85e14b569450245de0ad98cfcfd22/ghc

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

commit 49664e9699c85e14b569450245de0ad98cfcfd22
Author: Joachim Breitner <mail at joachim-breitner.de>
Date:   Fri Dec 23 22:42:07 2016 +0100

    Stg CSE: Try handle trivial cases less intrusively


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

49664e9699c85e14b569450245de0ad98cfcfd22
 compiler/simplStg/StgCse.hs | 27 ++++++++++-----------------
 1 file changed, 10 insertions(+), 17 deletions(-)

diff --git a/compiler/simplStg/StgCse.hs b/compiler/simplStg/StgCse.hs
index 8d66420..74c1964 100644
--- a/compiler/simplStg/StgCse.hs
+++ b/compiler/simplStg/StgCse.hs
@@ -137,11 +137,8 @@ data CseEnv = CseEnv
     , ce_subst     :: IdEnv OutId
         -- ^ This substitution contains CSE-specific entries. The domain are
         --   OutIds, so ce_renaming has to be applied first.
-        --   It has entries for two reasons:
-        --     x ↦ y,  when a let-binding `let x = Con y` is removed because
-        --             `let y = Con z` is in scope
-        --     b ↦ s,  when `case s of b` (trivial scrutinee!) is encountered
-        --             see Note [Trivial case scrutinee]
+        --   It has an entry x ↦ y when a let-binding `let x = Con y` is
+        --   removed because `let y = Con z` is in scope.
         --
         --   Both substitutions are applied to data constructor arguments
         --   before these are looked up in the conAppMap.
@@ -189,11 +186,7 @@ addDataCon :: OutId -> DataCon -> [OutStgArg] -> CseEnv -> CseEnv
 addDataCon _ _ [] env = env
 addDataCon bndr dataCon args env = env { ce_conAppMap = new_env }
   where
-    new_env = insertTM (dataCon, args) cse_target (ce_conAppMap env)
-    cse_target = fromMaybe bndr $ lookupVarEnv (ce_subst env) bndr
-      -- The binder might be a case binder of a trivial case,
-      -- in which case we want to use the scrutinee
-      -- See Note [Trivial case scrutinee]
+    new_env = insertTM (dataCon, args) bndr (ce_conAppMap env)
 
 forgetCse :: CseEnv -> CseEnv
 forgetCse env = env { ce_conAppMap = emptyTM }
@@ -300,10 +293,10 @@ stgCseExpr env (StgCase scrut bndr ty alts)
   where
     scrut' = stgCseExpr env scrut
     (env1, bndr') = substBndr env bndr
-    env2 | StgApp trivial_scrut [] <- scrut' = addSubst bndr' trivial_scrut env1
-        -- See Note [Trivial case scrutinee]
-         | otherwise                         = env1
-    alts' = map (stgCseAlt env2 bndr') alts
+    cse_bndr | StgApp trivial_scrut [] <- scrut' = trivial_scrut
+                 -- See Note [Trivial case scrutinee]
+             | otherwise                         = bndr'
+    alts' = map (stgCseAlt env1 cse_bndr) alts
 
 
 -- A constructor application.
@@ -407,13 +400,13 @@ order to handle nested reconstruction of constructors as in
     nested _ = Left True
 
 Therefore, we add
-    Con a ↦ x  and  b ↦ x
-to the ConAppMap and the substitution respectively.
+    Con a ↦ x
+to the ConAppMap respectively.
 Compare Note [CSE for case expressions] in CSE.hs, which does the same for Core CSE.
 
 If we find
     case foo x as b of { Con a -> … }
-we only add
+we use
     Con a ↦ b
 
 Note [Free variables of an StgClosure]