diff options
| author | Michal Terepeta <michal.terepeta@gmail.com> | 2018-03-19 12:03:20 -0400 |
|---|---|---|
| committer | Ben Gamari <ben@smart-cactus.org> | 2018-03-19 12:05:12 -0400 |
| commit | 256577fbde836f13c744418d38d18c17a369f7e9 (patch) | |
| tree | 3bce5b87c24e6832e1c659a3d737768dad130822 /compiler/cmm/CmmProcPoint.hs | |
| parent | 20cbb0165e4d18df510e707791e761942d3c10f0 (diff) | |
| download | haskell-256577fbde836f13c744418d38d18c17a369f7e9.tar.gz | |
CmmUtils: get rid of insertBlock
`Hoopl.Graph` has almost exactly the same function, so let's use that.
Also, use `IntMap.alter` to make it more efficient.
Also switch `Hoopl` to use strict maps.
Signed-off-by: Michal Terepeta <michal.terepeta@gmail.com>
Test Plan: ./validate
Reviewers: bgamari, simonmar
Reviewed By: bgamari
Subscribers: dfeuer, rwbarton, thomie, carter
Differential Revision: https://phabricator.haskell.org/D4493
Diffstat (limited to 'compiler/cmm/CmmProcPoint.hs')
| -rw-r--r-- | compiler/cmm/CmmProcPoint.hs | 8 |
1 files changed, 4 insertions, 4 deletions
diff --git a/compiler/cmm/CmmProcPoint.hs b/compiler/cmm/CmmProcPoint.hs index e3eb1dc45d..bef8f384b8 100644 --- a/compiler/cmm/CmmProcPoint.hs +++ b/compiler/cmm/CmmProcPoint.hs @@ -242,11 +242,11 @@ splitAtProcPoints dflags entry_label callPPs procPoints procMap (CmmProc (TopInfo {info_tbls = info_tbls}) top_l _ g@(CmmGraph {g_entry=entry})) = do -- Build a map from procpoints to the blocks they reach - let addBlock + let add_block :: LabelMap (LabelMap CmmBlock) -> CmmBlock -> LabelMap (LabelMap CmmBlock) - addBlock graphEnv b = + add_block graphEnv b = case mapLookup bid procMap of Just ProcPoint -> add graphEnv bid bid b Just (ReachedBy set) -> @@ -265,7 +265,7 @@ splitAtProcPoints dflags entry_label callPPs procPoints procMap regSetToList $ expectJust "ppLiveness" $ mapLookup pp liveness - graphEnv <- return $ foldlGraphBlocks addBlock mapEmpty g + graphEnv <- return $ foldlGraphBlocks add_block mapEmpty g -- Build a map from proc point BlockId to pairs of: -- * Labels for their new procedures @@ -330,7 +330,7 @@ splitAtProcPoints dflags entry_label callPPs procPoints procMap -- replace branches to procpoints with branches to jumps blockEnv'' = toBlockMap $ replaceBranches jumpEnv $ ofBlockMap ppId blockEnv' -- add the jump blocks to the graph - blockEnv''' = foldl' (flip insertBlock) blockEnv'' jumpBlocks + blockEnv''' = foldl' (flip addBlock) blockEnv'' jumpBlocks let g' = ofBlockMap ppId blockEnv''' -- pprTrace "g' pre jumps" (ppr g') $ do return (mapInsert ppId g' newGraphEnv) |