[commit: ghc] master: Revert "CmmPipeline: add a second pass of CmmCommonBlockElim" (78ff6e5)

[git at git.haskell.org]

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

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/78ff6e541d33d2d2caf52d2cb4578cd7b745d282/ghc

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

commit 78ff6e541d33d2d2caf52d2cb4578cd7b745d282
Author: Michal Terepeta <michal.terepeta at gmail.com>
Date:   Fri Apr 13 11:31:38 2018 -0400

    Revert "CmmPipeline: add a second pass of CmmCommonBlockElim"
    
    This reverts commit d5c4d46a62ce6a0cfa6440344f707136eff18119.
    
    Please see #14989 for details.
    
    Test Plan: ./validate
    
    Reviewers: bgamari, simonmar
    
    Subscribers: thomie, carter
    
    GHC Trac Issues: #14989
    
    Differential Revision: https://phabricator.haskell.org/D4577


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

78ff6e541d33d2d2caf52d2cb4578cd7b745d282
 compiler/cmm/CmmCommonBlockElim.hs |  8 ++++----
 compiler/cmm/CmmPipeline.hs        | 42 +++-----------------------------------
 2 files changed, 7 insertions(+), 43 deletions(-)

diff --git a/compiler/cmm/CmmCommonBlockElim.hs b/compiler/cmm/CmmCommonBlockElim.hs
index ad10511..c91d553 100644
--- a/compiler/cmm/CmmCommonBlockElim.hs
+++ b/compiler/cmm/CmmCommonBlockElim.hs
@@ -59,10 +59,9 @@ import Data.List (foldl')
 -- hashes, and at most once otherwise. Previously, we were slower, and people
 -- rightfully complained: #10397
 
-type Subst = LabelMap BlockId
-
-elimCommonBlocks :: CmmGraph -> (CmmGraph, Subst)
-elimCommonBlocks g = (replaceLabels env $ copyTicks env g, env)
+-- TODO: Use optimization fuel
+elimCommonBlocks :: CmmGraph -> CmmGraph
+elimCommonBlocks g = replaceLabels env $ copyTicks env g
   where
      env = iterate mapEmpty blocks_with_key
      -- The order of blocks doesn't matter here, but revPostorder also drops any
@@ -74,6 +73,7 @@ elimCommonBlocks g = (replaceLabels env $ copyTicks env g, env)
 -- (so avoid comparing them again)
 type DistinctBlocks = [CmmBlock]
 type Key = [Label]
+type Subst = LabelMap BlockId
 
 -- The outer list groups by hash. We retain this grouping throughout.
 iterate :: Subst -> [[(Key, DistinctBlocks)]] -> Subst
diff --git a/compiler/cmm/CmmPipeline.hs b/compiler/cmm/CmmPipeline.hs
index babdb0b..4d109a4 100644
--- a/compiler/cmm/CmmPipeline.hs
+++ b/compiler/cmm/CmmPipeline.hs
@@ -1,5 +1,4 @@
 {-# LANGUAGE BangPatterns #-}
-{-# LANGUAGE TypeFamilies #-}
 
 module CmmPipeline (
   -- | Converts C-- with an implicit stack and native C-- calls into
@@ -29,8 +28,6 @@ import Control.Monad
 import Outputable
 import Platform
 
-import Data.Maybe
-
 -----------------------------------------------------------------------------
 -- | Top level driver for C-- pipeline
 -----------------------------------------------------------------------------
@@ -70,9 +67,9 @@ cpsTop hsc_env proc =
                                           , do_layout = do_layout }} = h
 
        ----------- Eliminate common blocks -------------------------------------
-       (g, _) <- {-# SCC "elimCommonBlocks" #-}
-                 condPass2 Opt_CmmElimCommonBlocks elimCommonBlocks g mapEmpty
-                           Opt_D_dump_cmm_cbe "Post common block elimination"
+       g <- {-# SCC "elimCommonBlocks" #-}
+            condPass Opt_CmmElimCommonBlocks elimCommonBlocks g
+                          Opt_D_dump_cmm_cbe "Post common block elimination"
 
        -- Any work storing block Labels must be performed _after_
        -- elimCommonBlocks
@@ -107,32 +104,6 @@ cpsTop hsc_env proc =
             condPass Opt_CmmSink (cmmSink dflags) g
                      Opt_D_dump_cmm_sink "Sink assignments"
 
-       (g, call_pps, proc_points) <- do
-         -- Only do the second CBE if we did the sinking pass. Otherwise,
-         -- it's unlikely we'll have any new opportunities to find redundant
-         -- blocks.
-         if not (gopt Opt_CmmSink dflags)
-           then pure (g, call_pps, proc_points)
-           else do
-             (g, cbe_subst) <- {-# SCC "elimCommonBlocks2" #-}
-               condPass2
-                 Opt_CmmElimCommonBlocks elimCommonBlocks g mapEmpty
-                 Opt_D_dump_cmm_cbe "Post common block elimination 2"
-
-             -- CBE might invalidate the results of proc-point analysis (by
-             -- removing labels). So we need to fix it. Instead of re-doing
-             -- the whole analysis, we use the final substitution env from
-             -- CBE to update existing results.
-             let cbe_fix set bid =
-                   setInsert (fromMaybe bid (mapLookup bid cbe_subst)) set
-             let !new_call_pps = setFoldl cbe_fix setEmpty call_pps
-             let !new_proc_points
-                   | splitting_proc_points =
-                       setFoldl cbe_fix setEmpty proc_points
-                   | otherwise = new_call_pps
-
-             return (g, new_call_pps, new_proc_points)
-
        ------------- CAF analysis ----------------------------------------------
        let cafEnv = {-# SCC "cafAnal" #-} cafAnal g
        dumpWith dflags Opt_D_dump_cmm_caf "CAFEnv" (ppr cafEnv)
@@ -184,13 +155,6 @@ cpsTop hsc_env proc =
                     return g
                else return g
 
-        condPass2 flag pass g a dumpflag dumpname =
-            if gopt flag dflags
-               then do
-                    (g, a) <- return $ pass g
-                    dump dumpflag dumpname g
-                    return (g, a)
-               else return (g, a)
 
         -- we don't need to split proc points for the NCG, unless
         -- tablesNextToCode is off.  The latter is because we have no