-- | Basic operations on graphs.
--

module GraphOps (
        addNode,        delNode,        getNode,       lookupNode,     modNode,
        size,
        union,
        addConflict,    delConflict,    addConflicts,
        addCoalesce,    delCoalesce,
        addExclusion,   addExclusions,
        addPreference,
        coalesceNodes,  coalesceGraph,
        freezeNode,     freezeOneInGraph, freezeAllInGraph,
        scanGraph,
        setColor,
        validateGraph,
        slurpNodeConflictCount
)
where

import GhcPrelude

import GraphBase

import Outputable
import Unique
import UniqSet
import UniqFM

import Data.List        hiding (union)
import Data.Maybe

-- | Lookup a node from the graph.
lookupNode
        :: Uniquable k
        => Graph k cls color
        -> k -> Maybe (Node  k cls color)

lookupNode :: Graph k cls color -> k -> Maybe (Node k cls color)
lookupNode graph :: Graph k cls color
graph k :: k
k
        = UniqFM (Node k cls color) -> k -> Maybe (Node k cls color)
forall key elt. Uniquable key => UniqFM elt -> key -> Maybe elt
lookupUFM (Graph k cls color -> UniqFM (Node k cls color)
forall k cls color. Graph k cls color -> UniqFM (Node k cls color)
graphMap Graph k cls color
graph) k
k


-- | Get a node from the graph, throwing an error if it's not there
getNode
        :: Uniquable k
        => Graph k cls color
        -> k -> Node k cls color

getNode :: Graph k cls color -> k -> Node k cls color
getNode graph :: Graph k cls color
graph k :: k
k
 = case UniqFM (Node k cls color) -> k -> Maybe (Node k cls color)
forall key elt. Uniquable key => UniqFM elt -> key -> Maybe elt
lookupUFM (Graph k cls color -> UniqFM (Node k cls color)
forall k cls color. Graph k cls color -> UniqFM (Node k cls color)
graphMap Graph k cls color
graph) k
k of
        Just node :: Node k cls color
node       -> Node k cls color
node
        Nothing         -> String -> Node k cls color
forall a. String -> a
panic "ColorOps.getNode: not found"


-- | Add a node to the graph, linking up its edges
addNode :: Uniquable k
        => k -> Node k cls color
        -> Graph k cls color -> Graph k cls color

addNode :: k -> Node k cls color -> Graph k cls color -> Graph k cls color
addNode k :: k
k node :: Node k cls color
node graph :: Graph k cls color
graph
 = let
        -- add back conflict edges from other nodes to this one
        map_conflict :: UniqFM (Node k cls color)
map_conflict =
          (k -> UniqFM (Node k cls color) -> UniqFM (Node k cls color))
-> UniqFM (Node k cls color)
-> UniqSet k
-> UniqFM (Node k cls color)
forall elt a. (elt -> a -> a) -> a -> UniqSet elt -> a
nonDetFoldUniqSet
            -- It's OK to use nonDetFoldUFM here because the
            -- operation is commutative
            ((Node k cls color -> Node k cls color)
-> k -> UniqFM (Node k cls color) -> UniqFM (Node k cls color)
forall k a. Uniquable k => (a -> a) -> k -> UniqFM a -> UniqFM a
adjustUFM_C (\n :: Node k cls color
n -> Node k cls color
n { nodeConflicts :: UniqSet k
nodeConflicts =
                                      UniqSet k -> k -> UniqSet k
forall a. Uniquable a => UniqSet a -> a -> UniqSet a
addOneToUniqSet (Node k cls color -> UniqSet k
forall k cls color. Node k cls color -> UniqSet k
nodeConflicts Node k cls color
n) k
k}))
            (Graph k cls color -> UniqFM (Node k cls color)
forall k cls color. Graph k cls color -> UniqFM (Node k cls color)
graphMap Graph k cls color
graph)
            (Node k cls color -> UniqSet k
forall k cls color. Node k cls color -> UniqSet k
nodeConflicts Node k cls color
node)

        -- add back coalesce edges from other nodes to this one
        map_coalesce :: UniqFM (Node k cls color)
map_coalesce =
          (k -> UniqFM (Node k cls color) -> UniqFM (Node k cls color))
-> UniqFM (Node k cls color)
-> UniqSet k
-> UniqFM (Node k cls color)
forall elt a. (elt -> a -> a) -> a -> UniqSet elt -> a
nonDetFoldUniqSet
            -- It's OK to use nonDetFoldUFM here because the
            -- operation is commutative
            ((Node k cls color -> Node k cls color)
-> k -> UniqFM (Node k cls color) -> UniqFM (Node k cls color)
forall k a. Uniquable k => (a -> a) -> k -> UniqFM a -> UniqFM a
adjustUFM_C (\n :: Node k cls color
n -> Node k cls color
n { nodeCoalesce :: UniqSet k
nodeCoalesce =
                                      UniqSet k -> k -> UniqSet k
forall a. Uniquable a => UniqSet a -> a -> UniqSet a
addOneToUniqSet (Node k cls color -> UniqSet k
forall k cls color. Node k cls color -> UniqSet k
nodeCoalesce Node k cls color
n) k
k}))
            UniqFM (Node k cls color)
map_conflict
            (Node k cls color -> UniqSet k
forall k cls color. Node k cls color -> UniqSet k
nodeCoalesce Node k cls color
node)

  in    Graph k cls color
graph
        { graphMap :: UniqFM (Node k cls color)
graphMap      = UniqFM (Node k cls color)
-> k -> Node k cls color -> UniqFM (Node k cls color)
forall key elt.
Uniquable key =>
UniqFM elt -> key -> elt -> UniqFM elt
addToUFM UniqFM (Node k cls color)
map_coalesce k
k Node k cls color
node}


-- | Delete a node and all its edges from the graph.
delNode :: (Uniquable k)
        => k -> Graph k cls color -> Maybe (Graph k cls color)

delNode :: k -> Graph k cls color -> Maybe (Graph k cls color)
delNode k :: k
k graph :: Graph k cls color
graph
        | Just node :: Node k cls color
node     <- Graph k cls color -> k -> Maybe (Node k cls color)
forall k cls color.
Uniquable k =>
Graph k cls color -> k -> Maybe (Node k cls color)
lookupNode Graph k cls color
graph k
k
        = let   -- delete conflict edges from other nodes to this one.
                graph1 :: Graph k cls color
graph1  = (Graph k cls color -> k -> Graph k cls color)
-> Graph k cls color -> [k] -> Graph k cls color
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\g :: Graph k cls color
g k1 :: k
k1 -> let Just g' :: Graph k cls color
g' = k -> k -> Graph k cls color -> Maybe (Graph k cls color)
forall k cls color.
Uniquable k =>
k -> k -> Graph k cls color -> Maybe (Graph k cls color)
delConflict k
k1 k
k Graph k cls color
g in Graph k cls color
g') Graph k cls color
graph
                        ([k] -> Graph k cls color) -> [k] -> Graph k cls color
forall a b. (a -> b) -> a -> b
$ UniqSet k -> [k]
forall elt. UniqSet elt -> [elt]
nonDetEltsUniqSet (Node k cls color -> UniqSet k
forall k cls color. Node k cls color -> UniqSet k
nodeConflicts Node k cls color
node)

                -- delete coalesce edge from other nodes to this one.
                graph2 :: Graph k cls color
graph2  = (Graph k cls color -> k -> Graph k cls color)
-> Graph k cls color -> [k] -> Graph k cls color
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\g :: Graph k cls color
g k1 :: k
k1 -> let Just g' :: Graph k cls color
g' = k -> k -> Graph k cls color -> Maybe (Graph k cls color)
forall k cls color.
Uniquable k =>
k -> k -> Graph k cls color -> Maybe (Graph k cls color)
delCoalesce k
k1 k
k Graph k cls color
g in Graph k cls color
g') Graph k cls color
graph1
                        ([k] -> Graph k cls color) -> [k] -> Graph k cls color
forall a b. (a -> b) -> a -> b
$ UniqSet k -> [k]
forall elt. UniqSet elt -> [elt]
nonDetEltsUniqSet (Node k cls color -> UniqSet k
forall k cls color. Node k cls color -> UniqSet k
nodeCoalesce Node k cls color
node)
                        -- See Note [Unique Determinism and code generation]

                -- delete the node
                graph3 :: Graph k cls color
graph3  = (UniqFM (Node k cls color) -> UniqFM (Node k cls color))
-> Graph k cls color -> Graph k cls color
forall k cls color.
(UniqFM (Node k cls color) -> UniqFM (Node k cls color))
-> Graph k cls color -> Graph k cls color
graphMapModify (\fm :: UniqFM (Node k cls color)
fm -> UniqFM (Node k cls color) -> k -> UniqFM (Node k cls color)
forall key elt. Uniquable key => UniqFM elt -> key -> UniqFM elt
delFromUFM UniqFM (Node k cls color)
fm k
k) Graph k cls color
graph2

          in    Graph k cls color -> Maybe (Graph k cls color)
forall a. a -> Maybe a
Just Graph k cls color
graph3

        | Bool
otherwise
        = Maybe (Graph k cls color)
forall a. Maybe a
Nothing


