{-# LANGUAGE GADTs, LambdaCase #-}

module Test.Credit.Deque.Catenable where

import Prelude hiding (concat)
import Prettyprinter (Pretty)
import Control.Monad.Credit
import Test.Credit.Deque.Base
import qualified Test.Credit.Queue.Base as Q
import qualified Test.Credit.Queue.Bankers as Q

-- | A rose tree where the elements are pre-ordered
data CatDeque a m
  = E
  | C a -- ^ head
      (Q.BQueue (Thunk m (CLazyCon m) (CatDeque a m)) m) -- ^ tail

data CLazyCon m a where
  Pure :: a -> CLazyCon m a
  LinkAll :: Q.BQueue (Thunk m (CLazyCon m) (CatDeque a m)) m -> CLazyCon m (CatDeque a m)

instance MonadInherit m => HasStep (CLazyCon m) m where
  step :: forall a. CLazyCon m a -> m a
step (Pure a
xs) = a -> m a
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
xs
  step (LinkAll BQueue (Thunk m (CLazyCon m) (CatDeque a m)) m
q) = BQueue (Thunk m (CLazyCon m) (CatDeque a m)) m -> m (CatDeque a m)
forall (m :: * -> *) a.
MonadInherit m =>
BQueue (Thunk m (CLazyCon m) (CatDeque a m)) m -> m (CatDeque a m)
linkAll BQueue (Thunk m (CLazyCon m) (CatDeque a m)) m
q

costSnoc :: Credit
costSnoc :: Credit
costSnoc = forall (q :: * -> (* -> *) -> *) a.
BoundedQueue q =>
Size -> QueueOp a -> Credit
Q.qcost @(Q.BQueue) Size
forall a. HasCallStack => a
undefined (Any -> QueueOp Any
forall a. a -> QueueOp a
Q.Snoc Any
forall a. HasCallStack => a
undefined)

costUncons :: Credit
costUncons :: Credit
costUncons = forall (q :: * -> (* -> *) -> *) a.
BoundedQueue q =>
Size -> QueueOp a -> Credit
Q.qcost @(Q.BQueue) Size
forall a. HasCallStack => a
undefined (QueueOp Any
forall a. QueueOp a
Q.Uncons)

link :: MonadInherit m => CatDeque a m -> Thunk m (CLazyCon m) (CatDeque a m) -> m (CatDeque a m)
link :: forall (m :: * -> *) a.
MonadInherit m =>
CatDeque a m
-> Thunk m (CLazyCon m) (CatDeque a m) -> m (CatDeque a m)
link (C a
x BQueue (Thunk m (CLazyCon m) (CatDeque a m)) m
q) Thunk m (CLazyCon m) (CatDeque a m)
s = a -> BQueue (Thunk m (CLazyCon m) (CatDeque a m)) m -> CatDeque a m
forall a (m :: * -> *).
a -> BQueue (Thunk m (CLazyCon m) (CatDeque a m)) m -> CatDeque a m
C a
x (BQueue (Thunk m (CLazyCon m) (CatDeque a m)) m -> CatDeque a m)
-> m (BQueue (Thunk m (CLazyCon m) (CatDeque a m)) m)
-> m (CatDeque a m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BQueue (Thunk m (CLazyCon m) (CatDeque a m)) m
-> Thunk m (CLazyCon m) (CatDeque a m)
-> m (BQueue (Thunk m (CLazyCon m) (CatDeque a m)) m)
forall (m :: * -> *) a.
MonadInherit m =>
BQueue a m -> a -> m (BQueue a m)
forall (q :: * -> (* -> *) -> *) (m :: * -> *) a.
(Queue q, MonadInherit m) =>
q a m -> a -> m (q a m)
Q.snoc BQueue (Thunk m (CLazyCon m) (CatDeque a m)) m
q Thunk m (CLazyCon m) (CatDeque a m)
s

linkAll :: MonadInherit m => Q.BQueue (Thunk m (CLazyCon m) (CatDeque a m)) m -> m (CatDeque a m)
linkAll :: forall (m :: * -> *) a.
MonadInherit m =>
BQueue (Thunk m (CLazyCon m) (CatDeque a m)) m -> m (CatDeque a m)
linkAll BQueue (Thunk m (CLazyCon m) (CatDeque a m)) m
q = do
  Maybe
  (Thunk m (CLazyCon m) (CatDeque a m),
   BQueue (Thunk m (CLazyCon m) (CatDeque a m)) m)
m <- BQueue (Thunk m (CLazyCon m) (CatDeque a m)) m
-> m (Maybe
        (Thunk m (CLazyCon m) (CatDeque a m),
         BQueue (Thunk m (CLazyCon m) (CatDeque a m)) m))
forall (m :: * -> *) a.
MonadInherit m =>
BQueue a m -> m (Maybe (a, BQueue a m))
forall (q :: * -> (* -> *) -> *) (m :: * -> *) a.
(Queue q, MonadInherit m) =>
q a m -> m (Maybe (a, q a m))
Q.uncons BQueue (Thunk m (CLazyCon m) (CatDeque a m)) m
q
  case Maybe
  (Thunk m (CLazyCon m) (CatDeque a m),
   BQueue (Thunk m (CLazyCon m) (CatDeque a m)) m)
m of
    Maybe
  (Thunk m (CLazyCon m) (CatDeque a m),
   BQueue (Thunk m (CLazyCon m) (CatDeque a m)) m)
Nothing -> String -> m (CatDeque a m)
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"linkAll: empty queue"
    Just (Thunk m (CLazyCon m) (CatDeque a m)
t, BQueue (Thunk m (CLazyCon m) (CatDeque a m)) m
q') -> do
      CatDeque a m
t <- Thunk m (CLazyCon m) (CatDeque a m) -> m (CatDeque a m)
forall (m :: * -> *) (t :: * -> *) a.
(MonadLazy m, HasStep t m) =>
Thunk m t a -> m a
forall (t :: * -> *) a. HasStep t m => Thunk m t a -> m a
force Thunk m (CLazyCon m) (CatDeque a m)
t
      if BQueue (Thunk m (CLazyCon m) (CatDeque a m)) m -> Bool
forall a (m :: * -> *). BQueue a m -> Bool
Q.isEmpty BQueue (Thunk m (CLazyCon m) (CatDeque a m)) m
q' then CatDeque a m -> m (CatDeque a m)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CatDeque a m
t
      else do
        Thunk m (CLazyCon m) (CatDeque a m)
s <- CLazyCon m (CatDeque a m)
-> m (Thunk m (CLazyCon m) (CatDeque a m))
forall (m :: * -> *) (t :: * -> *) a.
MonadLazy m =>
t a -> m (Thunk m t a)
forall (t :: * -> *) a. t a -> m (Thunk m t a)
delay (CLazyCon m (CatDeque a m)
 -> m (Thunk m (CLazyCon m) (CatDeque a m)))
-> CLazyCon m (CatDeque a m)
-> m (Thunk m (CLazyCon m) (CatDeque a m))
forall a b. (a -> b) -> a -> b
$ BQueue (Thunk m (CLazyCon m) (CatDeque a m)) m
-> CLazyCon m (CatDeque a m)
forall (m :: * -> *) a.
BQueue (Thunk m (CLazyCon m) (CatDeque a m)) m
-> CLazyCon m (CatDeque a m)
LinkAll BQueue (Thunk m (CLazyCon m) (CatDeque a m)) m
q'
        Thunk m (CLazyCon m) (CatDeque a m) -> Credit -> m ()
forall (m :: * -> *) (t :: * -> *) a.
MonadCredit m =>
Thunk m t a -> Credit -> m ()
forall (t :: * -> *) a. Thunk m t a -> Credit -> m ()
creditWith Thunk m (CLazyCon m) (CatDeque a m)
s Credit
costUncons -- for the last uncons
        CatDeque a m
-> Thunk m (CLazyCon m) (CatDeque a m) -> m (CatDeque a m)
forall (m :: * -> *) a.
MonadInherit m =>
CatDeque a m
-> Thunk m (CLazyCon m) (CatDeque a m) -> m (CatDeque a m)
link CatDeque a m
t Thunk m (CLazyCon m) (CatDeque a m)
s

concat' :: MonadInherit m => CatDeque a m -> CatDeque a m -> m (CatDeque a m)
concat' :: forall (m :: * -> *) a.
MonadInherit m =>
CatDeque a m -> CatDeque a m -> m (CatDeque a m)
concat' CatDeque a m
E CatDeque a m
xs = CatDeque a m -> m (CatDeque a m)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CatDeque a m
xs
concat' CatDeque a m
xs CatDeque a m
E = CatDeque a m -> m (CatDeque a m)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CatDeque a m
xs
concat' CatDeque a m
xs CatDeque a m
ys = do
  Thunk m (CLazyCon m) (CatDeque a m)
ys <- CLazyCon m (CatDeque a m)
-> m (Thunk m (CLazyCon m) (CatDeque a m))
forall (m :: * -> *) (t :: * -> *) a.
MonadLazy m =>
t a -> m (Thunk m t a)
forall (t :: * -> *) a. t a -> m (Thunk m t a)
delay (CLazyCon m (CatDeque a m)
 -> m (Thunk m (CLazyCon m) (CatDeque a m)))
-> CLazyCon m (CatDeque a m)
-> m (Thunk m (CLazyCon m) (CatDeque a m))
forall a b. (a -> b) -> a -> b
$ CatDeque a m -> CLazyCon m (CatDeque a m)
forall a (m :: * -> *). a -> CLazyCon m a
Pure CatDeque a m
ys
  CatDeque a m
-> Thunk m (CLazyCon m) (CatDeque a m) -> m (CatDeque a m)
forall (m :: * -> *) a.
MonadInherit m =>
CatDeque a m
-> Thunk m (CLazyCon m) (CatDeque a m) -> m (CatDeque a m)
link CatDeque a m
xs Thunk m (CLazyCon m) (CatDeque a m)
ys

-- | Assign credits to the thunk and force it
-- unless it is a `LinkAll(t:_)` where `t` requires credits.
-- In the latter case, recursive until we can force a thunk.
dischargeThunk :: MonadInherit m => Thunk m (CLazyCon m) (CatDeque a m) -> m ()
dischargeThunk :: forall (m :: * -> *) a.
MonadInherit m =>
Thunk m (CLazyCon m) (CatDeque a m) -> m ()
dischargeThunk Thunk m (CLazyCon m) (CatDeque a m)
s = do
  let assign :: m ()
assign = Thunk m (CLazyCon m) (CatDeque a m) -> Credit -> m ()
forall (m :: * -> *) (t :: * -> *) a.
MonadCredit m =>
Thunk m t a -> Credit -> m ()
forall (t :: * -> *) a. Thunk m t a -> Credit -> m ()
creditWith Thunk m (CLazyCon m) (CatDeque a m)
s (Credit
costSnoc Credit -> Credit -> Credit
forall a. Num a => a -> a -> a
+ Credit
costUncons) m () -> m (CatDeque a m) -> m (CatDeque a m)
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Thunk m (CLazyCon m) (CatDeque a m) -> m (CatDeque a m)
forall (m :: * -> *) (t :: * -> *) a.
(MonadLazy m, HasStep t m) =>
Thunk m t a -> m a
forall (t :: * -> *) a. HasStep t m => Thunk m t a -> m a
force Thunk m (CLazyCon m) (CatDeque a m)
s m (CatDeque a m) -> m () -> m ()
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  Thunk m (CLazyCon m) (CatDeque a m)
-> (CatDeque a m -> m ())
-> (CLazyCon m (CatDeque a m) -> m ())
-> m ()
forall (m :: * -> *) (t :: * -> *) a b.
MonadLazy m =>
Thunk m t a -> (a -> m b) -> (t a -> m b) -> m b
forall (t :: * -> *) a b.
Thunk m t a -> (a -> m b) -> (t a -> m b) -> m b
lazymatch Thunk m (CLazyCon m) (CatDeque a m)
s (\CatDeque a m
_ -> m ()
assign) ((CLazyCon m (CatDeque a m) -> m ()) -> m ())
-> (CLazyCon m (CatDeque a m) -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \case
    Pure CatDeque a m
_ -> m ()
assign
    LinkAll BQueue (Thunk m (CLazyCon m) (CatDeque a m)) m
q -> do
      [Thunk m (CLazyCon m) (CatDeque a m)]
q' <- BQueue (Thunk m (CLazyCon m) (CatDeque a m)) m
-> m [Thunk m (CLazyCon m) (CatDeque a m)]
forall (m :: * -> *) a. MonadInherit m => BQueue a m -> m [a]
Q.lazyqueue BQueue (Thunk m (CLazyCon m) (CatDeque a m)) m
q
      case [Thunk m (CLazyCon m) (CatDeque a m)]
q' of
        [] -> m ()
assign
        Thunk m (CLazyCon m) (CatDeque a m)
t' : [Thunk m (CLazyCon m) (CatDeque a m)]
_ -> do
          Thunk m (CLazyCon m) (CatDeque a m)
-> (CatDeque a m -> m ())
-> (CLazyCon m (CatDeque a m) -> m ())
-> m ()
forall (m :: * -> *) (t :: * -> *) a b.
MonadLazy m =>
Thunk m t a -> (a -> m b) -> (t a -> m b) -> m b
forall (t :: * -> *) a b.
Thunk m t a -> (a -> m b) -> (t a -> m b) -> m b
lazymatch Thunk m (CLazyCon m) (CatDeque a m)
t' (\CatDeque a m
_ -> m ()
assign) ((CLazyCon m (CatDeque a m) -> m ()) -> m ())
-> (CLazyCon m (CatDeque a m) -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \case
            Pure CatDeque a m
_ -> m ()
assign
            LinkAll BQueue (Thunk m (CLazyCon m) (CatDeque a m)) m
_ -> Thunk m (CLazyCon m) (CatDeque a m) -> m ()
forall (m :: * -> *) a.
MonadInherit m =>
Thunk m (CLazyCon m) (CatDeque a m) -> m ()
dischargeThunk Thunk m (CLazyCon m) (CatDeque a m)
t'

findFirstThunk :: MonadInherit m => CatDeque a m -> m (Maybe (Thunk m (CLazyCon m) (CatDeque a m)))
findFirstThunk :: forall (m :: * -> *) a.
MonadInherit m =>
CatDeque a m -> m (Maybe (Thunk m (CLazyCon m) (CatDeque a m)))
findFirstThunk (C a
_ BQueue (Thunk m (CLazyCon m) (CatDeque a m)) m
q) = do
  [Thunk m (CLazyCon m) (CatDeque a m)]
q' <- BQueue (Thunk m (CLazyCon m) (CatDeque a m)) m
-> m [Thunk m (CLazyCon m) (CatDeque a m)]
forall (m :: * -> *) a. MonadInherit m => BQueue a m -> m [a]
Q.lazyqueue BQueue (Thunk m (CLazyCon m) (CatDeque a m)) m
q
  [Thunk m (CLazyCon m) (CatDeque a m)]
-> m (Maybe (Thunk m (CLazyCon m) (CatDeque a m)))
forall (m :: * -> *) a.
MonadInherit m =>
[Thunk m (CLazyCon m) (CatDeque a m)]
-> m (Maybe (Thunk m (CLazyCon m) (CatDeque a m)))
seekFirstThunk [Thunk m (CLazyCon m) (CatDeque a m)]
q'
findFirstThunk CatDeque a m
_ = Maybe (Thunk m (CLazyCon m) (CatDeque a m))
-> m (Maybe (Thunk m (CLazyCon m) (CatDeque a m)))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Thunk m (CLazyCon m) (CatDeque a m))
forall a. Maybe a
Nothing

seekFirstThunk :: MonadInherit m => [Thunk m (CLazyCon m) (CatDeque a m)] -> m (Maybe (Thunk m (CLazyCon m) (CatDeque a m)))
seekFirstThunk :: forall (m :: * -> *) a.
MonadInherit m =>
[Thunk m (CLazyCon m) (CatDeque a m)]
-> m (Maybe (Thunk m (CLazyCon m) (CatDeque a m)))
seekFirstThunk [] = Maybe (Thunk m (CLazyCon m) (CatDeque a m))
-> m (Maybe (Thunk m (CLazyCon m) (CatDeque a m)))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Thunk m (CLazyCon m) (CatDeque a m))
forall a. Maybe a
Nothing
seekFirstThunk (Thunk m (CLazyCon m) (CatDeque a m)
t : [Thunk m (CLazyCon m) (CatDeque a m)]
q) = do
  Maybe (Thunk m (CLazyCon m) (CatDeque a m))
mt <- Thunk m (CLazyCon m) (CatDeque a m)
-> (CatDeque a m
    -> m (Maybe (Thunk m (CLazyCon m) (CatDeque a m))))
-> (CLazyCon m (CatDeque a m)
    -> m (Maybe (Thunk m (CLazyCon m) (CatDeque a m))))
-> m (Maybe (Thunk m (CLazyCon m) (CatDeque a m)))
forall (m :: * -> *) (t :: * -> *) a b.
MonadLazy m =>
Thunk m t a -> (a -> m b) -> (t a -> m b) -> m b
forall (t :: * -> *) a b.
Thunk m t a -> (a -> m b) -> (t a -> m b) -> m b
lazymatch Thunk m (CLazyCon m) (CatDeque a m)
t CatDeque a m -> m (Maybe (Thunk m (CLazyCon m) (CatDeque a m)))
forall (m :: * -> *) a.
MonadInherit m =>
CatDeque a m -> m (Maybe (Thunk m (CLazyCon m) (CatDeque a m)))
findFirstThunk ((CLazyCon m (CatDeque a m)
  -> m (Maybe (Thunk m (CLazyCon m) (CatDeque a m))))
 -> m (Maybe (Thunk m (CLazyCon m) (CatDeque a m))))
-> (CLazyCon m (CatDeque a m)
    -> m (Maybe (Thunk m (CLazyCon m) (CatDeque a m))))
-> m (Maybe (Thunk m (CLazyCon m) (CatDeque a m)))
forall a b. (a -> b) -> a -> b
$ \case
    Pure CatDeque a m
q' -> CatDeque a m -> m (Maybe (Thunk m (CLazyCon m) (CatDeque a m)))
forall (m :: * -> *) a.
MonadInherit m =>
CatDeque a m -> m (Maybe (Thunk m (CLazyCon m) (CatDeque a m)))
findFirstThunk CatDeque a m
q'
    LinkAll BQueue (Thunk m (CLazyCon m) (CatDeque a m)) m
_ -> Maybe (Thunk m (CLazyCon m) (CatDeque a m))
-> m (Maybe (Thunk m (CLazyCon m) (CatDeque a m)))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Thunk m (CLazyCon m) (CatDeque a m))
 -> m (Maybe (Thunk m (CLazyCon m) (CatDeque a m))))
