BoundedChan-1.0.1.0/0000755000000000000000000000000011762217363012217 5ustar0000000000000000BoundedChan-1.0.1.0/LICENSE0000644000000000000000000000273711762217363013235 0ustar0000000000000000Copyright (c) 2009, Galois, Inc. All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of the Galois, Inc. nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. BoundedChan-1.0.1.0/Setup.hs0000644000000000000000000000005611762217363013654 0ustar0000000000000000import Distribution.Simple main = defaultMain BoundedChan-1.0.1.0/BoundedChan.cabal0000644000000000000000000000163311762217363015360 0ustar0000000000000000name: BoundedChan category: Concurrency version: 1.0.1.0 license: BSD3 license-file: LICENSE author: Adam Wick , Chris Kuklewicz maintainer: Adam Wick stability: stable build-type: Simple cabal-version: >= 1.6 tested-with: GHC == 6.10 synopsis: Implementation of bounded channels. description: This library introduces BoundedChan. BoundedChans differ from Chans in that they are guaranteed to contain no more than a certain number of elements. library build-depends: base >= 3 && < 5, array >= 0.2 && < 0.8 exposed-modules: Control.Concurrent.BoundedChan ghc-options: -O2 -Wall -funbox-strict-fields if impl(ghc >= 6.8) ghc-options: -fwarn-tabs source-repository head type: git location: git://github.com/GaloisInc/BoundedChan.git BoundedChan-1.0.1.0/Control/0000755000000000000000000000000011762217363013637 5ustar0000000000000000BoundedChan-1.0.1.0/Control/Concurrent/0000755000000000000000000000000011762217363015761 5ustar0000000000000000BoundedChan-1.0.1.0/Control/Concurrent/BoundedChan.hs0000644000000000000000000001125011762217363020466 0ustar0000000000000000-- |Implements bounded channels. These channels differ from normal 'Chan's in -- that they are guaranteed to contain no more than a certain number of -- elements. This is ideal when you may be writing to a channel faster than you -- are able to read from it. -- -- This module supports all the functions of "Control.Concurrent.Chan" except -- 'unGetChan' and 'dupChan', which are not supported for bounded channels. -- -- Extra consitency: This version enforces that if thread Alice writes -- e1 followed by e2 then e1 will be returned by readChan before e2. -- Conversely, if thead Bob reads e1 followed by e2 then it was true that -- writeChan e1 preceded writeChan e2. -- -- Previous versions did not enforce this consistency: if writeChan were -- preempted between putMVars or killThread arrived between putMVars then it -- can fail. Similarly it might fail if readChan were stopped after putMVar -- and before the second takeMVar. An unlucky pattern of several such deaths -- might actually break the invariants of the array in an unrecoverable way -- causing all future reads and writes to block. module Control.Concurrent.BoundedChan( BoundedChan , newBoundedChan , writeChan , readChan , isEmptyChan , getChanContents , writeList2Chan ) where import Control.Concurrent.MVar (MVar, isEmptyMVar, newEmptyMVar, newMVar, putMVar, takeMVar) import Control.Exception (mask_, onException) import Control.Monad (replicateM) import Data.Array (Array, (!), listArray) import System.IO.Unsafe (unsafeInterleaveIO) -- |'BoundedChan' is an abstract data type representing a bounded channel. data BoundedChan a = BC { _size :: Int , _contents :: Array Int (MVar a) , _writePos :: MVar Int , _readPos :: MVar Int } -- Versions of modifyMVar and withMVar that do not 'restore' the previous mask state when running -- 'io', with added modification strictness. The lack of 'restore' may make these perform better -- than the normal version. Moving strictness here makes using them more pleasant. {-# INLINE modifyMVar_mask #-} modifyMVar_mask :: MVar a -> (a -> IO (a,b)) -> IO b modifyMVar_mask m io = mask_ $ do a <- takeMVar m (a',b) <- io a `onException` putMVar m a putMVar m $! a' return b {-# INLINE modifyMVar_mask_ #-} modifyMVar_mask_ :: MVar a -> (a -> IO a) -> IO () modifyMVar_mask_ m io = mask_ $ do a <- takeMVar m a' <- io a `onException` putMVar m a putMVar m $! a' {-# INLINE withMVar_mask #-} withMVar_mask :: MVar a -> (a -> IO b) -> IO b withMVar_mask m io = mask_ $ do a <- takeMVar m b <- io a `onException` putMVar m a putMVar m a return b -- |@newBoundedChan n@ returns a channel than can contain no more than @n@ -- elements. newBoundedChan :: Int -> IO (BoundedChan a) newBoundedChan x = do entls <- replicateM x newEmptyMVar wpos <- newMVar 0 rpos <- newMVar 0 let entries = listArray (0, x - 1) entls return (BC x entries wpos rpos) -- |Write an element to the channel. If the channel is full, this routine will -- block until it is able to write. Blockers wait in a fair FIFO queue. writeChan :: BoundedChan a -> a -> IO () writeChan (BC size contents wposMV _) x = modifyMVar_mask_ wposMV $ \wpos -> do putMVar (contents ! wpos) x return ((succ wpos) `mod` size) -- only advance when putMVar succeeds -- |Read an element from the channel. If the channel is empty, this routine -- will block until it is able to read. Blockers wait in a fair FIFO queue. readChan :: BoundedChan a -> IO a readChan (BC size contents _ rposMV) = modifyMVar_mask rposMV $ \rpos -> do a <- takeMVar (contents ! rpos) return ((succ rpos) `mod` size, a) -- only advance when takeMVar succeeds -- |DANGER: This may block on an empty channel if there is already a blocked reader. -- Returns 'True' if the supplied channel is empty. -- -- DEPRECATED {-# DEPRECATED isEmptyChan "This isEmptyChan can block, no non-blocking substitute yet" #-} isEmptyChan :: BoundedChan a -> IO Bool isEmptyChan (BC _ contents _ rposMV) = withMVar_mask rposMV $ \rpos -> isEmptyMVar (contents ! rpos) -- |Return a lazy list representing the contents of the supplied channel. Competing -- readers might steal from this list. getChanContents :: BoundedChan a -> IO [a] getChanContents ch = unsafeInterleaveIO $ do x <- readChan ch xs <- getChanContents ch return (x:xs) -- |Write a list of elements to the channel. If the channel becomes full, this -- routine will block until it is able to write. Competing writers may interleave with -- this one. writeList2Chan :: BoundedChan a -> [a] -> IO () writeList2Chan = mapM_ . writeChan