X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FnativeGen%2FGraphPpr.hs;h=1df5158dc22f5db24ca159d0751d01796c697a7e;hb=86f1f4e0748ba1146cf74786af38a68a88164e2f;hp=29148fa6c4ecaf2c5cd1d1f1f77b0b411dc5eecd;hpb=17b297d97d327620ed6bfab942f8992b2446f1bf;p=ghc-hetmet.git

diff --git a/compiler/nativeGen/GraphPpr.hs b/compiler/nativeGen/GraphPpr.hs
index 29148fa..1df5158 100644
--- a/compiler/nativeGen/GraphPpr.hs
+++ b/compiler/nativeGen/GraphPpr.hs
@@ -1,13 +1,6 @@
 
 -- | Pretty printing of graphs.
 
-{-# OPTIONS_GHC -w #-}
--- The above warning supression flag is a temporary kludge.
--- While working on this module you are encouraged to remove it and fix
--- any warnings in the module. See
---     http://hackage.haskell.org/trac/ghc/wiki/WorkingConventions#Warnings
--- for details
-
 module GraphPpr (
 	dumpGraph,
 	dotGraph
@@ -34,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 " 
@@ -76,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
@@ -126,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
@@ -148,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 ];"