{-# 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