diff options
Diffstat (limited to 'compiler')
| -rw-r--r-- | compiler/cmm/CmmCommonBlockElim.hs | 8 | ||||
| -rw-r--r-- | 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 ad10511c1d..c91d553c47 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 babdb0b300..4d109a4086 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 |