{-# LANGUAGE CPP #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# OPTIONS_HADDOCK not-home #-}
module Control.Concurrent.RCU.GC.Internal
( SRef(..)
, RCUThread(..)
, RCU(..)
, runRCU
, runOnRCU
, ReadingRCU(..)
, WritingRCU(..)
, RCUState(..)
#if BENCHMARKS
, unRCU
, runWritingRCU
, runReadingRCU
, writeSRefIO
#endif
) where
import Control.Applicative
import Control.Concurrent
import Control.Concurrent.RCU.Class
import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.Primitive
import Control.Parallel
import Data.Atomics
import Data.IORef
import qualified Data.List as L
import Data.Primitive
import Prelude hiding (Read(..))
import System.Mem
import qualified Control.Monad.Fail as Fail
newtype SRef s a = SRef { forall s a. SRef s a -> IORef a
unSRef :: IORef a }
deriving SRef s a -> SRef s a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall s a. SRef s a -> SRef s a -> Bool
/= :: SRef s a -> SRef s a -> Bool
$c/= :: forall s a. SRef s a -> SRef s a -> Bool
== :: SRef s a -> SRef s a -> Bool
$c== :: forall s a. SRef s a -> SRef s a -> Bool
Eq
newSRefIO :: a -> IO (IORef a)
newSRefIO :: forall a. a -> IO (IORef a)
newSRefIO = forall a. a -> IO (IORef a)
newIORef
{-# INLINE newSRefIO #-}
readSRefIO :: IORef a -> IO a
readSRefIO :: forall a. IORef a -> IO a
readSRefIO = forall a. IORef a -> IO a
readIORef
{-# INLINE readSRefIO #-}
writeSRefIO :: IORef a -> a -> IO ()
writeSRefIO :: forall a. IORef a -> a -> IO ()
writeSRefIO IORef a
r a
a = do a
a forall a b. a -> b -> b
`pseq` IO ()
writeBarrier
forall a. IORef a -> a -> IO ()
writeIORef IORef a
r a
a
{-# INLINE writeSRefIO #-}
newtype Counter = Counter (MutableByteArray RealWorld)
instance Eq Counter where
Counter MutableByteArray RealWorld
m == :: Counter -> Counter -> Bool
== Counter MutableByteArray RealWorld
n = forall s. MutableByteArray s -> MutableByteArray s -> Bool
sameMutableByteArray MutableByteArray RealWorld
m MutableByteArray RealWorld
n
newCounter :: Int -> IO Counter
newCounter :: Int -> IO Counter
newCounter Int
w = do
MutableByteArray RealWorld
b <- forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
newByteArray Int
8
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
writeByteArray MutableByteArray RealWorld
b Int
0 Int
w
forall (m :: * -> *) a. Monad m => a -> m a
return (MutableByteArray RealWorld -> Counter
Counter MutableByteArray RealWorld
b)
{-# INLINE newCounter #-}
readCounter :: Counter -> IO Int
readCounter :: Counter -> IO Int
readCounter (Counter MutableByteArray RealWorld
c) = forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> m a
readByteArray MutableByteArray RealWorld
c Int
0
{-# INLINE readCounter #-}
writeCounter :: Counter -> Int -> IO ()
writeCounter :: Counter -> Int -> IO ()
writeCounter (Counter MutableByteArray RealWorld
c) Int
w = forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
writeByteArray MutableByteArray RealWorld
c Int
0 Int
w
{-# INLINE writeCounter #-}
incCounter :: Counter -> IO Int
incCounter :: Counter -> IO Int
incCounter (Counter MutableByteArray RealWorld
c) = do
Int
x <- MutableByteArray RealWorld -> Int -> Int -> IO Int
fetchAddIntArray MutableByteArray RealWorld
c Int
0 Int
1
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! Int
x forall a. Num a => a -> a -> a
+ Int
1
{-# INLINE incCounter #-}
newtype Version = Version (IORef ())
newVersion :: IO Version
newVersion :: IO Version
newVersion = IORef () -> Version
Version forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. a -> IO (IORef a)
newIORef ()
data RCUState = RCUState
{
RCUState -> Counter
rcuStateGlobalCounter :: {-# UNPACK #-} !Counter
, RCUState -> IORef Version
rcuStateGlobalVersion :: {-# UNPACK #-} !(IORef Version)
, RCUState -> MVar [Counter]
rcuStateThreadCountersV :: {-# UNPACK #-} !(MVar [Counter])
, RCUState -> MVar ()
rcuStateWriterLockV :: {-# UNPACK #-} !(MVar ())
, RCUState -> Counter
rcuStateMyCounter :: {-# UNPACK #-} !Counter
, RCUState -> Maybe Int
rcuStatePinned :: !(Maybe Int)
}
newtype ReadingRCU s a = ReadingRCU { forall s a. ReadingRCU s a -> RCUState -> IO a
runReadingRCU :: RCUState -> IO a }
deriving forall a b. a -> ReadingRCU s b -> ReadingRCU s a
forall a b. (a -> b) -> ReadingRCU s a -> ReadingRCU s b
forall s a b. a -> ReadingRCU s b -> ReadingRCU s a
forall s a b. (a -> b) -> ReadingRCU s a -> ReadingRCU s b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> ReadingRCU s b -> ReadingRCU s a
$c<$ :: forall s a b. a -> ReadingRCU s b -> ReadingRCU s a
fmap :: forall a b. (a -> b) -> ReadingRCU s a -> ReadingRCU s b
$cfmap :: forall s a b. (a -> b) -> ReadingRCU s a -> ReadingRCU s b
Functor
instance Applicative (ReadingRCU s) where
pure :: forall a. a -> ReadingRCU s a
pure a
a = forall s a. (RCUState -> IO a) -> ReadingRCU s a
ReadingRCU forall a b. (a -> b) -> a -> b
$ \ RCUState
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
ReadingRCU RCUState -> IO (a -> b)
mf <*> :: forall a b.
ReadingRCU s (a -> b) -> ReadingRCU s a -> ReadingRCU s b
<*> ReadingRCU RCUState -> IO a
ma = forall s a. (RCUState -> IO a) -> ReadingRCU s a
ReadingRCU forall a b. (a -> b) -> a -> b
$ \ RCUState
s -> RCUState -> IO (a -> b)
mf RCUState
s forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RCUState -> IO a
ma RCUState
s
instance Monad (ReadingRCU s) where
ReadingRCU RCUState -> IO a
m >>= :: forall a b.
ReadingRCU s a -> (a -> ReadingRCU s b) -> ReadingRCU s b
>>= a -> ReadingRCU s b
f = forall s a. (RCUState -> IO a) -> ReadingRCU s a
ReadingRCU forall a b. (a -> b) -> a -> b
$ \ RCUState
s -> do
a
a <- RCUState -> IO a
m RCUState
s
forall s a. ReadingRCU s a -> RCUState -> IO a
runReadingRCU (a -> ReadingRCU s b
f a
a) RCUState
s
#if !(MIN_VERSION_base(4,11,0))
return a = ReadingRCU $ \ _ -> pure a
#endif
#if !(MIN_VERSION_base(4,13,0))
fail = Fail.fail
#endif
instance Fail.MonadFail (ReadingRCU s) where
fail :: forall a. String -> ReadingRCU s a
fail String
s = forall s a. (RCUState -> IO a) -> ReadingRCU s a
ReadingRCU forall a b. (a -> b) -> a -> b
$ \ RCUState
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
Fail.fail String
s
instance Alternative (ReadingRCU s) where
empty :: forall a. ReadingRCU s a
empty = forall s a. (RCUState -> IO a) -> ReadingRCU s a
ReadingRCU forall a b. (a -> b) -> a -> b
$ \ RCUState
_ -> forall (f :: * -> *) a. Alternative f => f a
empty
ReadingRCU RCUState -> IO a
ma <|> :: forall a. ReadingRCU s a -> ReadingRCU s a -> ReadingRCU s a
<|> ReadingRCU RCUState -> IO a
mb = forall s a. (RCUState -> IO a) -> ReadingRCU s a
ReadingRCU forall a b. (a -> b) -> a -> b
$ \RCUState
s -> RCUState -> IO a
ma RCUState
s forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> RCUState -> IO a
mb RCUState
s
instance MonadPlus (ReadingRCU s) where
mzero :: forall a. ReadingRCU s a
mzero = forall s a. (RCUState -> IO a) -> ReadingRCU s a
ReadingRCU forall a b. (a -> b) -> a -> b
$ \ RCUState
_ -> forall (m :: * -> *) a. MonadPlus m => m a
mzero
ReadingRCU RCUState -> IO a
ma mplus :: forall a. ReadingRCU s a -> ReadingRCU s a -> ReadingRCU s a
`mplus` ReadingRCU RCUState -> IO a
mb = forall s a. (RCUState -> IO a) -> ReadingRCU s a
ReadingRCU forall a b. (a -> b) -> a -> b
$ \RCUState
s -> RCUState -> IO a
ma RCUState
s forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` RCUState -> IO a
mb RCUState
s
instance MonadNew (SRef s) (ReadingRCU s) where
newSRef :: forall a. a -> ReadingRCU s (SRef s a)
newSRef a
a = forall s a. (RCUState -> IO a) -> ReadingRCU s a
ReadingRCU forall a b. (a -> b) -> a -> b
$ \RCUState
_ -> forall s a. IORef a -> SRef s a
SRef forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. a -> IO (IORef a)
newSRefIO a
a
instance MonadReading (SRef s) (ReadingRCU s) where
readSRef :: forall a. SRef s a -> ReadingRCU s a
readSRef (SRef IORef a
r) = forall s a. (RCUState -> IO a) -> ReadingRCU s a
ReadingRCU forall a b. (a -> b) -> a -> b
$ \ RCUState
_ -> forall a. IORef a -> IO a
readSRefIO IORef a
r
{-# INLINE readSRef #-}
newtype WritingRCU s a = WritingRCU { forall s a. WritingRCU s a -> RCUState -> IO a
runWritingRCU :: RCUState -> IO a }
deriving forall a b. a -> WritingRCU s b -> WritingRCU s a
forall a b. (a -> b) -> WritingRCU s a -> WritingRCU s b
forall s a b. a -> WritingRCU s b -> WritingRCU s a
forall s a b. (a -> b) -> WritingRCU s a -> WritingRCU s b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> WritingRCU s b -> WritingRCU s a
$c<$ :: forall s a b. a -> WritingRCU s b -> WritingRCU s a
fmap :: forall a b. (a -> b) -> WritingRCU s a -> WritingRCU s b
$cfmap :: forall s a b. (a -> b) -> WritingRCU s a -> WritingRCU s b
Functor
instance Applicative (WritingRCU s) where
pure :: forall a. a -> WritingRCU s a
pure a
a = forall s a. (RCUState -> IO a) -> WritingRCU s a
WritingRCU forall a b. (a -> b) -> a -> b
$ \ RCUState
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
WritingRCU RCUState -> IO (a -> b)
mf <*> :: forall a b.
WritingRCU s (a -> b) -> WritingRCU s a -> WritingRCU s b
<*> WritingRCU RCUState -> IO a
ma = forall s a. (RCUState -> IO a) -> WritingRCU s a
WritingRCU forall a b. (a -> b) -> a -> b
$ \ RCUState
s -> RCUState -> IO (a -> b)
mf RCUState
s forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RCUState -> IO a
ma RCUState
s
instance Monad (WritingRCU s) where
WritingRCU RCUState -> IO a
m >>= :: forall a b.
WritingRCU s a -> (a -> WritingRCU s b) -> WritingRCU s b
>>= a -> WritingRCU s b
f = forall s a. (RCUState -> IO a) -> WritingRCU s a
WritingRCU forall a b. (a -> b) -> a -> b
$ \ RCUState
s -> do
a
a <- RCUState -> IO a
m RCUState
s
forall s a. WritingRCU s a -> RCUState -> IO a
runWritingRCU (a -> WritingRCU s b
f a
a) RCUState
s
#if !(MIN_VERSION_base(4,11,0))
return a = WritingRCU $ \ _ -> pure a
#endif
#if !(MIN_VERSION_base(4,13,0))
fail = Fail.fail
#endif
instance Fail.MonadFail (WritingRCU s) where
fail :: forall a. String -> WritingRCU s a
fail String
s = forall s a. (RCUState -> IO a) -> WritingRCU s a
WritingRCU forall a b. (a -> b) -> a -> b
$ \ RCUState
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
Fail.fail String
s
instance Alternative (WritingRCU s) where
empty :: forall a. WritingRCU s a
empty = forall s a. (RCUState -> IO a) -> WritingRCU s a
WritingRCU forall a b. (a -> b) -> a -> b
$ \ RCUState
_ -> forall (f :: * -> *) a. Alternative f => f a
empty
WritingRCU RCUState -> IO a
ma <|> :: forall a. WritingRCU s a -> WritingRCU s a -> WritingRCU s a
<|> WritingRCU RCUState -> IO a
mb = forall s a. (RCUState -> IO a) -> WritingRCU s a
WritingRCU forall a b. (a -> b) -> a -> b
$ \RCUState
s -> RCUState -> IO a
ma RCUState
s forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> RCUState -> IO a
mb RCUState
s
instance MonadPlus (WritingRCU s) where
mzero :: forall a. WritingRCU s a
mzero = forall s a. (RCUState -> IO a) -> WritingRCU s a
WritingRCU forall a b. (a -> b) -> a -> b
$ \ RCUState
_ -> forall (m :: * -> *) a. MonadPlus m => m a
mzero
WritingRCU RCUState -> IO a
ma mplus :: forall a. WritingRCU s a -> WritingRCU s a -> WritingRCU s a
`mplus` WritingRCU RCUState -> IO a
mb = forall s a. (RCUState -> IO a) -> WritingRCU s a
WritingRCU forall a b. (a -> b) -> a -> b
$ \RCUState
s -> RCUState -> IO a
ma RCUState
s forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` RCUState -> IO a
mb RCUState
s
instance MonadNew (SRef s) (WritingRCU s) where
newSRef :: forall a. a -> WritingRCU s (SRef s a)
newSRef a
a = forall s a. (RCUState -> IO a) -> WritingRCU s a
WritingRCU forall a b. (a -> b) -> a -> b
$ \RCUState
_ -> forall s a. IORef a -> SRef s a
SRef forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. a -> IO (IORef a)
newSRefIO a
a
instance MonadReading (SRef s) (WritingRCU s) where
readSRef :: forall a. SRef s a -> WritingRCU s a
readSRef (SRef IORef a
r) = forall s a. (RCUState -> IO a) -> WritingRCU s a
WritingRCU forall a b. (a -> b) -> a -> b
$ \ RCUState
_ -> forall a. IORef a -> IO a
readSRefIO IORef a
r
{-# INLINE readSRef #-}
instance MonadWriting (SRef s) (WritingRCU s) where
writeSRef :: forall a. SRef s a -> a -> WritingRCU s ()
writeSRef (SRef IORef a
r) a
a = forall s a. (RCUState -> IO a) -> WritingRCU s a
WritingRCU forall a b. (a -> b) -> a -> b
$ \ RCUState
_ -> forall a. IORef a -> a -> IO ()
writeSRefIO IORef a
r a
a
{-# INLINE writeSRef #-}
synchronize :: WritingRCU s ()
synchronize = forall s a. (RCUState -> IO a) -> WritingRCU s a
WritingRCU RCUState -> IO ()
synchronizeIO
synchronizeIO :: RCUState -> IO ()
synchronizeIO :: RCUState -> IO ()
synchronizeIO RCUState
s = do
forall a b. MVar a -> (a -> IO b) -> IO b
withMVar (RCUState -> MVar [Counter]
rcuStateThreadCountersV RCUState
s) forall a b. (a -> b) -> a -> b
$ \ [Counter]
threadCounters -> do
Int
gc' <- Counter -> IO Int
incCounter (RCUState -> Counter
rcuStateGlobalCounter RCUState
s)
Counter -> Int -> IO ()
writeCounter (RCUState -> Counter
rcuStateMyCounter RCUState
s) Int
gc'
let waitForThreads :: Int -> [Counter] -> IO Bool
waitForThreads Int
i xxs :: [Counter]
xxs@(Counter
x:[Counter]
xs)
| Int
i forall a. Ord a => a -> a -> Bool
> Int
2000 = forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
| Bool
otherwise = do
Int
tc <- Counter -> IO Int
readCounter Counter
x
if Int
tc forall a. Eq a => a -> a -> Bool
== Int
gc' then Int -> [Counter] -> IO Bool
waitForThreads (Int
i forall a. Num a => a -> a -> a
+ Int
1) [Counter]
xs
else do
Int -> IO ()
threadDelay Int
1
Int -> [Counter] -> IO Bool
waitForThreads (Int
i forall a. Num a => a -> a -> a
+ Int
1) [Counter]
xxs
waitForThreads Int
_ [] = forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
Bool
bad <- Int -> [Counter] -> IO Bool
waitForThreads (Int
0 :: Int) [Counter]
threadCounters
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
bad forall a b. (a -> b) -> a -> b
$ do
MVar ()
m <- forall a. IO (MVar a)
newEmptyMVar
RCUState -> MVar () -> IO ()
stuff RCUState
s MVar ()
m
IO ()
performMinorGC
MVar () -> IO ()
sitAndSpin MVar ()
m
IO ()
storeLoadBarrier
stuff :: RCUState -> MVar () -> IO ()
stuff :: RCUState -> MVar () -> IO ()
stuff RCUState
s MVar ()
m = do
Version IORef ()
v <- forall a. IORef a -> IO a
readIORef (RCUState -> IORef Version
rcuStateGlobalVersion RCUState
s)
Version
v' <- IO Version
newVersion
forall a. IORef a -> a -> IO ()
atomicWriteIORef (RCUState -> IORef Version
rcuStateGlobalVersion RCUState
s) Version
v'
Weak (IORef ())
_ <- forall a. IORef a -> IO () -> IO (Weak (IORef a))
mkWeakIORef IORef ()
v forall a b. (a -> b) -> a -> b
$ forall a. MVar a -> a -> IO ()
putMVar MVar ()
m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
{-# NOINLINE stuff #-}
sitAndSpin :: MVar () -> IO ()
sitAndSpin :: MVar () -> IO ()
sitAndSpin MVar ()
m = forall a. MVar a -> IO (Maybe a)
tryTakeMVar MVar ()
m forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Just () -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
Maybe ()
Nothing -> do
IO ()
performMajorGC
MVar () -> IO ()
sitAndSpin MVar ()
m
newtype RCU s a = RCU { forall s a. RCU s a -> RCUState -> IO a
unRCU :: RCUState -> IO a }
deriving forall a b. a -> RCU s b -> RCU s a
forall a b. (a -> b) -> RCU s a -> RCU s b
forall s a b. a -> RCU s b -> RCU s a
forall s a b. (a -> b) -> RCU s a -> RCU s b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> RCU s b -> RCU s a
$c<$ :: forall s a b. a -> RCU s b -> RCU s a
fmap :: forall a b. (a -> b) -> RCU s a -> RCU s b
$cfmap :: forall s a b. (a -> b) -> RCU s a -> RCU s b
Functor
instance Applicative (RCU s) where
pure :: forall a. a -> RCU s a
pure a
a = forall s a. (RCUState -> IO a) -> RCU s a
RCU forall a b. (a -> b) -> a -> b
$ \ RCUState
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return a
a
<*> :: forall a b. RCU s (a -> b) -> RCU s a -> RCU s b
(<*>) = forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap
instance Monad (RCU s) where
#if !(MIN_VERSION_base(4,11,0))
return a = RCU $ \ _ -> return a
#endif
RCU RCUState -> IO a
m >>= :: forall a b. RCU s a -> (a -> RCU s b) -> RCU s b
>>= a -> RCU s b
f = forall s a. (RCUState -> IO a) -> RCU s a
RCU forall a b. (a -> b) -> a -> b
$ \RCUState
s -> do
a
a <- RCUState -> IO a
m RCUState
s
forall s a. RCU s a -> RCUState -> IO a
unRCU (a -> RCU s b
f a
a) RCUState
s
instance MonadNew (SRef s) (RCU s) where
newSRef :: forall a. a -> RCU s (SRef s a)
newSRef a
a = forall s a. (RCUState -> IO a) -> RCU s a
RCU forall a b. (a -> b) -> a -> b
$ \RCUState
_ -> forall s a. IORef a -> SRef s a
SRef forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. a -> IO (IORef a)
newSRefIO a
a
data RCUThread s a = RCUThread
{ forall s a. RCUThread s a -> ThreadId
rcuThreadId :: {-# UNPACK #-} !ThreadId
, forall s a. RCUThread s a -> MVar a
rcuThreadVar :: {-# UNPACK #-} !(MVar a)
}
instance MonadRCU (SRef s) (RCU s) where
type Reading (RCU s) = ReadingRCU s
type Writing (RCU s) = WritingRCU s
type Thread (RCU s) = RCUThread s
forking :: forall a. RCU s a -> RCU s (Thread (RCU s) a)
forking (RCU RCUState -> IO a
m) = forall s a. (RCUState -> IO a) -> RCU s a
RCU forall a b. (a -> b) -> a -> b
$ \ RCUState
s -> do
MVar a
result <- forall a. IO (MVar a)
newEmptyMVar
Int
gc <- Counter -> IO Int
readCounter (RCUState -> Counter
rcuStateGlobalCounter RCUState
s)
Counter
threadCounter <- Int -> IO Counter
newCounter Int
gc
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ (RCUState -> MVar [Counter]
rcuStateThreadCountersV RCUState
s) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Counter
threadCounter forall a. a -> [a] -> [a]
:)
ThreadId
tid <- IO () -> IO ThreadId
forkIO forall a b. (a -> b) -> a -> b
$ do
a
x <- RCUState -> IO a
m forall a b. (a -> b) -> a -> b
$ RCUState
s { rcuStateMyCounter :: Counter
rcuStateMyCounter = Counter
threadCounter }
forall a. MVar a -> a -> IO ()
putMVar MVar a
result a
x
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ (RCUState -> MVar [Counter]
rcuStateThreadCountersV RCUState
s) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => a -> [a] -> [a]
L.delete Counter
threadCounter
forall (m :: * -> *) a. Monad m => a -> m a
return (forall s a. ThreadId -> MVar a -> RCUThread s a
RCUThread ThreadId
tid MVar a
result)
{-# INLINE forking #-}
joining :: forall a. Thread (RCU s) a -> RCU s a
joining (RCUThread ThreadId
_ MVar a
m) = forall s a. (RCUState -> IO a) -> RCU s a
RCU forall a b. (a -> b) -> a -> b
$ \ RCUState
_ -> forall a. MVar a -> IO a
readMVar MVar a
m
{-# INLINE joining #-}
reading :: forall a. Reading (RCU s) a -> RCU s a
reading (ReadingRCU RCUState -> IO a
m) = forall s a. (RCUState -> IO a) -> RCU s a
RCU forall a b. (a -> b) -> a -> b
$ \ RCUState
s -> do
Version
v <- forall a. IORef a -> IO a
readIORef (RCUState -> IORef Version
rcuStateGlobalVersion RCUState
s)
a
x <- RCUState -> IO a
m RCUState
s
forall (m :: * -> *) a. PrimMonad m => a -> m ()
touch Version
v
Counter -> Int -> IO ()
writeCounter (RCUState -> Counter
rcuStateMyCounter RCUState
s) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Counter -> IO Int
readCounter (RCUState -> Counter
rcuStateGlobalCounter RCUState
s)
forall (m :: * -> *) a. Monad m => a -> m a
return a
x
{-# INLINE reading #-}
writing :: forall a. Writing (RCU s) a -> RCU s a
writing (WritingRCU RCUState -> IO a
m) = forall s a. (RCUState -> IO a) -> RCU s a
RCU forall a b. (a -> b) -> a -> b
$ \ RCUState
s -> do
forall a. MVar a -> IO a
takeMVar (RCUState -> MVar ()
rcuStateWriterLockV RCUState
s)
a
x <- RCUState -> IO a
m RCUState
s
RCUState -> IO ()
synchronizeIO RCUState
s
forall a. MVar a -> a -> IO ()
putMVar (RCUState -> MVar ()
rcuStateWriterLockV RCUState
s) ()
forall (m :: * -> *) a. Monad m => a -> m a
return a
x
{-# INLINE writing #-}
instance MonadIO (RCU s) where
liftIO :: forall a. IO a -> RCU s a
liftIO IO a
m = forall s a. (RCUState -> IO a) -> RCU s a
RCU forall a b. (a -> b) -> a -> b
$ \ RCUState
_ -> IO a
m
{-# INLINE liftIO #-}
runRCU :: (forall s. RCU s a) -> IO a
runRCU :: forall a. (forall s. RCU s a) -> IO a
runRCU forall s. RCU s a
m = do
Version
v <- IO Version
newVersion
forall s a. RCU s a -> RCUState -> IO a
unRCU forall s. RCU s a
m forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Counter
-> IORef Version
-> MVar [Counter]
-> MVar ()
-> Counter
-> Maybe Int
-> RCUState
RCUState forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> IO Counter
newCounter Int
0
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. a -> IO (IORef a)
newIORef Version
v
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. a -> IO (MVar a)
newMVar []
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. a -> IO (MVar a)
newMVar ()
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> IO Counter
newCounter Int
0
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
{-# INLINE runRCU #-}
runOnRCU :: Int -> (forall s. RCU s a) -> IO a
runOnRCU :: forall a. Int -> (forall s. RCU s a) -> IO a
runOnRCU Int
i forall s. RCU s a
m = do
Version
v <- IO Version
newVersion
forall s a. RCU s a -> RCUState -> IO a
unRCU forall s. RCU s a
m forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Counter
-> IORef Version
-> MVar [Counter]
-> MVar ()
-> Counter
-> Maybe Int
-> RCUState
RCUState forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> IO Counter
newCounter Int
0
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. a -> IO (IORef a)
newIORef Version
v
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. a -> IO (MVar a)
newMVar []
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. a -> IO (MVar a)
newMVar ()
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> IO Counter
newCounter Int
0
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. a -> Maybe a
Just Int
i)
{-# INLINE runOnRCU #-}