-- | Modify a node in the graph.
--      returns Nothing if the node isn't present.
--
modNode :: Uniquable k
        => (Node k cls color -> Node k cls color)
        -> k -> Graph k cls color -> Maybe (Graph k cls color)

modNode :: (Node k cls color -> Node k cls color)
-> k -> Graph k cls color -> Maybe (Graph k cls color)
modNode f :: Node k cls color -> Node k cls color
f k :: k
k graph :: Graph k cls color
graph
 = case Graph k cls color -> k -> Maybe (Node k cls color)
forall k cls color.
Uniquable k =>
Graph k cls color -> k -> Maybe (Node k cls color)
lookupNode Graph k cls color
graph k
k of
        Just Node{}
         -> Graph k cls color -> Maybe (Graph k cls color)
forall a. a -> Maybe a
Just
         (Graph k cls color -> Maybe (Graph k cls color))
-> Graph k cls color -> Maybe (Graph k cls color)
forall a b. (a -> b) -> a -> b
$  (UniqFM (Node k cls color) -> UniqFM (Node k cls color))
-> Graph k cls color -> Graph k cls color
forall k cls color.
(UniqFM (Node k cls color) -> UniqFM (Node k cls color))
-> Graph k cls color -> Graph k cls color
graphMapModify
                 (\fm :: UniqFM (Node k cls color)
fm   -> let  Just node :: Node k cls color
node       = UniqFM (Node k cls color) -> k -> Maybe (Node k cls color)
forall key elt. Uniquable key => UniqFM elt -> key -> Maybe elt
lookupUFM UniqFM (Node k cls color)
fm k
k
                                node' :: Node k cls color
node'           = Node k cls color -> Node k cls color
f Node k cls color
node
                           in   UniqFM (Node k cls color)
-> k -> Node k cls color -> UniqFM (Node k cls color)
forall key elt.
Uniquable key =>
UniqFM elt -> key -> elt -> UniqFM elt
addToUFM UniqFM (Node k cls color)
fm k
k Node k cls color
node')
                Graph k cls color
graph

        Nothing -> Maybe (Graph k cls color)
forall a. Maybe a
Nothing


-- | Get the size of the graph, O(n)
size    :: Graph k cls color -> Int

size :: Graph k cls color -> Int
size graph :: Graph k cls color
graph
        = UniqFM (Node k cls color) -> Int
forall elt. UniqFM elt -> Int
sizeUFM (UniqFM (Node k cls color) -> Int)
-> UniqFM (Node k cls color) -> Int
forall a b. (a -> b) -> a -> b
$ Graph k cls color -> UniqFM (Node k cls color)
forall k cls color. Graph k cls color -> UniqFM (Node k cls color)
graphMap Graph k cls color
graph


-- | Union two graphs together.
union   :: Graph k cls color -> Graph k cls color -> Graph k cls color

union :: Graph k cls color -> Graph k cls color -> Graph k cls color
union   graph1 :: Graph k cls color
graph1 graph2 :: Graph k cls color
graph2
        = Graph :: forall k cls color. UniqFM (Node k cls color) -> Graph k cls color
Graph
        { graphMap :: UniqFM (Node k cls color)
graphMap              = UniqFM (Node k cls color)
-> UniqFM (Node k cls color) -> UniqFM (Node k cls color)
forall elt. UniqFM elt -> UniqFM elt -> UniqFM elt
plusUFM (Graph k cls color -> UniqFM (Node k cls color)
forall k cls color. Graph k cls color -> UniqFM (Node k cls color)
graphMap Graph k cls color
graph1) (Graph k cls color -> UniqFM (Node k cls color)
forall k cls color. Graph k cls color -> UniqFM (Node k cls color)
graphMap Graph k cls color
graph2) }


-- | Add a conflict between nodes to the graph, creating the nodes required.
--      Conflicts are virtual regs which need to be colored differently.
addConflict
        :: Uniquable k
        => (k, cls) -> (k, cls)
        -> Graph k cls color -> Graph k cls color

addConflict :: (k, cls) -> (k, cls) -> Graph k cls color -> Graph k cls color
addConflict (u1 :: k
u1, c1 :: cls
c1) (u2 :: k
u2, c2 :: cls
c2)
 = let  addNeighbor :: k
-> cls
-> k
-> UniqFM (Node k cls color)
-> UniqFM (Node k cls color)
addNeighbor u :: k
u c :: cls
c u' :: k
u'
                = (Node k cls color -> Node k cls color)
-> Node k cls color
-> k
-> UniqFM (Node k cls color)
-> UniqFM (Node k cls color)
forall k a.
Uniquable k =>
(a -> a) -> a -> k -> UniqFM a -> UniqFM a
adjustWithDefaultUFM
                        (\node :: Node k cls color
node -> Node k cls color
node { nodeConflicts :: UniqSet k
nodeConflicts = UniqSet k -> k -> UniqSet k
forall a. Uniquable a => UniqSet a -> a -> UniqSet a
addOneToUniqSet (Node k cls color -> UniqSet k
forall k cls color. Node k cls color -> UniqSet k
nodeConflicts Node k cls color
node) k
u' })
                        (k -> cls -> Node k cls color
forall k cls color. k -> cls -> Node k cls color
newNode k
u cls
c)  { nodeConflicts :: UniqSet k
nodeConflicts = k -> UniqSet k
forall a. Uniquable a => a -> UniqSet a
unitUniqSet k
u' }
                        k
u

   in   (UniqFM (Node k cls color) -> UniqFM (Node k cls color))
-> Graph k cls color -> Graph k cls color
forall k cls color.
(UniqFM (Node k cls color) -> UniqFM (Node k cls color))
-> Graph k cls color -> Graph k cls color
graphMapModify
        ( k
-> cls
-> k
-> UniqFM (Node k cls color)
-> UniqFM (Node k cls color)
forall k cls color.
Uniquable k =>
k
-> cls
-> k
-> UniqFM (Node k cls color)
-> UniqFM (Node k cls color)
addNeighbor k
u1 cls
c1 k
u2
        (UniqFM (Node k cls color) -> UniqFM (Node k cls color))
-> (UniqFM (Node k cls color) -> UniqFM (Node k cls color))
-> UniqFM (Node k cls color)
-> UniqFM (Node k cls color)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. k
-> cls
-> k
-> UniqFM (Node k cls color)
-> UniqFM (Node k cls color)
forall k cls color.
Uniquable k =>
k
-> cls
-> k
-> UniqFM (Node k cls color)
-> UniqFM (Node k cls color)
addNeighbor k
u2 cls
c2 k
u1)


-- | Delete a conflict edge. k1 -> k2
--      returns Nothing if the node isn't in the graph
delConflict
        :: Uniquable k
        => k -> k
        -> Graph k cls color -> Maybe (Graph k cls color)

delConflict :: k -> k -> Graph k cls color -> Maybe (Graph k cls color)
delConflict k1 :: k
k1 k2 :: k
k2
        = (Node k cls color -> Node k cls color)
-> k -> Graph k cls color -> Maybe (Graph k cls color)
forall k cls color.
Uniquable k =>
(Node k cls color -> Node k cls color)
-> k -> Graph k cls color -> Maybe (Graph k cls color)
modNode
                (\node :: Node k cls color
node -> Node k cls color
node { nodeConflicts :: UniqSet k
nodeConflicts = UniqSet k -> k -> UniqSet k
forall a. Uniquable a => UniqSet a -> a -> UniqSet a
delOneFromUniqSet (Node k cls color -> UniqSet k
forall k cls color. Node k cls color -> UniqSet k
nodeConflicts Node k cls color
node) k
k2 })
                k
k1


-- | Add some conflicts to the graph, creating nodes if required.
--      All the nodes in the set are taken to conflict with each other.
addConflicts
        :: Uniquable k
        => UniqSet k -> (k -> cls)
        -> Graph k cls color -> Graph k cls color

addConflicts :: UniqSet k -> (k -> cls) -> Graph k cls color -> Graph k cls color
addConflicts conflicts :: UniqSet k
conflicts getClass :: k -> cls
getClass

        -- just a single node, but no conflicts, create the node anyway.
        | (u :: k
u : [])      <- UniqSet k -> [k]
forall elt. UniqSet elt -> [elt]
nonDetEltsUniqSet UniqSet k
conflicts
        = (UniqFM (Node k cls color) -> UniqFM (Node k cls color))
-> Graph k cls color -> Graph k cls color
forall k cls color.
(UniqFM (Node k cls color) -> UniqFM (Node k cls color))
-> Graph k cls color -> Graph k cls color
graphMapModify
        ((UniqFM (Node k cls color) -> UniqFM (Node k cls color))
 -> Graph k cls color -> Graph k cls color)
-> (UniqFM (Node k cls color) -> UniqFM (Node k cls color))
-> Graph k cls color
-> Graph k cls color
forall a b. (a -> b) -> a -> b
$ (Node k cls color -> Node k cls color)
-> Node k cls color
-> k
-> UniqFM (Node k cls color)
-> UniqFM (Node k cls color)
forall k a.
Uniquable k =>
(a -> a) -> a -> k -> UniqFM a -> UniqFM a
adjustWithDefaultUFM
                Node k cls color -> Node k cls color
forall a. a -> a
id
                (k -> cls -> Node k cls color
forall k cls color. k -> cls -> Node k cls color
newNode k
u (k -> cls
getClass k
u))
                k
u

        | Bool
otherwise
        = (UniqFM (Node k cls color) -> UniqFM (Node k cls color))
-> Graph k cls color -> Graph k cls color
forall k cls color.
(UniqFM (Node k cls color) -> UniqFM (Node k cls color))
-> Graph k cls color -> Graph k cls color
graphMapModify
        ((UniqFM (Node k cls color) -> UniqFM (Node k cls color))
 -> Graph k cls color -> Graph k cls color)
-> (UniqFM (Node k cls color) -> UniqFM (Node k cls color))
-> Graph k cls color
-> Graph k cls color
forall a b. (a -> b) -> a -> b
$ \fm :: UniqFM (Node k cls color)
fm -> (UniqFM (Node k cls color) -> k -> UniqFM (Node k cls color))
-> UniqFM (Node k cls color) -> [k] -> UniqFM (Node k cls color)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\g :: UniqFM (Node k cls color)
g u :: k
u  -> k
-> (k -> cls)
-> UniqSet k
-> UniqFM (Node k cls color)
-> UniqFM (Node k cls color)
forall k cls color.
Uniquable k =>
k
-> (k -> cls)
-> UniqSet k
-> UniqFM (Node k cls color)
-> UniqFM (Node k cls color)
addConflictSet1 k
u k -> cls
getClass UniqSet k
conflicts UniqFM (Node k cls color)
g) UniqFM (Node k cls color)
fm
                ([k] -> UniqFM (Node k cls color))
-> [k] -> UniqFM (Node k cls color)
forall a b. (a -> b) -> a -> b
$ UniqSet k -> [k]
forall elt. UniqSet elt -> [elt]
nonDetEltsUniqSet UniqSet k
conflicts
                -- See Note [Unique Determinism and code generation]


addConflictSet1 :: Uniquable k
                => k -> (k -> cls) -> UniqSet k
                -> UniqFM (Node k cls color)
                -> UniqFM (Node k cls color)
addConflictSet1 :: k
-> (k -> cls)
-> UniqSet k
-> UniqFM (Node k cls color)
-> UniqFM (Node k cls color)
addConflictSet1 u :: k
u getClass :: k -> cls
getClass set :: UniqSet k
set
 = case UniqSet k -> k -> UniqSet k
forall a. Uniquable a => UniqSet a -> a -> UniqSet a
delOneFromUniqSet UniqSet k
set k
u of
    set' :: UniqSet k
set' -> (Node k cls color -> Node k cls color)
-> Node k cls color
-> k
-> UniqFM (Node k cls color)
-> UniqFM (Node k cls color)
forall k a.
Uniquable k =>
(a -> a) -> a -> k -> UniqFM a -> UniqFM a
adjustWithDefaultUFM
                (\node :: Node k cls color
node -> Node k cls color
node                  { nodeConflicts :: UniqSet k
nodeConflicts = UniqSet k -> UniqSet k -> UniqSet k
forall a. UniqSet a -> UniqSet a -> UniqSet a
unionUniqSets UniqSet k
set' (Node k cls color -> UniqSet k
forall k cls color. Node k cls color -> UniqSet k
nodeConflicts Node k cls color
node) } )
                (k -> cls -> Node k cls color
forall k cls color. k -> cls -> Node k cls color
newNode k
u (k -> cls
getClass k
u))        { nodeConflicts :: UniqSet k
nodeConflicts = UniqSet k
set' }
                k
u


-- | Add an exclusion to the graph, creating nodes if required.
--      These are extra colors that the node cannot use.
addExclusion
        :: (Uniquable k, Uniquable color)
        => k -> (k -> cls) -> color
        -> Graph k cls color -> Graph k cls color

addExclusion :: k -> (k -> cls) -> color -> Graph k cls color -> Graph k cls color
addExclusion u :: k
u getClass :: k -> cls
getClass color :: color
color
        = (UniqFM (Node k cls color) -> UniqFM (Node k cls color))
-> Graph k cls color -> Graph k cls color
forall k cls color.
(UniqFM (Node k cls color) -> UniqFM (Node k cls color))
-> Graph k cls color -> Graph k cls color
graphMapModify
        ((UniqFM (Node k cls color) -> UniqFM (Node k cls color))
 -> Graph k cls color -> Graph k cls color)
-> (UniqFM (Node k cls color) -> UniqFM (Node k cls color))
-> Graph k cls color
-> Graph k cls color
forall a b. (a -> b) -> a -> b
$ (Node k cls color -> Node k cls color)
-> Node k cls color
-> k
-> UniqFM (Node k cls color)
-> UniqFM (Node k cls color)
forall k a.
Uniquable k =>
(a -> a) -> a -> k -> UniqFM a -> UniqFM a
adjustWithDefaultUFM
                (\node :: Node k cls color
node -> Node k cls color
node                  { nodeExclusions :: UniqSet color
nodeExclusions = UniqSet color -> color -> UniqSet color
forall a. Uniquable a => UniqSet a -> a -> UniqSet a
addOneToUniqSet (Node k cls color -> UniqSet color
forall k cls color. Node k cls color -> UniqSet color
nodeExclusions Node k cls color
node) color
color })
                (k -> cls -> Node k cls color
forall k cls color. k -> cls -> Node k cls color
newNode k
u (k -> cls
getClass k
u))        { nodeExclusions :: UniqSet color
nodeExclusions = color -> UniqSet color
forall a. Uniquable a => a -> UniqSet a
unitUniqSet color
color }
                k
u

addExclusions
        :: (Uniquable k, Uniquable color)
        => k -> (k -> cls) -> [color]
        -> Graph k cls color -> Graph k cls color

addExclusions :: k
-> (k -> cls) -> [color] -> Graph k cls color -> Graph k cls color
addExclusions u :: k
u getClass :: k -> cls
getClass colors :: [color]
colors graph :: Graph k cls color
graph
        = (color -> Graph k cls color -> Graph k cls color)
-> Graph k cls color -> [color] -> Graph k cls color
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (k -> (k -> cls) -> color -> Graph k cls color -> Graph k cls color
forall k color cls.
(Uniquable k, Uniquable color) =>
k -> (k -> cls) -> color -> Graph k cls color -> Graph k cls color
addExclusion k
u k -> cls
getClass) Graph k cls color
graph [color]
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.
addCoalesce
        :: Uniquable k
        => (k, cls) -> (k, cls)
        -> Graph k cls color -> Graph k cls color

addCoalesce :: (k, cls) -> (k, cls) -> Graph k cls color -> Graph k cls color
addCoalesce (u1 :: k
u1, c1 :: cls
c1) (u2 :: k
u2, c2 :: cls
c2)
 = let  addCoalesce :: k
-> cls
-> k
-> UniqFM (Node k cls color)
-> UniqFM (Node k cls color)
addCoalesce u :: k
u c :: cls
c u' :: k
u'
         =      (Node k cls color -> Node k cls color)
-> Node k cls color
-> k
-> UniqFM (Node k cls color)
-> UniqFM (Node k cls color)
forall k a.
Uniquable k =>
(a -> a) -> a -> k -> UniqFM a -> UniqFM a
adjustWithDefaultUFM
                        (\node :: Node k cls color
node -> Node k cls color
node { nodeCoalesce :: UniqSet k
nodeCoalesce = UniqSet k -> k -> UniqSet k
forall a. Uniquable a => UniqSet a -> a -> UniqSet a
addOneToUniqSet (Node k cls color -> UniqSet k
forall k cls color. Node k cls color -> UniqSet k
nodeCoalesce Node k cls color
node) k
u' })
                        (k -> cls -> Node k cls color
forall k cls color. k -> cls -> Node k cls color
newNode k
u cls
c)  { nodeCoalesce :: UniqSet k
nodeCoalesce = k -> UniqSet k
forall a. Uniquable a => a -> UniqSet a
unitUniqSet k
u' }
                        k
u

   in   (UniqFM (Node k cls color) -> UniqFM (Node k cls color))
-> Graph k cls color -> Graph k cls color
forall k cls color.
(UniqFM (Node k cls color) -> UniqFM (Node k cls color))
-> Graph k cls color -> Graph k cls color
graphMapModify
        ( k
-> cls
-> k
-> UniqFM (Node k cls color)
-> UniqFM (Node k cls color)
forall k cls color.
Uniquable k =>
k
-> cls
-> k
-> UniqFM (Node k cls color)
-> UniqFM (Node k cls color)
addCoalesce k
u1 cls
c1 k
u2
        (UniqFM (Node k cls color) -> UniqFM (Node k cls color))
-> (UniqFM (Node k cls color) -> UniqFM (Node k cls color))
-> UniqFM (Node k cls color)
-> UniqFM (Node k cls color)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. k
-> cls
-> k
-> UniqFM (Node k cls color)
-> UniqFM (Node k cls color)
forall k cls color.
Uniquable k =>
k
-> cls
-> k
-> UniqFM (Node k cls color)
-> UniqFM (Node k cls color)
addCoalesce k
u2 cls
c2 k
u1)


-- | Delete a coalescence edge (k1 -> k2) from the graph.
delCoalesce
        :: Uniquable k
        => k -> k
        -> Graph k cls color    -> Maybe (Graph k cls color)

delCoalesce :: k -> k -> Graph k cls color -> Maybe (Graph k cls color)
delCoalesce k1 :: k
k1 k2 :: k
k2
        = (Node k cls color -> Node k cls color)
-> k -> Graph k cls color -> Maybe (Graph k cls color)
forall k cls color.
Uniquable k =>
(Node k cls color -> Node k cls color)
-> k -> Graph k cls color -> Maybe (Graph k cls color)
modNode (\node :: Node k cls color
node -> Node k cls color
node { nodeCoalesce :: UniqSet k
nodeCoalesce = UniqSet k -> k -> UniqSet k
forall a. Uniquable a => UniqSet a -> a -> UniqSet a
delOneFromUniqSet (Node k cls color -> UniqSet k
forall k cls color. Node k cls color -> UniqSet k
nodeCoalesce Node k cls color
node) k
k2 })
                k
k1


-- | Add a color preference to the graph, creating nodes if required.
--      The most recently added preference is the most prefered.
--      The algorithm tries to assign a node it's prefered color if possible.
--
addPreference
        :: Uniquable k
        => (k, cls) -> color
        -> Graph k cls color -> Graph k cls color

addPreference :: (k, cls) -> color -> Graph k cls color -> Graph k cls color
addPreference (u :: k
u, c :: cls
c) color :: color
color
        = (UniqFM (Node k cls color) -> UniqFM (Node k cls color))
-> Graph k cls color -> Graph k cls color
forall k cls color.
(UniqFM (Node k cls color) -> UniqFM (Node k cls color))
-> Graph k cls color -> Graph k cls color
graphMapModify
        ((UniqFM (Node k cls color) -> UniqFM (Node k cls color))
 -> Graph k cls color -> Graph k cls color)
-> (UniqFM (Node k cls color) -> UniqFM (Node k cls color))
-> Graph k cls color
-> Graph k cls color
forall a b. (a -> b) -> a -> b
$ (Node k cls color -> Node k cls color)
-> Node k cls color
-> k
-> UniqFM (Node k cls color)
-> UniqFM (Node k cls color)
forall k a.
Uniquable k =>
(a -> a) -> a -> k -> UniqFM a -> UniqFM a
adjustWithDefaultUFM
                (\node :: Node k cls color
node -> Node k cls color
node { nodePreference :: [color]
nodePreference = color
color color -> [color] -> [color]
forall a. a -> [a] -> [a]
: (Node k cls color -> [color]
forall k cls color. Node k cls color -> [color]
nodePreference Node k cls color
node) })
                (k -> cls -> Node k cls color
forall k cls color. k -> cls -> Node k cls color
newNode k
u cls
c)  { nodePreference :: [color]
nodePreference = [color
color] }
                k
u


-- | Do aggressive coalescing on this graph.
--      returns the new graph and the list of pairs of nodes that got coalesced 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)])          -- pairs of nodes that were coalesced, in the order that the
                                --      coalescing was applied.

coalesceGraph :: Bool
-> Triv k cls color
-> Graph k cls color
-> (Graph k cls color, [(k, k)])
coalesceGraph aggressive :: Bool
aggressive triv :: Triv k cls color
triv graph :: Graph k cls color
graph
        = Bool
-> Triv k cls color
-> Graph k cls color
-> [(k, k)]
-> (Graph k cls color, [(k, k)])
forall k cls color.
(Uniquable k, Ord k, Eq cls, Outputable k) =>
Bool
-> Triv k cls color
-> Graph k cls color
-> [(k, k)]
-> (Graph k cls color, [(k, k)])
coalesceGraph' Bool
aggressive Triv k cls color
triv Graph k cls color
graph []

coalesceGraph'
        :: (Uniquable k, Ord k, Eq cls, Outputable k)
        => Bool
        -> Triv k cls color
        -> Graph k cls color
        -> [(k, k)]
        -> ( Graph k cls color
           , [(k, k)])
coalesceGraph' :: Bool
-> Triv k cls color
-> Graph k cls color
-> [(k, k)]
-> (Graph k cls color, [(k, k)])
coalesceGraph' aggressive :: Bool
aggressive triv :: Triv k cls color
triv graph :: Graph k cls color
graph kkPairsAcc :: [(k, k)]
kkPairsAcc
 = let
        -- find all the nodes that have coalescence edges
        cNodes :: [Node k cls color]
cNodes  = (Node k cls color -> Bool)
-> [Node k cls color] -> [Node k cls color]
forall a. (a -> Bool) -> [a] -> [a]
filter (\node :: Node k cls color
node -> Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ UniqSet k -> Bool
forall a. UniqSet a -> Bool
isEmptyUniqSet (Node k cls color -> UniqSet k
forall k cls color. Node k cls color -> UniqSet k
nodeCoalesce Node k cls color
node))
                ([Node k cls color] -> [Node k cls color])
-> [Node k cls color] -> [Node k cls color]
forall a b. (a -> b) -> a -> b
$ UniqFM (Node k cls color) -> [Node k cls color]
forall elt. UniqFM elt -> [elt]
nonDetEltsUFM (UniqFM (Node k cls color) -> [Node k cls color])
-> UniqFM (Node k cls color) -> [Node k cls color]
forall a b. (a -> b) -> a -> b
$ Graph k cls color -> UniqFM (Node k cls color)
forall k cls color. Graph k cls color -> UniqFM (Node k cls color)
graphMap Graph k cls color
graph
                -- See Note [Unique Determinism and code generation]

        -- 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 :: [(k, k)]
cList   = [ (Node k cls color -> k
forall k cls color. Node k cls color -> k
nodeId Node k cls color
node1, k
k2)
                        | Node k cls color
node1 <- [Node k cls color]
cNodes
                        , k
k2    <- UniqSet k -> [k]
forall elt. UniqSet elt -> [elt]
nonDetEltsUniqSet (UniqSet k -> [k]) -> UniqSet k -> [k]
forall a b. (a -> b) -> a -> b
$ Node k cls color -> UniqSet k
forall k cls color. Node k cls color -> UniqSet k
nodeCoalesce Node k cls color
node1 ]
                        -- See Note [Unique Determinism and code generation]

        -- do the coalescing, returning the new graph and a list of pairs of keys
        --      that got coalesced together.
        (graph' :: Graph k cls color
graph', mPairs :: [Maybe (k, k)]
mPairs)
                = (Graph k cls color -> (k, k) -> (Graph k cls color, Maybe (k, k)))
-> Graph k cls color
-> [(k, k)]
-> (Graph k cls color, [Maybe (k, k)])
forall (t :: * -> *) a b c.
Traversable t =>
(a -> b -> (a, c)) -> a -> t b -> (a, t c)
mapAccumL (Bool
-> Triv k cls color
-> Graph k cls color
-> (k, k)
-> (Graph k cls color, Maybe (k, k))
forall k cls color.
(Uniquable k, Ord k, Eq cls) =>
Bool
-> Triv k cls color
-> Graph k cls color
-> (k, k)
-> (Graph k cls color, Maybe (k, k))
coalesceNodes Bool
aggressive Triv k cls color
triv) Graph k cls color
graph [(k, k)]
cList

        -- keep running until there are no more coalesces can be found
   in   case [Maybe (k, k)] -> [(k, k)]
forall a. [Maybe a] -> [a]
catMaybes [Maybe (k, k)]
mPairs of
         []     -> (Graph k cls color
graph', [(k, k)] -> [(k, k)]
forall a. [a] -> [a]
reverse [(k, k)]
kkPairsAcc)
         pairs :: [(k, k)]
pairs  -> Bool
-> Triv k cls color
-> Graph k cls color
-> [(k, k)]
-> (Graph k cls color, [(k, k)])
forall k cls color.
(Uniquable k, Ord k, Eq cls, Outputable k) =>
Bool
-> Triv k cls color
-> Graph k cls color
-> [(k, k)]
-> (Graph k cls color, [(k, k)])
coalesceGraph' Bool
aggressive Triv k cls color
triv Graph k cls color
graph' ([(k, k)] -> [(k, k)]
forall a. [a] -> [a]
reverse [(k, k)]
pairs [(k, k)] -> [(k, k)] -> [(k, k)]
forall a. [a] -> [a] -> [a]
++ [(k, k)]
kkPairsAcc)


-- | Coalesce this pair of nodes unconditionally \/ aggressively.
--      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)
        => 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 :: Bool
-> Triv k cls color
-> Graph k cls color
-> (k, k)
-> (Graph k cls color, Maybe (k, k))
coalesceNodes aggressive :: Bool
aggressive triv :: Triv k cls color
triv graph :: Graph k cls color
graph (k1 :: k
k1, k2 :: k
k2)
        | (kMin :: k
kMin, kMax :: k
kMax)  <- if k
k1 k -> k -> Bool
forall a. Ord a => a -> a -> Bool
< k
k2
                                then (k
k1, k
k2)
                                else (k
k2, k
k1)

        -- the nodes being coalesced must be in the graph
        , Just nMin :: Node k cls color
nMin     <- Graph k cls color -> k -> Maybe (Node k cls color)
forall k cls color.
Uniquable k =>
Graph k cls color -> k -> Maybe (Node k cls color)
lookupNode Graph k cls color
graph k
kMin
        , Just nMax :: Node k cls color
nMax     <- Graph k cls color -> k -> Maybe (Node k cls color)
forall k cls color.
Uniquable k =>
Graph k cls color -> k -> Maybe (Node k cls color)
lookupNode Graph k cls color
graph k
kMax

        -- can't coalesce conflicting modes
        , Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ k -> UniqSet k -> Bool
forall a. Uniquable a => a -> UniqSet a -> Bool
elementOfUniqSet k
kMin (Node k cls color -> UniqSet k
forall k cls color. Node k cls color -> UniqSet k
nodeConflicts Node k cls color
nMax)
        , Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ k -> UniqSet k -> Bool
forall a. Uniquable a => a -> UniqSet a -> Bool
elementOfUniqSet k
kMax (Node k cls color -> UniqSet k
forall k cls color. Node k cls color -> UniqSet k
nodeConflicts Node k cls color
nMin)

        -- can't coalesce the same node
        , Node k cls color -> k
forall k cls color. Node k cls color -> k
nodeId Node k cls color
nMin k -> k -> Bool
forall a. Eq a => a -> a -> Bool
/= Node k cls color -> k
forall k cls color. Node k cls color -> k
nodeId Node k cls color
nMax

        = Bool
-> Triv k cls color
-> Graph k cls color
-> k
-> k
-> Node k cls color
-> Node k cls color
-> (Graph k cls color, Maybe (k, k))
forall k cls color.
(Uniquable k, Eq cls) =>
Bool
-> Triv k cls color
-> Graph k cls color
-> k
-> k
-> Node k cls color
-> Node k cls color
-> (Graph k cls color, Maybe (k, k))
coalesceNodes_merge Bool
aggressive Triv k cls color
triv Graph k cls color
graph k
kMin k
kMax Node k cls color
nMin Node k cls color
nMax

        -- don't do the coalescing after all
        | Bool
otherwise
        = (Graph k cls color
graph, Maybe (k, k)
forall a. Maybe a
Nothing)

coalesceNodes_merge
        :: (Uniquable k, Eq cls)
        => Bool
        -> Triv  k cls color
        -> Graph k cls color
        -> k -> k
        -> Node k cls color
        -> Node k cls color
        -> (Graph k cls color, Maybe (k, k))

coalesceNodes_merge :: Bool
-> Triv k cls color
-> Graph k cls color
-> k
-> k
-> Node k cls color
-> Node k cls color
-> (Graph k cls color, Maybe (k, k))
coalesceNodes_merge aggressive :: Bool
aggressive triv :: Triv k cls color
triv graph :: Graph k cls color
graph kMin :: k
kMin kMax :: k
kMax nMin :: Node k cls color
nMin nMax :: Node k cls color
nMax

        -- sanity checks
        | Node k cls color -> cls
forall k cls color. Node k cls color -> cls
nodeClass Node k cls color
nMin cls -> cls -> Bool
forall a. Eq a => a -> a -> Bool
/= Node k cls color -> cls
forall k cls color. Node k cls color -> cls
nodeClass Node k cls color
nMax
        = String -> (Graph k cls color, Maybe (k, k))
forall a. HasCallStack => String -> a
error "GraphOps.coalesceNodes: can't coalesce nodes of different classes."

        | Bool -> Bool
not (Maybe color -> Bool
forall a. Maybe a -> Bool
isNothing (Node k cls color -> Maybe color
forall k cls color. Node k cls color -> Maybe color
nodeColor Node k cls color
nMin) Bool -> Bool -> Bool
&& Maybe color -> Bool
forall a. Maybe a -> Bool
isNothing (Node k cls color -> Maybe color
forall k cls color. Node k cls color -> Maybe color
nodeColor Node k cls color
nMax))
        = String -> (Graph k cls color, Maybe (k, k))
forall a. HasCallStack => String -> a
error "GraphOps.coalesceNodes: can't coalesce colored nodes."

        ---
        | Bool
otherwise
        = let
                -- the new node gets all the edges from its two components
                node :: Node k cls color
node    =
                 Node :: forall k cls color.
k
-> cls
-> Maybe color
-> UniqSet k
-> UniqSet color
-> [color]
-> UniqSet k
-> Node k cls color
Node   { nodeId :: k
nodeId                = k
kMin
                        , nodeClass :: cls
nodeClass             = Node k cls color -> cls
forall k cls color. Node k cls color -> cls
nodeClass Node k cls color
nMin
                        , nodeColor :: Maybe color
nodeColor             = Maybe color
forall a. Maybe a
Nothing

                        -- nodes don't conflict with themselves..
                        , nodeConflicts :: UniqSet k
nodeConflicts
                                = (UniqSet k -> UniqSet k -> UniqSet k
forall a. UniqSet a -> UniqSet a -> UniqSet a
unionUniqSets (Node k cls color -> UniqSet k
forall k cls color. Node k cls color -> UniqSet k
nodeConflicts Node k cls color
nMin) (Node k cls color -> UniqSet k
forall k cls color. Node k cls color -> UniqSet k
nodeConflicts Node k cls color
nMax))
                                        UniqSet k -> k -> UniqSet k
forall a. Uniquable a => UniqSet a -> a -> UniqSet a
`delOneFromUniqSet` k
kMin
                                        UniqSet k -> k -> UniqSet k
forall a. Uniquable a => UniqSet a -> a -> UniqSet a
`delOneFromUniqSet` k
kMax

                        , nodeExclusions :: UniqSet color
nodeExclusions        = UniqSet color -> UniqSet color -> UniqSet color
forall a. UniqSet a -> UniqSet a -> UniqSet a
unionUniqSets (Node k cls color -> UniqSet color
forall k cls color. Node k cls color -> UniqSet color
nodeExclusions Node k cls color
nMin) (Node k cls color -> UniqSet color
forall k cls color. Node k cls color -> UniqSet color
nodeExclusions Node k cls color
nMax)
                        , nodePreference :: [color]
nodePreference        = Node k cls color -> [color]
forall k cls color. Node k cls color -> [color]
nodePreference Node k cls color
nMin [color] -> [color] -> [color]
forall a. [a] -> [a] -> [a]
++ Node k cls color -> [color]
forall k cls color. Node k cls color -> [color]
nodePreference Node k cls color
nMax

                        -- nodes don't coalesce with themselves..
                        , nodeCoalesce :: UniqSet k
nodeCoalesce
                                = (UniqSet k -> UniqSet k -> UniqSet k
forall a. UniqSet a -> UniqSet a -> UniqSet a
unionUniqSets (Node k cls color -> UniqSet k
forall k cls color. Node k cls color -> UniqSet k
nodeCoalesce Node k cls color
nMin) (Node k cls color -> UniqSet k
forall k cls color. Node k cls color -> UniqSet k
nodeCoalesce Node k cls color
nMax))
                                        UniqSet k -> k -> UniqSet k
forall a. Uniquable a => UniqSet a -> a -> UniqSet a
`delOneFromUniqSet` k
kMin
                                        UniqSet k -> k -> UniqSet k
forall a. Uniquable a => UniqSet a -> a -> UniqSet a
`delOneFromUniqSet` k
kMax
                        }

          in    Bool
-> Triv k cls color
-> Graph k cls color
-> k
-> k
-> Node k cls color
-> (Graph k cls color, Maybe (k, k))
forall k cls color.
Uniquable k =>
Bool
-> Triv k cls color
-> Graph k cls color
-> k
-> k
-> Node k cls color
-> (Graph k cls color, Maybe (k, k))
coalesceNodes_check Bool
aggressive Triv k cls color
triv Graph k cls color
graph k
kMin k
kMax Node k cls color
node

coalesceNodes_check
        :: Uniquable k
        => Bool
        -> Triv  k cls color
        -> Graph k cls color
        -> k -> k
        -> Node k cls color
        -> (Graph k cls color, Maybe (k, k))

coalesceNodes_check :: Bool
-> Triv k cls color
-> Graph k cls color
-> k
-> k
-> Node k cls color
-> (Graph k cls color, Maybe (k, k))
coalesceNodes_check aggressive :: Bool
aggressive triv :: Triv k cls color
triv graph :: Graph k cls color
graph kMin :: k
kMin kMax :: k
kMax node :: Node k cls color
node

        -- Unless we're coalescing aggressively, if the result node is not trivially
        --      colorable then don't do the coalescing.
        | Bool -> Bool
not Bool
aggressive
        , Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Triv k cls color
triv (Node k cls color -> cls
forall k cls color. Node k cls color -> cls
nodeClass Node k cls color
node) (Node k cls color -> UniqSet k
forall k cls color. Node k cls color -> UniqSet k
nodeConflicts Node k cls color
node) (Node k cls color -> UniqSet color
forall k cls color. Node k cls color -> UniqSet color
nodeExclusions Node k cls color
node)
        = (Graph k cls color
graph, Maybe (k, k)
forall a. Maybe a
Nothing)

        | Bool
otherwise
        = let -- delete the old nodes from the graph and add the new one
                Just graph1 :: Graph k cls color
graph1     = k -> Graph k cls color -> Maybe (Graph k cls color)
forall k cls color.
Uniquable k =>
k -> Graph k cls color -> Maybe (Graph k cls color)
delNode k
kMax Graph k cls color
graph
                Just graph2 :: Graph k cls color
graph2     = k -> Graph k cls color -> Maybe (Graph k cls color)
forall k cls color.
Uniquable k =>
k -> Graph k cls color -> Maybe (Graph k cls color)
delNode k
kMin Graph k cls color
graph1
                graph3 :: Graph k cls color
graph3          = k -> Node k cls color -> Graph k cls color -> Graph k cls color
forall k cls color.
Uniquable k =>
k -> Node k cls color -> Graph k cls color -> Graph k cls color
addNode k
kMin Node k cls color
node Graph k cls color
graph2

          in    (Graph k cls color
graph3, (k, k) -> Maybe (k, k)
forall a. a -> Maybe a
Just (k
kMax, k
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.
--
freezeNode
        :: Uniquable k
        => k                    -- ^ key of the node to freeze
        -> Graph k cls color    -- ^ the graph
        -> Graph k cls color    -- ^ graph with that node frozen

freezeNode :: k -> Graph k cls color -> Graph k cls color
freezeNode k :: k
k
  = (UniqFM (Node k cls color) -> UniqFM (Node k cls color))
-> Graph k cls color -> Graph k cls color
forall k cls color.
(UniqFM (Node k cls color) -> UniqFM (Node k cls color))
-> Graph k cls color -> Graph k cls color
graphMapModify
  ((UniqFM (Node k cls color) -> UniqFM (Node k cls color))
 -> Graph k cls color -> Graph k cls color)
-> (UniqFM (Node k cls color) -> UniqFM (Node k cls color))
-> Graph k cls color
-> Graph k cls color
forall a b. (a -> b) -> a -> b
$ \fm :: UniqFM (Node k cls color)
fm ->
    let -- freeze all the edges in the node to be frozen
        Just node :: Node k cls color
node = UniqFM (Node k cls color) -> k -> Maybe (Node k cls color)
forall key elt. Uniquable key => UniqFM elt -> key -> Maybe elt
lookupUFM UniqFM (Node k cls color)
fm k
k
        node' :: Node k cls color
node'   = Node k cls color
node
                { nodeCoalesce :: UniqSet k
nodeCoalesce          = UniqSet k
forall a. UniqSet a
emptyUniqSet }

        fm1 :: UniqFM (Node k cls color)
fm1     = UniqFM (Node k cls color)
-> k -> Node k cls color -> UniqFM (Node k cls color)
forall key elt.
Uniquable key =>
UniqFM elt -> key -> elt -> UniqFM elt
addToUFM UniqFM (Node k cls color)
fm k
k Node k cls color
node'

        -- update back edges pointing to this node
        freezeEdge :: a -> Node a cls color -> Node a cls color
freezeEdge k :: a
k node :: Node a cls color
node
         = if a -> UniqSet a -> Bool
forall a. Uniquable a => a -> UniqSet a -> Bool
elementOfUniqSet a
k (Node a cls color -> UniqSet a
forall k cls color. Node k cls color -> UniqSet k
nodeCoalesce Node a cls color
node)
                then Node a cls color
node { nodeCoalesce :: UniqSet a
nodeCoalesce = UniqSet a -> a -> UniqSet a
forall a. Uniquable a => UniqSet a -> a -> UniqSet a
delOneFromUniqSet (Node a cls color -> UniqSet a
forall k cls color. Node k cls color -> UniqSet k
nodeCoalesce Node a cls color
node) a
k }
                else Node a cls color
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 :: UniqFM (Node k cls color)
fm2     = (k -> UniqFM (Node k cls color) -> UniqFM (Node k cls color))
-> UniqFM (Node k cls color)
-> UniqSet k
-> UniqFM (Node k cls color)
forall elt a. (elt -> a -> a) -> a -> UniqSet elt -> a
nonDetFoldUniqSet ((Node k cls color -> Node k cls color)
-> k -> UniqFM (Node k cls color) -> UniqFM (Node k cls color)
forall k a. Uniquable k => (a -> a) -> k -> UniqFM a -> UniqFM a
adjustUFM_C (k -> Node k cls color -> Node k cls color
forall a cls color.
Uniquable a =>
a -> Node a cls color -> Node a cls color
freezeEdge k
k)) UniqFM (Node k cls color)
fm1
                    -- It's OK to use nonDetFoldUFM here because the operation
                    -- is commutative
                        (UniqSet k -> UniqFM (Node k cls color))
-> UniqSet k -> UniqFM (Node k cls color)
forall a b. (a -> b) -> a -> b
$ Node k cls color -> UniqSet k
forall k cls color. Node k cls color -> UniqSet k
nodeCoalesce Node k cls color
node

    in  UniqFM (Node k cls color)
fm2


-- | Freeze one node in the graph
--      This if for the iterative coalescer.
--      Look for a move related node of low degree and freeze it.
--
--      We probably don't need to scan the whole graph looking for the node of absolute
--      lowest degree. Just sample the first few and choose the one with the lowest
--      degree out of those. Also, we don't make any distinction between conflicts of different
--      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.
--
freezeOneInGraph
        :: (Uniquable k)
        => Graph k cls color
        -> ( Graph k cls color          -- the new graph
           , Bool )                     -- whether we found a node to freeze

freezeOneInGraph :: Graph k cls color -> (Graph k cls color, Bool)
freezeOneInGraph graph :: Graph k cls color
graph
 = let  compareNodeDegree :: Node a cls color -> Node a cls color -> Ordering
compareNodeDegree n1 :: Node a cls color
n1 n2 :: Node a cls color
n2
                = Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (UniqSet a -> Int
forall a. UniqSet a -> Int
sizeUniqSet (UniqSet a -> Int) -> UniqSet a -> Int
forall a b. (a -> b) -> a -> b
$ Node a cls color -> UniqSet a
forall k cls color. Node k cls color -> UniqSet k
nodeConflicts Node a cls color
n1) (UniqSet a -> Int
forall a. UniqSet a -> Int
sizeUniqSet (UniqSet a -> Int) -> UniqSet a -> Int
forall a b. (a -> b) -> a -> b
$ Node a cls color -> UniqSet a
forall k cls color. Node k cls color -> UniqSet k
nodeConflicts Node a cls color
n2)

        candidates :: [Node k cls color]
candidates
                = (Node k cls color -> Node k cls color -> Ordering)
-> [Node k cls color] -> [Node k cls color]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy Node k cls color -> Node k cls color -> Ordering
forall a cls color a cls color.
Node a cls color -> Node a cls color -> Ordering
compareNodeDegree
                ([Node k cls color] -> [Node k cls color])
-> [Node k cls color] -> [Node k cls color]
forall a b. (a -> b) -> a -> b
$ Int -> [Node k cls color] -> [Node k cls color]
forall a. Int -> [a] -> [a]
take 5        -- 5 isn't special, it's just a small number.
                ([Node k cls color] -> [Node k cls color])
-> [Node k cls color] -> [Node k cls color]
forall a b. (a -> b) -> a -> b
$ (Node k cls color -> Bool)
-> Graph k cls color -> [Node k cls color]
forall k cls color.
(Node k cls color -> Bool)
-> Graph k cls color -> [Node k cls color]
scanGraph (\node :: Node k cls color
node -> Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ UniqSet k -> Bool
forall a. UniqSet a -> Bool
isEmptyUniqSet (Node k cls color -> UniqSet k
forall k cls color. Node k cls color -> UniqSet k
nodeCoalesce Node k cls color
node)) Graph k cls color
graph

   in   case [Node k cls color]
candidates of

         -- there wasn't anything available to freeze
         []     -> (Graph k cls color
graph, Bool
False)

         -- we found something to freeze
         (n :: Node k cls color
n : _)
          -> ( k -> Graph k cls color -> Graph k cls color
forall k cls color.
Uniquable k =>
k -> Graph k cls color -> Graph k cls color
freezeNode (Node k cls color -> k
forall k cls color. Node k cls color -> k
nodeId Node k cls color
n) Graph k cls color
graph
             , Bool
True)


-- | Freeze all the nodes in the graph
--      for debugging the iterative allocator.
--
freezeAllInGraph
        :: (Uniquable k)
        => Graph k cls color
        -> Graph k cls color

freezeAllInGraph :: Graph k cls color -> Graph k cls color
freezeAllInGraph graph :: Graph k cls color
graph
        = (k -> Graph k cls color -> Graph k cls color)
-> Graph k cls color -> [k] -> Graph k cls color
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr k -> Graph k cls color -> Graph k cls color
forall k cls color.
Uniquable k =>
k -> Graph k cls color -> Graph k cls color
freezeNode Graph k cls color
graph
                ([k] -> Graph k cls color) -> [k] -> Graph k cls color
forall a b. (a -> b) -> a -> b
$ (Node k cls color -> k) -> [Node k cls color] -> [k]
forall a b. (a -> b) -> [a] -> [b]
map Node k cls color -> k
forall k cls color. Node k cls color -> k
nodeId
                ([Node k cls color] -> [k]) -> [Node k cls color] -> [k]
forall a b. (a -> b) -> a -> b
$ UniqFM (Node k cls color) -> [Node k cls color]
forall elt. UniqFM elt -> [elt]
nonDetEltsUFM (UniqFM (Node k cls color) -> [Node k cls color])
-> UniqFM (Node k cls color) -> [Node k cls color]
forall a b. (a -> b) -> a -> b
$ Graph k cls color -> UniqFM (Node k cls color)
forall k cls color. Graph k cls color -> UniqFM (Node k cls color)
graphMap Graph k cls color
graph
                -- See Note [Unique Determinism and code generation]


-- | Find all the nodes in the graph that meet some criteria
--
scanGraph
        :: (Node k cls color -> Bool)
        -> Graph k cls color
        -> [Node k cls color]

scanGraph :: (Node k cls color -> Bool)
-> Graph k cls color -> [Node k cls color]
scanGraph match :: Node k cls color -> Bool
match graph :: Graph k cls color
graph
        = (Node k cls color -> Bool)
-> [Node k cls color] -> [Node k cls color]
forall a. (a -> Bool) -> [a] -> [a]
filter Node k cls color -> Bool
match ([Node k cls color] -> [Node k cls color])
-> [Node k cls color] -> [Node k cls color]
forall a b. (a -> b) -> a -> b
$ UniqFM (Node k cls color) -> [Node k cls color]
forall elt. UniqFM elt -> [elt]
nonDetEltsUFM (UniqFM (Node k cls color) -> [Node k cls color])
-> UniqFM (Node k cls color) -> [Node k cls color]
forall a b. (a -> b) -> a -> b
$ Graph k cls color -> UniqFM (Node k cls color)
forall k cls color. Graph k cls color -> UniqFM (Node k cls color)
graphMap Graph k cls color
graph
          -- See Note [Unique Determinism and code generation]


-- | validate the internal structure of a graph
--      all its edges should point to valid nodes
--      If they don't then throw an error
--
validateGraph
        :: (Uniquable k, Outputable k, Eq color)
        => SDoc                         -- ^ extra debugging info to display on error
        -> Bool                         -- ^ whether this graph is supposed to be colored.
        -> Graph k cls color            -- ^ graph to validate
        -> Graph k cls color            -- ^ validated graph

validateGraph :: SDoc -> Bool -> Graph k cls color -> Graph k cls color
validateGraph doc :: SDoc
doc isColored :: Bool
isColored graph :: Graph k cls color
graph

        -- Check that all edges point to valid nodes.
        | UniqSet k
edges         <- [UniqSet k] -> UniqSet k
forall a. [UniqSet a] -> UniqSet a
unionManyUniqSets
                                (  ((Node k cls color -> UniqSet k)
-> [Node k cls color] -> [UniqSet k]
forall a b. (a -> b) -> [a] -> [b]
map Node k cls color -> UniqSet k
forall k cls color. Node k cls color -> UniqSet k
nodeConflicts       ([Node k cls color] -> [UniqSet k])
-> [Node k cls color] -> [UniqSet k]
forall a b. (a -> b) -> a -> b
$ UniqFM (Node k cls color) -> [Node k cls color]
forall elt. UniqFM elt -> [elt]
nonDetEltsUFM (UniqFM (Node k cls color) -> [Node k cls color])
-> UniqFM (Node k cls color) -> [Node k cls color]
forall a b. (a -> b) -> a -> b
$ Graph k cls color -> UniqFM (Node k cls color)
forall k cls color. Graph k cls color -> UniqFM (Node k cls color)
graphMap Graph k cls color
graph)
                                [UniqSet k] -> [UniqSet k] -> [UniqSet k]
forall a. [a] -> [a] -> [a]
++ ((Node k cls color -> UniqSet k)
-> [Node k cls color] -> [UniqSet k]
forall a b. (a -> b) -> [a] -> [b]
map Node k cls color -> UniqSet k
forall k cls color. Node k cls color -> UniqSet k
nodeCoalesce        ([Node k cls color] -> [UniqSet k])
-> [Node k cls color] -> [UniqSet k]
forall a b. (a -> b) -> a -> b
$ UniqFM (Node k cls color) -> [Node k cls color]
forall elt. UniqFM elt -> [elt]
nonDetEltsUFM (UniqFM (Node k cls color) -> [Node k cls color])
-> UniqFM (Node k cls color) -> [Node k cls color]
forall a b. (a -> b) -> a -> b
$ Graph k cls color -> UniqFM (Node k cls color)
forall k cls color. Graph k cls color -> UniqFM (Node k cls color)
graphMap Graph k cls color
graph))

        , UniqSet k
nodes         <- [k] -> UniqSet k
forall a. Uniquable a => [a] -> UniqSet a
mkUniqSet ([k] -> UniqSet k) -> [k] -> UniqSet k
forall a b. (a -> b) -> a -> b
$ (Node k cls color -> k) -> [Node k cls color] -> [k]
forall a b. (a -> b) -> [a] -> [b]
map Node k cls color -> k
forall k cls color. Node k cls color -> k
nodeId ([Node k cls color] -> [k]) -> [Node k cls color] -> [k]
forall a b. (a -> b) -> a -> b
$ UniqFM (Node k cls color) -> [Node k cls color]
forall elt. UniqFM elt -> [elt]
nonDetEltsUFM (UniqFM (Node k cls color) -> [Node k cls color])
-> UniqFM (Node k cls color) -> [Node k cls color]
forall a b. (a -> b) -> a -> b
$ Graph k cls color -> UniqFM (Node k cls color)
forall k cls color. Graph k cls color -> UniqFM (Node k cls color)
graphMap Graph k cls color
graph
        , UniqSet k
badEdges      <- UniqSet k -> UniqSet k -> UniqSet k
forall a. UniqSet a -> UniqSet a -> UniqSet a
minusUniqSet UniqSet k
edges UniqSet k
nodes
        , Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ UniqSet k -> Bool
forall a. UniqSet a -> Bool
isEmptyUniqSet UniqSet k
badEdges
        = String -> SDoc -> Graph k cls color
forall a. HasCallStack => String -> SDoc -> a
pprPanic "GraphOps.validateGraph"
                (  String -> SDoc
text "Graph has edges that point to non-existent nodes"
                SDoc -> SDoc -> SDoc
$$ String -> SDoc
text "  bad edges: " SDoc -> SDoc -> SDoc
<> UniqFM k -> ([k] -> SDoc) -> SDoc
forall a. UniqFM a -> ([a] -> SDoc) -> SDoc
pprUFM (UniqSet k -> UniqFM k
forall a. UniqSet a -> UniqFM a
getUniqSet UniqSet k
badEdges) ([SDoc] -> SDoc
vcat ([SDoc] -> SDoc) -> ([k] -> [SDoc]) -> [k] -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (k -> SDoc) -> [k] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map k -> SDoc
forall a. Outputable a => a -> SDoc
ppr)
                SDoc -> SDoc -> SDoc
$$ SDoc
doc )

        -- Check that no conflicting nodes have the same color
        | [Node k cls color]
badNodes      <- (Node k cls color -> Bool)
-> [Node k cls color] -> [Node k cls color]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> (Node k cls color -> Bool) -> Node k cls color -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Graph k cls color -> Node k cls color -> Bool
forall k color cls.
(Uniquable k, Eq color) =>
Graph k cls color -> Node k cls color -> Bool
checkNode Graph k cls color
graph))
                        ([Node k cls color] -> [Node k cls color])
-> [Node k cls color] -> [Node k cls color]
forall a b. (a -> b) -> a -> b
$ UniqFM (Node k cls color) -> [Node k cls color]
forall elt. UniqFM elt -> [elt]
nonDetEltsUFM (UniqFM (Node k cls color) -> [Node k cls color])
-> UniqFM (Node k cls color) -> [Node k cls color]
forall a b. (a -> b) -> a -> b
$ Graph k cls color -> UniqFM (Node k cls color)
forall k cls color. Graph k cls color -> UniqFM (Node k cls color)
graphMap Graph k cls color
graph
                           -- See Note [Unique Determinism and code generation]
        , Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [Node k cls color] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Node k cls color]
