------------------------------------------------------------------------------- |-- Module : Control.Concurrent.QSem-- Copyright : (c) The University of Glasgow 2001-- License : BSD-style (see the file libraries/base/LICENSE)-- -- Maintainer : libraries@haskell.org-- Stability : experimental-- Portability : non-portable (concurrency)---- Simple quantity semaphores.-------------------------------------------------------------------------------moduleControl.Concurrent.QSem(-- * Simple Quantity SemaphoresQSem,-- abstractnewQSem,-- :: Int -> IO QSemwaitQSem,-- :: QSem -> IO ()signalQSem-- :: QSem -> IO ())whereimportPreludeimportControl.Concurrent.MVarimportData.Typeable#include "Typeable.h"-- General semaphores are also implemented readily in terms of shared-- @MVar@s, only have to catch the case when the semaphore is tried-- waited on when it is empty (==0). Implement this in the same way as-- shared variables are implemented - maintaining a list of @MVar@s-- representing threads currently waiting. The counter is a shared-- variable, ensuring the mutual exclusion on its access.-- |A 'QSem' is a simple quantity semaphore, in which the available-- \"quantity\" is always dealt with in units of one.newtypeQSem=QSem(MVar(Int,[MVar()]))INSTANCE_TYPEABLE0(QSem,qSemTc,"QSem")-- |Build a new 'QSem' with a supplied initial quantity.-- The initial quantity must be at least 0.newQSem::Int->IOQSemnewQSeminitial=ifinitial<0thenfail"newQSem: Initial quantity must be non-negative"elsedosem<-newMVar(initial,[])return(QSemsem)-- |Wait for a unit to become availablewaitQSem::QSem->IO()waitQSem(QSemsem)=do(avail,blocked)<-takeMVarsem-- gain ex. accessifavail>0thenputMVarsem(avail-1,[])elsedoblock<-newEmptyMVar{-
Stuff the reader at the back of the queue,
so as to preserve waiting order. A signalling
process then only have to pick the MVar at the
front of the blocked list.
The version of waitQSem given in the paper could
lead to starvation.
-}putMVarsem(0,blocked++[block])takeMVarblock-- |Signal that a unit of the 'QSem' is availablesignalQSem::QSem->IO()signalQSem(QSemsem)=do(avail,blocked)<-takeMVarsemcaseblockedof[]->putMVarsem(avail+1,[])(block:blocked')->doputMVarsem(0,blocked')putMVarblock()