Commit bd43378d authored by Andreas Klebinger's avatar Andreas Klebinger Committed by Ben Gamari

Optimizations for CmmBlockElim.

* Use toBlockList instead of revPostorder.

    Block elimination works on a given Cmm graph by:
     * Getting a list of blocks.
     * Looking for duplicates in these blocks.
     * Removing all but one instance of duplicates.

    There are two (reasonable) ways to get the list of blocks.
     * The fast way: `toBlockList`
       This just flattens the underlying map into a list.
     * The convenient way: `revPostorder`
       Start at the entry label, scan for reachable blocks and return
       only these. This has the advantage of removing all dead code.

    If there is dead code the later is better. Work done on unreachable
    blocks is clearly wasted work. However by the point we run the
    common block elimination pass the input graph already had all dead code
    removed. This is done during control flow optimization in
    CmmContFlowOpt which is our first Cmm pass.

    This means common block elimination is free to use toBlockList
    because revPostorder would return the same blocks. (Although in
    a different order).

* Change the triemap used for grouping by a label list
  from `(TM.ListMap UniqDFM)` to `ListMap (GenMap LabelMap)`.

    * Using GenMap offers leaf compression. Which is a trie
      optimization described by the Note [Compressed TrieMap] in
      CoreSyn/TrieMap.hs

    * Using LabelMap removes the overhead associated with UniqDFM.

  This is deterministic since if we have the same input keys the same
  LabelMap will be constructed.

Test Plan: ci, profiling output

Reviewers: bgamari, simonmar

Reviewed By: bgamari

Subscribers: dfeuer, thomie, carter

GHC Trac Issues: #15103

Differential Revision: https://phabricator.haskell.org/D4597
parent 9fd4ed90
{-# LANGUAGE GADTs, BangPatterns #-}
{-# LANGUAGE GADTs, BangPatterns, ScopedTypeVariables #-}
module CmmCommonBlockElim
( elimCommonBlocks
)
......@@ -24,9 +25,8 @@ import qualified Data.List as List
import Data.Word
import qualified Data.Map as M
import Outputable
import UniqFM
import UniqDFM
import qualified TrieMap as TM
import UniqFM
import Unique
import Control.Arrow (first, second)
import Data.List (foldl')
......@@ -64,9 +64,11 @@ 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
-- unreachable blocks, which is useful.
groups = groupByInt hash_block (revPostorder g)
-- The order of blocks doesn't matter here. While we could use
-- revPostorder which drops unreachable blocks this is done in
-- ContFlowOpt already which runs before this pass. So we use
-- toBlockList since it is faster.
groups = groupByInt hash_block (toBlockList g) :: [[CmmBlock]]
blocks_with_key = [ [ (successors b, [b]) | b <- bs] | bs <- groups]
-- Invariant: The blocks in the list are pairwise distinct
......@@ -94,6 +96,8 @@ iterate subst blocks
subst' = subst `mapUnion` new_substs
updated_blocks = map (map (first (map (lookupBid subst')))) merged_blocks
-- Combine two lists of blocks.
-- While they are internally distinct they can still share common blocks.
mergeBlocks :: Subst -> DistinctBlocks -> DistinctBlocks -> (Subst, DistinctBlocks)
mergeBlocks subst existing new = go new
where
......@@ -298,17 +302,21 @@ copyTicks env g
foldr blockCons code (map CmmTick ticks)
-- Group by [Label]
groupByLabel :: [(Key, a)] -> [(Key, [a])]
groupByLabel = go (TM.emptyTM :: TM.ListMap UniqDFM a)
where
go !m [] = TM.foldTM (:) m []
go !m ((k,v) : entries) = go (TM.alterTM k' adjust m) entries
where k' = map getUnique k
adjust Nothing = Just (k,[v])
adjust (Just (_,vs)) = Just (k,v:vs)
-- See Note [Compressed TrieMap] in coreSyn/TrieMap about the usage of GenMap.
groupByLabel :: [(Key, DistinctBlocks)] -> [(Key, [DistinctBlocks])]
groupByLabel =
go (TM.emptyTM :: TM.ListMap (TM.GenMap LabelMap) (Key, [DistinctBlocks]))
where
go !m [] = TM.foldTM (:) m []
go !m ((k,v) : entries) = go (TM.alterTM k adjust m) entries
where --k' = map (getKey . getUnique) k
adjust Nothing = Just (k,[v])
adjust (Just (_,vs)) = Just (k,v:vs)
groupByInt :: (a -> Int) -> [a] -> [[a]]
groupByInt f xs = nonDetEltsUFM $ List.foldl' go emptyUFM xs
-- See Note [Unique Determinism and code generation]
where go m x = alterUFM (Just . maybe [x] (x:)) m (f x)
-- See Note [Unique Determinism and code generation]
where
go m x = alterUFM addEntry m (f x)
where
addEntry xs = Just $! maybe [x] (x:) xs
......@@ -21,6 +21,8 @@ import Outputable
import Hoopl.Collections
import Unique (Uniquable(..))
import TrieMap
-----------------------------------------------------------------------------
-- Label
......@@ -120,6 +122,14 @@ instance Outputable LabelSet where
instance Outputable a => Outputable (LabelMap a) where
ppr = ppr . mapToList
instance TrieMap LabelMap where
type Key LabelMap = Label
emptyTM = mapEmpty
lookupTM k m = mapLookup k m
alterTM k f m = mapAlter f k m
foldTM k m z = mapFoldr k z m
mapTM f m = mapMap f m
-----------------------------------------------------------------------------
-- FactBase
......
......@@ -24,6 +24,8 @@ module CoreMap(
ListMap,
-- * Maps over 'Literal's
LiteralMap,
-- * Map for compressing leaves. See Note [Compressed TrieMap]
GenMap,
-- * 'TrieMap' class
TrieMap(..), insertTM, deleteTM,
lkDFreeVar, xtDFreeVar,
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment