Whitespace only in nativeGen/RegAlloc/Graph/TrivColorable.hs
[ghc-hetmet.git] / compiler / utils / GraphColor.hs
index bd777b7..8dc4121 100644 (file)
@@ -1,9 +1,9 @@
+{-# OPTIONS -fno-warn-missing-signatures #-}
 
 -- | Graph Coloring.
 --     This is a generic graph coloring library, abstracted over the type of
 --     the node keys, nodes and colors.
 --
-{-# OPTIONS -fno-warn-missing-signatures #-}
 
 module GraphColor ( 
        module GraphBase,
@@ -39,6 +39,7 @@ colorGraph
           , Eq color, Eq cls, Ord k
           , Outputable k, Outputable cls, Outputable color)
        => Bool                         -- ^ whether to do iterative coalescing
+       -> Int                          -- ^ how many times we've tried to color this graph so far.
        -> UniqFM (UniqSet color)       -- ^ map of (node class -> set of colors available for this class).
        -> Triv   k cls color           -- ^ fn to decide whether a node is trivially colorable.
        -> (Graph k cls color -> k)     -- ^ fn to choose a node to potentially leave uncolored if nothing is trivially colorable.
@@ -49,14 +50,22 @@ colorGraph
           , UniqFM  k )                -- map of regs (r1 -> r2) that were coaleced
                                        --       r1 should be replaced by r2 in the source
 
-colorGraph iterative colors triv spill graph0
+colorGraph iterative spinCount colors triv spill graph0
  = let
-       -- If we're not doing iterative coalescing then just do a conservative
-       --      coalescing stage at the front.
+       -- If we're not doing iterative coalescing then do an aggressive coalescing first time
+       --      around and then conservative coalescing for subsequent passes.
+       --
+       --      Aggressive coalescing is a quick way to get rid of many reg-reg moves. However, if
+       --      there is a lot of register pressure and we do it on every round then it can make the
+       --      graph less colorable and prevent the algorithm from converging in a sensible number
+       --      of cycles.
+       --
        (graph_coalesced, kksCoalesce1)
-               = if not iterative
-                       then coalesceGraph True triv graph0
-                       else (graph0, [])
+        = if iterative
+               then (graph0, [])
+               else if spinCount == 0
+                       then coalesceGraph True  triv graph0
+                       else coalesceGraph False triv graph0
 
        -- run the scanner to slurp out all the trivially colorable nodes
        --      (and do coalescing if iterative coalescing is enabled)
@@ -89,12 +98,13 @@ colorGraph iterative colors triv spill graph0
        --      with the provided triv function.
         --
    in  if not $ null ksNoTriv
-        then   pprPanic "colorGraph: trivially colorable nodes didn't color!" empty
-{-                     (  empty
+        then   pprPanic "colorGraph: trivially colorable nodes didn't color!" -- empty
+                       (  empty
                        $$ text "ksTriv    = " <> ppr ksTriv
                        $$ text "ksNoTriv  = " <> ppr ksNoTriv
+                       $$ text "colors    = " <> ppr colors
                        $$ empty
-                       $$ dotGraph (\x -> text "white") triv graph1) -}
+                       $$ dotGraph (\_ -> text "white") triv graph_triv) 
 
         else   ( graph_prob
                , mkUniqSet ksNoColor   -- the nodes that didn't color (spills)
@@ -122,7 +132,7 @@ colorGraph iterative colors triv spill graph0
 colorScan
        :: ( Uniquable k, Uniquable cls, Uniquable color
           , Ord k,       Eq cls
-          , Outputable k, Outputable color)
+          , Outputable k, Outputable cls)
        => Bool                         -- ^ whether to do iterative coalescing
        -> Triv k cls color             -- ^ fn to decide whether a node is trivially colorable
        -> (Graph k cls color -> k)     -- ^ fn to choose a node to potentially leave uncolored if nothing is trivially colorable.
@@ -215,7 +225,8 @@ colorScan_spill iterative triv spill graph
 -- | Try to assign a color to all these nodes.
 
 assignColors 
-       :: ( Uniquable k, Uniquable cls, Uniquable color, Eq color )
+       :: ( Uniquable k, Uniquable cls, Uniquable color
+          , Eq color, Outputable cls)
        => UniqFM (UniqSet color)       -- ^ map of (node class -> set of colors available for this class).
        -> Graph k cls color            -- ^ the graph
        -> [k]                          -- ^ nodes to assign a color to.
@@ -252,7 +263,8 @@ assignColors colors graph ks
 --     returns Nothing if no color can be assigned to this node.
 --
 selectColor
-       :: ( Uniquable k, Uniquable cls, Uniquable color, Eq color)
+       :: ( Uniquable k, Uniquable cls, Uniquable color
+          , Eq color, Outputable cls)
        => UniqFM (UniqSet color)       -- ^ map of (node class -> set of colors available for this class).
        -> Graph k cls color            -- ^ the graph
        -> k                            -- ^ key of the node to select a color for.
@@ -263,8 +275,10 @@ selectColor colors graph u
        Just node       = lookupNode graph u
 
        -- lookup the available colors for the class of this node.
-       Just colors_avail
-                       = lookupUFM colors (nodeClass node)
+       colors_avail
+        = case lookupUFM colors (nodeClass node) of
+               Nothing -> pprPanic "selectColor: no colors available for class " (ppr (nodeClass node))
+               Just cs -> cs
 
        -- find colors we can't use because they're already being used
        --      by a node that conflicts with this one.