{-# LANGUAGE MagicHash, UnboxedTuples #-}
module Reactive.Banana.Prim.Low.Util where
import Control.Monad
import Control.Monad.IO.Class
import Data.Hashable
import Data.IORef
import Data.Maybe (catMaybes)
import Data.Unique.Really
import qualified GHC.Base as GHC
import qualified GHC.IORef as GHC
import qualified GHC.STRef as GHC
import qualified GHC.Weak as GHC
import System.Mem.Weak
debug :: MonadIO m => String -> m ()
debug :: String -> m ()
debug String
_ = () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
nop :: Monad m => m ()
nop :: m ()
nop = () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
data Ref a = Ref !(IORef a) !Unique
instance Eq (Ref a) where == :: Ref a -> Ref a -> Bool
(==) = Ref a -> Ref a -> Bool
forall a b. Ref a -> Ref b -> Bool
equalRef
instance Hashable (Ref a) where hashWithSalt :: Int -> Ref a -> Int
hashWithSalt Int
s (Ref IORef a
_ Unique
u) = Int -> Unique -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
s Unique
u
equalRef :: Ref a -> Ref b -> Bool
equalRef :: Ref a -> Ref b -> Bool
equalRef (Ref IORef a
_ Unique
a) (Ref IORef b
_ Unique
b) = Unique
a Unique -> Unique -> Bool
forall a. Eq a => a -> a -> Bool
== Unique
b
newRef :: MonadIO m => a -> m (Ref a)
newRef :: a -> m (Ref a)
newRef a
a = IO (Ref a) -> m (Ref 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
$ (IORef a -> Unique -> Ref a)
-> IO (IORef a) -> IO Unique -> IO (Ref a)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 IORef a -> Unique -> Ref a
forall a. IORef a -> Unique -> Ref a
Ref (a -> IO (IORef a)
forall a. a -> IO (IORef a)
newIORef a
a) IO Unique
newUnique
readRef :: MonadIO m => Ref a -> m a
readRef :: Ref a -> m a
readRef ~(Ref IORef a
ref Unique
_) = 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
ref
put :: MonadIO m => Ref a -> a -> m ()
put :: Ref a -> a -> m ()
put ~(Ref IORef a
ref Unique
_) = IO () -> m ()
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
ref
modify' :: MonadIO m => Ref a -> (a -> a) -> m ()
modify' :: Ref a -> (a -> a) -> m ()
modify' ~(Ref IORef a
ref Unique
_) a -> a
f = IO () -> m ()
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
ref IO a -> (a -> IO ()) -> IO ()
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
ref (a -> IO ()) -> a -> IO ()
forall a b. (a -> b) -> a -> b
$! a -> a
f a
x
mkWeakIORefValue :: IORef a -> value -> IO (Weak value)
mkWeakIORefValue :: IORef a -> value -> IO (Weak value)
mkWeakIORefValue (GHC.IORef (GHC.STRef MutVar# RealWorld a
r#)) value
val = (State# RealWorld -> (# State# RealWorld, Weak value #))
-> IO (Weak value)
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
GHC.IO ((State# RealWorld -> (# State# RealWorld, Weak value #))
-> IO (Weak value))
-> (State# RealWorld -> (# State# RealWorld, Weak value #))
-> IO (Weak value)
forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s ->
case MutVar# RealWorld a
-> value -> State# RealWorld -> (# State# RealWorld, Weak# value #)
forall a b.
a -> b -> State# RealWorld -> (# State# RealWorld, Weak# b #)
GHC.mkWeakNoFinalizer# MutVar# RealWorld a
r# value
val State# RealWorld
s of (# State# RealWorld
s1, Weak# value
w #) -> (# State# RealWorld
s1, Weak# value -> Weak value
forall v. Weak# v -> Weak v
GHC.Weak Weak# value
w #)
mkWeakRefValue :: MonadIO m => Ref a -> value -> m (Weak value)
mkWeakRefValue :: Ref a -> value -> m (Weak value)
mkWeakRefValue (Ref IORef a
ref Unique
_) value
v = IO (Weak value) -> m (Weak value)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Weak value) -> m (Weak value))
-> IO (Weak value) -> m (Weak value)
forall a b. (a -> b) -> a -> b
$ IORef a -> value -> IO (Weak value)
forall a value. IORef a -> value -> IO (Weak value)
mkWeakIORefValue IORef a
ref value
v
deRefWeaks :: [Weak v] -> IO [v]
deRefWeaks :: [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)
mapM Weak v -> IO (Maybe v)
forall v. Weak v -> IO (Maybe v)
deRefWeak [Weak v]
ws