{-# LANGUAGE MagicHash #-}
{-# LANGUAGE RecursiveDo #-}
{-# LANGUAGE UnboxedTuples #-}
module Reactive.Banana.Prim.Low.Ref
(
Ref
, getUnique
, new
, equal
, read
, put
, modify'
, addFinalizer
, getWeakRef
, WeakRef
, mkWeak
, deRefWeak
, deRefWeaks
, finalize
) where
import Prelude hiding ( read )
import Control.DeepSeq
( NFData (..) )
import Control.Monad
( void )
import Control.Monad.IO.Class
( MonadIO (liftIO) )
import Data.Hashable
( Hashable (..) )
import Data.IORef
( IORef, newIORef, readIORef, writeIORef )
import Data.Maybe
( catMaybes )
import Data.Unique.Really
( Unique, newUnique )
import qualified System.Mem.Weak as Weak
import qualified GHC.Base as GHC
import qualified GHC.IORef as GHC
import qualified GHC.STRef as GHC
import qualified GHC.Weak as GHC
data Ref a = Ref
!Unique
!(IORef a)
!(WeakRef a)
instance NFData (Ref a) where rnf :: Ref a -> ()
rnf (Ref Unique
_ IORef a
_ WeakRef a
_) = ()
instance Eq (Ref a) where == :: Ref a -> Ref a -> Bool
(==) = Ref a -> Ref a -> Bool
forall a b. Ref a -> Ref b -> Bool
equal
instance Hashable (Ref a) where hashWithSalt :: Int -> Ref a -> Int
hashWithSalt Int
s (Ref Unique
u IORef a
_ WeakRef a
_) = Int -> Unique -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
s Unique
u
getUnique :: Ref a -> Unique
getUnique :: forall a. Ref a -> Unique
getUnique (Ref Unique
u IORef a
_ WeakRef a
_) = Unique
u
getWeakRef :: Ref a -> WeakRef a
getWeakRef :: forall a. Ref a -> WeakRef a
getWeakRef (Ref Unique
_ IORef a
_ WeakRef a
w) = WeakRef a
w
equal :: Ref a -> Ref b -> Bool
equal :: forall a b. Ref a -> Ref b -> Bool
equal (Ref Unique
ua IORef a
_ WeakRef a
_) (Ref Unique
ub IORef b
_ WeakRef b
_) = Unique
ua Unique -> Unique -> Bool
forall a. Eq a => a -> a -> Bool
== Unique
ub
new :: MonadIO m => a -> m (Ref a)
new :: forall (m :: * -> *) a. MonadIO m => a -> m (Ref a)
new a
a = IO (Ref a) -> m (Ref a)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Ref a) -> m (Ref a)) -> IO (Ref a) -> m (Ref a)
forall a b. (a -> b) -> a -> b
$ mdo
IORef a
ra <- a -> IO (IORef a)
forall a. a -> IO (IORef a)
newIORef a
a
Ref a
result <- Unique -> IORef a -> WeakRef a -> Ref a
forall a. Unique -> IORef a -> WeakRef a -> Ref a
Ref (Unique -> IORef a -> WeakRef a -> Ref a)
-> IO Unique -> IO (IORef a -> WeakRef a -> Ref a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Unique
newUnique IO (IORef a -> WeakRef a -> Ref a)
-> IO (IORef a) -> IO (WeakRef a -> Ref a)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IORef a -> IO (IORef a)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure IORef a
ra IO (WeakRef a -> Ref a) -> IO (WeakRef a) -> IO (Ref a)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> WeakRef a -> IO (WeakRef a)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure WeakRef a
wa
WeakRef a
wa <- IORef a -> Ref a -> Maybe (IO ()) -> IO (WeakRef a)
forall k v. IORef k -> v -> Maybe (IO ()) -> IO (Weak v)
mkWeakIORef IORef a
ra Ref a
result Maybe (IO ())
forall a. Maybe a
Nothing
Ref a -> IO (Ref a)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Ref a
result
read :: MonadIO m => Ref a -> m a
read :: forall (m :: * -> *) a. MonadIO m => Ref a -> m a
read ~(Ref Unique
_ IORef a
r WeakRef a
_) = IO a -> m a
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> m a) -> IO a -> m a
forall a b. (a -> b) -> a -> b
$ IORef a -> IO a
forall a. IORef a -> IO a
readIORef IORef a
r
put :: MonadIO m => Ref a -> a -> m ()
put :: forall (m :: * -> *) a. MonadIO m => Ref a -> a -> m ()
put ~(Ref Unique
_ IORef a
r WeakRef a
_) = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (a -> IO ()) -> a -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IORef a -> a -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef a
r
modify' :: MonadIO m => Ref a -> (a -> a) -> m ()
modify' :: forall (m :: * -> *) a. MonadIO m => Ref a -> (a -> a) -> m ()
modify' ~(Ref Unique
_ IORef a
r WeakRef a
_) a -> a
f = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$
IORef a -> IO a
forall a. IORef a -> IO a
readIORef IORef a
r IO a -> (a -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
x -> IORef a -> a -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef a
r (a -> IO ()) -> a -> IO ()
forall a b. (a -> b) -> a -> b
$! a -> a
f a
x
addFinalizer :: Ref v -> IO () -> IO ()
addFinalizer :: forall v. Ref v -> IO () -> IO ()
addFinalizer (Ref Unique
_ IORef v
r WeakRef v
_) = IO (Weak ()) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (Weak ()) -> IO ())
-> (IO () -> IO (Weak ())) -> IO () -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IORef v -> () -> Maybe (IO ()) -> IO (Weak ())
forall k v. IORef k -> v -> Maybe (IO ()) -> IO (Weak v)
mkWeakIORef IORef v
r () (Maybe (IO ()) -> IO (Weak ()))
-> (IO () -> Maybe (IO ())) -> IO () -> IO (Weak ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO () -> Maybe (IO ())
forall a. a -> Maybe a
Just
type WeakRef v = Weak.Weak (Ref v)
mkWeak
:: Ref k
-> v
-> Maybe (IO ())
-> IO (Weak.Weak v)
mkWeak :: forall k v. Ref k -> v -> Maybe (IO ()) -> IO (Weak v)
mkWeak (Ref Unique
_ IORef k
r WeakRef k
_) = IORef k -> v -> Maybe (IO ()) -> IO (Weak v)
forall k v. IORef k -> v -> Maybe (IO ()) -> IO (Weak v)
mkWeakIORef IORef k
r
finalize :: WeakRef v -> IO ()
finalize :: forall v. WeakRef v -> IO ()
finalize = Weak (Ref v) -> IO ()
forall v. Weak v -> IO ()
Weak.finalize
deRefWeak :: Weak.Weak v -> IO (Maybe v)
deRefWeak :: forall v. Weak v -> IO (Maybe v)
deRefWeak = Weak v -> IO (Maybe v)
forall v. Weak v -> IO (Maybe v)
Weak.deRefWeak
deRefWeaks :: [Weak.Weak v] -> IO [v]
deRefWeaks :: forall v. [Weak v] -> IO [v]
deRefWeaks [Weak v]
ws = [Maybe v] -> [v]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe v] -> [v]) -> IO [Maybe v] -> IO [v]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Weak v -> IO (Maybe v)) -> [Weak v] -> IO [Maybe v]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Weak v -> IO (Maybe v)
forall v. Weak v -> IO (Maybe v)
Weak.deRefWeak [Weak v]
ws
mkWeakIORef
:: IORef k
-> v
-> Maybe (IO ())
-> IO (Weak.Weak v)
mkWeakIORef :: forall k v. IORef k -> v -> Maybe (IO ()) -> IO (Weak v)
mkWeakIORef (GHC.IORef (GHC.STRef MutVar# RealWorld k
r#)) v
v (Just (GHC.IO State# RealWorld -> (# State# RealWorld, () #)
finalizer)) =
(State# RealWorld -> (# State# RealWorld, Weak v #)) -> IO (Weak v)
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
GHC.IO ((State# RealWorld -> (# State# RealWorld, Weak v #))
-> IO (Weak v))
-> (State# RealWorld -> (# State# RealWorld, Weak v #))
-> IO (Weak v)
forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s -> case MutVar# RealWorld k
-> v
-> (State# RealWorld -> (# State# RealWorld, () #))
-> State# RealWorld
-> (# State# RealWorld, Weak# v #)
forall a b c.
a
-> b
-> (State# RealWorld -> (# State# RealWorld, c #))
-> State# RealWorld
-> (# State# RealWorld, Weak# b #)
GHC.mkWeak# MutVar# RealWorld k
r# v
v State# RealWorld -> (# State# RealWorld, () #)
finalizer State# RealWorld
s of
(# State# RealWorld
s1, Weak# v
w #) -> (# State# RealWorld
s1, Weak# v -> Weak v
forall v. Weak# v -> Weak v
GHC.Weak Weak# v
w #)
mkWeakIORef (GHC.IORef (GHC.STRef MutVar# RealWorld k
r#)) v
v Maybe (IO ())
Nothing =
(State# RealWorld -> (# State# RealWorld, Weak v #)) -> IO (Weak v)
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
GHC.IO ((State# RealWorld -> (# State# RealWorld, Weak v #))
-> IO (Weak v))
-> (State# RealWorld -> (# State# RealWorld, Weak v #))
-> IO (Weak v)
forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s -> case MutVar# RealWorld k
-> v -> State# RealWorld -> (# State# RealWorld, Weak# v #)
forall a b.
a -> b -> State# RealWorld -> (# State# RealWorld, Weak# b #)
GHC.mkWeakNoFinalizer# MutVar# RealWorld k
r# v
v State# RealWorld
s of
(# State# RealWorld
s1, Weak# v
w #) -> (# State# RealWorld
s1, Weak# v -> Weak v
forall v. Weak# v -> Weak v
GHC.Weak Weak# v
w #)