-> Maybe (Thunk m (CLazyCon m) (CatDeque a m))
-> m (Maybe (Thunk m (CLazyCon m) (CatDeque a m)))
forall a b. (a -> b) -> a -> b
$ Thunk m (CLazyCon m) (CatDeque a m)
-> Maybe (Thunk m (CLazyCon m) (CatDeque a m))
forall a. a -> Maybe a
Just Thunk m (CLazyCon m) (CatDeque a m)
t
  case Maybe (Thunk m (CLazyCon m) (CatDeque a m))
mt of
    Maybe (Thunk m (CLazyCon m) (CatDeque a m))
Nothing -> [Thunk m (CLazyCon m) (CatDeque a m)]
-> m (Maybe (Thunk m (CLazyCon m) (CatDeque a m)))
forall (m :: * -> *) a.
MonadInherit m =>
[Thunk m (CLazyCon m) (CatDeque a m)]
-> m (Maybe (Thunk m (CLazyCon m) (CatDeque a m)))
seekFirstThunk [Thunk m (CLazyCon m) (CatDeque a m)]
q
    Just Thunk m (CLazyCon m) (CatDeque a m)
t' -> Maybe (Thunk m (CLazyCon m) (CatDeque a m))
-> m (Maybe (Thunk m (CLazyCon m) (CatDeque a m)))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Thunk m (CLazyCon m) (CatDeque a m))
 -> m (Maybe (Thunk m (CLazyCon m) (CatDeque a m))))