badNodes
        = String -> SDoc -> Graph k cls color
forall a. HasCallStack => String -> SDoc -> a
pprPanic "GraphOps.validateGraph"
                (  String -> SDoc
text "Node has same color as one of it's conflicts"
                SDoc -> SDoc -> SDoc
$$ String -> SDoc
text "  bad nodes: " SDoc -> SDoc -> SDoc
<> [SDoc] -> SDoc
hcat ((Node k cls color -> SDoc) -> [Node k cls color] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (k -> SDoc
forall a. Outputable a => a -> SDoc
ppr (k -> SDoc) -> (Node k cls color -> k) -> Node k cls color -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Node k cls color -> k
forall k cls color. Node k cls color -> k
nodeId) [Node k cls color]
badNodes)
                SDoc -> SDoc -> SDoc
$$ SDoc
doc)

        -- If this is supposed to be a colored graph,
        --      check that all nodes have a color.
        | Bool
isColored
        , [Node k cls color]
badNodes      <- (Node k cls color -> Bool)
-> [Node k cls color] -> [Node k cls color]
forall a. (a -> Bool) -> [a] -> [a]
filter (\n :: Node k cls color
n -> Maybe color -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe color -> Bool) -> Maybe color -> Bool
forall a b. (a -> b) -> a -> b
$ Node k cls color -> Maybe color
forall k cls color. Node k cls color -> Maybe color
nodeColor Node k cls color
n)
                        ([Node k cls color] -> [Node k cls color])
