2 -- | Pretty printing of graphs.
21 -- | Pretty print a graph in a somewhat human readable format.
23 :: (Outputable k, Outputable cls, Outputable color)
24 => Graph k cls color -> SDoc
28 $$ (vcat $ map dumpNode $ eltsUFM $ graphMap graph)
31 = text "Node " <> ppr (nodeId node)
33 <> parens (int (sizeUniqSet $ nodeConflicts node))
35 <> ppr (nodeConflicts node)
38 <> parens (int (sizeUniqSet $ nodeExclusions node))
40 <> ppr (nodeExclusions node)
43 <> parens (int (sizeUniqSet $ nodeCoalesce node))
45 <> ppr (nodeCoalesce node)
51 -- | Pretty print a graph in graphviz .dot format.
52 -- Conflicts get solid edges.
53 -- Coalescences get dashed edges.
56 , Outputable k, Outputable cls, Outputable color)
57 => (color -> SDoc) -- | What graphviz color to use for each node color
58 -- It's usually safe to return X11 style colors here,
59 -- ie "red", "green" etc or a hex triplet #aaff55 etc
61 -> Graph k cls color -> SDoc
63 dotGraph colorMap triv graph
64 = let nodes = eltsUFM $ graphMap graph
66 ( [ text "graph G {" ]
67 ++ map (dotNode colorMap triv) nodes
68 ++ (catMaybes $ snd $ mapAccumL dotNodeEdges emptyUniqSet nodes)
72 dotNode colorMap triv node
73 = let name = ppr $ nodeId node
74 cls = ppr $ nodeClass node
77 = hcat $ punctuate space
78 $ map (\n -> text "-" <> ppr n)
79 $ uniqSetToList $ nodeExclusions node
82 = hcat $ punctuate space
83 $ map (\n -> text "+" <> ppr n)
86 expref = if and [isEmptyUniqSet (nodeExclusions node), null (nodePreference node)]
88 else text "\\n" <> (excludes <+> preferences)
90 -- if the node has been colored then show that,
91 -- otherwise indicate whether it looks trivially colorable.
93 | Just c <- nodeColor node
94 = text "\\n(" <> ppr c <> text ")"
96 | triv (nodeClass node) (nodeConflicts node) (nodeExclusions node)
97 = text "\\n(" <> text "triv" <> text ")"
100 = text "\\n(" <> text "spill?" <> text ")"
102 label = name <> text " :: " <> cls
106 pcolorC = case nodeColor node of
107 Nothing -> text "style=filled fillcolor=white"
108 Just c -> text "style=filled fillcolor=" <> doubleQuotes (colorMap c)
111 pout = text "node [label=" <> doubleQuotes label <> space <> pcolorC <> text "]"
112 <> space <> doubleQuotes name
118 -- | Nodes in the graph are doubly linked, but we only want one edge for each
119 -- conflict if the graphviz graph. Traverse over the graph, but make sure
120 -- to only print the edges for each node once.
122 dotNodeEdges visited node
123 | elementOfUniqSet (nodeId node) visited
129 = map (dotEdgeConflict (nodeId node))
131 $ minusUniqSet (nodeConflicts node) visited
134 = map (dotEdgeCoalesce (nodeId node))
136 $ minusUniqSet (nodeCoalesce node) visited
138 out = vcat dconflicts
141 in ( addOneToUniqSet visited (nodeId node)
144 dotEdgeConflict u1 u2
145 = doubleQuotes (ppr u1) <> text " -- " <> doubleQuotes (ppr u2) <> text ";"
147 dotEdgeCoalesce u1 u2
148 = doubleQuotes (ppr u1) <> text " -- " <> doubleQuotes (ppr u2) <> space <> text "[ style = dashed ];"