mirror of
https://github.com/barrucadu/dejafu.git
synced 2024-12-20 03:51:39 +03:00
121 lines
4.2 KiB
Haskell
121 lines
4.2 KiB
Haskell
-- |
|
|
-- Module : Control.Concurrent.Classy.CRef
|
|
-- Copyright : (c) 2016 Michael Walker
|
|
-- License : MIT
|
|
-- Maintainer : Michael Walker <mike@barrucadu.co.uk>
|
|
-- Stability : stable
|
|
-- Portability : portable
|
|
--
|
|
-- Mutable references in a concurrency monad.
|
|
--
|
|
-- __Deviations:__ There is no @Eq@ instance for @MonadConc@ the
|
|
-- @CRef@ type. Furthermore, the @mkWeakIORef@ function is not
|
|
-- provided.
|
|
module Control.Concurrent.Classy.CRef
|
|
( -- * CRefs
|
|
newCRef
|
|
, readCRef
|
|
, writeCRef
|
|
, modifyCRef
|
|
, modifyCRef'
|
|
, atomicModifyCRef
|
|
, atomicModifyCRef'
|
|
, atomicWriteCRef
|
|
|
|
-- * Memory Model
|
|
|
|
-- | In a concurrent program, @CRef@ operations may appear
|
|
-- out-of-order to another thread, depending on the memory model of
|
|
-- the underlying processor architecture. For example, on x86 (which
|
|
-- uses total store order), loads can move ahead of stores. Consider
|
|
-- this example:
|
|
--
|
|
-- > crefs :: MonadConc m => m (Bool, Bool)
|
|
-- > crefs = do
|
|
-- > r1 <- newCRef False
|
|
-- > r2 <- newCRef False
|
|
-- >
|
|
-- > x <- spawn $ writeCRef r1 True >> readCRef r2
|
|
-- > y <- spawn $ writeCRef r2 True >> readCRef r1
|
|
-- >
|
|
-- > (,) <$> readMVar x <*> readMVar y
|
|
--
|
|
-- Under a sequentially consistent memory model the possible results
|
|
-- are @(True, True)@, @(True, False)@, and @(False, True)@. Under
|
|
-- total or partial store order, @(False, False)@ is also a possible
|
|
-- result, even though there is no interleaving of the threads which
|
|
-- can lead to this.
|
|
--
|
|
-- We can see this by testing with different memory models:
|
|
--
|
|
-- > > autocheck' SequentialConsistency crefs
|
|
-- > [pass] Never Deadlocks (checked: 6)
|
|
-- > [pass] No Exceptions (checked: 6)
|
|
-- > [fail] Consistent Result (checked: 5)
|
|
-- > (False,True) S0-------S1-----S0--S2-----S0---
|
|
-- > (True,False) S0-------S1-P2-----S1----S0----
|
|
-- > (True,True) S0-------S1--P2-----S1---S0----
|
|
-- > (False,True) S0-------S1---P2-----S1--S0----
|
|
-- > (True,False) S0-------S2-----S1-----S0----
|
|
-- > ...
|
|
-- > False
|
|
--
|
|
-- > > autocheck' TotalStoreOrder crefs
|
|
-- > [pass] Never Deadlocks (checked: 303)
|
|
-- > [pass] No Exceptions (checked: 303)
|
|
-- > [fail] Consistent Result (checked: 302)
|
|
-- > (False,True) S0-------S1-----C-S0--S2-----C-S0---
|
|
-- > (True,False) S0-------S1-P2-----C-S1----S0----
|
|
-- > (True,True) S0-------S1-P2--C-S1----C-S0--S2---S0---
|
|
-- > (False,True) S0-------S1-P2--P1--C-C-S1--S0--S2---S0---
|
|
-- > (False,False) S0-------S1-P2--P1----S2---C-C-S0----
|
|
-- > ...
|
|
-- > False
|
|
--
|
|
-- Traces for non-sequentially-consistent memory models show where
|
|
-- writes to @CRef@s are /committed/, which makes a write visible to
|
|
-- all threads rather than just the one which performed the
|
|
-- write. Only 'writeCRef' is broken up into separate write and
|
|
-- commit steps, 'atomicModifyCRef' is still atomic and imposes a
|
|
-- memory barrier.
|
|
) where
|
|
|
|
import Control.Monad.Conc.Class
|
|
|
|
-- | Mutate the contents of a @CRef@.
|
|
--
|
|
-- Be warned that 'modifyCRef' does not apply the function strictly.
|
|
-- This means if the program calls 'modifyCRef' many times, but
|
|
-- seldomly uses the value, thunks will pile up in memory resulting in
|
|
-- a space leak. This is a common mistake made when using a @CRef@ as
|
|
-- a counter. For example, the following will likely produce a stack
|
|
-- overflow:
|
|
--
|
|
-- >ref <- newCRef 0
|
|
-- >replicateM_ 1000000 $ modifyCRef ref (+1)
|
|
-- >readCRef ref >>= print
|
|
--
|
|
-- To avoid this problem, use 'modifyCRef'' instead.
|
|
--
|
|
-- @since 1.0.0.0
|
|
modifyCRef :: MonadConc m => CRef m a -> (a -> a) -> m ()
|
|
modifyCRef ref f = readCRef ref >>= writeCRef ref . f
|
|
|
|
-- | Strict version of 'modifyCRef'
|
|
--
|
|
-- @since 1.0.0.0
|
|
modifyCRef' :: MonadConc m => CRef m a -> (a -> a) -> m ()
|
|
modifyCRef' ref f = do
|
|
x <- readCRef ref
|
|
writeCRef ref $! f x
|
|
|
|
-- | Strict version of 'atomicModifyCRef'. This forces both the value
|
|
-- stored in the @CRef@ as well as the value returned.
|
|
--
|
|
-- @since 1.0.0.0
|
|
atomicModifyCRef' :: MonadConc m => CRef m a -> (a -> (a,b)) -> m b
|
|
atomicModifyCRef' ref f = do
|
|
b <- atomicModifyCRef ref $ \a -> case f a of
|
|
v@(a',_) -> a' `seq` v
|
|
pure $! b
|