-> [Node k cls color] -> [Node k cls color]
forall a b. (a -> b) -> a -> b
$  UniqFM (Node k cls color) -> [Node k cls color]
forall elt. UniqFM elt -> [elt]
nonDetEltsUFM (UniqFM (Node k cls color) -> [Node k cls color])
-> UniqFM (Node k cls color) -> [Node k cls color]
forall a b. (a -> b) -> a -> b
$ Graph k cls color -> UniqFM (Node k cls color)
forall k cls color. Graph k cls color -> UniqFM (Node k cls color)
graphMap Graph k cls color
graph
        , Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [Node k cls color] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Node k cls color]
badNodes
        = String -> SDoc -> Graph k cls color
forall a. HasCallStack => String -> SDoc -> a
pprPanic "GraphOps.validateGraph"
                (  String -> SDoc
text "Supposably colored graph has uncolored nodes."
                SDoc -> SDoc -> SDoc
$$ String -> SDoc
text "  uncolored nodes: " SDoc -> SDoc -> SDoc
<> [SDoc] -> SDoc
hcat ((Node k cls color -> SDoc) -> [Node k cls color] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (k -> SDoc
forall a. Outputable a => a -> SDoc
ppr (k -> SDoc) -> (Node k cls color -> k) -> Node k cls color -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Node k cls color -> k
forall k cls color. Node k cls color -> k
nodeId) [Node k cls color]
badNodes)
                SDoc -> SDoc -> SDoc
$$ SDoc
doc )


        -- graph looks ok
        | Bool
