{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE BangPatterns #-}
module Control.Monad.Logic.Sequence.Internal.ScheduledQueue
( Queue
) where
import Data.SequenceClass (Sequence, ViewL (..))
import qualified Data.SequenceClass as S
import Data.Foldable
import qualified Data.Traversable as T
import qualified Control.Applicative as A
#if !MIN_VERSION_base(4,8,0)
import Data.Functor (Functor (..))
import Data.Monoid (Monoid (..))
#endif
infixl 5 :>
data SL a
= SNil
| !(SL a) :> a
deriving forall a b. a -> SL b -> SL a
forall a b. (a -> b) -> SL a -> SL b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> SL b -> SL a
$c<$ :: forall a b. a -> SL b -> SL a
fmap :: forall a b. (a -> b) -> SL a -> SL b
$cfmap :: forall a b. (a -> b) -> SL a -> SL b
Functor
appendSL :: [a] -> SL a -> [a]
appendSL :: forall a. [a] -> SL a -> [a]
appendSL [a]
f SL a
r = forall a. [a] -> SL a -> [a] -> [a]
rotate [a]
f SL a
r []
rotate :: [a] -> SL a -> [a] -> [a]
rotate :: forall a. [a] -> SL a -> [a] -> [a]
rotate [] (SL a
_SNil :> a
y) [a]
a = a
y forall a. a -> [a] -> [a]
: [a]
a
rotate (a
x : [a]
f) (SL a
r :> a
y) [a]
a = a
x forall a. a -> [a] -> [a]
: forall a. [a] -> SL a -> [a] -> [a]
rotate [a]
f SL a
r (a
y forall a. a -> [a] -> [a]
: [a]
a)
rotate [a]
_f SL a
_a [a]
_r = forall a. HasCallStack => [Char] -> a
error [Char]
"Invariant |f| = |r| + |a| - 1 broken"
data Queue a =
RQ ![a]
!(SL a)
![a]
deriving forall a b. a -> Queue b -> Queue a
forall a b. (a -> b) -> Queue a -> Queue b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Queue b -> Queue a
$c<$ :: forall a b. a -> Queue b -> Queue a
fmap :: forall a b. (a -> b) -> Queue a -> Queue b
$cfmap :: forall a b. (a -> b) -> Queue a -> Queue b
Functor
queue :: [a] -> SL a -> [a] -> Queue a
queue :: forall a. [a] -> SL a -> [a] -> Queue a
queue [a]
f SL a
r [] =
let
f' :: [a]
f' = forall a. [a] -> SL a -> [a]
appendSL [a]
f SL a
r
{-# NOINLINE f' #-}
in forall a. [a] -> SL a -> [a] -> Queue a
RQ [a]
f' forall a. SL a
SNil [a]
f'
queue [a]
f SL a
r (a
_h : [a]
t) = forall a. [a] -> SL a -> [a] -> Queue a
RQ [a]
f SL a
r [a]
t
instance Sequence Queue where
empty :: forall c. Queue c
empty = forall a. [a] -> SL a -> [a] -> Queue a
RQ [] forall a. SL a
SNil []
singleton :: forall c. c -> Queue c
singleton c
x =
let
c :: [c]
c = [c
x]
in forall a. [a] -> SL a -> [a] -> Queue a
RQ [c]
c forall a. SL a
SNil [c]
c
RQ [] SL c
_ [c]
_ |> :: forall c. Queue c -> c -> Queue c
|> c
x = forall (s :: * -> *) c. Sequence s => c -> s c
S.singleton c
x
RQ [c]
f SL c
r [c]
a |> c
x = forall a. [a] -> SL a -> [a] -> Queue a
queue [c]
f (SL c
r forall a. SL a -> a -> SL a
:> c
x) [c]
a
viewl :: forall c. Queue c -> ViewL Queue c
viewl (RQ [] SL c
_SNil [c]
_nil) = forall (s :: * -> *) c. ViewL s c
EmptyL
viewl (RQ (c
h : [c]
t) SL c
f [c]
a) = c
h forall c (s :: * -> *). c -> s c -> ViewL s c
:< forall a. [a] -> SL a -> [a] -> Queue a
queue [c]
t SL c
f [c]
a
instance Foldable Queue where
foldr :: forall a b. (a -> b -> b) -> b -> Queue a -> b
foldr a -> b -> b
c b
n = \Queue a
q -> forall {s :: * -> *}. Sequence s => s a -> b
go Queue a
q
where
go :: s a -> b
go s a
q = case forall (s :: * -> *) c. Sequence s => s c -> ViewL s c
S.viewl s a
q of
ViewL s a
EmptyL -> b
n
a
h :< s a
t -> a -> b -> b
c a
h (s a -> b
go s a
t)
foldl' :: forall b a. (b -> a -> b) -> b -> Queue a -> b
foldl' b -> a -> b
f b
b0 = \Queue a
q -> forall {s :: * -> *}. Sequence s => s a -> b -> b
go Queue a
q b
b0
where
go :: s a -> b -> b
go s a
q !b
b = case forall (s :: * -> *) c. Sequence s => s c -> ViewL s c
S.viewl s a
q of
ViewL s a
EmptyL -> b
b
a
h :< s a
t -> s a -> b -> b
go s a
t (b -> a -> b
f b
b a
h)
#if MIN_VERSION_base(4,8,0)
null :: forall a. Queue a -> Bool
null (RQ [] SL a
_SNil [a]
_nil) = Bool
True
null Queue a
_ = Bool
False
length :: forall a. Queue a -> Int
length (RQ [a]
f SL a
_ [a]
a) = Int
2 forall a. Num a => a -> a -> a
* forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
f forall a. Num a => a -> a -> a
- forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
a
#endif
instance T.Traversable Queue where
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Queue a -> f (Queue b)
traverse a -> f b
f = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall c. [c] -> Queue c
fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {s :: * -> *}. Sequence s => s a -> f [b]
go
where
go :: s a -> f [b]
go s a
q = case forall (s :: * -> *) c. Sequence s => s c -> ViewL s c
S.viewl s a
q of
ViewL s a
EmptyL -> forall (f :: * -> *) a. Applicative f => a -> f a
A.pure []
a
h :< s a
t -> forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
A.liftA2 (:) (a -> f b
f a
h) (s a -> f [b]
go s a
t)
fromList :: [a] -> Queue a
fromList :: forall c. [c] -> Queue c
fromList [a]
f = forall a. [a] -> SL a -> [a] -> Queue a
RQ [a]
f forall a. SL a
SNil [a]
f