Movatterモバイル変換

{-# LANGUAGE Safe #-}{-# LANGUAGE BangPatterns #-}{-# OPTIONS_GHC -funbox-strict-fields #-}------------------------------------------------------------------------------- |-- 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 ())whereimportControl.Concurrent.MVar(MVar,newEmptyMVar,takeMVar,tryTakeMVar,putMVar,newMVar,tryPutMVar)importControl.ExceptionimportData.Maybe-- | 'QSem' is a quantity semaphore in which the resource is acquired-- and released in units of one. It provides guaranteed FIFO ordering-- for satisfying blocked `waitQSem` calls.---- The pattern---- >   bracket_ waitQSem signalQSem (...)---- is safe; it never loses a unit of the resource.--dataQSem=QSem!(MVar(Int,[MVar()],[MVar()]))-- The semaphore state (i, xs, ys):----   i is the current resource value----   (xs,ys) is the queue of blocked threads, where the queue is--           given by xs ++ reverse ys.  We can enqueue new blocked threads--           by consing onto ys, and dequeue by removing from the head of xs.---- A blocked thread is represented by an empty (MVar ()).  To unblock-- the thread, we put () into the MVar.---- A thread can dequeue itself by also putting () into the MVar, which-- it must do if it receives an exception while blocked in waitQSem.-- This means that when unblocking a thread in signalQSem we must-- first check whether the MVar is already full; the MVar lock on the-- semaphore itself resolves race conditions between signalQSem and a-- thread attempting to dequeue itself.-- |Build a new 'QSem' with a supplied initial quantity.--  The initial quantity must be at least 0.newQSem::Int->IOQSemnewQSeminitial|initial<0=fail"newQSem: Initial quantity must be non-negative"|otherwise=dosem<-newMVar(initial,[],[])return(QSemsem)-- |Wait for a unit to become availablewaitQSem::QSem->IO()waitQSem(QSemm)=mask_$do(i,b1,b2)<-takeMVarmifi==0thendob<-newEmptyMVarputMVarm(i,b1,b:b2)waitbelsedolet!z=i-1putMVarm(z,b1,b2)return()wherewaitb=takeMVarb`onException`do(uninterruptibleMask_$do-- Note [signal uninterruptible](i,b1,b2)<-takeMVarmr<-tryTakeMVarbr'<-ifisJustrthensignal(i,b1,b2)elsedoputMVarb();return(i,b1,b2)putMVarmr')-- |Signal that a unit of the 'QSem' is availablesignalQSem::QSem->IO()signalQSem(QSemm)=uninterruptibleMask_$do-- Note [signal uninterruptible]r<-takeMVarmr'<-signalrputMVarmr'-- Note [signal uninterruptible]----   If we have----      bracket waitQSem signalQSem (...)----   and an exception arrives at the signalQSem, then we must not lose--   the resource.  The signalQSem is masked by bracket, but taking--   the MVar might block, and so it would be interruptible.  Hence we--   need an uninterruptibleMask here.----   This isn't ideal: during high contention, some threads won't be--   interruptible.  The QSemSTM implementation has better behaviour--   here, but it performs much worse than this one in some--   benchmarks.signal::(Int,[MVar()],[MVar()])->IO(Int,[MVar()],[MVar()])signal(i,a1,a2)=ifi==0thenloopa1a2elselet!z=i+1inreturn(z,a1,a2)whereloop[][]=return(1,[],[])loop[]b2=loop(reverseb2)[]loop(b:bs)b2=dor<-tryPutMVarb()ifrthenreturn(0,bs,b2)elseloopbsb2