{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE ExistentialQuantification #-}
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 = forall x. RQ ![a] !(SL a) ![x]
instance Functor Queue where
fmap :: forall a b. (a -> b) -> Queue a -> Queue b
fmap a -> b
f (RQ [a]
x SL a
y [x]
s) = forall a x. [a] -> SL a -> [x] -> Queue a
RQ (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f [a]
x) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f SL a
y) [x]
s
a
a <$ :: forall a b. a -> Queue b -> Queue a
<$ RQ [b]
x SL b
y [x]
s = forall a x. [a] -> SL a -> [x] -> Queue a
RQ (a
a forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [b]
x) (a
a forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ SL b
y) [x]
s
queue :: [a] -> SL a -> [x] -> Queue a
queue :: forall a x. [a] -> SL a -> [x] -> 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 x. [a] -> SL a -> [x] -> Queue a
RQ [a]
f' forall a. SL a
SNil [a]
f'
queue [a]
f SL a
r (x
_h : [x]
t) = forall a x. [a] -> SL a -> [x] -> Queue a
RQ [a]
f SL a
r [x]
t
instance Sequence Queue where
empty :: forall c. Queue c
empty = forall a x. [a] -> SL a -> [x] -> Queue a
RQ [] forall a. SL a
SNil []
singleton :: forall c. c -> Queue c
singleton c
x =
let
c :: [c]
c = [c
x]
{-# NOINLINE c #-}
in forall a x. [a] -> SL a -> [x] -> Queue a
RQ [c]
c forall a. SL a
SNil [c]
c
RQ [c]
f SL c
r [x]
a |> :: forall c. Queue c -> c -> Queue c
|> c
x = forall a x. [a] -> SL a -> [x] -> Queue a
queue [c]
f (SL c
r forall a. SL a -> a -> SL a
:> c
x) [x]
a
viewl :: forall c. Queue c -> ViewL Queue c
viewl (RQ [] SL c
_SNil [x]
_nil) = forall (s :: * -> *) c. ViewL s c
EmptyL
viewl (RQ (c
h : [c]
t) SL c
f [x]
a) = c
h forall c (s :: * -> *). c -> s c -> ViewL s c
:< forall a x. [a] -> SL a -> [x] -> Queue a
queue [c]
t SL c
f [x]
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)
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 = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' forall (s :: * -> *) c. Sequence s => s c -> c -> s c
(S.|>) forall (s :: * -> *) c. Sequence s => s c
S.empty