-> Maybe (Thunk m (CLazyCon m) (CatDeque a m))
-> m (Maybe (Thunk m (CLazyCon m) (CatDeque a m)))
forall a b. (a -> b) -> a -> b
$ Thunk m (CLazyCon m) (CatDeque a m)
-> Maybe (Thunk m (CLazyCon m) (CatDeque a m))
forall a. a -> Maybe a
Just Thunk m (CLazyCon m) (CatDeque a m)
t'

dischargeFirst :: MonadInherit m => CatDeque a m -> m ()
dischargeFirst :: forall (m :: * -> *) a. MonadInherit m => CatDeque a m -> m ()
dischargeFirst CatDeque a m
q = do
  Maybe (Thunk m (CLazyCon m) (CatDeque a m))
mt <- CatDeque a m -> m (Maybe (Thunk m (CLazyCon m) (CatDeque a m)))
forall (m :: * -> *) a.
MonadInherit m =>
CatDeque a m -> m (Maybe (Thunk m (CLazyCon m) (CatDeque a m)))
findFirstThunk CatDeque a m
q
  case Maybe (Thunk m (CLazyCon m) (CatDeque a m))
mt of
    Maybe (Thunk m (CLazyCon m) (CatDeque a m))
Nothing -> () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    Just Thunk m (CLazyCon m) (CatDeque a m)
t -> Thunk m (CLazyCon m) (CatDeque a m) -> m ()
forall (m :: * -> *) a.
MonadInherit m =>
Thunk m (CLazyCon m) (CatDeque a m) -> m ()
dischargeThunk Thunk m (CLazyCon m) (CatDeque a m)
t

