diff options
| author | Iavor S. Diatchki <iavor.diatchki@gmail.com> | 2014-07-19 14:29:57 -0700 |
|---|---|---|
| committer | Iavor S. Diatchki <iavor.diatchki@gmail.com> | 2014-07-19 14:29:57 -0700 |
| commit | 524634641c61ab42c555452f6f87119b27f6c331 (patch) | |
| tree | f78d17bb6b09fb3b2e22cb4d93c2a3d45accc2d9 /compiler/nativeGen/RegAlloc/Liveness.hs | |
| parent | 79ad1d20c5500e17ce5daaf93b171131669bddad (diff) | |
| parent | c41b716d82b1722f909979d02a76e21e9b68886c (diff) | |
| download | haskell-wip/ext-solver.tar.gz | |
Merge branch 'master' into wip/ext-solverwip/ext-solver
Diffstat (limited to 'compiler/nativeGen/RegAlloc/Liveness.hs')
| -rw-r--r-- | compiler/nativeGen/RegAlloc/Liveness.hs | 21 |
1 files changed, 16 insertions, 5 deletions
diff --git a/compiler/nativeGen/RegAlloc/Liveness.hs b/compiler/nativeGen/RegAlloc/Liveness.hs index b0e763a6f0..1cb6dc8268 100644 --- a/compiler/nativeGen/RegAlloc/Liveness.hs +++ b/compiler/nativeGen/RegAlloc/Liveness.hs @@ -1,3 +1,8 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeFamilies #-} + ----------------------------------------------------------------------------- -- -- The register liveness determinator @@ -5,7 +10,7 @@ -- (c) The University of Glasgow 2004-2013 -- ----------------------------------------------------------------------------- -{-# LANGUAGE FlexibleContexts, TypeFamilies #-} + module RegAlloc.Liveness ( RegSet, RegMap, emptyRegMap, @@ -666,14 +671,20 @@ sccBlocks sccBlocks blocks entries = map (fmap get_node) sccs where - sccs = stronglyConnCompFromG graph roots - - graph = graphFromEdgedVertices nodes - -- nodes :: [(NatBasicBlock instr, Unique, [Unique])] nodes = [ (block, id, getOutEdges instrs) | block@(BasicBlock id instrs) <- blocks ] + g1 = graphFromEdgedVertices nodes + + reachable :: BlockSet + reachable = setFromList [ id | (_,id,_) <- reachablesG g1 roots ] + + g2 = graphFromEdgedVertices [ node | node@(_,id,_) <- nodes + , id `setMember` reachable ] + + sccs = stronglyConnCompG g2 + get_node (n, _, _) = n getOutEdges :: Instruction instr => [instr] -> [BlockId] |