Remove CPP from nativeGen/RegAlloc/Graph/TrivColorable.hs

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

diff --git a/compiler/utils/GraphOps.hs b/compiler/utils/GraphOps.hs
index 972dd07..1fa4199 100644 (file)
--- a/compiler/utils/GraphOps.hs
+++ b/compiler/utils/GraphOps.hs
@@ -1,8 +1,6 @@
+{-# OPTIONS -fno-warn-missing-signatures #-}
 -- | Basic operations on graphs.
 --
---     TODO: refine coalescing crieteria
-
-{-# OPTIONS -fno-warn-missing-signatures #-}
 
 module GraphOps (
        addNode,        delNode,        getNode,        lookupNode,     modNode,
@@ -10,7 +8,7 @@ module GraphOps (
        union,
        addConflict,    delConflict,    addConflicts,
        addCoalesce,    delCoalesce,    
-       addExclusion,   
+       addExclusion,   addExclusions,
        addPreference,
        coalesceNodes,  coalesceGraph,
        freezeNode,     freezeOneInGraph, freezeAllInGraph,
@@ -63,14 +61,14 @@ addNode k node graph
        -- add back conflict edges from other nodes to this one
        map_conflict    
                = foldUniqSet 
-                       (adjustUFM (\n -> n { nodeConflicts = addOneToUniqSet (nodeConflicts n) k}))
+                       (adjustUFM_C (\n -> n { nodeConflicts = addOneToUniqSet (nodeConflicts n) k}))
                        (graphMap graph)
                        (nodeConflicts node)
                        
        -- add back coalesce edges from other nodes to this one
        map_coalesce
                = foldUniqSet
-                       (adjustUFM (\n -> n { nodeCoalesce = addOneToUniqSet (nodeCoalesce n) k}))
+                       (adjustUFM_C (\n -> n { nodeCoalesce = addOneToUniqSet (nodeCoalesce n) k}))
                        map_conflict
                        (nodeCoalesce node)
        
@@ -215,6 +213,14 @@ addExclusion u getClass color
                (newNode u (getClass u))        { nodeExclusions = unitUniqSet color }
                u
 
+addExclusions
+       :: (Uniquable k, Uniquable color)
+       => k -> (k -> cls) -> [color]
+       -> Graph k cls color -> Graph k cls color
+
+addExclusions u getClass colors graph
+       = foldr (addExclusion u getClass) graph colors
+
 
 -- | Add a coalescence edge to the graph, creating nodes if requried.
 --     It is considered adventageous to assign the same color to nodes in a coalesence.
@@ -307,7 +313,7 @@ coalesceGraph' aggressive triv graph kkPairsAcc
         pairs  -> coalesceGraph' aggressive triv graph' (reverse pairs ++ kkPairsAcc)
 
 
--- | Coalesce this pair of nodes unconditionally / agressively.
+-- | Coalesce this pair of nodes unconditionally \/ agressively.
 --     The resulting node is the one with the least key.
 --
 --     returns: Just    the pair of keys if the nodes were coalesced
@@ -337,6 +343,9 @@ coalesceNodes aggressive triv graph (k1, k2)
        , not $ elementOfUniqSet kMin (nodeConflicts nMax)
        , not $ elementOfUniqSet kMax (nodeConflicts nMin)
 
+       -- can't coalesce the same node
+       , nodeId nMin /= nodeId nMax
+
        = coalesceNodes_merge aggressive triv graph kMin kMax nMin nMax
 
        -- don't do the coalescing after all
@@ -352,9 +361,6 @@ coalesceNodes_merge aggressive triv graph kMin kMax nMin nMax
        | not (isNothing (nodeColor nMin) && isNothing (nodeColor nMax))
        = error "GraphOps.coalesceNodes: can't coalesce colored nodes."
 
-       | nodeId nMin == nodeId nMax
-       = error "GraphOps.coalesceNodes: can't coalesce the same node."
-
        ---
        | otherwise
        = let
@@ -414,8 +420,7 @@ freezeNode
 freezeNode k
   = graphMapModify
   $ \fm ->
-    let
-       -- freeze all the edges in the node to be frozen
+    let        -- freeze all the edges in the node to be frozen
        Just node = lookupUFM fm k
        node'   = node
                { nodeCoalesce          = emptyUniqSet }
@@ -425,11 +430,11 @@ freezeNode k
        -- update back edges pointing to this node
        freezeEdge k node
         = if elementOfUniqSet k (nodeCoalesce node)
-               then node
-                       { nodeCoalesce          = delOneFromUniqSet (nodeCoalesce node) k }
-               else    panic "GraphOps.freezeNode: edge to freeze wasn't in the coalesce set"
+               then node { nodeCoalesce = delOneFromUniqSet (nodeCoalesce node) k }
+               else node       -- panic "GraphOps.freezeNode: edge to freeze wasn't in the coalesce set"
+                               -- If the edge isn't actually in the coelesce set then just ignore it.
 
-       fm2     = foldUniqSet (adjustUFM (freezeEdge k)) fm1
+       fm2     = foldUniqSet (adjustUFM_C (freezeEdge k)) fm1
                        $ nodeCoalesce node
 
     in fm2
@@ -445,7 +450,7 @@ freezeNode k
 --     classes.. this is just a heuristic, after all.
 --
 --     IDEA:   freezing a node might free it up for Simplify.. would be good to check for triv
---             right here, and add it to a worklist if known triv/non-move nodes.
+--             right here, and add it to a worklist if known triv\/non-move nodes.
 --
 freezeOneInGraph
        :: (Uniquable k, Outputable k)
@@ -599,7 +604,7 @@ setColor
        
 setColor u color
        = graphMapModify
-       $ adjustUFM
+       $ adjustUFM_C
                (\n -> n { nodeColor = Just color })
                u 
        
@@ -616,13 +621,14 @@ adjustWithDefaultUFM f def k map
                map
                k def
                
-{-# INLINE adjustUFM #-}
-adjustUFM 
+-- Argument order different from UniqFM's adjustUFM
+{-# INLINE adjustUFM_C #-}
+adjustUFM_C 
        :: Uniquable k
        => (a -> a)
        -> k -> UniqFM a -> UniqFM a
 
-adjustUFM f k map
+adjustUFM_C f k map
  = case lookupUFM map k of
        Nothing -> map
        Just a  -> addToUFM map k (f a)