{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RecordWildCards #-}
module Reactive.Banana.Prim.Low.GraphGC
( GraphGC
, listReachableVertices
, getSize
, new
, insertEdge
, clearPredecessors
, Step (..)
, walkSuccessors
, walkSuccessors_
, removeGarbage
, printDot
) where
import Control.Applicative
( (<|>) )
import Control.Monad
( unless )
import Data.IORef
( IORef, atomicModifyIORef', newIORef, readIORef )
import Data.Maybe
( fromJust )
import Data.Unique.Really
( Unique )
import Reactive.Banana.Prim.Low.Graph
( Graph, Step )
import Reactive.Banana.Prim.Low.Ref
( Ref, WeakRef )
import qualified Control.Concurrent.STM as STM
import qualified Data.HashMap.Strict as Map
import qualified Reactive.Banana.Prim.Low.Graph as Graph
import qualified Reactive.Banana.Prim.Low.Ref as Ref
type Map = Map.HashMap
type WeakEdge v = WeakRef v
data GraphD v = GraphD
{ forall v. GraphD v -> Graph Unique (WeakEdge v)
graph :: !(Graph Unique (WeakEdge v))
, forall v. GraphD v -> Map Unique (WeakEdge v)
references :: !(Map Unique (WeakRef v))
}
data GraphGC v = GraphGC
{ forall v. GraphGC v -> IORef (GraphD v)
graphRef :: IORef (GraphD v)
, forall v. GraphGC v -> TQueue Unique
deletions :: STM.TQueue Unique
}
new :: IO (GraphGC v)
new :: forall v. IO (GraphGC v)
new = IORef (GraphD v) -> TQueue Unique -> GraphGC v
forall v. IORef (GraphD v) -> TQueue Unique -> GraphGC v
GraphGC (IORef (GraphD v) -> TQueue Unique -> GraphGC v)
-> IO (IORef (GraphD v)) -> IO (TQueue Unique -> GraphGC v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GraphD v -> IO (IORef (GraphD v))
forall a. a -> IO (IORef a)
newIORef GraphD v
forall {v}. GraphD v
newGraphD IO (TQueue Unique -> GraphGC v)
-> IO (TQueue Unique) -> IO (GraphGC v)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IO (TQueue Unique)
forall a. IO (TQueue a)
STM.newTQueueIO
where
newGraphD :: GraphD v
newGraphD = GraphD
{ graph :: Graph Unique (WeakEdge v)
graph = Graph Unique (WeakEdge v)
forall v e. Graph v e
Graph.empty
, references :: Map Unique (WeakEdge v)
references = Map Unique (WeakEdge v)
forall k v. HashMap k v
Map.empty
}
getSize :: GraphGC v -> IO Int
getSize :: forall v. GraphGC v -> IO Int
getSize GraphGC{IORef (GraphD v)
graphRef :: forall v. GraphGC v -> IORef (GraphD v)
graphRef :: IORef (GraphD v)
graphRef} = Graph Unique (WeakEdge v) -> Int
forall v e. (Eq v, Hashable v) => Graph v e -> Int
Graph.size (Graph Unique (WeakEdge v) -> Int)
-> (GraphD v -> Graph Unique (WeakEdge v)) -> GraphD v -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GraphD v -> Graph Unique (WeakEdge v)
forall v. GraphD v -> Graph Unique (WeakEdge v)
graph (GraphD v -> Int) -> IO (GraphD v) -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IORef (GraphD v) -> IO (GraphD v)
forall a. IORef a -> IO a
readIORef IORef (GraphD v)
graphRef
listReachableVertices :: GraphGC v -> IO [Ref v]
listReachableVertices :: forall v. GraphGC v -> IO [Ref v]
listReachableVertices GraphGC{IORef (GraphD v)
graphRef :: forall v. GraphGC v -> IORef (GraphD v)
graphRef :: IORef (GraphD v)
graphRef} = do
GraphD{Map Unique (WeakRef v)
references :: forall v. GraphD v -> Map Unique (WeakEdge v)
references :: Map Unique (WeakRef v)
references} <- IORef (GraphD v) -> IO (GraphD v)
forall a. IORef a -> IO a
readIORef IORef (GraphD v)
graphRef
[[Ref v]] -> [Ref v]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Ref v]] -> [Ref v])
-> (HashMap Unique [Ref v] -> [[Ref v]])
-> HashMap Unique [Ref v]
-> [Ref v]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashMap Unique [Ref v] -> [[Ref v]]
forall k v. HashMap k v -> [v]
Map.elems (HashMap Unique [Ref v] -> [Ref v])
-> IO (HashMap Unique [Ref v]) -> IO [Ref v]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (WeakRef v -> IO [Ref v])
-> Map Unique (WeakRef v) -> IO (HashMap Unique [Ref v])
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> HashMap Unique a -> f (HashMap Unique b)
traverse WeakRef v -> IO [Ref v]
forall {a}. Weak a -> IO [a]
inspect Map Unique (WeakRef v)
references
where
inspect :: Weak a -> IO [a]
inspect Weak a
ref = do
Maybe a
mv <- Weak a -> IO (Maybe a)
forall v. Weak v -> IO (Maybe v)
Ref.deRefWeak Weak a
ref
[a] -> IO [a]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([a] -> IO [a]) -> [a] -> IO [a]
forall a b. (a -> b) -> a -> b
$ case Maybe a
mv of
Maybe a
Nothing -> []
Just a
r -> [a
r]
insertEdge :: (Ref v, Ref v) -> GraphGC v -> IO ()
insertEdge :: forall v. (Ref v, Ref v) -> GraphGC v -> IO ()
insertEdge (Ref v
x,Ref v
y) g :: GraphGC v
g@GraphGC{IORef (GraphD v)
graphRef :: forall v. GraphGC v -> IORef (GraphD v)
graphRef :: IORef (GraphD v)
graphRef} = do
(Bool
xKnown, Bool
yKnown) <-
WeakEdge v -> IO (Bool, Bool)
insertTheEdge (WeakEdge v -> IO (Bool, Bool))
-> IO (WeakEdge v) -> IO (Bool, Bool)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO (WeakEdge v)
makeWeakPointerThatRepresentsEdge
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
xKnown (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Ref v -> IO () -> IO ()
forall v. Ref v -> IO () -> IO ()
Ref.addFinalizer Ref v
x (GraphGC v -> Unique -> IO ()
forall v. GraphGC v -> Unique -> IO ()
finalizeVertex GraphGC v
g Unique
ux)
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
yKnown (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Ref v -> IO () -> IO ()
forall v. Ref v -> IO () -> IO ()
Ref.addFinalizer Ref v
y (GraphGC v -> Unique -> IO ()
forall v. GraphGC v -> Unique -> IO ()
finalizeVertex GraphGC v
g Unique
uy)
where
ux :: Unique
ux = Ref v -> Unique
forall a. Ref a -> Unique
Ref.getUnique Ref v
x
uy :: Unique
uy = Ref v -> Unique
forall a. Ref a -> Unique
Ref.getUnique Ref v
y
makeWeakPointerThatRepresentsEdge :: IO (WeakEdge v)
makeWeakPointerThatRepresentsEdge =
Ref v -> Ref v -> Maybe (IO ()) -> IO (WeakEdge v)
forall k v. Ref k -> v -> Maybe (IO ()) -> IO (Weak v)
Ref.mkWeak Ref v
y Ref v
x Maybe (IO ())
forall a. Maybe a
Nothing
insertTheEdge :: WeakEdge v -> IO (Bool, Bool)
insertTheEdge WeakEdge v
we = IORef (GraphD v)
-> (GraphD v -> (GraphD v, (Bool, Bool))) -> IO (Bool, Bool)
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef (GraphD v)
graphRef ((GraphD v -> (GraphD v, (Bool, Bool))) -> IO (Bool, Bool))
-> (GraphD v -> (GraphD v, (Bool, Bool))) -> IO (Bool, Bool)
forall a b. (a -> b) -> a -> b
$
\GraphD{Graph Unique (WeakEdge v)
graph :: forall v. GraphD v -> Graph Unique (WeakEdge v)
graph :: Graph Unique (WeakEdge v)
graph,Map Unique (WeakEdge v)
references :: forall v. GraphD v -> Map Unique (WeakEdge v)
references :: Map Unique (WeakEdge v)
references} ->
( GraphD
{ graph :: Graph Unique (WeakEdge v)
graph
= (Unique, Unique)
-> WeakEdge v
-> Graph Unique (WeakEdge v)
-> Graph Unique (WeakEdge v)
forall v e.
(Eq v, Hashable v) =>
(v, v) -> e -> Graph v e -> Graph v e
Graph.insertEdge (Unique
ux,Unique
uy) WeakEdge v
we
(Graph Unique (WeakEdge v) -> Graph Unique (WeakEdge v))
-> Graph Unique (WeakEdge v) -> Graph Unique (WeakEdge v)
forall a b. (a -> b) -> a -> b
$ Graph Unique (WeakEdge v)
graph
, references :: Map Unique (WeakEdge v)
references
= Unique
-> WeakEdge v -> Map Unique (WeakEdge v) -> Map Unique (WeakEdge v)
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
Map.insert Unique
ux (Ref v -> WeakEdge v
forall a. Ref a -> WeakRef a
Ref.getWeakRef Ref v
x)
(Map Unique (WeakEdge v) -> Map Unique (WeakEdge v))
-> (Map Unique (WeakEdge v) -> Map Unique (WeakEdge v))
-> Map Unique (WeakEdge v)
-> Map Unique (WeakEdge v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Unique
-> WeakEdge v -> Map Unique (WeakEdge v) -> Map Unique (WeakEdge v)
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
Map.insert Unique
uy (Ref v -> WeakEdge v
forall a. Ref a -> WeakRef a
Ref.getWeakRef Ref v
y)
(Map Unique (WeakEdge v) -> Map Unique (WeakEdge v))
-> Map Unique (WeakEdge v) -> Map Unique (WeakEdge v)
forall a b. (a -> b) -> a -> b
$ Map Unique (WeakEdge v)
references
}
, ( Unique
ux Unique -> Map Unique (WeakEdge v) -> Bool
forall k a. (Eq k, Hashable k) => k -> HashMap k a -> Bool
`Map.member` Map Unique (WeakEdge v)
references
, Unique
uy Unique -> Map Unique (WeakEdge v) -> Bool
forall k a. (Eq k, Hashable k) => k -> HashMap k a -> Bool
`Map.member` Map Unique (WeakEdge v)
references
)
)
clearPredecessors :: Ref v -> GraphGC v -> IO ()
clearPredecessors :: forall v. Ref v -> GraphGC v -> IO ()
clearPredecessors Ref v
x GraphGC{IORef (GraphD v)
graphRef :: forall v. GraphGC v -> IORef (GraphD v)
graphRef :: IORef (GraphD v)
graphRef} = do
GraphD v
g <- IORef (GraphD v)
-> (GraphD v -> (GraphD v, GraphD v)) -> IO (GraphD v)
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef (GraphD v)
graphRef ((GraphD v -> (GraphD v, GraphD v)) -> IO (GraphD v))
-> (GraphD v -> (GraphD v, GraphD v)) -> IO (GraphD v)
forall a b. (a -> b) -> a -> b
$ \GraphD v
g -> (GraphD v -> GraphD v
forall {v}. GraphD v -> GraphD v
removeIncomingEdges GraphD v
g, GraphD v
g)
GraphD v -> IO ()
forall {v}. GraphD v -> IO ()
finalizeIncomingEdges GraphD v
g
where
removeIncomingEdges :: GraphD v -> GraphD v
removeIncomingEdges g :: GraphD v
g@GraphD{Graph Unique (WeakEdge v)
graph :: forall v. GraphD v -> Graph Unique (WeakEdge v)
graph :: Graph Unique (WeakEdge v)
graph} =
GraphD v
g{ graph = Graph.clearPredecessors (Ref.getUnique x) graph }
finalizeIncomingEdges :: GraphD v -> IO ()
finalizeIncomingEdges GraphD{Graph Unique (WeakEdge v)
graph :: forall v. GraphD v -> Graph Unique (WeakEdge v)
graph :: Graph Unique (WeakEdge v)
graph} =
((Unique, WeakEdge v) -> IO ()) -> [(Unique, WeakEdge v)] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (WeakEdge v -> IO ()
forall v. WeakRef v -> IO ()
Ref.finalize (WeakEdge v -> IO ())
-> ((Unique, WeakEdge v) -> WeakEdge v)
-> (Unique, WeakEdge v)
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Unique, WeakEdge v) -> WeakEdge v
forall a b. (a, b) -> b
snd) ([(Unique, WeakEdge v)] -> IO ())
-> (Unique -> [(Unique, WeakEdge v)]) -> Unique -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Graph Unique (WeakEdge v) -> Unique -> [(Unique, WeakEdge v)]
forall v e. (Eq v, Hashable v) => Graph v e -> v -> [(v, e)]
Graph.getIncoming Graph Unique (WeakEdge v)
graph (Unique -> IO ()) -> Unique -> IO ()
forall a b. (a -> b) -> a -> b
$ Ref v -> Unique
forall a. Ref a -> Unique
Ref.getUnique Ref v
x
walkSuccessors
:: Monad m
=> [Ref v] -> (WeakRef v -> m Step) -> GraphGC v -> IO (m [WeakRef v])
walkSuccessors :: forall (m :: * -> *) v.
Monad m =>
[Ref v] -> (WeakRef v -> m Step) -> GraphGC v -> IO (m [WeakRef v])
walkSuccessors [Ref v]
roots WeakRef v -> m Step
step GraphGC{IORef (GraphD v)
TQueue Unique
graphRef :: forall v. GraphGC v -> IORef (GraphD v)
deletions :: forall v. GraphGC v -> TQueue Unique
graphRef :: IORef (GraphD v)
deletions :: TQueue Unique
..} = do
GraphD{Graph Unique (WeakRef v)
graph :: forall v. GraphD v -> Graph Unique (WeakEdge v)
graph :: Graph Unique (WeakRef v)
graph,Map Unique (WeakRef v)
references :: forall v. GraphD v -> Map Unique (WeakEdge v)
references :: Map Unique (WeakRef v)
references} <- IORef (GraphD v) -> IO (GraphD v)
forall a. IORef a -> IO a
readIORef IORef (GraphD v)
graphRef
let rootsMap :: Map Unique (WeakRef v)
rootsMap = [(Unique, WeakRef v)] -> Map Unique (WeakRef v)
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
Map.fromList
[ (Ref v -> Unique
forall a. Ref a -> Unique
Ref.getUnique Ref v
r, Ref v -> WeakRef v
forall a. Ref a -> WeakRef a
Ref.getWeakRef Ref v
r) | Ref v
r <- [Ref v]
roots ]
fromUnique :: Unique -> WeakRef v
fromUnique Unique
u = Maybe (WeakRef v) -> WeakRef v
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (WeakRef v) -> WeakRef v) -> Maybe (WeakRef v) -> WeakRef v
forall a b. (a -> b) -> a -> b
$
Unique -> Map Unique (WeakRef v) -> Maybe (WeakRef v)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
Map.lookup Unique
u Map Unique (WeakRef v)
references Maybe (WeakRef v) -> Maybe (WeakRef v) -> Maybe (WeakRef v)
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Unique -> Map Unique (WeakRef v) -> Maybe (WeakRef v)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
Map.lookup Unique
u Map Unique (WeakRef v)
rootsMap
m [WeakRef v] -> IO (m [WeakRef v])
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
(m [WeakRef v] -> IO (m [WeakRef v]))
-> (Graph Unique (WeakRef v) -> m [WeakRef v])
-> Graph Unique (WeakRef v)
-> IO (m [WeakRef v])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Unique] -> [WeakRef v]) -> m [Unique] -> m [WeakRef v]
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Unique -> WeakRef v) -> [Unique] -> [WeakRef v]
forall a b. (a -> b) -> [a] -> [b]
map Unique -> WeakRef v
fromUnique)
(m [Unique] -> m [WeakRef v])
-> (Graph Unique (WeakRef v) -> m [Unique])
-> Graph Unique (WeakRef v)
-> m [WeakRef v]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Unique]
-> (Unique -> m Step) -> Graph Unique (WeakRef v) -> m [Unique]
forall v e (m :: * -> *).
(Monad m, Eq v, Hashable v) =>
[v] -> (v -> m Step) -> Graph v e -> m [v]
Graph.walkSuccessors ((Ref v -> Unique) -> [Ref v] -> [Unique]
forall a b. (a -> b) -> [a] -> [b]
map Ref v -> Unique
forall a. Ref a -> Unique
Ref.getUnique [Ref v]
roots) (WeakRef v -> m Step
step (WeakRef v -> m Step) -> (Unique -> WeakRef v) -> Unique -> m Step
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Unique -> WeakRef v
fromUnique)
(Graph Unique (WeakRef v) -> IO (m [WeakRef v]))
-> Graph Unique (WeakRef v) -> IO (m [WeakRef v])
forall a b. (a -> b) -> a -> b
$ Graph Unique (WeakRef v)
graph
walkSuccessors_ ::
Monad m => [Ref v] -> (WeakRef v -> m Step) -> GraphGC v -> IO (m ())
walkSuccessors_ :: forall (m :: * -> *) v.
Monad m =>
[Ref v] -> (WeakRef v -> m Step) -> GraphGC v -> IO (m ())
walkSuccessors_ [Ref v]
roots WeakRef v -> m Step
step GraphGC v
g = do
m [WeakRef v]
action <- [Ref v] -> (WeakRef v -> m Step) -> GraphGC v -> IO (m [WeakRef v])
forall (m :: * -> *) v.
Monad m =>
[Ref v] -> (WeakRef v -> m Step) -> GraphGC v -> IO (m [WeakRef v])
walkSuccessors [Ref v]
roots WeakRef v -> m Step
step GraphGC v
g
m () -> IO (m ())
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (m () -> IO (m ())) -> m () -> IO (m ())
forall a b. (a -> b) -> a -> b
$ m [WeakRef v]
action m [WeakRef v] -> m () -> m ()
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
removeGarbage :: GraphGC v -> IO ()
removeGarbage :: forall v. GraphGC v -> IO ()
removeGarbage g :: GraphGC v
g@GraphGC{TQueue Unique
deletions :: forall v. GraphGC v -> TQueue Unique
deletions :: TQueue Unique
deletions} = do
[Unique]
xs <- STM [Unique] -> IO [Unique]
forall a. STM a -> IO a
STM.atomically (STM [Unique] -> IO [Unique]) -> STM [Unique] -> IO [Unique]
forall a b. (a -> b) -> a -> b
$ TQueue Unique -> STM [Unique]
forall a. TQueue a -> STM [a]
STM.flushTQueue TQueue Unique
deletions
(Unique -> IO ()) -> [Unique] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (GraphGC v -> Unique -> IO ()
forall v. GraphGC v -> Unique -> IO ()
deleteVertex GraphGC v
g) [Unique]
xs
deleteVertex :: GraphGC v -> Unique -> IO ()
deleteVertex :: forall v. GraphGC v -> Unique -> IO ()
deleteVertex GraphGC{IORef (GraphD v)
graphRef :: forall v. GraphGC v -> IORef (GraphD v)
graphRef :: IORef (GraphD v)
graphRef} Unique
x =
IORef (GraphD v) -> (GraphD v -> GraphD v) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
atomicModifyIORef'_ IORef (GraphD v)
graphRef ((GraphD v -> GraphD v) -> IO ())
-> (GraphD v -> GraphD v) -> IO ()
forall a b. (a -> b) -> a -> b
$ \GraphD{Graph Unique (WeakEdge v)
graph :: forall v. GraphD v -> Graph Unique (WeakEdge v)
graph :: Graph Unique (WeakEdge v)
graph,Map Unique (WeakEdge v)
references :: forall v. GraphD v -> Map Unique (WeakEdge v)
references :: Map Unique (WeakEdge v)
references} -> GraphD
{ graph :: Graph Unique (WeakEdge v)
graph = Unique -> Graph Unique (WeakEdge v) -> Graph Unique (WeakEdge v)
forall v e. (Eq v, Hashable v) => v -> Graph v e -> Graph v e
Graph.deleteVertex Unique
x Graph Unique (WeakEdge v)
graph
, references :: Map Unique (WeakEdge v)
references = Unique -> Map Unique (WeakEdge v) -> Map Unique (WeakEdge v)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> HashMap k v
Map.delete Unique
x Map Unique (WeakEdge v)
references
}
finalizeVertex :: GraphGC v -> Unique -> IO ()
finalizeVertex :: forall v. GraphGC v -> Unique -> IO ()
finalizeVertex GraphGC{TQueue Unique
deletions :: forall v. GraphGC v -> TQueue Unique
deletions :: TQueue Unique
deletions} =
STM () -> IO ()
forall a. STM a -> IO a
STM.atomically (STM () -> IO ()) -> (Unique -> STM ()) -> Unique -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TQueue Unique -> Unique -> STM ()
forall a. TQueue a -> a -> STM ()
STM.writeTQueue TQueue Unique
deletions
printDot :: (Unique -> WeakRef v -> IO String) -> GraphGC v -> IO String
printDot :: forall v.
(Unique -> WeakRef v -> IO String) -> GraphGC v -> IO String
printDot Unique -> WeakRef v -> IO String
format GraphGC{IORef (GraphD v)
graphRef :: forall v. GraphGC v -> IORef (GraphD v)
graphRef :: IORef (GraphD v)
graphRef} = do
GraphD{Graph Unique (WeakRef v)
graph :: forall v. GraphD v -> Graph Unique (WeakEdge v)
graph :: Graph Unique (WeakRef v)
graph,Map Unique (WeakRef v)
references :: forall v. GraphD v -> Map Unique (WeakEdge v)
references :: Map Unique (WeakRef v)
references} <- IORef (GraphD v) -> IO (GraphD v)
forall a. IORef a -> IO a
readIORef IORef (GraphD v)
graphRef
HashMap Unique String
strings <- (Unique -> WeakRef v -> IO String)
-> Map Unique (WeakRef v) -> IO (HashMap Unique String)
forall (f :: * -> *) k v1 v2.
Applicative f =>
(k -> v1 -> f v2) -> HashMap k v1 -> f (HashMap k v2)
Map.traverseWithKey Unique -> WeakRef v -> IO String
format Map Unique (WeakRef v)
references
String -> IO String
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ (Unique -> String) -> Graph Unique (WeakRef v) -> String
forall v e.
(Eq v, Hashable v) =>
(v -> String) -> Graph v e -> String
Graph.showDot (HashMap Unique String
strings HashMap Unique String -> Unique -> String
forall k v.
(Eq k, Hashable k, HasCallStack) =>
HashMap k v -> k -> v
Map.!) Graph Unique (WeakRef v)
graph
atomicModifyIORef'_ :: IORef a -> (a -> a) -> IO ()
atomicModifyIORef'_ :: forall a. IORef a -> (a -> a) -> IO ()
atomicModifyIORef'_ IORef a
ref a -> a
f = IORef a -> (a -> (a, ())) -> IO ()
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef a
ref ((a -> (a, ())) -> IO ()) -> (a -> (a, ())) -> IO ()
forall a b. (a -> b) -> a -> b
$ \a
x -> (a -> a
f a
x, ())