{-# LANGUAGE TypeFamilies, CPP, BangPatterns #-}
module Data.Concurrent.Deque.Reference
(SimpleDeque(..),
newQ, nullQ, newBoundedQ, pushL, pushR, tryPopR, tryPopL, tryPushL, tryPushR,
_is_using_CAS
)
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)
modify = atomicModifyIORefCAS
_is_using_CAS = True
#else
modify :: forall a b. IORef a -> (a -> (a, b)) -> IO b
modify = forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef
_is_using_CAS :: Bool
_is_using_CAS = Bool
False
#endif
{-# INLINE modify #-}
modify :: IORef a -> (a -> (a, b)) -> IO b
_is_using_CAS :: Bool
data SimpleDeque elt = DQ {-# UNPACK #-} !Int !(IORef (Seq elt))
newQ :: IO (SimpleDeque elt)
newQ :: forall elt. IO (SimpleDeque elt)
newQ = do IORef (Seq elt)
r <- forall a. a -> IO (IORef a)
newIORef forall a. Seq a
empty
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall elt. Int -> IORef (Seq elt) -> SimpleDeque elt
DQ Int
0 IORef (Seq elt)
r
newBoundedQ :: Int -> IO (SimpleDeque elt)
newBoundedQ :: forall elt. Int -> IO (SimpleDeque elt)
newBoundedQ Int
lim =
do IORef (Seq elt)
r <- forall a. a -> IO (IORef a)
newIORef forall a. Seq a
empty
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall elt. Int -> IORef (Seq elt) -> SimpleDeque elt
DQ Int
lim IORef (Seq elt)
r
pushL :: SimpleDeque t -> t -> IO ()
pushL :: forall t. SimpleDeque t -> t -> IO ()
pushL (DQ Int
0 IORef (Seq t)
qr) !t
x = do
() <- forall a b. IORef a -> (a -> (a, b)) -> IO b
modify IORef (Seq t)
qr Seq t -> (Seq t, ())
addleft
forall (m :: * -> *) a. Monad m => a -> m a
return ()
where
addleft :: Seq t -> (Seq t, ())
addleft !Seq t
s = Seq t
extended seq :: forall a b. a -> b -> b
`seq` (Seq t, ())
pair
where extended :: Seq t
extended = t
x forall a. a -> Seq a -> Seq a
<| Seq t
s
pair :: (Seq t, ())
pair = (Seq t
extended, ())
pushL (DQ Int
n IORef (Seq t)
_) t
_ = forall a. HasCallStack => [Char] -> a
errorforall a b. (a -> b) -> a -> b
$ [Char]
"should not call pushL on Deque with size bound "forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
n
tryPopR :: SimpleDeque a -> IO (Maybe a)
tryPopR :: forall a. SimpleDeque a -> IO (Maybe a)
tryPopR (DQ Int
_ IORef (Seq a)
qr) = forall a b. IORef a -> (a -> (a, b)) -> IO b
modify IORef (Seq a)
qr forall a b. (a -> b) -> a -> b
$ \ Seq a
s ->
case forall a. Seq a -> ViewR a
viewr Seq a
s of
ViewR a
EmptyR -> (forall a. Seq a
empty, forall a. Maybe a
Nothing)
Seq a
s' :> a
x -> (Seq a
s', forall a. a -> Maybe a
Just a
x)
nullQ :: SimpleDeque elt -> IO Bool
nullQ :: forall elt. SimpleDeque elt -> IO Bool
nullQ (DQ Int
_ IORef (Seq elt)
qr) =
do Seq elt
s <- forall a. IORef a -> IO a
readIORef IORef (Seq elt)
qr
case forall a. Seq a -> ViewR a
viewr Seq elt
s of
ViewR elt
EmptyR -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
Seq elt
_ :> elt
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
tryPopL :: SimpleDeque a -> IO (Maybe a)
tryPopL :: forall a. SimpleDeque a -> IO (Maybe a)
tryPopL (DQ Int
_ IORef (Seq a)
qr) = forall a b. IORef a -> (a -> (a, b)) -> IO b
modify IORef (Seq a)
qr forall a b. (a -> b) -> a -> b
$ \Seq a
s ->
case forall a. Seq a -> ViewL a
viewl Seq a
s of
ViewL a
EmptyL -> (forall a. Seq a
empty, forall a. Maybe a
Nothing)
a
x :< Seq a
s' -> (Seq a
s', forall a. a -> Maybe a
Just a
x)
pushR :: SimpleDeque t -> t -> IO ()
pushR :: forall t. SimpleDeque t -> t -> IO ()
pushR (DQ Int
0 IORef (Seq t)
qr) t
x = forall a b. IORef a -> (a -> (a, b)) -> IO b
modify IORef (Seq t)
qr (\Seq t
s -> (Seq t
s forall a. Seq a -> a -> Seq a
|> t
x, ()))
pushR (DQ Int
n IORef (Seq t)
_) t
_ = forall a. HasCallStack => [Char] -> a
errorforall a b. (a -> b) -> a -> b
$ [Char]
"should not call pushR on Deque with size bound "forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
n
tryPushL :: SimpleDeque a -> a -> IO Bool
tryPushL :: forall a. SimpleDeque a -> a -> IO Bool
tryPushL q :: SimpleDeque a
q@(DQ Int
0 IORef (Seq a)
_) a
v = forall t. SimpleDeque t -> t -> IO ()
pushL SimpleDeque a
q a
v forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
tryPushL (DQ Int
lim IORef (Seq a)
qr) a
v =
forall a b. IORef a -> (a -> (a, b)) -> IO b
modify IORef (Seq a)
qr forall a b. (a -> b) -> a -> b
$ \Seq a
s ->
if forall a. Seq a -> Int
length Seq a
s forall a. Eq a => a -> a -> Bool
== Int
lim
then (Seq a
s, Bool
False)
else (a
v forall a. a -> Seq a -> Seq a
<| Seq a
s, Bool
True)
tryPushR :: SimpleDeque a -> a -> IO Bool
tryPushR :: forall a. SimpleDeque a -> a -> IO Bool
tryPushR q :: SimpleDeque a
q@(DQ Int
0 IORef (Seq a)
_) a
v = forall t. SimpleDeque t -> t -> IO ()
pushR SimpleDeque a
q a
v forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
tryPushR (DQ Int
lim IORef (Seq a)
qr) a
v =
forall a b. IORef a -> (a -> (a, b)) -> IO b
modify IORef (Seq a)
qr forall a b. (a -> b) -> a -> b
$ \Seq a
s ->
if forall a. Seq a -> Int
length Seq a
s forall a. Eq a => a -> a -> Bool
== Int
lim
then (Seq a
s, Bool
False)
else (Seq a
s forall a. Seq a -> a -> Seq a
|> a
v, Bool
True)
instance C.DequeClass SimpleDeque where
newQ :: forall elt. IO (SimpleDeque elt)
newQ = forall elt. IO (SimpleDeque elt)
newQ
nullQ :: forall elt. SimpleDeque elt -> IO Bool
nullQ = forall elt. SimpleDeque elt -> IO Bool
nullQ
pushL :: forall t. SimpleDeque t -> t -> IO ()
pushL = forall t. SimpleDeque t -> t -> IO ()
pushL
tryPopR :: forall a. SimpleDeque a -> IO (Maybe a)
tryPopR = forall a. SimpleDeque a -> IO (Maybe a)
tryPopR
leftThreadSafe :: forall elt. SimpleDeque elt -> Bool
leftThreadSafe SimpleDeque elt
_ = Bool
True
rightThreadSafe :: forall elt. SimpleDeque elt -> Bool
rightThreadSafe SimpleDeque elt
_ = Bool
True
instance C.PopL SimpleDeque where
tryPopL :: forall a. SimpleDeque a -> IO (Maybe a)
tryPopL = forall a. SimpleDeque a -> IO (Maybe a)
tryPopL
instance C.PushR SimpleDeque where
pushR :: forall t. SimpleDeque t -> t -> IO ()
pushR = forall t. SimpleDeque t -> t -> IO ()
pushR
instance C.BoundedL SimpleDeque where
tryPushL :: forall a. SimpleDeque a -> a -> IO Bool
tryPushL = forall a. SimpleDeque a -> a -> IO Bool
tryPushL
newBoundedQ :: forall elt. Int -> IO (SimpleDeque elt)
newBoundedQ = forall elt. Int -> IO (SimpleDeque elt)
newBoundedQ
instance C.BoundedR SimpleDeque where
tryPushR :: forall a. SimpleDeque a -> a -> IO Bool
tryPushR = forall a. SimpleDeque a -> a -> IO Bool
tryPushR