instance Deque CatDeque where
  empty :: forall (m :: * -> *) a. MonadInherit m => m (CatDeque a m)
empty = CatDeque a m -> m (CatDeque a m)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CatDeque a m
forall a (m :: * -> *). CatDeque a m
E
  cons :: forall (m :: * -> *) a.
MonadInherit m =>
a -> CatDeque a m -> m (CatDeque a m)
cons a
x CatDeque a m
q = do
    BQueue (Thunk m (CLazyCon m) (CatDeque a m)) m
e <- m (BQueue (Thunk m (CLazyCon m) (CatDeque a m)) m)
forall (m :: * -> *) a. MonadInherit m => m (BQueue a m)
forall (q :: * -> (* -> *) -> *) (m :: * -> *) a.
(Queue q, MonadInherit m) =>
m (q a m)
Q.empty
    CatDeque a m -> CatDeque a m -> m (CatDeque a m)
forall (m :: * -> *) a.
MonadInherit m =>
CatDeque a m -> CatDeque a m -> m (CatDeque a m)
forall (q :: * -> (* -> *) -> *) (m :: * -> *) a.
(Deque q, MonadInherit m) =>
q a m -> q a m -> m (q a m)
concat (a -> BQueue (Thunk m (CLazyCon m) (CatDeque a m)) m -> CatDeque a m
forall a (m :: * -> *).
a -> BQueue (Thunk m (CLazyCon m) (CatDeque a m)) m -> CatDeque a m
C a
x BQueue (Thunk m (CLazyCon m) (CatDeque a m)) m
e) CatDeque a m
q
  snoc :: forall (m :: * -> *) a.
