{-# LANGUAGE TypeFamilies #-}

module Test.Credit.RandomAccess.Binary where

import Prelude hiding (lookup)
import Prettyprinter (Pretty)
import Control.Monad.Credit hiding (exec)
import Test.Credit
import Test.Credit.RandomAccess.Base

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

data Tree a = Leaf a | Node Int (Tree a) (Tree a)
  deriving (Tree a -> Tree a -> Bool
(Tree a -> Tree a -> Bool)
-> (Tree a -> Tree a -> Bool) -> Eq (Tree a)
forall a. Eq a => Tree a -> Tree a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => Tree a -> Tree a -> Bool
== :: Tree a -> Tree a -> Bool
$c/= :: forall a. Eq a => Tree a -> Tree a -> Bool
/= :: Tree a -> Tree a -> Bool
Eq, Eq (Tree a)
Eq (Tree a) =>
(Tree a -> Tree a -> Ordering)
-> (Tree a -> Tree a -> Bool)
-> (Tree a -> Tree a -> Bool)
-> (Tree a -> Tree a -> Bool)
-> (Tree a -> Tree a -> Bool)
-> (Tree a -> Tree a -> Tree a)
-> (Tree a -> Tree a -> Tree a)
-> Ord (Tree a)
Tree a -> Tree a -> Bool
Tree a -> Tree a -> Ordering
Tree a -> Tree a -> Tree a
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (Tree a)
forall a. Ord a => Tree a -> Tree a -> Bool
forall a. Ord a => Tree a -> Tree a -> Ordering
forall a. Ord a => Tree a -> Tree a -> Tree a
$ccompare :: forall a. Ord a => Tree a -> Tree a -> Ordering
compare :: Tree a -> Tree a -> Ordering
$c< :: forall a. Ord a => Tree a -> Tree a -> Bool
< :: Tree a -> Tree a -> Bool
$c<= :: forall a. Ord a => Tree a -> Tree a -> Bool
<= :: Tree a -> Tree a -> Bool
$c> :: forall a. Ord a => Tree a -> Tree a -> Bool
> :: Tree a -> Tree a -> Bool
$c>= :: forall a. Ord a => Tree a -> Tree a -> Bool
>= :: Tree a -> Tree a -> Bool
$cmax :: forall a. Ord a => Tree a -> Tree a -> Tree a
max :: Tree a -> Tree a -> Tree a
$cmin :: forall a. Ord a => Tree a -> Tree a -> Tree a
min :: Tree a -> Tree a -> Tree a
Ord, Int -> Tree a -> ShowS
[Tree a] -> ShowS
Tree a -> String
(Int -> Tree a -> ShowS)
-> (Tree a -> String) -> ([Tree a] -> ShowS) -> Show (Tree a)
forall a. Show a => Int -> Tree a -> ShowS
forall a. Show a => [Tree a] -> ShowS
forall a. Show a => Tree a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Tree a -> ShowS
showsPrec :: Int -> Tree a -> ShowS
$cshow :: forall a. Show a => Tree a -> String
show :: Tree a -> String
$cshowList :: forall a. Show a => [Tree a] -> ShowS
showList :: [Tree a] -> ShowS
Show)

data Digit a = Zero | One (Tree a) | Two (Tree a) (Tree a)
  deriving (Digit a -> Digit a -> Bool
(Digit a -> Digit a -> Bool)
-> (Digit a -> Digit a -> Bool) -> Eq (Digit a)
forall a. Eq a => Digit a -> Digit a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => Digit a -> Digit a -> Bool
== :: Digit a -> Digit a -> Bool
$c/= :: forall a. Eq a => Digit a -> Digit a -> Bool
/= :: Digit a -> Digit a -> Bool
Eq, Eq (Digit a)
Eq (Digit a) =>
(Digit a -> Digit a -> Ordering)
-> (Digit a -> Digit a -> Bool)
-> (Digit a -> Digit a -> Bool)
-> (Digit a -> Digit a -> Bool)
-> (Digit a -> Digit a -> Bool)
-> (Digit a -> Digit a -> Digit a)
-> (Digit a -> Digit a -> Digit a)
-> Ord (Digit a)
Digit a -> Digit a -> Bool
Digit a -> Digit a -> Ordering
Digit a -> Digit a -> Digit a
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (Digit a)
forall a. Ord a => Digit a -> Digit a -> Bool
forall a. Ord a => Digit a -> Digit a -> Ordering
forall a. Ord a => Digit a -> Digit a -> Digit a
$ccompare :: forall a. Ord a => Digit a -> Digit a -> Ordering
compare :: Digit a -> Digit a -> Ordering
$c< :: forall a. Ord a => Digit a -> Digit a -> Bool
< :: Digit a -> Digit a -> Bool
$c<= :: forall a. Ord a => Digit a -> Digit a -> Bool
<= :: Digit a -> Digit a -> Bool
$c> :: forall a. Ord a => Digit a -> Digit a -> Bool
> :: Digit a -> Digit a -> Bool
$c>= :: forall a. Ord a => Digit a -> Digit a -> Bool
>= :: Digit a -> Digit a -> Bool
$cmax :: forall a. Ord a => Digit a -> Digit a -> Digit a
max :: Digit a -> Digit a -> Digit a
$cmin :: forall a. Ord a => Digit a -> Digit a -> Digit a
min :: Digit a -> Digit a -> Digit a
Ord, Int -> Digit a -> ShowS
[Digit a] -> ShowS
Digit a -> String
(Int -> Digit a -> ShowS)
-> (Digit a -> String) -> ([Digit a] -> ShowS) -> Show (Digit a)
forall a. Show a => Int -> Digit a -> ShowS
forall a. Show a => [Digit a] -> ShowS
forall a. Show a => Digit a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Digit a -> ShowS
showsPrec :: Int -> Digit a -> ShowS
$cshow :: forall a. Show a => Digit a -> String
show :: Digit a -> String
$cshowList :: forall a. Show a => [Digit a] -> ShowS
showList :: [Digit a] -> ShowS
Show)

size :: Tree a -> Int
size :: forall a. Tree a -> Int
size (Leaf a
_) = Int
1
size (Node Int
w Tree a
_ Tree a
_) = Int
w

link :: Tree a -> Tree a -> Tree a
link :: forall a. Tree a -> Tree a -> Tree a
link Tree a
t1 Tree a
t2 = Int -> Tree a -> Tree a -> Tree a
forall a. Int -> Tree a -> Tree a -> Tree a
Node (Tree a -> Int
forall a. Tree a -> Int
size Tree a
t1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Tree a -> Int
forall a. Tree a -> Int
size Tree a
t2) Tree a
t1 Tree a
t2

consTree :: MonadCredit m => Tree a -> Stream m (Digit a) -> m (Stream m (Digit a))
consTree :: forall (m :: * -> *) a.
MonadCredit m =>
Tree a -> Stream m (Digit a) -> m (Stream m (Digit a))
consTree Tree a
t Stream m (Digit a)
ts = Stream m (Digit a)
-> m (Stream m (Digit a))
-> (Digit a -> Stream m (Digit a) -> m (Stream m (Digit a)))
-> m (Stream m (Digit a))
forall (m :: * -> *) a b.
MonadCredit m =>
Stream m a -> m b -> (a -> Stream m a -> m b) -> m b
smatch Stream m (Digit a)
ts
  (Stream m (Digit a) -> m (Stream m (Digit a))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Stream m (Digit a) -> m (Stream m (Digit a)))
-> Stream m (Digit a) -> m (Stream m (Digit a))
forall a b. (a -> b) -> a -> b
$ Digit a -> Stream m (Digit a) -> Stream m (Digit a)
forall (m :: * -> *) a. a -> Stream m a -> Stream m a
SCons (Tree a -> Digit a
forall a. Tree a -> Digit a
One Tree a
t) Stream m (Digit a)
forall (m :: * -> *) a. Stream m a
SNil)
  (\Digit a
d Stream m (Digit a)
ds -> case Digit a
d of
    Digit a
Zero -> Stream m (Digit a) -> m (Stream m (Digit a))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Stream m (Digit a) -> m (Stream m (Digit a)))
-> Stream m (Digit a) -> m (Stream m (Digit a))
forall a b. (a -> b) -> a -> b
$ Digit a -> Stream m (Digit a) -> Stream m (Digit a)
forall (m :: * -> *) a. a -> Stream m a -> Stream m a
SCons (Tree a -> Digit a
forall a. Tree a -> Digit a
One Tree a
t) Stream m (Digit a)
ds
    One Tree a