otherwise
        = Graph k cls color
graph


-- | If this node is colored, check that all the nodes which
--      conflict with it have different colors.
checkNode
        :: (Uniquable k, Eq color)
        => Graph k cls color
        -> Node  k cls color
        -> Bool                 -- ^ True if this node is ok

checkNode :: Graph k cls color -> Node k cls color -> Bool
checkNode graph :: Graph k cls color
graph node :: Node k cls color
node
        | Just color :: color
color            <- Node k cls color -> Maybe color
forall k cls color. Node k cls color -> Maybe color
nodeColor Node k cls color
node
        , Just neighbors :: [Node k cls color]
neighbors        <- [Maybe (Node k cls color)] -> Maybe [Node k cls color]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence ([Maybe (Node k cls color)] -> Maybe [Node k cls color])
-> [Maybe (Node k cls color)] -> Maybe [Node k cls color]
forall a b. (a -> b) -> a -> b
$ (k -> Maybe (Node k cls color))
-> [k] -> [Maybe (Node k cls color)]
forall a b. (a -> b) -> [a] -> [b]
map (Graph k cls color -> k -> Maybe (Node k cls color)
forall k cls color.
Uniquable k =>
Graph k cls color -> k -> Maybe (Node k cls color)
lookupNode Graph k cls color
graph)
                                ([k] -> [Maybe (Node k cls color)])
