module Data.Atomics.Counter.Unboxed
(AtomicCounter, CTicket,
newCounter, readCounterForCAS, readCounter, peekCTicket,
writeCounter, casCounter, incrCounter, incrCounter_)
where
import GHC.Ptr
import Data.Atomics (casByteArrayInt)
import Data.Atomics.Internal
#if MIN_VERSION_base(4,7,0)
import GHC.Base hiding ((==#))
import GHC.Prim hiding ((==#))
import qualified GHC.PrimopWrappers as GPW
#else
import GHC.Base
import GHC.Prim
#endif
#if MIN_VERSION_base(4,7,0)
(==#) :: Int# -> Int# -> Bool
(==#) x y = case x GPW.==# y of { 0# -> False; _ -> True }
#endif
#ifndef __GLASGOW_HASKELL__
#error "Unboxed Counter: this library is not portable to other Haskell's"
#endif
#include "MachDeps.h"
#ifndef SIZEOF_HSINT
#define SIZEOF_HSINT INT_SIZE_IN_BYTES
#endif
data AtomicCounter = AtomicCounter (MutableByteArray# RealWorld)
type CTicket = Int
newCounter :: Int -> IO AtomicCounter
newCounter n = do
c <- newRawCounter
writeCounter c n
return c
newRawCounter :: IO AtomicCounter
newRawCounter = IO $ \s ->
case newByteArray# size s of { (# s, arr #) ->
(# s, AtomicCounter arr #) }
where !(I# size) = SIZEOF_HSINT
readCounter :: AtomicCounter -> IO Int
readCounter (AtomicCounter arr) = IO $ \s ->
case readIntArray# arr 0# s of { (# s, i #) ->
(# s, I# i #) }
writeCounter :: AtomicCounter -> Int -> IO ()
writeCounter (AtomicCounter arr) (I# i) = IO $ \s ->
case writeIntArray# arr 0# i s of { s ->
(# s, () #) }
readCounterForCAS :: AtomicCounter -> IO CTicket
readCounterForCAS = readCounter
peekCTicket :: CTicket -> Int
peekCTicket !x = x
casCounter :: AtomicCounter -> CTicket -> Int -> IO (Bool, CTicket)
casCounter (AtomicCounter mba#) (I# old#) newBox@(I# new#) = IO$ \s1# ->
let (# s2#, res# #) = casIntArray# mba# 0# old# new# s1# in
case res# ==# old# of
False -> (# s2#, (False, I# res# ) #)
True -> (# s2#, (True , newBox ) #)
sameCTicket :: CTicket -> CTicket -> Bool
sameCTicket = (==)
incrCounter :: Int -> AtomicCounter -> IO Int
incrCounter (I# incr#) (AtomicCounter mba#) = IO $ \ s1# ->
let (# s2#, res #) = fetchAddIntArray# mba# 0# incr# s1# in
(# s2#, (I# res) #)
incrCounter_ :: Int -> AtomicCounter -> IO ()
incrCounter_ (I# incr#) (AtomicCounter mba#) = IO $ \ s1# ->
let (# s2#, res #) = fetchAddIntArray# mba# 0# incr# s1# in
(# s2#, () #)