{-# LANGUAGE FlexibleInstances, 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 = do
ref <- newMutVar Seq.empty
return (SeqQueue ref)
instance PrimMonad m => Enqueue (SeqQueue m a) m a where
{-# INLINE enqueue #-}
enqueue (SeqQueue ref) val = do
modifyMutVar ref (Seq.|> val)
instance PrimMonad m => Dequeue (SeqQueue m a) m a where
{-# INLINE dequeue #-}
dequeue (SeqQueue ref) = do
s <- readMutVar ref
case Seq.viewl s of
Seq.EmptyL -> return Nothing
val Seq.:< s' -> do
writeMutVar ref s'
return (Just val)
{-# INLINE dequeueBatch #-}
dequeueBatch (SeqQueue ref) = do
s <- readMutVar ref
writeMutVar ref Seq.empty
return (toList s)
instance PrimMonad m => QueueSize (SeqQueue m a) m where
{-# INLINE queueSize #-}
queueSize (SeqQueue ref) = do
s <- readMutVar ref
return $! Seq.length s
{-# INLINE clear #-}
clear :: PrimMonad m => SeqQueue m a -> m ()
clear (SeqQueue ref) = do
writeMutVar ref Seq.empty