Hello John, Wednesday, May 3, 2006, 2:37:03 AM, you wrote:
This reminds me, I wonder if we should have an MVar varient that is _just_ for locking, it would have no separate take and put primitives, just a withLock, enforcing the restriction that the thread that took the lock is the same one that will return it.
to be exact, i has the following definitions, which uses class to define 'lock' operation and therefore allow alternative implementations in future without need to change application code that uses this operation:
data WithLocking h = WithLocking h !(MVar ())
-- | Add lock to object to ensure its proper use in concurrent threads addLocking h = do mvar <- newMVar () return (WithLocking h mvar)
-- | Run `action` with locked version of object `h` withLocking :: h -> (WithLocking h -> IO a) -> IO a withLocking h action = do addLocking h >>= action
-- | Define class of locking implementations, where 'lh' holds lock around 'h' class Locking lh h | lh->h where -- | Perform `action` while exclusively locking wrapped object lock :: lh -> (h->IO a) -> IO a
instance Locking (WithLocking h) h where {-# INLINE lock #-} lock (WithLocking h mvar) action = do -- Faster analog of withMVar Exception.catch (do takeMVar mvar result <- action h putMVar mvar () return res ) (\e -> do tryPutMVar mvar (); throw e)
liftLock1 action h = lock h (\a -> action a) liftLock2 action h x = lock h (\a -> action a x) liftLock3 action h x y = lock h (\a -> action a x y) liftLock4 action h x y z = lock h (\a -> action a x y z) liftLock5 action h x y z t = lock h (\a -> action a x y z t) {-# INLINE liftLock1 #-} {-# INLINE liftLock2 #-}
instance (Show h) => Show (WithLocking h) where show (WithLocking h _) = "WithLocking ("++ show h ++")"
and then any type class can be made client of this library, f.e.:
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 unsafeReadArray = liftLock2 unsafeReadArray unsafeWriteArray = liftLock3 unsafeWriteArray
main = do arr <- newArray (0,9) 0 >>= addLocking readArray arr 0 >>= writeArray arr 1 .....
-- Best regards, Bulat mailto:Bulat.Ziganshin@gmail.com