t' -> Credit -> Stream m (Digit a) -> m ()
forall (m :: * -> *) a.
MonadCredit m =>
Credit -> Stream m a -> m ()
credit Credit
1 Stream m (Digit a)
ds m () -> m (Stream m (Digit a)) -> m (Stream m (Digit a))
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Stream m (Digit a) -> m (Stream m (Digit a))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Digit a -> Stream m (Digit a) -> Stream m (Digit a)
forall (m :: * -> *) a. a -> Stream m a -> Stream m a
SCons (Tree a -> Tree a -> Digit a
forall a. Tree a -> Tree a -> Digit a
Two Tree a
t Tree a
t') Stream m (Digit a)
ds)
    Two Tree a
t2 Tree a
t3 -> do
      Stream m (Digit a)
ds' <- m (Stream m (Digit a)) -> m (Stream m (Digit a))
forall (m :: * -> *) a.
MonadCredit m =>
m (Stream m a) -> m (Stream m a)
indirect (m (Stream m (Digit a)) -> m (Stream m (Digit a)))
-> m (Stream m (Digit a)) -> m (Stream m (Digit a))
forall a b. (a -> b) -> a -> b
$ Tree a -> Stream m (Digit a) -> m (Stream m (Digit a))
forall (m :: * -> *) a.
MonadCredit m =>
Tree a -> Stream m (Digit a) -> m (Stream m (Digit a))
consTree (Tree a -> Tree a -> Tree a
forall a. Tree a -> Tree a -> Tree a
link Tree a
t2 Tree a
t3) Stream m (Digit a)
ds
      Credit -> Stream m (Digit a) -> m ()
