    {-# LANGUAGE BangPatterns #-}
    {-# LANGUAGE FlexibleContexts #-}
    {-# LANGUAGE RankNTypes #-}
    {-# LANGUAGE Strict #-}

    {- |
      Module      :  GHC.CmmToAsm.CFG.Dominators
      Copyright   :  (c) Matt Morrow 2009
      License     :  BSD3
      Maintainer  :  <klebinger.andreas@gmx.at>
      Stability   :  stable
      Portability :  portable

      The Lengauer-Tarjan graph dominators algorithm.

        \[1\] Lengauer, Tarjan,
          /A Fast Algorithm for Finding Dominators in a Flowgraph/, 1979.

        \[2\] Muchnick,
          /Advanced Compiler Design and Implementation/, 1997.

        \[3\] Brisk, Sarrafzadeh,
          /Interference Graphs for Procedures in Static Single/
          /Information Form are Interval Graphs/, 2007.

     * Strictness

     Unless stated otherwise all exposed functions might fully evaluate their input
     but are not guaranteed to do so.

    -}

    module GHC.CmmToAsm.CFG.Dominators (
       Node,Path,Edge
      ,Graph,Rooted
      ,idom,ipdom
      ,domTree,pdomTree
      ,dom,pdom
      ,pddfs,rpddfs
      ,fromAdj,fromEdges
      ,toAdj,toEdges
      ,asTree,asGraph
      ,parents,ancestors
    ) where

    import GHC.Prelude
    import Data.Bifunctor
    import Data.Tuple (swap)

    import Data.Tree
    import Data.IntMap(IntMap)
    import Data.IntSet(IntSet)
    import qualified Data.IntMap.Strict as IM
    import qualified Data.IntSet as IS

    import Control.Monad
    import Control.Monad.ST.Strict

    import Data.Array.ST
    import Data.Array.Base
      (unsafeNewArray_
      ,unsafeWrite,unsafeRead)

    -----------------------------------------------------------------------------

    type Node       = Int
    type Path       = [Node]
    type Edge       = (Node,Node)
    type Graph      = IntMap IntSet
    type Rooted     = (Node, Graph)

    -----------------------------------------------------------------------------

    -- | /Dominators/.
    -- Complexity as for @idom@
    dom :: Rooted -> [(Node, Path)]
    dom :: Rooted -> [(Int, Path)]
    dom = Tree Int -> [(Int, Path)]
    forall a. Tree a -> [(a, [a])]
    ancestors (Tree Int -> [(Int, Path)])
    -> (Rooted -> Tree Int) -> Rooted -> [(Int, Path)]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Rooted -> Tree Int
    domTree

    -- | /Post-dominators/.
    -- Complexity as for @idom@.
    pdom :: Rooted -> [(Node, Path)]
    pdom :: Rooted -> [(Int, Path)]
    pdom = Tree Int -> [(Int, Path)]
    forall a. Tree a -> [(a, [a])]
    ancestors (Tree Int -> [(Int, Path)])
    -> (Rooted -> Tree Int) -> Rooted -> [(Int, Path)]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Rooted -> Tree Int
    pdomTree

    -- | /Dominator tree/.
    -- Complexity as for @idom@.
    domTree :: Rooted -> Tree Node
    domTree :: Rooted -> Tree Int
    domTree a :: Rooted
    a@(Int
    r,Graph
    _) =
      let is :: [(Int, Int)]
    is = ((Int, Int) -> Bool) -> [(Int, Int)] -> [(Int, Int)]
    forall a. (a -> Bool) -> [a] -> [a]
    filter ((Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    /=Int
    r)(Int -> Bool) -> ((Int, Int) -> Int) -> (Int, Int) -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .(Int, Int) -> Int
    forall a b. (a, b) -> a
    fst) (Rooted -> [(Int, Int)]
    idom Rooted
    a)
          tg :: Graph
    tg = [(Int, Int)] -> Graph
    fromEdges (((Int, Int) -> (Int, Int)) -> [(Int, Int)] -> [(Int, Int)]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (Int, Int) -> (Int, Int)
    forall a b. (a, b) -> (b, a)
    swap [(Int, Int)]
    is)
      in Rooted -> Tree Int
    asTree (Int
    r,Graph
    tg)

    -- | /Post-dominator tree/.
    -- Complexity as for @idom@.
    pdomTree :: Rooted -> Tree Node
    pdomTree :: Rooted -> Tree Int
    pdomTree a :: Rooted
    a@(Int
    r,Graph
    _) =
      let is :: [(Int, Int)]
    is = ((Int, Int) -> Bool) -> [(Int, Int)] -> [(Int, Int)]
    forall a. (a -> Bool) -> [a] -> [a]
    filter ((Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    /=Int
    r)(Int -> Bool) -> ((Int, Int) -> Int) -> (Int, Int) -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .(Int, Int) -> Int
    forall a b. (a, b) -> a
    fst) (Rooted -> [(Int, Int)]
    ipdom Rooted
    a)
          tg :: Graph
    tg = [(Int, Int)] -> Graph
    fromEdges (((Int, Int) -> (Int, Int)) -> [(Int, Int)] -> [(Int, Int)]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (Int, Int) -> (Int, Int)
    forall a b. (a, b) -> (b, a)
    swap [(Int, Int)]
    is)
      in Rooted -> Tree Int
    asTree (Int
    r,Graph
    tg)

    -- | /Immediate dominators/.
    -- /O(|E|*alpha(|E|,|V|))/, where /alpha(m,n)/ is
    -- \"a functional inverse of Ackermann's function\".
    --
    -- This Complexity bound assumes /O(1)/ indexing. Since we're
    -- using @IntMap@, it has an additional /lg |V|/ factor
    -- somewhere in there. I'm not sure where.
    idom :: Rooted -> [(Node,Node)]
    idom :: Rooted -> [(Int, Int)]
    idom Rooted
    rg = (forall s. ST s [(Int, Int)]) -> [(Int, Int)]
    forall a. (forall s. ST s a) -> a
    runST (S s (Env s) [(Int, Int)] -> Env s -> ST s [(Int, Int)]
    forall z s a. S z s a -> s -> ST z a
    evalS S s (Env s) [(Int, Int)]
    forall s. Dom s [(Int, Int)]
    idomM (Env s -> ST s [(Int, Int)]) -> ST s (Env s) -> ST s [(Int, Int)]
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< Rooted -> ST s (Env s)
    forall s. Rooted -> ST s (Env s)
    initEnv (Rooted -> Rooted
    pruneReach Rooted
    rg))

    -- | /Immediate post-dominators/.
    -- Complexity as for @idom@.
    ipdom :: Rooted -> [(Node,Node)]
    ipdom :: Rooted -> [(Int, Int)]
    ipdom Rooted
    rg = (forall s. ST s [(Int, Int)]) -> [(Int, Int)]
    forall a. (forall s. ST s a) -> a
    runST (S s (Env s) [(Int, Int)] -> Env s -> ST s [(Int, Int)]
    forall z s a. S z s a -> s -> ST z a
    evalS S s (Env s) [(Int, Int)]
    forall s. Dom s [(Int, Int)]
    idomM (Env s -> ST s [(Int, Int)]) -> ST s (Env s) -> ST s [(Int, Int)]
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< Rooted -> ST s (Env s)
    forall s. Rooted -> ST s (Env s)
    initEnv (Rooted -> Rooted
    pruneReach ((Graph -> Graph) -> Rooted -> Rooted
    forall (p :: * -> * -> *) b c a.
    Bifunctor p =>
    (b -> c) -> p a b -> p a c
    second Graph -> Graph
    predG Rooted
    rg)))

    -----------------------------------------------------------------------------

    -- | /Post-dominated depth-first search/.
    pddfs :: Rooted -> [Node]
    pddfs :: Rooted -> Path
    pddfs = Path -> Path
    forall a. [a] -> [a]
    reverse (Path -> Path) -> (Rooted -> Path) -> Rooted -> Path
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Rooted -> Path
    rpddfs

    -- | /Reverse post-dominated depth-first search/.
    rpddfs :: Rooted -> [Node]
    rpddfs :: Rooted -> Path
    rpddfs = [Path] -> Path
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat ([Path] -> Path) -> (Rooted -> [Path]) -> Rooted -> Path
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Tree Int -> [Path]
    forall a. Tree a -> [[a]]
    levels (Tree Int -> [Path]) -> (Rooted -> Tree Int) -> Rooted -> [Path]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Rooted -> Tree Int
    pdomTree

    -----------------------------------------------------------------------------

    type Dom s a = S s (Env s) a
    type NodeSet    = IntSet
    type NodeMap a  = IntMap a
    data Env s = Env
      {forall s. Env s -> Graph
    succE      :: !Graph
      ,forall s. Env s -> Graph
    predE      :: !Graph
      ,forall s. Env s -> Graph
    bucketE    :: !Graph
      ,forall s. Env s -> Int
    dfsE       :: {-# UNPACK #-}!Int
      ,forall s. Env s -> Int
    zeroE      :: {-# UNPACK #-}!Node
      ,forall s. Env s -> Int
    rootE      :: {-# UNPACK #-}!Node
      ,forall s. Env s -> Arr s Int
    labelE     :: {-# UNPACK #-}!(Arr s Node)
      ,forall s. Env s -> Arr s Int
    parentE    :: {-# UNPACK #-}!(Arr s Node)
      ,forall s. Env s -> Arr s Int
    ancestorE  :: {-# UNPACK #-}!(Arr s Node)
      ,forall s. Env s -> Arr s Int
    childE     :: {-# UNPACK #-}!(Arr s Node)
      ,forall s. Env s -> Arr s Int
    ndfsE      :: {-# UNPACK #-}!(Arr s Node)
      ,forall s. Env s -> Arr s Int
    dfnE       :: {-# UNPACK #-}!(Arr s Int)
      ,forall s. Env s -> Arr s Int
    sdnoE      :: {-# UNPACK #-}!(Arr s Int)
      ,forall s. Env s -> Arr s Int
    sizeE      :: {-# UNPACK #-}!(Arr s Int)
      ,forall s. Env s -> Arr s Int
    domE       :: {-# UNPACK #-}!(Arr s Node)
      ,forall s. Env s -> Arr s Int
    rnE        :: {-# UNPACK #-}!(Arr s Node)}

    -----------------------------------------------------------------------------

    idomM :: Dom s [(Node,Node)]
    idomM :: forall s. Dom s [(Int, Int)]
    idomM = do
      Int -> Dom s ()
    forall s. Int -> Dom s ()
    dfsDom (Int -> Dom s ()) -> S s (Env s) Int -> Dom s ()
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< S s (Env s) Int
    forall s. Dom s Int
    rootM
      Int
    n <- (Env s -> Int) -> S s (Env s) Int
    forall s a z. (s -> a) -> S z s a
    gets Env s -> Int
    forall s. Env s -> Int
    dfsE
      Path -> (Int -> Dom s ()) -> Dom s ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    t a -> (a -> m b) -> m ()
    forM_ [Int
    n,Int
    nInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    1..Int
    1] (\Int
    i-> do
        Int
    w <- Int -> S s (Env s) Int
    forall s. Int -> Dom s Int
    ndfsM Int
    i
        Path
    ps <- Int -> Dom s Path
    forall s. Int -> Dom s Path
    predsM Int
    w
        Path -> (Int -> Dom s ()) -> Dom s ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    t a -> (a -> m b) -> m ()
    forM_ Path
    ps (\Int
    v-> do
          Int
    sw <- Int -> S s (Env s) Int
    forall s. Int -> Dom s Int
    sdnoM Int
    w
          Int
    u <- Int -> S s (Env s) Int
    forall s. Int -> Dom s Int
    eval Int
    v
          Int
    su <- Int -> S s (Env s) Int
    forall s. Int -> Dom s Int
    sdnoM Int
    u
          Bool -> Dom s () -> Dom s ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Int
    su Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    sw)
            ((Env s -> Arr s Int) -> Int -> Int -> Dom s ()
    forall z a s.
    MArray (A z) a (ST z) =>
    (s -> Arr z a) -> Int -> a -> S z s ()
    store Env s -> Arr s Int
    forall s. Env s -> Arr s Int
    sdnoE Int
    w Int
    su))
        Int
    z <- Int -> S s (Env s) Int
    forall s. Int -> Dom s Int
    ndfsM (Int -> S s (Env s) Int) -> S s (Env s) Int -> S s (Env s) Int
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< Int -> S s (Env s) Int
    forall s. Int -> Dom s Int
    sdnoM Int
    w
        (Env s -> Env s) -> Dom s ()
    forall s z. (s -> s) -> S z s ()
    modify(\Env s
    e->Env s
    e{bucketE :: Graph
    bucketE=(IntSet -> IntSet) -> Int -> Graph -> Graph
    forall a. (a -> a) -> Int -> IntMap a -> IntMap a
    IM.adjust
                          (Int
    wInt -> IntSet -> IntSet
    `IS.insert`)
                          Int
    z (Env s -> Graph
    forall s. Env s -> Graph
    bucketE Env s
    e)})
        Int
    pw <- Int -> S s (Env s) Int
    forall s. Int -> Dom s Int
    parentM Int
    w
        Int -> Int -> Dom s ()
    forall s. Int -> Int -> Dom s ()
    link Int
    pw Int
    w
        Path
    bps <- Int -> Dom s Path
    forall s. Int -> Dom s Path
    bucketM Int
    pw
        Path -> (Int -> Dom s ()) -> Dom s ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    t a -> (a -> m b) -> m ()
    forM_ Path
    bps (\Int
    v-> do
          Int
    u <- Int -> S s (Env s) Int
    forall s. Int -> Dom s Int
    eval Int
    v
          Int
    su <- Int -> S s (Env s) Int
    forall s. Int -> Dom s Int
    sdnoM Int
    u
          Int
    sv <- Int -> S s (Env s) Int
    forall s. Int -> Dom s Int
    sdnoM Int
    v
          let dv :: Int
    dv = case Int
    su Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    sv of
                    Bool
    True-> Int
    u
                    Bool
    False-> Int
    pw
          (Env s -> Arr s Int) -> Int -> Int -> Dom s ()
    forall z a s.
    MArray (A z) a (ST z) =>
    (s -> Arr z a) -> Int -> a -> S z s ()
    store Env s -> Arr s Int
    forall s. Env s -> Arr s Int
    domE Int
    v Int
    dv))
      Path -> (Int -> Dom s ()) -> Dom s ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    t a -> (a -> m b) -> m ()
    forM_ [Int
    1..Int
    n] (\Int
    i-> do
        Int
    w <- Int -> S s (Env s) Int
    forall s. Int -> Dom s Int
    ndfsM Int
    i
        Int
    j <- Int -> S s (Env s) Int
    forall s. Int -> Dom s Int
    sdnoM Int
    w
        Int
    z <- Int -> S s (Env s) Int
    forall s. Int -> Dom s Int
    ndfsM Int
    j
        Int
    dw <- Int -> S s (Env s) Int
    forall s. Int -> Dom s Int
    domM Int
    w
        Bool -> Dom s () -> Dom s ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Int
    dw Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Int
    z)
          (do Int
    ddw <- Int -> S s (Env s) Int
    forall s. Int -> Dom s Int
    domM Int
    dw
              (Env s -> Arr s Int) -> Int -> Int -> Dom s ()
    forall z a s.
    MArray (A z) a (ST z) =>
    (s -> Arr z a) -> Int -> a -> S z s ()
    store Env s -> Arr s Int
    forall s. Env s -> Arr s Int
    domE Int
    w Int
    ddw))
      Dom s [(Int, Int)]
    forall s. Dom s [(Int, Int)]
    fromEnv

    -----------------------------------------------------------------------------

    eval :: Node -> Dom s Node
    eval :: forall s. Int -> Dom s Int
    eval Int
    v = do
      Int
    n0 <- Dom s Int
    forall s. Dom s Int
    zeroM
      Int
    a  <- Int -> Dom s Int
    forall s. Int -> Dom s Int
    ancestorM Int
    v
      case Int
    aInt -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    ==Int
    n0 of
        Bool
    True-> Int -> Dom s Int
    forall s. Int -> Dom s Int
    labelM Int
    v
        Bool
    False-> do
          Int -> Dom s ()
    forall s. Int -> Dom s ()
    compress Int
    v
          Int
    a   <- Int -> Dom s Int
    forall s. Int -> Dom s Int
    ancestorM Int
    v
          Int
    l   <- Int -> Dom s Int
    forall s. Int -> Dom s Int
    labelM Int
    v
          Int
    la  <- Int -> Dom s Int
    forall s. Int -> Dom s Int
    labelM Int
    a
          Int
    sl  <- Int -> Dom s Int
    forall s. Int -> Dom s Int
    sdnoM Int
    l
          Int
    sla <- Int -> Dom s Int
    forall s. Int -> Dom s Int
    sdnoM Int
    la
          case Int
    sl Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    sla of
            Bool
    True-> Int -> Dom s Int
    forall (m :: * -> *) a. Monad m => a -> m a
    return Int
    l
            Bool
    False-> Int -> Dom s Int
    forall (m :: * -> *) a. Monad m => a -> m a
    return Int
    la

    compress :: Node -> Dom s ()
    compress :: forall s. Int -> Dom s ()
    compress Int
    v = do
      Int
    n0  <- Dom s Int
    forall s. Dom s Int
    zeroM
      Int
    a   <- Int -> Dom s Int
    forall s. Int -> Dom s Int
    ancestorM Int
    v
      Int
    aa  <- Int -> Dom s Int
    forall s. Int -> Dom s Int
    ancestorM Int
    a
      Bool -> Dom s () -> Dom s ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Int
    aa Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Int
    n0) (do
        Int -> Dom s ()
    forall s. Int -> Dom s ()
    compress Int
    a
        Int
    a   <- Int -> Dom s Int
    forall s. Int -> Dom s Int
    ancestorM Int
    v
        Int
    aa  <- Int -> Dom s Int
    forall s. Int -> Dom s Int
    ancestorM Int
    a
        Int
    l   <- Int -> Dom s Int
    forall s. Int -> Dom s Int
    labelM Int
    v
        Int
    la  <- Int -> Dom s Int
    forall s. Int -> Dom s Int
    labelM Int
    a
        Int
    sl  <- Int -> Dom s Int
    forall s. Int -> Dom s Int
    sdnoM Int
    l
        Int
    sla <- Int -> Dom s Int
    forall s. Int -> Dom s Int
    sdnoM Int
    la
        Bool -> Dom s () -> Dom s ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Int
    sla Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    sl)
          ((Env s -> Arr s Int) -> Int -> Int -> Dom s ()
    forall z a s.
    MArray (A z) a (ST z) =>
    (s -> Arr z a) -> Int -> a -> S z s ()
    store Env s -> Arr s Int
    forall s. Env s -> Arr s Int
    labelE Int
    v Int
    la)
        (Env s -> Arr s Int) -> Int -> Int -> Dom s ()
    forall z a s.
    MArray (A z) a (ST z) =>
    (s -> Arr z a) -> Int -> a -> S z s ()
    store Env s -> Arr s Int
    forall s. Env s -> Arr s Int
    ancestorE Int
    v Int
    aa)

    -----------------------------------------------------------------------------

    link :: Node -> Node -> Dom s ()
    link :: forall s. Int -> Int -> Dom s ()
    link Int
    v Int
    w = do
      Int
    n0  <- Dom s Int
    forall s. Dom s Int
    zeroM
      Int
    lw  <- Int -> Dom s Int
    forall s. Int -> Dom s Int
    labelM Int
    w
      Int
    slw <- Int -> Dom s Int
    forall s. Int -> Dom s Int
    sdnoM Int
    lw
      let balance :: Int -> Dom s Int
    balance Int
    s = do
            Int
    c   <- Int -> Dom s Int
    forall s. Int -> Dom s Int
    childM Int
    s
            Int
    lc  <- Int -> Dom s Int
    forall s. Int -> Dom s Int
    labelM Int
    c
            Int
    slc <- Int -> Dom s Int
    forall s. Int -> Dom s Int
    sdnoM Int
    lc
            case Int
    slw Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    slc of
              Bool
    False-> Int -> Dom s Int
    forall (m :: * -> *) a. Monad m => a -> m a
    return Int
    s
              Bool
    True-> do
                Int
    zs  <- Int -> Dom s Int
    forall s. Int -> Dom s Int
    sizeM Int
    s
                Int
    zc  <- Int -> Dom s Int
    forall s. Int -> Dom s Int
    sizeM Int
    c
                Int
    cc  <- Int -> Dom s Int
    forall s. Int -> Dom s Int
    childM Int
    c
                Int
    zcc <- Int -> Dom s Int
    forall s. Int -> Dom s Int
    sizeM Int
    cc
                case Int
    2Int -> Int -> Int
    forall a. Num a => a -> a -> a
    *Int
    zc Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    zsInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    zcc of
                  Bool
    True-> do
                    (Env s -> Arr s Int) -> Int -> Int -> Dom s ()
    forall z a s.
    MArray (A z) a (ST z) =>
    (s -> Arr z a) -> Int -> a -> S z s ()
    store Env s -> Arr s Int
    forall s. Env s -> Arr s Int
    ancestorE Int
    c Int
    s
                    (Env s -> Arr s Int) -> Int -> Int -> Dom s ()
    forall z a s.
    MArray (A z) a (ST z) =>
    (s -> Arr z a) -> Int -> a -> S z s ()
    store Env s -> Arr s Int
    forall s. Env s -> Arr s Int
    childE Int
    s Int
    cc
                    Int -> Dom s Int
    balance Int
    s
                  Bool
    False-> do
                    (Env s -> Arr s Int) -> Int -> Int -> Dom s ()
    forall z a s.
    MArray (A z) a (ST z) =>
    (s -> Arr z a) -> Int -> a -> S z s ()
    store Env s -> Arr s Int
    forall s. Env s -> Arr s Int
    sizeE Int
    c Int
    zs
                    (Env s -> Arr s Int) -> Int -> Int -> Dom s ()
    forall z a s.
    MArray (A z) a (ST z) =>
    (s -> Arr z a) -> Int -> a -> S z s ()
    store Env s -> Arr s Int
    forall s. Env s -> Arr s Int
    ancestorE Int
    s Int
    c
                    Int -> Dom s Int
    balance Int
    c
      Int
    s   <- Int -> Dom s Int
    balance Int
    w
      Int
    lw  <- Int -> Dom s Int
    forall s. Int -> Dom s Int
    labelM Int
    w
      Int
    zw  <- Int -> Dom s Int
    forall s. Int -> Dom s Int
    sizeM Int
    w
      (Env s -> Arr s Int) -> Int -> Int -> Dom s ()
    forall z a s.
    MArray (A z) a (ST z) =>
    (s -> Arr z a) -> Int -> a -> S z s ()
    store Env s -> Arr s Int
    forall s. Env s -> Arr s Int
    labelE Int
    s Int
    lw
      (Env s -> Arr s Int) -> Int -> Int -> Dom s ()
    forall z a s.
    MArray (A z) a (ST z) =>
    (s -> Arr z a) -> Int -> a -> S z s ()
    store Env s -> Arr s Int
    forall s. Env s -> Arr s Int
    sizeE Int
    v (Int -> Dom s ()) -> (Int -> Int) -> Int -> Dom s ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Int -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    zw) (Int -> Dom s ()) -> Dom s Int -> Dom s ()
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< Int -> Dom s Int
    forall s. Int -> Dom s Int
    sizeM Int
    v
      let follow :: Int -> Dom s ()
    follow Int
    s =
            Bool -> Dom s () -> Dom s ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Int
    s Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Int
    n0) (do
              (Env s -> Arr s Int) -> Int -> Int -> Dom s ()
    forall z a s.
    MArray (A z) a (ST z) =>
    (s -> Arr z a) -> Int -> a -> S z s ()
    store Env s -> Arr s Int
    forall s. Env s -> Arr s Int
    ancestorE Int
    s Int
    v
              Int -> Dom s ()
    follow (Int -> Dom s ()) -> Dom s Int -> Dom s ()
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< Int -> Dom s Int
    forall s. Int -> Dom s Int
    childM Int
    s)
      Int
    zv  <- Int -> Dom s Int
    forall s. Int -> Dom s Int
    sizeM Int
    v
      Int -> Dom s ()
    follow (Int -> Dom s ()) -> Dom s Int -> Dom s ()
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< case Int
    zv Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    2Int -> Int -> Int
    forall a. Num a => a -> a -> a
    *Int
    zw of
                  Bool
    False-> Int -> Dom s Int
    forall (m :: * -> *) a. Monad m => a -> m a
    return Int
    s
                  Bool
    True-> do
                    Int
    cv <- Int -> Dom s Int
    forall s. Int -> Dom s Int
    childM Int
    v
                    (Env s -> Arr s Int) -> Int -> Int -> Dom s ()
    forall z a s.
    MArray (A z) a (ST z) =>
    (s -> Arr z a) -> Int -> a -> S z s ()
    store Env s -> Arr s Int
    forall s. Env s -> Arr s Int
    childE Int
    v Int
    s
                    Int -> Dom s Int
    forall (m :: * -> *) a. Monad m => a -> m a
    return Int
    cv

    -----------------------------------------------------------------------------

    dfsDom :: Node -> Dom s ()
    dfsDom :: forall s. Int -> Dom s ()
    dfsDom Int
    i = do
      ()
    _   <- Int -> Dom s ()
    forall s. Int -> Dom s ()
    go Int
    i
      Int
    n0  <- Dom s Int
    forall s. Dom s Int
    zeroM
      Int
    r   <- Dom s Int
    forall s. Dom s Int
    rootM
      (Env s -> Arr s Int) -> Int -> Int -> Dom s ()
    forall z a s.
    MArray (A z) a (ST z) =>
    (s -> Arr z a) -> Int -> a -> S z s ()
    store Env s -> Arr s Int
    forall s. Env s -> Arr s Int
    parentE Int
    r Int
    n0
      where go :: Int -> S s (Env s) ()
    go Int
    i = do
              Int
    n <- Dom s Int
    forall s. Dom s Int
    nextM
              (Env s -> Arr s Int) -> Int -> Int -> S s (Env s) ()
    forall z a s.
    MArray (A z) a (ST z) =>
    (s -> Arr z a) -> Int -> a -> S z s ()
    store Env s -> Arr s Int
    forall s. Env s -> Arr s Int
    dfnE   Int
    i Int
    n
              (Env s -> Arr s Int) -> Int -> Int -> S s (Env s) ()
    forall z a s.
    MArray (A z) a (ST z) =>
    (s -> Arr z a) -> Int -> a -> S z s ()
    store Env s -> Arr s Int
    forall s. Env s -> Arr s Int
    sdnoE  Int
    i Int
    n
              (Env s -> Arr s Int) -> Int -> Int -> S s (Env s) ()
    forall z a s.
    MArray (A z) a (ST z) =>
    (s -> Arr z a) -> Int -> a -> S z s ()
    store Env s -> Arr s Int
    forall s. Env s -> Arr s Int
    ndfsE  Int
    n Int
    i
              (Env s -> Arr s Int) -> Int -> Int -> S s (Env s) ()
    forall z a s.
    MArray (A z) a (ST z) =>
    (s -> Arr z a) -> Int -> a -> S z s ()
    store Env s -> Arr s Int
    forall s. Env s -> Arr s Int
    labelE Int
    i Int
    i
              Path
    ss <- Int -> Dom s Path
    forall s. Int -> Dom s Path
    succsM Int
    i
              Path -> (Int -> S s (Env s) ()) -> S s (Env s) ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    t a -> (a -> m b) -> m ()
    forM_ Path
    ss (\Int
    j-> do
                Int
    s <- Int -> Dom s Int
    forall s. Int -> Dom s Int
    sdnoM Int
    j
                case Int
    sInt -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    ==Int
    0 of
                  Bool
    False-> () -> S s (Env s) ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return()
                  Bool
    True-> do
                    (Env s -> Arr s Int) -> Int -> Int -> S s (Env s) ()
    forall z a s.
    MArray (A z) a (ST z) =>
    (s -> Arr z a) -> Int -> a -> S z s ()
    store Env s -> Arr s Int
    forall s. Env s -> Arr s Int
    parentE Int
    j Int
    i
                    Int -> S s (Env s) ()
    go Int
    j)

    -----------------------------------------------------------------------------

    initEnv :: Rooted -> ST s (Env s)
    initEnv :: forall s. Rooted -> ST s (Env s)
    initEnv (Int
    r0,Graph
    g0) = do
      -- Graph renumbered to indices from 1 to |V|
      let (Graph
    g,NodeMap Int
    rnmap) = Int -> Graph -> (Graph, NodeMap Int)
    renum Int
    1 Graph
    g0
          pred :: Graph
    pred      = Graph -> Graph
    predG Graph
    g -- reverse graph
          root :: Int
    root      = NodeMap Int
    rnmap NodeMap Int -> Int -> Int
    forall a. IntMap a -> Int -> a
    IM.! Int
    r0 -- renamed root
          n :: Int
    n         = Graph -> Int
    forall a. IntMap a -> Int
    IM.size Graph
    g
          ns :: Path
    ns        = [Int
    0..Int
    n]
          m :: Int
    m         = Int
    nInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    1

      let bucket :: Graph
    bucket = [(Int, IntSet)] -> Graph
    forall a. [(Int, a)] -> IntMap a
    IM.fromList
            (Path -> [IntSet] -> [(Int, IntSet)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip Path
    ns (IntSet -> [IntSet]
    forall a. a -> [a]
    repeat IntSet
    forall a. Monoid a => a
    mempty))

      Arr s Int
    rna <- Int -> ST s (Arr s Int)
    forall s. Int -> ST s (Arr s Int)
    newI Int
    m
      Arr s Int -> [(Int, Int)] -> ST s ()
    forall s a.
    MArray (A s) a (ST s) =>
    Arr s a -> [(Int, a)] -> ST s ()
    writes Arr s Int
    rna (((Int, Int) -> (Int, Int)) -> [(Int, Int)] -> [(Int, Int)]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (Int, Int) -> (Int, Int)
    forall a b. (a, b) -> (b, a)
    swap
            (NodeMap Int -> [(Int, Int)]
    forall a. IntMap a -> [(Int, a)]
    IM.toList NodeMap Int
    rnmap))

      Arr s Int
    doms      <- Int -> ST s (Arr s Int)
    forall s. Int -> ST s (Arr s Int)
    newI Int
    m
      Arr s Int
    sdno      <- Int -> ST s (Arr s Int)
    forall s. Int -> ST s (Arr s Int)
    newI Int
    m
      Arr s Int
    size      <- Int -> ST s (Arr s Int)
    forall s. Int -> ST s (Arr s Int)
    newI Int
    m
      Arr s Int
    parent    <- Int -> ST s (Arr s Int)
    forall s. Int -> ST s (Arr s Int)
    newI Int
    m
      Arr s Int
    ancestor  <- Int -> ST s (Arr s Int)
    forall s. Int -> ST s (Arr s Int)
    newI Int
    m
      Arr s Int
    child     <- Int -> ST s (Arr s Int)
    forall s. Int -> ST s (Arr s Int)
    newI Int
    m
      Arr s Int
    label     <- Int -> ST s (Arr s Int)
    forall s. Int -> ST s (Arr s Int)
    newI Int
    m
      Arr s Int
    ndfs      <- Int -> ST s (Arr s Int)
    forall s. Int -> ST s (Arr s Int)
    newI Int
    m
      Arr s Int
    dfn       <- Int -> ST s (Arr s Int)
    forall s. Int -> ST s (Arr s Int)
    newI Int
    m

      -- Initialize all arrays
      Path -> (Int -> ST s ()) -> ST s ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    t a -> (a -> m b) -> m ()
    forM_ [Int
    0..Int
    n] (Arr s Int
    domsArr s Int -> Int -> Int -> ST s ()
    forall s a. MArray (A s) a (ST s) => Arr s a -> a -> Int -> ST s ()
    .=Int
    0)
      Path -> (Int -> ST s ()) -> ST s ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    t a -> (a -> m b) -> m ()
    forM_ [Int
    0..Int
    n] (Arr s Int
    sdnoArr s Int -> Int -> Int -> ST s ()
    forall s a. MArray (A s) a (ST s) => Arr s a -> a -> Int -> ST s ()
    .=Int
    0)
      Path -> (Int -> ST s ()) -> ST s ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    t a -> (a -> m b) -> m ()
    forM_ [Int
    1..Int
    n] (Arr s Int
    sizeArr s Int -> Int -> Int -> ST s ()
    forall s a. MArray (A s) a (ST s) => Arr s a -> a -> Int -> ST s ()
    .=Int
    1)
      Path -> (Int -> ST s ()) -> ST s ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    t a -> (a -> m b) -> m ()
    forM_ [Int
    0..Int
    n] (Arr s Int
    ancestorArr s Int -> Int -> Int -> ST s ()
    forall s a. MArray (A s) a (ST s) => Arr s a -> a -> Int -> ST s ()
    .=Int
    0)
      Path -> (Int -> ST s ()) -> ST s ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    t a -> (a -> m b) -> m ()
    forM_ [Int
    0..Int
    n] (Arr s Int
    childArr s Int -> Int -> Int -> ST s ()
    forall s a. MArray (A s) a (ST s) => Arr s a -> a -> Int -> ST s ()
    .=Int
    0)

      (Arr s Int
    domsArr s Int -> Int -> Int -> ST s ()
    forall s a. MArray (A s) a (ST s) => Arr s a -> a -> Int -> ST s ()
    .=Int
    root) Int
    root
      (Arr s Int
    sizeArr s Int -> Int -> Int -> ST s ()
    forall s a. MArray (A s) a (ST s) => Arr s a -> a -> Int -> ST s ()
    .=Int
    0) Int
    0
      (Arr s Int
    labelArr s Int -> Int -> Int -> ST s ()
    forall s a. MArray (A s) a (ST s) => Arr s a -> a -> Int -> ST s ()
    .=Int
    0) Int
    0

      Env s -> ST s (Env s)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Env
        {rnE :: Arr s Int
    rnE        = Arr s Int
    rna
        ,dfsE :: Int
    dfsE       = Int
    0
        ,zeroE :: Int
    zeroE      = Int
    0
        ,rootE :: Int
    rootE      = Int
    root
        ,labelE :: Arr s Int
    labelE     = Arr s Int
    label
        ,parentE :: Arr s Int
    parentE    = Arr s Int
    parent
        ,ancestorE :: Arr s Int
    ancestorE  = Arr s Int
    ancestor
        ,childE :: Arr s Int
    childE     = Arr s Int
    child
        ,ndfsE :: Arr s Int
    ndfsE      = Arr s Int
    ndfs
        ,dfnE :: Arr s Int
    dfnE       = Arr s Int
    dfn
        ,sdnoE :: Arr s Int
    sdnoE      = Arr s Int
    sdno
        ,sizeE :: Arr s Int
    sizeE      = Arr s Int
    size
        ,succE :: Graph
    succE      = Graph
    g
        ,predE :: Graph
    predE      = Graph
    pred
        ,bucketE :: Graph
    bucketE    = Graph
    bucket
        ,domE :: Arr s Int
    domE       = Arr s Int
    doms})

    fromEnv :: Dom s [(Node,Node)]
    fromEnv :: forall s. Dom s [(Int, Int)]
    fromEnv = do
      Arr s Int
    dom   <- (Env s -> Arr s Int) -> S s (Env s) (Arr s Int)
    forall s a z. (s -> a) -> S z s a
    gets Env s -> Arr s Int
    forall s. Env s -> Arr s Int
    domE
      Arr s Int
    rn    <- (Env s -> Arr s Int) -> S s (Env s) (Arr s Int)
    forall s a z. (s -> a) -> S z s a
    gets Env s -> Arr s Int
    forall s. Env s -> Arr s Int
    rnE
      -- r     <- gets rootE
      (Int
    _,Int
    n) <- ST s (Int, Int) -> S s (Env s) (Int, Int)
    forall z a s. ST z a -> S z s a
    st (Arr s Int -> ST s (Int, Int)
    forall (a :: * -> * -> *) e (m :: * -> *) i.
    (MArray a e m, Ix i) =>
    a i e -> m (i, i)
    getBounds Arr s Int
    dom)
      Path -> (Int -> S s (Env s) (Int, Int)) -> Dom s [(Int, Int)]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    t a -> (a -> m b) -> m (t b)
    forM [Int
    1..Int
    n] (\Int
    i-> do
        Int
    j <- ST s Int -> S s (Env s) Int
    forall z a s. ST z a -> S z s a
    st(Arr s Int
    rnArr s Int -> Int -> ST s Int
    forall s a. MArray (A s) a (ST s) => A s Int a -> Int -> ST s a
    !:Int
    i)
        Int
    d <- ST s Int -> S s (Env s) Int
    forall z a s. ST z a -> S z s a
    st(Arr s Int
    domArr s Int -> Int -> ST s Int
    forall s a. MArray (A s) a (ST s) => A s Int a -> Int -> ST s a
    !:Int
    i)
        Int
    k <- ST s Int -> S s (Env s) Int
    forall z a s. ST z a -> S z s a
    st(Arr s Int
    rnArr s Int -> Int -> ST s Int
    forall s a. MArray (A s) a (ST s) => A s Int a -> Int -> ST s a
    !:Int
    d)
        (Int, Int) -> S s (Env s) (Int, Int)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Int
    j,Int
    k))

    -----------------------------------------------------------------------------

    zeroM :: Dom s Node
    zeroM :: forall s. Dom s Int
    zeroM = (Env s -> Int) -> S s (Env s) Int
    forall s a z. (s -> a) -> S z s a
    gets Env s -> Int
    forall s. Env s -> Int
    zeroE
    domM :: Node -> Dom s Node
    domM :: forall s. Int -> Dom s Int
    domM = (Env s -> Arr s Int) -> Int -> S s (Env s) Int
    forall z a s.
    MArray (A z) a (ST z) =>
    (s -> Arr z a) -> Int -> S z s a
    fetch Env s -> Arr s Int
    forall s. Env s -> Arr s Int
    domE
    rootM :: Dom s Node
    rootM :: forall s. Dom s Int
    rootM = (Env s -> Int) -> S s (Env s) Int
    forall s a z. (s -> a) -> S z s a
    gets Env s -> Int
    forall s. Env s -> Int
    rootE
    succsM :: Node -> Dom s [Node]
    succsM :: forall s. Int -> Dom s Path
    succsM Int
    i = (Env s -> Path) -> S s (Env s) Path
    forall s a z. (s -> a) -> S z s a
    gets (IntSet -> Path
    IS.toList (IntSet -> Path) -> (Env s -> IntSet) -> Env s -> Path
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Graph -> Int -> IntSet
    forall a. Monoid a => IntMap a -> Int -> a
    ! Int
    i) (Graph -> IntSet) -> (Env s -> Graph) -> Env s -> IntSet
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Env s -> Graph
    forall s. Env s -> Graph
    succE)
    predsM :: Node -> Dom s [Node]
    predsM :: forall s. Int -> Dom s Path
    predsM Int
    i = (Env s -> Path) -> S s (Env s) Path
    forall s a z. (s -> a) -> S z s a
    gets (IntSet -> Path
    IS.toList (IntSet -> Path) -> (Env s -> IntSet) -> Env s -> Path
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Graph -> Int -> IntSet
    forall a. Monoid a => IntMap a -> Int -> a
    ! Int
    i) (Graph -> IntSet) -> (Env s -> Graph) -> Env s -> IntSet
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Env s -> Graph
    forall s. Env s -> Graph
    predE)
    bucketM :: Node -> Dom s [Node]
    bucketM :: forall s. Int -> Dom s Path
    bucketM Int
    i = (Env s -> Path) -> S s (Env s) Path
    forall s a z. (s -> a) -> S z s a
    gets (IntSet -> Path
    IS.toList (IntSet -> Path) -> (Env s -> IntSet) -> Env s -> Path
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Graph -> Int -> IntSet
    forall a. Monoid a => IntMap a -> Int -> a
    ! Int
    i) (Graph -> IntSet) -> (Env s -> Graph) -> Env s -> IntSet
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Env s -> Graph
    forall s. Env s -> Graph
    bucketE)
    sizeM :: Node -> Dom s Int
    sizeM :: forall s. Int -> Dom s Int
    sizeM = (Env s -> Arr s Int) -> Int -> S s (Env s) Int
    forall z a s.
    MArray (A z) a (ST z) =>
    (s -> Arr z a) -> Int -> S z s a
    fetch Env s -> Arr s Int
    forall s. Env s -> Arr s Int
    sizeE
    sdnoM :: Node -> Dom s Int
    sdnoM :: forall s. Int -> Dom s Int
    sdnoM = (Env s -> Arr s Int) -> Int -> S s (Env s) Int
    forall z a s.
    MArray (A z) a (ST z) =>
    (s -> Arr z a) -> Int -> S z s a
    fetch Env s -> Arr s Int
    forall s. Env s -> Arr s Int
    sdnoE
    -- dfnM :: Node -> Dom s Int
    -- dfnM = fetch dfnE
    ndfsM :: Int -> Dom s Node
    ndfsM :: forall s. Int -> Dom s Int
    ndfsM = (Env s -> Arr s Int) -> Int -> S s (Env s) Int
    forall z a s.
    MArray (A z) a (ST z) =>
    (s -> Arr z a) -> Int -> S z s a
    fetch Env s -> Arr s Int
    forall s. Env s -> Arr s Int
    ndfsE
    childM :: Node -> Dom s Node
    childM :: forall s. Int -> Dom s Int
    childM = (Env s -> Arr s Int) -> Int -> S s (Env s) Int
    forall z a s.
    MArray (A z) a (ST z) =>
    (s -> Arr z a) -> Int -> S z s a
    fetch Env s -> Arr s Int
    forall s. Env s -> Arr s Int
    childE
    ancestorM :: Node -> Dom s Node
    ancestorM :: forall s. Int -> Dom s Int
    ancestorM = (Env s -> Arr s Int) -> Int -> S s (Env s) Int
    forall z a s.
    MArray (A z) a (ST z) =>
    (s -> Arr z a) -> Int -> S z s a
    fetch Env s -> Arr s Int
    forall s. Env s -> Arr s Int
    ancestorE
    parentM :: Node -> Dom s Node
    parentM :: forall s. Int -> Dom s Int
    parentM = (Env s -> Arr s Int) -> Int -> S s (Env s) Int
    forall z a s.
    MArray (A z) a (ST z) =>
    (s -> Arr z a) -> Int -> S z s a
    fetch Env s -> Arr s Int
    forall s. Env s -> Arr s Int
    parentE
    labelM :: Node -> Dom s Node
    labelM :: forall s. Int -> Dom s Int
    labelM = (Env s -> Arr s Int) -> Int -> S s (Env s) Int
    forall z a s.
    MArray (A z) a (ST z) =>
    (s -> Arr z a) -> Int -> S z s a
    fetch Env s -> Arr s Int
    forall s. Env s -> Arr s Int
    labelE
    nextM :: Dom s Int
    nextM :: forall s. Dom s Int
    nextM = do
      Int
    n <- (Env s -> Int) -> Dom s Int
    forall s a z. (s -> a) -> S z s a
    gets Env s -> Int
    forall s. Env s -> Int
    dfsE
      let n' :: Int
    n' = Int
    nInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    1
      (Env s -> Env s) -> S s (Env s) ()
    forall s z. (s -> s) -> S z s ()
    modify(\Env s
    e->Env s
    e{dfsE :: Int
    dfsE=Int
    n'})
      Int -> Dom s Int
    forall (m :: * -> *) a. Monad m => a -> m a
    return Int
    n'

    -----------------------------------------------------------------------------

    type A = STUArray
    type Arr s a = A s Int a

    infixl 9 !:
    infixr 2 .=

    -- | arr .= x idx => write x to index
    (.=) :: (MArray (A s) a (ST s))
         => Arr s a -> a -> Int -> ST s ()
    (Arr s a
    v .= :: forall s a. MArray (A s) a (ST s) => Arr s a -> a -> Int -> ST s ()
    .= a
    x) Int
    i = Arr s a -> Int -> a -> ST s ()
    forall (a :: * -> * -> *) e (m :: * -> *) i.
    (MArray a e m, Ix i) =>
    a i e -> Int -> e -> m ()
    unsafeWrite Arr s a
    v Int
    i a
    x

    (!:) :: (MArray (A s) a (ST s))
         => A s Int a -> Int -> ST s a
    A s Int a
    a !: :: forall s a. MArray (A s) a (ST s) => A s Int a -> Int -> ST s a
    !: Int
    i = do
      a
    o <- A s Int a -> Int -> ST s a
    forall (a :: * -> * -> *) e (m :: * -> *) i.
    (MArray a e m, Ix i) =>
    a i e -> Int -> m e
    unsafeRead A s Int a
    a Int
    i
      a -> ST s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (a -> ST s a) -> a -> ST s a
    forall a b. (a -> b) -> a -> b
    $! a
    o

    new :: (MArray (A s) a (ST s))
        => Int -> ST s (Arr s a)
    new :: forall s a. MArray (A s) a (ST s) => Int -> ST s (Arr s a)
    new Int
    n = (Int, Int) -> ST s (STUArray s Int a)
    forall (a :: * -> * -> *) e (m :: * -> *) i.
    (MArray a e m, Ix i) =>
    (i, i) -> m (a i e)
    unsafeNewArray_ (Int
    0,Int
    nInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    1)

    newI :: Int -> ST s (Arr s Int)
    newI :: forall s. Int -> ST s (Arr s Int)
    newI = Int -> ST s (Arr s Int)
    forall s a. MArray (A s) a (ST s) => Int -> ST s (Arr s a)
    new

    writes :: (MArray (A s) a (ST s))
         => Arr s a -> [(Int,a)] -> ST s ()
    writes :: forall s a.
    MArray (A s) a (ST s) =>
    Arr s a -> [(Int, a)] -> ST s ()
    writes Arr s a
    a [(Int, a)]
    xs = [(Int, a)] -> ((Int, a) -> ST s ()) -> ST s ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    t a -> (a -> m b) -> m ()
    forM_ [(Int, a)]
    xs (\(Int
    i,a
    x) -> (Arr s a
    aArr s a -> a -> Int -> ST s ()
    forall s a. MArray (A s) a (ST s) => Arr s a -> a -> Int -> ST s ()
    .=a
    x) Int
    i)

    (!) :: Monoid a => IntMap a -> Int -> a
    ! :: forall a. Monoid a => IntMap a -> Int -> a
    (!) IntMap a
    g Int
    n = a -> (a -> a) -> Maybe a -> a
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe a
    forall a. Monoid a => a
    mempty a -> a
    forall a. a -> a
    id (Int -> IntMap a -> Maybe a
    forall a. Int -> IntMap a -> Maybe a
    IM.lookup Int
    n IntMap a
    g)

    fromAdj :: [(Node, [Node])] -> Graph
    fromAdj :: [(Int, Path)] -> Graph
    fromAdj = [(Int, IntSet)] -> Graph
    forall a. [(Int, a)] -> IntMap a
    IM.fromList ([(Int, IntSet)] -> Graph)
    -> ([(Int, Path)] -> [(Int, IntSet)]) -> [(Int, Path)] -> Graph
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((Int, Path) -> (Int, IntSet)) -> [(Int, Path)] -> [(Int, IntSet)]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((Path -> IntSet) -> (Int, Path) -> (Int, IntSet)
    forall (p :: * -> * -> *) b c a.
    Bifunctor p =>
    (b -> c) -> p a b -> p a c
    second Path -> IntSet
    IS.fromList)

    fromEdges :: [Edge] -> Graph
    fromEdges :: [(Int, Int)] -> Graph
    fromEdges = (IntSet -> IntSet -> IntSet)
    -> ((Int, Int) -> Int)
    -> ((Int, Int) -> IntSet)
    -> [(Int, Int)]
    -> Graph
    forall c a.
    (c -> c -> c) -> (a -> Int) -> (a -> c) -> [a] -> IntMap c
    collectI IntSet -> IntSet -> IntSet
    IS.union (Int, Int) -> Int
    forall a b. (a, b) -> a
    fst (Int -> IntSet
    IS.singleton (Int -> IntSet) -> ((Int, Int) -> Int) -> (Int, Int) -> IntSet
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Int, Int) -> Int
    forall a b. (a, b) -> b
    snd)

    toAdj :: Graph -> [(Node, [Node])]
    toAdj :: Graph -> [(Int, Path)]
    toAdj = ((Int, IntSet) -> (Int, Path)) -> [(Int, IntSet)] -> [(Int, Path)]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((IntSet -> Path) -> (Int, IntSet) -> (Int, Path)
    forall (p :: * -> * -> *) b c a.
    Bifunctor p =>
    (b -> c) -> p a b -> p a c
    second IntSet -> Path
    IS.toList) ([(Int, IntSet)] -> [(Int, Path)])
    -> (Graph -> [(Int, IntSet)]) -> Graph -> [(Int, Path)]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Graph -> [(Int, IntSet)]
    forall a. IntMap a -> [(Int, a)]
    IM.toList

    toEdges :: Graph -> [Edge]
    toEdges :: Graph -> [(Int, Int)]
    toEdges = ((Int, Path) -> [(Int, Int)]) -> [(Int, Path)] -> [(Int, Int)]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap ((Int -> Path -> [(Int, Int)]) -> (Int, Path) -> [(Int, Int)]
    forall a b c. (a -> b -> c) -> (a, b) -> c
    uncurry ((Int -> (Int, Int)) -> Path -> [(Int, Int)]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((Int -> (Int, Int)) -> Path -> [(Int, Int)])
    -> (Int -> Int -> (Int, Int)) -> Int -> Path -> [(Int, Int)]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (,))) ([(Int, Path)] -> [(Int, Int)])
    -> (Graph -> [(Int, Path)]) -> Graph -> [(Int, Int)]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Graph -> [(Int, Path)]
    toAdj

    predG :: Graph -> Graph
    predG :: Graph -> Graph
    predG Graph
    g = (IntSet -> IntSet -> IntSet) -> Graph -> Graph -> Graph
    forall a. (a -> a -> a) -> IntMap a -> IntMap a -> IntMap a
    IM.unionWith IntSet -> IntSet -> IntSet
    IS.union (Graph -> Graph
    go Graph
    g) Graph
    g0
      where g0 :: Graph
    g0 = (IntSet -> IntSet) -> Graph -> Graph
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (IntSet -> IntSet -> IntSet
    forall a b. a -> b -> a
    const IntSet
    forall a. Monoid a => a
    mempty) Graph
    g
            go :: Graph -> Graph
    go = ((Int -> IntSet -> Graph -> Graph) -> Graph -> Graph -> Graph)
    -> Graph -> (Int -> IntSet -> Graph -> Graph) -> Graph -> Graph
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip (Int -> IntSet -> Graph -> Graph) -> Graph -> Graph -> Graph
    forall a b. (Int -> a -> b -> b) -> b -> IntMap a -> b
    IM.foldrWithKey Graph
    forall a. Monoid a => a
    mempty (\Int
    i IntSet
    a Graph
    m ->
                    (Graph -> Int -> Graph) -> Graph -> Path -> Graph
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl' (\Graph
    m Int
    p -> (IntSet -> IntSet -> IntSet) -> Int -> IntSet -> Graph -> Graph
    forall a. (a -> a -> a) -> Int -> a -> IntMap a -> IntMap a
    IM.insertWith IntSet -> IntSet -> IntSet
    forall a. Monoid a => a -> a -> a
    mappend Int
    p
                                          (Int -> IntSet
    IS.singleton Int
    i) Graph
    m)
                            Graph
    m
                           (IntSet -> Path
    IS.toList IntSet
    a))

    pruneReach :: Rooted -> Rooted
    pruneReach :: Rooted -> Rooted
    pruneReach (Int
    r,Graph
    g) = (Int
    r,Graph
    g2)
      where is :: IntSet
    is = (Int -> IntSet) -> Int -> IntSet
    reachable
                  (IntSet -> (IntSet -> IntSet) -> Maybe IntSet -> IntSet
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe IntSet
    forall a. Monoid a => a
    mempty IntSet -> IntSet
    forall a. a -> a
    id
                    (Maybe IntSet -> IntSet) -> (Int -> Maybe IntSet) -> Int -> IntSet
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Int -> Graph -> Maybe IntSet) -> Graph -> Int -> Maybe IntSet
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip Int -> Graph -> Maybe IntSet
    forall a. Int -> IntMap a -> Maybe a
    IM.lookup Graph
    g) (Int -> IntSet) -> Int -> IntSet
    forall a b. (a -> b) -> a -> b
    $ Int
    r
            g2 :: Graph
    g2 = [(Int, IntSet)] -> Graph
    forall a. [(Int, a)] -> IntMap a
    IM.fromList
                ([(Int, IntSet)] -> Graph)
    -> (Graph -> [(Int, IntSet)]) -> Graph -> Graph
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((Int, IntSet) -> (Int, IntSet))
    -> [(Int, IntSet)] -> [(Int, IntSet)]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((IntSet -> IntSet) -> (Int, IntSet) -> (Int, IntSet)
    forall (p :: * -> * -> *) b c a.
    Bifunctor p =>
    (b -> c) -> p a b -> p a c
    second ((Int -> Bool) -> IntSet -> IntSet
    IS.filter (Int -> IntSet -> Bool
    `IS.member`IntSet
    is)))
                ([(Int, IntSet)] -> [(Int, IntSet)])
    -> (Graph -> [(Int, IntSet)]) -> Graph -> [(Int, IntSet)]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((Int, IntSet) -> Bool) -> [(Int, IntSet)] -> [(Int, IntSet)]
    forall a. (a -> Bool) -> [a] -> [a]
    filter ((Int -> IntSet -> Bool
    `IS.member`IntSet
    is) (Int -> Bool) -> ((Int, IntSet) -> Int) -> (Int, IntSet) -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Int, IntSet) -> Int
    forall a b. (a, b) -> a
    fst)
                ([(Int, IntSet)] -> [(Int, IntSet)])
    -> (Graph -> [(Int, IntSet)]) -> Graph -> [(Int, IntSet)]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Graph -> [(Int, IntSet)]
    forall a. IntMap a -> [(Int, a)]
    IM.toList (Graph -> Graph) -> Graph -> Graph
    forall a b. (a -> b) -> a -> b
    $ Graph
    g

    tip :: Tree a -> (a, [Tree a])
    tip :: forall a. Tree a -> (a, [Tree a])
    tip (Node a
    a [Tree a]
    ts) = (a
    a, [Tree a]
    ts)

    parents :: Tree a -> [(a, a)]
    parents :: forall a. Tree a -> [(a, a)]
    parents (Node a
    i [Tree a]
    xs) = a -> [Tree a] -> [(a, a)]
    forall {f :: * -> *} {b} {b}.
    Functor f =>
    b -> f (Tree b) -> f (b, b)
    p a
    i [Tree a]
    xs
            [(a, a)] -> [(a, a)] -> [(a, a)]
    forall a. [a] -> [a] -> [a]
    ++ (Tree a -> [(a, a)]) -> [Tree a] -> [(a, a)]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap Tree a -> [(a, a)]
    forall a. Tree a -> [(a, a)]
    parents [Tree a]
    xs
      where p :: b -> f (Tree b) -> f (b, b)
    p b
    i = (Tree b -> (b, b)) -> f (Tree b) -> f (b, b)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((b -> b -> (b, b)) -> b -> b -> (b, b)
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip (,) b
    i (b -> (b, b)) -> (Tree b -> b) -> Tree b -> (b, b)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Tree b -> b
    forall a. Tree a -> a
    rootLabel)

    ancestors :: Tree a -> [(a, [a])]
    ancestors :: forall a. Tree a -> [(a, [a])]
    ancestors = [a] -> Tree a -> [(a, [a])]
    forall {b}. [b] -> Tree b -> [(b, [b])]
    go []
      where go :: [b] -> Tree b -> [(b, [b])]
    go [b]
    acc (Node b
    i [Tree b]
    xs)
              = let acc' :: [b]
    acc' = b
    ib -> [b] -> [b]
    forall a. a -> [a] -> [a]
    :[b]
    acc
                in [b] -> [Tree b] -> [(b, [b])]
    forall {f :: * -> *} {b} {b}.
    Functor f =>
    b -> f (Tree b) -> f (b, b)
    p [b]
    acc' [Tree b]
    xs [(b, [b])] -> [(b, [b])] -> [(b, [b])]
    forall a. [a] -> [a] -> [a]
    ++ (Tree b -> [(b, [b])]) -> [Tree b] -> [(b, [b])]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap ([b] -> Tree b -> [(b, [b])]
    go [b]
    acc') [Tree b]
    xs
            p :: b -> f (Tree b) -> f (b, b)
    p b
    is = (Tree b -> (b, b)) -> f (Tree b) -> f (b, b)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((b -> b -> (b, b)) -> b -> b -> (b, b)
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip (,) b
    is (b -> (b, b)) -> (Tree b -> b) -> Tree b -> (b, b)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Tree b -> b
    forall a. Tree a -> a
    rootLabel)

    asGraph :: Tree Node -> Rooted
    asGraph :: Tree Int -> Rooted
    asGraph t :: Tree Int
    t@(Node Int
    a [Tree Int]
    _) = let g :: [(Int, Path)]
    g = Tree Int -> [(Int, Path)]
    forall a. Tree a -> [(a, [a])]
    go Tree Int
    t in (Int
    a, [(Int, Path)] -> Graph
    fromAdj [(Int, Path)]
    g)
      where go :: Tree a -> [(a, [a])]
    go (Node a
    a [Tree a]
    ts) = let as :: [a]
    as = (([a], [[Tree a]]) -> [a]
    forall a b. (a, b) -> a
    fst (([a], [[Tree a]]) -> [a])
    -> ([Tree a] -> ([a], [[Tree a]])) -> [Tree a] -> [a]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [(a, [Tree a])] -> ([a], [[Tree a]])
    forall a b. [(a, b)] -> ([a], [b])
    unzip ([(a, [Tree a])] -> ([a], [[Tree a]]))
    -> ([Tree a] -> [(a, [Tree a])]) -> [Tree a] -> ([a], [[Tree a]])
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Tree a -> (a, [Tree a])) -> [Tree a] -> [(a, [Tree a])]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Tree a -> (a, [Tree a])
    forall a. Tree a -> (a, [Tree a])
    tip) [Tree a]
    ts
                              in (a
    a, [a]
    as) (a, [a]) -> [(a, [a])] -> [(a, [a])]
    forall a. a -> [a] -> [a]
    : (Tree a -> [(a, [a])]) -> [Tree a] -> [(a, [a])]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap Tree a -> [(a, [a])]
    go [Tree a]
    ts

    asTree :: Rooted -> Tree Node
    asTree :: Rooted -> Tree Int
    asTree (Int
    r,Graph
    g) = let go :: Int -> Tree Int
    go Int
    a = Int -> [Tree Int] -> Tree Int
    forall a. a -> [Tree a] -> Tree a
    Node Int
    a ((Int -> Tree Int) -> Path -> [Tree Int]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Int -> Tree Int
    go ((IntSet -> Path
    IS.toList (IntSet -> Path) -> (Int -> IntSet) -> Int -> Path
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> IntSet
    f) Int
    a))
                       f :: Int -> IntSet
    f = (Graph
    g Graph -> Int -> IntSet
    forall a. Monoid a => IntMap a -> Int -> a
    !)
                in Int -> Tree Int
    go Int
    r

    reachable :: (Node -> NodeSet) -> (Node -> NodeSet)
    reachable :: (Int -> IntSet) -> Int -> IntSet
    reachable Int -> IntSet
    f Int
    a = IntSet -> Int -> IntSet
    go (Int -> IntSet
    IS.singleton Int
    a) Int
    a
      where go :: IntSet -> Int -> IntSet
    go IntSet
    seen Int
    a = let s :: IntSet
    s = Int -> IntSet
    f Int
    a
                            as :: Path
    as = IntSet -> Path
    IS.toList (IntSet
    s IntSet -> IntSet -> IntSet
    `IS.difference` IntSet
    seen)
                        in (IntSet -> Int -> IntSet) -> IntSet -> Path -> IntSet
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl' IntSet -> Int -> IntSet
    go (IntSet
    s IntSet -> IntSet -> IntSet
    `IS.union` IntSet
    seen) Path
    as

    collectI :: (c -> c -> c)
            -> (a -> Int) -> (a -> c) -> [a] -> IntMap c
    collectI :: forall c a.
    (c -> c -> c) -> (a -> Int) -> (a -> c) -> [a] -> IntMap c
    collectI c -> c -> c
    (<>) a -> Int
    f a -> c
    g
      = (IntMap c -> a -> IntMap c) -> IntMap c -> [a] -> IntMap c
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl' (\IntMap c
    m a
    a -> (c -> c -> c) -> Int -> c -> IntMap c -> IntMap c
    forall a. (a -> a -> a) -> Int -> a -> IntMap a -> IntMap a
    IM.insertWith c -> c -> c
    (<>)
                                      (a -> Int
    f a
    a)
                                      (a -> c
    g a
    a) IntMap c
    m) IntMap c
    forall a. Monoid a => a
    mempty

    -- | renum n g: Rename all nodes
    --
    -- Gives nodes sequential names starting at n.
    -- Returns the new graph and a mapping.
    -- (renamed, old -> new)
    renum :: Int -> Graph -> (Graph, NodeMap Node)
    renum :: Int -> Graph -> (Graph, NodeMap Int)
    renum Int
    from = (\(Int
    _,NodeMap Int
    m,Graph
    g)->(Graph
    g,NodeMap Int
    m))
      ((Int, NodeMap Int, Graph) -> (Graph, NodeMap Int))
    -> (Graph -> (Int, NodeMap Int, Graph))
    -> Graph
    -> (Graph, NodeMap Int)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Int
     -> IntSet
     -> (Int, NodeMap Int, Graph)
     -> (Int, NodeMap Int, Graph))
    -> (Int, NodeMap Int, Graph) -> Graph -> (Int, NodeMap Int, Graph)
    forall a b. (Int -> a -> b -> b) -> b -> IntMap a -> b
    IM.foldrWithKey
          (\Int
    i IntSet
    ss (!Int
    n,!NodeMap Int
    env,!Graph
    new)->
              let (Int
    j,Int
    n2,NodeMap Int
    env2) = Int -> NodeMap Int -> Int -> (Int, Int, NodeMap Int)
    go Int
    n NodeMap Int
    env Int
    i
                  (Int
    n3,NodeMap Int
    env3,IntSet
    ss2) = (Int -> (Int, NodeMap Int, IntSet) -> (Int, NodeMap Int, IntSet))
    -> (Int, NodeMap Int, IntSet)
    -> IntSet
    -> (Int, NodeMap Int, IntSet)
    forall b. (Int -> b -> b) -> b -> IntSet -> b
    IS.fold
                    (\Int
    k (!Int
    n,!NodeMap Int
    env,!IntSet
    new)->
                        case Int -> NodeMap Int -> Int -> (Int, Int, NodeMap Int)
    go Int
    n NodeMap Int
    env Int
    k of
                          (Int
    l,Int
    n2,NodeMap Int
    env2)-> (Int
    n2,NodeMap Int
    env2,Int
    l Int -> IntSet -> IntSet
    `IS.insert` IntSet
    new))
                    (Int
    n2,NodeMap Int
    env2,IntSet
    forall a. Monoid a => a
    mempty) IntSet
    ss
                  new2 :: Graph
    new2 = (IntSet -> IntSet -> IntSet) -> Int -> IntSet -> Graph -> Graph
    forall a. (a -> a -> a) -> Int -> a -> IntMap a -> IntMap a
    IM.insertWith IntSet -> IntSet -> IntSet
    IS.union Int
    j IntSet
    ss2 Graph
    new
              in (Int
    n3,NodeMap Int
    env3,Graph
    new2)) (Int
    from,NodeMap Int
    forall a. Monoid a => a
    mempty,Graph
    forall a. Monoid a => a
    mempty)
      where go :: Int
               -> NodeMap Node
               -> Node
               -> (Node,Int,NodeMap Node)
            go :: Int -> NodeMap Int -> Int -> (Int, Int, NodeMap Int)
    go !Int
    n !NodeMap Int
    env Int
    i =
              case Int -> NodeMap Int -> Maybe Int
    forall a. Int -> IntMap a -> Maybe a
    IM.lookup Int
    i NodeMap Int
    env of
                Just Int
    j -> (Int
    j,Int
    n,NodeMap Int
    env)
                Maybe Int
    Nothing -> (Int
    n,Int
    nInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    1,Int -> Int -> NodeMap Int -> NodeMap Int
    forall a. Int -> a -> IntMap a -> IntMap a
    IM.insert Int
    i Int
    n NodeMap Int
    env)

    -----------------------------------------------------------------------------

    -- Nothing better than reinvinting the state monad.
    newtype S z s a = S {forall z s a.
    S z s a -> forall o. (a -> s -> ST z o) -> s -> ST z o
    unS :: forall o. (a -> s -> ST z o) -> s -> ST z o}
    instance Functor (S z s) where
      fmap :: forall a b. (a -> b) -> S z s a -> S z s b
    fmap a -> b
    f (S forall o. (a -> s -> ST z o) -> s -> ST z o
    g) = (forall o. (b -> s -> ST z o) -> s -> ST z o) -> S z s b
    forall z s a.
    (forall o. (a -> s -> ST z o) -> s -> ST z o) -> S z s a
    S (\b -> s -> ST z o
    k -> (a -> s -> ST z o) -> s -> ST z o
    forall o. (a -> s -> ST z o) -> s -> ST z o
    g (b -> s -> ST z o
    k (b -> s -> ST z o) -> (a -> b) -> a -> s -> ST z o
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> b
    f))
    instance Monad (S z s) where
      return :: forall a. a -> S z s a
    return = a -> S z s a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure
      S forall o. (a -> s -> ST z o) -> s -> ST z o
    g >>= :: forall a b. S z s a -> (a -> S z s b) -> S z s b
    >>= a -> S z s b
    f = (forall o. (b -> s -> ST z o) -> s -> ST z o) -> S z s b
    forall z s a.
    (forall o. (a -> s -> ST z o) -> s -> ST z o) -> S z s a
    S (\b -> s -> ST z o
    k -> (a -> s -> ST z o) -> s -> ST z o
    forall o. (a -> s -> ST z o) -> s -> ST z o
    g (\a
    a -> S z s b -> forall o. (b -> s -> ST z o) -> s -> ST z o
    forall z s a.
    S z s a -> forall o. (a -> s -> ST z o) -> s -> ST z o
    unS (a -> S z s b
    f a
    a) b -> s -> ST z o
    k))
    instance Applicative (S z s) where
      pure :: forall a. a -> S z s a
    pure a
    a = (forall o. (a -> s -> ST z o) -> s -> ST z o) -> S z s a
    forall z s a.
    (forall o. (a -> s -> ST z o) -> s -> ST z o) -> S z s a
    S (\a -> s -> ST z o
    k -> a -> s -> ST z o
    k a
    a)
      <*> :: forall a b. S z s (a -> b) -> S z s a -> S z s b
    (<*>) = S z s (a -> b) -> S z s a -> S z s b
    forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
    ap
    -- get :: S z s s
    -- get = S (\k s -> k s s)
    gets :: (s -> a) -> S z s a
    gets :: forall s a z. (s -> a) -> S z s a
    gets s -> a
    f = (forall o. (a -> s -> ST z o) -> s -> ST z o) -> S z s a
    forall z s a.
    (forall o. (a -> s -> ST z o) -> s -> ST z o) -> S z s a
    S (\a -> s -> ST z o
    k s
    s -> a -> s -> ST z o
    k (s -> a
    f s
    s) s
    s)
    -- set :: s -> S z s ()
    -- set s = S (\k _ -> k () s)
    modify :: (s -> s) -> S z s ()
    modify :: forall s z. (s -> s) -> S z s ()
    modify s -> s
    f = (forall o. (() -> s -> ST z o) -> s -> ST z o) -> S z s ()
    forall z s a.
    (forall o. (a -> s -> ST z o) -> s -> ST z o) -> S z s a
    S (\() -> s -> ST z o
    k -> () -> s -> ST z o
    k () (s -> ST z o) -> (s -> s) -> s -> ST z o
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . s -> s
    f)
    -- runS :: S z s a -> s -> ST z (a, s)
    -- runS (S g) = g (\a s -> return (a,s))
    evalS :: S z s a -> s -> ST z a
    evalS :: forall z s a. S z s a -> s -> ST z a
    evalS (S forall o. (a -> s -> ST z o) -> s -> ST z o
    g) = (a -> s -> ST z a) -> s -> ST z a
    forall o. (a -> s -> ST z o) -> s -> ST z o
    g ((a -> ST z a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (a -> ST z a) -> (s -> a) -> s -> ST z a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .) ((s -> a) -> s -> ST z a) -> (a -> s -> a) -> a -> s -> ST z a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> s -> a
    forall a b. a -> b -> a
    const)
    -- execS :: S z s a -> s -> ST z s
    -- execS (S g) = g ((return .) . flip const)
    st :: ST z a -> S z s a
    st :: forall z a s. ST z a -> S z s a
    st ST z a
    m = (forall o. (a -> s -> ST z o) -> s -> ST z o) -> S z s a
    forall z s a.
    (forall o. (a -> s -> ST z o) -> s -> ST z o) -> S z s a
    S (\a -> s -> ST z o
    k s
    s-> do
      a
    a <- ST z a
    m
      a -> s -> ST z o
    k a
    a s
    s)
    store :: (MArray (A z) a (ST z))
          => (s -> Arr z a) -> Int -> a -> S z s ()
    store :: forall z a s.
    MArray (A z) a (ST z) =>
    (s -> Arr z a) -> Int -> a -> S z s ()
    store s -> Arr z a
    f Int
    i a
    x = do
      Arr z a
    a <- (s -> Arr z a) -> S z s (Arr z a)
    forall s a z. (s -> a) -> S z s a
    gets s -> Arr z a
    f
      ST z () -> S z s ()
    forall z a s. ST z a -> S z s a
    st ((Arr z a
    aArr z a -> a -> Int -> ST z ()
    forall s a. MArray (A s) a (ST s) => Arr s a -> a -> Int -> ST s ()
    .=a
    x) Int
    i)
    fetch :: (MArray (A z) a (ST z))
          => (s -> Arr z a) -> Int -> S z s a
    fetch :: forall z a s.
    MArray (A z) a (ST z) =>
    (s -> Arr z a) -> Int -> S z s a
    fetch s -> Arr z a
    f Int
    i = do
      Arr z a
    a <- (s -> Arr z a) -> S z s (Arr z a)
    forall s a z. (s -> a) -> S z s a
    gets s -> Arr z a
    f
      ST z a -> S z s a
    forall z a s. ST z a -> S z s a
    st (Arr z a
    aArr z a -> Int -> ST z a
    forall s a. MArray (A s) a (ST s) => A s Int a -> Int -> ST s a
    !:Int
    i)