summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorjulek <>2015-01-22 12:44:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2015-01-22 12:44:00 (GMT)
commitedeb6112fb5f92b242b68364ada55834a9618e5f (patch)
tree1798986939fc1aafa798d1cd320f0db512e1e4ba
parentcb8dfce93fb46812e169a6f3bade0d10cacb6b2b (diff)
version 0.0.20.0.2
-rw-r--r--Data/NonBlocking/LockFree/Treiber.hs31
-rw-r--r--Treiber.cabal4
2 files changed, 29 insertions, 6 deletions
diff --git a/Data/NonBlocking/LockFree/Treiber.hs b/Data/NonBlocking/LockFree/Treiber.hs
index 8ad86b0..75c82e7 100644
--- a/Data/NonBlocking/LockFree/Treiber.hs
+++ b/Data/NonBlocking/LockFree/Treiber.hs
@@ -1,13 +1,30 @@
{-# LANGUAGE BangPatterns, MagicHash #-}
+
+{-|
+Module : Treiber
+Description : Implementation of a Treiber stack.
+License : BSD3
+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(), 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 GHC.Exts (Int(I#))
import GHC.Prim (reallyUnsafePtrEquality#)
--- |A Lock-free concurrent Treiber stack usable in any monad, m, that is paired with a reference type, r, by an instance of 'MonadAtomicRef'.
+-- |TreiberStack inside the IO Monad.
+type TreiberStackIO a = TreiberStack IORef a
+-- |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
data TreiberStack r a = TreiberStack (r (TreiberElem r a))
data TreiberElem r a = TreiberElem a (r (TreiberElem r a)) | End
@@ -15,14 +32,18 @@ instance (Eq a) => Eq (TreiberElem r a) where
End == End = True
(TreiberElem x rest1) == (TreiberElem y rest2) = (x == y) && (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, Show a) => m (TreiberStack r a)
+newTreiberStack :: (MonadAtomicRef r m, Eq a) => 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, Show a) => TreiberStack r a -> a -> m ()
+pushTreiberStack :: (MonadAtomicRef r m, Eq a) => TreiberStack r a -> a -> m ()
pushTreiberStack (TreiberStack x) v = do
let partConstr = TreiberElem v
b <- newRef False
@@ -32,8 +53,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, Show a) => TreiberStack r a -> m (Maybe a)
+popTreiberStack :: (MonadAtomicRef r m, Eq a) => TreiberStack r a -> m (Maybe a)
popTreiberStack (TreiberStack x) = do
b <- newRef False
ret <- newRef Nothing
diff --git a/Treiber.cabal b/Treiber.cabal
index 97a866b..89c946c 100644
--- a/Treiber.cabal
+++ b/Treiber.cabal
@@ -1,5 +1,5 @@
Name: Treiber
-Version: 0.0.1
+Version: 0.0.2
Cabal-Version: >= 1.2
License: BSD3
Author: Julian Sutherland
@@ -12,5 +12,5 @@ Description: An implementation of Treiber stacks, a lock free stack. Works wi
License-file: LICENSE
Library
- Build-Depends: base >= 4.6 && < 4.8, ghc-prim >= 0.3 && < 0.4, monad-loops >= 0.4.2 && < 0.5, ref-mtl <0.4 && >= 0.3
+ Build-Depends: base >= 4.6 && < 4.8, ghc-prim >= 0.3 && < 0.4, monad-loops >= 0.4.2 && < 0.5, ref-mtl <2.3 && >= 0.2.1, stm >= 0.2.4 && < 2.5
Exposed-modules: Data.NonBlocking.LockFree.Treiber