forall (m :: * -> *) a.
MonadCredit m =>
Credit -> Stream m a -> m ()
credit Credit
1 Stream m (Digit a)
ds'
      Stream m (Digit a) -> m (Stream m (Digit a))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Stream m (Digit a) -> m (Stream m (Digit a)))
-> Stream m (Digit a) -> m (Stream m (Digit a))
forall a b. (a -> b) -> a -> b
$ Digit a -> Stream m (Digit a) -> Stream m (Digit a)
forall (m :: * -> *) a. a -> Stream m a -> Stream m a
SCons (Tree a -> Digit a
forall a. Tree a -> Digit a
One Tree a
t) Stream m (Digit a)
ds')

unconsTree :: MonadCredit m => Stream m (Digit a) -> m (Maybe (Tree a, Stream m (Digit a)))
unconsTree :: forall (m :: * -> *) a.
MonadCredit m =>
Stream m (Digit a) -> m (Maybe (Tree a, Stream m (Digit a)))
unconsTree Stream m (Digit a)
ts = Stream m (Digit a)
-> m (Maybe (Tree a, Stream m (Digit a)))
-> (Digit a
    -> Stream m (Digit a) -> m (Maybe (Tree a, Stream m (Digit a))))
-> m (Maybe (Tree a, Stream m (Digit a)))
forall (m :: * -> *) a b.
MonadCredit m =>
Stream m a -> m b -> (a -> Stream m a -> m b) -> m b
smatch Stream m (Digit a)
ts
  (Maybe (Tree a, Stream m (Digit a))
-> m (Maybe (Tree a, Stream m (Digit a)))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Tree a, Stream m (Digit a))
forall a. Maybe a
Nothing)
  (\Digit a
d Stream m (Digit a)
ds -> case Digit a
d of
    One Tree a
t -> Credit -> Stream m (Digit a) -> m ()
forall (m :: * -> *) a.
MonadCredit m =>
Credit -> Stream m a -> m ()
credit Credit
1 Stream m (Digit a)
ds m ()
-> m (Maybe (Tree a, Stream m (Digit a)))
-> m (Maybe (Tree a, Stream m (Digit a)))
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Stream m (Digit a)
-> m (Maybe (Tree a, Stream m (Digit a)))
-> (Digit a
    -> Stream m (Digit a) -> m (Maybe (Tree a, Stream m (Digit a))))
-> m (Maybe (Tree a, Stream m (Digit a)))
forall (m :: * -> *) a b.
MonadCredit m =>
Stream m a -> m b -> (a -> Stream m a -> m b) -> m b
smatch Stream m (Digit a)
ds
      (Maybe (Tree a, Stream m (Digit a))
-> m (Maybe (Tree a, Stream m (Digit a)))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Tree a, Stream m (Digit a))
 -> m (Maybe (Tree a, Stream m (Digit a))))
-> Maybe (Tree a, Stream m (Digit a))
-> m (Maybe (Tree a, Stream m (Digit a)))
forall a b. (a -> b) -> a -> b
$ (Tree a, Stream m (Digit a)) -> Maybe (Tree a, Stream m (Digit a))
forall a. a -> Maybe a
Just (Tree a
t, Stream m (Digit a)
forall (m :: * -> *) a. Stream m a
SNil))
      (\Digit a
_ Stream m (Digit a)
_ -> Maybe (Tree a, Stream m (Digit a))
-> m (Maybe (Tree a, Stream m (Digit a)))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Tree a, Stream m (Digit a))
 -> m (Maybe (Tree a, Stream m (Digit a))))
-> Maybe (Tree a, Stream m (Digit a))
-> m (Maybe (Tree a, Stream m (Digit a)))
forall a b. (a -> b) -> a -> b
$ (Tree a, Stream m (Digit a)) -> Maybe (Tree a, Stream m (Digit a))
forall a. a -> Maybe a
Just (Tree a
t, Digit a -> Stream m (Digit a) -> Stream m (Digit a)
forall (m :: * -> *) a. a -> Stream m a -> Stream m a
SCons Digit a
forall a. Digit a
Zero Stream m (Digit a)
ds))
    Two Tree a
t Tree a
t' -> Maybe (Tree a, Stream m (Digit a))
-> m (Maybe (Tree a, Stream m (Digit a)))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Tree a, Stream m (Digit a))
 -> m (Maybe (Tree a, Stream m (Digit a))))
-> Maybe (Tree a, Stream m (Digit a))
-> m (Maybe (Tree a, Stream m (Digit a)))
forall a b. (a -> b) -> a -> b
$ (Tree a, Stream m (Digit a)) -> Maybe (Tree a, Stream m (Digit a))
forall a. a -> Maybe a
Just (Tree a
t, Digit a -> Stream m (Digit a) -> Stream m (Digit a)
forall (m :: * -> *) a. a -> Stream m a -> Stream m a
SCons (Tree a -> Digit a
forall a. Tree a -> Digit a
One Tree a
t') Stream m (Digit a)
ds)
    Digit a
Zero -> do
      Maybe (Tree a, Stream m (Digit a))
ds' <- Stream m (Digit a) -> m (Maybe (Tree a, Stream m (Digit a)))
forall (m :: * -> *) a.
MonadCredit m =>
Stream m (Digit a) -> m (Maybe (Tree a, Stream m (Digit a)))
unconsTree Stream m (Digit a)
ds
      case Maybe (Tree a, Stream m (Digit a))
ds' of
        Just (Node Int
_ Tree a
t1 Tree a
t2, Stream m (Digit a)
ds'') -> Maybe (Tree a, Stream m (Digit a))
-> m (Maybe (Tree a, Stream m (Digit a)))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Tree a, Stream m (Digit a))
 -> m (Maybe (Tree a, Stream m (Digit a))))