-> [k] -> [Maybe (Node k cls color)]
forall a b. (a -> b) -> a -> b
$  UniqSet k -> [k]
forall elt. UniqSet elt -> [elt]
nonDetEltsUniqSet (UniqSet k -> [k]) -> UniqSet k -> [k]
forall a b. (a -> b) -> a -> b
$ Node k cls color -> UniqSet k
forall k cls color. Node k cls color -> UniqSet k
nodeConflicts Node k cls color
node
            -- See Note [Unique Determinism and code generation]

        , [color]
neighbourColors       <- [Maybe color] -> [color]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe color] -> [color]) -> [Maybe color] -> [color]
forall a b. (a -> b) -> a -> b
$ (Node k cls color -> Maybe color)
-> [Node k cls color] -> [Maybe color]
forall a b. (a -> b) -> [a] -> [b]
map Node k cls color -> Maybe color
forall k cls color. Node k cls color -> Maybe color
nodeColor [Node k cls color]
neighbors
        , color -> [color] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem color
color [color]
neighbourColors
        = Bool
False

        | Bool
otherwise
        = Bool
True



-- | Slurp out a map of how many nodes had a certain number of conflict neighbours

slurpNodeConflictCount
        :: Graph k cls color
        -> UniqFM (Int, Int)    -- ^ (conflict neighbours, num nodes with that many conflicts)

