{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE Strict #-}
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)
dom :: Rooted -> [(Node, Path)]
dom :: Rooted -> [(Int, Path)]
dom = forall a. Tree a -> [(a, [a])]
ancestors forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rooted -> Tree Int
domTree
pdom :: Rooted -> [(Node, Path)]
pdom :: Rooted -> [(Int, Path)]
pdom = forall a. Tree a -> [(a, [a])]
ancestors forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rooted -> Tree Int
pdomTree
domTree :: Rooted -> Tree Node
domTree :: Rooted -> Tree Int
domTree a :: Rooted
a@(Int
r,Graph
_) =
let is :: [(Int, Int)]
is = forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Eq a => a -> a -> Bool
/=Int
r)forall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b. (a, b) -> a
fst) (Rooted -> [(Int, Int)]
idom Rooted
a)
tg :: Graph
tg = [(Int, Int)] -> Graph
fromEdges (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> (b, a)
swap [(Int, Int)]
is)
in Rooted -> Tree Int
asTree (Int
r,Graph
tg)
pdomTree :: Rooted -> Tree Node
pdomTree :: Rooted -> Tree Int
pdomTree a :: Rooted
a@(Int
r,Graph
_) =
let is :: [(Int, Int)]
is = forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Eq a => a -> a -> Bool
/=Int
r)forall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b. (a, b) -> a
fst) (Rooted -> [(Int, Int)]
ipdom Rooted
a)
tg :: Graph
tg = [(Int, Int)] -> Graph
fromEdges (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> (b, a)
swap [(Int, Int)]
is)
in Rooted -> Tree Int
asTree (Int
r,Graph
tg)
idom :: Rooted -> [(Node,Node)]
idom :: Rooted -> [(Int, Int)]
idom Rooted
rg = forall a. (forall s. ST s a) -> a
runST (forall z s a. S z s a -> s -> ST z a
evalS forall s. Dom s [(Int, Int)]
idomM forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall s. Rooted -> ST s (Env s)
initEnv (Rooted -> Rooted
pruneReach Rooted
rg))
ipdom :: Rooted -> [(Node,Node)]
ipdom :: Rooted -> [(Int, Int)]
ipdom Rooted
rg = forall a. (forall s. ST s a) -> a
runST (forall z s a. S z s a -> s -> ST z a
evalS forall s. Dom s [(Int, Int)]
idomM forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall s. Rooted -> ST s (Env s)
initEnv (Rooted -> Rooted
pruneReach (forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second Graph -> Graph
predG Rooted
rg)))
pddfs :: Rooted -> [Node]
pddfs :: Rooted -> Path
pddfs = forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rooted -> Path
rpddfs
rpddfs :: Rooted -> [Node]
rpddfs :: Rooted -> Path
rpddfs = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Tree a -> [[a]]
levels 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
forall s. Int -> Dom s ()
dfsDom forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall s. Dom s Int
rootM
Int
n <- forall s a z. (s -> a) -> S z s a
gets forall s. Env s -> Int
dfsE
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int
n,Int
nforall a. Num a => a -> a -> a
-Int
1..Int
1] (\Int
i-> do
Int
w <- forall s. Int -> Dom s Int
ndfsM Int
i
Path
ps <- forall s. Int -> Dom s Path
predsM Int
w
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Path
ps (\Int
v-> do
Int
sw <- forall s. Int -> Dom s Int
sdnoM Int
w
Int
u <- forall s. Int -> Dom s Int
eval Int
v
Int
su <- forall s. Int -> Dom s Int
sdnoM Int
u
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
su forall a. Ord a => a -> a -> Bool
< Int
sw)
(forall z a s.
MArray (A z) a (ST z) =>
(s -> Arr z a) -> Int -> a -> S z s ()
store forall s. Env s -> Arr s Int
sdnoE Int
w Int
su))
Int
z <- forall s. Int -> Dom s Int
ndfsM forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall s. Int -> Dom s Int
sdnoM Int
w
forall s z. (s -> s) -> S z s ()
modify(\Env s
e->Env s
e{bucketE :: Graph
bucketE=forall a. (a -> a) -> Int -> IntMap a -> IntMap a
IM.adjust
(Int
wInt -> IntSet -> IntSet
`IS.insert`)
Int
z (forall s. Env s -> Graph
bucketE Env s
e)})
Int
pw <- forall s. Int -> Dom s Int
parentM Int
w
forall s. Int -> Int -> Dom s ()
link Int
pw Int
w
Path
bps <- forall s. Int -> Dom s Path
bucketM Int
pw
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Path
bps (\Int
v-> do
Int
u <- forall s. Int -> Dom s Int
eval Int
v
Int
su <- forall s. Int -> Dom s Int
sdnoM Int
u
Int
sv <- forall s. Int -> Dom s Int
sdnoM Int
v
let dv :: Int
dv = case Int
su forall a. Ord a => a -> a -> Bool
< Int
sv of
Bool
True-> Int
u
Bool
False-> Int
pw
forall z a s.
MArray (A z) a (ST z) =>
(s -> Arr z a) -> Int -> a -> S z s ()
store forall s. Env s -> Arr s Int
domE Int
v Int
dv))
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 <- forall s. Int -> Dom s Int
ndfsM Int
i
Int
j <- forall s. Int -> Dom s Int
sdnoM Int
w
Int
z <- forall s. Int -> Dom s Int
ndfsM Int
j
Int
dw <- forall s. Int -> Dom s Int
domM Int
w
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
dw forall a. Eq a => a -> a -> Bool
/= Int
z)
(do Int
ddw <- forall s. Int -> Dom s Int
domM Int
dw
forall z a s.
MArray (A z) a (ST z) =>
(s -> Arr z a) -> Int -> a -> S z s ()
store forall s. Env s -> Arr s Int
domE Int
w Int
ddw))
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 <- forall s. Dom s Int
zeroM
Int
a <- forall s. Int -> Dom s Int
ancestorM Int
v
case Int
aforall a. Eq a => a -> a -> Bool
==Int
n0 of
Bool
True-> forall s. Int -> Dom s Int
labelM Int
v
Bool
False-> do
forall s. Int -> Dom s ()
compress Int
v
Int
a <- forall s. Int -> Dom s Int
ancestorM Int
v
Int
l <- forall s. Int -> Dom s Int
labelM Int
v
Int
la <- forall s. Int -> Dom s Int
labelM Int
a
Int
sl <- forall s. Int -> Dom s Int
sdnoM Int
l
Int
sla <- forall s. Int -> Dom s Int
sdnoM Int
la
case Int
sl forall a. Ord a => a -> a -> Bool
<= Int
sla of
Bool
True-> forall (m :: * -> *) a. Monad m => a -> m a
return Int
l
Bool
False-> 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 <- forall s. Dom s Int
zeroM
Int
a <- forall s. Int -> Dom s Int
ancestorM Int
v
Int
aa <- forall s. Int -> Dom s Int
ancestorM Int
a
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
aa forall a. Eq a => a -> a -> Bool
/= Int
n0) (do
forall s. Int -> Dom s ()
compress Int
a
Int
a <- forall s. Int -> Dom s Int
ancestorM Int
v
Int
aa <- forall s. Int -> Dom s Int
ancestorM Int
a
Int
l <- forall s. Int -> Dom s Int
labelM Int
v
Int
la <- forall s. Int -> Dom s Int
labelM Int
a
Int
sl <- forall s. Int -> Dom s Int
sdnoM Int
l
Int
sla <- forall s. Int -> Dom s Int
sdnoM Int
la
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
sla forall a. Ord a => a -> a -> Bool
< Int
sl)
(forall z a s.
MArray (A z) a (ST z) =>
(s -> Arr z a) -> Int -> a -> S z s ()
store forall s. Env s -> Arr s Int
labelE Int
v Int
la)
forall z a s.
MArray (A z) a (ST z) =>
(s -> Arr z a) -> Int -> a -> S z s ()
store 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 <- forall s. Dom s Int
zeroM
Int
lw <- forall s. Int -> Dom s Int
labelM Int
w
Int
slw <- forall s. Int -> Dom s Int
sdnoM Int
lw
let balance :: Int -> S s (Env s) Int
balance Int
s = do
Int
c <- forall s. Int -> Dom s Int
childM Int
s
Int
lc <- forall s. Int -> Dom s Int
labelM Int
c
Int
slc <- forall s. Int -> Dom s Int
sdnoM Int
lc
case Int
slw forall a. Ord a => a -> a -> Bool
< Int
slc of
Bool
False-> forall (m :: * -> *) a. Monad m => a -> m a
return Int
s
Bool
True-> do
Int
zs <- forall s. Int -> Dom s Int
sizeM Int
s
Int
zc <- forall s. Int -> Dom s Int
sizeM Int
c
Int
cc <- forall s. Int -> Dom s Int
childM Int
c
Int
zcc <- forall s. Int -> Dom s Int
sizeM Int
cc
case Int
2forall a. Num a => a -> a -> a
*Int
zc forall a. Ord a => a -> a -> Bool
<= Int
zsforall a. Num a => a -> a -> a
+Int
zcc of
Bool
True-> do
forall z a s.
MArray (A z) a (ST z) =>
(s -> Arr z a) -> Int -> a -> S z s ()
store forall s. Env s -> Arr s Int
ancestorE Int
c Int
s
forall z a s.
MArray (A z) a (ST z) =>
(s -> Arr z a) -> Int -> a -> S z s ()
store forall s. Env s -> Arr s Int
childE Int
s Int
cc
Int -> S s (Env s) Int
balance Int
s
Bool
False-> do
forall z a s.
MArray (A z) a (ST z) =>
(s -> Arr z a) -> Int -> a -> S z s ()
store forall s. Env s -> Arr s Int
sizeE Int
c Int
zs
forall z a s.
MArray (A z) a (ST z) =>
(s -> Arr z a) -> Int -> a -> S z s ()
store forall s. Env s -> Arr s Int
ancestorE Int
s Int
c
Int -> S s (Env s) Int
balance Int
c
Int
s <- Int -> S s (Env s) Int
balance Int
w
Int
lw <- forall s. Int -> Dom s Int
labelM Int
w
Int
zw <- forall s. Int -> Dom s Int
sizeM Int
w
forall z a s.
MArray (A z) a (ST z) =>
(s -> Arr z a) -> Int -> a -> S z s ()
store forall s. Env s -> Arr s Int
labelE Int
s Int
lw
forall z a s.
MArray (A z) a (ST z) =>
(s -> Arr z a) -> Int -> a -> S z s ()
store forall s. Env s -> Arr s Int
sizeE Int
v forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Num a => a -> a -> a
+Int
zw) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall s. Int -> Dom s Int
sizeM Int
v
let follow :: Int -> Dom s ()
follow Int
s =
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
s forall a. Eq a => a -> a -> Bool
/= Int
n0) (do
forall z a s.
MArray (A z) a (ST z) =>
(s -> Arr z a) -> Int -> a -> S z s ()
store forall s. Env s -> Arr s Int
ancestorE Int
s Int
v
Int -> Dom s ()
follow forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall s. Int -> Dom s Int
childM Int
s)
Int
zv <- forall s. Int -> Dom s Int
sizeM Int
v
Int -> Dom s ()
follow forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< case Int
zv forall a. Ord a => a -> a -> Bool
< Int
2forall a. Num a => a -> a -> a
*Int
zw of
Bool
False-> forall (m :: * -> *) a. Monad m => a -> m a
return Int
s
Bool
True-> do
Int
cv <- forall s. Int -> Dom s Int
childM Int
v
forall z a s.
MArray (A z) a (ST z) =>
(s -> Arr z a) -> Int -> a -> S z s ()
store forall s. Env s -> Arr s Int
childE Int
v Int
s
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
()
_ <- forall s. Int -> Dom s ()
go Int
i
Int
n0 <- forall s. Dom s Int
zeroM
Int
r <- forall s. Dom s Int
rootM
forall z a s.
MArray (A z) a (ST z) =>
(s -> Arr z a) -> Int -> a -> S z s ()
store 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 <- forall s. Dom s Int
nextM
forall z a s.
MArray (A z) a (ST z) =>
(s -> Arr z a) -> Int -> a -> S z s ()
store forall s. Env s -> Arr s Int
dfnE Int
i Int
n
forall z a s.
MArray (A z) a (ST z) =>
(s -> Arr z a) -> Int -> a -> S z s ()
store forall s. Env s -> Arr s Int
sdnoE Int
i Int
n
forall z a s.
MArray (A z) a (ST z) =>
(s -> Arr z a) -> Int -> a -> S z s ()
store forall s. Env s -> Arr s Int
ndfsE Int
n Int
i
forall z a s.
MArray (A z) a (ST z) =>
(s -> Arr z a) -> Int -> a -> S z s ()
store forall s. Env s -> Arr s Int
labelE Int
i Int
i
Path
ss <- forall s. Int -> Dom s Path
succsM Int
i
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Path
ss (\Int
j-> do
Int
s <- forall s. Int -> Dom s Int
sdnoM Int
j
case Int
sforall a. Eq a => a -> a -> Bool
==Int
0 of
Bool
False-> forall (m :: * -> *) a. Monad m => a -> m a
return()
Bool
True-> do
forall z a s.
MArray (A z) a (ST z) =>
(s -> Arr z a) -> Int -> a -> S z s ()
store 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
let (Graph
g,NodeMap Int
rnmap) = Int -> Graph -> (Graph, NodeMap Int)
renum Int
1 Graph
g0
pred :: Graph
pred = Graph -> Graph
predG Graph
g
root :: Int
root = NodeMap Int
rnmap forall a. IntMap a -> Int -> a
IM.! Int
r0
n :: Int
n = forall a. IntMap a -> Int
IM.size Graph
g
ns :: Path
ns = [Int
0..Int
n]
m :: Int
m = Int
nforall a. Num a => a -> a -> a
+Int
1
let bucket :: Graph
bucket = forall a. [(Int, a)] -> IntMap a
IM.fromList
(forall a b. [a] -> [b] -> [(a, b)]
zip Path
ns (forall a. a -> [a]
repeat forall a. Monoid a => a
mempty))
Arr s Int
rna <- forall s. Int -> ST s (Arr s Int)
newI Int
m
forall s a.
MArray (A s) a (ST s) =>
Arr s a -> [(Int, a)] -> ST s ()
writes Arr s Int
rna (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> (b, a)
swap
(forall a. IntMap a -> [(Int, a)]
IM.toList NodeMap Int
rnmap))
Arr s Int
doms <- forall s. Int -> ST s (Arr s Int)
newI Int
m
Arr s Int
sdno <- forall s. Int -> ST s (Arr s Int)
newI Int
m
Arr s Int
size <- forall s. Int -> ST s (Arr s Int)
newI Int
m
Arr s Int
parent <- forall s. Int -> ST s (Arr s Int)
newI Int
m
Arr s Int
ancestor <- forall s. Int -> ST s (Arr s Int)
newI Int
m
Arr s Int
child <- forall s. Int -> ST s (Arr s Int)
newI Int
m
Arr s Int
label <- forall s. Int -> ST s (Arr s Int)
newI Int
m
Arr s Int
ndfs <- forall s. Int -> ST s (Arr s Int)
newI Int
m
Arr s Int
dfn <- forall s. Int -> ST s (Arr s Int)
newI Int
m
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int
0..Int
n] (Arr s Int
domsforall s a. MArray (A s) a (ST s) => Arr s a -> a -> Int -> ST s ()
.=Int
0)
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int
0..Int
n] (Arr s Int
sdnoforall s a. MArray (A s) a (ST s) => Arr s a -> a -> Int -> ST s ()
.=Int
0)
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int
1..Int
n] (Arr s Int
sizeforall s a. MArray (A s) a (ST s) => Arr s a -> a -> Int -> ST s ()
.=Int
1)
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int
0..Int
n] (Arr s Int
ancestorforall s a. MArray (A s) a (ST s) => Arr s a -> a -> Int -> ST s ()
.=Int
0)
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int
0..Int
n] (Arr s Int
childforall s a. MArray (A s) a (ST s) => Arr s a -> a -> Int -> ST s ()
.=Int
0)
(Arr s Int
domsforall s a. MArray (A s) a (ST s) => Arr s a -> a -> Int -> ST s ()
.=Int
root) Int
root
(Arr s Int
sizeforall s a. MArray (A s) a (ST s) => Arr s a -> a -> Int -> ST s ()
.=Int
0) Int
0
(Arr s Int
labelforall s a. MArray (A s) a (ST s) => Arr s a -> a -> Int -> ST s ()
.=Int
0) Int
0
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 <- forall s a z. (s -> a) -> S z s a
gets forall s. Env s -> Arr s Int
domE
Arr s Int
rn <- forall s a z. (s -> a) -> S z s a
gets forall s. Env s -> Arr s Int
rnE
(Int
_,Int
n) <- forall z a s. ST z a -> S z s a
st (forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> m (i, i)
getBounds Arr s Int
dom)
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 <- forall z a s. ST z a -> S z s a
st(Arr s Int
rnforall s a. MArray (A s) a (ST s) => A s Int a -> Int -> ST s a
!:Int
i)
Int
d <- forall z a s. ST z a -> S z s a
st(Arr s Int
domforall s a. MArray (A s) a (ST s) => A s Int a -> Int -> ST s a
!:Int
i)
Int
k <- forall z a s. ST z a -> S z s a
st(Arr s Int
rnforall s a. MArray (A s) a (ST s) => A s Int a -> Int -> ST s a
!:Int
d)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
j,Int
k))
zeroM :: Dom s Node
zeroM :: forall s. Dom s Int
zeroM = forall s a z. (s -> a) -> S z s a
gets forall s. Env s -> Int
zeroE
domM :: Node -> Dom s Node
domM :: forall s. Int -> Dom s Int
domM = forall z a s.
MArray (A z) a (ST z) =>
(s -> Arr z a) -> Int -> S z s a
fetch forall s. Env s -> Arr s Int
domE
rootM :: Dom s Node
rootM :: forall s. Dom s Int
rootM = forall s a z. (s -> a) -> S z s a
gets forall s. Env s -> Int
rootE
succsM :: Node -> Dom s [Node]
succsM :: forall s. Int -> Dom s Path
succsM Int
i = forall s a z. (s -> a) -> S z s a
gets (IntSet -> Path
IS.toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Monoid a => IntMap a -> Int -> a
! Int
i) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s. Env s -> Graph
succE)
predsM :: Node -> Dom s [Node]
predsM :: forall s. Int -> Dom s Path
predsM Int
i = forall s a z. (s -> a) -> S z s a
gets (IntSet -> Path
IS.toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Monoid a => IntMap a -> Int -> a
! Int
i) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s. Env s -> Graph
predE)
bucketM :: Node -> Dom s [Node]
bucketM :: forall s. Int -> Dom s Path
bucketM Int
i = forall s a z. (s -> a) -> S z s a
gets (IntSet -> Path
IS.toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Monoid a => IntMap a -> Int -> a
! Int
i) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s. Env s -> Graph
bucketE)
sizeM :: Node -> Dom s Int
sizeM :: forall s. Int -> Dom s Int
sizeM = forall z a s.
MArray (A z) a (ST z) =>
(s -> Arr z a) -> Int -> S z s a
fetch forall s. Env s -> Arr s Int
sizeE
sdnoM :: Node -> Dom s Int
sdnoM :: forall s. Int -> Dom s Int
sdnoM = forall z a s.
MArray (A z) a (ST z) =>
(s -> Arr z a) -> Int -> S z s a
fetch forall s. Env s -> Arr s Int
sdnoE
ndfsM :: Int -> Dom s Node
ndfsM :: forall s. Int -> Dom s Int
ndfsM = forall z a s.
MArray (A z) a (ST z) =>
(s -> Arr z a) -> Int -> S z s a
fetch forall s. Env s -> Arr s Int
ndfsE
childM :: Node -> Dom s Node
childM :: forall s. Int -> Dom s Int
childM = forall z a s.
MArray (A z) a (ST z) =>
(s -> Arr z a) -> Int -> S z s a
fetch forall s. Env s -> Arr s Int
childE
ancestorM :: Node -> Dom s Node
ancestorM :: forall s. Int -> Dom s Int
ancestorM = forall z a s.
MArray (A z) a (ST z) =>
(s -> Arr z a) -> Int -> S z s a
fetch forall s. Env s -> Arr s Int
ancestorE
parentM :: Node -> Dom s Node
parentM :: forall s. Int -> Dom s Int
parentM = forall z a s.
MArray (A z) a (ST z) =>
(s -> Arr z a) -> Int -> S z s a
fetch forall s. Env s -> Arr s Int
parentE
labelM :: Node -> Dom s Node
labelM :: forall s. Int -> Dom s Int
labelM = forall z a s.
MArray (A z) a (ST z) =>
(s -> Arr z a) -> Int -> S z s a
fetch forall s. Env s -> Arr s Int
labelE
nextM :: Dom s Int
nextM :: forall s. Dom s Int
nextM = do
Int
n <- forall s a z. (s -> a) -> S z s a
gets forall s. Env s -> Int
dfsE
let n' :: Int
n' = Int
nforall a. Num a => a -> a -> a
+Int
1
forall s z. (s -> s) -> S z s ()
modify(\Env s
e->Env s
e{dfsE :: Int
dfsE=Int
n'})
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 .=
(.=) :: (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 = 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 <- 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
forall (m :: * -> *) a. Monad m => a -> m a
return 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 = forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
(i, i) -> m (a i e)
unsafeNewArray_ (Int
0,Int
nforall 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 = 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 = 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
aforall 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 = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty forall a. a -> a
id (forall a. Int -> IntMap a -> Maybe a
IM.lookup Int
n IntMap a
g)
fromAdj :: [(Node, [Node])] -> Graph
fromAdj :: [(Int, Path)] -> Graph
fromAdj = forall a. [(Int, a)] -> IntMap a
IM.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (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 = forall c a.
(c -> c -> c) -> (a -> Int) -> (a -> c) -> [a] -> IntMap c
collectI IntSet -> IntSet -> IntSet
IS.union forall a b. (a, b) -> a
fst (Int -> IntSet
IS.singleton forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd)
toAdj :: Graph -> [(Node, [Node])]
toAdj :: Graph -> [(Int, Path)]
toAdj = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second IntSet -> Path
IS.toList) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IntMap a -> [(Int, a)]
IM.toList
toEdges :: Graph -> [Edge]
toEdges :: Graph -> [(Int, Int)]
toEdges = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,))) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Graph -> [(Int, Path)]
toAdj
predG :: Graph -> Graph
predG :: Graph -> Graph
predG Graph
g = 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 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. a -> b -> a
const forall a. Monoid a => a
mempty) Graph
g
go :: Graph -> Graph
go = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. (Int -> a -> b -> b) -> b -> IntMap a -> b
IM.foldrWithKey forall a. Monoid a => a
mempty (\Int
i IntSet
a Graph
m ->
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Graph
m Int
p -> forall a. (a -> a -> a) -> Int -> a -> IntMap a -> IntMap a
IM.insertWith 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
(forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty forall a. a -> a
id
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Int -> IntMap a -> Maybe a
IM.lookup Graph
g) forall a b. (a -> b) -> a -> b
$ Int
r
g2 :: Graph
g2 = forall a. [(Int, a)] -> IntMap a
IM.fromList
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (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)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter ((Int -> IntSet -> Bool
`IS.member`IntSet
is) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IntMap a -> [(Int, a)]
IM.toList 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) = forall {f :: * -> *} {b} {b}.
Functor f =>
b -> f (Tree b) -> f (b, b)
p a
i [Tree a]
xs
forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall a. Tree a -> [(a, a)]
parents [Tree a]
xs
where p :: b -> f (Tree b) -> f (b, b)
p b
i = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b c. (a -> b -> c) -> b -> a -> c
flip (,) b
i forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Tree a -> a
rootLabel)
ancestors :: Tree a -> [(a, [a])]
ancestors :: forall a. Tree a -> [(a, [a])]
ancestors = 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
iforall a. a -> [a] -> [a]
:[b]
acc
in forall {f :: * -> *} {b} {b}.
Functor f =>
b -> f (Tree b) -> f (b, b)
p [b]
acc' [Tree b]
xs forall a. [a] -> [a] -> [a]
++ 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 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b c. (a -> b -> c) -> b -> a -> c
flip (,) b
is forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = 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 = (forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. [(a, b)] -> ([a], [b])
unzip forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Tree a -> (a, [Tree a])
tip) [Tree a]
ts
in (a
a, [a]
as) forall a. 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 = forall a. a -> [Tree a] -> Tree a
Node Int
a (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Tree Int
go ((IntSet -> Path
IS.toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> IntSet
f) Int
a))
f :: Int -> IntSet
f = (Graph
g 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 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
= forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\IntMap c
m a
a -> 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) forall a. Monoid a => a
mempty
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))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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) = 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,forall a. Monoid a => a
mempty) IntSet
ss
new2 :: Graph
new2 = 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,forall a. Monoid a => a
mempty,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 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
nforall a. Num a => a -> a -> a
+Int
1,forall a. Int -> a -> IntMap a -> IntMap a
IM.insert Int
i Int
n NodeMap Int
env)
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 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 -> forall o. (a -> s -> ST z o) -> s -> ST z o
g (b -> s -> ST z o
k 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 = 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 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 -> forall o. (a -> s -> ST z o) -> s -> ST z o
g (\a
a -> 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 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
(<*>) = forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap
gets :: (s -> a) -> S z s a
gets :: forall s a z. (s -> a) -> S z s a
gets s -> a
f = 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)
modify :: (s -> s) -> S z s ()
modify :: forall s z. (s -> s) -> S z s ()
modify s -> s
f = 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 () forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> s
f)
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) = forall o. (a -> s -> ST z o) -> s -> ST z o
g ((forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
.) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> b -> a
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 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 <- forall s a z. (s -> a) -> S z s a
gets s -> Arr z a
f
forall z a s. ST z a -> S z s a
st ((Arr z a
aforall 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 <- forall s a z. (s -> a) -> S z s a
gets s -> Arr z a
f
forall z a s. ST z a -> S z s a
st (Arr z a
aforall s a. MArray (A s) a (ST s) => A s Int a -> Int -> ST s a
!:Int
i)