{-# LANGUAGE TypeFamilies #-}
module Data.Mutable.Deque
( Deque
, UDeque
, asUDeque
, SDeque
, asSDeque
, BDeque
, asBDeque
, module Data.Mutable.Class
) where
import Control.Exception (assert)
import Control.Monad (liftM)
import Data.Mutable.Class
import qualified Data.Vector.Generic.Mutable as V
import qualified Data.Vector.Mutable as B
import qualified Data.Vector.Storable.Mutable as S
import qualified Data.Vector.Unboxed.Mutable as U
data DequeState v s a = DequeState
(v s a)
{-# UNPACK #-} !Int
{-# UNPACK #-} !Int
newtype Deque v s a = Deque (MutVar s (DequeState v s a))
type UDeque = Deque U.MVector
type SDeque = Deque S.MVector
type BDeque = Deque B.MVector
asUDeque :: UDeque s a -> UDeque s a
asUDeque :: forall s a. UDeque s a -> UDeque s a
asUDeque = forall a. a -> a
id
asSDeque :: SDeque s a -> SDeque s a
asSDeque :: forall s a. SDeque s a -> SDeque s a
asSDeque = forall a. a -> a
id
asBDeque :: BDeque s a -> BDeque s a
asBDeque :: forall s a. BDeque s a -> BDeque s a
asBDeque = forall a. a -> a
id
instance MutableContainer (Deque v s a) where
type MCState (Deque v s a) = s
instance V.MVector v a => MutableCollection (Deque v s a) where
type CollElement (Deque v s a) = a
newColl :: forall (m :: * -> *).
(PrimMonad m, PrimState m ~ MCState (Deque v s a)) =>
m (Deque v s a)
newColl = do
v s a
v <- forall (m :: * -> *) (v :: * -> * -> *) a.
(HasCallStack, PrimMonad m, MVector v a) =>
Int -> m (v (PrimState m) a)
V.new Int
baseSize
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM forall (v :: * -> * -> *) s a.
MutVar s (DequeState v s a) -> Deque v s a
Deque forall a b. (a -> b) -> a -> b
$ forall c (m :: * -> *).
(MutableRef c, PrimMonad m, PrimState m ~ MCState c) =>
RefElement c -> m c
newRef (forall (v :: * -> * -> *) s a.
v s a -> Int -> Int -> DequeState v s a
DequeState v s a
v Int
0 Int
0)
where
baseSize :: Int
baseSize = Int
32
{-# INLINE newColl #-}
instance V.MVector v a => MutablePopFront (Deque v s a) where
popFront :: forall (m :: * -> *).
(PrimMonad m, PrimState m ~ MCState (Deque v s a)) =>
Deque v s a -> m (Maybe (CollElement (Deque v s a)))
popFront (Deque MutVar s (DequeState v s a)
var) = do
DequeState v s a
v Int
start Int
size <- forall c (m :: * -> *).
(MutableRef c, PrimMonad m, PrimState m ~ MCState c) =>
c -> m (RefElement c)
readRef MutVar s (DequeState v s a)
var
if Int
size forall a. Eq a => a -> a -> Bool
== Int
0
then forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
else do
a
x <- forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> Int -> m a
V.unsafeRead v s a
v Int
start
let start' :: Int
start' = Int
start forall a. Num a => a -> a -> a
+ Int
1
start'' :: Int
start''
| Int
start' forall a. Ord a => a -> a -> Bool
>= forall (v :: * -> * -> *) a s. MVector v a => v s a -> Int
V.length v s a
v = Int
0
| Bool
otherwise = Int
start'
forall c (m :: * -> *).
(MutableRef c, PrimMonad m, PrimState m ~ MCState c) =>
c -> RefElement c -> m ()
writeRef MutVar s (DequeState v s a)
var forall a b. (a -> b) -> a -> b
$! forall (v :: * -> * -> *) s a.
v s a -> Int -> Int -> DequeState v s a
DequeState v s a
v Int
start'' (Int
size forall a. Num a => a -> a -> a
- Int
1)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall a. a -> Maybe a
Just a
x
{-# INLINE popFront #-}
instance V.MVector v a => MutablePopBack (Deque v s a) where
popBack :: forall (m :: * -> *).
(PrimMonad m, PrimState m ~ MCState (Deque v s a)) =>
Deque v s a -> m (Maybe (CollElement (Deque v s a)))
popBack (Deque MutVar s (DequeState v s a)
var) = do
DequeState v s a
v Int
start Int
size <- forall c (m :: * -> *).
(MutableRef c, PrimMonad m, PrimState m ~ MCState c) =>
c -> m (RefElement c)
readRef MutVar s (DequeState v s a)
var
if Int
size forall a. Eq a => a -> a -> Bool
== Int
0
then forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
else do
let size' :: Int
size' = Int
size forall a. Num a => a -> a -> a
- Int
1
end :: Int
end = Int
start forall a. Num a => a -> a -> a
+ Int
size'
end' :: Int
end'
| Int
end forall a. Ord a => a -> a -> Bool
>= forall (v :: * -> * -> *) a s. MVector v a => v s a -> Int
V.length v s a
v = Int
end forall a. Num a => a -> a -> a
- forall (v :: * -> * -> *) a s. MVector v a => v s a -> Int
V.length v s a
v
| Bool
otherwise = Int
end
a
x <- forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> Int -> m a
V.unsafeRead v s a
v Int
end'
forall c (m :: * -> *).
(MutableRef c, PrimMonad m, PrimState m ~ MCState c) =>
c -> RefElement c -> m ()
writeRef MutVar s (DequeState v s a)
var forall a b. (a -> b) -> a -> b
$! forall (v :: * -> * -> *) s a.
v s a -> Int -> Int -> DequeState v s a
DequeState v s a
v Int
start Int
size'
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall a. a -> Maybe a
Just a
x
{-# INLINE popBack #-}
instance V.MVector v a => MutablePushFront (Deque v s a) where
pushFront :: forall (m :: * -> *).
(PrimMonad m, PrimState m ~ MCState (Deque v s a)) =>
Deque v s a -> CollElement (Deque v s a) -> m ()
pushFront (Deque MutVar s (DequeState v s a)
var) CollElement (Deque v s a)
x = do
DequeState v s a
v Int
start Int
size <- forall c (m :: * -> *).
(MutableRef c, PrimMonad m, PrimState m ~ MCState c) =>
c -> m (RefElement c)
readRef MutVar s (DequeState v s a)
var
v s a -> Int -> Int -> m ()
inner v s a
v Int
start Int
size
where
inner :: v s a -> Int -> Int -> m ()
inner v s a
v Int
start Int
size = do
if Int
size forall a. Ord a => a -> a -> Bool
>= forall (v :: * -> * -> *) a s. MVector v a => v s a -> Int
V.length v s a
v
then forall (m :: * -> *) (v :: * -> * -> *) a b.
(PrimMonad m, MVector v a) =>
v (PrimState m) a
-> Int -> Int -> (v (PrimState m) a -> Int -> Int -> m b) -> m b
newVector v s a
v Int
start Int
size v s a -> Int -> Int -> m ()
inner
else do
let size' :: Int
size' = Int
size forall a. Num a => a -> a -> a
+ Int
1
start' :: Int
start' = (Int
start forall a. Num a => a -> a -> a
- Int
1) forall a. Integral a => a -> a -> a
`rem` forall (v :: * -> * -> *) a s. MVector v a => v s a -> Int
V.length v s a
v
start'' :: Int
start''
| Int
start' forall a. Ord a => a -> a -> Bool
< Int
0 = forall (v :: * -> * -> *) a s. MVector v a => v s a -> Int
V.length v s a
v forall a. Num a => a -> a -> a
+ Int
start'
| Bool
otherwise = Int
start'
forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> Int -> a -> m ()
V.unsafeWrite v s a
v Int
start'' CollElement (Deque v s a)
x
forall c (m :: * -> *).
(MutableRef c, PrimMonad m, PrimState m ~ MCState c) =>
c -> RefElement c -> m ()
writeRef MutVar s (DequeState v s a)
var forall a b. (a -> b) -> a -> b
$! forall (v :: * -> * -> *) s a.
v s a -> Int -> Int -> DequeState v s a
DequeState v s a
v Int
start'' Int
size'
{-# INLINE pushFront #-}
instance V.MVector v a => MutablePushBack (Deque v s a) where
pushBack :: forall (m :: * -> *).
(PrimMonad m, PrimState m ~ MCState (Deque v s a)) =>
Deque v s a -> CollElement (Deque v s a) -> m ()
pushBack (Deque MutVar s (DequeState v s a)
var) CollElement (Deque v s a)
x = do
DequeState v s a
v Int
start Int
size <- forall c (m :: * -> *).
(MutableRef c, PrimMonad m, PrimState m ~ MCState c) =>
c -> m (RefElement c)
readRef MutVar s (DequeState v s a)
var
v s a -> Int -> Int -> m ()
inner v s a
v Int
start Int
size
where
inner :: v s a -> Int -> Int -> m ()
inner v s a
v Int
start Int
size = do
if Int
size forall a. Ord a => a -> a -> Bool
>= forall (v :: * -> * -> *) a s. MVector v a => v s a -> Int
V.length v s a
v
then forall (m :: * -> *) (v :: * -> * -> *) a b.
(PrimMonad m, MVector v a) =>
v (PrimState m) a
-> Int -> Int -> (v (PrimState m) a -> Int -> Int -> m b) -> m b
newVector v s a
v Int
start Int
size v s a -> Int -> Int -> m ()
inner
else do
let end :: Int
end = Int
start forall a. Num a => a -> a -> a
+ Int
size
end' :: Int
end'
| Int
end forall a. Ord a => a -> a -> Bool
>= forall (v :: * -> * -> *) a s. MVector v a => v s a -> Int
V.length v s a
v = Int
end forall a. Num a => a -> a -> a
- forall (v :: * -> * -> *) a s. MVector v a => v s a -> Int
V.length v s a
v
| Bool
otherwise = Int
end
forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> Int -> a -> m ()
V.unsafeWrite v s a
v Int
end' CollElement (Deque v s a)
x
forall c (m :: * -> *).
(MutableRef c, PrimMonad m, PrimState m ~ MCState c) =>
c -> RefElement c -> m ()
writeRef MutVar s (DequeState v s a)
var forall a b. (a -> b) -> a -> b
$! forall (v :: * -> * -> *) s a.
v s a -> Int -> Int -> DequeState v s a
DequeState v s a
v Int
start (Int
size forall a. Num a => a -> a -> a
+ Int
1)
{-# INLINE pushBack #-}
newVector :: (PrimMonad m, V.MVector v a)
=> v (PrimState m) a
-> Int
-> Int
-> (v (PrimState m) a -> Int -> Int -> m b)
-> m b
newVector :: forall (m :: * -> *) (v :: * -> * -> *) a b.
(PrimMonad m, MVector v a) =>
v (PrimState m) a
-> Int -> Int -> (v (PrimState m) a -> Int -> Int -> m b) -> m b
newVector v (PrimState m) a
v Int
size2 Int
sizeOrig v (PrimState m) a -> Int -> Int -> m b
f = forall a. HasCallStack => Bool -> a -> a
assert (Int
sizeOrig forall a. Eq a => a -> a -> Bool
== forall (v :: * -> * -> *) a s. MVector v a => v s a -> Int
V.length v (PrimState m) a
v) forall a b. (a -> b) -> a -> b
$ do
v (PrimState m) a
v' <- forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
Int -> m (v (PrimState m) a)
V.unsafeNew (forall (v :: * -> * -> *) a s. MVector v a => v s a -> Int
V.length v (PrimState m) a
v forall a. Num a => a -> a -> a
* Int
2)
let size1 :: Int
size1 = forall (v :: * -> * -> *) a s. MVector v a => v s a -> Int
V.length v (PrimState m) a
v forall a. Num a => a -> a -> a
- Int
size2
forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> v (PrimState m) a -> m ()
V.unsafeCopy
(forall (v :: * -> * -> *) a s. MVector v a => Int -> v s a -> v s a
V.unsafeTake Int
size1 v (PrimState m) a
v')
(forall (v :: * -> * -> *) a s.
MVector v a =>
Int -> Int -> v s a -> v s a
V.unsafeSlice Int
size2 Int
size1 v (PrimState m) a
v)
forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> v (PrimState m) a -> m ()
V.unsafeCopy
(forall (v :: * -> * -> *) a s.
MVector v a =>
Int -> Int -> v s a -> v s a
V.unsafeSlice Int
size1 Int
size2 v (PrimState m) a
v')
(forall (v :: * -> * -> *) a s. MVector v a => Int -> v s a -> v s a
V.unsafeTake Int
size2 v (PrimState m) a
v)
v (PrimState m) a -> Int -> Int -> m b
f v (PrimState m) a
v' Int
0 Int
sizeOrig
{-# INLINE newVector #-}