MonadInherit m =>
CatDeque a m -> a -> m (CatDeque a m)
snoc CatDeque a m
q a
x = do
    BQueue (Thunk m (CLazyCon m) (CatDeque a m)) m
e <- m (BQueue (Thunk m (CLazyCon m) (CatDeque a m)) m)
forall (m :: * -> *) a. MonadInherit m => m (BQueue a m)
forall (q :: * -> (* -> *) -> *) (m :: * -> *) a.
(Queue q, MonadInherit m) =>
m (q a m)
Q.empty
    CatDeque a m -> CatDeque a m -> m (CatDeque a m)
forall (m :: * -> *) a.
MonadInherit m =>
CatDeque a m -> CatDeque a m -> m (CatDeque a m)
forall (q :: * -> (* -> *) -> *) (m :: * -> *) a.
(Deque q, MonadInherit m) =>
q a m -> q a m -> m (q a m)
concat CatDeque a m
q (a -> BQueue (Thunk m (CLazyCon m) (CatDeque a m)) m -> CatDeque a m
forall a (m :: * -> *).
a -> BQueue (Thunk m (CLazyCon m) (CatDeque a m)) m -> CatDeque a m
C a
x BQueue (Thunk m (CLazyCon m) (CatDeque a m)) m
e)
  uncons :: forall (m :: * -> *) a.
