X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=Control%2FConcurrent%2FQSem.hs;h=22f6c0c8f6be1eba665998fd90ef377536e7771f;hb=41e8fba828acbae1751628af50849f5352b27873;hp=c009aafe01e19b6a6f661bf5db6a619ff97505eb;hpb=1127922b72ce9f2e57dd4e77e303be6804ae9c3a;p=ghc-base.git diff --git a/Control/Concurrent/QSem.hs b/Control/Concurrent/QSem.hs index c009aaf..22f6c0c 100644 --- a/Control/Concurrent/QSem.hs +++ b/Control/Concurrent/QSem.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE CPP #-} + ----------------------------------------------------------------------------- -- | -- Module : Control.Concurrent.QSem @@ -22,7 +24,7 @@ module Control.Concurrent.QSem import Prelude import Control.Concurrent.MVar -import Control.Exception ( block ) +import Control.Exception ( mask_ ) import Data.Typeable #include "Typeable.h" @@ -36,7 +38,7 @@ import Data.Typeable -- |A 'QSem' is a simple quantity semaphore, in which the available -- \"quantity\" is always dealt with in units of one. -newtype QSem = QSem (MVar (Int, [MVar ()])) +newtype QSem = QSem (MVar (Int, [MVar ()])) deriving Eq INSTANCE_TYPEABLE0(QSem,qSemTc,"QSem") @@ -51,7 +53,7 @@ newQSem initial = -- |Wait for a unit to become available waitQSem :: QSem -> IO () -waitQSem (QSem sem) = block $ do +waitQSem (QSem sem) = mask_ $ do (avail,blocked) <- takeMVar sem -- gain ex. access if avail > 0 then let avail' = avail-1 @@ -72,7 +74,7 @@ waitQSem (QSem sem) = block $ do -- |Signal that a unit of the 'QSem' is available signalQSem :: QSem -> IO () -signalQSem (QSem sem) = block $ do +signalQSem (QSem sem) = mask_ $ do (avail,blocked) <- takeMVar sem case blocked of [] -> let avail' = avail+1