summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorjulek <>2015-01-31 19:39:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2015-01-31 19:39:00 (GMT)
commit1f75f7d6f85b9205e49080327d3cfa6f9c390cac (patch)
tree8b9f6244e7ced2e5b3c475944dca5e4735ccea14
parent3b2e58f5a733066ba353c3ee5775bcd4796dca4f (diff)
version 0.0.4HEAD0.0.4master
-rw-r--r--Data/NonBlocking/LockFree/Treiber.hs41
-rw-r--r--Treiber.cabal9
2 files changed, 29 insertions, 21 deletions
diff --git a/Data/NonBlocking/LockFree/Treiber.hs b/Data/NonBlocking/LockFree/Treiber.hs
index d33e1a2..0ab9286 100644
--- a/Data/NonBlocking/LockFree/Treiber.hs
+++ b/Data/NonBlocking/LockFree/Treiber.hs
@@ -8,42 +8,43 @@ Maintainer : Julian Sutherland (julian.sutherland10@imperial.ac.uk)
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 @@ pushTreiberStack (TreiberStack x) v = do
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 @@ popTreiberStack (TreiberStack x) = do
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))
diff --git a/Treiber.cabal b/Treiber.cabal
index 3bd0ed9..d0a1d25 100644
--- a/Treiber.cabal
+++ b/Treiber.cabal
@@ -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 @@ Category: Data
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