MonadInherit m =>
CatDeque a m -> m (Maybe (a, CatDeque a m))
uncons CatDeque a m
E = Maybe (a, CatDeque a m) -> m (Maybe (a, CatDeque a m))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (a, CatDeque a m)
forall a. Maybe a
Nothing
  uncons (C a
x BQueue (Thunk m (CLazyCon m) (CatDeque a m)) m
q) = do
    CatDeque a m
q' <- if BQueue (Thunk m (CLazyCon m) (CatDeque a m)) m -> Bool
forall a (m :: * -> *). BQueue a m -> Bool
Q.isEmpty BQueue (Thunk m (CLazyCon m) (CatDeque a m)) m
q then CatDeque a m -> m (CatDeque a m)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CatDeque a m
forall a (m :: * -> *). CatDeque a m
E else BQueue (Thunk m (CLazyCon m) (CatDeque a m)) m -> m (CatDeque a m)
forall (m :: * -> *) a.
MonadInherit m =>
BQueue (Thunk m (CLazyCon m) (CatDeque a m)) m -> m (CatDeque a m)
linkAll BQueue (Thunk m (CLazyCon m) (CatDeque a m)) m
q
    CatDeque a m -> m ()
forall (m :: * -> *) a. MonadInherit m => CatDeque a m -> m ()
dischargeFirst CatDeque a m
q'
    CatDeque a m -> m ()
