-- | Types for the general graph colorer.
module GHC.Data.Graph.Base (
        Triv,
        Graph (..),
        initGraph,
        graphMapModify,

        Node  (..),     newNode,
)


where

import GHC.Prelude

import GHC.Types.Unique.Set
import GHC.Types.Unique.FM


-- | A fn to check if a node is trivially colorable
--      For graphs who's color classes are disjoint then a node is 'trivially colorable'
--      when it has less neighbors and exclusions than available colors for that node.
--
--      For graph's who's color classes overlap, ie some colors alias other colors, then
--      this can be a bit more tricky. There is a general way to calculate this, but
--      it's likely be too slow for use in the code. The coloring algorithm takes
--      a canned function which can be optimised by the user to be specific to the
--      specific graph being colored.
--
--      for details, see  "A Generalised Algorithm for Graph-Coloring Register Allocation"
--                              Smith, Ramsey, Holloway - PLDI 2004.
--
type Triv k cls color
        =  cls                  -- the class of the node we're trying to color.
        -> UniqSet k            -- the node's neighbors.
        -> UniqSet color        -- the node's exclusions.
        -> Bool


-- | The Interference graph.
--      There used to be more fields, but they were turfed out in a previous revision.
--      maybe we'll want more later..
--
newtype Graph k cls color
        = Graph {
        -- | All active nodes in the graph.
          forall k cls color.
Graph k cls color -> UniqFM k (Node k cls color)
graphMap              :: UniqFM k (Node k cls color)  }


-- | An empty graph.
initGraph :: Graph k cls color
initGraph :: forall k cls color. Graph k cls color
initGraph
        = Graph
        { graphMap :: UniqFM k (Node k cls color)
graphMap              = UniqFM k (Node k cls color)
forall {k} (key :: k) elt. UniqFM key elt
emptyUFM }


-- | Modify the finite map holding the nodes in the graph.
graphMapModify
        :: (UniqFM k (Node k cls color) -> UniqFM k (Node k cls color))
        -> Graph k cls color -> Graph k cls color

graphMapModify :: forall k cls color.
(UniqFM k (Node k cls color) -> UniqFM k (Node k cls color))
-> Graph k cls color -> Graph k cls color
graphMapModify UniqFM k (Node k cls color) -> UniqFM k (Node k cls color)
f Graph k cls color
graph
        = Graph k cls color
graph { graphMap      = f (graphMap graph) }



-- | Graph nodes.
--      Represents a thing that can conflict with another thing.
--      For the register allocater the nodes represent registers.
--
data Node k cls color
        = Node {
        -- | A unique identifier for this node.
          forall k cls color. Node k cls color -> k
nodeId                :: k

        -- | The class of this node,
        --      determines the set of colors that can be used.
        , forall k cls color. Node k cls color -> cls
nodeClass             :: cls

        -- | The color of this node, if any.
        , forall k cls color. Node k cls color -> Maybe color
nodeColor             :: Maybe color

        -- | Neighbors which must be colored differently to this node.
        , forall k cls color. Node k cls color -> UniqSet k
nodeConflicts         :: UniqSet k

        -- | Colors that cannot be used by this node.
        , forall k cls color. Node k cls color -> UniqSet color
nodeExclusions        :: UniqSet color

        -- | Colors that this node would prefer to be, in descending order.
        , forall k cls color. Node k cls color -> [color]
nodePreference        :: [color]

        -- | Neighbors that this node would like to be colored the same as.
        , forall k cls color. Node k cls color -> UniqSet k
nodeCoalesce          :: UniqSet k }


-- | An empty node.
newNode :: k -> cls -> Node k cls color
newNode :: forall k cls color. k -> cls -> Node k cls color
newNode k
k cls
cls
        = Node
        { nodeId :: k
nodeId                = k
k
        , nodeClass :: cls
nodeClass             = cls
cls
        , nodeColor :: Maybe color
nodeColor             = Maybe color
forall a. Maybe a
Nothing
        , nodeConflicts :: UniqSet k
nodeConflicts         = UniqSet k
forall a. UniqSet a
emptyUniqSet
        , nodeExclusions :: UniqSet color
nodeExclusions        = UniqSet color
forall a. UniqSet a
emptyUniqSet
        , nodePreference :: [color]
nodePreference        = []
        , nodeCoalesce :: UniqSet k
nodeCoalesce          = UniqSet k
forall a. UniqSet a
emptyUniqSet }