diff options
| author | Matthew Pickering <matthewtpickering@gmail.com> | 2017-04-04 21:47:29 -0400 |
|---|---|---|
| committer | Ben Gamari <ben@smart-cactus.org> | 2017-04-04 21:47:51 -0400 |
| commit | 1831aed16d9883b2845fa6997e38b9ac3d72f191 (patch) | |
| tree | 5f18307cfda76206dc74f15f0678039e667d2427 /compiler/nativeGen/RegAlloc/Liveness.hs | |
| parent | 5315223683b64c665959781112f8206fb8230a54 (diff) | |
| download | haskell-1831aed16d9883b2845fa6997e38b9ac3d72f191.tar.gz | |
Replace Digraph's Node type synonym with a data type
This refactoring makes it more obvious when we are constructing
a Node for the digraph rather than a less useful 3-tuple.
Reviewers: austin, goldfire, bgamari, simonmar, dfeuer
Reviewed By: dfeuer
Subscribers: rwbarton, thomie
Differential Revision: https://phabricator.haskell.org/D3414
Diffstat (limited to 'compiler/nativeGen/RegAlloc/Liveness.hs')
| -rw-r--r-- | compiler/nativeGen/RegAlloc/Liveness.hs | 20 |
1 files changed, 10 insertions, 10 deletions
diff --git a/compiler/nativeGen/RegAlloc/Liveness.hs b/compiler/nativeGen/RegAlloc/Liveness.hs index e387f82420..53e09285c4 100644 --- a/compiler/nativeGen/RegAlloc/Liveness.hs +++ b/compiler/nativeGen/RegAlloc/Liveness.hs @@ -677,29 +677,28 @@ natCmmTopToLive proc@(CmmProc info lbl live (ListGraph blocks@(first : _))) -- exactly what we do. (#7574) -- sccBlocks - :: Instruction instr + :: forall instr . Instruction instr => [NatBasicBlock instr] -> [BlockId] -> [SCC (NatBasicBlock instr)] -sccBlocks blocks entries = map (fmap get_node) sccs +sccBlocks blocks entries = map (fmap node_payload) sccs where - -- nodes :: [(NatBasicBlock instr, Unique, [Unique])] - nodes = [ (block, id, getOutEdges instrs) + nodes :: [ Node BlockId (NatBasicBlock instr) ] + nodes = [ DigraphNode block id (getOutEdges instrs) | block@(BasicBlock id instrs) <- blocks ] g1 = graphFromEdgedVerticesUniq nodes reachable :: LabelSet - reachable = setFromList [ id | (_,id,_) <- reachablesG g1 roots ] + reachable = setFromList [ node_key node | node <- reachablesG g1 roots ] - g2 = graphFromEdgedVerticesUniq [ node | node@(_,id,_) <- nodes - , id `setMember` reachable ] + g2 = graphFromEdgedVerticesUniq [ node | node <- nodes + , node_key node + `setMember` reachable ] sccs = stronglyConnCompG g2 - get_node (n, _, _) = n - getOutEdges :: Instruction instr => [instr] -> [BlockId] getOutEdges instrs = concat $ map jumpDestsOfInstr instrs @@ -709,7 +708,8 @@ sccBlocks blocks entries = map (fmap get_node) sccs -- node: (NatBasicBlock, BlockId, [BlockId]). This takes -- advantage of the fact that Digraph only looks at the key, -- even though it asks for the whole triple. - roots = [(panic "sccBlocks",b,panic "sccBlocks") | b <- entries ] + roots = [DigraphNode (panic "sccBlocks") b (panic "sccBlocks") + | b <- entries ] |