forall (m :: * -> *) a. MonadInherit m => CatDeque a m -> m ()
dischargeFirst CatDeque a m
q'
    Maybe (a, CatDeque a m) -> m (Maybe (a, CatDeque a m))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (a, CatDeque a m) -> m (Maybe (a, CatDeque a m)))
-> Maybe (a, CatDeque a m) -> m (Maybe (a, CatDeque a m))
forall a b. (a -> b) -> a -> b
$ (a, CatDeque a m) -> Maybe (a, CatDeque a m)
forall a. a -> Maybe a
Just (a
x, CatDeque a m
q')
  unsnoc :: forall (m :: * -> *) a.
MonadInherit m =>
CatDeque a m -> m (Maybe (CatDeque a m, a))
unsnoc CatDeque a m
q = Maybe (CatDeque a m, a) -> m (Maybe (CatDeque a m, a))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (CatDeque a m, a) -> m (Maybe (CatDeque a m, a)))
-> Maybe (CatDeque a m, a) -> m (Maybe (CatDeque a m, a))
forall a b. (a -> b) -> a -> b
$ (CatDeque a m, a) -> Maybe (CatDeque a m, a)
forall a. a -> Maybe a
Just (CatDeque a m
q, a
forall a. HasCallStack => a
undefined)
  concat :: forall (m :: * -> *) a.
