{-# OPTIONS_HADDOCK show-extensions #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
module ToySolver.Internal.Data.SeqQueue
(
SeqQueue
, NewFifo (..)
, Enqueue (..)
, Dequeue (..)
, QueueSize (..)
, clear
) where
import Control.Monad.Primitive
import Control.Monad.ST
import Data.Queue
import Data.Foldable
import Data.Primitive.MutVar
import qualified Data.Sequence as Seq
newtype SeqQueue m a = SeqQueue (MutVar (PrimState m) (Seq.Seq a))
instance PrimMonad m => NewFifo (SeqQueue m a) m where
{-# INLINE newFifo #-}
newFifo :: m (SeqQueue m a)
newFifo = do
MutVar (PrimState m) (Seq a)
ref <- forall (m :: * -> *) a.
PrimMonad m =>
a -> m (MutVar (PrimState m) a)
newMutVar forall a. Seq a
Seq.empty
forall (m :: * -> *) a. Monad m => a -> m a
return (forall (m :: * -> *) a.
MutVar (PrimState m) (Seq a) -> SeqQueue m a
SeqQueue MutVar (PrimState m) (Seq a)
ref)
instance PrimMonad m => Enqueue (SeqQueue m a) m a where
{-# INLINE enqueue #-}
enqueue :: SeqQueue m a -> a -> m ()
enqueue (SeqQueue MutVar (PrimState m) (Seq a)
ref) a
val = do
forall (m :: * -> *) a.
PrimMonad m =>
MutVar (PrimState m) a -> (a -> a) -> m ()
modifyMutVar MutVar (PrimState m) (Seq a)
ref (forall a. Seq a -> a -> Seq a
Seq.|> a
val)
instance PrimMonad m => Dequeue (SeqQueue m a) m a where
{-# INLINE dequeue #-}
dequeue :: SeqQueue m a -> m (Maybe a)
dequeue (SeqQueue MutVar (PrimState m) (Seq a)
ref) = do
Seq a
s <- forall (m :: * -> *) a.
PrimMonad m =>
MutVar (PrimState m) a -> m a
readMutVar MutVar (PrimState m) (Seq a)
ref
case forall a. Seq a -> ViewL a
Seq.viewl Seq a
s of
ViewL a
Seq.EmptyL -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
a
val Seq.:< Seq a
s' -> do
forall (m :: * -> *) a.
PrimMonad m =>
MutVar (PrimState m) a -> a -> m ()
writeMutVar MutVar (PrimState m) (Seq a)
ref Seq a
s'
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just a
val)
{-# INLINE dequeueBatch #-}
dequeueBatch :: SeqQueue m a -> m [a]
dequeueBatch (SeqQueue MutVar (PrimState m) (Seq a)
ref) = do
Seq a
s <- forall (m :: * -> *) a.
PrimMonad m =>
MutVar (PrimState m) a -> m a
readMutVar MutVar (PrimState m) (Seq a)
ref
forall (m :: * -> *) a.
PrimMonad m =>
MutVar (PrimState m) a -> a -> m ()
writeMutVar MutVar (PrimState m) (Seq a)
ref forall a. Seq a
Seq.empty
forall (m :: * -> *) a. Monad m => a -> m a
return (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq a
s)
instance PrimMonad m => QueueSize (SeqQueue m a) m where
{-# INLINE queueSize #-}
queueSize :: SeqQueue m a -> m Int
queueSize (SeqQueue MutVar (PrimState m) (Seq a)
ref) = do
Seq a
s <- forall (m :: * -> *) a.
PrimMonad m =>
MutVar (PrimState m) a -> m a
readMutVar MutVar (PrimState m) (Seq a)
ref
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall a. Seq a -> Int
Seq.length Seq a
s
{-# INLINE clear #-}
clear :: PrimMonad m => SeqQueue m a -> m ()
clear :: forall (m :: * -> *) a. PrimMonad m => SeqQueue m a -> m ()
clear (SeqQueue MutVar (PrimState m) (Seq a)
ref) = do
forall (m :: * -> *) a.
PrimMonad m =>
MutVar (PrimState m) a -> a -> m ()
writeMutVar MutVar (PrimState m) (Seq a)
ref forall a. Seq a
Seq.empty