-- Hoogle documentation, generated by Haddock -- See Hoogle, http://www.haskell.org/hoogle/ -- | A safe approach to CAS and other atomic ops in Haskell. -- -- After GHC 7.4 a new `casMutVar#` primop became available, but it's -- difficult to use safely, because pointer equality is a highly unstable -- property in Haskell. This library provides a safer method based on the -- concept of Tickets. -- -- Also, this library uses the foreign primop capability of GHC to -- add access to other variants that may be of interest, specifically, -- compare and swap inside an array. -- -- Changes in 0.3: -- -- -- -- Changes in 0.4: -- -- @package atomic-primops @version 0.4 -- | This implementation stores an unboxed counter and uses FFI operations -- to modify its contents. It has the advantage that it can use true -- fetch-and-add operations. It has the disadvantage of extra overhead -- due to FFI calls. module Data.Atomics.Counter.Foreign type AtomicCounter = ForeignPtr Int type CTicket = Int -- | Create a new counter initialized to the given value. newCounter :: Int -> IO AtomicCounter -- | Just like the Data.Atomics CAS interface, this routine returns -- an opaque ticket that can be used in CAS operations. readCounterForCAS :: AtomicCounter -> IO CTicket -- | Equivalent to readCounterForCAS followed by peekCTicket. readCounter :: AtomicCounter -> IO Int -- | Opaque tickets cannot be constructed, but they can be destructed into -- values. peekCTicket :: CTicket -> Int -- | Make a non-atomic write to the counter. No memory-barrier. writeCounter :: AtomicCounter -> Int -> IO () -- | Compare and swap for the counter ADT. casCounter :: AtomicCounter -> CTicket -> Int -> IO (Bool, CTicket) -- | Increment the counter by a given amount. Returns the original value -- before the increment. -- -- Note that UNLIKE with boxed implementations of counters, where -- increment is based on CAS, this increment is O(1). -- Fetch-and-add does not require a retry loop like CAS. incrCounter :: Int -> AtomicCounter -> IO Int -- | An alternate version for when you don't care about the old value. incrCounter_ :: Int -> AtomicCounter -> IO () -- | This reference version is implemented with atomicModifyIORef and can -- be a useful fallback if one of the other implementations needs to be -- debugged for a given architecture. module Data.Atomics.Counter.Reference data AtomicCounter type CTicket = Int -- | Create a new counter initialized to the given value. newCounter :: Int -> IO AtomicCounter -- | Just like the Data.Atomics CAS interface, this routine returns -- an opaque ticket that can be used in CAS operations. readCounterForCAS :: AtomicCounter -> IO CTicket -- | Equivalent to readCounterForCAS followed by peekCTicket. readCounter :: AtomicCounter -> IO Int -- | Opaque tickets cannot be constructed, but they can be destructed into -- values. peekCTicket :: CTicket -> Int -- | Make a non-atomic write to the counter. No memory-barrier. writeCounter :: AtomicCounter -> Int -> IO () -- | Compare and swap for the counter ADT. casCounter :: AtomicCounter -> CTicket -> Int -> IO (Bool, CTicket) -- | Try repeatedly until we successfully increment the counter by a given -- amount. Returns the original value of the counter (pre-increment). incrCounter :: Int -> AtomicCounter -> IO Int incrCounter_ :: Int -> AtomicCounter -> IO () -- | This module provides only the raw primops (and necessary types) for -- atomic operations. module Data.Atomics.Internal -- | Unsafe, machine-level atomic compare and swap on an element within an -- Array. casArray# :: MutableArray# RealWorld a -> Int# -> Ticket a -> Ticket a -> State# RealWorld -> (# State# RealWorld, Int#, Ticket a #) casByteArrayInt# :: MutableByteArray# s -> Int# -> Int# -> Int# -> State# s -> (# State# s, Int# #) fetchAddByteArrayInt# :: MutableByteArray# s -> Int# -> Int# -> State# s -> (# State# s, Int# #) readForCAS# :: MutVar# RealWorld a -> State# RealWorld -> (# State# RealWorld, Ticket a #) casMutVarTicketed# :: MutVar# RealWorld a -> Ticket a -> Ticket a -> State# RealWorld -> (# State# RealWorld, Int#, Ticket a #) -- | When performing compare-and-swaps, the ticket encapsulates -- proof that a thread observed a specific previous value of a mutable -- variable. It is provided in lieu of the old value to -- compare-and-swap. type Ticket a = Any a stg_storeLoadBarrier# :: State# RealWorld -> (# State# RealWorld, Int# #) stg_loadLoadBarrier# :: State# RealWorld -> (# State# RealWorld, Int# #) stg_writeBarrier# :: State# RealWorld -> (# State# RealWorld, Int# #) instance Eq (Ticket a) instance Show (Ticket a) -- | Provides atomic memory operations on IORefs and Mutable Arrays. -- -- Pointer equality need not be maintained by a Haskell compiler. For -- example, Int values will frequently be boxed and unboxed, changing the -- pointer identity of the thunk. To deal with this, the compare-and-swap -- (CAS) approach used in this module is uses a sealed -- representation of pointers into the Haskell heap (Tickets). -- Currently, the user cannot coin new tickets, rather a Ticket -- provides evidence of a past observation, and grants permission to make -- a future change. module Data.Atomics -- | When performing compare-and-swaps, the ticket encapsulates -- proof that a thread observed a specific previous value of a mutable -- variable. It is provided in lieu of the old value to -- compare-and-swap. type Ticket a = Any a -- | A ticket contains or can get the usable Haskell value. peekTicket :: Ticket a -> a -- | Compare-and-swap casArrayElem :: MutableArray RealWorld a -> Int -> Ticket a -> a -> IO (Bool, Ticket a) -- | This variant takes two tickets: the new value is a ticket -- rather than an arbitrary, lifted, Haskell value. casArrayElem2 :: MutableArray RealWorld a -> Int -> Ticket a -> Ticket a -> IO (Bool, Ticket a) readArrayElem :: MutableArray RealWorld a -> Int -> IO (Ticket a) casByteArrayInt :: MutableByteArray RealWorld -> Int -> Int -> Int -> IO Int fetchAddByteArrayInt :: MutableByteArray RealWorld -> Int -> Int -> IO Int readForCAS :: IORef a -> IO (Ticket a) -- | Performs a machine-level compare and swap operation on an -- IORef. Returns a tuple containing a Bool which is -- True when a swap is performed, along with the current -- value from the IORef. -- -- Note "compare" here means pointer equality in the sense of -- reallyUnsafePtrEquality#. casIORef :: IORef a -> Ticket a -> a -> IO (Bool, Ticket a) -- | This variant takes two tickets, i.e. the new value is a -- ticket rather than an arbitrary, lifted, Haskell value. casIORef2 :: IORef a -> Ticket a -> Ticket a -> IO (Bool, Ticket a) readMutVarForCAS :: MutVar# RealWorld a -> IO (Ticket a) -- | MutVar counterpart of casIORef. casMutVar :: MutVar# RealWorld a -> Ticket a -> a -> IO (Bool, Ticket a) -- | This variant takes two tickets, i.e. the new value is a -- ticket rather than an arbitrary, lifted, Haskell value. casMutVar2 :: MutVar# RealWorld a -> Ticket a -> Ticket a -> IO (Bool, Ticket a) -- | Memory barrier implemented by the GHC rts (SMP.h). storeLoadBarrier :: IO () -- | Memory barrier implemented by the GHC rts (SMP.h). loadLoadBarrier :: IO () -- | Memory barrier implemented by the GHC rts (SMP.h). writeBarrier :: IO () module Data.Atomics.Counter.Unboxed data AtomicCounter type CTicket = Int -- | Create a new counter initialized to the given value. newCounter :: Int -> IO AtomicCounter -- | Just like the Data.Atomics CAS interface, this routine returns -- an opaque ticket that can be used in CAS operations. readCounterForCAS :: AtomicCounter -> IO CTicket -- | Equivalent to readCounterForCAS followed by peekCTicket. readCounter :: AtomicCounter -> IO Int -- | Opaque tickets cannot be constructed, but they can be destructed into -- values. peekCTicket :: CTicket -> Int -- | Make a non-atomic write to the counter. No memory-barrier. writeCounter :: AtomicCounter -> Int -> IO () -- | Compare and swap for the counter ADT. casCounter :: AtomicCounter -> CTicket -> Int -> IO (Bool, CTicket) -- | Increment the counter by a given amount. Returns the original value -- before the increment. -- -- Note that UNLIKE with boxed implementations of counters, where -- increment is based on CAS, this increment is O(1). -- Fetch-and-add does not require a retry loop like CAS. incrCounter :: Int -> AtomicCounter -> IO Int -- | An alternate version for when you don't care about the old value. incrCounter_ :: Int -> AtomicCounter -> IO () module Data.Atomics.Counter -- | This version uses a boxed IORef representation, but it can be somewhat -- cheaper than the Refence version because it uses raw CAS rather than -- full atomicModifyIORef. module Data.Atomics.Counter.IORef data AtomicCounter type CTicket = Ticket Int -- | Create a new counter initialized to the given value. newCounter :: Int -> IO AtomicCounter -- | Just like the Data.Atomics CAS interface, this routine returns -- an opaque ticket that can be used in CAS operations. readCounterForCAS :: AtomicCounter -> IO CTicket -- | Equivalent to readCounterForCAS followed by peekCTicket. readCounter :: AtomicCounter -> IO Int -- | Opaque tickets cannot be constructed, but they can be destructed into -- values. peekCTicket :: CTicket -> Int -- | Make a non-atomic write to the counter. No memory-barrier. writeCounter :: AtomicCounter -> Int -> IO () -- | Compare and swap for the counter ADT. casCounter :: AtomicCounter -> CTicket -> Int -> IO (Bool, CTicket) -- | Try repeatedly until we successfully increment the counter by a given -- amount. Returns the original value of the counter (pre-increment). incrCounter :: Int -> AtomicCounter -> IO Int incrCounter_ :: Int -> AtomicCounter -> IO ()