abstract-deque-0.3/0000755000000000000000000000000012274327523012455 5ustar0000000000000000abstract-deque-0.3/abstract-deque.cabal0000644000000000000000000000500512274327523016345 0ustar0000000000000000Name: abstract-deque Version: 0.3 License: BSD3 License-file: LICENSE Author: Ryan R. Newton Maintainer: rrnewton@gmail.com Category: Data Build-type: Simple Cabal-version: >= 1.8 Homepage: https://github.com/rrnewton/haskell-lockfree/wiki Bug-Reports: https://github.com/rrnewton/haskell-lockfree/issues -- Version History: -- 0.1: -- 0.1.1: Added nullQ to interface. [First release] -- 0.1.2: dependency on IORefCAS -- 0.1.3: Actually turned on real CAS! DANGER -- 0.1.4: Another release. -- 0.1.5: Fix for 6.12 and 7.0. -- 0.1.6: Make useCAS default FALSE. -- 0.1.7: Add leftThreadSafe / rightThreadSafe -- 0.2: [breaking] Refactor names of exposed Tests -- 0.2.2: Add Debugger -- 0.2.2.1: Add some extra testing helpers. -- 0.3: Remove testing utilities to their own package. Synopsis: Abstract, parameterized interface to mutable Deques. Description: An abstract interface to highly-parameterizable queues/deques. . Background: There exists a feature space for queues that extends between: . * simple, single-ended, non-concurrent, bounded queues . * double-ended, threadsafe, growable queues . ... with important points inbetween (such as the queues used for work-stealing). . This package includes an interface for Deques that allows the programmer to use a single API for all of the above, while using the type-system to select an efficient implementation given the requirements (using type families). . This package also includes a simple reference implementation based on 'IORef' and "Data.Sequence". -- Making this default False because abstract-deque should be VERY depndency-safe. -- The reference implementation can be factored out in the future. Flag useCAS Description: Enable the reference implementation to use hardware compare-and-swap. Default: False Library exposed-modules: Data.Concurrent.Deque.Class, Data.Concurrent.Deque.Reference, Data.Concurrent.Deque.Reference.DequeInstance, Data.Concurrent.Deque.Debugger build-depends: base >= 4 && < 5, array, random, containers, time if flag(useCAS) && impl( ghc >= 7.4 ) && !os(mingw32) { build-depends: atomic-primops >= 0.5.0.2 cpp-options: -DUSE_CAS -DDEFAULT_SIGNATURES } extensions: CPP ghc-options: -O2 Source-Repository head Type: git Location: git://github.com/rrnewton/haskell-lockfree.git abstract-deque-0.3/LICENSE0000644000000000000000000000327712274327523013473 0ustar0000000000000000Unless otherwise noted in individual files, the below copyright/LICENSE applies to the source files in this repository. -------------------------------------------------------------------------------- Copyright (c)2011, Ryan R. Newton 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 Ryan R. Newton nor the names of other 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. abstract-deque-0.3/Setup.hs0000644000000000000000000000005612274327523014112 0ustar0000000000000000import Distribution.Simple main = defaultMain abstract-deque-0.3/Data/0000755000000000000000000000000012274327523013326 5ustar0000000000000000abstract-deque-0.3/Data/Concurrent/0000755000000000000000000000000012274327523015450 5ustar0000000000000000abstract-deque-0.3/Data/Concurrent/Deque/0000755000000000000000000000000012274327523016513 5ustar0000000000000000abstract-deque-0.3/Data/Concurrent/Deque/Class.hs0000644000000000000000000001565712274327523020132 0ustar0000000000000000{-# LANGUAGE TypeFamilies, CPP, TypeSynonymInstances, MultiParamTypeClasses, FlexibleInstances, EmptyDataDecls #-} #ifdef DEFAULT_SIGNATURES {-# LANGUAGE DefaultSignatures #-} #endif {- | An abstract, parameterizable interface for queues. This interface includes a non-associated type family for Deques plus separate type classes encapsulating the Deque operations. That is, we separate type selection (type family) from function overloading (vanilla type classes). This design strives to hide the extra phantom-type parameters from the Class constraints and therefore from the type signatures of client code. -} module Data.Concurrent.Deque.Class ( -- * Highly parameterized Deque type(s) Deque -- ** The choices that select a queue-variant. -- *** Choice #1 -- thread safety. , Threadsafe, Nonthreadsafe -- *** Choice #2 -- double or single functionality on an end. , SingleEnd, DoubleEnd -- *** Choice #3 -- bounded or growing queues: , Bound, Grow -- *** Choice #4 -- duplication of elements. , Safe, Dup -- ** Aliases enabling more concise Deque types: , S, D, NT, T -- ** Aliases for commonly used Deque configurations: , Queue, ConcQueue, ConcDeque, WSDeque -- * Class for basic Queue operations , DequeClass(..) -- * Extra capabilities: type classes -- | These classes provide a more programmer-friendly constraints than directly -- using the phantom type parameters to constrain queues in user code. Also note -- that instances can be provided for types outside the type `Deque` type family. -- -- We still make a distinction between the different capabilities -- (e.g. single-ended / double ended), and thus we need the below type classes for -- the additional operations unsupported by the minimal "DequeClass". -- ** The \"unnatural\" double ended cases: pop left, push right. , PopL(..), PushR(..) -- ** Operations that only make sense for bounded queues. , BoundedL(..), BoundedR(..) ) where import Prelude hiding (Bounded) {- | A family of Deques implementations. A concrete Deque implementation is selected based on the (phantom) type parameters, which encode several choices. For example, a work stealing deque is threadsafe only on one end and supports push/pop on one end (and pop-only) on the other: >> (Deque NT T D S Grow elt) Note, however, that the above example is overconstraining in many situations. It demands an implementation which is NOT threadsafe on one end and does NOT support push on one end, whereas both these features would not hurt, if present. Thus when accepting a queue as input to a function you probably never want to overconstrain by demanding a less-featureful option. For example, rather than @(Deque NT D T S Grow elt)@ You would probably want: @(Deque nt D T s Grow elt)@ -} -- data family Deque lThreaded rThreaded lDbl rDbl bnd safe elt type family Deque lThreaded rThreaded lDbl rDbl bnd safe elt -- | Haskell IO threads ("Control.Concurrent") may concurrently access -- this end of the queue. Note that this attribute is set -- separately for the left and right ends. data Threadsafe -- | Only one thread at a time may access this end of the queue. data Nonthreadsafe -- | This end of the queue provides push-only (left) or pop-only -- (right) functionality. Thus a 'SingleEnd' / 'SingleEnd' combination -- is what is commonly referred to as a /single ended queue/, whereas -- 'DoubleEnd' / 'DoubleEnd' is -- a /double ended queue/. Heterogeneous combinations are sometimes -- colloquially referred to as \"1.5 ended queues\". data SingleEnd -- | This end of the queue supports both push and pop. data DoubleEnd -- | The queue has bounded capacity. data Bound -- | The queue can grow as elements are added. data Grow -- | The queue will not duplicate elements. data Safe -- | Pop operations may possibly duplicate elements. Hopefully with low probability! data Dup -- Possible #5: -- data Lossy -- I know of no algorithm which would motivate having a Lossy mode. ---------------------------------------- type T = Threadsafe type NT = Nonthreadsafe type S = SingleEnd type D = DoubleEnd -- | A traditional single-threaded, single-ended queue. type Queue a = Deque Nonthreadsafe Nonthreadsafe SingleEnd SingleEnd Grow Safe a -- | A concurrent queue. type ConcQueue a = Deque Threadsafe Threadsafe SingleEnd SingleEnd Grow Safe a -- | A concurrent deque. type ConcDeque a = Deque Threadsafe Threadsafe DoubleEnd DoubleEnd Grow Safe a -- | Work-stealing deques (1.5 ended). Typically the worker pushes -- and pops its own queue (left) whereas thieves only pop (right). type WSDeque a = Deque Nonthreadsafe Threadsafe DoubleEnd SingleEnd Grow Safe a -------------------------------------------------------------------------------- -- | Class encompassing the basic queue operations that hold for all -- single, 1.5, and double ended modes. We arbitrarily call the -- ends \"left\" and \"right\" and choose the natural operations to be -- pushing on the left and popping on the right. class DequeClass d where -- | Create a new deque. Most appropriate for unbounded deques. -- If bounded, the size is unspecified. newQ :: IO (d elt) #ifdef DEFAULT_SIGNATURES #warning "Providing default binding and signature for newQ..." default newQ :: BoundedL d => IO (d elt) newQ = newBoundedQ 256 #endif -- | Is the queue currently empty? Beware that this can be a highly transient state. nullQ :: d elt -> IO Bool -- | Natural push: push onto the left end of the deque. pushL :: d elt -> elt -> IO () -- | Natural pop: pop from the right end of the deque. tryPopR :: d elt -> IO (Maybe elt) -- TODO: Consider adding a peek operation? -- TODO: It would also be possible to include blocking/spinning pops. -- But maybe those should go in separate type classes... -- | Runtime indication of thread saftey for `pushL` (and `popL`). -- (Argument unused.) leftThreadSafe :: d elt -> Bool -- | Runtime indication of thread saftey for `tryPopR` (and `pushR`). -- (Argument unused.) rightThreadSafe :: d elt -> Bool class DequeClass d => PopL d where -- | PopL is not the native operation for the left end, so it requires -- that the left end be a 'DoubleEnd', but places no other requirements -- on the input queue. -- tryPopL :: d elt -> IO (Maybe elt) class DequeClass d => PushR d where -- | Pushing is not the native operation for the right end, so it requires -- that end be a 'DoubleEnd'. pushR :: d elt -> elt -> IO () class DequeClass d => BoundedL d where -- | Create a new, bounded deque with a specified capacity. newBoundedQ :: Int -> IO (d elt) -- | For a bounded deque, pushing may fail if the deque is full. tryPushL :: d elt -> elt -> IO Bool class PushR d => BoundedR d where -- | For a bounded deque, pushing may fail if the deque is full. tryPushR :: d elt -> elt -> IO Bool abstract-deque-0.3/Data/Concurrent/Deque/Debugger.hs0000644000000000000000000000413312274327523020574 0ustar0000000000000000 -- | This module provides a wrapper around a deque that can enforce additional -- invariants at runtime for debugging purposes. module Data.Concurrent.Deque.Debugger (DebugDeque(DebugDeque)) where import Data.IORef import Control.Concurrent import Data.Concurrent.Deque.Class -- newtype DebugDeque d = DebugDeque d -- | Warning, this enforces the excessively STRONG invariant that if any end of the -- deque is non-threadsafe then it may ever only be touched by one thread during its -- entire lifetime. -- -- This extreme form of monagamy is easier to verify, because we don't have enough -- information to know if two operations on different threads are racing with one -- another or are properly synchronized. -- -- The wrapper data structure has two IORefs to track the last thread that touched -- the left and right end of the deque, respectively. data DebugDeque d elt = DebugDeque (IORef (Maybe ThreadId), IORef (Maybe ThreadId)) (d elt) instance DequeClass d => DequeClass (DebugDeque d) where pushL (DebugDeque (ref,_) q) elt = do markThread (leftThreadSafe q) ref pushL q elt tryPopR (DebugDeque (_,ref) q) = do markThread (rightThreadSafe q) ref tryPopR q newQ = do l <- newIORef Nothing r <- newIORef Nothing fmap (DebugDeque (l,r)) newQ -- FIXME: What are the threadsafe rules for nullQ? nullQ (DebugDeque _ q) = nullQ q leftThreadSafe (DebugDeque _ q) = leftThreadSafe q rightThreadSafe (DebugDeque _ q) = rightThreadSafe q instance PopL d => PopL (DebugDeque d) where tryPopL (DebugDeque (ref,_) q) = do markThread (leftThreadSafe q) ref tryPopL q -- | Mark the last thread to use this endpoint. markThread True _ = return () -- Don't bother tracking. markThread False ref = do last <- readIORef ref tid <- myThreadId -- putStrLn$"Marking! "++show tid atomicModifyIORef ref $ \ x -> case x of Nothing -> (Just tid, ()) Just tid2 | tid == tid2 -> (Just tid,()) | otherwise -> error$ "DebugDeque: invariant violated, thread safety not allowed but accessed by: "++show (tid,tid2) abstract-deque-0.3/Data/Concurrent/Deque/Reference.hs0000644000000000000000000000715512274327523020755 0ustar0000000000000000{-# LANGUAGE TypeFamilies, CPP, BangPatterns #-} {-| A strawman implementation of concurrent Dequeues. This implementation is so simple that it also makes a good reference implementation for debugging. The queue representation is simply an IORef containing a Data.Sequence. Also see "Data.Concurrent.Deque.Reference.DequeInstance". By convention a module of this name is also provided. -} module Data.Concurrent.Deque.Reference (SimpleDeque(..), newQ, nullQ, newBoundedQ, pushL, pushR, tryPopR, tryPopL, tryPushL, tryPushR, _is_using_CAS -- Internal ) where import Prelude hiding (length) import qualified Data.Concurrent.Deque.Class as C import Data.Sequence import Data.IORef #ifdef USE_CAS #warning "abstract-deque: reference implementation using CAS..." import Data.CAS (atomicModifyIORefCAS) -- Toggle these and compare performance: modify = atomicModifyIORefCAS _is_using_CAS = True #else modify = atomicModifyIORef _is_using_CAS = False #endif {-# INLINE modify #-} modify :: IORef a -> (a -> (a, b)) -> IO b _is_using_CAS :: Bool -- | Stores a size bound (if any) as well as a mutable Seq. data SimpleDeque elt = DQ {-# UNPACK #-} !Int !(IORef (Seq elt)) newQ :: IO (SimpleDeque elt) newQ = do r <- newIORef empty return $! DQ 0 r newBoundedQ :: Int -> IO (SimpleDeque elt) newBoundedQ lim = do r <- newIORef empty return $! DQ lim r pushL :: SimpleDeque t -> t -> IO () pushL (DQ 0 qr) !x = do () <- modify qr addleft return () where -- Here we are very strict to avoid stack leaks. addleft !s = extended `seq` pair where extended = x <| s pair = (extended, ()) pushL (DQ n _) _ = error$ "should not call pushL on Deque with size bound "++ show n tryPopR :: SimpleDeque a -> IO (Maybe a) tryPopR (DQ _ qr) = modify qr $ \ s -> case viewr s of EmptyR -> (empty, Nothing) s' :> x -> (s', Just x) nullQ :: SimpleDeque elt -> IO Bool nullQ (DQ _ qr) = do s <- readIORef qr case viewr s of EmptyR -> return True _ :> _ -> return False -- -- This simplistic version simply spins: -- popR q = do x <- tryPopR q -- case x of -- Nothing -> popR q -- Just x -> return x -- popL q = do x <- tryPopL q -- case x of -- Nothing -> popL q -- Just x -> return x tryPopL :: SimpleDeque a -> IO (Maybe a) tryPopL (DQ _ qr) = modify qr $ \s -> case viewl s of EmptyL -> (empty, Nothing) x :< s' -> (s', Just x) pushR :: SimpleDeque t -> t -> IO () pushR (DQ 0 qr) x = modify qr (\s -> (s |> x, ())) pushR (DQ n _) _ = error$ "should not call pushR on Deque with size bound "++ show n tryPushL :: SimpleDeque a -> a -> IO Bool tryPushL q@(DQ 0 _) v = pushL q v >> return True tryPushL (DQ lim qr) v = modify qr $ \s -> if length s == lim then (s, False) else (v <| s, True) tryPushR :: SimpleDeque a -> a -> IO Bool tryPushR q@(DQ 0 _) v = pushR q v >> return True tryPushR (DQ lim qr) v = modify qr $ \s -> if length s == lim then (s, False) else (s |> v, True) -------------------------------------------------------------------------------- -- Instances -------------------------------------------------------------------------------- instance C.DequeClass SimpleDeque where newQ = newQ nullQ = nullQ pushL = pushL tryPopR = tryPopR leftThreadSafe _ = True rightThreadSafe _ = True instance C.PopL SimpleDeque where tryPopL = tryPopL instance C.PushR SimpleDeque where pushR = pushR instance C.BoundedL SimpleDeque where tryPushL = tryPushL newBoundedQ = newBoundedQ instance C.BoundedR SimpleDeque where tryPushR = tryPushR abstract-deque-0.3/Data/Concurrent/Deque/Reference/0000755000000000000000000000000012274327523020411 5ustar0000000000000000abstract-deque-0.3/Data/Concurrent/Deque/Reference/DequeInstance.hs0000644000000000000000000000156212274327523023501 0ustar0000000000000000{-# LANGUAGE TypeFamilies, TypeSynonymInstances #-} {- | By convention, every provider of the "Data.Concurrent.Deque.Class" interface optionally provides a module that provides the relevant instances of the 'Deque' type class, covering the [maximum] portion of the configuration space that the implementation is able to handle. This is kept in a separate package because importing instances is unconditional and the user may well want to assemble their own combination of 'Deque' instances to cover the configuration space. -} module Data.Concurrent.Deque.Reference.DequeInstance () where import Data.Concurrent.Deque.Class import qualified Data.Concurrent.Deque.Reference as R -- | The reference implementation is a fully general Deque. It can -- thus cover the full configuration space. type instance Deque lt rt l r bnd safe elt = R.SimpleDeque elt