-> Maybe (Tree a, Stream m (Digit a))
-> m (Maybe (Tree a, Stream m (Digit a)))
forall a b. (a -> b) -> a -> b
$ (Tree a, Stream m (Digit a)) -> Maybe (Tree a, Stream m (Digit a))
forall a. a -> Maybe a
Just (Tree a
t1, Digit a -> Stream m (Digit a) -> Stream m (Digit a)
forall (m :: * -> *) a. a -> Stream m a -> Stream m a
SCons (Tree a -> Digit a
forall a. Tree a -> Digit a
One Tree a
t2) Stream m (Digit a)
ds'')
        Maybe (Tree a, Stream m (Digit a))
_ -> Maybe (Tree a, Stream m (Digit a))
-> m (Maybe (Tree a, Stream m (Digit a)))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Tree a, Stream m (Digit a))
forall a. Maybe a
Nothing)

lookupTree :: MonadCredit m => Int -> Tree a -> m (Maybe a)
lookupTree :: forall (m :: * -> *) a.
MonadCredit m =>
Int -> Tree a -> m (Maybe a)
lookupTree Int
0 (Leaf a
x) = Maybe a -> m (Maybe a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe a -> m (Maybe a)) -> Maybe a -> m (Maybe a)
forall a b. (a -> b) -> a -> b
$ a -> Maybe a
forall a. a -> Maybe a
Just a
x
lookupTree Int
i (Leaf a
_) = Maybe a -> m (Maybe a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing
lookupTree Int
i (Node Int
w Tree a
t1 Tree a
t2)
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
w Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2 = m ()
forall (m :: * -> *). MonadCount m => m ()
tick m () -> m (Maybe a) -> m (Maybe a)
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Tree a -> m (Maybe a)
forall (m :: * -> *) a.
MonadCredit m =>
Int -> Tree a -> m (Maybe a)
lookupTree Int
i Tree a
t1
  | Bool
otherwise = m ()
forall (m :: * -> *). MonadCount m => m ()
tick m () -> m (Maybe a) -> m (Maybe a)
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Tree a -> m (Maybe a)
forall (m :: * -> *) a.
MonadCredit m =>
Int -> Tree a -> m (Maybe a)
lookupTree (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
w Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2) Tree a
t2

updateTree :: MonadCredit m => Int -> a -> Tree a -> m (Tree a)
updateTree :: forall (m :: * -> *) a.
MonadCredit m =>
Int -> a -> Tree a -> m (Tree a)
updateTree Int
0 a
y (Leaf a
_) = Tree a -> m (Tree a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Tree a -> m (Tree a)) -> Tree a -> m (Tree a)
forall a b. (a -> b) -> a -> b
$ a -> Tree a
forall a. a -> Tree a
Leaf a
y
updateTree Int
i a
_ (Leaf a
x) = Tree a -> m (Tree a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Tree a -> m (Tree a)) -> Tree a -> m (Tree a)
forall a b. (a -> b) -> a -> b
$ a -> Tree a
forall a. a -> Tree a
Leaf a
x
updateTree Int
i a
y (Node Int
w Tree a
t1 Tree a
t2)
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
w Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2 = m ()
forall (m :: * -> *). MonadCount m => m ()
tick m () -> m (Tree a) -> m (Tree a)
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> do
      Tree a
t1' <- Int -> a -> Tree a -> m (Tree a)
forall (m :: * -> *) a.
MonadCredit m =>
Int -> a -> Tree a -> m (Tree a)
updateTree Int
i a
y Tree a
t1
      Tree a -> m (Tree a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Tree a -> m (Tree a)) -> Tree a -> m (Tree a)
forall a b. (a -> b) -> a -> b
$ Int -> Tree a -> Tree a -> Tree a
forall a. Int -> Tree a -> Tree a -> Tree a
Node Int
w Tree a
t1' Tree a
t2
  | Bool
otherwise = m ()
forall (m :: * -> *). MonadCount m => m ()
tick m () -> m (Tree a) -> m (Tree a)
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> do
      Tree a
t2' <- Int -> a -> Tree a -> m (Tree a)
forall (m :: * -> *) a.
MonadCredit m =>
Int -> a -> Tree a -> m (Tree a)
updateTree (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
w Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2) a
y Tree a
t2
      Tree a -> m (Tree a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Tree a -> m (Tree a)) -> Tree a -> m (Tree a)
forall a b. (a -> b) -> a -> b
$ Int -> Tree a -> Tree a -> Tree a
forall a. Int -> Tree a -> Tree a -> Tree a
Node Int
w Tree a
t1 Tree a
t2'

newtype BinaryRA a m = BinaryRA { forall a (m :: * -> *). BinaryRA a m -> Stream m (Digit a)
unBinaryRA :: Stream m (Digit a) }

instance RandomAccess BinaryRA where
  empty :: forall (m :: * -> *) a. MonadCredit m => m (BinaryRA a m)
empty = BinaryRA a m -> m (BinaryRA a m)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BinaryRA a m -> m (BinaryRA a m))
-> BinaryRA a m -> m (BinaryRA a m)
forall a b. (a -> b) -> a -> b
$ Stream m (Digit a) -> BinaryRA a m
forall a (m :: * -> *). Stream m (Digit a) -> BinaryRA a m
BinaryRA Stream m (Digit a)
forall (m :: * -> *) a. Stream m a
SNil
  cons :: forall (m :: * -> *) a.
