summaryrefslogtreecommitdiff
path: root/compiler/GHC
diff options
context:
space:
mode:
authorMatthew Pickering <matthewtpickering@gmail.com>2021-09-15 13:06:07 +0100
committerMarge Bot <ben+marge-bot@smart-cactus.org>2021-09-17 09:44:53 -0400
commitb041ea7784f036dd7cfc5fae6380db4f3c392ab4 (patch)
tree9b8b91e76dfe579cc8424f52c082456c0cf41120 /compiler/GHC
parent44e7120dacad683829194b0dbedcfb679d5ffe93 (diff)
downloadhaskell-b041ea7784f036dd7cfc5fae6380db4f3c392ab4.tar.gz
Code Gen: Optimise successors calculation in loop calculation
Before this change, the whole map would be traversed in order to delete a node from the graph before calculating successors. This is quite inefficient if the CFG is big, as was the case in the mmark package. A more efficient alternative is to leave the CFG untouched and then just delete the node once after the lookups have been performed. Ticket: #19471
Diffstat (limited to 'compiler/GHC')
-rw-r--r--compiler/GHC/CmmToAsm/CFG.hs9
1 files changed, 4 insertions, 5 deletions
diff --git a/compiler/GHC/CmmToAsm/CFG.hs b/compiler/GHC/CmmToAsm/CFG.hs
index 5c1f23ceab..d698ae12ca 100644
--- a/compiler/GHC/CmmToAsm/CFG.hs
+++ b/compiler/GHC/CmmToAsm/CFG.hs
@@ -860,7 +860,7 @@ loopInfo cfg root = LoopInfo { liBackEdges = backEdges
= ( edge, setInsert head $ go (setSingleton tail) (setSingleton tail) )
where
-- See Note [Determining the loop body]
- cfg' = delNode head revCfg
+
go :: LabelSet -> LabelSet -> LabelSet
go found current
@@ -870,10 +870,9 @@ loopInfo cfg root = LoopInfo { liBackEdges = backEdges
where
-- Really predecessors, since we use the reversed cfg.
newSuccessors = setFilter (\n -> not $ setMember n found) successors :: LabelSet
- successors = setFromList $ concatMap
- (getSuccessors cfg')
- -- we filter head as it's no longer part of the cfg.
- (filter (/= head) $ setElems current) :: LabelSet
+ successors = setDelete head $ setUnions $ map
+ (\x -> if x == head then setEmpty else setFromList (getSuccessors revCfg x))
+ (setElems current) :: LabelSet
backEdges = filter isBackEdge edges
loopBodies = map findBody backEdges :: [(Edge, LabelSet)]