{-# LANGUAGE GADTs #-}

module Test.Credit.Sortable.Scheduled where

import Prettyprinter (Pretty)
import Control.Monad.Credit
import Test.Credit
import Test.Credit.Sortable.Base

rev :: MonadCredit m => [a] -> [a] -> m [a]
rev :: forall (m :: * -> *) a. MonadCredit m => [a] -> [a] -> m [a]
rev [] [a]
acc = [a] -> m [a]
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [a]
acc
rev (a
x : [a]
xs) [a]
acc = m ()
forall (m :: * -> *). MonadCount m => m ()
tick m () -> m [a] -> m [a]
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [a] -> [a] -> m [a]
forall (m :: * -> *) a. MonadCredit m => [a] -> [a] -> m [a]
rev [a]
xs (a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
acc)

data Stream m a
  = SCons a (Stream m a)
  | SNil
  | SIndirect (Thunk m (Lazy m) (Stream m a))

indirect :: MonadCredit m => m (Stream m a) -> m (Stream m a)
indirect :: forall (m :: * -> *) a.
MonadCredit m =>
m (Stream m a) -> m (Stream m a)
indirect = (Thunk m (Lazy m) (Stream m a) -> Stream m a)
-> m (Thunk m (Lazy m) (Stream m a)) -> m (Stream m a)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Thunk m (Lazy m) (Stream m a) -> Stream m a
forall (m :: * -> *) a. Thunk m (Lazy m) (Stream m a) -> Stream m a
SIndirect (m (Thunk m (Lazy m) (Stream m a)) -> m (Stream m a))
-> (m (Stream m a) -> m (Thunk m (Lazy m) (Stream m a)))
-> m (Stream m a)
-> m (Stream m a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lazy m (Stream m a) -> m (Thunk m (Lazy m) (Stream m a))
forall (m :: * -> *) (t :: * -> *) a.
MonadLazy m =>
t a -> m (Thunk m t a)
forall (t :: * -> *) a. t a -> m (Thunk m t a)
delay (Lazy m (Stream m a) -> m (Thunk m (Lazy m) (Stream m a)))
-> (m (Stream m a) -> Lazy m (Stream m a))
-> m (Stream m a)
-> m (Thunk m (Lazy m) (Stream m a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (Stream m a) -> Lazy m (Stream m a)
forall {k} (m :: k -> *) (a :: k). m a -> Lazy m a
Lazy

credit :: MonadCredit m => Credit -> Stream m a -> m ()
credit :: forall (m :: * -> *) a.
MonadCredit m =>
Credit -> Stream m a -> m ()
credit Credit
cr (SIndirect Thunk m (Lazy m) (Stream m a)
i) = Thunk m (Lazy m) (Stream m a) -> 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 (Lazy m) (Stream m a)
i Credit
cr
credit Credit
_ Stream m a
_ = () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

-- | Smart destructor for streams, consuming one credit
smatch :: MonadCredit m => Stream m a -- ^ Scrutinee
       -> m b -- ^ Nil case
       -> (a -> Stream m a -> m b) -- ^ Cons case
       -> m b
smatch :: forall (m :: * -> *) a b.
MonadCredit m =>
Stream m a -> m b -> (a -> Stream m a -> m b) -> m b
smatch Stream m a
x m b
nil a -> Stream m a -> m b
cons = m ()
forall (m :: * -> *). MonadCount m => m ()
tick m () -> m b -> m b
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Stream m a -> m b
eval Stream m a
x
  where
    eval :: Stream m a -> m b
eval Stream m a
x = case Stream m a
x of
      SCons a
a Stream m a
as -> a -> Stream m a -> m b
cons a
a Stream m a
as
      Stream m a
SNil -> m b
nil
      SIndirect Thunk m (Lazy m) (Stream m a)
i -> Thunk m (Lazy m) (Stream m a) -> m (Stream m a)
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 (Lazy m) (Stream m a)
i m (Stream m a) -> (Stream m a -> m b) -> m b
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Stream m a -> m b
eval

streamToList :: MonadCredit m => Stream m a -> m [a]
streamToList :: forall (m :: * -> *) a. MonadCredit m => Stream m a -> m [a]
streamToList Stream m a
xs = Stream m a -> m [a] -> (a -> Stream m a -> m [a]) -> m [a]
forall (m :: * -> *) a b.
MonadCredit m =>
Stream m a -> m b -> (a -> Stream m a -> m b) -> m b
smatch Stream m a
xs
  ([a] -> m [a]
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [])
  (\a
x Stream m a
xs' -> (a
x:) ([a] -> [a]) -> m [a] -> m [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Stream m a -> m [a]
forall (m :: * -> *) a. MonadCredit m => Stream m a -> m [a]
streamToList Stream m a
xs')

type Schedule m a = [Stream m a]

data SMergeSort a m = SMergeSort Size [(Stream m a, Schedule m a)]

mrg :: MonadCredit m => Ord a => Stream m a -> Stream m a -> m (Stream m a)
mrg :: forall (m :: * -> *) a.
(MonadCredit m, Ord a) =>
Stream m a -> Stream m a -> m (Stream m a)
mrg Stream m a
xs Stream m a
ys = m (Stream m a) -> m (Stream m a)
forall (m :: * -> *) a.
MonadCredit m =>
m (Stream m a) -> m (Stream m a)
indirect (m (Stream m a) -> m (Stream m a))
-> m (Stream m a) -> m (Stream m a)
forall a b. (a -> b) -> a -> b
$ do
  Stream m a
-> m (Stream m a)
-> (a -> Stream m a -> m (Stream m a))
-> m (Stream m a)
forall (m :: * -> *) a b.
MonadCredit m =>
Stream m a -> m b -> (a -> Stream m a -> m b) -> m b
smatch Stream m a
xs (Stream m a -> m (Stream m a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Stream m a
ys) ((a -> Stream m a -> m (Stream m a)) -> m (Stream m a))
-> (a -> Stream m a -> m (Stream m a)) -> m (Stream m a)
forall a b. (a -> b) -> a -> b
$ \a
x Stream m a
xs' ->
    Stream m a
-> m (Stream m a)
-> (a -> Stream m a -> m (Stream m a))
-> m (Stream m a)
forall (m :: * -> *) a b.
MonadCredit m =>
Stream m a -> m b -> (a -> Stream m a -> m b) -> m b
smatch Stream m a
ys (Stream m a -> m (Stream m a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Stream m a
xs) ((a -> Stream m a -> m (Stream m a)) -> m (Stream m a))
-> (a -> Stream m a -> m (Stream m a)) -> m (Stream m a)
forall a b. (a -> b) -> a -> b
$ \a
y Stream m a
ys' -> do
      if a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
y
        then (a -> Stream m a -> Stream m a
forall (m :: * -> *) a. a -> Stream m a -> Stream m a
SCons a
x) (Stream m a -> Stream m a) -> m (Stream m a) -> m (Stream m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Stream m a -> Stream m a -> m (Stream m a)
forall (m :: * -> *) a.
(MonadCredit m, Ord a) =>
Stream m a -> Stream m a -> m (Stream m a)
mrg Stream m a
xs' Stream m a
ys
        else (a -> Stream m a -> Stream m a
forall (m :: * -> *) a. a -> Stream m a -> Stream m a
SCons a
y) (Stream m a -> Stream m a) -> m (Stream m a) -> m (Stream m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Stream m a -> Stream m a -> m (Stream m a)
forall (m :: * -> *) a.
(MonadCredit m, Ord a) =>
Stream m a -> Stream m a -> m (Stream m a)
mrg Stream m a
xs Stream m a
ys'

exec1 :: MonadCredit m => Schedule m a -> m (Schedule m a)
exec1 :: forall (m :: * -> *) a.
MonadCredit m =>
Schedule m a -> m (Schedule m a)
exec1 [] = [Stream m a] -> m [Stream m a]
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
exec1 (Stream m a
ds:[Stream m a]
sched) = Credit -> Stream m a -> m ()
forall (m :: * -> *) a.
MonadCredit m =>
Credit -> Stream m a -> m ()
credit Credit
2 Stream m a
ds m () -> m [Stream m a] -> m [Stream m a]
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Stream m a
-> m [Stream m a]
-> (a -> Stream m a -> m [Stream m a])
-> m [Stream m a]
forall (m :: * -> *) a b.
MonadCredit m =>
Stream m a -> m b -> (a -> Stream m a -> m b) -> m b
smatch Stream m a
ds
  ([Stream m a] -> m [Stream m a]
forall (m :: * -> *) a.
MonadCredit m =>
Schedule m a -> m (Schedule m a)
exec1 [Stream m a]
sched)
  (\a
_ Stream m a
xs -> [Stream m a] -> m [Stream m a]
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Stream m a] -> m [Stream m a]) -> [Stream m a] -> m [Stream m a]
forall a b. (a -> b) -> a -> b
$ Stream m a
xs Stream m a -> [Stream m a] -> [Stream m a]
forall a. a -> [a] -> [a]
: [Stream m a]
sched)

exec2 :: MonadCredit m => (Stream m a, Schedule m a) -> m (Stream m a, Schedule m a)
exec2 :: forall (m :: * -> *) a.
MonadCredit m =>
(Stream m a, Schedule m a) -> m (Stream m a, Schedule m a)
exec2 (Stream m a
xs, Schedule m a
sched) = Schedule m a -> m (Schedule m a)
forall (m :: * -> *) a.
MonadCredit m =>
Schedule m a -> m (Schedule m a)
exec1 Schedule m a
sched m (Schedule m a)
-> (Schedule m a -> m (Schedule m a)) -> m (Schedule m a)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Schedule m a -> m (Schedule m a)
forall (m :: * -> *) a.
MonadCredit m =>
Schedule m a -> m (Schedule m a)
exec1 m (Schedule m a)
-> (Schedule m a -> m (Stream m a, Schedule m a))
-> m (Stream m a, Schedule m a)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Stream m a, Schedule m a) -> m (Stream m a, Schedule m a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Stream m a, Schedule m a) -> m (Stream m a, Schedule m a))
-> (Schedule m a -> (Stream m a, Schedule m a))
-> Schedule m a
-> m (Stream m a, Schedule m a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Stream m a
xs,)

execAll :: MonadCredit m => Schedule m a -> m ()
execAll :: forall (m :: * -> *) a. MonadCredit m => Schedule m a -> m ()
execAll [] = () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
execAll [Stream m a]
sched = [Stream m a] -> m [Stream m a]
forall (m :: * -> *) a.
MonadCredit m =>
Schedule m a -> m (Schedule m a)
exec1 [Stream m a]
sched m [Stream m a] -> ([Stream m a] -> m ()) -> m ()
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Stream m a] -> m ()
forall (m :: * -> *) a. MonadCredit m => Schedule m a -> m ()
execAll

addSeg :: MonadCredit m => Ord a => Stream m a -> [(Stream m a, Schedule m a)] -> Size -> Schedule m a -> m [(Stream m a, Schedule m a)]
addSeg :: forall (m :: * -> *) a.
(MonadCredit m, Ord a) =>
Stream m a
-> [(Stream m a, Schedule m a)]
-> Size
-> Schedule m a
-> m [(Stream m a, Schedule m a)]
addSeg Stream m a
xs [(Stream m a, Schedule m a)]
segs Size
size Schedule m a
rsched =
  if Size
size Size -> Size -> Size
forall a. Integral a => a -> a -> a
`mod` Size
2 Size -> Size -> Bool
forall a. Eq a => a -> a -> Bool
== Size
0
    then do
      Schedule m a
sched <- Schedule m a -> Schedule m a -> m (Schedule m a)
forall (m :: * -> *) a. MonadCredit m => [a] -> [a] -> m [a]
rev Schedule m a
rsched [] -- log2 size
      [(Stream m a, Schedule m a)] -> m [(Stream m a, Schedule m a)]
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([(Stream m a, Schedule m a)] -> m [(Stream m a, Schedule m a)])
-> [(Stream m a, Schedule m a)] -> m [(Stream m a, Schedule m a)]
forall a b. (a -> b) -> a -> b
$ (Stream m a
xs, Schedule m a
sched) (Stream m a, Schedule m a)
-> [(Stream m a, Schedule m a)] -> [(Stream m a, Schedule m a)]
forall a. a -> [a] -> [a]
: [(Stream m a, Schedule m a)]
segs
    else do
      let ((Stream m a
xs', []) : [(Stream m a, Schedule m a)]
segs') = [(Stream m a, Schedule m a)]
segs
      Stream m a
xs'' <- Stream m a -> Stream m a -> m (Stream m a)
forall (m :: * -> *) a.
(MonadCredit m, Ord a) =>
Stream m a -> Stream m a -> m (Stream m a)
mrg Stream m a
xs Stream m a
xs'
      Stream m a
-> [(Stream m a, Schedule m a)]
-> Size
-> Schedule m a
-> m [(Stream m a, Schedule m a)]
forall (m :: * -> *) a.
(MonadCredit m, Ord a) =>
Stream m a
-> [(Stream m a, Schedule m a)]
-> Size
-> Schedule m a
-> m [(Stream m a, Schedule m a)]
addSeg Stream m a
xs'' [(Stream m a, Schedule m a)]
segs' (Size
size Size -> Size -> Size
forall a. Integral a => a -> a -> a
`div` Size
2) (Stream m a
xs'' Stream m a -> Schedule m a -> Schedule m a
forall a. a -> [a] -> [a]
: Schedule m a
rsched)

mrgAll :: MonadCredit m => Ord a => Stream m a -> [(Stream m a, Schedule m a)] -> m (Stream m a)
mrgAll :: forall (m :: * -> *) a.
(MonadCredit m, Ord a) =>
Stream m a -> [(Stream m a, Schedule m a)] -> m (Stream m a)
mrgAll Stream m a
xs [] = Stream m a -> m (Stream m a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Stream m a
xs
mrgAll Stream m a
xs ((Stream m a
xs', Schedule m a
sched):[(Stream m a, Schedule m a)]
segs) = do
  Schedule m a -> m ()
forall (m :: * -> *) a. MonadCredit m => Schedule m a -> m ()
execAll Schedule m a
sched -- total cost: 3 * linear size
  Stream m a
seg <- Stream m a -> Stream m a -> m (Stream m a)
forall (m :: * -> *) a.
(MonadCredit m, Ord a) =>
Stream m a -> Stream m a -> m (Stream m a)
mrg Stream m a
xs Stream m a
xs'
  Schedule m a -> m ()
forall (m :: * -> *) a. MonadCredit m => Schedule m a -> m ()
execAll [Stream m a
seg] -- total cost: 6 * linear size
  Stream m a -> [(Stream m a, Schedule m a)] -> m (Stream m a)
forall (m :: * -> *) a.
(MonadCredit m, Ord a) =>
Stream m a -> [(Stream m a, Schedule m a)] -> m (Stream m a)
mrgAll Stream m a
seg [(Stream m a, Schedule m a)]
segs

instance Sortable SMergeSort where
  empty :: forall (m :: * -> *) a. MonadCredit m => m (SMergeSort a m)
empty = SMergeSort a m -> m (SMergeSort a m)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SMergeSort a m -> m (SMergeSort a m))
-> SMergeSort a m -> m (SMergeSort a m)
forall a b. (a -> b) -> a -> b
$ Size -> [(Stream m a, Schedule m a)] -> SMergeSort a m
forall a (m :: * -> *).
Size -> [(Stream m a, Schedule m a)] -> SMergeSort a m
SMergeSort Size
0 []
  add :: forall (m :: * -> *) a.
(MonadCredit m, Ord a) =>
a -> SMergeSort a m -> m (SMergeSort a m)
add a
x (SMergeSort Size
size [(Stream m a, Schedule m a)]
segs) = do
    [(Stream m a, Schedule m a)]
segs' <- Stream m a
-> [(Stream m a, Schedule m a)]
-> Size
-> Schedule m a
-> m [(Stream m a, Schedule m a)]
forall (m :: * -> *) a.
(MonadCredit m, Ord a) =>
Stream m a
-> [(Stream m a, Schedule m a)]
-> Size
-> Schedule m a
-> m [(Stream m a, Schedule m a)]
addSeg (a -> Stream m a -> Stream m a
forall (m :: * -> *) a. a -> Stream m a -> Stream m a
SCons a
x Stream m a
forall (m :: * -> *) a. Stream m a
SNil) [(Stream m a, Schedule m a)]
segs Size
size [] -- 1 * (log2 size + 1)
    [(Stream m a, Schedule m a)]
segs'' <- ((Stream m a, Schedule m a) -> m (Stream m a, Schedule m a))
-> [(Stream m a, Schedule m a)] -> m [(Stream m a, Schedule m a)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Stream m a, Schedule m a) -> m (Stream m a, Schedule m a)
forall (m :: * -> *) a.
MonadCredit m =>
(Stream m a, Schedule m a) -> m (Stream m a, Schedule m a)
exec2 [(Stream m a, Schedule m a)]
segs' -- 6 * (log2 size + 1)
    SMergeSort a m -> m (SMergeSort a m)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SMergeSort a m -> m (SMergeSort a m))
-> SMergeSort a m -> m (SMergeSort a m)
forall a b. (a -> b) -> a -> b
$ Size -> [(Stream m a, Schedule m a)] -> SMergeSort a m
forall a (m :: * -> *).
Size -> [(Stream m a, Schedule m a)] -> SMergeSort a m
SMergeSort (Size
size Size -> Size -> Size
forall a. Num a => a -> a -> a
+ Size
1) [(Stream m a, Schedule m a)]
segs''
  sort :: forall (m :: * -> *) a.
(MonadCredit m, Ord a) =>
SMergeSort a m -> m [a]
sort (SMergeSort Size
size [(Stream m a, Schedule m a)]
segs) = do
    Stream m a
s <- Stream m a -> [(Stream m a, Schedule m a)] -> m (Stream m a)
forall (m :: * -> *) a.
(MonadCredit m, Ord a) =>
Stream m a -> [(Stream m a, Schedule m a)] -> m (Stream m a)
mrgAll Stream m a
forall (m :: * -> *) a. Stream m a
SNil [(Stream m a, Schedule m a)]
segs -- 9 * (log2 size + 1)
    Stream m a -> m [a]
forall (m :: * -> *) a. MonadCredit m => Stream m a -> m [a]
streamToList Stream m a
s -- linear size

instance BoundedSortable SMergeSort where
  scost :: forall a. Size -> SortableOp a -> Credit
scost Size
n (Add a
_) = Credit
7 Credit -> Credit -> Credit
forall a. Num a => a -> a -> a
* (Size -> Credit
log2 Size
n Credit -> Credit -> Credit
forall a. Num a => a -> a -> a
+ Credit
1)
  scost Size
n SortableOp a
Sort = Credit
10 Credit -> Credit -> Credit
forall a. Num a => a -> a -> a
* (Size -> Credit
linear Size
n Credit -> Credit -> Credit
forall a. Num a => a -> a -> a
+ Credit
1)

instance (MonadMemory m, MemoryCell m a) => MemoryCell m (Stream m a) where
  prettyCell :: Stream m a -> m Memory
prettyCell Stream m a
xs = [Memory] -> Maybe Memory -> Memory
mkMList ([Memory] -> Maybe Memory -> Memory)
-> m [Memory] -> m (Maybe Memory -> Memory)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Stream m a -> m [Memory]
forall {f :: * -> *} {a} {m :: * -> *}.
MemoryCell f a =>
Stream m a -> f [Memory]
toList Stream m a
xs m (Maybe Memory -> Memory) -> m (Maybe Memory) -> m Memory
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Stream m a -> m (Maybe Memory)
forall {f :: * -> *} {m :: * -> *} {a}.
MemoryCell f (Thunk m (Lazy m) (Stream m a)) =>
Stream m a -> f (Maybe Memory)
toHole Stream m a
xs
    where
      toList :: Stream m a -> f [Memory]
toList Stream m a
SNil = [Memory] -> f [Memory]
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Memory] -> f [Memory]) -> [Memory] -> f [Memory]
forall a b. (a -> b) -> a -> b
$ []
      toList (SCons a
x Stream m a
xs) = (:) (Memory -> [Memory] -> [Memory])
-> f Memory -> f ([Memory] -> [Memory])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f Memory
forall (m :: * -> *) a. MemoryCell m a => a -> m Memory
prettyCell a
x f ([Memory] -> [Memory]) -> f [Memory] -> f [Memory]
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Stream m a -> f [Memory]
toList Stream m a
xs
      toList (SIndirect Thunk m (Lazy m) (Stream m a)
t) = [Memory] -> f [Memory]
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Memory] -> f [Memory]) -> [Memory] -> f [Memory]
forall a b. (a -> b) -> a -> b
$ []

      toHole :: Stream m a -> f (Maybe Memory)