slurpNodeConflictCount :: Graph k cls color -> UniqFM (Int, Int)
slurpNodeConflictCount graph :: Graph k cls color
graph
        = ((Int, Int) -> (Int, Int) -> (Int, Int))
-> UniqFM (Int, Int) -> [(Int, (Int, Int))] -> UniqFM (Int, Int)
forall key elt.
Uniquable key =>
(elt -> elt -> elt) -> UniqFM elt -> [(key, elt)] -> UniqFM elt
addListToUFM_C
                (\(c1 :: Int
c1, n1 :: Int
n1) (_, n2 :: Int
n2) -> (Int
c1, Int
n1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n2))
                UniqFM (Int, Int)
forall elt. UniqFM elt
emptyUFM
        ([(Int, (Int, Int))] -> UniqFM (Int, Int))
-> [(Int, (Int, Int))] -> UniqFM (Int, Int)
forall a b. (a -> b) -> a -> b
$ (Node k cls color -> (Int, (Int, Int)))
-> [Node k cls color] -> [(Int, (Int, Int))]
forall a b. (a -> b) -> [a] -> [b]
map   (\node :: Node k cls color
node
                  -> let count :: Int
count  = UniqSet k -> Int
forall a. UniqSet a -> Int
sizeUniqSet (UniqSet k -> Int) -> UniqSet k -> Int
forall a b. (a -> b) -> a -> b
$ Node k cls color -> UniqSet k
forall k cls color. Node k cls color -> UniqSet k
nodeConflicts Node k cls color
node
                     in  (Int
count, (Int
count, 1)))
        ([Node k cls color] -> [(Int, (Int, Int))])
