diff options
Diffstat (limited to 'compiler/nativeGen/CFG.hs')
| -rw-r--r-- | compiler/nativeGen/CFG.hs | 18 |
1 files changed, 18 insertions, 0 deletions
diff --git a/compiler/nativeGen/CFG.hs b/compiler/nativeGen/CFG.hs index b19db02b13..155e5bcac4 100644 --- a/compiler/nativeGen/CFG.hs +++ b/compiler/nativeGen/CFG.hs @@ -24,6 +24,7 @@ module CFG , getSuccEdgesSorted, weightedEdgeList , getEdgeInfo , getCfgNodes, hasNode + , loopMembers --Construction/Misc , getCfg, getCfgProc, pprEdgeWeights, sanityCheckCfg @@ -636,3 +637,20 @@ optimizeCFG weights (CmmProc info _lab _live graph) cfg = | CmmSource (CmmBranch {}) <- source = True | CmmSource (CmmCondBranch {}) <- source = True | otherwise = False + +-- | Determine loop membership of blocks based on SCC analysis +-- Ideally we would replace this with a variant giving us loop +-- levels instead but the SCC code will do for now. +loopMembers :: CFG -> LabelMap Bool +loopMembers cfg = + foldl' (flip setLevel) mapEmpty sccs + where + mkNode :: BlockId -> Node BlockId BlockId + mkNode bid = DigraphNode bid bid (getSuccessors cfg bid) + nodes = map mkNode (setElems $ getCfgNodes cfg) + + sccs = stronglyConnCompFromEdgedVerticesOrd nodes + + setLevel :: SCC BlockId -> LabelMap Bool -> LabelMap Bool + setLevel (AcyclicSCC bid) m = mapInsert bid False m + setLevel (CyclicSCC bids) m = foldl' (\m k -> mapInsert k True m) m bids |