This library allows to attach lock to any immutable value so that access
to this value can be obtained only via the lock operation that ensures
that this value will never be used at the same time by concurrent threads.
Lock attached to value by addLocking operation, it's also possible to run
code block with locked version of some value by withLocking operation.
To work with value contained inside lock, you should use lock operation;
it's usage is very like to using withMVar for the same purpose, but you
don't got ability to return new value of internal data from the action
performed. On the other side, lock operation is about two times faster
than withMVar according to my tests. There are also 'liftLock*'
operations that simplifies promoting operations on original value to
operations on it's locked version. Hugs/GHC version of this library defines
lock as operation of class Locking that opens possibility to define
alternative lock implementations.
First usage example - adding lock to mutable array and promoting the mutable
array with lock to support mutable array interface again. This can be done
with any objects what are accessed through some interface defined via type
class:
import Control.Concurrent.Locking
type WithLocking2 a e m = WithLocking (a e m)
instance (MArray a e m) => (MArray (WithLocking2 a) e m) where
newArray lu e = newArray lu e >>= addLocking
newArray_ lu = newArray_ lu >>= addLocking
unsafeRead = liftLock2 unsafeRead
unsafeWrite = liftLock3 unsafeWrite
main = do arr <- newArray (0,9) 0 >>= addLocking
readArray arr 0 >>= writeArray arr 1
.....
Another example where lock operation used to get exclusive access to file
while performing sequence of operations on it:
main = do lh <- openBinaryFile "test" ReadMode >>= addLocking
....
str <- readStringAt lh pos
....
readStringAt lh pos =
lock lh $ \h -> do
saved_pos <- hTell h
hSeek h AbsoluteSeek pos
str <- hGetLine h
hSeek h AbsoluteSeek saved_pos
return str
In this example, any thread can use readStringAt on the same locked handle
without risk to interfere with each other's operation
|