{-# LANGUAGE ScopedTypeVariables, DeriveDataTypeable #-} -- | Shim permitting the insertion of new semaphore implementation(s). module Control.CUtils.Semaphore (Sem, newSem, putSem, takeSem) where --import Data.Atomics --import Data.Primitive.ByteArray import Data.Data import Data.IORef import Foreign.Storable import Control.Concurrent.MVar import Control.Concurrent import Control.Monad.ST import Control.Monad import Control.Monad.Loops import Control.Exception import Control.Exception.Assert import Control.Concurrent.QSemN newtype Sem = Sem { unSem :: QSemN } deriving Typeable instance Data Sem -- Temp. harness newSem :: IO Sem -- | Make a new quantity semaphore initialized at zero. newSem = liftM Sem(newQSemN 0) {-getQuantity_ :: Sem -> IO Int -- | Snapshot the quantity in the semaphore at a point in time. {-# INLINE getQuantity_ #-} getQuantity_ s = fetchAddIntArray(marray_ s) 0 0 -- Yes.-} putSem :: Sem -> Int -> IO() {-# INLINE putSem #-} -- | Put quantity into the semaphore. Caller is responsible for ensuring that n is non-negative and that it -- leaves the counter within the positive integers. putSem = signalQSemN. unSem takeSem :: Sem -> Int -> IO() -- | Probe the semaphore. Quantity requested must be non-negative. {-# INLINE takeSem #-} takeSem = waitQSemN. unSem