1.4. Concurrency abstractions

1.4.1. M-Vars

The Concurrent interface provides access to ``M-Vars'', which are synchronising variables.

MVars are rendezvous points, mostly for concurrent threads. They begin either empty or full, and any attempt to read an empty MVar blocks. When an MVar is written, a single blocked thread may be freed. Reading an MVar toggles its state from full back to empty. Therefore, any value written to an MVar may only be read once. Multiple reads and writes are allowed, but there must be at least one read between any two writes. Interface:

data MVar a -- abstract
instance Eq (MVar a)

newEmptyMVar     :: IO (MVar a)
newMVar          :: a -> IO (MVar a)
takeMVar         :: MVar a -> IO a
putMVar          :: MVar a -> a -> IO ()
readMVar         :: MVar a -> IO a
swapMVar         :: MVar a -> a -> IO a
isEmptyMVar      :: MVar a -> IO Bool

The operation isEmptyMVar returns a flag indicating whether the MVar is currently empty or filled in, i.e., will a thread block when performing a takeMVar on that MVar or not?

Please notice that the Boolean value returned from isEmptyMVar represent just a snapshot of the state of the MVar. By the time a thread gets to inspect the result and act upon it, other threads may have accessed the MVar and changed the 'filled-in' status of the variable.

The same proviso applies to isEmptyChan (next sub-section).

These two predicates are currently only supported by GHC.

1.4.2. Channel Variables

A channel variable (CVar) is a one-element channel, as described in the paper:

data CVar a
newCVar :: IO (CVar a)
putCVar :: CVar a -> a -> IO ()
getCVar :: CVar a -> IO a

1.4.3. Channels

A Channel is an unbounded channel:

data Chan a 
newChan         :: IO (Chan a)
putChan         :: Chan a -> a -> IO ()
getChan         :: Chan a -> IO a
dupChan         :: Chan a -> IO (Chan a)
unGetChan       :: Chan a -> a -> IO ()
getChanContents :: Chan a -> IO [a]

1.4.4. Semaphores

General and quantity semaphores:

data QSem
newQSem     :: Int   -> IO QSem
waitQSem    :: QSem  -> IO ()
signalQSem  :: QSem  -> IO ()

data QSemN
newQSemN    :: Int   -> IO QSemN
signalQSemN :: QSemN -> Int -> IO ()
waitQSemN   :: QSemN -> Int -> IO ()

1.4.5. Merging Streams

Merging streams---binary and n-ary:

mergeIO  :: [a]   -> [a] -> IO [a]
nmergeIO :: [[a]] -> IO [a]

These actions fork one thread for each input list that concurrently evaluates that list; the results are merged into a single output list.

Note: Hugs does not provide the functions mergeIO or nmergeIO since these require preemptive multitasking.

1.4.6. Sample Variables

A Sample variable (SampleVar) is slightly different from a normal MVar:

type SampleVar a = MVar (Int, MVar a)

emptySampleVar :: SampleVar a -> IO ()
newSampleVar   :: IO (SampleVar a)
readSample     :: SampleVar a -> IO a
writeSample    :: SampleVar a -> a -> IO ()