MonadInherit m =>
CatDeque a m -> CatDeque a m -> m (CatDeque a m)
concat = CatDeque a m -> CatDeque a m -> m (CatDeque a m)
forall (m :: * -> *) a.
MonadInherit m =>
CatDeque a m -> CatDeque a m -> m (CatDeque a m)
concat'

instance BoundedDeque CatDeque where
  qcost :: forall a. Size -> DequeOp a -> Credit
qcost Size
_ (Cons a
_) = Credit
costSnoc
  qcost Size
_ (Snoc a
_) = Credit
costSnoc
  qcost Size
_ DequeOp a
Uncons = Credit
4 Credit -> Credit -> Credit
forall a. Num a => a -> a -> a
* Credit
costUncons Credit -> Credit -> Credit
forall a. Num a => a -> a -> a
+ Credit
3 Credit -> Credit -> Credit
forall a. Num a => a -> a -> a
* Credit
costSnoc
  qcost Size
_ DequeOp a
Unsnoc = Credit
0
  qcost Size
_ DequeOp a
Concat = Credit
0

instance (MonadMemory m, MemoryCell m a) => MemoryCell m (CLazyCon m a) where
  prettyCell :: CLazyCon m a -> m Memory
prettyCell (Pure a
x) = do
    Memory
x' <- a -> m Memory
forall (m :: * -> *) a. MemoryCell m a => a -> m Memory
prettyCell a
x
    Memory -> m Memory
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Memory -> m Memory) -> Memory -> m Memory
forall a b. (a -> b) -> a -> b
$ String -> [Memory] -> Memory
mkMCell String
"Pure" [Memory
x']
  prettyCell (LinkAll BQueue (Thunk m (CLazyCon m) (CatDeque a m)) m
q) = do
    Memory
q' <- BQueue (Thunk m (CLazyCon m) (CatDeque a m)) m -> m Memory
forall (m :: * -> *) a. MemoryCell m a => a -> m Memory
prettyCell BQueue (Thunk m (CLazyCon m) (CatDeque a m)) m
q
    Memory -> m Memory
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Memory -> m Memory) -> Memory -> m Memory
forall a b. (a -> b) -> a -> b
$ String -> [Memory] -> Memory
mkMCell String
"LinkAll" [Memory
q']

instance (MonadMemory m, MemoryCell m a) => MemoryCell m (CatDeque a m) where
  prettyCell :: CatDeque a m -> m Memory
prettyCell CatDeque a m
E = Memory -> m Memory
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Memory -> m Memory) -> Memory -> m Memory
forall a b. (a -> b) -> a -> b
$ String -> [Memory] -> Memory
mkMCell String
"E" []
  prettyCell (C a
x BQueue (Thunk m (CLazyCon m) (CatDeque a m)) m
q) = do
    Memory
x' <- a -> m Memory
forall (m :: * -> *) a. MemoryCell m a => a -> m Memory
prettyCell a
x
    Memory
q' <- BQueue (Thunk m (CLazyCon m) (CatDeque a m)) m -> m Memory
forall (m :: * -> *) a. MemoryCell m a => a -> m Memory
prettyCell BQueue (Thunk m (CLazyCon m) (CatDeque a m)) m
q
    Memory -> m Memory
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Memory -> m Memory) -> Memory -> m Memory
forall a b. (a -> b) -> a -> b
$ String -> [Memory] -> Memory
mkMCell String
"C" [Memory
x', Memory
q']

instance Pretty a => MemoryStructure (CatDeque (PrettyCell a)) where
  prettyStructure :: forall (m :: * -> *).
MonadMemory m =>
CatDeque (PrettyCell a) m -> m Memory
prettyStructure = CatDeque (PrettyCell a) m -> m Memory
forall (m :: * -> *) a. MemoryCell m a => a -> m Memory
prettyCell