| ... |
... |
@@ -56,22 +56,18 @@ import GHC.Utils.Misc |
|
56
|
56
|
import GHC.Data.Graph.Directed
|
|
57
|
57
|
import GHC.Data.Maybe
|
|
58
|
58
|
|
|
59
|
|
-import GHC.Types.Unique
|
|
60
|
59
|
import qualified GHC.CmmToAsm.CFG.Dominators as Dom
|
|
61
|
60
|
import GHC.CmmToAsm.CFG.Weight
|
|
62
|
|
-import GHC.Data.Word64Map.Strict (Word64Map)
|
|
63
|
|
-import GHC.Data.Word64Set (Word64Set)
|
|
64
|
61
|
import Data.IntMap.Strict (IntMap)
|
|
65
|
62
|
import Data.IntSet (IntSet)
|
|
66
|
63
|
|
|
67
|
64
|
import qualified Data.IntMap.Strict as IM
|
|
68
|
|
-import qualified GHC.Data.Word64Map.Strict as WM
|
|
69
|
65
|
import qualified Data.Map as M
|
|
70
|
66
|
import qualified Data.IntSet as IS
|
|
71
|
|
-import qualified GHC.Data.Word64Set as WS
|
|
72
|
67
|
import qualified Data.Set as S
|
|
73
|
68
|
import Data.Tree
|
|
74
|
69
|
import Data.Bifunctor
|
|
|
70
|
+import Data.Coerce
|
|
75
|
71
|
|
|
76
|
72
|
import GHC.Utils.Outputable
|
|
77
|
73
|
import GHC.Utils.Panic
|
| ... |
... |
@@ -92,7 +88,6 @@ import Data.Array.Base (unsafeRead, unsafeWrite) |
|
92
|
88
|
|
|
93
|
89
|
import Control.Monad
|
|
94
|
90
|
import GHC.Data.UnionFind
|
|
95
|
|
-import Data.Word
|
|
96
|
91
|
|
|
97
|
92
|
type Prob = Double
|
|
98
|
93
|
|
| ... |
... |
@@ -849,10 +844,8 @@ loopInfo cfg root = LoopInfo { liBackEdges = backEdges |
|
849
|
844
|
fmap (setFromList . mapKeys ) cfg :: LabelMap LabelSet
|
|
850
|
845
|
|
|
851
|
846
|
|
|
852
|
|
- --TODO - This should be a no op: Export constructors? Use unsafeCoerce? ...
|
|
853
|
|
- rooted = ( fromBlockId root
|
|
854
|
|
- , toWord64Map $ fmap toWord64Set graph) :: (Word64, Word64Map Word64Set)
|
|
855
|
|
- tree = fmap toBlockId $ Dom.domTree rooted :: Tree BlockId
|
|
|
847
|
+ rooted = coerce (root, graph)
|
|
|
848
|
+ tree = coerce (Dom.domTree rooted) :: Tree BlockId
|
|
856
|
849
|
|
|
857
|
850
|
-- Map from Nodes to their dominators
|
|
858
|
851
|
domMap :: LabelMap LabelSet
|
| ... |
... |
@@ -898,11 +891,6 @@ loopInfo cfg root = LoopInfo { liBackEdges = backEdges |
|
898
|
891
|
loopCount n = length $ nub . map fst . filter (setMember n . snd) $ bodies
|
|
899
|
892
|
in map (\n -> (n, loopCount n)) $ nodes :: [(BlockId, Int)]
|
|
900
|
893
|
|
|
901
|
|
- toWord64Set :: LabelSet -> Word64Set
|
|
902
|
|
- toWord64Set s = WS.fromList . map fromBlockId . setElems $ s
|
|
903
|
|
- toWord64Map :: LabelMap a -> Word64Map a
|
|
904
|
|
- toWord64Map m = WM.fromList $ map (\(x,y) -> (fromBlockId x,y)) $ mapToList m
|
|
905
|
|
-
|
|
906
|
894
|
mkDomMap :: Tree BlockId -> LabelMap LabelSet
|
|
907
|
895
|
mkDomMap root = mapFromList $ go setEmpty root
|
|
908
|
896
|
where
|
| ... |
... |
@@ -916,12 +904,6 @@ loopInfo cfg root = LoopInfo { liBackEdges = backEdges |
|
916
|
904
|
(\n -> go (setInsert (rootLabel n) parents) n)
|
|
917
|
905
|
leaves
|
|
918
|
906
|
|
|
919
|
|
- fromBlockId :: BlockId -> Word64
|
|
920
|
|
- fromBlockId = getKey . getUnique
|
|
921
|
|
-
|
|
922
|
|
- toBlockId :: Word64 -> BlockId
|
|
923
|
|
- toBlockId = mkBlockId . mkUniqueGrimily
|
|
924
|
|
-
|
|
925
|
907
|
-- We make the CFG a Hoopl Graph, so we can reuse revPostOrder.
|
|
926
|
908
|
newtype BlockNode (e :: Extensibility) (x :: Extensibility) = BN (BlockId,[BlockId])
|
|
927
|
909
|
|