projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Make various assertions work when !DEBUG
[ghc-hetmet.git]
/
compiler
/
nativeGen
/
GraphPpr.hs
diff --git
a/compiler/nativeGen/GraphPpr.hs
b/compiler/nativeGen/GraphPpr.hs
index
a2a64bc
..
1df5158
100644
(file)
--- a/
compiler/nativeGen/GraphPpr.hs
+++ b/
compiler/nativeGen/GraphPpr.hs
@@
-27,6
+27,10
@@
dumpGraph graph
= text "Graph"
$$ (vcat $ map dumpNode $ eltsUFM $ graphMap graph)
= text "Graph"
$$ (vcat $ map dumpNode $ eltsUFM $ graphMap graph)
+dumpNode
+ :: (Outputable k, Outputable cls, Outputable color)
+ => Node k cls color -> SDoc
+
dumpNode node
= text "Node " <> ppr (nodeId node)
$$ text "conflicts "
dumpNode node
= text "Node " <> ppr (nodeId node)
$$ text "conflicts "
@@
-69,6
+73,13
@@
dotGraph colorMap triv graph
++ [ text "}"
, space ])
++ [ text "}"
, space ])
+
+dotNode :: ( Uniquable k
+ , Outputable k, Outputable cls, Outputable color)
+ => (color -> SDoc)
+ -> Triv k cls color
+ -> Node k cls color -> SDoc
+
dotNode colorMap triv node
= let name = ppr $ nodeId node
cls = ppr $ nodeClass node
dotNode colorMap triv node
= let name = ppr $ nodeId node
cls = ppr $ nodeClass node
@@
-119,6
+130,13
@@
dotNode colorMap triv node
-- conflict if the graphviz graph. Traverse over the graph, but make sure
-- to only print the edges for each node once.
-- conflict if the graphviz graph. Traverse over the graph, but make sure
-- to only print the edges for each node once.
+dotNodeEdges
+ :: ( Uniquable k
+ , Outputable k, Outputable cls, Outputable color)
+ => UniqSet k
+ -> Node k cls color
+ -> (UniqSet k, Maybe SDoc)
+
dotNodeEdges visited node
| elementOfUniqSet (nodeId node) visited
= ( visited
dotNodeEdges visited node
| elementOfUniqSet (nodeId node) visited
= ( visited
@@
-141,9
+159,11
@@
dotNodeEdges visited node
in ( addOneToUniqSet visited (nodeId node)
, Just out)
in ( addOneToUniqSet visited (nodeId node)
, Just out)
-dotEdgeConflict u1 u2
- = doubleQuotes (ppr u1) <> text " -- " <> doubleQuotes (ppr u2) <> text ";"
+ where dotEdgeConflict u1 u2
+ = doubleQuotes (ppr u1) <> text " -- " <> doubleQuotes (ppr u2)
+ <> text ";"
-dotEdgeCoalesce u1 u2
- = doubleQuotes (ppr u1) <> text " -- " <> doubleQuotes (ppr u2) <> space <> text "[ style = dashed ];"
+ dotEdgeCoalesce u1 u2
+ = doubleQuotes (ppr u1) <> text " -- " <> doubleQuotes (ppr u2)
+ <> space <> text "[ style = dashed ];"