/usr/lib/hugs/packages/base/Control/Concurrent/QSemN.hs is in libhugs-base-bundled 98.200609.21-5.4.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 | -----------------------------------------------------------------------------
-- |
-- Module : Control.Concurrent.QSemN
-- 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)
--
-- Quantity semaphores in which each thread may wait for an arbitrary
-- \"amount\".
--
-----------------------------------------------------------------------------
module Control.Concurrent.QSemN
( -- * General Quantity Semaphores
QSemN, -- abstract
newQSemN, -- :: Int -> IO QSemN
waitQSemN, -- :: QSemN -> Int -> IO ()
signalQSemN -- :: QSemN -> Int -> IO ()
) where
import Prelude
import Control.Concurrent.MVar
import Data.Typeable
-- |A 'QSemN' is a quantity semaphore, in which the available
-- \"quantity\" may be signalled or waited for in arbitrary amounts.
newtype QSemN = QSemN (MVar (Int,[(Int,MVar ())]))
qSemNTc = mkTyCon "QSemN"; instance Typeable QSemN where { typeOf _ = mkTyConApp qSemNTc [] }
-- |Build a new 'QSemN' with a supplied initial quantity.
newQSemN :: Int -> IO QSemN
newQSemN init = do
sem <- newMVar (init,[])
return (QSemN sem)
-- |Wait for the specified quantity to become available
waitQSemN :: QSemN -> Int -> IO ()
waitQSemN (QSemN sem) sz = do
(avail,blocked) <- takeMVar sem -- gain ex. access
if (avail - sz) >= 0 then
-- discharging 'sz' still leaves the semaphore
-- in an 'unblocked' state.
putMVar sem (avail-sz,blocked)
else do
block <- newEmptyMVar
putMVar sem (avail, blocked++[(sz,block)])
takeMVar block
-- |Signal that a given quantity is now available from the 'QSemN'.
signalQSemN :: QSemN -> Int -> IO ()
signalQSemN (QSemN sem) n = do
(avail,blocked) <- takeMVar sem
(avail',blocked') <- free (avail+n) blocked
putMVar sem (avail',blocked')
where
free avail [] = return (avail,[])
free avail ((req,block):blocked)
| avail >= req = do
putMVar block ()
free (avail-req) blocked
| otherwise = do
(avail',blocked') <- free avail blocked
return (avail',(req,block):blocked')
|