MonadCredit m =>
a -> BinaryRA a m -> m (BinaryRA a m)
cons a
x (BinaryRA Stream m (Digit a)
ts) = Stream m (Digit a) -> BinaryRA a m
forall a (m :: * -> *). Stream m (Digit a) -> BinaryRA a m
BinaryRA (Stream m (Digit a) -> BinaryRA a m)
-> m (Stream m (Digit a)) -> m (BinaryRA a m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Tree a -> Stream m (Digit a) -> m (Stream m (Digit a))
forall (m :: * -> *) a.
MonadCredit m =>
Tree a -> Stream m (Digit a) -> m (Stream m (Digit a))
consTree (a -> Tree a
forall a. a -> Tree a
Leaf a
x) Stream m (Digit a)
ts
  uncons :: forall (m :: * -> *) a.
MonadCredit m =>
BinaryRA a m -> m (Maybe (a, BinaryRA a m))
uncons (BinaryRA Stream m (Digit a)
ts) = do
    Maybe (Tree a, Stream m (Digit a))
m <- Stream m (Digit a) -> m (Maybe (Tree a, Stream m (Digit a)))
forall (m :: * -> *) a.
MonadCredit m =>
Stream m (Digit a) -> m (Maybe (Tree a, Stream m (Digit a)))
unconsTree Stream m (Digit a)
ts
    case Maybe (Tree a, Stream m (Digit a))
m of
      Just (Leaf a
x, Stream m (Digit a)
ts') -> Maybe (a, BinaryRA a m) -> m (Maybe (a, BinaryRA a m))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (a, BinaryRA a m) -> m (Maybe (a, BinaryRA a m)))
-> Maybe (a, BinaryRA a m) -> m (Maybe (a, BinaryRA a m))
forall a b. (a -> b) -> a -> b
$ (a, BinaryRA a m) -> Maybe (a, BinaryRA a m)
forall a. a -> Maybe a
Just (a
x, Stream m (Digit a) -> BinaryRA a m
forall a (m :: * -> *). Stream m (Digit a) -> BinaryRA a m
BinaryRA Stream m (Digit a)
ts')
      Maybe (Tree a, Stream m (Digit a))
_ -> Maybe (a, BinaryRA a m) -> m (Maybe (a, BinaryRA a m))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (a, BinaryRA a m)
forall a. Maybe a
Nothing
  lookup :: forall (m :: * -> *) a.
MonadCredit m =>
Int -> BinaryRA a m -> m (Maybe a)
lookup Int
i (BinaryRA Stream m (Digit a)
ts) = Stream m (Digit a)
-> m (Maybe a)
-> (Digit a -> Stream m (Digit a) -> m (Maybe a))
-> m (Maybe a)
forall (m :: * -> *) a b.
MonadCredit m =>
Stream m a -> m b -> (a -> Stream m a -> m b) -> m b
smatch Stream m (Digit a)
ts
    (Maybe a -> m (Maybe a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing)
    (\Digit a
d Stream m (Digit a)
ds -> case Digit a
d of
      Digit a
Zero -> Int -> BinaryRA a m -> m (Maybe a)
forall (m :: * -> *) a.
MonadCredit m =>
Int -> BinaryRA a m -> m (Maybe a)
forall (q :: * -> (* -> *) -> *) (m :: * -> *) a.
(RandomAccess q, MonadCredit m) =>
Int -> q a m -> m (Maybe a)
lookup Int
i (Stream m (Digit a) -> BinaryRA a m
forall a (m :: * -> *). Stream m (Digit a) -> BinaryRA a m
BinaryRA Stream m (Digit a)
ds)
      One Tree a
t ->
        if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Tree a -> Int
forall a. Tree a -> Int
size Tree a
t
          then Int -> Tree a -> m (Maybe a)
forall (m :: * -> *) a.
MonadCredit m =>
Int -> Tree a -> m (Maybe a)
lookupTree Int
i Tree a
t
          else Credit -> Stream m (Digit a) -> m ()
forall (m :: * -> *) a.
MonadCredit m =>
Credit -> Stream m a -> m ()
credit Credit
1 Stream m (Digit a)
ds m () -> m (Maybe a) -> m (Maybe a)
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> BinaryRA a m -> m (Maybe a)
forall (m :: * -> *) a.
MonadCredit m =>
Int -> BinaryRA a m -> m (Maybe a)
forall (q :: * -> (* -> *) -> *) (m :: * -> *) a.
(RandomAccess q, MonadCredit m) =>
Int -> q a m -> m (Maybe a)
lookup (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Tree a -> Int
forall a. Tree a -> Int
size Tree a
t) (Stream m (Digit a) -> BinaryRA a m
forall a (m :: * -> *). Stream m (Digit a) -> BinaryRA a m
BinaryRA Stream m (Digit a)
ds)
      Two Tree a
t1 Tree a
t2 ->
        if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Tree a -> Int
forall a. Tree a -> Int
size Tree a
t1
          then Int -> Tree a -> m (Maybe a)
forall (m :: * -> *) a.
MonadCredit m =>
Int -> Tree a -> m (Maybe a)
lookupTree Int
i Tree a
t1
          else let j :: Int
j = Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Tree a -> Int
forall a. Tree a -> Int
size Tree a
t1 in
            if Int
j Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Tree a -> Int
forall a. Tree a -> Int
size Tree a
t2
              then Int -> Tree a -> m (Maybe a)
forall (m :: * -> *) a.
MonadCredit m =>
Int -> Tree a -> m (Maybe a)
lookupTree Int
j Tree a
t2
              else Int -> BinaryRA a m -> m (Maybe a)
forall (m :: * -> *) a.
MonadCredit m =>
Int -> BinaryRA a m -> m (Maybe a)
forall (q :: * -> (* -> *) -> *) (m :: * -> *) a.
(RandomAccess q, MonadCredit m) =>
Int -> q a m -> m (Maybe a)
lookup (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
- Tree a -> Int
forall a. Tree a -> Int
size Tree a
t2) (Stream m (Digit a) -> BinaryRA a m
forall a (m :: * -> *). Stream m (Digit a) -> BinaryRA a m
BinaryRA Stream m (Digit a)
ds))
  update :: forall (m :: * -> *) a.
MonadCredit m =>
Int -> a -> BinaryRA a m -> m (BinaryRA a m)
update Int
i a
y (BinaryRA Stream m (Digit a)
ts) = Stream m (Digit a)
-> m (BinaryRA a m)
-> (Digit a -> Stream m (Digit a) -> m (BinaryRA a m))
-> m (BinaryRA a m)
forall (m :: * -> *) a b.
MonadCredit m =>
Stream m a -> m b -> (a -> Stream m a -> m b) -> m b
smatch Stream m (Digit a)
ts
    (BinaryRA a m -> m (BinaryRA a m)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BinaryRA a m -> m (BinaryRA a m))
-> BinaryRA a m -> m (BinaryRA a m)
forall a b. (a -> b) -> a -> b
$ Stream m (Digit a) -> BinaryRA a m
forall a (m :: * -> *). Stream m (Digit a) -> BinaryRA a m
BinaryRA Stream m (Digit a)
forall (m :: * -> *) a. Stream m a
SNil)
    (\Digit a
d Stream m (Digit a)
ds -> case Digit a
d of
      Digit a
Zero -> Stream m (Digit a) -> BinaryRA a m
forall a (m :: * -> *). Stream m (Digit a) -> BinaryRA a m
BinaryRA (Stream m (Digit a) -> BinaryRA a m)
-> (BinaryRA a m -> Stream m (Digit a))
-> BinaryRA a m
-> BinaryRA a m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Digit a -> Stream m (Digit a) -> Stream m (Digit a)
forall (m :: * -> *) a. a -> Stream m a -> Stream m a
SCons Digit a
forall a. Digit a
Zero) (Stream m (Digit a) -> Stream m (Digit a))
-> (BinaryRA a m -> Stream m (Digit a))
-> BinaryRA a m
-> Stream m (Digit a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BinaryRA a m -> Stream m (Digit a)
forall a (m :: * -> *). BinaryRA a m -> Stream m (Digit a)
unBinaryRA (BinaryRA a m -> BinaryRA a m)
-> m (BinaryRA a m) -> m (BinaryRA a m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> a -> BinaryRA a m -> m (BinaryRA a m)
forall (m :: * -> *) a.
MonadCredit m =>
Int -> a -> BinaryRA a m -> m (BinaryRA a m)
forall (q :: * -> (* -> *) -> *) (m :: * -> *) a.
(RandomAccess q, MonadCredit m) =>
Int -> a -> q a m -> m (q a m)
update Int
i a
y (Stream m (Digit a) -> BinaryRA a m
forall a (m :: * -> *). Stream m (Digit a) -> BinaryRA a m
BinaryRA Stream m (Digit a)
ds)
      One Tree a
t ->
        if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Tree a -> Int
forall a. Tree a -> Int
size Tree a
t
          then Stream m (Digit a) -> BinaryRA a m
forall a (m :: * -> *). Stream m (Digit a) -> BinaryRA a m
BinaryRA (Stream m (Digit a) -> BinaryRA a m)
-> (Tree a -> Stream m (Digit a)) -> Tree a -> BinaryRA a m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Digit a -> Stream m (Digit a) -> Stream m (Digit a))
-> Stream m (Digit a) -> Digit a -> Stream m (Digit a)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Digit a -> Stream m (Digit a) -> Stream m (Digit a)
forall (m :: * -> *) a. a -> Stream m a -> Stream m a
SCons Stream m (Digit a)
ds) (Digit a -> Stream m (Digit a))
-> (Tree a -> Digit a) -> Tree a -> Stream m (Digit a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tree a -> Digit a
forall a. Tree a -> Digit a
One (Tree a -> BinaryRA a m) -> m (Tree a) -> m (BinaryRA a m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> a -> Tree a -> m (Tree a)
forall (m :: * -> *) a.
MonadCredit m =>
Int -> a -> Tree a -> m (Tree a)
updateTree Int
i a
y Tree a
t
          else Credit -> Stream m (Digit a) -> m ()
forall (m :: * -> *) a.
MonadCredit m =>
Credit -> Stream m a -> m ()
credit Credit
1 Stream m (Digit a)
ds m () -> m (BinaryRA a m) -> m (BinaryRA a m)
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Stream m (Digit a) -> BinaryRA a m
forall a (m :: * -> *). Stream m (Digit a) -> BinaryRA a m
BinaryRA (Stream m (Digit a) -> BinaryRA a m)
-> (BinaryRA a m -> Stream m (Digit a))
-> BinaryRA a m
-> BinaryRA a m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Digit a -> Stream m (Digit a) -> Stream m (Digit a)
forall (m :: * -> *) a. a -> Stream m a -> Stream m a
SCons (Tree a -> Digit a
forall a. Tree a -> Digit a
One Tree a
t)) (Stream m (Digit a) -> Stream m (Digit a))
-> (BinaryRA a m -> Stream m (Digit a))
-> BinaryRA a m
-> Stream m (Digit a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BinaryRA a m -> Stream m (Digit a)
forall a (m :: * -> *). BinaryRA a m -> Stream m (Digit a)
unBinaryRA (BinaryRA a m -> BinaryRA a m)
-> m (BinaryRA a m) -> m (BinaryRA a m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> a -> BinaryRA a m -> m (BinaryRA a m)
forall (m :: * -> *) a.
MonadCredit m =>
Int -> a -> BinaryRA a m -> m (BinaryRA a m)
forall (q :: * -> (* -> *) -> *) (m :: * -> *) a.
(RandomAccess q, MonadCredit m) =>
Int -> a -> q a m -> m (q a m)
update (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Tree a -> Int
forall a. Tree a -> Int
size Tree a
t) a
y (Stream m (Digit a) -> BinaryRA a m
forall a (m :: * -> *). Stream m (Digit a) -> BinaryRA a m
BinaryRA Stream m (Digit a)
ds)
      Two Tree a
t1 Tree a
t2 ->
        if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Tree a -> Int
forall a. Tree a -> Int
size Tree a
t1
          then Stream m (Digit a) -> BinaryRA a m
forall a (m :: * -> *). Stream m (Digit a) -> BinaryRA a m
BinaryRA (Stream m (Digit a) -> BinaryRA a m)
-> (Tree a -> Stream m (Digit a)) -> Tree a -> BinaryRA a m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Digit a -> Stream m (Digit a) -> Stream m (Digit a))
-> Stream m (Digit a) -> Digit a -> Stream m (Digit a)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Digit a -> Stream m (Digit a) -> Stream m (Digit a)
forall (m :: * -> *) a. a -> Stream m a -> Stream m a
SCons Stream m (Digit a)
ds) (Digit a -> Stream m (Digit a))
-> (Tree a -> Digit a) -> Tree a -> Stream m (Digit a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Tree a -> Tree a -> Digit a) -> Tree a -> Tree a -> Digit a
forall a b c. (a -> b -> c) -> b -> a -> c
flip Tree a -> Tree a -> Digit a
forall a. Tree a -> Tree a -> Digit a
Two Tree a
t2 (Tree a -> BinaryRA a m) -> m (Tree a) -> m (BinaryRA a m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> a -> Tree a -> m (Tree a)
forall (m :: * -> *) a.
MonadCredit m =>
Int -> a -> Tree a -> m (Tree a)
updateTree Int
i a
y Tree a
t1
          else let j :: Int
j = Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Tree a -> Int
forall a. Tree a -> Int
size Tree a
t1 in
            if Int
j Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Tree a -> Int
forall a. Tree a -> Int
size Tree a
t2
              then Stream m (Digit a) -> BinaryRA a m
forall a (m :: * -> *). Stream m (Digit a) -> BinaryRA a m
BinaryRA (Stream m (Digit a) -> BinaryRA a m)
-> (Tree a -> Stream m (Digit a)) -> Tree a -> BinaryRA a m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Digit a -> Stream m (Digit a) -> Stream m (Digit a))
-> Stream m (Digit a) -> Digit a -> Stream m (Digit a)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Digit a -> Stream m (Digit a) -> Stream m (Digit a)
forall (m :: * -> *) a. a -> Stream m a -> Stream m a
SCons Stream m (Digit a)
ds) (Digit a -> Stream m (Digit a))
-> (Tree a -> Digit a) -> Tree a -> Stream m (Digit a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tree a -> Tree a -> Digit a
forall a. Tree a -> Tree a -> Digit a
Two Tree a
t1 (Tree a -> BinaryRA a m) -> m (Tree a) -> m (BinaryRA a m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> a -> Tree a -> m (Tree a)
forall (m :: * -> *) a.
MonadCredit m =>
Int -> a -> Tree a -> m (Tree a)
updateTree Int
j a
y Tree a
t2
              else Stream m (Digit a) -> BinaryRA a m
forall a (m :: * -> *). Stream m (Digit a) -> BinaryRA a m
BinaryRA (Stream m (Digit a) -> BinaryRA a m)
-> (BinaryRA a m -> Stream m (Digit a))
-> BinaryRA a m
-> BinaryRA a m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Digit a -> Stream m (Digit a) -> Stream m (Digit a)
forall (m :: * -> *) a. a -> Stream m a -> Stream m a
SCons (Tree a -> Tree a -> Digit a
forall a. Tree a -> Tree a -> Digit a
Two Tree a
t1 Tree a
t2)) (Stream m (Digit a) -> Stream m (Digit a))
-> (BinaryRA a m -> Stream m (Digit a))
-> BinaryRA a m
-> Stream m (Digit a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BinaryRA a m -> Stream m (Digit a)
forall a (m :: * -> *). BinaryRA a m -> Stream m (Digit a)
unBinaryRA (BinaryRA a m -> BinaryRA a m)
-> m (BinaryRA a m) -> m (BinaryRA a m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> a -> BinaryRA a m -> m (BinaryRA a m)
forall (m :: * -> *) a.
MonadCredit m =>
Int -> a -> BinaryRA a m -> m (BinaryRA a m)
forall (q :: * -> (* -> *) -> *) (m :: * -> *) a.
(RandomAccess q, MonadCredit m) =>
Int -> a -> q a m -> m (q a m)
update (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
- Tree a -> Int
forall a. Tree a -> Int
size Tree a
t2) a
y (Stream m (Digit a) -> BinaryRA a m
forall a (m :: * -> *). Stream m (Digit a) -> BinaryRA a m
BinaryRA Stream m (Digit a)
ds))

instance BoundedRandomAccess BinaryRA where
  qcost :: forall a. Size -> RandomAccessOp a -> Credit
qcost Size
n (Cons a
_) = Credit
2
  qcost Size
n RandomAccessOp a
Uncons = Credit
3 Credit -> Credit -> Credit
forall a. Num a => a -> a -> a
+ Size -> Credit
log2 Size
n
  qcost Size
n (Lookup Int
_) = Credit
1 Credit -> Credit -> Credit
forall a. Num a => a -> a -> a
+ Credit
3 Credit -> Credit -> Credit
forall a. Num a => a -> a -> a
* Size -> Credit
log2 Size
n
  qcost Size
n (Update Int
_ a
_) = Credit
1 Credit -> Credit -> Credit
forall a. Num a => a -> a -> a
+ Credit
3 Credit -> Credit -> Credit
forall a. Num a => a -> a -> a
* Size -> Credit
log2 Size
n

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 MemoryCell m a => MemoryCell m (Tree a) where
  prettyCell :: Tree a -> m Memory
prettyCell (Leaf 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
"Leaf" [Memory
x']
  prettyCell (Node Int
w Tree a
t1 Tree a
t2) = do
    Memory
t1' <- Tree a -> m Memory
forall (m :: * -> *) a. MemoryCell m a => a -> m Memory
prettyCell Tree a
t1
    Memory
t2' <- Tree a -> m Memory
forall (m :: * -> *) a. MemoryCell m a => a -> m Memory
prettyCell Tree a
t2
    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
"Node" [Memory
t1', Memory
t2']

instance MemoryCell m a => MemoryCell m (Digit a) where
  prettyCell :: Digit a -> m Memory
prettyCell Digit a
Zero = 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
"Zero" []
  prettyCell (One Tree a
t) = do
    Memory
t' <- Tree a -> m Memory
forall (m :: * -> *) a. MemoryCell m a => a -> m Memory
prettyCell Tree a
t
    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
"One" [Memory
t']
  prettyCell (Two Tree a
t1 Tree a
t2) = do
    Memory
t1' <- Tree a -> m Memory
forall (m :: * -> *) a. MemoryCell m a => a -> m Memory
prettyCell Tree a
t1
    Memory
t2' <- Tree a -> m Memory
forall (m :: * -> *) a. MemoryCell m a => a -> m Memory
prettyCell Tree a
t2
    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
"Two" [Memory
t1', Memory
t2']

instance (MonadMemory m, MemoryCell m a) => MemoryCell m (BinaryRA a m) where
  prettyCell :: BinaryRA a m -> m Memory
prettyCell (BinaryRA Stream m (Digit a)
ts) = do
    Memory
ts' <- Stream m (Digit a) -> m Memory
forall (m :: * -> *) a. MemoryCell m a => a -> m Memory
prettyCell Stream m (Digit a)
ts
    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
"BinaryRA" [Memory
ts']

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