SafeSemaphore 0.4.1 → 0.5.0

raw patch · 2 files changed

+115/−2 lines, 2 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• SafeSemaphore.cabal +3/−2
• src/Control/Concurrent/MSampleVar.hs +112/−0

@@ -1,6 +1,6 @@ Name:                SafeSemaphore-Version:             0.4.1-Synopsis:            Much safer replacement for QSemN and QSem+Version:             0.5.0+Synopsis:            Much safer replacement for QSemN, QSem, and SampleVar Description:         This provides a much safer semaphore than the QSem in base.  Performance has not been compared.  In the source is a tests/TestKillSem.hs executable (run by cabal test) that shows the problem with QSem. Homepage:            http://hackage.haskell.org/package/SafeSemaphore License:             BSD3@@ -16,6 +16,7 @@   ghc-options:  -Wall -O2 -funbox-strict-fields   Exposed-modules: Control.Concurrent.MSem                    Control.Concurrent.MSemN+                   Control.Concurrent.MSampleVar   Build-depends:  base < 5  Test-Suite TestSafeSemaphore

@@ -0,0 +1,112 @@+--+-- Module      :  Control.Concurrent.MSampleVar+-- Copyright   :  (c) Chris Kuklewicz 2011+-- License     :  3 clause BSD-style (see the file LICENSE)+-- +-- Maintainer  :  haskell@list.mightyreason.com+-- Stability   :  experimental+-- Portability :  non-portable (concurrency)+--++-- | 'MSampleVar' is a safer version of the "Control.Concurrent.SampleVar" in+-- base.  The same problem as QSem(N) is being fixed, that of handling waiters+-- that die before being woken normally.  For "Control.Concurrent.SampleVar" in+-- base this error can lead to thinking a full 'SampleVar' is really empty and+-- cause 'writeSampleVar' to hang.  The 'MSampleVar' in this module is immune+-- to this error, and has a simpler implementation.+module Control.Concurrent.MSampleVar+       (+         -- * Sample Variables+         MSampleVar,         -- :: type _ =+ +         newEmptySV, -- :: IO (MSampleVar a)+         newSV,      -- :: a -> IO (MSampleVar a)+         emptySV,    -- :: MSampleVar a -> IO ()+         readSV,     -- :: MSampleVar a -> IO a+         writeSV,    -- :: MSampleVar a -> a -> IO ()+         isEmptySV,  -- :: MSampleVar a -> IO Bool++       ) where++import Control.Monad+import Control.Concurrent+import Control.Concurrent.MVar+import Control.Exception+import Data.Typeable(Typeable)++-- |+-- Sample variables are slightly different from a normal 'MVar':+-- +--  * Reading an empty 'MSampleVar' causes the reader to block.+--    (same as 'takeMVar' on empty 'MVar')+-- +--  * Reading a filled 'MSampleVar' empties it and returns value.+--    (same as 'takeMVar')+--+--  * Try reading a filled 'MSampleVar' returns a Maybe value.+--    (same as 'tryTakeMVar')+-- +--  * Writing to an empty 'MSampleVar' fills it with a value, and+--    potentially, wakes up a blocked reader (same as for 'putMVar' on+--    empty 'MVar').+--+--  * Writing to a filled 'MSampleVar' overwrites the current value.+--    (different from 'putMVar' on full 'MVar'.)+data MSampleVar a = MSampleVar { readQueue :: MVar ()+                               , lockedStore :: MVar (MVar a) }++-- 'newEmptySV' allocates a new MSampleVar in an empty state.  No futher+-- allocation is done when using the 'MSampleVar'.+newEmptySV :: IO (MSampleVar a)+newEmptySV = do+  newReadQueue <- newMVar ()+  newLockedStore <- newMVar =<< newEmptyMVar+  return (MSampleVar { readQueue = newReadQueue+                     , lockedStore = newLockedStore })++-- 'newSV' allocates a new MSampleVar containing the passed value.  The value+-- is not evalated or forced, but stored lazily.  No futher allocation is done+-- when using the 'MSampleVar'.+newSV :: a -> IO (MSampleVar a)+newSV a = do+  newReadQueue <- newMVar ()+  newLockedStore <- newMVar =<< newMVar a+  return (MSampleVar { readQueue = newReadQueue+                     , lockedStore = newLockedStore })++-- 'isEmptySV' can block and be interrupted, in which case it does nothing.  If+-- 'isEmptySV' returns then it reports the momentary status the 'MSampleVar'.+-- Using this value without producing unwanted race conditions is left up to+-- the programmer.+isEmptySV :: MSampleVar a -> IO Bool+isEmptySV (MSampleVar _ ls) = withMVar ls isEmptyMVar+  -- (withMVar ls) might block, interrupting is okay++-- | If the 'MSampleVar' is full, leave it empty.  Otherwise, do nothing.+--+-- 'emptySV' can block and be interrupted, in which case it does nothing.  If+-- 'emptySV' returns then it left the 'MSampleVar' in an empty state.+emptySV :: MSampleVar a -> IO ()+emptySV (MSampleVar _ ls) = withMVar ls (void . tryTakeMVar)+  -- (withMVar ls) might block, interrupting is okay++-- | Wait for a value to become available, then take it and return.+--+-- 'readSV' can block and be interrupted, in which case it takes nothing.  If+-- 'readSV returns normally then it has taken a value.+readSV :: MSampleVar a -> IO a+readSV (MSampleVar rq ls) =  mask_ $ withMVar rq $ \ () ->+  join $ withMVar ls (return . takeMVar)+  -- (withMVar rq) might block, interrupting is okay+  -- (withMVar ls) might block, interrupting is okay+  -- join (takeMVar v) might block if empty, interrupting is okay++-- | Write a value into the 'MSampleVar', overwriting any previous value that was+-- there.+--+-- 'writeSV' can block and be interrupted, in which case it does nothing.+writeSV :: MSampleVar a -> a -> IO ()+writeSV (MSampleVar _ ls) a = mask_ $ withMVar ls $ \ v -> do+  void (tryTakeMVar v)+  putMVar v a           -- cannot block+  -- (withMVar ls) might block, interrupting is okay