-> [Node k cls color] -> [(Int, (Int, Int))]
forall a b. (a -> b) -> a -> b
$ UniqFM (Node k cls color) -> [Node k cls color]
forall elt. UniqFM elt -> [elt]
nonDetEltsUFM
        -- See Note [Unique Determinism and code generation]
        (UniqFM (Node k cls color) -> [Node k cls color])
-> UniqFM (Node k cls color) -> [Node k cls color]
forall a b. (a -> b) -> a -> b
$ Graph k cls color -> UniqFM (Node k cls color)
forall k cls color. Graph k cls color -> UniqFM (Node k cls color)
graphMap Graph k cls color
graph


-- | Set the color of a certain node
setColor
        :: Uniquable k
        => k -> color
        -> Graph k cls color -> Graph k cls color

setColor :: k -> color -> Graph k cls color -> Graph k cls color
setColor u :: k
u color :: color
color
        = (UniqFM (Node k cls color) -> UniqFM (Node k cls color))
-> Graph k cls color -> Graph k cls color
forall k cls color.
(UniqFM (Node k cls color) -> UniqFM (Node k cls color))
-> Graph k cls color -> Graph k cls color
graphMapModify
        ((UniqFM (Node k cls color) -> UniqFM (Node k cls color))
 -> Graph k cls color -> Graph k cls color)
-> (UniqFM (Node k cls color) -> UniqFM (Node k cls color))
-> Graph k cls color
-> Graph k cls color
forall a b. (a -> b) -> a -> b
$ (Node k cls color -> Node k cls color)
-> k -> UniqFM (Node k cls color) -> UniqFM (Node k cls color)
forall k a. Uniquable k => (a -> a) -> k -> UniqFM a -> UniqFM a
adjustUFM_C
                (\n :: Node k cls color
n -> Node k cls color
n { nodeColor :: Maybe color
nodeColor = color -> Maybe color
forall a. a -> Maybe a
Just color
color })
                k
u


{-# INLINE adjustWithDefaultUFM #-}
adjustWithDefaultUFM
        :: Uniquable k
        => (a -> a) -> a -> k
        -> UniqFM a -> UniqFM a

adjustWithDefaultUFM :: (a -> a) -> a -> k -> UniqFM a -> UniqFM a
adjustWithDefaultUFM f :: a -> a
f def :: a
def k :: k
k map :: UniqFM a
map
        = (a -> a -> a) -> UniqFM a -> k -> a -> UniqFM a
forall key elt.
Uniquable key =>
(elt -> elt -> elt) -> UniqFM elt -> key -> elt -> UniqFM elt
addToUFM_C
                (\old :: a
old _ -> a -> a
f a
old)
                UniqFM a
map
                k
k a
def

-- Argument order different from UniqFM's adjustUFM
{-# INLINE adjustUFM_C #-}
adjustUFM_C
        :: Uniquable k
        => (a -> a)
        -> k -> UniqFM a -> UniqFM a

adjustUFM_C :: (a -> a) -> k -> UniqFM a -> UniqFM a
adjustUFM_C f :: a -> a
f k :: k
k map :: UniqFM a
map
 = case UniqFM a -> k -> Maybe a
forall key elt. Uniquable key => UniqFM elt -> key -> Maybe elt
lookupUFM UniqFM a
map k
k of
        Nothing -> UniqFM a
map
        Just a :: a
a  -> UniqFM a -> k -> a -> UniqFM a
forall key elt.
Uniquable key =>
UniqFM elt -> key -> elt -> UniqFM elt
addToUFM UniqFM a
map k
k (a -> a
f a
a)