    -- | Basic operations on graphs.
    --

    {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}

    module GHC.Data.Graph.Ops
       ( 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 GHC.Prelude

    import GHC.Data.Graph.Base

    import GHC.Utils.Outputable
    import GHC.Utils.Panic
    import GHC.Types.Unique
    import GHC.Types.Unique.Set
    import GHC.Types.Unique.FM

    import Data.List (mapAccumL, sortBy)
    import Data.Maybe

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

    lookupNode :: forall k cls color.
    Uniquable k =>
    Graph k cls color -> k -> Maybe (Node k cls color)
    lookupNode Graph k cls color
    graph k
    k
            = forall key elt. Uniquable key => UniqFM key elt -> key -> Maybe elt
    lookupUFM (forall k cls color.
    Graph k cls color -> UniqFM k (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 :: forall k cls color.
    Uniquable k =>
    Graph k cls color -> k -> Node k cls color
    getNode Graph k cls color
    graph k
    k
     = case forall key elt. Uniquable key => UniqFM key elt -> key -> Maybe elt
    lookupUFM (forall k cls color.
    Graph k cls color -> UniqFM k (Node k cls color)
    graphMap Graph k cls color
    graph) k
    k of
            Just Node k cls color
    node       -> Node k cls color
    node
            Maybe (Node k cls color)
    Nothing         -> forall a. String -> a
    panic String
    "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 :: forall k cls color.
    Uniquable k =>
    k -> Node k cls color -> Graph k cls color -> Graph k cls color
    addNode k
    k Node k cls color
    node Graph k cls color
    graph
     = let
            -- add back conflict edges from other nodes to this one
            map_conflict :: UniqFM k (Node k cls color)
    map_conflict =
              forall elt a. (elt -> a -> a) -> a -> UniqSet elt -> a
    nonDetStrictFoldUniqSet
                -- It's OK to use a non-deterministic fold here because the
                -- operation is commutative
                (forall k a.
    Uniquable k =>
    (a -> a) -> k -> UniqFM k a -> UniqFM k a
    adjustUFM_C (\Node k cls color
    n -> Node k cls color
    n { nodeConflicts :: UniqSet k
    nodeConflicts =
                                          forall a. Uniquable a => UniqSet a -> a -> UniqSet a
    addOneToUniqSet (forall k cls color. Node k cls color -> UniqSet k
    nodeConflicts Node k cls color
    n) k
    k}))
                (forall k cls color.
    Graph k cls color -> UniqFM k (Node k cls color)
    graphMap Graph k cls color
    graph)
                (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 k (Node k cls color)
    map_coalesce =
              forall elt a. (elt -> a -> a) -> a -> UniqSet elt -> a
    nonDetStrictFoldUniqSet
                -- It's OK to use a non-deterministic fold here because the
                -- operation is commutative
                (forall k a.
    Uniquable k =>
    (a -> a) -> k -> UniqFM k a -> UniqFM k a
    adjustUFM_C (\Node k cls color
    n -> Node k cls color
    n { nodeCoalesce :: UniqSet k
    nodeCoalesce =
                                          forall a. Uniquable a => UniqSet a -> a -> UniqSet a
    addOneToUniqSet (forall k cls color. Node k cls color -> UniqSet k
    nodeCoalesce Node k cls color
    n) k
    k}))
                UniqFM k (Node k cls color)
    map_conflict
                (forall k cls color. Node k cls color -> UniqSet k
    nodeCoalesce Node k cls color
    node)

      in    Graph k cls color
    graph
            { graphMap :: UniqFM k (Node k cls color)
    graphMap      = forall key elt.
    Uniquable key =>
    UniqFM key elt -> key -> elt -> UniqFM key elt
    addToUFM UniqFM k (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 :: forall k cls color.
    Uniquable k =>
    k -> Graph k cls color -> Maybe (Graph k cls color)
    delNode k
    k Graph k cls color
    graph
            | Just Node k cls color
    node     <- 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  = forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl' (\Graph k cls color
    g k
    k1 -> let Just Graph k cls color
    g' = 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
                            forall a b. (a -> b) -> a -> b
    $ forall elt. UniqSet elt -> [elt]
    nonDetEltsUniqSet (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  = forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl' (\Graph k cls color
    g k
    k1 -> let Just Graph k cls color
    g' = 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
                            forall a b. (a -> b) -> a -> b
    $ forall elt. UniqSet elt -> [elt]
    nonDetEltsUniqSet (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  = 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)
    fm -> forall key elt.
    Uniquable key =>
    UniqFM key elt -> key -> UniqFM key elt
    delFromUFM UniqFM k (Node k cls color)
    fm k
    k) Graph k cls color
    graph2

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

            | Bool
    otherwise
            = 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 :: 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 k cls color -> Node k cls color
    f k
    k Graph k cls color
    graph
     = case 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{}
             -> forall a. a -> Maybe a
    Just
             forall a b. (a -> b) -> a -> b
    $  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)
    fm   -> let  Just Node k cls color
    node       = forall key elt. Uniquable key => UniqFM key elt -> key -> Maybe elt
    lookupUFM UniqFM k (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   forall key elt.
    Uniquable key =>
    UniqFM key elt -> key -> elt -> UniqFM key elt
    addToUFM UniqFM k (Node k cls color)
    fm k
    k Node k cls color
    node')
                    Graph k cls color
    graph

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

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

    size :: forall k cls color. Graph k cls color -> Int
    size Graph k cls color
    graph
            = forall key elt. UniqFM key elt -> Int
    sizeUFM forall a b. (a -> b) -> a -> b
    $ forall k cls color.
    Graph k cls color -> UniqFM k (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 :: forall k cls color.
    Graph k cls color -> Graph k cls color -> Graph k cls color
    union   Graph k cls color
    graph1 Graph k cls color
    graph2
            = Graph
            { graphMap :: UniqFM k (Node k cls color)
    graphMap              = forall key elt. UniqFM key elt -> UniqFM key elt -> UniqFM key elt
    plusUFM (forall k cls color.
    Graph k cls color -> UniqFM k (Node k cls color)
    graphMap Graph k cls color
    graph1) (forall k cls color.
    Graph k cls color -> UniqFM k (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 :: forall k cls color.
    Uniquable k =>
    (k, cls) -> (k, cls) -> Graph k cls color -> Graph k cls color
    addConflict (k
    u1, cls
    c1) (k
    u2, cls
    c2)
     = let  addNeighbor :: k
    -> cls
    -> k
    -> UniqFM k (Node k cls color)
    -> UniqFM k (Node k cls color)
    addNeighbor k
    u cls
    c k
    u'
                    = forall k a.
    Uniquable k =>
    (a -> a) -> a -> k -> UniqFM k a -> UniqFM k a
    adjustWithDefaultUFM
                            (\Node k cls color
    node -> Node k cls color
    node { nodeConflicts :: UniqSet k
    nodeConflicts = forall a. Uniquable a => UniqSet a -> a -> UniqSet a
    addOneToUniqSet (forall k cls color. Node k cls color -> UniqSet k
    nodeConflicts Node k cls color
    node) k
    u' })
                            (forall k cls color. k -> cls -> Node k cls color
    newNode k
    u cls
    c)  { nodeConflicts :: UniqSet k
    nodeConflicts = forall a. Uniquable a => a -> UniqSet a
    unitUniqSet k
    u' }
                            k
    u

       in   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
            ( forall {k} {cls} {color}.
    Uniquable k =>
    k
    -> cls
    -> k
    -> UniqFM k (Node k cls color)
    -> UniqFM k (Node k cls color)
    addNeighbor k
    u1 cls
    c1 k
    u2
            forall b c a. (b -> c) -> (a -> b) -> a -> c
    . forall {k} {cls} {color}.
    Uniquable k =>
    k
    -> cls
    -> k
    -> UniqFM k (Node k cls color)
    -> UniqFM k (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 :: forall k cls color.
    Uniquable k =>
    k -> k -> Graph k cls color -> Maybe (Graph k cls color)
    delConflict k
    k1 k
    k2
            = 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 k cls color
    node -> Node k cls color
    node { nodeConflicts :: UniqSet k
    nodeConflicts = forall a. Uniquable a => UniqSet a -> a -> UniqSet a
    delOneFromUniqSet (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 :: forall k cls color.
    Uniquable k =>
    UniqSet k -> (k -> cls) -> Graph k cls color -> Graph k cls color
    addConflicts UniqSet k
    conflicts k -> cls
    getClass

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

            | Bool
    otherwise
            = 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
            forall a b. (a -> b) -> a -> b
    $ \UniqFM k (Node k cls color)
    fm -> forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl' (\UniqFM k (Node k cls color)
    g k
    u  -> forall k cls color.
    Uniquable k =>
    k
    -> (k -> cls)
    -> UniqSet k
    -> UniqFM k (Node k cls color)
    -> UniqFM k (Node k cls color)
    addConflictSet1 k
    u k -> cls
    getClass UniqSet k
    conflicts UniqFM k (Node k cls color)
    g) UniqFM k (Node k cls color)
    fm
                    forall a b. (a -> b) -> a -> b
    $ 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 k (Node k cls color)
                    -> UniqFM k (Node k cls color)
    addConflictSet1 :: forall k cls color.
    Uniquable k =>
    k
    -> (k -> cls)
    -> UniqSet k
    -> UniqFM k (Node k cls color)
    -> UniqFM k (Node k cls color)
    addConflictSet1 k
    u k -> cls
    getClass UniqSet k
    set
     = case forall a. Uniquable a => UniqSet a -> a -> UniqSet a
    delOneFromUniqSet UniqSet k
    set k
    u of
        UniqSet k
    set' -> forall k a.
    Uniquable k =>
    (a -> a) -> a -> k -> UniqFM k a -> UniqFM k a
    adjustWithDefaultUFM
                    (\Node k cls color
    node -> Node k cls color
    node                  { nodeConflicts :: UniqSet k
    nodeConflicts = forall a. UniqSet a -> UniqSet a -> UniqSet a
    unionUniqSets UniqSet k
    set' (forall k cls color. Node k cls color -> UniqSet k
    nodeConflicts Node k cls color
    node) } )
                    (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 :: 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 color
    color
            = 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
            forall a b. (a -> b) -> a -> b
    $ forall k a.
    Uniquable k =>
    (a -> a) -> a -> k -> UniqFM k a -> UniqFM k a
    adjustWithDefaultUFM
                    (\Node k cls color
    node -> Node k cls color
    node                  { nodeExclusions :: UniqSet color
    nodeExclusions = forall a. Uniquable a => UniqSet a -> a -> UniqSet a
    addOneToUniqSet (forall k cls color. Node k cls color -> UniqSet color
    nodeExclusions Node k cls color
    node) color
    color })
                    (forall k cls color. k -> cls -> Node k cls color
    newNode k
    u (k -> cls
    getClass k
    u))        { nodeExclusions :: UniqSet color
    nodeExclusions = 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 :: forall k color cls.
    (Uniquable k, Uniquable color) =>
    k
    -> (k -> cls) -> [color] -> Graph k cls color -> Graph k cls color
    addExclusions k
    u k -> cls
    getClass [color]
    colors Graph k cls color
    graph
            = forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr (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 required.
    --      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 :: forall k cls color.
    Uniquable k =>
    (k, cls) -> (k, cls) -> Graph k cls color -> Graph k cls color
    addCoalesce (k
    u1, cls
    c1) (k
    u2, cls
    c2)
     = let  addCoalesce :: k
    -> cls
    -> k
    -> UniqFM k (Node k cls color)
    -> UniqFM k (Node k cls color)
    addCoalesce k
    u cls
    c k
    u'
             =      forall k a.
    Uniquable k =>
    (a -> a) -> a -> k -> UniqFM k a -> UniqFM k a
    adjustWithDefaultUFM
                            (\Node k cls color
    node -> Node k cls color
    node { nodeCoalesce :: UniqSet k
    nodeCoalesce = forall a. Uniquable a => UniqSet a -> a -> UniqSet a
    addOneToUniqSet (forall k cls color. Node k cls color -> UniqSet k
    nodeCoalesce Node k cls color
    node) k
    u' })
                            (forall k cls color. k -> cls -> Node k cls color
    newNode k
    u cls
    c)  { nodeCoalesce :: UniqSet k
    nodeCoalesce = forall a. Uniquable a => a -> UniqSet a
    unitUniqSet k
    u' }
                            k
    u

       in   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
            ( forall {k} {cls} {color}.
    Uniquable k =>
    k
    -> cls
    -> k
    -> UniqFM k (Node k cls color)
    -> UniqFM k (Node k cls color)
    addCoalesce k
    u1 cls
    c1 k
    u2
            forall b c a. (b -> c) -> (a -> b) -> a -> c
    . forall {k} {cls} {color}.
    Uniquable k =>
    k
    -> cls
    -> k
    -> UniqFM k (Node k cls color)
    -> UniqFM k (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 :: forall k cls color.
    Uniquable k =>
    k -> k -> Graph k cls color -> Maybe (Graph k cls color)
    delCoalesce k
    k1 k
    k2
            = 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 k cls color
    node -> Node k cls color
    node { nodeCoalesce :: UniqSet k
    nodeCoalesce = forall a. Uniquable a => UniqSet a -> a -> UniqSet a
    delOneFromUniqSet (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 preferred.
    --      The algorithm tries to assign a node it's preferred color if possible.
    --
    addPreference
            :: Uniquable k
            => (k, cls) -> color
            -> Graph k cls color -> Graph k cls color

    addPreference :: forall k cls color.
    Uniquable k =>
    (k, cls) -> color -> Graph k cls color -> Graph k cls color
    addPreference (k
    u, cls
    c) color
    color
            = 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
            forall a b. (a -> b) -> a -> b
    $ forall k a.
    Uniquable k =>
    (a -> a) -> a -> k -> UniqFM k a -> UniqFM k a
    adjustWithDefaultUFM
                    (\Node k cls color
    node -> Node k cls color
    node { nodePreference :: [color]
    nodePreference = color
    color forall a. a -> [a] -> [a]
    : (forall k cls color. Node k cls color -> [color]
    nodePreference Node k cls color
    node) })
                    (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 :: forall k cls color.
    (Uniquable k, Ord k, Eq cls, Outputable k) =>
    Bool
    -> Triv k cls color
    -> Graph k cls color
    -> (Graph k cls color, [(k, k)])
    coalesceGraph Bool
    aggressive Triv k cls color
    triv Graph k cls color
    graph
            = 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' :: 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)]
    kkPairsAcc
     = let
            -- find all the nodes that have coalescence edges
            cNodes :: [Node k cls color]
    cNodes  = forall a. (a -> Bool) -> [a] -> [a]
    filter (\Node k cls color
    node -> Bool -> Bool
    not forall a b. (a -> b) -> a -> b
    $ forall a. UniqSet a -> Bool
    isEmptyUniqSet (forall k cls color. Node k cls color -> UniqSet k
    nodeCoalesce Node k cls color
    node))
                    forall a b. (a -> b) -> a -> b
    $ forall key elt. UniqFM key elt -> [elt]
    nonDetEltsUFM forall a b. (a -> b) -> a -> b
    $ forall k cls color.
    Graph k cls color -> UniqFM k (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   = [ (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    <- forall elt. UniqSet elt -> [elt]
    nonDetEltsUniqSet forall a b. (a -> b) -> a -> b
    $ 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 k cls color
    graph', [Maybe (k, k)]
    mPairs)
                    = forall (t :: * -> *) s a b.
    Traversable t =>
    (s -> a -> (s, b)) -> s -> t a -> (s, t b)
    mapAccumL (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 forall a. [Maybe a] -> [a]
    catMaybes [Maybe (k, k)]
    mPairs of
             []     -> (Graph k cls color
    graph', forall a. [a] -> [a]
    reverse [(k, k)]
    kkPairsAcc)
             [(k, k)]
    pairs  -> 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' (forall a. [a] -> [a]
    reverse [(k, k)]
    pairs 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 :: 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
    k1, k
    k2)
            | (k
    kMin, k
    kMax)  <- if k
    k1 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 Node k cls color
    nMin     <- 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 Node k cls color
    nMax     <- 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 forall a b. (a -> b) -> a -> b
    $ forall a. Uniquable a => a -> UniqSet a -> Bool
    elementOfUniqSet k
    kMin (forall k cls color. Node k cls color -> UniqSet k
    nodeConflicts Node k cls color
    nMax)
            , Bool -> Bool
    not forall a b. (a -> b) -> a -> b
    $ forall a. Uniquable a => a -> UniqSet a -> Bool
    elementOfUniqSet k
    kMax (forall k cls color. Node k cls color -> UniqSet k
    nodeConflicts Node k cls color
    nMin)

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

            = 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, 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 :: 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

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

            | Bool -> Bool
    not (forall a. Maybe a -> Bool
    isNothing (forall k cls color. Node k cls color -> Maybe color
    nodeColor Node k cls color
    nMin) Bool -> Bool -> Bool
    && forall a. Maybe a -> Bool
    isNothing (forall k cls color. Node k cls color -> Maybe color
    nodeColor Node k cls color
    nMax))
            = forall a. HasCallStack => String -> a
    error String
    "GHC.Data.Graph.Ops.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   { nodeId :: k
    nodeId                = k
    kMin
                            , nodeClass :: cls
    nodeClass             = forall k cls color. Node k cls color -> cls
    nodeClass Node k cls color
    nMin
                            , nodeColor :: Maybe color
    nodeColor             = forall a. Maybe a
    Nothing

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

                            , nodeExclusions :: UniqSet color
    nodeExclusions        = forall a. UniqSet a -> UniqSet a -> UniqSet a
    unionUniqSets (forall k cls color. Node k cls color -> UniqSet color
    nodeExclusions Node k cls color
    nMin) (forall k cls color. Node k cls color -> UniqSet color
    nodeExclusions Node k cls color
    nMax)
                            , nodePreference :: [color]
    nodePreference        = forall k cls color. Node k cls color -> [color]
    nodePreference Node k cls color
    nMin forall a. [a] -> [a] -> [a]
    ++ 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
                                    = (forall a. UniqSet a -> UniqSet a -> UniqSet a
    unionUniqSets (forall k cls color. Node k cls color -> UniqSet k
    nodeCoalesce Node k cls color
    nMin) (forall k cls color. Node k cls color -> UniqSet k
    nodeCoalesce Node k cls color
    nMax))
                                            forall a. Uniquable a => UniqSet a -> a -> UniqSet a
    `delOneFromUniqSet` k
    kMin
                                            forall a. Uniquable a => UniqSet a -> a -> UniqSet a
    `delOneFromUniqSet` k
    kMax
                            }

              in    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 :: 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

            -- 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 forall a b. (a -> b) -> a -> b
    $ Triv k cls color
    triv (forall k cls color. Node k cls color -> cls
    nodeClass Node k cls color
    node) (forall k cls color. Node k cls color -> UniqSet k
    nodeConflicts Node k cls color
    node) (forall k cls color. Node k cls color -> UniqSet color
    nodeExclusions Node k cls color
    node)
            = (Graph k cls color
    graph, forall a. Maybe a
    Nothing)

            | Bool
    otherwise
            = let -- delete the old nodes from the graph and add the new one
                    Just Graph k cls color
    graph1     = 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 Graph k cls color
    graph2     = 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          = 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, 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 :: forall k cls color.
    Uniquable k =>
    k -> Graph k cls color -> Graph k cls color
    freezeNode k
    k
      = 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
      forall a b. (a -> b) -> a -> b
    $ \UniqFM k (Node k cls color)
    fm ->
        let -- freeze all the edges in the node to be frozen
            Just Node k cls color
    node = forall key elt. Uniquable key => UniqFM key elt -> key -> Maybe elt
    lookupUFM UniqFM k (Node k cls color)
    fm k
    k
            node' :: Node k cls color
    node'   = Node k cls color
    node
                    { nodeCoalesce :: UniqSet k
    nodeCoalesce          = forall a. UniqSet a
    emptyUniqSet }

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

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

        in  UniqFM k (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 :: forall k cls color.
    Uniquable k =>
    Graph k cls color -> (Graph k cls color, Bool)
    freezeOneInGraph Graph k cls color
    graph
     = let  compareNodeDegree :: Node a cls color -> Node a cls color -> Ordering
    compareNodeDegree Node a cls color
    n1 Node a cls color
    n2
                    = forall a. Ord a => a -> a -> Ordering
    compare (forall a. UniqSet a -> Int
    sizeUniqSet forall a b. (a -> b) -> a -> b
    $ forall k cls color. Node k cls color -> UniqSet k
    nodeConflicts Node a cls color
    n1) (forall a. UniqSet a -> Int
    sizeUniqSet forall a b. (a -> b) -> a -> b
    $ forall k cls color. Node k cls color -> UniqSet k
    nodeConflicts Node a cls color
    n2)

            candidates :: [Node k cls color]
    candidates
                    = forall a. (a -> a -> Ordering) -> [a] -> [a]
    sortBy forall {a} {cls} {color} {a} {cls} {color}.
    Node a cls color -> Node a cls color -> Ordering
    compareNodeDegree
                    forall a b. (a -> b) -> a -> b
    $ forall a. Int -> [a] -> [a]
    take Int
    5        -- 5 isn't special, it's just a small number.
                    forall a b. (a -> b) -> a -> b
    $ forall k cls color.
    (Node k cls color -> Bool)
    -> Graph k cls color -> [Node k cls color]
    scanGraph (\Node k cls color
    node -> Bool -> Bool
    not forall a b. (a -> b) -> a -> b
    $ forall a. UniqSet a -> Bool
    isEmptyUniqSet (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
             (Node k cls color
    n : [Node k cls color]
    _)
              -> ( forall k cls color.
    Uniquable k =>
    k -> Graph k cls color -> Graph k cls color
    freezeNode (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 :: forall k cls color.
    Uniquable k =>
    Graph k cls color -> Graph k cls color
    freezeAllInGraph Graph k cls color
    graph
            = forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr forall k cls color.
    Uniquable k =>
    k -> Graph k cls color -> Graph k cls color
    freezeNode Graph k cls color
    graph
                    forall a b. (a -> b) -> a -> b
    $ forall a b. (a -> b) -> [a] -> [b]
    map forall k cls color. Node k cls color -> k
    nodeId
                    forall a b. (a -> b) -> a -> b
    $ forall key elt. UniqFM key elt -> [elt]
    nonDetEltsUFM forall a b. (a -> b) -> a -> b
    $ forall k cls color.
    Graph k cls color -> UniqFM k (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 :: forall k cls color.
    (Node k cls color -> Bool)
    -> Graph k cls color -> [Node k cls color]
    scanGraph Node k cls color -> Bool
    match Graph k cls color
    graph
            = forall a. (a -> Bool) -> [a] -> [a]
    filter Node k cls color -> Bool
    match forall a b. (a -> b) -> a -> b
    $ forall key elt. UniqFM key elt -> [elt]
    nonDetEltsUFM forall a b. (a -> b) -> a -> b
    $ forall k cls color.
    Graph k cls color -> UniqFM k (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 :: forall k color cls.
    (Uniquable k, Outputable k, Eq color) =>
    SDoc -> Bool -> Graph k cls color -> Graph k cls color
    validateGraph SDoc
    doc Bool
    isColored Graph k cls color
    graph

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

            , UniqSet k
    nodes         <- forall a. Uniquable a => [a] -> UniqSet a
    mkUniqSet forall a b. (a -> b) -> a -> b
    $ forall a b. (a -> b) -> [a] -> [b]
    map forall k cls color. Node k cls color -> k
    nodeId forall a b. (a -> b) -> a -> b
    $ forall key elt. UniqFM key elt -> [elt]
    nonDetEltsUFM forall a b. (a -> b) -> a -> b
    $ forall k cls color.
    Graph k cls color -> UniqFM k (Node k cls color)
    graphMap Graph k cls color
    graph
            , UniqSet k
    badEdges      <- forall a. UniqSet a -> UniqSet a -> UniqSet a
    minusUniqSet UniqSet k
    edges UniqSet k
    nodes
            , Bool -> Bool
    not forall a b. (a -> b) -> a -> b
    $ forall a. UniqSet a -> Bool
    isEmptyUniqSet UniqSet k
    badEdges
            = forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "GHC.Data.Graph.Ops.validateGraph"
                    (  String -> SDoc
    text String
    "Graph has edges that point to non-existent nodes"
                    SDoc -> SDoc -> SDoc
    $$ String -> SDoc
    text String
    "  bad edges: " SDoc -> SDoc -> SDoc
    <> forall key a. UniqFM key a -> ([a] -> SDoc) -> SDoc
    pprUFM (forall a. UniqSet a -> UniqFM a a
    getUniqSet UniqSet k
    badEdges) ([SDoc] -> SDoc
    vcat forall b c a. (b -> c) -> (a -> b) -> a -> c
    . forall a b. (a -> b) -> [a] -> [b]
    map 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      <- forall a. (a -> Bool) -> [a] -> [a]
    filter (Bool -> Bool
    not forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (forall k color cls.
    (Uniquable k, Eq color) =>
    Graph k cls color -> Node k cls color -> Bool
    checkNode Graph k cls color
    graph))
                            forall a b. (a -> b) -> a -> b
    $ forall key elt. UniqFM key elt -> [elt]
    nonDetEltsUFM forall a b. (a -> b) -> a -> b
    $ forall k cls color.
    Graph k cls color -> UniqFM k (Node k cls color)
    graphMap Graph k cls color
    graph
                               -- See Note [Unique Determinism and code generation]
            , Bool -> Bool
    not forall a b. (a -> b) -> a -> b
    $ forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Node k cls color]
    badNodes
            = forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "GHC.Data.Graph.Ops.validateGraph"
                    (  String -> SDoc
    text String
    "Node has same color as one of it's conflicts"
                    SDoc -> SDoc -> SDoc
    $$ String -> SDoc
    text String
    "  bad nodes: " SDoc -> SDoc -> SDoc
    <> [SDoc] -> SDoc
    hcat (forall a b. (a -> b) -> [a] -> [b]
    map (forall a. Outputable a => a -> SDoc
    ppr forall b c a. (b -> c) -> (a -> b) -> a -> c
    . 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      <- forall a. (a -> Bool) -> [a] -> [a]
    filter (\Node k cls color
    n -> forall a. Maybe a -> Bool
    isNothing forall a b. (a -> b) -> a -> b
    $ forall k cls color. Node k cls color -> Maybe color
    nodeColor Node k cls color
    n)
                            forall a b. (a -> b) -> a -> b
    $  forall key elt. UniqFM key elt -> [elt]
    nonDetEltsUFM forall a b. (a -> b) -> a -> b
    $ forall k cls color.
    Graph k cls color -> UniqFM k (Node k cls color)
    graphMap Graph k cls color
    graph
            , Bool -> Bool
    not forall a b. (a -> b) -> a -> b
    $ forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Node k cls color]
    badNodes
            = forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "GHC.Data.Graph.Ops.validateGraph"
                    (  String -> SDoc
    text String
    "Supposably colored graph has uncolored nodes."
                    SDoc -> SDoc -> SDoc
    $$ String -> SDoc
    text String
    "  uncolored nodes: " SDoc -> SDoc -> SDoc
    <> [SDoc] -> SDoc
    hcat (forall a b. (a -> b) -> [a] -> [b]
    map (forall a. Outputable a => a -> SDoc
    ppr forall b c a. (b -> c) -> (a -> b) -> a -> c
    . 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 :: 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
            | Just color
    color            <- forall k cls color. Node k cls color -> Maybe color
    nodeColor Node k cls color
    node
            , Just [Node k cls color]
    neighbors        <- forall (t :: * -> *) (m :: * -> *) a.
    (Traversable t, Monad m) =>
    t (m a) -> m (t a)
    sequence forall a b. (a -> b) -> a -> b
    $ forall a b. (a -> b) -> [a] -> [b]
    map (forall k cls color.
    Uniquable k =>
    Graph k cls color -> k -> Maybe (Node k cls color)
    lookupNode Graph k cls color
    graph)
                                    forall a b. (a -> b) -> a -> b
    $  forall elt. UniqSet elt -> [elt]
    nonDetEltsUniqSet forall a b. (a -> b) -> a -> b
    $ 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       <- forall a. [Maybe a] -> [a]
    catMaybes forall a b. (a -> b) -> a -> b
    $ forall a b. (a -> b) -> [a] -> [b]
    map forall k cls color. Node k cls color -> Maybe color
    nodeColor [Node k cls color]
    neighbors
            , 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, Int)    -- ^ (conflict neighbours, num nodes with that many conflicts)

    slurpNodeConflictCount :: forall k cls color. Graph k cls color -> UniqFM Int (Int, Int)
    slurpNodeConflictCount Graph k cls color
    graph
            = forall key elt.
    Uniquable key =>
    (elt -> elt -> elt)
    -> UniqFM key elt -> [(key, elt)] -> UniqFM key elt
    addListToUFM_C
                    (\(Int
    c1, Int
    n1) (Int
    _, Int
    n2) -> (Int
    c1, Int
    n1 forall a. Num a => a -> a -> a
    + Int
    n2))
                    forall key elt. UniqFM key elt
    emptyUFM
            forall a b. (a -> b) -> a -> b
    $ forall a b. (a -> b) -> [a] -> [b]
    map   (\Node k cls color
    node
                      -> let count :: Int
    count  = forall a. UniqSet a -> Int
    sizeUniqSet forall a b. (a -> b) -> a -> b
    $ forall k cls color. Node k cls color -> UniqSet k
    nodeConflicts Node k cls color
    node
                         in  (Int
    count, (Int
    count, Int
    1)))
            forall a b. (a -> b) -> a -> b
    $ forall key elt. UniqFM key elt -> [elt]
    nonDetEltsUFM
            -- See Note [Unique Determinism and code generation]
            forall a b. (a -> b) -> a -> b
    $ forall k cls color.
    Graph k cls color -> UniqFM k (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 :: forall k color cls.
    Uniquable k =>
    k -> color -> Graph k cls color -> Graph k cls color
    setColor k
    u color
    color
            = 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
            forall a b. (a -> b) -> a -> b
    $ forall k a.
    Uniquable k =>
    (a -> a) -> k -> UniqFM k a -> UniqFM k a
    adjustUFM_C
                    (\Node k cls color
    n -> Node k cls color
    n { nodeColor :: Maybe color
    nodeColor = forall a. a -> Maybe a
    Just color
    color })
                    k
    u

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

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

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

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