Try and allocate vregs spilled/reloaded from some slot to the same hreg
[ghc-hetmet.git] / compiler / nativeGen / GraphPpr.hs
index a2a64bc..1df5158 100644 (file)
@@ -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 ];"