+
+-- | Do agressive coalescing on this graph.
+-- returns the new graph and the list of pairs of nodes that got coaleced together.
+-- for each pair, the resulting node will have the least key and be second in the pair.
+--
+coalesceGraph
+ :: (Uniquable k, Ord k, Eq cls, Outputable k)
+ => Bool -- ^ If True, coalesce nodes even if this might make the graph
+ -- less colorable (aggressive coalescing)
+ -> Triv k cls color
+ -> Graph k cls color
+ -> (Graph k cls color, [(k, k)])
+
+coalesceGraph aggressive triv graph
+ = coalesceGraph' aggressive triv graph []
+
+coalesceGraph' aggressive triv graph kkPairsAcc
+ = let
+ -- find all the nodes that have coalescence edges
+ cNodes = filter (\node -> not $ isEmptyUniqSet (nodeCoalesce node))
+ $ eltsUFM $ graphMap graph
+
+ -- build a list of pairs of keys for node's we'll try and coalesce
+ -- every pair of nodes will appear twice in this list
+ -- ie [(k1, k2), (k2, k1) ... ]
+ -- This is ok, GrapOps.coalesceNodes handles this and it's convenient for
+ -- build a list of what nodes get coalesced together for later on.
+ --
+ cList = [ (nodeId node1, k2)
+ | node1 <- cNodes
+ , k2 <- uniqSetToList $ nodeCoalesce node1 ]
+
+ -- do the coalescing, returning the new graph and a list of pairs of keys
+ -- that got coalesced together.
+ (graph', mPairs)
+ = mapAccumL (coalesceNodes aggressive triv) graph cList
+
+ -- keep running until there are no more coalesces can be found
+ in case catMaybes mPairs of
+ [] -> (graph', kkPairsAcc)
+ pairs -> coalesceGraph' aggressive triv graph' (pairs ++ kkPairsAcc)
+
+
+-- | 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
+-- the second element of the pair being the least one
+--
+-- Nothing if either of the nodes weren't in the graph
+
+coalesceNodes
+ :: (Uniquable k, Ord k, Eq cls, Outputable k)
+ => 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 aggressive triv graph (k1, k2)
+ | (kMin, kMax) <- if k1 < k2
+ then (k1, k2)
+ else (k2, k1)
+
+ -- the nodes being coalesced must be in the graph
+ , Just nMin <- lookupNode graph kMin
+ , Just nMax <- lookupNode graph kMax
+
+ -- can't coalesce conflicting modes
+ , not $ elementOfUniqSet kMin (nodeConflicts nMax)
+ , not $ elementOfUniqSet kMax (nodeConflicts nMin)
+
+ = coalesceNodes_merge aggressive triv graph kMin kMax nMin nMax
+
+ -- don't do the coalescing after all
+ | otherwise
+ = (graph, Nothing)
+
+coalesceNodes_merge aggressive triv graph kMin kMax nMin nMax
+
+ -- sanity checks
+ | nodeClass nMin /= nodeClass nMax
+ = error "GraphOps.coalesceNodes: can't coalesce nodes of different classes."
+
+ | not (isNothing (nodeColor nMin) && isNothing (nodeColor nMax))
+ = error "GraphOps.coalesceNodes: can't coalesce colored nodes."
+
+ ---
+ | otherwise
+ = let
+ -- the new node gets all the edges from its two components
+ node =
+ Node { nodeId = kMin
+ , nodeClass = nodeClass nMin
+ , nodeColor = Nothing
+
+ -- nodes don't conflict with themselves..
+ , nodeConflicts
+ = (unionUniqSets (nodeConflicts nMin) (nodeConflicts nMax))
+ `delOneFromUniqSet` kMin
+ `delOneFromUniqSet` kMax
+
+ , nodeExclusions = unionUniqSets (nodeExclusions nMin) (nodeExclusions nMax)
+ , nodePreference = nodePreference nMin ++ nodePreference nMax
+
+ -- nodes don't coalesce with themselves..
+ , nodeCoalesce
+ = (unionUniqSets (nodeCoalesce nMin) (nodeCoalesce nMax))
+ `delOneFromUniqSet` kMin
+ `delOneFromUniqSet` kMax
+ }
+
+ 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
+
+ in (graph', Just (kMax, kMin))
+
+
+-- | Freeze a node
+-- This is for the iterative coalescer.
+-- By freezing a node we give up on ever coalescing it.
+-- Move all its coalesce edges into the frozen set - and update
+-- back edges from other nodes.