Treiber 0.0.3 → 0.0.4

raw patch · 2 files changed

+29/−21 lines, 2 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• Data/NonBlocking/LockFree/Treiber.hs +22/−19
• Treiber.cabal +7/−2

@@ -8,42 +8,43 @@  An implementation of Treiber stacks, a lock free stack. Works with any monad that has atomically modificable references. -}+ module Data.NonBlocking.LockFree.Treiber(TreiberStack(), TreiberStackIO, TreiberStackSTM, newTreiberStack, pushTreiberStack, popTreiberStack) where  import Control.Concurrent.STM (STM()) import Control.Concurrent.STM.TVar (TVar()) import Control.Monad(join, when) import Control.Monad.Loops(whileM_)-import Control.Monad.Ref-import Data.IORef+import Control.Monad.Ref(MonadAtomicRef, newRef, readRef, writeRef, atomicModifyRef)+import Data.IORef(IORef) import GHC.Exts (Int(I#)) import GHC.Prim (reallyUnsafePtrEquality#) --- |TreiberStack inside the IO Monad.+-- |TreiberStack inside the 'IO' 'Monad'. type TreiberStackIO a = TreiberStack IORef a--- |TreiberStack inside the STM Monad.+-- |TreiberStack inside the 'STM' 'Monad'. type TreiberStackSTM a = TreiberStack TVar a --- |A Lock-free concurrent Treiber stack usable in any monad, m, that is paired with a reference type, r, by an instance of 'MonadAtomicRef'. Can use Specializations TreiberStackIO and TreiberStackSTM+-- |A lock-free concurrent Treiber stack usable in any 'Monad', m, that is paired with a reference type, r, by an instance of 'MonadAtomicRef'. Can use Specializations 'TreiberStackIO' and 'TreiberStackSTM'. data TreiberStack r a = TreiberStack (r (TreiberElem r a)) data TreiberElem r a = TreiberElem a (r (TreiberElem r a)) | End -instance (Eq a) => Eq (TreiberElem r a) where+instance Eq (TreiberElem r a) where   End == End = True-  (TreiberElem x rest1) == (TreiberElem y rest2) = (x == y) && (ptrEq rest1 rest2)+  (TreiberElem x rest1) == (TreiberElem y rest2) = (ptrEq rest1 rest2) -{-# SPECIALIZE newTreiberStack :: (Eq a) => IO (TreiberStackIO a) #-}-{-# SPECIALIZE newTreiberStack :: (Eq a) => STM (TreiberStackSTM a) #-}--- |Creates a new empty instance of the 'TreiberStack'. Internally implemented with a reference of type r, which is why they must be atomically modifiable.-newTreiberStack :: (MonadAtomicRef r m, Eq a) => m (TreiberStack r a)+{-# SPECIALIZE newTreiberStack :: IO (TreiberStackIO a) #-}+{-# SPECIALIZE newTreiberStack :: STM (TreiberStackSTM a) #-}+-- |Creates a new empty instance of the 'TreiberStack'. Internally implemented with a reference of type r, which is why they must be atomically modifiable. Initially empty.+newTreiberStack :: (MonadAtomicRef r m) => m (TreiberStack r a) newTreiberStack = do   ref <- newRef End   return (TreiberStack ref) -{-# SPECIALIZE pushTreiberStack :: (Eq a) => TreiberStackIO a -> a -> IO () #-}-{-# SPECIALIZE pushTreiberStack :: (Eq a) => TreiberStackSTM a -> a -> STM () #-}--- |Pushes an element on to a Treiber stack.-pushTreiberStack :: (MonadAtomicRef r m, Eq a) => TreiberStack r a -> a -> m ()+{-# SPECIALIZE pushTreiberStack :: TreiberStackIO a -> a -> IO () #-}+{-# SPECIALIZE pushTreiberStack :: TreiberStackSTM a -> a -> STM () #-}+-- |Pushes an element on to a 'TreiberStack' in a lock-free manner.+pushTreiberStack :: (MonadAtomicRef r m) => TreiberStack r a -> a -> m () pushTreiberStack (TreiberStack x) v = do   let partConstr = TreiberElem v   b <- newRef False@@ -53,10 +54,10 @@     suc <- cas x z (partConstr res)     writeRef b suc -{-# SPECIALIZE popTreiberStack :: (Eq a) => TreiberStackIO a -> IO (Maybe a) #-}-{-# SPECIALIZE popTreiberStack :: (Eq a) => TreiberStackSTM a -> STM (Maybe a) #-}--- |Pops an element of a Treiber stack. Returns 'Nothing' if the stack is empty.-popTreiberStack :: (MonadAtomicRef r m, Eq a) => TreiberStack r a -> m (Maybe a)+{-# SPECIALIZE popTreiberStack :: TreiberStackIO a -> IO (Maybe a) #-}+{-# SPECIALIZE popTreiberStack :: TreiberStackSTM a -> STM (Maybe a) #-}+-- |Pops an element of a 'TreiberStack' in a lock-free manner. Returns 'Nothing' if the stack is empty.+popTreiberStack :: (MonadAtomicRef r m) => TreiberStack r a -> m (Maybe a) popTreiberStack (TreiberStack x) = do   b <- newRef False   ret <- newRef Nothing@@ -72,6 +73,8 @@         when suc $ writeRef ret (Just elem)   readRef ret +{-# SPECIALIZE cas :: (Eq a) => IORef a -> a -> a -> IO Bool #-}+{-# SPECIALIZE cas :: (Eq a) => TVar a -> a -> a -> STM Bool #-} cas :: (MonadAtomicRef r m, Eq a) => r a -> a -> a -> m Bool cas ref comp rep = atomicModifyRef ref (\val -> let b = val == comp in (if b then rep else val, b)) 

@@ -1,5 +1,5 @@ Name:		Treiber-Version:	0.0.3+Version:	0.0.4 Cabal-Version:  >= 1.2 License:	BSD3 Author:		Julian Sutherland@@ -8,7 +8,12 @@ Synopsis:	Lock free Treiber stack Build-Type:     Simple Maintainer:     Julian Sutherland (julian.sutherland10@imperial.ac.uk)-Description:    An implementation of Treiber stacks, a lock free stack. Works with any monad that has atomically modificable references. Removed debug code accidentally left in in version 0.0.1 and added specializations of the TreiberStack data structure to the IO and STM monads (forgotten to export in 0.0.2).+Description:    An implementation of Treiber stacks, a lock free stack. Works with any monad that has atomically modificable references. ++  0.0.2: Removed debug code accidentally left in in version 0.0.1.+  0.0.3: Added specializations of the TreiberStack data structure to the IO and STM monads (forgotten to export in 0.0.2).+  0.0.4: Modification to remove unrequired Eq class requirement and changed broken specialize pragma.+   License-file:   LICENSE  Library