change of representation for GenCmm, GenCmmTop, CmmProc

[ghc-hetmet.git] / compiler / nativeGen / GraphOps.hs

diff --git a/compiler/nativeGen/GraphOps.hs b/compiler/nativeGen/GraphOps.hs
index 96c8e4e..f620d8a 100644 (file)
--- a/compiler/nativeGen/GraphOps.hs
+++ b/compiler/nativeGen/GraphOps.hs
@@ -1,13 +1,6 @@
-
 -- | Basic operations on graphs.
 --
-
-{-# OPTIONS -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/CodingStyle#Warnings
--- for details
+{-# OPTIONS -fno-warn-missing-signatures #-}
 
 module GraphOps (
        addNode,        delNode,        getNode,        lookupNode,     modNode,
@@ -275,10 +268,11 @@ addPreference (u, c) color
 --
 coalesceGraph
        :: (Uniquable k, Ord k, Eq cls, Outputable k)
-       =>  Graph k cls color
+       => Triv k cls color
+       -> Graph k cls color
        -> (Graph k cls color, [(k, k)])
 
-coalesceGraph graph
+coalesceGraph triv graph
  = let
        -- find all the nodes that have coalescence edges
        cNodes  = filter (\node -> not $ isEmptyUniqSet (nodeCoalesce node))
@@ -297,7 +291,7 @@ coalesceGraph graph
        -- do the coalescing, returning the new graph and a list of pairs of keys
        --      that got coalesced together.
        (graph', mPairs)
-               = mapAccumL coalesceNodes graph cList
+               = mapAccumL (coalesceNodes False triv) graph cList
 
    in  (graph', catMaybes mPairs)
 
@@ -312,32 +306,33 @@ coalesceGraph graph
 
 coalesceNodes
        :: (Uniquable k, Ord k, Eq cls, Outputable k)
-       => Graph k cls color
+       => Bool                 -- ^ If True, coalesce nodes even if this might make the graph
+                               --      less colorable (aggressive coalescing)
+       -> Triv  k cls color
+       -> Graph k cls color
        -> (k, k)               -- ^ keys of the nodes to be coalesced
        -> (Graph k cls color, Maybe (k, k))
 
-coalesceNodes graph (k1, k2)
+coalesceNodes aggressive triv graph (k1, k2)
        | (kMin, kMax)  <- if k1 < k2
                                then (k1, k2)
                                else (k2, k1)
 
-       -- nodes must be in the graph
-       , Just nMin     <- lookupNode graph kMin
-       , Just nMax     <- lookupNode graph kMax
+       -- the nodes being coalesced must be in the graph
+       , Just nMin             <- lookupNode graph kMin
+       , Just nMax             <- lookupNode graph kMax
 
-       -- can't coalesce conflicting nodes
+       -- can't coalesce conflicting modes
        , not $ elementOfUniqSet kMin (nodeConflicts nMax)
        , not $ elementOfUniqSet kMax (nodeConflicts nMin)
 
-       = coalesceNodes' graph kMin kMax nMin nMax
-
+       = coalesceNodes_merge aggressive triv graph kMin kMax nMin nMax
 
-
-       -- one of the nodes wasn't in the graph anymore
+       -- don't do the coalescing after all
        | otherwise
        = (graph, Nothing)
 
-coalesceNodes' graph kMin kMax nMin nMax
+coalesceNodes_merge aggressive triv graph kMin kMax nMin nMax
 
        -- sanity checks
        | nodeClass nMin /= nodeClass nMax
@@ -371,9 +366,20 @@ coalesceNodes' graph kMin kMax nMin nMax
                                        `delOneFromUniqSet` kMax
                        }
 
-               -- delete the old nodes from the graph and add the new one
-               graph'  = addNode kMin node
-                       $ delNode kMin
+         in    coalesceNodes_check aggressive triv graph kMin kMax node
+
+coalesceNodes_check aggressive triv graph kMin kMax node
+
+       -- Unless we're coalescing aggressively, if the result node is not trivially
+       --      colorable then don't do the coalescing.
+       | not aggressive
+       , not $ triv (nodeClass node) (nodeConflicts node) (nodeExclusions node)
+       = (graph, Nothing)
+
+       | otherwise
+       = let -- delete the old nodes from the graph and add the new one
+               graph'  = addNode kMin node
+                       $ delNode kMin
                        $ delNode kMax
                        $ graph
 
@@ -419,7 +425,7 @@ slurpNodeConflictCount
 
 slurpNodeConflictCount graph
        = addListToUFM_C
-               (\(c1, n1) (c2, n2) -> (c1, n1 + n2))
+               (\(c1, n1) (_, n2) -> (c1, n1 + n2))
                emptyUFM
        $ map   (\node
                  -> let count  = sizeUniqSet $ nodeConflicts node
@@ -448,7 +454,7 @@ adjustWithDefaultUFM
 
 adjustWithDefaultUFM f def k map
        = addToUFM_C 
-               (\old new -> f old)
+               (\old _ -> f old)
                map
                k def