toHole Stream m a
SNil = Maybe Memory -> f (Maybe Memory)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Memory -> f (Maybe Memory))
-> Maybe Memory -> f (Maybe Memory)
forall a b. (a -> b) -> a -> b
$ Maybe Memory
forall a. Maybe a
Nothing
      toHole (SCons a
x Stream m a
xs) = Stream m a -> f (Maybe Memory)
toHole Stream m a
xs
      toHole (SIndirect Thunk m (Lazy m) (Stream m a)
t) = Memory -> Maybe Memory
forall a. a -> Maybe a
Just (Memory -> Maybe Memory) -> f Memory -> f (Maybe Memory)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Thunk m (Lazy m) (Stream m a) -> f Memory
forall (m :: * -> *) a. MemoryCell m a => a -> m Memory
prettyCell Thunk m (Lazy m) (Stream m a)
t

instance (MonadMemory m, MemoryCell m a) => MemoryCell m (SMergeSort a m) where
  prettyCell :: SMergeSort a m -> m Memory
prettyCell (SMergeSort Size
size [(Stream m a, Schedule m a)]
segs) = do
    Memory
size' <- Size -> m Memory
forall (m :: * -> *) a. MemoryCell m a => a -> m Memory
prettyCell Size
size
    Memory
segs' <- [(Stream m a, Schedule m a)] -> m Memory
forall (m :: * -> *) a. MemoryCell m a => a -> m Memory
prettyCell [(Stream m a, Schedule m a)]
segs
    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
"SMergeSort" [Memory
size', Memory
segs']

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