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 :: (Outputable k, Outputable cls, Outputable color)
32 => Node k cls color -> SDoc
35 = text "Node " <> ppr (nodeId node)
37 <> parens (int (sizeUniqSet $ nodeConflicts node))
39 <> ppr (nodeConflicts node)
42 <> parens (int (sizeUniqSet $ nodeExclusions node))
44 <> ppr (nodeExclusions node)
47 <> parens (int (sizeUniqSet $ nodeCoalesce node))
49 <> ppr (nodeCoalesce node)
55 -- | Pretty print a graph in graphviz .dot format.
56 -- Conflicts get solid edges.
57 -- Coalescences get dashed edges.
60 , Outputable k, Outputable cls, Outputable color)
61 => (color -> SDoc) -- | What graphviz color to use for each node color
62 -- It's usually safe to return X11 style colors here,
63 -- ie "red", "green" etc or a hex triplet #aaff55 etc
65 -> Graph k cls color -> SDoc
67 dotGraph colorMap triv graph
68 = let nodes = eltsUFM $ graphMap graph
70 ( [ text "graph G {" ]
71 ++ map (dotNode colorMap triv) nodes
72 ++ (catMaybes $ snd $ mapAccumL dotNodeEdges emptyUniqSet nodes)
77 dotNode :: ( Uniquable k
78 , Outputable k, Outputable cls, Outputable color)
81 -> Node k cls color -> SDoc
83 dotNode colorMap triv node
84 = let name = ppr $ nodeId node
85 cls = ppr $ nodeClass node
88 = hcat $ punctuate space
89 $ map (\n -> text "-" <> ppr n)
90 $ uniqSetToList $ nodeExclusions node
93 = hcat $ punctuate space
94 $ map (\n -> text "+" <> ppr n)
97 expref = if and [isEmptyUniqSet (nodeExclusions node), null (nodePreference node)]
99 else text "\\n" <> (excludes <+> preferences)
101 -- if the node has been colored then show that,
102 -- otherwise indicate whether it looks trivially colorable.
104 | Just c <- nodeColor node
105 = text "\\n(" <> ppr c <> text ")"
107 | triv (nodeClass node) (nodeConflicts node) (nodeExclusions node)
108 = text "\\n(" <> text "triv" <> text ")"
111 = text "\\n(" <> text "spill?" <> text ")"
113 label = name <> text " :: " <> cls
117 pcolorC = case nodeColor node of
118 Nothing -> text "style=filled fillcolor=white"
119 Just c -> text "style=filled fillcolor=" <> doubleQuotes (colorMap c)
122 pout = text "node [label=" <> doubleQuotes label <> space <> pcolorC <> text "]"
123 <> space <> doubleQuotes name
129 -- | Nodes in the graph are doubly linked, but we only want one edge for each
130 -- conflict if the graphviz graph. Traverse over the graph, but make sure
131 -- to only print the edges for each node once.
135 , Outputable k, Outputable cls, Outputable color)
138 -> (UniqSet k, Maybe SDoc)
140 dotNodeEdges visited node
141 | elementOfUniqSet (nodeId node) visited
147 = map (dotEdgeConflict (nodeId node))
149 $ minusUniqSet (nodeConflicts node) visited
152 = map (dotEdgeCoalesce (nodeId node))
154 $ minusUniqSet (nodeCoalesce node) visited
156 out = vcat dconflicts
159 in ( addOneToUniqSet visited (nodeId node)
162 where dotEdgeConflict u1 u2
163 = doubleQuotes (ppr u1) <> text " -- " <> doubleQuotes (ppr u2)
166 dotEdgeCoalesce u1 u2
167 = doubleQuotes (ppr u1) <> text " -- " <> doubleQuotes (ppr u2)
168 <> space <> text "[ style = dashed ];"