X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FnativeGen%2FGraphPpr.hs;h=1df5158dc22f5db24ca159d0751d01796c697a7e;hb=272f0ba89eca1d9fc700cf4c27b9f8c3e23d6fe8;hp=a2a64bcf1e5346f4111eb2d1a253d359596eb8aa;hpb=0f7d268d00795a58a06ae3c92ebbd14571295b84;p=ghc-hetmet.git

diff --git a/compiler/nativeGen/GraphPpr.hs b/compiler/nativeGen/GraphPpr.hs
index a2a64bc..1df5158 100644
--- a/compiler/nativeGen/GraphPpr.hs
+++ b/compiler/nativeGen/GraphPpr.hs
@@ -27,6 +27,10 @@ dumpGraph 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 " 
@@ -69,6 +73,13 @@ dotGraph colorMap triv graph
 		++ [ 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
@@ -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.
 
+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
@@ -141,9 +159,11 @@ dotNodeEdges visited node
 	  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 ];"