    -- (c) The University of Glasgow 2006

    {-# LANGUAGE GeneralizedNewtypeDeriving #-}
    {-# LANGUAGE ScopedTypeVariables #-}
    {-# LANGUAGE ViewPatterns #-}
    {-# LANGUAGE DeriveFunctor #-}

    module GHC.Data.Graph.Directed (
            Graph, graphFromEdgedVerticesOrd, graphFromEdgedVerticesUniq,
            graphFromVerticesAndAdjacency,

            SCC(..), Node(..), G.flattenSCC, G.flattenSCCs,
            stronglyConnCompG,
            topologicalSortG,
            verticesG, edgesG, hasVertexG,
            reachableG, reachablesG, transposeG, allReachable, allReachableCyclic, outgoingG,
            emptyG,

            findCycle,

            -- For backwards compatibility with the simpler version of Digraph
            stronglyConnCompFromEdgedVerticesOrd,
            stronglyConnCompFromEdgedVerticesOrdR,
            stronglyConnCompFromEdgedVerticesUniq,
            stronglyConnCompFromEdgedVerticesUniqR,

            -- Simple way to classify edges
            EdgeType(..), classifyEdges
            ) where

    ------------------------------------------------------------------------------
    -- A version of the graph algorithms described in:
    --
    -- ``Lazy Depth-First Search and Linear IntGraph Algorithms in Haskell''
    --   by David King and John Launchbury
    --
    -- Also included is some additional code for printing tree structures ...
    --
    -- If you ever find yourself in need of algorithms for classifying edges,
    -- or finding connected/biconnected components, consult the history; Sigbjorn
    -- Finne contributed some implementations in 1997, although we've since
    -- removed them since they were not used anywhere in GHC.
    ------------------------------------------------------------------------------

    import GHC.Prelude

    import GHC.Utils.Misc ( sortWith, count )
    import GHC.Utils.Outputable
    import GHC.Utils.Panic
    import GHC.Data.Maybe ( expectJust )

    -- std interfaces
    import Data.Maybe
    import Data.Array
    import Data.List ( sort )
    import qualified Data.Map as Map
    import qualified Data.Set as Set

    import qualified Data.Graph as G
    import Data.Graph ( Vertex, Bounds, SCC(..) ) -- Used in the underlying representation
    import Data.Tree
    import GHC.Types.Unique
    import GHC.Types.Unique.FM
    import qualified Data.IntMap as IM
    import qualified Data.IntSet as IS
    import qualified Data.Map as M
    import qualified Data.Set as S

    {-
    ************************************************************************
    *                                                                      *
    *      Graphs and Graph Construction
    *                                                                      *
    ************************************************************************

    Note [Nodes, keys, vertices]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
     * A 'node' is a big blob of client-stuff

     * Each 'node' has a unique (client) 'key', but the latter
            is in Ord and has fast comparison

     * Digraph then maps each 'key' to a Vertex (Int) which is
            arranged densely in 0.n
    -}

    data Graph node = Graph {
        forall node. Graph node -> IntGraph
    gr_int_graph      :: IntGraph,
        forall node. Graph node -> Vertex -> node
    gr_vertex_to_node :: Vertex -> node,
        forall node. Graph node -> node -> Maybe Vertex
    gr_node_to_vertex :: node -> Maybe Vertex
      }

    data Edge node = Edge node node

    {-| Representation for nodes of the Graph.

     * The @payload@ is user data, just carried around in this module

     * The @key@ is the node identifier.
       Key has an Ord instance for performance reasons.

     * The @[key]@ are the dependencies of the node;
       it's ok to have extra keys in the dependencies that
       are not the key of any Node in the graph
    -}
    data Node key payload = DigraphNode {
          forall key payload. Node key payload -> payload
    node_payload :: payload, -- ^ User data
          forall key payload. Node key payload -> key
    node_key :: key, -- ^ User defined node id
          forall key payload. Node key payload -> [key]
    node_dependencies :: [key] -- ^ Dependencies/successors of the node
      } deriving (forall a b. (a -> b) -> Node key a -> Node key b)
    -> (forall a b. a -> Node key b -> Node key a)
    -> Functor (Node key)
    forall a b. a -> Node key b -> Node key a
    forall a b. (a -> b) -> Node key a -> Node key b
    forall key a b. a -> Node key b -> Node key a
    forall key a b. (a -> b) -> Node key a -> Node key b
    forall (f :: * -> *).
    (forall a b. (a -> b) -> f a -> f b)
    -> (forall a b. a -> f b -> f a) -> Functor f
    $cfmap :: forall key a b. (a -> b) -> Node key a -> Node key b
    fmap :: forall a b. (a -> b) -> Node key a -> Node key b
    $c<$ :: forall key a b. a -> Node key b -> Node key a
    <$ :: forall a b. a -> Node key b -> Node key a
    Functor

    instance (Outputable a, Outputable b) => Outputable (Node a b) where
      ppr :: Node a b -> SDoc
    ppr (DigraphNode b
    a a
    b [a]
    c) = (b, a, [a]) -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (b
    a, a
    b, [a]
    c)

    emptyGraph :: Graph a
    emptyGraph :: forall a. Graph a
    emptyGraph = IntGraph -> (Vertex -> a) -> (a -> Maybe Vertex) -> Graph a
    forall node.
    IntGraph
    -> (Vertex -> node) -> (node -> Maybe Vertex) -> Graph node
    Graph ((Vertex, Vertex) -> [(Vertex, [Vertex])] -> IntGraph
    forall i e. Ix i => (i, i) -> [(i, e)] -> Array i e
    array (Vertex
    1, Vertex
    0) []) ([Char] -> Vertex -> a
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "emptyGraph") (Maybe Vertex -> a -> Maybe Vertex
    forall a b. a -> b -> a
    const Maybe Vertex
    forall a. Maybe a
    Nothing)

    -- See Note [Deterministic SCC]
    graphFromEdgedVertices
            :: ReduceFn key payload
            -> [Node key payload]           -- The graph; its ok for the
                                            -- out-list to contain keys which aren't
                                            -- a vertex key, they are ignored
            -> Graph (Node key payload)
    graphFromEdgedVertices :: forall key payload.
    ReduceFn key payload
    -> [Node key payload] -> Graph (Node key payload)
    graphFromEdgedVertices ReduceFn key payload
    _reduceFn []            = Graph (Node key payload)
    forall a. Graph a
    emptyGraph
    graphFromEdgedVertices ReduceFn key payload
    reduceFn [Node key payload]
    edged_vertices =
      IntGraph
    -> (Vertex -> Node key payload)
    -> (Node key payload -> Maybe Vertex)
    -> Graph (Node key payload)
    forall node.
    IntGraph
    -> (Vertex -> node) -> (node -> Maybe Vertex) -> Graph node
    Graph IntGraph
    graph Vertex -> Node key payload
    vertex_fn (key -> Maybe Vertex
    key_vertex (key -> Maybe Vertex)
    -> (Node key payload -> key) -> Node key payload -> Maybe Vertex
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Node key payload -> key
    forall key payload. Node key payload -> key
    key_extractor)
      where key_extractor :: Node key payload -> key
    key_extractor = Node key payload -> key
    forall key payload. Node key payload -> key
    node_key
            ((Vertex, Vertex)
    bounds, Vertex -> Node key payload
    vertex_fn, key -> Maybe Vertex
    key_vertex, [(Vertex, Node key payload)]
    numbered_nodes) =
              ReduceFn key payload
    reduceFn [Node key payload]
    edged_vertices Node key payload -> key
    forall key payload. Node key payload -> key
    key_extractor
            graph :: IntGraph
    graph = (Vertex, Vertex) -> [(Vertex, [Vertex])] -> IntGraph
    forall i e. Ix i => (i, i) -> [(i, e)] -> Array i e
    array (Vertex, Vertex)
    bounds [ (Vertex
    v, [Vertex] -> [Vertex]
    forall a. Ord a => [a] -> [a]
    sort ([Vertex] -> [Vertex]) -> [Vertex] -> [Vertex]
    forall a b. (a -> b) -> a -> b
    $ (key -> Maybe Vertex) -> [key] -> [Vertex]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe key -> Maybe Vertex
    key_vertex [key]
    ks)
                                 | (Vertex
    v, (Node key payload -> [key]
    forall key payload. Node key payload -> [key]
    node_dependencies -> [key]
    ks)) <- [(Vertex, Node key payload)]
    numbered_nodes]
                    -- We normalize outgoing edges by sorting on node order, so
                    -- that the result doesn't depend on the order of the edges

    -- See Note [Deterministic SCC]
    -- See Note [reduceNodesIntoVertices implementations]
    graphFromEdgedVerticesOrd
            :: Ord key
            => [Node key payload]           -- The graph; its ok for the
                                            -- out-list to contain keys which aren't
                                            -- a vertex key, they are ignored
            -> Graph (Node key payload)
    graphFromEdgedVerticesOrd :: forall key payload.
    Ord key =>
    [Node key payload] -> Graph (Node key payload)
    graphFromEdgedVerticesOrd = ReduceFn key payload
    -> [Node key payload] -> Graph (Node key payload)
    forall key payload.
    ReduceFn key payload
    -> [Node key payload] -> Graph (Node key payload)
    graphFromEdgedVertices ReduceFn key payload
    forall key payload. Ord key => ReduceFn key payload
    reduceNodesIntoVerticesOrd

    -- See Note [Deterministic SCC]
    -- See Note [reduceNodesIntoVertices implementations]
    graphFromEdgedVerticesUniq
            :: Uniquable key
            => [Node key payload]           -- The graph; its ok for the
                                            -- out-list to contain keys which aren't
                                            -- a vertex key, they are ignored
            -> Graph (Node key payload)
    graphFromEdgedVerticesUniq :: forall key payload.
    Uniquable key =>
    [Node key payload] -> Graph (Node key payload)
    graphFromEdgedVerticesUniq = ReduceFn key payload
    -> [Node key payload] -> Graph (Node key payload)
    forall key payload.
    ReduceFn key payload
    -> [Node key payload] -> Graph (Node key payload)
    graphFromEdgedVertices ReduceFn key payload
    forall key payload. Uniquable key => ReduceFn key payload
    reduceNodesIntoVerticesUniq

    type ReduceFn key payload =
      [Node key payload] -> (Node key payload -> key) ->
        (Bounds, Vertex -> Node key payload
        , key -> Maybe Vertex, [(Vertex, Node key payload)])

    {-
    Note [reduceNodesIntoVertices implementations]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    reduceNodesIntoVertices is parameterized by the container type.
    This is to accommodate key types that don't have an Ord instance
    and hence preclude the use of Data.Map. An example of such type
    would be Unique, there's no way to implement Ord Unique
    deterministically.

    For such types, there's a version with a Uniquable constraint.
    This leaves us with two versions of every function that depends on
    reduceNodesIntoVertices, one with Ord constraint and the other with
    Uniquable constraint.
    For example: graphFromEdgedVerticesOrd and graphFromEdgedVerticesUniq.

    The Uniq version should be a tiny bit more efficient since it uses
    Data.IntMap internally.
    -}
    reduceNodesIntoVertices
      :: ([(key, Vertex)] -> m)
      -> (key -> m -> Maybe Vertex)
      -> ReduceFn key payload
    reduceNodesIntoVertices :: forall key m payload.
    ([(key, Vertex)] -> m)
    -> (key -> m -> Maybe Vertex) -> ReduceFn key payload
    reduceNodesIntoVertices [(key, Vertex)] -> m
    fromList key -> m -> Maybe Vertex
    lookup [Node key payload]
    nodes Node key payload -> key
    key_extractor =
      ((Vertex, Vertex)
    bounds, Array Vertex (Node key payload) -> Vertex -> Node key payload
    forall i e. Ix i => Array i e -> i -> e
    (!) Array Vertex (Node key payload)
    vertex_map, key -> Maybe Vertex
    key_vertex, [(Vertex, Node key payload)]
    numbered_nodes)
      where
        max_v :: Vertex
    max_v           = [Node key payload] -> Vertex
    forall a. [a] -> Vertex
    forall (t :: * -> *) a. Foldable t => t a -> Vertex
    length [Node key payload]
    nodes Vertex -> Vertex -> Vertex
    forall a. Num a => a -> a -> a
    - Vertex
    1
        bounds :: (Vertex, Vertex)
    bounds          = (Vertex
    0, Vertex
    max_v) :: (Vertex, Vertex)

        -- Keep the order intact to make the result depend on input order
        -- instead of key order
        numbered_nodes :: [(Vertex, Node key payload)]
    numbered_nodes  = [Vertex] -> [Node key payload] -> [(Vertex, Node key payload)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [Vertex
    0..] [Node key payload]
    nodes
        vertex_map :: Array Vertex (Node key payload)
    vertex_map      = (Vertex, Vertex)
    -> [(Vertex, Node key payload)] -> Array Vertex (Node key payload)
    forall i e. Ix i => (i, i) -> [(i, e)] -> Array i e
    array (Vertex, Vertex)
    bounds [(Vertex, Node key payload)]
    numbered_nodes

        key_map :: m
    key_map = [(key, Vertex)] -> m
    fromList
          [ (Node key payload -> key
    key_extractor Node key payload
    node, Vertex
    v) | (Vertex
    v, Node key payload
    node) <- [(Vertex, Node key payload)]
    numbered_nodes ]
        key_vertex :: key -> Maybe Vertex
    key_vertex key
    k = key -> m -> Maybe Vertex
    lookup key
    k m
    key_map

    -- See Note [reduceNodesIntoVertices implementations]
    reduceNodesIntoVerticesOrd :: Ord key => ReduceFn key payload
    reduceNodesIntoVerticesOrd :: forall key payload. Ord key => ReduceFn key payload
    reduceNodesIntoVerticesOrd = ([(key, Vertex)] -> Map key Vertex)
    -> (key -> Map key Vertex -> Maybe Vertex) -> ReduceFn key payload
    forall key m payload.
    ([(key, Vertex)] -> m)
    -> (key -> m -> Maybe Vertex) -> ReduceFn key payload
    reduceNodesIntoVertices [(key, Vertex)] -> Map key Vertex
    forall k a. Ord k => [(k, a)] -> Map k a
    Map.fromList key -> Map key Vertex -> Maybe Vertex
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup

    -- See Note [reduceNodesIntoVertices implementations]
    reduceNodesIntoVerticesUniq :: Uniquable key => ReduceFn key payload
    reduceNodesIntoVerticesUniq :: forall key payload. Uniquable key => ReduceFn key payload
    reduceNodesIntoVerticesUniq = ([(key, Vertex)] -> UniqFM key Vertex)
    -> (key -> UniqFM key Vertex -> Maybe Vertex)
    -> ReduceFn key payload
    forall key m payload.
    ([(key, Vertex)] -> m)
    -> (key -> m -> Maybe Vertex) -> ReduceFn key payload
    reduceNodesIntoVertices [(key, Vertex)] -> UniqFM key Vertex
    forall key elt. Uniquable key => [(key, elt)] -> UniqFM key elt
    listToUFM ((UniqFM key Vertex -> key -> Maybe Vertex)
    -> key -> UniqFM key Vertex -> Maybe Vertex
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip UniqFM key Vertex -> key -> Maybe Vertex
    forall key elt. Uniquable key => UniqFM key elt -> key -> Maybe elt
    lookupUFM)

    {-
    ************************************************************************
    *                                                                      *
    *      SCC
    *                                                                      *
    ************************************************************************
    -}

    type WorkItem key payload
      = (Node key payload,  -- Tip of the path
         [payload])         -- Rest of the path;
                            --  [a,b,c] means c depends on b, b depends on a

    -- | Find a reasonably short cycle a->b->c->a, in a graph
    -- The graph might not necessarily be strongly connected.
    findCycle :: forall payload key. Ord key
              => [Node key payload]     -- The nodes.  The dependencies can
                                        -- contain extra keys, which are ignored
              -> Maybe [payload]        -- A cycle, starting with node
                                        -- so each depends on the next
    findCycle :: forall payload key.
    Ord key =>
    [Node key payload] -> Maybe [payload]
    findCycle [Node key payload]
    graph
      = [Node key payload] -> Maybe [payload]
    goRoots [Node key payload]
    plausible_roots
      where
        env :: Map.Map key (Node key payload)
        env :: Map key (Node key payload)
    env = [(key, Node key payload)] -> Map key (Node key payload)
    forall k a. Ord k => [(k, a)] -> Map k a
    Map.fromList [ (Node key payload -> key
    forall key payload. Node key payload -> key
    node_key Node key payload
    node, Node key payload
    node) | Node key payload
    node <- [Node key payload]
    graph ]

        goRoots :: [Node key payload] -> Maybe [payload]
    goRoots [] = Maybe [payload]
    forall a. Maybe a
    Nothing
        goRoots (Node key payload
    root:[Node key payload]
    xs) =
            case Set key
    -> [WorkItem key payload]
    -> [WorkItem key payload]
    -> Maybe [payload]
    go Set key
    forall a. Set a
    Set.empty ([key] -> [payload] -> [WorkItem key payload]
    new_work [key]
    root_deps []) [] of
              Maybe [payload]
    Nothing -> [Node key payload] -> Maybe [payload]
    goRoots [Node key payload]
    xs
              Just [payload]
    res -> [payload] -> Maybe [payload]
    forall a. a -> Maybe a
    Just [payload]
    res
          where
            DigraphNode payload
    root_payload key
    root_key [key]
    root_deps = Node key payload
    root
            -- 'go' implements Dijkstra's algorithm, more or less
            go :: Set.Set key   -- Visited
               -> [WorkItem key payload]        -- Work list, items length n
               -> [WorkItem key payload]        -- Work list, items length n+1
               -> Maybe [payload]               -- Returned cycle
               -- Invariant: in a call (go visited ps qs),
               --            visited = union (map tail (ps ++ qs))

            go :: Set key
    -> [WorkItem key payload]
    -> [WorkItem key payload]
    -> Maybe [payload]
    go Set key
    _       [] [] = Maybe [payload]
    forall a. Maybe a
    Nothing  -- No cycles
            go Set key
    visited [] [WorkItem key payload]
    qs = Set key
    -> [WorkItem key payload]
    -> [WorkItem key payload]
    -> Maybe [payload]
    go Set key
    visited [WorkItem key payload]
    qs []
            go Set key
    visited (((DigraphNode payload
    payload key
    key [key]
    deps), [payload]
    path) : [WorkItem key payload]
    ps) [WorkItem key payload]
    qs
               | key
    key key -> key -> Bool
    forall a. Eq a => a -> a -> Bool
    == key
    root_key           = [payload] -> Maybe [payload]
    forall a. a -> Maybe a
    Just (payload
    root_payload payload -> [payload] -> [payload]
    forall a. a -> [a] -> [a]
    : [payload] -> [payload]
    forall a. [a] -> [a]
    reverse [payload]
    path)
               | key
    key key -> Set key -> Bool
    forall a. Ord a => a -> Set a -> Bool
    `Set.member` Set key
    visited  = Set key
    -> [WorkItem key payload]
    -> [WorkItem key payload]
    -> Maybe [payload]
    go Set key
    visited [WorkItem key payload]
    ps [WorkItem key payload]
    qs
               | key
    key key -> Map key (Node key payload) -> Bool
    forall k a. Ord k => k -> Map k a -> Bool
    `Map.notMember` Map key (Node key payload)
    env   = Set key
    -> [WorkItem key payload]
    -> [WorkItem key payload]
    -> Maybe [payload]
    go Set key
    visited [WorkItem key payload]
    ps [WorkItem key payload]
    qs
               | Bool
    otherwise                 = Set key
    -> [WorkItem key payload]
    -> [WorkItem key payload]
    -> Maybe [payload]
    go (key -> Set key -> Set key
    forall a. Ord a => a -> Set a -> Set a
    Set.insert key
    key Set key
    visited)
                                                [WorkItem key payload]
    ps ([WorkItem key payload]
    new_qs [WorkItem key payload]
    -> [WorkItem key payload] -> [WorkItem key payload]
    forall a. [a] -> [a] -> [a]
    ++ [WorkItem key payload]
    qs)
               where
                 new_qs :: [WorkItem key payload]
    new_qs = [key] -> [payload] -> [WorkItem key payload]
    new_work [key]
    deps (payload
    payload payload -> [payload] -> [payload]
    forall a. a -> [a] -> [a]
    : [payload]
    path)

        -- Find the nodes with fewest dependencies among the SCC modules
        -- This is just a heuristic to find some plausible root module
        plausible_roots :: [Node key payload]
        plausible_roots :: [Node key payload]
    plausible_roots = ((Node key payload, Vertex) -> Node key payload)
    -> [(Node key payload, Vertex)] -> [Node key payload]
    forall a b. (a -> b) -> [a] -> [b]
    map (Node key payload, Vertex) -> Node key payload
    forall a b. (a, b) -> a
    fst (((Node key payload, Vertex) -> Vertex)
    -> [(Node key payload, Vertex)] -> [(Node key payload, Vertex)]
    forall b a. Ord b => (a -> b) -> [a] -> [a]
    sortWith (Node key payload, Vertex) -> Vertex
    forall a b. (a, b) -> b
    snd [ (Node key payload
    node, (key -> Bool) -> [key] -> Vertex
    forall a. (a -> Bool) -> [a] -> Vertex
    count (key -> Map key (Node key payload) -> Bool
    forall k a. Ord k => k -> Map k a -> Bool
    `Map.member` Map key (Node key payload)
    env) (Node key payload -> [key]
    forall key payload. Node key payload -> [key]
    node_dependencies Node key payload
    node))
                                                | Node key payload
    node <- [Node key payload]
    graph ])

        new_work :: [key] -> [payload] -> [WorkItem key payload]
        new_work :: [key] -> [payload] -> [WorkItem key payload]
    new_work [key]
    deps [payload]
    path = [ (Node key payload
    n, [payload]
    path) | Just Node key payload
    n <- (key -> Maybe (Node key payload))
    -> [key] -> [Maybe (Node key payload)]
    forall a b. (a -> b) -> [a] -> [b]
    map (key -> Map key (Node key payload) -> Maybe (Node key payload)
    forall k a. Ord k => k -> Map k a -> Maybe a
    `Map.lookup` Map key (Node key payload)
    env) [key]
    deps ]

    {-
    ************************************************************************
    *                                                                      *
    *      Strongly Connected Component wrappers for Graph
    *                                                                      *
    ************************************************************************

    Note: the components are returned topologically sorted: later components
    depend on earlier ones, but not vice versa i.e. later components only have
    edges going from them to earlier ones.
    -}

    {-
    Note [Deterministic SCC]
    ~~~~~~~~~~~~~~~~~~~~~~~~
    stronglyConnCompFromEdgedVerticesUniq,
    stronglyConnCompFromEdgedVerticesUniqR,
    stronglyConnCompFromEdgedVerticesOrd and
    stronglyConnCompFromEdgedVerticesOrdR
    provide a following guarantee:
    Given a deterministically ordered list of nodes it returns a deterministically
    ordered list of strongly connected components, where the list of vertices
    in an SCC is also deterministically ordered.
    Note that the order of edges doesn't need to be deterministic for this to work.
    We use the order of nodes to normalize the order of edges.
    -}

    stronglyConnCompG :: Graph node -> [SCC node]
    stronglyConnCompG :: forall node. Graph node -> [SCC node]
    stronglyConnCompG Graph node
    graph = Graph node -> [SCC Vertex] -> [SCC node]
    forall node. Graph node -> [SCC Vertex] -> [SCC node]
    decodeSccs Graph node
    graph ([SCC Vertex] -> [SCC node]) -> [SCC Vertex] -> [SCC node]
    forall a b. (a -> b) -> a -> b
    $ IntGraph -> [SCC Vertex]
    scc (Graph node -> IntGraph
    forall node. Graph node -> IntGraph
    gr_int_graph Graph node
    graph)

    decodeSccs :: Graph node -> [SCC Vertex] -> [SCC node]
    decodeSccs :: forall node. Graph node -> [SCC Vertex] -> [SCC node]
    decodeSccs Graph { gr_vertex_to_node :: forall node. Graph node -> Vertex -> node
    gr_vertex_to_node = Vertex -> node
    vertex_fn }
      = (SCC Vertex -> SCC node) -> [SCC Vertex] -> [SCC node]
    forall a b. (a -> b) -> [a] -> [b]
    map ((Vertex -> node) -> SCC Vertex -> SCC node
    forall a b. (a -> b) -> SCC a -> SCC b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Vertex -> node
    vertex_fn)

    -- The following two versions are provided for backwards compatibility:
    -- See Note [Deterministic SCC]
    -- See Note [reduceNodesIntoVertices implementations]
    stronglyConnCompFromEdgedVerticesOrd
            :: Ord key
            => [Node key payload]
            -> [SCC payload]
    stronglyConnCompFromEdgedVerticesOrd :: forall key payload. Ord key => [Node key payload] -> [SCC payload]
    stronglyConnCompFromEdgedVerticesOrd
      = (SCC (Node key payload) -> SCC payload)
    -> [SCC (Node key payload)] -> [SCC payload]
    forall a b. (a -> b) -> [a] -> [b]
    map ((Node key payload -> payload)
    -> SCC (Node key payload) -> SCC payload
    forall a b. (a -> b) -> SCC a -> SCC b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Node key payload -> payload
    forall key payload. Node key payload -> payload
    node_payload) ([SCC (Node key payload)] -> [SCC payload])
    -> ([Node key payload] -> [SCC (Node key payload)])
    -> [Node key payload]
    -> [SCC payload]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Node key payload] -> [SCC (Node key payload)]
    forall key payload.
    Ord key =>
    [Node key payload] -> [SCC (Node key payload)]
    stronglyConnCompFromEdgedVerticesOrdR

    -- The following two versions are provided for backwards compatibility:
    -- See Note [Deterministic SCC]
    -- See Note [reduceNodesIntoVertices implementations]
    stronglyConnCompFromEdgedVerticesUniq
            :: Uniquable key
            => [Node key payload]
            -> [SCC payload]
    stronglyConnCompFromEdgedVerticesUniq :: forall key payload.
    Uniquable key =>
    [Node key payload] -> [SCC payload]
    stronglyConnCompFromEdgedVerticesUniq
      = (SCC (Node key payload) -> SCC payload)
    -> [SCC (Node key payload)] -> [SCC payload]
    forall a b. (a -> b) -> [a] -> [b]
    map ((Node key payload -> payload)
    -> SCC (Node key payload) -> SCC payload
    forall a b. (a -> b) -> SCC a -> SCC b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Node key payload -> payload
    forall key payload. Node key payload -> payload
    node_payload) ([SCC (Node key payload)] -> [SCC payload])
    -> ([Node key payload] -> [SCC (Node key payload)])
    -> [Node key payload]
    -> [SCC payload]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Node key payload] -> [SCC (Node key payload)]
    forall key payload.
    Uniquable key =>
    [Node key payload] -> [SCC (Node key payload)]
    stronglyConnCompFromEdgedVerticesUniqR

    -- The "R" interface is used when you expect to apply SCC to
    -- (some of) the result of SCC, so you don't want to lose the dependency info
    -- See Note [Deterministic SCC]
    -- See Note [reduceNodesIntoVertices implementations]
    stronglyConnCompFromEdgedVerticesOrdR
            :: Ord key
            => [Node key payload]
            -> [SCC (Node key payload)]
    stronglyConnCompFromEdgedVerticesOrdR :: forall key payload.
    Ord key =>
    [Node key payload] -> [SCC (Node key payload)]
    stronglyConnCompFromEdgedVerticesOrdR =
      Graph (Node key payload) -> [SCC (Node key payload)]
    forall node. Graph node -> [SCC node]
    stronglyConnCompG (Graph (Node key payload) -> [SCC (Node key payload)])
    -> ([Node key payload] -> Graph (Node key payload))
    -> [Node key payload]
    -> [SCC (Node key payload)]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Node key payload] -> Graph (Node key payload)
    forall key payload.
    Ord key =>
    [Node key payload] -> Graph (Node key payload)
    graphFromEdgedVerticesOrd

    -- The "R" interface is used when you expect to apply SCC to
    -- (some of) the result of SCC, so you don't want to lose the dependency info
    -- See Note [Deterministic SCC]
    -- See Note [reduceNodesIntoVertices implementations]
    stronglyConnCompFromEdgedVerticesUniqR
            :: Uniquable key
            => [Node key payload]
            -> [SCC (Node key payload)]
    stronglyConnCompFromEdgedVerticesUniqR :: forall key payload.
    Uniquable key =>
    [Node key payload] -> [SCC (Node key payload)]
    stronglyConnCompFromEdgedVerticesUniqR =
      Graph (Node key payload) -> [SCC (Node key payload)]
    forall node. Graph node -> [SCC node]
    stronglyConnCompG (Graph (Node key payload) -> [SCC (Node key payload)])
    -> ([Node key payload] -> Graph (Node key payload))
    -> [Node key payload]
    -> [SCC (Node key payload)]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Node key payload] -> Graph (Node key payload)
    forall key payload.
    Uniquable key =>
    [Node key payload] -> Graph (Node key payload)
    graphFromEdgedVerticesUniq

    {-
    ************************************************************************
    *                                                                      *
    *      Misc wrappers for Graph
    *                                                                      *
    ************************************************************************
    -}

    topologicalSortG :: Graph node -> [node]
    topologicalSortG :: forall node. Graph node -> [node]
    topologicalSortG Graph node
    graph = (Vertex -> node) -> [Vertex] -> [node]
    forall a b. (a -> b) -> [a] -> [b]
    map (Graph node -> Vertex -> node
    forall node. Graph node -> Vertex -> node
    gr_vertex_to_node Graph node
    graph) [Vertex]
    result
      where result :: [Vertex]
    result = {-# SCC "Digraph.topSort" #-} IntGraph -> [Vertex]
    G.topSort (Graph node -> IntGraph
    forall node. Graph node -> IntGraph
    gr_int_graph Graph node
    graph)

    reachableG :: Graph node -> node -> [node]
    reachableG :: forall node. Graph node -> node -> [node]
    reachableG Graph node
    graph node
    from = (Vertex -> node) -> [Vertex] -> [node]
    forall a b. (a -> b) -> [a] -> [b]
    map (Graph node -> Vertex -> node
    forall node. Graph node -> Vertex -> node
    gr_vertex_to_node Graph node
    graph) [Vertex]
    result
      where from_vertex :: Vertex
    from_vertex = [Char] -> Maybe Vertex -> Vertex
    forall a. HasDebugCallStack => [Char] -> Maybe a -> a
    expectJust [Char]
    "reachableG" (Graph node -> node -> Maybe Vertex
    forall node. Graph node -> node -> Maybe Vertex
    gr_node_to_vertex Graph node
    graph node
    from)
            result :: [Vertex]
    result = {-# SCC "Digraph.reachable" #-} IntGraph -> [Vertex] -> [Vertex]
    reachable (Graph node -> IntGraph
    forall node. Graph node -> IntGraph
    gr_int_graph Graph node
    graph) [Vertex
    from_vertex]

    outgoingG :: Graph node -> node -> [node]
    outgoingG :: forall node. Graph node -> node -> [node]
    outgoingG Graph node
    graph node
    from = (Vertex -> node) -> [Vertex] -> [node]
    forall a b. (a -> b) -> [a] -> [b]
    map (Graph node -> Vertex -> node
    forall node. Graph node -> Vertex -> node
    gr_vertex_to_node Graph node
    graph) [Vertex]
    result
      where from_vertex :: Vertex
    from_vertex = [Char] -> Maybe Vertex -> Vertex
    forall a. HasDebugCallStack => [Char] -> Maybe a -> a
    expectJust [Char]
    "reachableG" (Graph node -> node -> Maybe Vertex
    forall node. Graph node -> node -> Maybe Vertex
    gr_node_to_vertex Graph node
    graph node
    from)
            result :: [Vertex]
    result = Graph node -> IntGraph
    forall node. Graph node -> IntGraph
    gr_int_graph Graph node
    graph IntGraph -> Vertex -> [Vertex]
    forall i e. Ix i => Array i e -> i -> e
    ! Vertex
    from_vertex

    -- | Given a list of roots return all reachable nodes.
    reachablesG :: Graph node -> [node] -> [node]
    reachablesG :: forall node. Graph node -> [node] -> [node]
    reachablesG Graph node
    graph [node]
    froms = (Vertex -> node) -> [Vertex] -> [node]
    forall a b. (a -> b) -> [a] -> [b]
    map (Graph node -> Vertex -> node
    forall node. Graph node -> Vertex -> node
    gr_vertex_to_node Graph node
    graph) [Vertex]
    result
      where result :: [Vertex]
    result = {-# SCC "Digraph.reachable" #-}
                     IntGraph -> [Vertex] -> [Vertex]
    reachable (Graph node -> IntGraph
    forall node. Graph node -> IntGraph
    gr_int_graph Graph node
    graph) [Vertex]
    vs
            vs :: [Vertex]
    vs = [ Vertex
    v | Just Vertex
    v <- (node -> Maybe Vertex) -> [node] -> [Maybe Vertex]
    forall a b. (a -> b) -> [a] -> [b]
    map (Graph node -> node -> Maybe Vertex
    forall node. Graph node -> node -> Maybe Vertex
    gr_node_to_vertex Graph node
    graph) [node]
    froms ]

    -- | Efficiently construct a map which maps each key to it's set of transitive
    -- dependencies. Only works on acyclic input.
    allReachable :: Ord key => Graph node -> (node -> key) -> M.Map key (S.Set key)
    allReachable :: forall key node.
    Ord key =>
    Graph node -> (node -> key) -> Map key (Set key)
    allReachable = (IntGraph -> IntMap IntSet)
    -> Graph node -> (node -> key) -> Map key (Set key)
    forall key node.
    Ord key =>
    (IntGraph -> IntMap IntSet)
    -> Graph node -> (node -> key) -> Map key (Set key)
    all_reachable IntGraph -> IntMap IntSet
    reachableGraph

    -- | Efficiently construct a map which maps each key to it's set of transitive
    -- dependencies. Less efficient than @allReachable@, but works on cyclic input as well.
    allReachableCyclic :: Ord key => Graph node -> (node -> key) -> M.Map key (S.Set key)
    allReachableCyclic :: forall key node.
    Ord key =>
    Graph node -> (node -> key) -> Map key (Set key)
    allReachableCyclic = (IntGraph -> IntMap IntSet)
    -> Graph node -> (node -> key) -> Map key (Set key)
    forall key node.
    Ord key =>
    (IntGraph -> IntMap IntSet)
    -> Graph node -> (node -> key) -> Map key (Set key)
    all_reachable IntGraph -> IntMap IntSet
    reachableGraphCyclic

    all_reachable :: Ord key => (IntGraph -> IM.IntMap IS.IntSet) -> Graph node -> (node -> key) -> M.Map key (S.Set key)
    all_reachable :: forall key node.
    Ord key =>
    (IntGraph -> IntMap IntSet)
    -> Graph node -> (node -> key) -> Map key (Set key)
    all_reachable IntGraph -> IntMap IntSet
    int_reachables (Graph IntGraph
    g Vertex -> node
    from node -> Maybe Vertex
    _) node -> key
    keyOf =
      [(key, Set key)] -> Map key (Set key)
    forall k a. Ord k => [(k, a)] -> Map k a
    M.fromList [(key
    k, (Vertex -> Set key -> Set key) -> Set key -> IntSet -> Set key
    forall b. (Vertex -> b -> b) -> b -> IntSet -> b
    IS.foldr (\Vertex
    v' Set key
    vs -> node -> key
    keyOf (Vertex -> node
    from Vertex
    v') key -> Set key -> Set key
    forall a. Ord a => a -> Set a -> Set a
    `S.insert` Set key
    vs) Set key
    forall a. Set a
    S.empty IntSet
    vs)
                 | (Vertex
    v, IntSet
    vs) <- IntMap IntSet -> [(Vertex, IntSet)]
    forall a. IntMap a -> [(Vertex, a)]
    IM.toList IntMap IntSet
    int_graph
                 , let k :: key
    k = node -> key
    keyOf (Vertex -> node
    from Vertex
    v)]
      where
        int_graph :: IntMap IntSet
    int_graph = IntGraph -> IntMap IntSet
    int_reachables IntGraph
    g

    hasVertexG :: Graph node -> node -> Bool
    hasVertexG :: forall node. Graph node -> node -> Bool
    hasVertexG Graph node
    graph node
    node = Maybe Vertex -> Bool
    forall a. Maybe a -> Bool
    isJust (Maybe Vertex -> Bool) -> Maybe Vertex -> Bool
    forall a b. (a -> b) -> a -> b
    $ Graph node -> node -> Maybe Vertex
    forall node. Graph node -> node -> Maybe Vertex
    gr_node_to_vertex Graph node
    graph node
    node

    verticesG :: Graph node -> [node]
    verticesG :: forall node. Graph node -> [node]
    verticesG Graph node
    graph = (Vertex -> node) -> [Vertex] -> [node]
    forall a b. (a -> b) -> [a] -> [b]
    map (Graph node -> Vertex -> node
    forall node. Graph node -> Vertex -> node
    gr_vertex_to_node Graph node
    graph) ([Vertex] -> [node]) -> [Vertex] -> [node]
    forall a b. (a -> b) -> a -> b
    $ IntGraph -> [Vertex]
    G.vertices (Graph node -> IntGraph
    forall node. Graph node -> IntGraph
    gr_int_graph Graph node
    graph)

    edgesG :: Graph node -> [Edge node]
    edgesG :: forall node. Graph node -> [Edge node]
    edgesG Graph node
    graph = ((Vertex, Vertex) -> Edge node)
    -> [(Vertex, Vertex)] -> [Edge node]
    forall a b. (a -> b) -> [a] -> [b]
    map (\(Vertex
    v1, Vertex
    v2) -> node -> node -> Edge node
    forall node. node -> node -> Edge node
    Edge (Vertex -> node
    v2n Vertex
    v1) (Vertex -> node
    v2n Vertex
    v2)) ([(Vertex, Vertex)] -> [Edge node])
    -> [(Vertex, Vertex)] -> [Edge node]
    forall a b. (a -> b) -> a -> b
    $ IntGraph -> [(Vertex, Vertex)]
    G.edges (Graph node -> IntGraph
    forall node. Graph node -> IntGraph
    gr_int_graph Graph node
    graph)
      where v2n :: Vertex -> node
    v2n = Graph node -> Vertex -> node
    forall node. Graph node -> Vertex -> node
    gr_vertex_to_node Graph node
    graph

    transposeG :: Graph node -> Graph node
    transposeG :: forall node. Graph node -> Graph node
    transposeG Graph node
    graph = IntGraph
    -> (Vertex -> node) -> (node -> Maybe Vertex) -> Graph node
    forall node.
    IntGraph
    -> (Vertex -> node) -> (node -> Maybe Vertex) -> Graph node
    Graph (IntGraph -> IntGraph
    G.transposeG (Graph node -> IntGraph
    forall node. Graph node -> IntGraph
    gr_int_graph Graph node
    graph))
                             (Graph node -> Vertex -> node
    forall node. Graph node -> Vertex -> node
    gr_vertex_to_node Graph node
    graph)
                             (Graph node -> node -> Maybe Vertex
    forall node. Graph node -> node -> Maybe Vertex
    gr_node_to_vertex Graph node
    graph)

    emptyG :: Graph node -> Bool
    emptyG :: forall node. Graph node -> Bool
    emptyG Graph node
    g = IntGraph -> Bool
    graphEmpty (Graph node -> IntGraph
    forall node. Graph node -> IntGraph
    gr_int_graph Graph node
    g)

    {-
    ************************************************************************
    *                                                                      *
    *      Showing Graphs
    *                                                                      *
    ************************************************************************
    -}

    instance Outputable node => Outputable (Graph node) where
        ppr :: Graph node -> SDoc
    ppr Graph node
    graph = [SDoc] -> SDoc
    forall doc. IsDoc doc => [doc] -> doc
    vcat [
                      SDoc -> Vertex -> SDoc -> SDoc
    hang ([Char] -> SDoc
    forall doc. IsLine doc => [Char] -> doc
    text [Char]
    "Vertices:") Vertex
    2 ([SDoc] -> SDoc
    forall doc. IsDoc doc => [doc] -> doc
    vcat ((node -> SDoc) -> [node] -> [SDoc]
    forall a b. (a -> b) -> [a] -> [b]
    map node -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr ([node] -> [SDoc]) -> [node] -> [SDoc]
    forall a b. (a -> b) -> a -> b
    $ Graph node -> [node]
    forall node. Graph node -> [node]
    verticesG Graph node
    graph)),
                      SDoc -> Vertex -> SDoc -> SDoc
    hang ([Char] -> SDoc
    forall doc. IsLine doc => [Char] -> doc
    text [Char]
    "Edges:") Vertex
    2 ([SDoc] -> SDoc
    forall doc. IsDoc doc => [doc] -> doc
    vcat ((Edge node -> SDoc) -> [Edge node] -> [SDoc]
    forall a b. (a -> b) -> [a] -> [b]
    map Edge node -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr ([Edge node] -> [SDoc]) -> [Edge node] -> [SDoc]
    forall a b. (a -> b) -> a -> b
    $ Graph node -> [Edge node]
    forall node. Graph node -> [Edge node]
    edgesG Graph node
    graph))
                    ]

    instance Outputable node => Outputable (Edge node) where
        ppr :: Edge node -> SDoc
    ppr (Edge node
    from node
    to) = node -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr node
    from SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> [Char] -> SDoc
    forall doc. IsLine doc => [Char] -> doc
    text [Char]
    "->" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> node -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr node
    to

    graphEmpty :: G.Graph -> Bool
    graphEmpty :: IntGraph -> Bool
    graphEmpty IntGraph
    g = Vertex
    lo Vertex -> Vertex -> Bool
    forall a. Ord a => a -> a -> Bool
    > Vertex
    hi
      where (Vertex
    lo, Vertex
    hi) = IntGraph -> (Vertex, Vertex)
    forall i e. Array i e -> (i, i)
    bounds IntGraph
    g

    {-
    ************************************************************************
    *                                                                      *
    *      IntGraphs
    *                                                                      *
    ************************************************************************
    -}

    type IntGraph = G.Graph

    {-
    ------------------------------------------------------------
    -- Depth first search numbering
    ------------------------------------------------------------
    -}

    -- Data.Tree has flatten for Tree, but nothing for Forest
    preorderF           :: Forest a -> [a]
    preorderF :: forall a. Forest a -> [a]
    preorderF Forest a
    ts         = (Tree a -> [a]) -> Forest a -> [a]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap Tree a -> [a]
    forall a. Tree a -> [a]
    flatten Forest a
    ts

    {-
    ------------------------------------------------------------
    -- Finding reachable vertices
    ------------------------------------------------------------
    -}

    -- This generalizes reachable which was found in Data.Graph
    reachable    :: IntGraph -> [Vertex] -> [Vertex]
    reachable :: IntGraph -> [Vertex] -> [Vertex]
    reachable IntGraph
    g [Vertex]
    vs = Forest Vertex -> [Vertex]
    forall a. Forest a -> [a]
    preorderF (IntGraph -> [Vertex] -> Forest Vertex
    G.dfs IntGraph
    g [Vertex]
    vs)

    reachableGraph :: IntGraph -> IM.IntMap IS.IntSet
    reachableGraph :: IntGraph -> IntMap IntSet
    reachableGraph IntGraph
    g = IntMap IntSet
    res
      where
        do_one :: Vertex -> IntSet
    do_one Vertex
    v = [IntSet] -> IntSet
    forall (f :: * -> *). Foldable f => f IntSet -> IntSet
    IS.unions ([Vertex] -> IntSet
    IS.fromList (IntGraph
    g IntGraph -> Vertex -> [Vertex]
    forall i e. Ix i => Array i e -> i -> e
    ! Vertex
    v) IntSet -> [IntSet] -> [IntSet]
    forall a. a -> [a] -> [a]
    : (Vertex -> Maybe IntSet) -> [Vertex] -> [IntSet]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe ((Vertex -> IntMap IntSet -> Maybe IntSet)
    -> IntMap IntSet -> Vertex -> Maybe IntSet
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip Vertex -> IntMap IntSet -> Maybe IntSet
    forall a. Vertex -> IntMap a -> Maybe a
    IM.lookup IntMap IntSet
    res) (IntGraph
    g IntGraph -> Vertex -> [Vertex]
    forall i e. Ix i => Array i e -> i -> e
    ! Vertex
    v))
        res :: IntMap IntSet
    res = [(Vertex, IntSet)] -> IntMap IntSet
    forall a. [(Vertex, a)] -> IntMap a
    IM.fromList [(Vertex
    v, Vertex -> IntSet
    do_one Vertex
    v) | Vertex
    v <- IntGraph -> [Vertex]
    G.vertices IntGraph
    g]

    scc :: IntGraph -> [SCC Vertex]
    scc :: IntGraph -> [SCC Vertex]
    scc IntGraph
    graph = (Tree Vertex -> SCC Vertex) -> Forest Vertex -> [SCC Vertex]
    forall a b. (a -> b) -> [a] -> [b]
    map Tree Vertex -> SCC Vertex
    decode Forest Vertex
    forest
      where
        forest :: Forest Vertex
    forest = {-# SCC "Digraph.scc" #-} IntGraph -> Forest Vertex
    G.scc IntGraph
    graph

        decode :: Tree Vertex -> SCC Vertex
    decode (Node Vertex
    v []) | Vertex -> Bool
    mentions_itself Vertex
    v = [Vertex] -> SCC Vertex
    forall vertex. [vertex] -> SCC vertex
    CyclicSCC [Vertex
    v]
                           | Bool
    otherwise         = Vertex -> SCC Vertex
    forall vertex. vertex -> SCC vertex
    AcyclicSCC Vertex
    v
        decode Tree Vertex
    other = [Vertex] -> SCC Vertex
    forall vertex. [vertex] -> SCC vertex
    CyclicSCC (Tree Vertex -> [Vertex] -> [Vertex]
    forall {a}. Tree a -> [a] -> [a]
    dec Tree Vertex
    other [])
          where dec :: Tree a -> [a] -> [a]
    dec (Node a
    v [Tree a]
    ts) [a]
    vs = a
    v a -> [a] -> [a]
    forall a. a -> [a] -> [a]
    : (Tree a -> [a] -> [a]) -> [a] -> [Tree a] -> [a]
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr Tree a -> [a] -> [a]
    dec [a]
    vs [Tree a]
    ts
        mentions_itself :: Vertex -> Bool
    mentions_itself Vertex
    v = Vertex
    v Vertex -> [Vertex] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` (IntGraph
    graph IntGraph -> Vertex -> [Vertex]
    forall i e. Ix i => Array i e -> i -> e
    ! Vertex
    v)

    reachableGraphCyclic :: IntGraph -> IM.IntMap IS.IntSet
    reachableGraphCyclic :: IntGraph -> IntMap IntSet
    reachableGraphCyclic IntGraph
    g = (IntMap IntSet -> SCC Vertex -> IntMap IntSet)
    -> IntMap IntSet -> [SCC Vertex] -> IntMap IntSet
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl' IntMap IntSet -> SCC Vertex -> IntMap IntSet
    add_one_comp IntMap IntSet
    forall a. Monoid a => a
    mempty [SCC Vertex]
    comps
      where
        neighboursOf :: Vertex -> [Vertex]
    neighboursOf Vertex
    v = IntGraph
    gIntGraph -> Vertex -> [Vertex]
    forall i e. Ix i => Array i e -> i -> e
    !Vertex
    v

        comps :: [SCC Vertex]
    comps = IntGraph -> [SCC Vertex]
    scc IntGraph
    g

        -- To avoid divergence on cyclic input, we build the result
        -- strongly connected component by component, in topological
        -- order. For each SCC, we know that:
        --
        --   * All vertices in the component can reach all other vertices
        --     in the component ("local" reachables)
        --
        --   * Other reachable vertices ("remote" reachables) must come
        --     from earlier components, either via direct neighbourhood, or
        --     transitively from earlier reachability map
        --
        -- This allows us to build the extension of the reachability map
        -- directly, without any self-reference, thereby avoiding a loop.
        add_one_comp :: IM.IntMap IS.IntSet -> SCC Vertex -> IM.IntMap IS.IntSet
        add_one_comp :: IntMap IntSet -> SCC Vertex -> IntMap IntSet
    add_one_comp IntMap IntSet
    earlier (AcyclicSCC Vertex
    v) = Vertex -> IntSet -> IntMap IntSet -> IntMap IntSet
    forall a. Vertex -> a -> IntMap a -> IntMap a
    IM.insert Vertex
    v IntSet
    all_remotes IntMap IntSet
    earlier
          where
            earlier_neighbours :: [Vertex]
    earlier_neighbours = Vertex -> [Vertex]
    neighboursOf Vertex
    v
            earlier_further :: [IntSet]
    earlier_further = (Vertex -> Maybe IntSet) -> [Vertex] -> [IntSet]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe ((Vertex -> IntMap IntSet -> Maybe IntSet)
    -> IntMap IntSet -> Vertex -> Maybe IntSet
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip Vertex -> IntMap IntSet -> Maybe IntSet
    forall a. Vertex -> IntMap a -> Maybe a
    IM.lookup IntMap IntSet
    earlier) [Vertex]
    earlier_neighbours
            all_remotes :: IntSet
    all_remotes = [IntSet] -> IntSet
    forall (f :: * -> *). Foldable f => f IntSet -> IntSet
    IS.unions ([Vertex] -> IntSet
    IS.fromList [Vertex]
    earlier_neighbours IntSet -> [IntSet] -> [IntSet]
    forall a. a -> [a] -> [a]
    : [IntSet]
    earlier_further)
        add_one_comp IntMap IntSet
    earlier (CyclicSCC [Vertex]
    vs) = IntMap IntSet -> IntMap IntSet -> IntMap IntSet
    forall a. IntMap a -> IntMap a -> IntMap a
    IM.union ([(Vertex, IntSet)] -> IntMap IntSet
    forall a. [(Vertex, a)] -> IntMap a
    IM.fromList [(Vertex
    v, Vertex -> IntSet
    local Vertex
    v IntSet -> IntSet -> IntSet
    `IS.union` IntSet
    all_remotes) | Vertex
    v <- [Vertex]
    vs]) IntMap IntSet
    earlier
          where
            all_locals :: IntSet
    all_locals = [Vertex] -> IntSet
    IS.fromList [Vertex]
    vs
            local :: Vertex -> IntSet
    local Vertex
    v = Vertex -> IntSet -> IntSet
    IS.delete Vertex
    v IntSet
    all_locals
                -- Arguably, for a cyclic SCC we should include each
                -- vertex in its own reachable set. However, this could
                -- lead to a lot of extra pain in client code to avoid
                -- looping when traversing the reachability map.
            all_neighbours :: IntSet
    all_neighbours = [Vertex] -> IntSet
    IS.fromList ((Vertex -> [Vertex]) -> [Vertex] -> [Vertex]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap Vertex -> [Vertex]
    neighboursOf [Vertex]
    vs)
            earlier_neighbours :: IntSet
    earlier_neighbours = IntSet
    all_neighbours IntSet -> IntSet -> IntSet
    IS.\\ IntSet
    all_locals
            earlier_further :: [IntSet]
    earlier_further = (Vertex -> Maybe IntSet) -> [Vertex] -> [IntSet]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe ((Vertex -> IntMap IntSet -> Maybe IntSet)
    -> IntMap IntSet -> Vertex -> Maybe IntSet
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip Vertex -> IntMap IntSet -> Maybe IntSet
    forall a. Vertex -> IntMap a -> Maybe a
    IM.lookup IntMap IntSet
    earlier) (IntSet -> [Vertex]
    IS.toList IntSet
    earlier_neighbours)
            all_remotes :: IntSet
    all_remotes = [IntSet] -> IntSet
    forall (f :: * -> *). Foldable f => f IntSet -> IntSet
    IS.unions (IntSet
    earlier_neighbours IntSet -> [IntSet] -> [IntSet]
    forall a. a -> [a] -> [a]
    : [IntSet]
    earlier_further)

    {-
    ************************************************************************
    *                                                                      *
    *                         Classify Edge Types
    *                                                                      *
    ************************************************************************
    -}

    -- Remark: While we could generalize this algorithm this comes at a runtime
    -- cost and with no advantages. If you find yourself using this with graphs
    -- not easily represented using Int nodes please consider rewriting this
    -- using the more general Graph type.

    -- | Edge direction based on DFS Classification
    data EdgeType
      = Forward
      | Cross
      | Backward -- ^ Loop back towards the root node.
                 -- Eg backjumps in loops
      | SelfLoop -- ^ v -> v
       deriving (EdgeType -> EdgeType -> Bool
    (EdgeType -> EdgeType -> Bool)
    -> (EdgeType -> EdgeType -> Bool) -> Eq EdgeType
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: EdgeType -> EdgeType -> Bool
    == :: EdgeType -> EdgeType -> Bool
    $c/= :: EdgeType -> EdgeType -> Bool
    /= :: EdgeType -> EdgeType -> Bool
    Eq,Eq EdgeType
    Eq EdgeType =>
    (EdgeType -> EdgeType -> Ordering)
    -> (EdgeType -> EdgeType -> Bool)
    -> (EdgeType -> EdgeType -> Bool)
    -> (EdgeType -> EdgeType -> Bool)
    -> (EdgeType -> EdgeType -> Bool)
    -> (EdgeType -> EdgeType -> EdgeType)
    -> (EdgeType -> EdgeType -> EdgeType)
    -> Ord EdgeType
    EdgeType -> EdgeType -> Bool
    EdgeType -> EdgeType -> Ordering
    EdgeType -> EdgeType -> EdgeType
    forall a.
    Eq a =>
    (a -> a -> Ordering)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> a)
    -> (a -> a -> a)
    -> Ord a
    $ccompare :: EdgeType -> EdgeType -> Ordering
    compare :: EdgeType -> EdgeType -> Ordering
    $c< :: EdgeType -> EdgeType -> Bool
    < :: EdgeType -> EdgeType -> Bool
    $c<= :: EdgeType -> EdgeType -> Bool
    <= :: EdgeType -> EdgeType -> Bool
    $c> :: EdgeType -> EdgeType -> Bool
    > :: EdgeType -> EdgeType -> Bool
    $c>= :: EdgeType -> EdgeType -> Bool
    >= :: EdgeType -> EdgeType -> Bool
    $cmax :: EdgeType -> EdgeType -> EdgeType
    max :: EdgeType -> EdgeType -> EdgeType
    $cmin :: EdgeType -> EdgeType -> EdgeType
    min :: EdgeType -> EdgeType -> EdgeType
    Ord)

    instance Outputable EdgeType where
      ppr :: EdgeType -> SDoc
    ppr EdgeType
    Forward = [Char] -> SDoc
    forall doc. IsLine doc => [Char] -> doc
    text [Char]
    "Forward"
      ppr EdgeType
    Cross = [Char] -> SDoc
    forall doc. IsLine doc => [Char] -> doc
    text [Char]
    "Cross"
      ppr EdgeType
    Backward = [Char] -> SDoc
    forall doc. IsLine doc => [Char] -> doc
    text [Char]
    "Backward"
      ppr EdgeType
    SelfLoop = [Char] -> SDoc
    forall doc. IsLine doc => [Char] -> doc
    text [Char]
    "SelfLoop"

    newtype Time = Time Int deriving (Time -> Time -> Bool
    (Time -> Time -> Bool) -> (Time -> Time -> Bool) -> Eq Time
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: Time -> Time -> Bool
    == :: Time -> Time -> Bool
    $c/= :: Time -> Time -> Bool
    /= :: Time -> Time -> Bool
    Eq,Eq Time
    Eq Time =>
    (Time -> Time -> Ordering)
    -> (Time -> Time -> Bool)
    -> (Time -> Time -> Bool)
    -> (Time -> Time -> Bool)
    -> (Time -> Time -> Bool)
    -> (Time -> Time -> Time)
    -> (Time -> Time -> Time)
    -> Ord Time
    Time -> Time -> Bool
    Time -> Time -> Ordering
    Time -> Time -> Time
    forall a.
    Eq a =>
    (a -> a -> Ordering)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> a)
    -> (a -> a -> a)
    -> Ord a
    $ccompare :: Time -> Time -> Ordering
    compare :: Time -> Time -> Ordering
    $c< :: Time -> Time -> Bool
    < :: Time -> Time -> Bool
    $c<= :: Time -> Time -> Bool
    <= :: Time -> Time -> Bool
    $c> :: Time -> Time -> Bool
    > :: Time -> Time -> Bool
    $c>= :: Time -> Time -> Bool
    >= :: Time -> Time -> Bool
    $cmax :: Time -> Time -> Time
    max :: Time -> Time -> Time
    $cmin :: Time -> Time -> Time
    min :: Time -> Time -> Time
    Ord,Integer -> Time
    Time -> Time
    Time -> Time -> Time
    (Time -> Time -> Time)
    -> (Time -> Time -> Time)
    -> (Time -> Time -> Time)
    -> (Time -> Time)
    -> (Time -> Time)
    -> (Time -> Time)
    -> (Integer -> Time)
    -> Num Time
    forall a.
    (a -> a -> a)
    -> (a -> a -> a)
    -> (a -> a -> a)
    -> (a -> a)
    -> (a -> a)
    -> (a -> a)
    -> (Integer -> a)
    -> Num a
    $c+ :: Time -> Time -> Time
    + :: Time -> Time -> Time
    $c- :: Time -> Time -> Time
    - :: Time -> Time -> Time
    $c* :: Time -> Time -> Time
    * :: Time -> Time -> Time
    $cnegate :: Time -> Time
    negate :: Time -> Time
    $cabs :: Time -> Time
    abs :: Time -> Time
    $csignum :: Time -> Time
    signum :: Time -> Time
    $cfromInteger :: Integer -> Time
    fromInteger :: Integer -> Time
    Num,Time -> SDoc
    (Time -> SDoc) -> Outputable Time
    forall a. (a -> SDoc) -> Outputable a
    $cppr :: Time -> SDoc
    ppr :: Time -> SDoc
    Outputable)

    --Allow for specialization
    {-# INLINEABLE classifyEdges #-}

    -- | Given a start vertex, a way to get successors from a node
    -- and a list of (directed) edges classify the types of edges.
    classifyEdges :: forall key. Uniquable key => key -> (key -> [key])
                  -> [(key,key)] -> [((key, key), EdgeType)]
    classifyEdges :: forall key.
    Uniquable key =>
    key -> (key -> [key]) -> [(key, key)] -> [((key, key), EdgeType)]
    classifyEdges key
    root key -> [key]
    getSucc [(key, key)]
    edges =
        --let uqe (from,to) = (getUnique from, getUnique to)
        --in pprTrace "Edges:" (ppr $ map uqe edges) $
        [(key, key)] -> [EdgeType] -> [((key, key), EdgeType)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [(key, key)]
    edges ([EdgeType] -> [((key, key), EdgeType)])
    -> [EdgeType] -> [((key, key), EdgeType)]
    forall a b. (a -> b) -> a -> b
    $ ((key, key) -> EdgeType) -> [(key, key)] -> [EdgeType]
    forall a b. (a -> b) -> [a] -> [b]
    map (key, key) -> EdgeType
    classify [(key, key)]
    edges
      where
        (Time
    _time, UniqFM key Time
    starts, UniqFM key Time
    ends) = (Time, UniqFM key Time, UniqFM key Time)
    -> key -> (Time, UniqFM key Time, UniqFM key Time)
    addTimes (Time
    0,UniqFM key Time
    forall {k} (key :: k) elt. UniqFM key elt
    emptyUFM,UniqFM key Time
    forall {k} (key :: k) elt. UniqFM key elt
    emptyUFM) key
    root
        classify :: (key,key) -> EdgeType
        classify :: (key, key) -> EdgeType
    classify (key
    from,key
    to)
          | Time
    startFrom Time -> Time -> Bool
    forall a. Ord a => a -> a -> Bool
    < Time
    startTo
          , Time
    endFrom   Time -> Time -> Bool
    forall a. Ord a => a -> a -> Bool
    > Time
    endTo
          = EdgeType
    Forward
          | Time
    startFrom Time -> Time -> Bool
    forall a. Ord a => a -> a -> Bool
    > Time
    startTo
          , Time
    endFrom   Time -> Time -> Bool
    forall a. Ord a => a -> a -> Bool
    < Time
    endTo
          = EdgeType
    Backward
          | Time
    startFrom Time -> Time -> Bool
    forall a. Ord a => a -> a -> Bool
    > Time
    startTo
          , Time
    endFrom   Time -> Time -> Bool
    forall a. Ord a => a -> a -> Bool
    > Time
    endTo
          = EdgeType
    Cross
          | key -> Unique
    forall a. Uniquable a => a -> Unique
    getUnique key
    from Unique -> Unique -> Bool
    forall a. Eq a => a -> a -> Bool
    == key -> Unique
    forall a. Uniquable a => a -> Unique
    getUnique key
    to
          = EdgeType
    SelfLoop
          | Bool
    otherwise
          = [Char] -> SDoc -> EdgeType
    forall a. HasCallStack => [Char] -> SDoc -> a
    pprPanic [Char]
    "Failed to classify edge of Graph"
                     ((Unique, Unique) -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (key -> Unique
    forall a. Uniquable a => a -> Unique
    getUnique key
    from, key -> Unique
    forall a. Uniquable a => a -> Unique
    getUnique key
    to))

          where
            getTime :: UniqFM key Time -> key -> Time
    getTime UniqFM key Time
    event key
    node
              | Just Time
    time <- UniqFM key Time -> key -> Maybe Time
    forall key elt. Uniquable key => UniqFM key elt -> key -> Maybe elt
    lookupUFM UniqFM key Time
    event key
    node
              = Time
    time
              | Bool
    otherwise
              = [Char] -> SDoc -> Time
    forall a. HasCallStack => [Char] -> SDoc -> a
    pprPanic [Char]
    "Failed to classify edge of CFG - not not timed"
                ([Char] -> SDoc
    forall doc. IsLine doc => [Char] -> doc
    text [Char]
    "edges" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> (Unique, Unique) -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (key -> Unique
    forall a. Uniquable a => a -> Unique
    getUnique key
    from, key -> Unique
    forall a. Uniquable a => a -> Unique
    getUnique key
    to)
                              SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> UniqFM key Time -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr UniqFM key Time
    starts SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> UniqFM key Time -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr UniqFM key Time
    ends )
            startFrom :: Time
    startFrom = UniqFM key Time -> key -> Time
    getTime UniqFM key Time
    starts key
    from
            startTo :: Time
    startTo   = UniqFM key Time -> key -> Time
    getTime UniqFM key Time
    starts key
    to
            endFrom :: Time
    endFrom   = UniqFM key Time -> key -> Time
    getTime UniqFM key Time
    ends   key
    from
            endTo :: Time
    endTo     = UniqFM key Time -> key -> Time
    getTime UniqFM key Time
    ends   key
    to

        addTimes :: (Time, UniqFM key Time, UniqFM key Time) -> key
                 -> (Time, UniqFM key Time, UniqFM key Time)
        addTimes :: (Time, UniqFM key Time, UniqFM key Time)
    -> key -> (Time, UniqFM key Time, UniqFM key Time)
    addTimes (Time
    time,UniqFM key Time
    starts,UniqFM key Time
    ends) key
    n
          --Dont reenter nodes
          | key -> UniqFM key Time -> Bool
    forall key elt. Uniquable key => key -> UniqFM key elt -> Bool
    elemUFM key
    n UniqFM key Time
    starts
          = (Time
    time,UniqFM key Time
    starts,UniqFM key Time
    ends)
          | Bool
    otherwise =
            let
              starts' :: UniqFM key Time
    starts' = UniqFM key Time -> key -> Time -> UniqFM key Time
    forall key elt.
    Uniquable key =>
    UniqFM key elt -> key -> elt -> UniqFM key elt
    addToUFM UniqFM key Time
    starts key
    n Time
    time
              time' :: Time
    time' = Time
    time Time -> Time -> Time
    forall a. Num a => a -> a -> a
    + Time
    1
              succs :: [key]
    succs = key -> [key]
    getSucc key
    n :: [key]
              (Time
    time'',UniqFM key Time
    starts'',UniqFM key Time
    ends') = ((Time, UniqFM key Time, UniqFM key Time)
     -> key -> (Time, UniqFM key Time, UniqFM key Time))
    -> (Time, UniqFM key Time, UniqFM key Time)
    -> [key]
    -> (Time, UniqFM key Time, UniqFM key Time)
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl' (Time, UniqFM key Time, UniqFM key Time)
    -> key -> (Time, UniqFM key Time, UniqFM key Time)
    addTimes (Time
    time',UniqFM key Time
    starts',UniqFM key Time
    ends) [key]
    succs
              ends'' :: UniqFM key Time
    ends'' = UniqFM key Time -> key -> Time -> UniqFM key Time
    forall key elt.
    Uniquable key =>
    UniqFM key elt -> key -> elt -> UniqFM key elt
    addToUFM UniqFM key Time
    ends' key
    n Time
    time''
            in
            (Time
    time'' Time -> Time -> Time
    forall a. Num a => a -> a -> a
    + Time
    1, UniqFM key Time
    starts'', UniqFM key Time
    ends'')

    graphFromVerticesAndAdjacency
            :: Ord key
            => [Node key payload]
            -> [(key, key)]  -- First component is source vertex key,
                             -- second is target vertex key (thing depended on)
                             -- Unlike the other interface I insist they correspond to
                             -- actual vertices because the alternative hides bugs. I can't
                             -- do the same thing for the other one for backcompat reasons.
            -> Graph (Node key payload)
    graphFromVerticesAndAdjacency :: forall key payload.
    Ord key =>
    [Node key payload] -> [(key, key)] -> Graph (Node key payload)
    graphFromVerticesAndAdjacency []       [(key, key)]
    _     = Graph (Node key payload)
    forall a. Graph a
    emptyGraph
    graphFromVerticesAndAdjacency [Node key payload]
    vertices [(key, key)]
    edges = IntGraph
    -> (Vertex -> Node key payload)
    -> (Node key payload -> Maybe Vertex)
    -> Graph (Node key payload)
    forall node.
    IntGraph
    -> (Vertex -> node) -> (node -> Maybe Vertex) -> Graph node
    Graph IntGraph
    graph Vertex -> Node key payload
    vertex_node (key -> Maybe Vertex
    key_vertex (key -> Maybe Vertex)
    -> (Node key payload -> key) -> Node key payload -> Maybe Vertex
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Node key payload -> key
    forall key payload. Node key payload -> key
    key_extractor)
      where key_extractor :: Node key payload -> key
    key_extractor = Node key payload -> key
    forall key payload. Node key payload -> key
    node_key
            ((Vertex, Vertex)
    bounds, Vertex -> Node key payload
    vertex_node, key -> Maybe Vertex
    key_vertex, [(Vertex, Node key payload)]
    _) = ReduceFn key payload
    forall key payload. Ord key => ReduceFn key payload
    reduceNodesIntoVerticesOrd [Node key payload]
    vertices Node key payload -> key
    forall key payload. Node key payload -> key
    key_extractor
            key_vertex_pair :: (key, key) -> (Vertex, Vertex)
    key_vertex_pair (key
    a, key
    b) = ([Char] -> Maybe Vertex -> Vertex
    forall a. HasDebugCallStack => [Char] -> Maybe a -> a
    expectJust [Char]
    "graphFromVerticesAndAdjacency" (Maybe Vertex -> Vertex) -> Maybe Vertex -> Vertex
    forall a b. (a -> b) -> a -> b
    $ key -> Maybe Vertex
    key_vertex key
    a,
                                      [Char] -> Maybe Vertex -> Vertex
    forall a. HasDebugCallStack => [Char] -> Maybe a -> a
    expectJust [Char]
    "graphFromVerticesAndAdjacency" (Maybe Vertex -> Vertex) -> Maybe Vertex -> Vertex
    forall a b. (a -> b) -> a -> b
    $ key -> Maybe Vertex
    key_vertex key
    b)
            reduced_edges :: [(Vertex, Vertex)]
    reduced_edges = ((key, key) -> (Vertex, Vertex))
    -> [(key, key)] -> [(Vertex, Vertex)]
    forall a b. (a -> b) -> [a] -> [b]
    map (key, key) -> (Vertex, Vertex)
    key_vertex_pair [(key, key)]
    edges
            graph :: IntGraph
    graph = (Vertex, Vertex) -> [(Vertex, Vertex)] -> IntGraph
    G.buildG (Vertex, Vertex)
    bounds [(Vertex, Vertex)]
    reduced_edges