{-# LANGUAGE GADTs, OverloadedLists, LambdaCase #-}

module Test.Credit.Finger where

import Prelude hiding (head, tail, last, init)
import Data.List.NonEmpty (NonEmpty(..), (<|))
import qualified Data.List.NonEmpty as NE
import Control.Monad (when, unless)
import Data.Foldable (foldlM, foldrM)
import Prettyprinter (Pretty)

import Control.Monad.Credit
import Test.Credit (linear, log2)
import qualified Test.Credit.Deque.Base as D
import qualified Test.Credit.Heap.Base as H
import qualified Test.Credit.RandomAccess.Base as RA
import qualified Test.Credit.Sortable.Base as S

data Digit a = One a | Two a a | Three a a 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)

data Tuple v a = Pair v a a | Triple v a a a
  deriving (Tuple v a -> Tuple v a -> Bool
(Tuple v a -> Tuple v a -> Bool)
-> (Tuple v a -> Tuple v a -> Bool) -> Eq (Tuple v a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall v a. (Eq v, Eq a) => Tuple v a -> Tuple v a -> Bool
$c== :: forall v a. (Eq v, Eq a) => Tuple v a -> Tuple v a -> Bool
== :: Tuple v a -> Tuple v a -> Bool
$c/= :: forall v a. (Eq v, Eq a) => Tuple v a -> Tuple v a -> Bool
/= :: Tuple v a -> Tuple v a -> Bool
Eq, Eq (Tuple v a)
Eq (Tuple v a) =>
(Tuple v a -> Tuple v a -> Ordering)
-> (Tuple v a -> Tuple v a -> Bool)
-> (Tuple v a -> Tuple v a -> Bool)
-> (Tuple v a -> Tuple v a -> Bool)
-> (Tuple v a -> Tuple v a -> Bool)
-> (Tuple v a -> Tuple v a -> Tuple v a)
-> (Tuple v a -> Tuple v a -> Tuple v a)
-> Ord (Tuple v a)
Tuple v a -> Tuple v a -> Bool
Tuple v a -> Tuple v a -> Ordering
Tuple v a -> Tuple v a -> Tuple v 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 v a. (Ord v, Ord a) => Eq (Tuple v a)
forall v a. (Ord v, Ord a) => Tuple v a -> Tuple v a -> Bool
forall v a. (Ord v, Ord a) => Tuple v a -> Tuple v a -> Ordering
forall v a. (Ord v, Ord a) => Tuple v a -> Tuple v a -> Tuple v a
$ccompare :: forall v a. (Ord v, Ord a) => Tuple v a -> Tuple v a -> Ordering
compare :: Tuple v a -> Tuple v a -> Ordering
$c< :: forall v a. (Ord v, Ord a) => Tuple v a -> Tuple v a -> Bool
< :: Tuple v a -> Tuple v a -> Bool
$c<= :: forall v a. (Ord v, Ord a) => Tuple v a -> Tuple v a -> Bool
<= :: Tuple v a -> Tuple v a -> Bool
$c> :: forall v a. (Ord v, Ord a) => Tuple v a -> Tuple v a -> Bool
> :: Tuple v a -> Tuple v a -> Bool
$c>= :: forall v a. (Ord v, Ord a) => Tuple v a -> Tuple v a -> Bool
>= :: Tuple v a -> Tuple v a -> Bool
$cmax :: forall v a. (Ord v, Ord a) => Tuple v a -> Tuple v a -> Tuple v a
max :: Tuple v a -> Tuple v a -> Tuple v a
$cmin :: forall v a. (Ord v, Ord a) => Tuple v a -> Tuple v a -> Tuple v a
min :: Tuple v a -> Tuple v a -> Tuple v a
Ord, Int -> Tuple v a -> ShowS
[Tuple v a] -> ShowS
Tuple v a -> String
(Int -> Tuple v a -> ShowS)
-> (Tuple v a -> String)
-> ([Tuple v a] -> ShowS)
-> Show (Tuple v a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall v a. (Show v, Show a) => Int -> Tuple v a -> ShowS
forall v a. (Show v, Show a) => [Tuple v a] -> ShowS
forall v a. (Show v, Show a) => Tuple v a -> String
$cshowsPrec :: forall v a. (Show v, Show a) => Int -> Tuple v a -> ShowS
showsPrec :: Int -> Tuple v a -> ShowS
$cshow :: forall v a. (Show v, Show a) => Tuple v a -> String
show :: Tuple v a -> String
$cshowList :: forall v a. (Show v, Show a) => [Tuple v a] -> ShowS
showList :: [Tuple v a] -> ShowS
Show)

data FingerTree v a m
  = Empty
  | Single a
  | Deep (Thunk m (Lazy m) v) (Digit a) (Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)) (Digit a)

data FLazyCon m a where
  FPure :: a -> FLazyCon m a
  FCons :: Measured a v => a -> Thunk m (FLazyCon m) (FingerTree v a m) -> FLazyCon m (FingerTree v a m)
  FSnoc :: Measured a v => Thunk m (FLazyCon m) (FingerTree v a m) -> a -> FLazyCon m (FingerTree v a m)
  FTail :: Measured a v => FingerTree v a m -> FLazyCon m (FingerTree v a m)
  FInit :: Measured a v => FingerTree v a m -> FLazyCon m (FingerTree v a m)

instance MonadCredit m => HasStep (FLazyCon m) m where
  step :: forall a. FLazyCon m a -> m a
step (FPure a
xs) = a -> m a
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
xs
  step (FCons a
x Thunk m (FLazyCon m) (FingerTree v a m)
m) = a -> FingerTree v a m -> m (FingerTree v a m)
forall (m :: * -> *) a v.
(MonadCredit m, Measured a v) =>
a -> FingerTree v a m -> m (FingerTree v a m)
cons a
x (FingerTree v a m -> m a) -> m (FingerTree v a m) -> m a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Thunk m (FLazyCon m) (FingerTree v a m) -> m (FingerTree v 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 (FLazyCon m) (FingerTree v a m)
m
  step (FSnoc Thunk m (FLazyCon m) (FingerTree v a m)
m a
x) = (FingerTree v a m -> a -> m a) -> a -> FingerTree v a m -> m a
forall a b c. (a -> b -> c) -> b -> a -> c
flip FingerTree v a m -> a -> m a
FingerTree v a m -> a -> m (FingerTree v a m)
forall (m :: * -> *) a v.
(MonadCredit m, Measured a v) =>
FingerTree v a m -> a -> m (FingerTree v a m)
snoc a
x (FingerTree v a m -> m a) -> m (FingerTree v a m) -> m a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Thunk m (FLazyCon m) (FingerTree v a m) -> m (FingerTree v 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 (FLazyCon m) (FingerTree v a m)
m
  step (FTail FingerTree v a m
q) = FingerTree v a m -> m (FingerTree v a m)
forall (m :: * -> *) a v.
(MonadCredit m, Measured a v) =>
FingerTree v a m -> m (FingerTree v a m)
tail FingerTree v a m
q
  step (FInit FingerTree v a m
q) = FingerTree v a m -> m (FingerTree v a m)
forall (m :: * -> *) a v.
(MonadCredit m, Measured a v) =>
FingerTree v a m -> m (FingerTree v a m)
init FingerTree v a m
q

-- Main idea:
--  - cons, snoc, tail and init all cost two credits
--  - the first credit is used to tick
--  - We maintain the invariant: In each queue Deep(f, m, r), m has ||f| - 2| + ||r| - 2| credits.
--  - The m thunk requires two credits to force.
--  - snoc and tail spend their second credit on either the old m to be able to force it,
--    or on the new m to maintain the invariant.

class Monoid v => Measured a v where
  measure :: a -> v

instance Measured a v => Measured [a] v where
  measure :: [a] -> v
measure = [v] -> v
forall a. Monoid a => [a] -> a
mconcat ([v] -> v) -> ([a] -> [v]) -> [a] -> v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> v) -> [a] -> [v]
forall a b. (a -> b) -> [a] -> [b]
map a -> v
forall a v. Measured a v => a -> v
measure

instance Measured a v => Measured (Digit a) v where
  measure :: Digit a -> v
measure = [a] -> v
forall a v. Measured a v => a -> v
measure ([a] -> v) -> (Digit a -> [a]) -> Digit a -> v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Digit a -> [a]
forall a. Digit a -> [a]
toList

instance Monoid v => Measured (Tuple v a) v where
  measure :: Tuple v a -> v
measure (Pair v
v a
_ a
_) = v
v
  measure (Triple v
v a
_ a
_ a
_) = v
v

measurement :: (MonadCredit m, Measured a v) => FingerTree v a m -> m v
measurement :: forall (m :: * -> *) a v.
(MonadCredit m, Measured a v) =>
FingerTree v a m -> m v
measurement FingerTree v a m
Empty = v -> m v
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (v -> m v) -> v -> m v
forall a b. (a -> b) -> a -> b
$ v
forall a. Monoid a => a
mempty
measurement (Single a
x) = v -> m v
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (v -> m v) -> v -> m v
forall a b. (a -> b) -> a -> b
$ a -> v
forall a v. Measured a v => a -> v
measure a
x
measurement (Deep Thunk m (Lazy m) v
vm Digit a
f Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
m Digit a
r) = do
  v
vm' <- Thunk m (Lazy m) v -> m v
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) v
vm
  v -> m v
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (v -> m v) -> v -> m v
forall a b. (a -> b) -> a -> b
$ Digit a -> v
forall a v. Measured a v => a -> v
measure Digit a
f v -> v -> v
forall a. Semigroup a => a -> a -> a
<> v
vm' v -> v -> v
forall a. Semigroup a => a -> a -> a
<> Digit a -> v
forall a v. Measured a v => a -> v
measure Digit a
r

forceAll :: (MonadCredit m, Measured a v) => FingerTree v a m -> m ()
forceAll :: forall (m :: * -> *) a v.
(MonadCredit m, Measured a v) =>
FingerTree v a m -> m ()
forceAll FingerTree v a m
Empty = () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
forceAll (Single a
_) = () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
forceAll (Deep Thunk m (Lazy m) v
_ Digit a
_ Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
m Digit a
_) = do
  Thunk m (FLazyCon m) (FingerTree v (Tuple v 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 (FLazyCon m) (FingerTree v (Tuple v a) m)
m Credit
2
  FingerTree v (Tuple v a) m -> m ()
forall (m :: * -> *) a v.
(MonadCredit m, Measured a v) =>
FingerTree v a m -> m ()
forceAll (FingerTree v (Tuple v a) m -> m ())
-> m (FingerTree v (Tuple v a) m) -> m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
-> m (FingerTree v (Tuple v 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 (FLazyCon m) (FingerTree v (Tuple v a) m)
m

isTwo :: Digit a -> Bool
isTwo :: forall a. Digit a -> Bool
isTwo (Two a
_ a
_) = Bool
True
isTwo Digit a
_ = Bool
False

empty :: MonadCredit m => m (Thunk m (FLazyCon m) (FingerTree v a m))
empty :: forall (m :: * -> *) v a.
MonadCredit m =>
m (Thunk m (FLazyCon m) (FingerTree v a m))
empty = FLazyCon m (FingerTree v a m)
-> m (Thunk m (FLazyCon m) (FingerTree v 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 (FLazyCon m (FingerTree v a m)
 -> m (Thunk m (FLazyCon m) (FingerTree v a m)))
-> FLazyCon m (FingerTree v a m)
-> m (Thunk m (FLazyCon m) (FingerTree v a m))
forall a b. (a -> b) -> a -> b
$ FingerTree v a m -> FLazyCon m (FingerTree v a m)
forall a (m :: * -> *). a -> FLazyCon m a
FPure FingerTree v a m
forall v a (m :: * -> *). FingerTree v a m
Empty

pair :: Measured a v => a -> a -> Tuple v a
pair :: forall a v. Measured a v => a -> a -> Tuple v a
pair a
x a
y = v -> a -> a -> Tuple v a
forall v a. v -> a -> a -> Tuple v a
Pair (a -> v
forall a v. Measured a v => a -> v
measure a
x v -> v -> v
forall a. Semigroup a => a -> a -> a
<> a -> v
forall a v. Measured a v => a -> v
measure a
y) a
x a
y

triple :: Measured a v => a -> a -> a -> Tuple v a
triple :: forall a v. Measured a v => a -> a -> a -> Tuple v a
triple a
x a
y a
z = v -> a -> a -> a -> Tuple v a
forall v a. v -> a -> a -> a -> Tuple v a
Triple (a -> v
forall a v. Measured a v => a -> v
measure a
x v -> v -> v
forall a. Semigroup a => a -> a -> a
<> a -> v
forall a v. Measured a v => a -> v
measure a
y v -> v -> v
forall a. Semigroup a => a -> a -> a
<> a -> v
forall a v. Measured a v => a -> v
measure a
z) a
x a
y a
z

deep :: (MonadCredit m, Measured a v) => Thunk m (Lazy m) v -> Digit a -> Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m) -> Digit a -> m (FingerTree v a m)
deep :: forall (m :: * -> *) a v.
(MonadCredit m, Measured a v) =>
Thunk m (Lazy m) v
-> Digit a
-> Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
-> Digit a
-> m (FingerTree v a m)
deep Thunk m (Lazy m) v
v Digit a
f Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
m Digit a
r = do
  let oneIfDangerous :: Digit a -> a
oneIfDangerous Digit a
d = if Digit a -> Bool
forall a. Digit a -> Bool
isTwo Digit a
d then a
0 else a
1
  Bool
mIsPure <- Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
-> (FingerTree v (Tuple v a) m -> m Bool)
-> (FLazyCon m (FingerTree v (Tuple v a) m) -> m Bool)
-> m Bool
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 (FLazyCon m) (FingerTree v (Tuple v a) m)
m (\FingerTree v (Tuple v a) m
_ -> Bool -> m Bool
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True) ((FLazyCon m (FingerTree v (Tuple v a) m) -> m Bool) -> m Bool)
-> (FLazyCon m (FingerTree v (Tuple v a) m) -> m Bool) -> m Bool
forall a b. (a -> b) -> a -> b
$ \case
    FPure FingerTree v (Tuple v a) m
_ -> Bool -> m Bool
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
    FLazyCon m (FingerTree v (Tuple v a) m)
_ -> Bool -> m Bool
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
mIsPure (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
    Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
m Thunk m (FLazyCon m) (FingerTree v (Tuple v 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 ()
`hasAtLeast` (Digit a -> Credit
forall {a} {a}. Num a => Digit a -> a
oneIfDangerous Digit a
f Credit -> Credit -> Credit
forall a. Num a => a -> a -> a
+ Digit a -> Credit
forall {a} {a}. Num a => Digit a -> a
oneIfDangerous Digit a
r)
  FingerTree v a m -> m (FingerTree v a m)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FingerTree v a m -> m (FingerTree v a m))
-> FingerTree v a m -> m (FingerTree v a m)
forall a b. (a -> b) -> a -> b
$ Thunk m (Lazy m) v
-> Digit a
-> Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
-> Digit a
-> FingerTree v a m
forall v a (m :: * -> *).
Thunk m (Lazy m) v
-> Digit a
-> Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
-> Digit a
-> FingerTree v a m
Deep Thunk m (Lazy m) v
v Digit a
f Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
m Digit a
r

deep' :: (MonadCredit m, Measured a v) => Digit a -> m (Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)) -> Digit a -> m (FingerTree v a m)
deep' :: forall (m :: * -> *) a v.
(MonadCredit m, Measured a v) =>
Digit a
-> m (Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m))
-> Digit a
-> m (FingerTree v a m)
deep' Digit a
f m (Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m))
mkM Digit a
r = do
  Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
m <- m (Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m))
mkM
  Thunk m (Lazy m) v
vm <- Lazy m v -> m (Thunk m (Lazy m) v)
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 v -> m (Thunk m (Lazy m) v))
-> Lazy m v -> m (Thunk m (Lazy m) v)
forall a b. (a -> b) -> a -> b
$ m v -> Lazy m v
forall {k} (m :: k -> *) (a :: k). m a -> Lazy m a
Lazy (m v -> Lazy m v) -> m v -> Lazy m v
forall a b. (a -> b) -> a -> b
$ FingerTree v (Tuple v a) m -> m v
forall (m :: * -> *) a v.
(MonadCredit m, Measured a v) =>
FingerTree v a m -> m v
measurement (FingerTree v (Tuple v a) m -> m v)
-> m (FingerTree v (Tuple v a) m) -> m v
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
-> m (FingerTree v (Tuple v 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 (FLazyCon m) (FingerTree v (Tuple v a) m)
m
  Thunk m (Lazy m) v
-> Digit a
-> Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
-> Digit a
-> m (FingerTree v a m)
forall (m :: * -> *) a v.
(MonadCredit m, Measured a v) =>
Thunk m (Lazy m) v
-> Digit a
-> Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
-> Digit a
-> m (FingerTree v a m)
deep Thunk m (Lazy m) v
vm Digit a
f Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
m Digit a
r

isEmpty :: FingerTree v a m -> Bool
isEmpty :: forall v a (m :: * -> *). FingerTree v a m -> Bool
isEmpty FingerTree v a m
Empty = Bool
True
isEmpty FingerTree v a m
_ = Bool
False

toList :: Digit a -> [a]
toList :: forall a. Digit a -> [a]
toList (One a
x) = [a
Item [a]
x]
toList (Two a
x a
y) = [a
Item [a]
x, a
Item [a]
y]
toList (Three a
x a
y a
z) = [a
Item [a]
x, a
Item [a]
y, a
Item [a]
z]

toTree :: (MonadCredit m, Measured a v) => [a] -> m (FingerTree v a m)
toTree :: forall (m :: * -> *) a v.
(MonadCredit m, Measured a v) =>
[a] -> m (FingerTree v a m)
toTree [] = FingerTree v a m -> m (FingerTree v a m)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FingerTree v a m
forall v a (m :: * -> *). FingerTree v a m
Empty
toTree [Item [a]
x] = FingerTree v a m -> m (FingerTree v a m)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FingerTree v a m -> m (FingerTree v a m))
-> FingerTree v a m -> m (FingerTree v a m)
forall a b. (a -> b) -> a -> b
$ a -> FingerTree v a m
forall v a (m :: * -> *). a -> FingerTree v a m
Single a
Item [a]
x
toTree [Item [a]
x,Item [a]
y] = Digit a
-> m (Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m))
-> Digit a
-> m (FingerTree v a m)
forall (m :: * -> *) a v.
(MonadCredit m, Measured a v) =>
Digit a
-> m (Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m))
-> Digit a
-> m (FingerTree v a m)
deep' (a -> Digit a
forall a. a -> Digit a
One a
Item [a]
x) m (Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m))
forall (m :: * -> *) v a.
MonadCredit m =>
m (Thunk m (FLazyCon m) (FingerTree v a m))
empty (a -> Digit a
forall a. a -> Digit a
One a
Item [a]
y)
toTree [Item [a]
x,Item [a]
y,Item [a]
z] = Digit a
-> m (Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m))
-> Digit a
-> m (FingerTree v a m)
forall (m :: * -> *) a v.
(MonadCredit m, Measured a v) =>
Digit a
-> m (Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m))
-> Digit a
-> m (FingerTree v a m)
deep' (a -> a -> Digit a
forall a. a -> a -> Digit a
Two a
Item [a]
x a
Item [a]
y) m (Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m))
forall (m :: * -> *) v a.
MonadCredit m =>
m (Thunk m (FLazyCon m) (FingerTree v a m))
empty (a -> Digit a
forall a. a -> Digit a
One a
Item [a]
z)

toDigit :: Tuple v a -> Digit a
toDigit :: forall v a. Tuple v a -> Digit a
toDigit (Pair v
_ a
x a
y) = a -> a -> Digit a
forall a. a -> a -> Digit a
Two a
x a
y
toDigit (Triple v
_ a
x a
y a
z) = a -> a -> a -> Digit a
forall a. a -> a -> a -> Digit a
Three a
x a
y a
z

cons :: (MonadCredit m, Measured a v) => a -> FingerTree v a m -> m (FingerTree v a m)
cons :: forall (m :: * -> *) a v.
(MonadCredit m, Measured a v) =>
a -> FingerTree v a m -> m (FingerTree v a m)
cons a
x FingerTree v a m
q = m ()
forall (m :: * -> *). MonadCount m => m ()
tick m () -> m (FingerTree v a m) -> m (FingerTree v a m)
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a -> FingerTree v a m -> m (FingerTree v a m)
forall (m :: * -> *) a v.
(MonadCredit m, Measured a v) =>
a -> FingerTree v a m -> m (FingerTree v a m)
cons' a
x FingerTree v a m
q

cons' :: (MonadCredit m, Measured a v) => a -> FingerTree v a m -> m (FingerTree v a m)
cons' :: forall (m :: * -> *) a v.
(MonadCredit m, Measured a v) =>
a -> FingerTree v a m -> m (FingerTree v a m)
cons' a
x FingerTree v a m
Empty = FingerTree v a m -> m (FingerTree v a m)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FingerTree v a m -> m (FingerTree v a m))
-> FingerTree v a m -> m (FingerTree v a m)
forall a b. (a -> b) -> a -> b
$ a -> FingerTree v a m
forall v a (m :: * -> *). a -> FingerTree v a m
Single a
x
cons' a
x (Single a
y) = do
  Digit a
-> m (Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m))
-> Digit a
-> m (FingerTree v a m)
forall (m :: * -> *) a v.
(MonadCredit m, Measured a v) =>
Digit a
-> m (Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m))
-> Digit a
-> m (FingerTree v a m)
deep' (a -> Digit a
forall a. a -> Digit a
One a
x) m (Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m))
forall (m :: * -> *) v a.
MonadCredit m =>
m (Thunk m (FLazyCon m) (FingerTree v a m))
empty (a -> Digit a
forall a. a -> Digit a
One a
y)
cons' a
x (Deep Thunk m (Lazy m) v
vq Digit a
pr Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
q Digit a
u) = case Digit a
pr of
  One a
y       -> Thunk m (Lazy m) v
-> Digit a
-> Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
-> Digit a
-> m (FingerTree v a m)
forall (m :: * -> *) a v.
(MonadCredit m, Measured a v) =>
Thunk m (Lazy m) v
-> Digit a
-> Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
-> Digit a
-> m (FingerTree v a m)
deep Thunk m (Lazy m) v
vq (a -> a -> Digit a
forall a. a -> a -> Digit a
Two a
x a
y) Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
q Digit a
u
  Two a
y a
z     -> Thunk m (FLazyCon m) (FingerTree v (Tuple v 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 (FLazyCon m) (FingerTree v (Tuple v a) m)
q Credit
1 m () -> m (FingerTree v a m) -> m (FingerTree v a m)
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FingerTree v a m -> m (FingerTree v a m)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Thunk m (Lazy m) v
-> Digit a
-> Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
-> Digit a
-> FingerTree v a m
forall v a (m :: * -> *).
Thunk m (Lazy m) v
-> Digit a
-> Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
-> Digit a
-> FingerTree v a m
Deep Thunk m (Lazy m) v
vq (a -> a -> a -> Digit a
forall a. a -> a -> a -> Digit a
Three a
x a
y a
z) Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
q Digit a
u)
  Three a
y a
z a
w -> do
    Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
q' <- FLazyCon m (FingerTree v (Tuple v a) m)
-> m (Thunk m (FLazyCon m) (FingerTree v (Tuple v 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 (FLazyCon m (FingerTree v (Tuple v a) m)
 -> m (Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)))
-> FLazyCon m (FingerTree v (Tuple v a) m)
-> m (Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m))
forall a b. (a -> b) -> a -> b
$ Tuple v a
-> Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
-> FLazyCon m (FingerTree v (Tuple v a) m)
forall a v (m :: * -> *).
Measured a v =>
a
-> Thunk m (FLazyCon m) (FingerTree v a m)
-> FLazyCon m (FingerTree v a m)
FCons (a -> a -> Tuple v a
forall a v. Measured a v => a -> a -> Tuple v a
pair a
z a
w) Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
q
    if Digit a -> Bool
forall a. Digit a -> Bool
isTwo Digit a
u
      then Thunk m (FLazyCon m) (FingerTree v (Tuple v 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 (FLazyCon m) (FingerTree v (Tuple v a) m)
q Credit
1
      else Thunk m (FLazyCon m) (FingerTree v (Tuple v 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 (FLazyCon m) (FingerTree v (Tuple v a) m)
q' Credit
1
    Thunk m (Lazy m) v
vq' <- Lazy m v -> m (Thunk m (Lazy m) v)
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 v -> m (Thunk m (Lazy m) v))
-> Lazy m v -> m (Thunk m (Lazy m) v)
forall a b. (a -> b) -> a -> b
$ m v -> Lazy m v
forall {k} (m :: k -> *) (a :: k). m a -> Lazy m a
Lazy (m v -> Lazy m v) -> m v -> Lazy m v
forall a b. (a -> b) -> a -> b
$ FingerTree v (Tuple v a) m -> m v
forall (m :: * -> *) a v.
(MonadCredit m, Measured a v) =>
FingerTree v a m -> m v
measurement (FingerTree v (Tuple v a) m -> m v)
-> m (FingerTree v (Tuple v a) m) -> m v
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
-> m (FingerTree v (Tuple v 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 (FLazyCon m) (FingerTree v (Tuple v a) m)
q'
    Thunk m (Lazy m) v
-> Digit a
-> Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
-> Digit a
-> m (FingerTree v a m)
forall (m :: * -> *) a v.
(MonadCredit m, Measured a v) =>
Thunk m (Lazy m) v
-> Digit a
-> Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
-> Digit a
-> m (FingerTree v a m)
deep Thunk m (Lazy m) v
vq' (a -> a -> Digit a
forall a. a -> a -> Digit a
Two a
x a
y) Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
q' Digit a
u

head :: MonadCredit m => FingerTree v a m -> m a
head :: forall (m :: * -> *) v a. MonadCredit m => FingerTree v a m -> m a
head FingerTree v a m
Empty = String -> m a
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"head: empty queue"
head (Single a
x) = a -> m a
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x
head (Deep Thunk m (Lazy m) v
_ Digit a
s Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
_ Digit a
_) = a -> m a
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> m a) -> a -> m a
forall a b. (a -> b) -> a -> b
$ let (a
h:[a]
_) = Digit a -> [a]
forall a. Digit a -> [a]
toList Digit a
s in a
h

tail :: (MonadCredit m, Measured a v) => FingerTree v a m -> m (FingerTree v a m)
tail :: forall (m :: * -> *) a v.
(MonadCredit m, Measured a v) =>
FingerTree v a m -> m (FingerTree v a m)
tail FingerTree v a m
Empty = m ()
forall (m :: * -> *). MonadCount m => m ()
tick m () -> m (FingerTree v a m) -> m (FingerTree v a m)
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FingerTree v a m -> m (FingerTree v a m)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FingerTree v a m
forall v a (m :: * -> *). FingerTree v a m
Empty
tail (Single a
_) = m ()
forall (m :: * -> *). MonadCount m => m ()
tick m () -> m (FingerTree v a m) -> m (FingerTree v a m)
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FingerTree v a m -> m (FingerTree v a m)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FingerTree v a m
forall v a (m :: * -> *). FingerTree v a m
Empty
tail (Deep Thunk m (Lazy m) v
vq (Three a
_ a
x a
y) Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
q Digit a
u) = m ()
forall (m :: * -> *). MonadCount m => m ()
tick m () -> m (FingerTree v a m) -> m (FingerTree v a m)
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FingerTree v a m -> m (FingerTree v a m)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Thunk m (Lazy m) v
-> Digit a
-> Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
-> Digit a
-> FingerTree v a m
forall v a (m :: * -> *).
Thunk m (Lazy m) v
-> Digit a
-> Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
-> Digit a
-> FingerTree v a m
Deep Thunk m (Lazy m) v
vq (a -> a -> Digit a
forall a. a -> a -> Digit a
Two a
x a
y) Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
q Digit a
u)
tail (Deep Thunk m (Lazy m) v
vq (Two a
_ a
x) Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
q Digit a
u) = m ()
forall (m :: * -> *). MonadCount m => m ()
tick m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Thunk m (FLazyCon m) (FingerTree v (Tuple v 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 (FLazyCon m) (FingerTree v (Tuple v a) m)
q Credit
1 m () -> m (FingerTree v a m) -> m (FingerTree v a m)
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FingerTree v a m -> m (FingerTree v a m)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Thunk m (Lazy m) v
-> Digit a
-> Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
-> Digit a
-> FingerTree v a m
forall v a (m :: * -> *).
Thunk m (Lazy m) v
-> Digit a
-> Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
-> Digit a
-> FingerTree v a m
Deep Thunk m (Lazy m) v
vq (a -> Digit a
forall a. a -> Digit a
One a
x) Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
q Digit a
u)
tail (Deep Thunk m (Lazy m) v
_ (One a
_) Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
q Digit a
u) = m ()
forall (m :: * -> *). MonadCount m => m ()
tick m () -> m (FingerTree v a m) -> m (FingerTree v a m)
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> do
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Digit a -> Bool
forall a. Digit a -> Bool
isTwo Digit a
u) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Thunk m (FLazyCon m) (FingerTree v (Tuple v 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 (FLazyCon m) (FingerTree v (Tuple v a) m)
q Credit
1
  FingerTree v (Tuple v a) m
q' <- Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
-> m (FingerTree v (Tuple v 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 (FLazyCon m) (FingerTree v (Tuple v a) m)
q
  FingerTree v (Tuple v a) m -> Digit a -> m (FingerTree v a m)
forall (m :: * -> *) a v.
(MonadCredit m, Measured a v) =>
FingerTree v (Tuple v a) m -> Digit a -> m (FingerTree v a m)
deep0 FingerTree v (Tuple v a) m
q' Digit a
u

deep0 :: (MonadCredit m, Measured a v) => FingerTree v (Tuple v a) m -> Digit a -> m (FingerTree v a m)
deep0 :: forall (m :: * -> *) a v.
(MonadCredit m, Measured a v) =>
FingerTree v (Tuple v a) m -> Digit a -> m (FingerTree v a m)
deep0 FingerTree v (Tuple v a) m
Empty Digit a
s = [a] -> m (FingerTree v a m)
forall (m :: * -> *) a v.
(MonadCredit m, Measured a v) =>
[a] -> m (FingerTree v a m)
toTree ([a] -> m (FingerTree v a m)) -> [a] -> m (FingerTree v a m)
forall a b. (a -> b) -> a -> b
$ Digit a -> [a]
forall a. Digit a -> [a]
toList Digit a
s
deep0 FingerTree v (Tuple v a) m
q Digit a
u = do
  Tuple v a
h <- FingerTree v (Tuple v a) m -> m (Tuple v a)
forall (m :: * -> *) v a. MonadCredit m => FingerTree v a m -> m a
head FingerTree v (Tuple v a) m
q
  case Tuple v a
h of
    Pair v
_ a
x a
y -> do
      Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
t <- FLazyCon m (FingerTree v (Tuple v a) m)
-> m (Thunk m (FLazyCon m) (FingerTree v (Tuple v 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 (FLazyCon m (FingerTree v (Tuple v a) m)
 -> m (Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)))
-> FLazyCon m (FingerTree v (Tuple v a) m)
-> m (Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m))
forall a b. (a -> b) -> a -> b
$ FingerTree v (Tuple v a) m
-> FLazyCon m (FingerTree v (Tuple v a) m)
forall a v (m :: * -> *).
Measured a v =>
FingerTree v a m -> FLazyCon m (FingerTree v a m)
FTail FingerTree v (Tuple v a) m
q
      Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Digit a -> Bool
forall a. Digit a -> Bool
isTwo Digit a
u) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Thunk m (FLazyCon m) (FingerTree v (Tuple v 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 (FLazyCon m) (FingerTree v (Tuple v a) m)
t Credit
1
      Thunk m (Lazy m) v
vt <- Lazy m v -> m (Thunk m (Lazy m) v)
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 v -> m (Thunk m (Lazy m) v))
-> Lazy m v -> m (Thunk m (Lazy m) v)
forall a b. (a -> b) -> a -> b
$ m v -> Lazy m v
forall {k} (m :: k -> *) (a :: k). m a -> Lazy m a
Lazy (m v -> Lazy m v) -> m v -> Lazy m v
forall a b. (a -> b) -> a -> b
$ FingerTree v (Tuple v a) m -> m v
forall (m :: * -> *) a v.
(MonadCredit m, Measured a v) =>
FingerTree v a m -> m v
measurement (FingerTree v (Tuple v a) m -> m v)
-> m (FingerTree v (Tuple v a) m) -> m v
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
-> m (FingerTree v (Tuple v 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 (FLazyCon m) (FingerTree v (Tuple v a) m)
t
      Thunk m (Lazy m) v
-> Digit a
-> Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
-> Digit a
-> m (FingerTree v a m)
forall (m :: * -> *) a v.
(MonadCredit m, Measured a v) =>
Thunk m (Lazy m) v
-> Digit a
-> Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
-> Digit a
-> m (FingerTree v a m)
deep Thunk m (Lazy m) v
vt (a -> a -> Digit a
forall a. a -> a -> Digit a
Two a
x a
y) Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
t Digit a
u
    Triple v
_ a
x a
_ a
_ -> do
      FingerTree v (Tuple v a) m
q' <- (Tuple v a -> Tuple v a)
-> FingerTree v (Tuple v a) m -> m (FingerTree v (Tuple v a) m)
forall (m :: * -> *) a v.
(MonadCredit m, Measured a v) =>
(a -> a) -> FingerTree v a m -> m (FingerTree v a m)
map1 Tuple v a -> Tuple v a
forall {a} {v} {v}. Measured a v => Tuple v a -> Tuple v a
chop FingerTree v (Tuple v a) m
q
      Digit a
-> m (Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m))
-> Digit a
-> m (FingerTree v a m)
forall (m :: * -> *) a v.
(MonadCredit m, Measured a v) =>
Digit a
-> m (Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m))
-> Digit a
-> m (FingerTree v a m)
deep' (a -> Digit a
forall a. a -> Digit a
One a
x) (FLazyCon m (FingerTree v (Tuple v a) m)
-> m (Thunk m (FLazyCon m) (FingerTree v (Tuple v 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 (FLazyCon m (FingerTree v (Tuple v a) m)
 -> m (Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)))
-> FLazyCon m (FingerTree v (Tuple v a) m)
-> m (Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m))
forall a b. (a -> b) -> a -> b
$ FingerTree v (Tuple v a) m
-> FLazyCon m (FingerTree v (Tuple v a) m)
forall a (m :: * -> *). a -> FLazyCon m a
FPure FingerTree v (Tuple v a) m
q') Digit a
u
      where chop :: Tuple v a -> Tuple v a
chop (Triple v
_ a
_ a
y a
z) = a -> a -> Tuple v a
forall a v. Measured a v => a -> a -> Tuple v a
pair a
y a
z

map1 :: (MonadCredit m, Measured a v) => (a -> a) -> FingerTree v a m -> m (FingerTree v a m)
map1 :: forall (m :: * -> *) a v.
(MonadCredit m, Measured a v) =>
(a -> a) -> FingerTree v a m -> m (FingerTree v a m)
map1 a -> a
_ FingerTree v a m
Empty = FingerTree v a m -> m (FingerTree v a m)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FingerTree v a m
forall v a (m :: * -> *). FingerTree v a m
Empty
map1 a -> a
f (Single a
x) = FingerTree v a m -> m (FingerTree v a m)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FingerTree v a m -> m (FingerTree v a m))
-> FingerTree v a m -> m (FingerTree v a m)
forall a b. (a -> b) -> a -> b
$ a -> FingerTree v a m
forall v a (m :: * -> *). a -> FingerTree v a m
Single (a -> a
f a
x)
map1 a -> a
f (Deep Thunk m (Lazy m) v
vq (One a
x) Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
q Digit a
u) = Thunk m (Lazy m) v
-> Digit a
-> Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
-> Digit a
-> m (FingerTree v a m)
forall (m :: * -> *) a v.
(MonadCredit m, Measured a v) =>
Thunk m (Lazy m) v
-> Digit a
-> Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
-> Digit a
-> m (FingerTree v a m)
deep Thunk m (Lazy m) v
vq (a -> Digit a
forall a. a -> Digit a
One (a -> a
f a
x)) Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
q Digit a
u
map1 a -> a
f (Deep Thunk m (Lazy m) v
vq (Two a
x a
y) Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
q Digit a
u) = Thunk m (Lazy m) v
-> Digit a
-> Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
-> Digit a
-> m (FingerTree v a m)
forall (m :: * -> *) a v.
(MonadCredit m, Measured a v) =>
Thunk m (Lazy m) v
-> Digit a
-> Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
-> Digit a
-> m (FingerTree v a m)
deep Thunk m (Lazy m) v
vq (a -> a -> Digit a
forall a. a -> a -> Digit a
Two (a -> a
f a
x) a
y) Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
q Digit a
u
map1 a -> a
f (Deep Thunk m (Lazy m) v
vq (Three a
x a
y a
z) Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
q Digit a
u) = Thunk m (Lazy m) v
-> Digit a
-> Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
-> Digit a
-> m (FingerTree v a m)
forall (m :: * -> *) a v.
(MonadCredit m, Measured a v) =>
Thunk m (Lazy m) v
-> Digit a
-> Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
-> Digit a
-> m (FingerTree v a m)
deep Thunk m (Lazy m) v
vq (a -> a -> a -> Digit a
forall a. a -> a -> a -> Digit a
Three (a -> a
f a
x) a
y a
z) Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
q Digit a
u

uncons :: (MonadCredit m, Measured a v) => FingerTree v a m -> m (Maybe (a, FingerTree v a m))
uncons :: forall (m :: * -> *) a v.
(MonadCredit m, Measured a v) =>
FingerTree v a m -> m (Maybe (a, FingerTree v a m))
uncons FingerTree v a m
q =
  if FingerTree v a m -> Bool
forall v a (m :: * -> *). FingerTree v a m -> Bool
isEmpty FingerTree v a m
q
    then Maybe (a, FingerTree v a m) -> m (Maybe (a, FingerTree v a m))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (a, FingerTree v a m)
forall a. Maybe a
Nothing
    else do
      a
h <- FingerTree v a m -> m a
forall (m :: * -> *) v a. MonadCredit m => FingerTree v a m -> m a
head FingerTree v a m
q
      FingerTree v a m
t <- FingerTree v a m -> m (FingerTree v a m)
forall (m :: * -> *) a v.
(MonadCredit m, Measured a v) =>
FingerTree v a m -> m (FingerTree v a m)
tail FingerTree v a m
q
      Maybe (a, FingerTree v a m) -> m (Maybe (a, FingerTree v a m))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (a, FingerTree v a m) -> m (Maybe (a, FingerTree v a m)))
-> Maybe (a, FingerTree v a m) -> m (Maybe (a, FingerTree v a m))
forall a b. (a -> b) -> a -> b
$ (a, FingerTree v a m) -> Maybe (a, FingerTree v a m)
forall a. a -> Maybe a
Just (a
h, FingerTree v a m
t)

deepL :: (MonadCredit m, Measured a v) => [a] -> Thunk m (Lazy m) v -> Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m) -> Digit a -> m (FingerTree v a m)
deepL :: forall (m :: * -> *) a v.
(MonadCredit m, Measured a v) =>
[a]
-> Thunk m (Lazy m) v
-> Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
-> Digit a
-> m (FingerTree v a m)
deepL [] Thunk m (Lazy m) v
_ Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
m Digit a
sf = do
  Maybe (Tuple v a, FingerTree v (Tuple v a) m)
m' <- FingerTree v (Tuple v a) m
-> m (Maybe (Tuple v a, FingerTree v (Tuple v a) m))
forall (m :: * -> *) a v.
(MonadCredit m, Measured a v) =>
FingerTree v a m -> m (Maybe (a, FingerTree v a m))
uncons (FingerTree v (Tuple v a) m
 -> m (Maybe (Tuple v a, FingerTree v (Tuple v a) m)))
-> m (FingerTree v (Tuple v a) m)
-> m (Maybe (Tuple v a, FingerTree v (Tuple v a) m))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
-> m (FingerTree v (Tuple v 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 (FLazyCon m) (FingerTree v (Tuple v a) m)
m
  case Maybe (Tuple v a, FingerTree v (Tuple v a) m)
m' of
    Maybe (Tuple v a, FingerTree v (Tuple v a) m)
Nothing -> [a] -> m (FingerTree v a m)
forall (m :: * -> *) a v.
(MonadCredit m, Measured a v) =>
[a] -> m (FingerTree v a m)
toTree ([a] -> m (FingerTree v a m)) -> [a] -> m (FingerTree v a m)
forall a b. (a -> b) -> a -> b
$ Digit a -> [a]
forall a. Digit a -> [a]
toList Digit a
sf
    Just (Pair v
_ a
x a
y, FingerTree v (Tuple v a) m
m'') -> do
      Digit a
-> m (Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m))
-> Digit a
-> m (FingerTree v a m)
forall (m :: * -> *) a v.
(MonadCredit m, Measured a v) =>
Digit a
-> m (Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m))
-> Digit a
-> m (FingerTree v a m)
deep' (a -> a -> Digit a
forall a. a -> a -> Digit a
Two a
x a
y) (FLazyCon m (FingerTree v (Tuple v a) m)
-> m (Thunk m (FLazyCon m) (FingerTree v (Tuple v 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 (FLazyCon m (FingerTree v (Tuple v a) m)
 -> m (Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)))
-> FLazyCon m (FingerTree v (Tuple v a) m)
-> m (Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m))
forall a b. (a -> b) -> a -> b
$ FingerTree v (Tuple v a) m
-> FLazyCon m (FingerTree v (Tuple v a) m)
forall a (m :: * -> *). a -> FLazyCon m a
FPure FingerTree v (Tuple v a) m
m'') Digit a
sf
    Just (Triple v
_ a
x a
y a
z, FingerTree v (Tuple v a) m
m'') -> do
      Digit a
-> m (Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m))
-> Digit a
-> m (FingerTree v a m)
forall (m :: * -> *) a v.
(MonadCredit m, Measured a v) =>
Digit a
-> m (Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m))
-> Digit a
-> m (FingerTree v a m)
deep' (a -> a -> a -> Digit a
forall a. a -> a -> a -> Digit a
Three a
x a
y a
z) (FLazyCon m (FingerTree v (Tuple v a) m)
-> m (Thunk m (FLazyCon m) (FingerTree v (Tuple v 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 (FLazyCon m (FingerTree v (Tuple v a) m)
 -> m (Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)))
-> FLazyCon m (FingerTree v (Tuple v a) m)
-> m (Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m))
forall a b. (a -> b) -> a -> b
$ FingerTree v (Tuple v a) m
-> FLazyCon m (FingerTree v (Tuple v a) m)
forall a (m :: * -> *). a -> FLazyCon m a
FPure FingerTree v (Tuple v a) m
m'') Digit a
sf
deepL [Item [a]
x] Thunk m (Lazy m) v
vm Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
m Digit a
sf = Thunk m (Lazy m) v
-> Digit a
-> Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
-> Digit a
-> m (FingerTree v a m)
forall (m :: * -> *) a v.
(MonadCredit m, Measured a v) =>
Thunk m (Lazy m) v
-> Digit a
-> Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
-> Digit a
-> m (FingerTree v a m)
deep Thunk m (Lazy m) v
vm (a -> Digit a
forall a. a -> Digit a
One a
Item [a]
x) Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
m Digit a
sf
deepL [Item [a]
x,Item [a]
y] Thunk m (Lazy m) v
vm Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
m Digit a
sf = Thunk m (Lazy m) v
-> Digit a
-> Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
-> Digit a
-> m (FingerTree v a m)
forall (m :: * -> *) a v.
(MonadCredit m, Measured a v) =>
Thunk m (Lazy m) v
-> Digit a
-> Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
-> Digit a
-> m (FingerTree v a m)
deep Thunk m (Lazy m) v
vm (a -> a -> Digit a
forall a. a -> a -> Digit a
Two a
Item [a]
x a
Item [a]
y) Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
m Digit a
sf
deepL [Item [a]
x,Item [a]
y,Item [a]
z] Thunk m (Lazy m) v
vm Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
m Digit a
sf = Thunk m (Lazy m) v
-> Digit a
-> Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
-> Digit a
-> m (FingerTree v a m)
forall (m :: * -> *) a v.
(MonadCredit m, Measured a v) =>
Thunk m (Lazy m) v
-> Digit a
-> Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
-> Digit a
-> m (FingerTree v a m)
deep Thunk m (Lazy m) v
vm (a -> a -> a -> Digit a
forall a. a -> a -> a -> Digit a
Three a
Item [a]
x a
Item [a]
y a
Item [a]
z) Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
m Digit a
sf

last :: (MonadCredit m, Measured a v) => FingerTree v a m -> m a
last :: forall (m :: * -> *) a v.
(MonadCredit m, Measured a v) =>
FingerTree v a m -> m a
last FingerTree v a m
Empty = String -> m a
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"last: empty queue"
last (Single a
x) = a -> m a
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x
last (Deep Thunk m (Lazy m) v
_ Digit a
_ Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
_ Digit a
s) = a -> m a
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> m a) -> a -> m a
forall a b. (a -> b) -> a -> b
$ let (a
h:[a]
_) = [a] -> [a]
forall a. [a] -> [a]
reverse ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ Digit a -> [a]
forall a. Digit a -> [a]
toList Digit a
s in a
h

snoc :: (MonadCredit m, Measured a v) => FingerTree v a m -> a -> m (FingerTree v a m)
snoc :: forall (m :: * -> *) a v.
(MonadCredit m, Measured a v) =>
FingerTree v a m -> a -> m (FingerTree v a m)
snoc FingerTree v a m
q a
y = m ()
forall (m :: * -> *). MonadCount m => m ()
tick m () -> m (FingerTree v a m) -> m (FingerTree v a m)
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FingerTree v a m -> a -> m (FingerTree v a m)
forall (m :: * -> *) a v.
(MonadCredit m, Measured a v) =>
FingerTree v a m -> a -> m (FingerTree v a m)
snoc' FingerTree v a m
q a
y

snoc' :: (MonadCredit m, Measured a v) => FingerTree v a m -> a -> m (FingerTree v a m)
snoc' :: forall (m :: * -> *) a v.
(MonadCredit m, Measured a v) =>
FingerTree v a m -> a -> m (FingerTree v a m)
snoc' FingerTree v a m
Empty a
y = FingerTree v a m -> m (FingerTree v a m)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FingerTree v a m -> m (FingerTree v a m))
-> FingerTree v a m -> m (FingerTree v a m)
forall a b. (a -> b) -> a -> b
$ a -> FingerTree v a m
forall v a (m :: * -> *). a -> FingerTree v a m
Single a
y
snoc' (Single a
x) a
y = Digit a
-> m (Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m))
-> Digit a
-> m (FingerTree v a m)
forall (m :: * -> *) a v.
(MonadCredit m, Measured a v) =>
Digit a
-> m (Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m))
-> Digit a
-> m (FingerTree v a m)
deep' (a -> Digit a
forall a. a -> Digit a
One a
x) m (Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m))
forall (m :: * -> *) v a.
MonadCredit m =>
m (Thunk m (FLazyCon m) (FingerTree v a m))
empty (a -> Digit a
forall a. a -> Digit a
One a
y)
snoc' (Deep Thunk m (Lazy m) v
vq Digit a
u Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
q (One a
x)) a
y = Thunk m (Lazy m) v
-> Digit a
-> Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
-> Digit a
-> m (FingerTree v a m)
forall (m :: * -> *) a v.
(MonadCredit m, Measured a v) =>
Thunk m (Lazy m) v
-> Digit a
-> Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
-> Digit a
-> m (FingerTree v a m)
deep Thunk m (Lazy m) v
vq Digit a
u Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
q (a -> a -> Digit a
forall a. a -> a -> Digit a
Two a
x a
y)
snoc' (Deep Thunk m (Lazy m) v
vq Digit a
u Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
q (Two a
x a
y)) a
z = Thunk m (FLazyCon m) (FingerTree v (Tuple v 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 (FLazyCon m) (FingerTree v (Tuple v a) m)
q Credit
1 m () -> m (FingerTree v a m) -> m (FingerTree v a m)
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FingerTree v a m -> m (FingerTree v a m)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Thunk m (Lazy m) v
-> Digit a
-> Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
-> Digit a
-> FingerTree v a m
forall v a (m :: * -> *).
Thunk m (Lazy m) v
-> Digit a
-> Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
-> Digit a
-> FingerTree v a m
Deep Thunk m (Lazy m) v
vq Digit a
u Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
q (a -> a -> a -> Digit a
forall a. a -> a -> a -> Digit a
Three a
x a
y a
z))
snoc' (Deep Thunk m (Lazy m) v
_ Digit a
u Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
q (Three a
x a
y a
z)) a
w = do
  Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
q' <- FLazyCon m (FingerTree v (Tuple v a) m)
-> m (Thunk m (FLazyCon m) (FingerTree v (Tuple v 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 (FLazyCon m (FingerTree v (Tuple v a) m)
 -> m (Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)))
-> FLazyCon m (FingerTree v (Tuple v a) m)
-> m (Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m))
forall a b. (a -> b) -> a -> b
$ Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
-> Tuple v a -> FLazyCon m (FingerTree v (Tuple v a) m)
forall a v (m :: * -> *).
Measured a v =>
Thunk m (FLazyCon m) (FingerTree v a m)
-> a -> FLazyCon m (FingerTree v a m)
FSnoc Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
q (a -> a -> Tuple v a
forall a v. Measured a v => a -> a -> Tuple v a
pair a
x a
y)
  if Digit a -> Bool
forall a. Digit a -> Bool
isTwo Digit a
u
    then Thunk m (FLazyCon m) (FingerTree v (Tuple v 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 (FLazyCon m) (FingerTree v (Tuple v a) m)
q Credit
1
    else Thunk m (FLazyCon m) (FingerTree v (Tuple v 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 (FLazyCon m) (FingerTree v (Tuple v a) m)
q' Credit
1
  Thunk m (Lazy m) v
vq' <- Lazy m v -> m (Thunk m (Lazy m) v)
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 v -> m (Thunk m (Lazy m) v))
-> Lazy m v -> m (Thunk m (Lazy m) v)
forall a b. (a -> b) -> a -> b
$ m v -> Lazy m v
forall {k} (m :: k -> *) (a :: k). m a -> Lazy m a
Lazy (m v -> Lazy m v) -> m v -> Lazy m v
forall a b. (a -> b) -> a -> b
$ FingerTree v (Tuple v a) m -> m v
forall (m :: * -> *) a v.
(MonadCredit m, Measured a v) =>
FingerTree v a m -> m v
measurement (FingerTree v (Tuple v a) m -> m v)
-> m (FingerTree v (Tuple v a) m) -> m v
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
-> m (FingerTree v (Tuple v 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 (FLazyCon m) (FingerTree v (Tuple v a) m)
q'
  Thunk m (Lazy m) v
-> Digit a
-> Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
-> Digit a
-> m (FingerTree v a m)
forall (m :: * -> *) a v.
(MonadCredit m, Measured a v) =>
Thunk m (Lazy m) v
-> Digit a
-> Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
-> Digit a
-> m (FingerTree v a m)
deep Thunk m (Lazy m) v
vq' Digit a
u Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
q' (a -> a -> Digit a
forall a. a -> a -> Digit a
Two a
z a
w)

init :: (MonadCredit m, Measured a v) => FingerTree v a m -> m (FingerTree v a m)
init :: forall (m :: * -> *) a v.
(MonadCredit m, Measured a v) =>
FingerTree v a m -> m (FingerTree v a m)
init FingerTree v a m
Empty = m ()
forall (m :: * -> *). MonadCount m => m ()
tick m () -> m (FingerTree v a m) -> m (FingerTree v a m)
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FingerTree v a m -> m (FingerTree v a m)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FingerTree v a m
forall v a (m :: * -> *). FingerTree v a m
Empty
init (Single a
_) = m ()
forall (m :: * -> *). MonadCount m => m ()
tick m () -> m (FingerTree v a m) -> m (FingerTree v a m)
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FingerTree v a m -> m (FingerTree v a m)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FingerTree v a m
forall v a (m :: * -> *). FingerTree v a m
Empty
init (Deep Thunk m (Lazy m) v
vq Digit a
u Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
q (Three a
x a
y a
_)) = m ()
forall (m :: * -> *). MonadCount m => m ()
tick m () -> m (FingerTree v a m) -> m (FingerTree v a m)
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FingerTree v a m -> m (FingerTree v a m)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Thunk m (Lazy m) v
-> Digit a
-> Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
-> Digit a
-> FingerTree v a m
forall v a (m :: * -> *).
Thunk m (Lazy m) v
-> Digit a
-> Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
-> Digit a
-> FingerTree v a m
Deep Thunk m (Lazy m) v
vq Digit a
u Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
q (a -> a -> Digit a
forall a. a -> a -> Digit a
Two a
x a
y))
init (Deep Thunk m (Lazy m) v
vq Digit a
u Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
q (Two a
x a
_)) = m ()
forall (m :: * -> *). MonadCount m => m ()
tick m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Thunk m (FLazyCon m) (FingerTree v (Tuple v 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 (FLazyCon m) (FingerTree v (Tuple v a) m)
q Credit
1 m () -> m (FingerTree v a m) -> m (FingerTree v a m)
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FingerTree v a m -> m (FingerTree v a m)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Thunk m (Lazy m) v
-> Digit a
-> Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
-> Digit a
-> FingerTree v a m
forall v a (m :: * -> *).
Thunk m (Lazy m) v
-> Digit a
-> Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
-> Digit a
-> FingerTree v a m
Deep Thunk m (Lazy m) v
vq Digit a
u Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
q (a -> Digit a
forall a. a -> Digit a
One a
x))
init (Deep Thunk m (Lazy m) v
_ Digit a
u Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
q (One a
_)) = m ()
forall (m :: * -> *). MonadCount m => m ()
tick m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Digit a -> Bool
forall a. Digit a -> Bool
isTwo Digit a
u) (Thunk m (FLazyCon m) (FingerTree v (Tuple v 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 (FLazyCon m) (FingerTree v (Tuple v a) m)
q Credit
1) m ()
-> m (FingerTree v (Tuple v a) m) -> m (FingerTree v (Tuple v 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 (FLazyCon m) (FingerTree v (Tuple v a) m)
-> m (FingerTree v (Tuple v 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 (FLazyCon m) (FingerTree v (Tuple v a) m)
q m (FingerTree v (Tuple v a) m)
-> (FingerTree v (Tuple v a) m -> m (FingerTree v a m))
-> m (FingerTree v a m)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Digit a -> FingerTree v (Tuple v a) m -> m (FingerTree v a m)
forall (m :: * -> *) a v.
(MonadCredit m, Measured a v) =>
Digit a -> FingerTree v (Tuple v a) m -> m (FingerTree v a m)
deepN Digit a
u

deepN :: (MonadCredit m, Measured a v) => Digit a -> FingerTree v (Tuple v a) m -> m (FingerTree v a m)
deepN :: forall (m :: * -> *) a v.
(MonadCredit m, Measured a v) =>
Digit a -> FingerTree v (Tuple v a) m -> m (FingerTree v a m)
deepN Digit a
s FingerTree v (Tuple v a) m
Empty = [a] -> m (FingerTree v a m)
forall (m :: * -> *) a v.
(MonadCredit m, Measured a v) =>
[a] -> m (FingerTree v a m)
toTree ([a] -> m (FingerTree v a m)) -> [a] -> m (FingerTree v a m)
forall a b. (a -> b) -> a -> b
$ Digit a -> [a]
forall a. Digit a -> [a]
toList Digit a
s
deepN Digit a
u FingerTree v (Tuple v a) m
q = do
  Tuple v a
l <- FingerTree v (Tuple v a) m -> m (Tuple v a)
forall (m :: * -> *) a v.
(MonadCredit m, Measured a v) =>
FingerTree v a m -> m a
last FingerTree v (Tuple v a) m
q
  case Tuple v a
l of
    Pair v
_ a
x a
y -> do
      Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
t <- FLazyCon m (FingerTree v (Tuple v a) m)
-> m (Thunk m (FLazyCon m) (FingerTree v (Tuple v 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 (FLazyCon m (FingerTree v (Tuple v a) m)
 -> m (Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)))
-> FLazyCon m (FingerTree v (Tuple v a) m)
-> m (Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m))
forall a b. (a -> b) -> a -> b
$ FingerTree v (Tuple v a) m
-> FLazyCon m (FingerTree v (Tuple v a) m)
forall a v (m :: * -> *).
Measured a v =>
FingerTree v a m -> FLazyCon m (FingerTree v a m)
FInit FingerTree v (Tuple v a) m
q
      Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Digit a -> Bool
forall a. Digit a -> Bool
isTwo Digit a
u) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Thunk m (FLazyCon m) (FingerTree v (Tuple v 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 (FLazyCon m) (FingerTree v (Tuple v a) m)
t Credit
1
      Thunk m (Lazy m) v
vt <- Lazy m v -> m (Thunk m (Lazy m) v)
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 v -> m (Thunk m (Lazy m) v))
-> Lazy m v -> m (Thunk m (Lazy m) v)
forall a b. (a -> b) -> a -> b
$ m v -> Lazy m v
forall {k} (m :: k -> *) (a :: k). m a -> Lazy m a
Lazy (m v -> Lazy m v) -> m v -> Lazy m v
forall a b. (a -> b) -> a -> b
$ FingerTree v (Tuple v a) m -> m v
forall (m :: * -> *) a v.
(MonadCredit m, Measured a v) =>
FingerTree v a m -> m v
measurement (FingerTree v (Tuple v a) m -> m v)
-> m (FingerTree v (Tuple v a) m) -> m v
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
-> m (FingerTree v (Tuple v 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 (FLazyCon m) (FingerTree v (Tuple v a) m)
t
      Thunk m (Lazy m) v
-> Digit a
-> Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
-> Digit a
-> m (FingerTree v a m)
forall (m :: * -> *) a v.
(MonadCredit m, Measured a v) =>
Thunk m (Lazy m) v
-> Digit a
-> Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
-> Digit a
-> m (FingerTree v a m)
deep Thunk m (Lazy m) v
vt Digit a
u Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
t (a -> a -> Digit a
forall a. a -> a -> Digit a
Two a
x a
y)
    Triple v
_ a
_ a
_ a
z -> do
      FingerTree v (Tuple v a) m
q' <- (Tuple v a -> Tuple v a)
-> FingerTree v (Tuple v a) m -> m (FingerTree v (Tuple v a) m)
forall (m :: * -> *) a v.
(MonadCredit m, Measured a v) =>
(a -> a) -> FingerTree v a m -> m (FingerTree v a m)
mapN Tuple v a -> Tuple v a
forall {a} {v} {v}. Measured a v => Tuple v a -> Tuple v a
chop FingerTree v (Tuple v a) m
q
      Digit a
-> m (Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m))
-> Digit a
-> m (FingerTree v a m)
forall (m :: * -> *) a v.
(MonadCredit m, Measured a v) =>
Digit a
-> m (Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m))
-> Digit a
-> m (FingerTree v a m)
deep' Digit a
u (FLazyCon m (FingerTree v (Tuple v a) m)
-> m (Thunk m (FLazyCon m) (FingerTree v (Tuple v 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 (FLazyCon m (FingerTree v (Tuple v a) m)
 -> m (Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)))
-> FLazyCon m (FingerTree v (Tuple v a) m)
-> m (Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m))
forall a b. (a -> b) -> a -> b
$ FingerTree v (Tuple v a) m
-> FLazyCon m (FingerTree v (Tuple v a) m)
forall a (m :: * -> *). a -> FLazyCon m a
FPure FingerTree v (Tuple v a) m
q') (a -> Digit a
forall a. a -> Digit a
One a
z)
      where chop :: Tuple v a -> Tuple v a
chop (Triple v
_ a
x a
y a
_) = a -> a -> Tuple v a
forall a v. Measured a v => a -> a -> Tuple v a
pair a
x a
y

mapN :: (MonadCredit m, Measured a v) => (a -> a) -> FingerTree v a m -> m (FingerTree v a m)
mapN :: forall (m :: * -> *) a v.
(MonadCredit m, Measured a v) =>
(a -> a) -> FingerTree v a m -> m (FingerTree v a m)
mapN a -> a
_ FingerTree v a m
Empty = FingerTree v a m -> m (FingerTree v a m)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FingerTree v a m -> m (FingerTree v a m))
-> FingerTree v a m -> m (FingerTree v a m)
forall a b. (a -> b) -> a -> b
$ FingerTree v a m
forall v a (m :: * -> *). FingerTree v a m
Empty
mapN a -> a
f (Single a
x) = FingerTree v a m -> m (FingerTree v a m)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FingerTree v a m -> m (FingerTree v a m))
-> FingerTree v a m -> m (FingerTree v a m)
forall a b. (a -> b) -> a -> b
$ a -> FingerTree v a m
forall v a (m :: * -> *). a -> FingerTree v a m
Single (a -> a
f a
x)
mapN a -> a
f (Deep Thunk m (Lazy m) v
vq Digit a
u Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
q (One a
x)) = Thunk m (Lazy m) v
-> Digit a
-> Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
-> Digit a
-> m (FingerTree v a m)
forall (m :: * -> *) a v.
(MonadCredit m, Measured a v) =>
Thunk m (Lazy m) v
-> Digit a
-> Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
-> Digit a
-> m (FingerTree v a m)
deep Thunk m (Lazy m) v
vq Digit a
u Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
q (a -> Digit a
forall a. a -> Digit a
One (a -> a
f a
x))
mapN a -> a
f (Deep Thunk m (Lazy m) v
vq Digit a
u Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
q (Two a
x a
y)) = Thunk m (Lazy m) v
-> Digit a
-> Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
-> Digit a
-> m (FingerTree v a m)
forall (m :: * -> *) a v.
(MonadCredit m, Measured a v) =>
Thunk m (Lazy m) v
-> Digit a
-> Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
-> Digit a
-> m (FingerTree v a m)
deep Thunk m (Lazy m) v
vq Digit a
u Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
q (a -> a -> Digit a
forall a. a -> a -> Digit a
Two a
x (a -> a
f a
y))
mapN a -> a
f (Deep Thunk m (Lazy m) v
vq Digit a
u Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
q (Three a
x a
y a
z)) = Thunk m (Lazy m) v
-> Digit a
-> Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
-> Digit a
-> m (FingerTree v a m)
forall (m :: * -> *) a v.
(MonadCredit m, Measured a v) =>
Thunk m (Lazy m) v
-> Digit a
-> Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
-> Digit a
-> m (FingerTree v a m)
deep Thunk m (Lazy m) v
vq Digit a
u Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
q (a -> a -> a -> Digit a
forall a. a -> a -> a -> Digit a
Three a
x a
y (a -> a
f a
z))

unsnoc :: (MonadCredit m, Measured a v) => FingerTree v a m -> m (Maybe (FingerTree v a m, a))
unsnoc :: forall (m :: * -> *) a v.
(MonadCredit m, Measured a v) =>
FingerTree v a m -> m (Maybe (FingerTree v a m, a))
unsnoc FingerTree v a m
q =
  if FingerTree v a m -> Bool
forall v a (m :: * -> *). FingerTree v a m -> Bool
isEmpty FingerTree v a m
q
    then Maybe (FingerTree v a m, a) -> m (Maybe (FingerTree v a m, a))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (FingerTree v a m, a)
forall a. Maybe a
Nothing
    else do
      a
h <- FingerTree v a m -> m a
forall (m :: * -> *) a v.
(MonadCredit m, Measured a v) =>
FingerTree v a m -> m a
last FingerTree v a m
q
      FingerTree v a m
t <- FingerTree v a m -> m (FingerTree v a m)
forall (m :: * -> *) a v.
(MonadCredit m, Measured a v) =>
FingerTree v a m -> m (FingerTree v a m)
init FingerTree v a m
q
      Maybe (FingerTree v a m, a) -> m (Maybe (FingerTree v a m, a))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (FingerTree v a m, a) -> m (Maybe (FingerTree v a m, a)))
-> Maybe (FingerTree v a m, a) -> m (Maybe (FingerTree v a m, a))
forall a b. (a -> b) -> a -> b
$ (FingerTree v a m, a) -> Maybe (FingerTree v a m, a)
forall a. a -> Maybe a
Just (FingerTree v a m
t, a
h)

deepR :: (MonadCredit m, Measured a v) => Digit a -> Thunk m (Lazy m) v -> Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m) -> [a] -> m (FingerTree v a m)
deepR :: forall (m :: * -> *) a v.
(MonadCredit m, Measured a v) =>
Digit a
-> Thunk m (Lazy m) v
-> Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
-> [a]
-> m (FingerTree v a m)
deepR Digit a
s Thunk m (Lazy m) v
_ Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
m [] = do
  Maybe (FingerTree v (Tuple v a) m, Tuple v a)
m' <- FingerTree v (Tuple v a) m
-> m (Maybe (FingerTree v (Tuple v a) m, Tuple v a))
forall (m :: * -> *) a v.
(MonadCredit m, Measured a v) =>
FingerTree v a m -> m (Maybe (FingerTree v a m, a))
unsnoc (FingerTree v (Tuple v a) m
 -> m (Maybe (FingerTree v (Tuple v a) m, Tuple v a)))
-> m (FingerTree v (Tuple v a) m)
-> m (Maybe (FingerTree v (Tuple v a) m, Tuple v a))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
-> m (FingerTree v (Tuple v 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 (FLazyCon m) (FingerTree v (Tuple v a) m)
m
  case Maybe (FingerTree v (Tuple v a) m, Tuple v a)
m' of
    Maybe (FingerTree v (Tuple v a) m, Tuple v a)
Nothing -> [a] -> m (FingerTree v a m)
forall (m :: * -> *) a v.
(MonadCredit m, Measured a v) =>
[a] -> m (FingerTree v a m)
toTree ([a] -> m (FingerTree v a m)) -> [a] -> m (FingerTree v a m)
forall a b. (a -> b) -> a -> b
$ Digit a -> [a]
forall a. Digit a -> [a]
toList Digit a
s
    Just (FingerTree v (Tuple v a) m
m'', Pair v
_ a
x a
y) -> do
      Digit a
-> m (Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m))
-> Digit a
-> m (FingerTree v a m)
forall (m :: * -> *) a v.
(MonadCredit m, Measured a v) =>
Digit a
-> m (Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m))
-> Digit a
-> m (FingerTree v a m)
deep' Digit a
s (FLazyCon m (FingerTree v (Tuple v a) m)
-> m (Thunk m (FLazyCon m) (FingerTree v (Tuple v 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 (FLazyCon m (FingerTree v (Tuple v a) m)
 -> m (Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)))
-> FLazyCon m (FingerTree v (Tuple v a) m)
-> m (Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m))
forall a b. (a -> b) -> a -> b
$ FingerTree v (Tuple v a) m
-> FLazyCon m (FingerTree v (Tuple v a) m)
forall a (m :: * -> *). a -> FLazyCon m a
FPure FingerTree v (Tuple v a) m
m'') (a -> a -> Digit a
forall a. a -> a -> Digit a
Two a
x a
y)
    Just (FingerTree v (Tuple v a) m
m'', Triple v
_ a
x a
y a
z) -> do
      Digit a
-> m (Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m))
-> Digit a
-> m (FingerTree v a m)
forall (m :: * -> *) a v.
(MonadCredit m, Measured a v) =>
Digit a
-> m (Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m))
-> Digit a
-> m (FingerTree v a m)
deep' Digit a
s (FLazyCon m (FingerTree v (Tuple v a) m)
-> m (Thunk m (FLazyCon m) (FingerTree v (Tuple v 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 (FLazyCon m (FingerTree v (Tuple v a) m)
 -> m (Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)))
-> FLazyCon m (FingerTree v (Tuple v a) m)
-> m (Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m))
forall a b. (a -> b) -> a -> b
$ FingerTree v (Tuple v a) m
-> FLazyCon m (FingerTree v (Tuple v a) m)
forall a (m :: * -> *). a -> FLazyCon m a
FPure FingerTree v (Tuple v a) m
m'') (a -> a -> a -> Digit a
forall a. a -> a -> a -> Digit a
Three a
x a
y a
z)
deepR Digit a
s Thunk m (Lazy m) v
vm Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
m [Item [a]
x] = Thunk m (Lazy m) v
-> Digit a
-> Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
-> Digit a
-> m (FingerTree v a m)
forall (m :: * -> *) a v.
(MonadCredit m, Measured a v) =>
Thunk m (Lazy m) v
-> Digit a
-> Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
-> Digit a
-> m (FingerTree v a m)
deep Thunk m (Lazy m) v
vm Digit a
s Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
m (a -> Digit a
forall a. a -> Digit a
One a
Item [a]
x)
deepR Digit a
s Thunk m (Lazy m) v
vm Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
m [Item [a]
x, Item [a]
y] = Thunk m (Lazy m) v
-> Digit a
-> Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
-> Digit a
-> m (FingerTree v a m)
forall (m :: * -> *) a v.
(MonadCredit m, Measured a v) =>
Thunk m (Lazy m) v
-> Digit a
-> Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
-> Digit a
-> m (FingerTree v a m)
deep Thunk m (Lazy m) v
vm Digit a
s Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
m (a -> a -> Digit a
forall a. a -> a -> Digit a
Two a
Item [a]
x a
Item [a]
y)
deepR Digit a
s Thunk m (Lazy m) v
vm Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
m [Item [a]
x, Item [a]
y, Item [a]
z] = Thunk m (Lazy m) v
-> Digit a
-> Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
-> Digit a
-> m (FingerTree v a m)
forall (m :: * -> *) a v.
(MonadCredit m, Measured a v) =>
Thunk m (Lazy m) v
-> Digit a
-> Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
-> Digit a
-> m (FingerTree v a m)
deep Thunk m (Lazy m) v
vm Digit a
s Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
m (a -> a -> a -> Digit a
forall a. a -> a -> a -> Digit a
Three a
Item [a]
x a
Item [a]
y a
Item [a]
z)

toTuples :: Measured a v => [a] -> [Tuple v a]
toTuples :: forall a v. Measured a v => [a] -> [Tuple v a]
toTuples [] = []
toTuples [Item [a]
x, Item [a]
y] = [a -> a -> Tuple v a
forall a v. Measured a v => a -> a -> Tuple v a
pair a
Item [a]
x a
Item [a]
y]
toTuples [Item [a]
x, Item [a]
y, Item [a]
z, Item [a]
w] = [a -> a -> Tuple v a
forall a v. Measured a v => a -> a -> Tuple v a
pair a
Item [a]
x a
Item [a]
y, a -> a -> Tuple v a
forall a v. Measured a v => a -> a -> Tuple v a
pair a
Item [a]
z a
Item [a]
w]
toTuples (a
x : a
y : a
z : [a]
xs) = a -> a -> a -> Tuple v a
forall a v. Measured a v => a -> a -> a -> Tuple v a
triple a
x a
y a
z Tuple v a -> [Tuple v a] -> [Tuple v a]
forall a. a -> [a] -> [a]
: [a] -> [Tuple v a]
forall a v. Measured a v => [a] -> [Tuple v a]
toTuples [a]
xs

glue :: (MonadCredit m, Measured a v) => FingerTree v a m -> [a] -> FingerTree v a m -> m (FingerTree v a m)
glue :: forall (m :: * -> *) a v.
(MonadCredit m, Measured a v) =>
FingerTree v a m -> [a] -> FingerTree v a m -> m (FingerTree v a m)
glue FingerTree v a m
Empty [a]
as FingerTree v a m
q2 = (a -> FingerTree v a m -> m (FingerTree v a m))
-> FingerTree v a m -> [a] -> m (FingerTree v a m)
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> b -> m b) -> b -> t a -> m b
foldrM a -> FingerTree v a m -> m (FingerTree v a m)
forall (m :: * -> *) a v.
(MonadCredit m, Measured a v) =>
a -> FingerTree v a m -> m (FingerTree v a m)
cons FingerTree v a m
q2 [a]
as
glue FingerTree v a m
q1 [a]
as FingerTree v a m
Empty = (FingerTree v a m -> a -> m (FingerTree v a m))
-> FingerTree v a m -> [a] -> m (FingerTree v a m)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldlM FingerTree v a m -> a -> m (FingerTree v a m)
forall (m :: * -> *) a v.
(MonadCredit m, Measured a v) =>
FingerTree v a m -> a -> m (FingerTree v a m)
snoc FingerTree v a m
q1 [a]
as
glue (Single a
x) [a]
as FingerTree v a m
q2 = (a -> FingerTree v a m -> m (FingerTree v a m))
-> FingerTree v a m -> [a] -> m (FingerTree v a m)
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> b -> m b) -> b -> t a -> m b
foldrM a -> FingerTree v a m -> m (FingerTree v a m)
forall (m :: * -> *) a v.
(MonadCredit m, Measured a v) =>
a -> FingerTree v a m -> m (FingerTree v a m)
cons FingerTree v a m
q2 (a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
as)
glue FingerTree v a m
q1 [a]
as (Single a
y) = (FingerTree v a m -> a -> m (FingerTree v a m))
-> FingerTree v a m -> [a] -> m (FingerTree v a m)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldlM FingerTree v a m -> a -> m (FingerTree v a m)
forall (m :: * -> *) a v.
(MonadCredit m, Measured a v) =>
FingerTree v a m -> a -> m (FingerTree v a m)
snoc FingerTree v a m
q1 ([a]
as [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a
Item [a]
y])
glue (Deep Thunk m (Lazy m) v
_ Digit a
u1 Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
q1 Digit a
v1) [a]
as (Deep Thunk m (Lazy m) v
_ Digit a
u2 Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
q2 Digit a
v2) = m ()
forall (m :: * -> *). MonadCount m => m ()
tick m () -> m (FingerTree v a m) -> m (FingerTree v a m)
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> do
  Thunk m (FLazyCon m) (FingerTree v (Tuple v 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 (FLazyCon m) (FingerTree v (Tuple v a) m)
q1 Credit
2
  FingerTree v (Tuple v a) m
q1 <- Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
-> m (FingerTree v (Tuple v 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 (FLazyCon m) (FingerTree v (Tuple v a) m)
q1
  Thunk m (FLazyCon m) (FingerTree v (Tuple v 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 (FLazyCon m) (FingerTree v (Tuple v a) m)
q2 Credit
2
  FingerTree v (Tuple v a) m
q2 <- Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
-> m (FingerTree v (Tuple v 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 (FLazyCon m) (FingerTree v (Tuple v a) m)
q2
  FingerTree v (Tuple v a) m
q <- FingerTree v (Tuple v a) m
-> [Tuple v a]
-> FingerTree v (Tuple v a) m
-> m (FingerTree v (Tuple v a) m)
forall (m :: * -> *) a v.
(MonadCredit m, Measured a v) =>
FingerTree v a m -> [a] -> FingerTree v a m -> m (FingerTree v a m)
glue FingerTree v (Tuple v a) m
q1 ([a] -> [Tuple v a]
forall a v. Measured a v => [a] -> [Tuple v a]
toTuples (Digit a -> [a]
forall a. Digit a -> [a]
toList Digit a
v1 [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
as [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ Digit a -> [a]
forall a. Digit a -> [a]
toList Digit a
u2)) FingerTree v (Tuple v a) m
q2
  Digit a
-> m (Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m))
-> Digit a
-> m (FingerTree v a m)
forall (m :: * -> *) a v.
(MonadCredit m, Measured a v) =>
Digit a
-> m (Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m))
-> Digit a
-> m (FingerTree v a m)
deep' Digit a
u1 (FLazyCon m (FingerTree v (Tuple v a) m)
-> m (Thunk m (FLazyCon m) (FingerTree v (Tuple v 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 (FLazyCon m (FingerTree v (Tuple v a) m)
 -> m (Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)))
-> FLazyCon m (FingerTree v (Tuple v a) m)
-> m (Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m))
forall a b. (a -> b) -> a -> b
$ FingerTree v (Tuple v a) m
-> FLazyCon m (FingerTree v (Tuple v a) m)
forall a (m :: * -> *). a -> FLazyCon m a
FPure FingerTree v (Tuple v a) m
q) Digit a
v2

concat' :: (MonadCredit m, Measured a v) => FingerTree v a m -> FingerTree v a m -> m (FingerTree v a m)
concat' :: forall (m :: * -> *) a v.
(MonadCredit m, Measured a v) =>
FingerTree v a m -> FingerTree v a m -> m (FingerTree v a m)
concat' FingerTree v a m
q1 FingerTree v a m
q2 = FingerTree v a m -> [a] -> FingerTree v a m -> m (FingerTree v a m)
forall (m :: * -> *) a v.
(MonadCredit m, Measured a v) =>
FingerTree v a m -> [a] -> FingerTree v a m -> m (FingerTree v a m)
glue FingerTree v a m
q1 [] FingerTree v a m
q2

data Split v a m = Split
  { forall v a (m :: * -> *). Split v a m -> v
measureOfSmaller :: v
  , forall v a (m :: * -> *). Split v a m -> FingerTree v a m
smaller :: FingerTree v a m
  , forall v a (m :: * -> *). Split v a m -> a
found   :: a
  , forall v a (m :: * -> *). Split v a m -> FingerTree v a m
bigger  :: FingerTree v a m
  }

splitDigit :: Measured a v => (v -> Bool) -> v -> Digit a -> ([a], a, [a])
splitDigit :: forall a v.
Measured a v =>
(v -> Bool) -> v -> Digit a -> ([a], a, [a])
splitDigit v -> Bool
p v
i (One a
x) = ([], a
x, [])
splitDigit v -> Bool
p v
i (Two a
x a
y)
  | v -> Bool
p (v
i v -> v -> v
forall a. Semigroup a => a -> a -> a
<> a -> v
forall a v. Measured a v => a -> v
measure a
x) = ([], a
x, [a
Item [a]
y])
  | Bool
otherwise = ([a
Item [a]
x], a
y, [])
splitDigit v -> Bool
p v
i (Three a
x a
y a
z)
  | v -> Bool
p (v
i v -> v -> v
forall a. Semigroup a => a -> a -> a
<> a -> v
forall a v. Measured a v => a -> v
measure a
x) = ([], a
x, [a
Item [a]
y, a
Item [a]
z])
  | v -> Bool
p (v
i v -> v -> v
forall a. Semigroup a => a -> a -> a
<> a -> v
forall a v. Measured a v => a -> v
measure a
x v -> v -> v
forall a. Semigroup a => a -> a -> a
<> a -> v
forall a v. Measured a v => a -> v
measure a
y) = ([a
Item [a]
x], a
y, [a
Item [a]
z])
  | Bool
otherwise = ([a
Item [a]
x, a
Item [a]
y], a
z, [])

-- For '(Split vml ml xs mr) <- splitTree p i m', we have 'vml = measurement ml'.
splitTree :: (MonadCredit m, Measured a v) => (v -> Bool) -> v -> FingerTree v a m -> m (Split v a m)
splitTree :: forall (m :: * -> *) a v.
(MonadCredit m, Measured a v) =>
(v -> Bool) -> v -> FingerTree v a m -> m (Split v a m)
splitTree v -> Bool
p v
i FingerTree v a m
Empty = String -> m (Split v a m)
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"splitTree: empty tree"
splitTree v -> Bool
p v
i (Single a
x) = Split v a m -> m (Split v a m)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Split v a m -> m (Split v a m)) -> Split v a m -> m (Split v a m)
forall a b. (a -> b) -> a -> b
$ v -> FingerTree v a m -> a -> FingerTree v a m -> Split v a m
forall v a (m :: * -> *).
v -> FingerTree v a m -> a -> FingerTree v a m -> Split v a m
Split v
forall a. Monoid a => a
mempty FingerTree v a m
forall v a (m :: * -> *). FingerTree v a m
Empty a
x FingerTree v a m
forall v a (m :: * -> *). FingerTree v a m
Empty
splitTree v -> Bool
p v
i (Deep Thunk m (Lazy m) v
vm Digit a
pr Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
m Digit a
sf) = m ()
forall (m :: * -> *). MonadCount m => m ()
tick m () -> m (Split v a m) -> m (Split v a m)
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> do
  v
vm' <- Thunk m (Lazy m) v -> m v
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) v
vm
  let vpr :: v
vpr = v
i v -> v -> v
forall a. Semigroup a => a -> a -> a
<> Digit a -> v
forall a v. Measured a v => a -> v
measure Digit a
pr
  let vprm :: v
vprm = v
vpr v -> v -> v
forall a. Semigroup a => a -> a -> a
<> v
vm'
  if v -> Bool
p v
vpr then do
    let ([a]
l, a
x, [a]
r) = (v -> Bool) -> v -> Digit a -> ([a], a, [a])
forall a v.
Measured a v =>
(v -> Bool) -> v -> Digit a -> ([a], a, [a])
splitDigit v -> Bool
p v
i Digit a
pr
    v -> FingerTree v a m -> a -> FingerTree v a m -> Split v a m
forall v a (m :: * -> *).
v -> FingerTree v a m -> a -> FingerTree v a m -> Split v a m
Split ([a] -> v
forall a v. Measured a v => a -> v
measure [a]
l) (FingerTree v a m -> a -> FingerTree v a m -> Split v a m)
-> m (FingerTree v a m) -> m (a -> FingerTree v a m -> Split v a m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a] -> m (FingerTree v a m)
forall (m :: * -> *) a v.
(MonadCredit m, Measured a v) =>
[a] -> m (FingerTree v a m)
toTree [a]
l m (a -> FingerTree v a m -> Split v a m)
-> m a -> m (FingerTree v a m -> Split v a m)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> m a
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x m (FingerTree v a m -> Split v a m)
-> m (FingerTree v a m) -> m (Split v a m)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [a]
-> Thunk m (Lazy m) v
-> Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
-> Digit a
-> m (FingerTree v a m)
forall (m :: * -> *) a v.
(MonadCredit m, Measured a v) =>
[a]
-> Thunk m (Lazy m) v
-> Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
-> Digit a
-> m (FingerTree v a m)
deepL [a]
r Thunk m (Lazy m) v
vm Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
m Digit a
sf
  else if v -> Bool
p v
vprm then do
    Split v
vml FingerTree v (Tuple v a) m
ml Tuple v a
xs FingerTree v (Tuple v a) m
mr <- (v -> Bool)
-> v -> FingerTree v (Tuple v a) m -> m (Split v (Tuple v a) m)
forall (m :: * -> *) a v.
(MonadCredit m, Measured a v) =>
(v -> Bool) -> v -> FingerTree v a m -> m (Split v a m)
splitTree v -> Bool
p v
vpr (FingerTree v (Tuple v a) m -> m (Split v (Tuple v a) m))
-> m (FingerTree v (Tuple v a) m) -> m (Split v (Tuple v a) m)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
-> m (FingerTree v (Tuple v 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 (FLazyCon m) (FingerTree v (Tuple v a) m)
m
    let ([a]
l, a
x, [a]
r) = (v -> Bool) -> v -> Digit a -> ([a], a, [a])
forall a v.
Measured a v =>
(v -> Bool) -> v -> Digit a -> ([a], a, [a])
splitDigit v -> Bool
p (v
vpr v -> v -> v
forall a. Semigroup a => a -> a -> a
<> v
vml) (Tuple v a -> Digit a
forall v a. Tuple v a -> Digit a
toDigit Tuple v a
xs)
    -- [ml', mr', vmr', vml'] <- mapM (delay . Lazy)
      -- [pure ml, pure mr, measurement mr, pure vml]
    Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
ml' <- FLazyCon m (FingerTree v (Tuple v a) m)
-> m (Thunk m (FLazyCon m) (FingerTree v (Tuple v 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 (FLazyCon m (FingerTree v (Tuple v a) m)
 -> m (Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)))
-> FLazyCon m (FingerTree v (Tuple v a) m)
-> m (Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m))
forall a b. (a -> b) -> a -> b
$ FingerTree v (Tuple v a) m
-> FLazyCon m (FingerTree v (Tuple v a) m)
forall a (m :: * -> *). a -> FLazyCon m a
FPure FingerTree v (Tuple v a) m
ml
    Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
mr' <- FLazyCon m (FingerTree v (Tuple v a) m)
-> m (Thunk m (FLazyCon m) (FingerTree v (Tuple v 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 (FLazyCon m (FingerTree v (Tuple v a) m)
 -> m (Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)))
-> FLazyCon m (FingerTree v (Tuple v a) m)
-> m (Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m))
forall a b. (a -> b) -> a -> b
$ FingerTree v (Tuple v a) m
-> FLazyCon m (FingerTree v (Tuple v a) m)
forall a (m :: * -> *). a -> FLazyCon m a
FPure FingerTree v (Tuple v a) m
mr
    Thunk m (Lazy m) v
vmr' <- Lazy m v -> m (Thunk m (Lazy m) v)
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 v -> m (Thunk m (Lazy m) v))
-> Lazy m v -> m (Thunk m (Lazy m) v)
forall a b. (a -> b) -> a -> b
$ m v -> Lazy m v
forall {k} (m :: k -> *) (a :: k). m a -> Lazy m a
Lazy (m v -> Lazy m v) -> m v -> Lazy m v
forall a b. (a -> b) -> a -> b
$ FingerTree v (Tuple v a) m -> m v
forall (m :: * -> *) a v.
(MonadCredit m, Measured a v) =>
FingerTree v a m -> m v
measurement FingerTree v (Tuple v a) m
mr
    Thunk m (Lazy m) v
vml' <- Lazy m v -> m (Thunk m (Lazy m) v)
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 v -> m (Thunk m (Lazy m) v))
-> Lazy m v -> m (Thunk m (Lazy m) v)
forall a b. (a -> b) -> a -> b
$ m v -> Lazy m v
forall {k} (m :: k -> *) (a :: k). m a -> Lazy m a
Lazy (m v -> Lazy m v) -> m v -> Lazy m v
forall a b. (a -> b) -> a -> b
$ v -> m v
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure v
vml
    v -> FingerTree v a m -> a -> FingerTree v a m -> Split v a m
forall v a (m :: * -> *).
v -> FingerTree v a m -> a -> FingerTree v a m -> Split v a m
Split (Digit a -> v
forall a v. Measured a v => a -> v
measure Digit a
pr v -> v -> v
forall a. Semigroup a => a -> a -> a
<> v
vml v -> v -> v
forall a. Semigroup a => a -> a -> a
<> [a] -> v
forall a v. Measured a v => a -> v
measure [a]
l) (FingerTree v a m -> a -> FingerTree v a m -> Split v a m)
-> m (FingerTree v a m) -> m (a -> FingerTree v a m -> Split v a m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Digit a
-> Thunk m (Lazy m) v
-> Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
-> [a]
-> m (FingerTree v a m)
forall (m :: * -> *) a v.
(MonadCredit m, Measured a v) =>
Digit a
-> Thunk m (Lazy m) v
-> Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
-> [a]
-> m (FingerTree v a m)
deepR Digit a
pr Thunk m (Lazy m) v
vml' Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
ml' [a]
l m (a -> FingerTree v a m -> Split v a m)
-> m a -> m (FingerTree v a m -> Split v a m)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> m a
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x m (FingerTree v a m -> Split v a m)
-> m (FingerTree v a m) -> m (Split v a m)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [a]
-> Thunk m (Lazy m) v
-> Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
-> Digit a
-> m (FingerTree v a m)
forall (m :: * -> *) a v.
(MonadCredit m, Measured a v) =>
[a]
-> Thunk m (Lazy m) v
-> Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
-> Digit a
-> m (FingerTree v a m)
deepL [a]
r Thunk m (Lazy m) v
vmr' Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
mr' Digit a
sf
  else do
    let ([a]
l, a
x, [a]
r) = (v -> Bool) -> v -> Digit a -> ([a], a, [a])
forall a v.
Measured a v =>
(v -> Bool) -> v -> Digit a -> ([a], a, [a])
splitDigit v -> Bool
p v
vprm Digit a
sf
    v -> FingerTree v a m -> a -> FingerTree v a m -> Split v a m
forall v a (m :: * -> *).
v -> FingerTree v a m -> a -> FingerTree v a m -> Split v a m
Split (Digit a -> v
forall a v. Measured a v => a -> v
measure Digit a
pr v -> v -> v
forall a. Semigroup a => a -> a -> a
<> v
vm' v -> v -> v
forall a. Semigroup a => a -> a -> a
<> [a] -> v
forall a v. Measured a v => a -> v
measure [a]
l) (FingerTree v a m -> a -> FingerTree v a m -> Split v a m)
-> m (FingerTree v a m) -> m (a -> FingerTree v a m -> Split v a m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Digit a
-> Thunk m (Lazy m) v
-> Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
-> [a]
-> m (FingerTree v a m)
forall (m :: * -> *) a v.
(MonadCredit m, Measured a v) =>
Digit a
-> Thunk m (Lazy m) v
-> Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
-> [a]
-> m (FingerTree v a m)
deepR Digit a
pr Thunk m (Lazy m) v
vm Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
m [a]
l m (a -> FingerTree v a m -> Split v a m)
-> m a -> m (FingerTree v a m -> Split v a m)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> m a
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x m (FingerTree v a m -> Split v a m)
-> m (FingerTree v a m) -> m (Split v a m)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [a] -> m (FingerTree v a m)
forall (m :: * -> *) a v.
(MonadCredit m, Measured a v) =>
[a] -> m (FingerTree v a m)
toTree [a]
r

split :: (MonadCredit m, Measured a v) => (v -> Bool) -> FingerTree v a m -> m (FingerTree v a m, FingerTree v a m)
split :: forall (m :: * -> *) a v.
(MonadCredit m, Measured a v) =>
(v -> Bool)
-> FingerTree v a m -> m (FingerTree v a m, FingerTree v a m)
split v -> Bool
p FingerTree v a m
Empty = (FingerTree v a m, FingerTree v a m)
-> m (FingerTree v a m, FingerTree v a m)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FingerTree v a m
forall v a (m :: * -> *). FingerTree v a m
Empty, FingerTree v a m
forall v a (m :: * -> *). FingerTree v a m
Empty)
split v -> Bool
p FingerTree v a m
xs = do
  FingerTree v a m -> m ()
forall (m :: * -> *) a v.
(MonadCredit m, Measured a v) =>
FingerTree v a m -> m ()
forceAll FingerTree v a m
xs
  v
mxs <- FingerTree v a m -> m v
forall (m :: * -> *) a v.
(MonadCredit m, Measured a v) =>
FingerTree v a m -> m v
measurement FingerTree v a m
xs
  if v -> Bool
p v
mxs
    then do (Split v
_ FingerTree v a m
l a
x FingerTree v a m
r) <- (v -> Bool) -> v -> FingerTree v a m -> m (Split v a m)
forall (m :: * -> *) a v.
(MonadCredit m, Measured a v) =>
(v -> Bool) -> v -> FingerTree v a m -> m (Split v a m)
splitTree v -> Bool
p v
forall a. Monoid a => a
mempty FingerTree v a m
xs
            (FingerTree v a m
l,) (FingerTree v a m -> (FingerTree v a m, FingerTree v a m))
-> m (FingerTree v a m) -> m (FingerTree v a m, FingerTree v a m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> FingerTree v a m -> m (FingerTree v a m)
forall (m :: * -> *) a v.
(MonadCredit m, Measured a v) =>
a -> FingerTree v a m -> m (FingerTree v a m)
cons a
x FingerTree v a m
r
    else (FingerTree v a m, FingerTree v a m)
-> m (FingerTree v a m, FingerTree v a m)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FingerTree v a m
xs, FingerTree v a m
forall v a (m :: * -> *). FingerTree v a m
Empty)

takeUntil :: (MonadCredit m, Measured a v) => (v -> Bool) -> FingerTree v a m -> m (FingerTree v a m)
takeUntil :: forall (m :: * -> *) a v.
(MonadCredit m, Measured a v) =>
(v -> Bool) -> FingerTree v a m -> m (FingerTree v a m)
takeUntil v -> Bool
p FingerTree v a m
m = (FingerTree v a m, FingerTree v a m) -> FingerTree v a m
forall a b. (a, b) -> a
fst ((FingerTree v a m, FingerTree v a m) -> FingerTree v a m)
-> m (FingerTree v a m, FingerTree v a m) -> m (FingerTree v a m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (v -> Bool)
-> FingerTree v a m -> m (FingerTree v a m, FingerTree v a m)
forall (m :: * -> *) a v.
(MonadCredit m, Measured a v) =>
(v -> Bool)
-> FingerTree v a m -> m (FingerTree v a m, FingerTree v a m)
split v -> Bool
p FingerTree v a m
m

dropUntil :: (MonadCredit m, Measured a v) => (v -> Bool) -> FingerTree v a m -> m (FingerTree v a m)
dropUntil :: forall (m :: * -> *) a v.
(MonadCredit m, Measured a v) =>
(v -> Bool) -> FingerTree v a m -> m (FingerTree v a m)
dropUntil v -> Bool
p FingerTree v a m
m = (FingerTree v a m, FingerTree v a m) -> FingerTree v a m
forall a b. (a, b) -> b
snd ((FingerTree v a m, FingerTree v a m) -> FingerTree v a m)
-> m (FingerTree v a m, FingerTree v a m) -> m (FingerTree v a m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (v -> Bool)
-> FingerTree v a m -> m (FingerTree v a m, FingerTree v a m)
forall (m :: * -> *) a v.
(MonadCredit m, Measured a v) =>
(v -> Bool)
-> FingerTree v a m -> m (FingerTree v a m, FingerTree v a m)
split v -> Bool
p FingerTree v a m
m

lookupTree :: (MonadCredit m, Measured a v) => (v -> Bool) -> v -> FingerTree v a m -> m (Maybe (v, a))
lookupTree :: forall (m :: * -> *) a v.
(MonadCredit m, Measured a v) =>
(v -> Bool) -> v -> FingerTree v a m -> m (Maybe (v, a))
lookupTree v -> Bool
p v
i FingerTree v a m
Empty = Maybe (v, a) -> m (Maybe (v, a))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (v, a)
forall a. Maybe a
Nothing
lookupTree v -> Bool
p v
i FingerTree v a m
t = do
  FingerTree v a m -> m ()
forall (m :: * -> *) a v.
(MonadCredit m, Measured a v) =>
FingerTree v a m -> m ()
forceAll FingerTree v a m
t
  (Split v
ml FingerTree v a m
_ a
x FingerTree v a m
_) <- (v -> Bool) -> v -> FingerTree v a m -> m (Split v a m)
forall (m :: * -> *) a v.
(MonadCredit m, Measured a v) =>
(v -> Bool) -> v -> FingerTree v a m -> m (Split v a m)
splitTree v -> Bool
p v
i FingerTree v a m
t
  Maybe (v, a) -> m (Maybe (v, a))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (v, a) -> m (Maybe (v, a)))
-> Maybe (v, a) -> m (Maybe (v, a))
forall a b. (a -> b) -> a -> b
$ (v, a) -> Maybe (v, a)
forall a. a -> Maybe a
Just (v
i v -> v -> v
forall a. Semigroup a => a -> a -> a
<> v
ml, a
x)

instance MemoryCell m a => MemoryCell m (Digit a) where
  prettyCell :: Digit a -> m Memory
prettyCell (One a
a) = do
    Memory
a' <- a -> m Memory
forall (m :: * -> *) a. MemoryCell m a => a -> m Memory
prettyCell a
a
    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" [Item [Memory]
Memory
a']
  prettyCell (Two a
a a
b) = do
    Memory
a' <- a -> m Memory
forall (m :: * -> *) a. MemoryCell m a => a -> m Memory
prettyCell a
a
    Memory
b' <- a -> m Memory
forall (m :: * -> *) a. MemoryCell m a => a -> m Memory
prettyCell a
b
    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" [Item [Memory]
Memory
a', Item [Memory]
Memory
b']
  prettyCell (Three a
a a
b a
c) = do
    Memory
a' <- a -> m Memory
forall (m :: * -> *) a. MemoryCell m a => a -> m Memory
prettyCell a
a
    Memory
b' <- a -> m Memory
forall (m :: * -> *) a. MemoryCell m a => a -> m Memory
prettyCell a
b
    Memory
c' <- a -> m Memory
forall (m :: * -> *) a. MemoryCell m a => a -> m Memory
prettyCell a
c
    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
"Three" [Item [Memory]
Memory
a', Item [Memory]
Memory
b', Item [Memory]
Memory
c']

instance MemoryCell m a => MemoryCell m (Tuple v a) where
  prettyCell :: Tuple v a -> m Memory
prettyCell (Pair v
_ a
a a
b) = do
    Memory
a' <- a -> m Memory
forall (m :: * -> *) a. MemoryCell m a => a -> m Memory
prettyCell a
a
    Memory
b' <- a -> m Memory
forall (m :: * -> *) a. MemoryCell m a => a -> m Memory
prettyCell a
b
    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
"Pair" [Item [Memory]
Memory
a', Item [Memory]
Memory
b']
  prettyCell (Triple v
_ a
a a
b a
c) = do
    Memory
a' <- a -> m Memory
forall (m :: * -> *) a. MemoryCell m a => a -> m Memory
prettyCell a
a
    Memory
b' <- a -> m Memory
forall (m :: * -> *) a. MemoryCell m a => a -> m Memory
prettyCell a
b
    Memory
c' <- a -> m Memory
forall (m :: * -> *) a. MemoryCell m a => a -> m Memory
prettyCell a
c
    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
"Triple" [Item [Memory]
Memory
a', Item [Memory]
Memory
b', Item [Memory]
Memory
c']

instance (MonadMemory m, MemoryCell m a) => MemoryCell m (FLazyCon m a) where
  prettyCell :: FLazyCon m a -> m Memory
prettyCell (FPure 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
"FPure" [Item [Memory]
Memory
x']
  prettyCell (FCons a
x Thunk m (FLazyCon m) (FingerTree v a m)
m) = do
    -- x' <- prettyCell x
    Memory
m' <- Thunk m (FLazyCon m) (FingerTree v a m) -> m Memory
forall (m :: * -> *) a. MemoryCell m a => a -> m Memory
prettyCell Thunk m (FLazyCon m) (FingerTree v a m)
m
    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
"FCons" [Item [Memory]
Memory
m']
  prettyCell (FSnoc Thunk m (FLazyCon m) (FingerTree v a m)
m a
x) = do
    Memory
m' <- Thunk m (FLazyCon m) (FingerTree v a m) -> m Memory
forall (m :: * -> *) a. MemoryCell m a => a -> m Memory
prettyCell Thunk m (FLazyCon m) (FingerTree v a m)
m
    -- x' <- prettyCell 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
"FSnoc" [Item [Memory]
Memory
m']
  prettyCell (FTail FingerTree v a m
q) = do
    Memory
q' <- FingerTree v a m -> m Memory
forall (m :: * -> *) a. MemoryCell m a => a -> m Memory
prettyCell FingerTree v a 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
"FTail" [Item [Memory]
Memory
q']
  prettyCell (FInit FingerTree v a m
q) = do
    Memory
q' <- FingerTree v a m -> m Memory
forall (m :: * -> *) a. MemoryCell m a => a -> m Memory
prettyCell FingerTree v a 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
"FInit" [Item [Memory]
Memory
q']

instance (MonadMemory m, MemoryCell m a) => MemoryCell m (FingerTree v a m) where
  prettyCell :: FingerTree v a m -> m Memory
prettyCell FingerTree v a m
Empty = 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
"Empty" []
  prettyCell (Single a
a) = do
    Memory
a' <- a -> m Memory
forall (m :: * -> *) a. MemoryCell m a => a -> m Memory
prettyCell a
a
    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
"Single" [Item [Memory]
Memory
a']
  prettyCell (Deep Thunk m (Lazy m) v
_ Digit a
s Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
q Digit a
u) = do
    Memory
s' <- Digit a -> m Memory
forall (m :: * -> *) a. MemoryCell m a => a -> m Memory
prettyCell Digit a
s
    Memory
q' <- Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m) -> m Memory
forall (m :: * -> *) a. MemoryCell m a => a -> m Memory
prettyCell Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
q
    Memory
u' <- Digit a -> m Memory
forall (m :: * -> *) a. MemoryCell m a => a -> m Memory
prettyCell Digit a
u
    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
"Deep" [Item [Memory]
Memory
s', Item [Memory]
Memory
q', Item [Memory]
Memory
u']

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

newtype Elem a = Elem a
  deriving (Elem a -> Elem a -> Bool
(Elem a -> Elem a -> Bool)
-> (Elem a -> Elem a -> Bool) -> Eq (Elem a)
forall a. Eq a => Elem a -> Elem a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => Elem a -> Elem a -> Bool
== :: Elem a -> Elem a -> Bool
$c/= :: forall a. Eq a => Elem a -> Elem a -> Bool
/= :: Elem a -> Elem a -> Bool
Eq, Eq (Elem a)
Eq (Elem a) =>
(Elem a -> Elem a -> Ordering)
-> (Elem a -> Elem a -> Bool)
-> (Elem a -> Elem a -> Bool)
-> (Elem a -> Elem a -> Bool)
-> (Elem a -> Elem a -> Bool)
-> (Elem a -> Elem a -> Elem a)
-> (Elem a -> Elem a -> Elem a)
-> Ord (Elem a)
Elem a -> Elem a -> Bool
Elem a -> Elem a -> Ordering
Elem a -> Elem a -> Elem 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 (Elem a)
forall a. Ord a => Elem a -> Elem a -> Bool
forall a. Ord a => Elem a -> Elem a -> Ordering
forall a. Ord a => Elem a -> Elem a -> Elem a
$ccompare :: forall a. Ord a => Elem a -> Elem a -> Ordering
compare :: Elem a -> Elem a -> Ordering
$c< :: forall a. Ord a => Elem a -> Elem a -> Bool
< :: Elem a -> Elem a -> Bool
$c<= :: forall a. Ord a => Elem a -> Elem a -> Bool
<= :: Elem a -> Elem a -> Bool
$c> :: forall a. Ord a => Elem a -> Elem a -> Bool
> :: Elem a -> Elem a -> Bool
$c>= :: forall a. Ord a => Elem a -> Elem a -> Bool
>= :: Elem a -> Elem a -> Bool
$cmax :: forall a. Ord a => Elem a -> Elem a -> Elem a
max :: Elem a -> Elem a -> Elem a
$cmin :: forall a. Ord a => Elem a -> Elem a -> Elem a
min :: Elem a -> Elem a -> Elem a
Ord, Int -> Elem a -> ShowS
[Elem a] -> ShowS
Elem a -> String
(Int -> Elem a -> ShowS)
-> (Elem a -> String) -> ([Elem a] -> ShowS) -> Show (Elem a)
forall a. Show a => Int -> Elem a -> ShowS
forall a. Show a => [Elem a] -> ShowS
forall a. Show a => Elem a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Elem a -> ShowS
showsPrec :: Int -> Elem a -> ShowS
$cshow :: forall a. Show a => Elem a -> String
show :: Elem a -> String
$cshowList :: forall a. Show a => [Elem a] -> ShowS
showList :: [Elem a] -> ShowS
Show)

instance (MemoryCell m a) => MemoryCell m (Elem a) where
  prettyCell :: Elem a -> m Memory
prettyCell (Elem a
x) = a -> m Memory
forall (m :: * -> *) a. MemoryCell m a => a -> m Memory
prettyCell a
x

-- Deque

instance Measured (Elem a) () where
  measure :: Elem a -> ()
measure (Elem a
x) = ()

newtype FingerDeque a m = FingerDeque (FingerTree () (Elem a) m)

instance D.Deque FingerDeque where
  empty :: forall (m :: * -> *) a. MonadInherit m => m (FingerDeque a m)
empty = FingerDeque a m -> m (FingerDeque a m)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FingerDeque a m -> m (FingerDeque a m))
-> FingerDeque a m -> m (FingerDeque a m)
forall a b. (a -> b) -> a -> b
$ FingerTree () (Elem a) m -> FingerDeque a m
forall a (m :: * -> *). FingerTree () (Elem a) m -> FingerDeque a m
FingerDeque FingerTree () (Elem a) m
forall v a (m :: * -> *). FingerTree v a m
Empty
  cons :: forall (m :: * -> *) a.
MonadInherit m =>
a -> FingerDeque a m -> m (FingerDeque a m)
cons a
x (FingerDeque FingerTree () (Elem a) m
q) = FingerTree () (Elem a) m -> FingerDeque a m
forall a (m :: * -> *). FingerTree () (Elem a) m -> FingerDeque a m
FingerDeque (FingerTree () (Elem a) m -> FingerDeque a m)
-> m (FingerTree () (Elem a) m) -> m (FingerDeque a m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Elem a -> FingerTree () (Elem a) m -> m (FingerTree () (Elem a) m)
forall (m :: * -> *) a v.
(MonadCredit m, Measured a v) =>
a -> FingerTree v a m -> m (FingerTree v a m)
cons (a -> Elem a
forall a. a -> Elem a
Elem a
x) FingerTree () (Elem a) m
q
  snoc :: forall (m :: * -> *) a.
MonadInherit m =>
FingerDeque a m -> a -> m (FingerDeque a m)
snoc (FingerDeque FingerTree () (Elem a) m
q) a
x = FingerTree () (Elem a) m -> FingerDeque a m
forall a (m :: * -> *). FingerTree () (Elem a) m -> FingerDeque a m
FingerDeque (FingerTree () (Elem a) m -> FingerDeque a m)
-> m (FingerTree () (Elem a) m) -> m (FingerDeque a m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FingerTree () (Elem a) m -> Elem a -> m (FingerTree () (Elem a) m)
forall (m :: * -> *) a v.
(MonadCredit m, Measured a v) =>
FingerTree v a m -> a -> m (FingerTree v a m)
snoc FingerTree () (Elem a) m
q (a -> Elem a
forall a. a -> Elem a
Elem a
x)
  uncons :: forall (m :: * -> *) a.
MonadInherit m =>
FingerDeque a m -> m (Maybe (a, FingerDeque a m))
uncons (FingerDeque FingerTree () (Elem a) m
q) = do
    Maybe (Elem a, FingerTree () (Elem a) m)
m <- FingerTree () (Elem a) m
-> m (Maybe (Elem a, FingerTree () (Elem a) m))
forall (m :: * -> *) a v.
(MonadCredit m, Measured a v) =>
FingerTree v a m -> m (Maybe (a, FingerTree v a m))
uncons FingerTree () (Elem a) m
q
    case Maybe (Elem a, FingerTree () (Elem a) m)
m of
      Maybe (Elem a, FingerTree () (Elem a) m)
Nothing -> Maybe (a, FingerDeque a m) -> m (Maybe (a, FingerDeque a m))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (a, FingerDeque a m)
forall a. Maybe a
Nothing
      Just (Elem a
x, FingerTree () (Elem a) m
q') -> Maybe (a, FingerDeque a m) -> m (Maybe (a, FingerDeque a m))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (a, FingerDeque a m) -> m (Maybe (a, FingerDeque a m)))
-> Maybe (a, FingerDeque a m) -> m (Maybe (a, FingerDeque a m))
forall a b. (a -> b) -> a -> b
$ (a, FingerDeque a m) -> Maybe (a, FingerDeque a m)
forall a. a -> Maybe a
Just (a
x, FingerTree () (Elem a) m -> FingerDeque a m
forall a (m :: * -> *). FingerTree () (Elem a) m -> FingerDeque a m
FingerDeque FingerTree () (Elem a) m
q')
  unsnoc :: forall (m :: * -> *) a.
MonadInherit m =>
FingerDeque a m -> m (Maybe (FingerDeque a m, a))
unsnoc (FingerDeque FingerTree () (Elem a) m
q) = do
    Maybe (FingerTree () (Elem a) m, Elem a)
m <- FingerTree () (Elem a) m
-> m (Maybe (FingerTree () (Elem a) m, Elem a))
forall (m :: * -> *) a v.
(MonadCredit m, Measured a v) =>
FingerTree v a m -> m (Maybe (FingerTree v a m, a))
unsnoc FingerTree () (Elem a) m
q
    case Maybe (FingerTree () (Elem a) m, Elem a)
m of
      Maybe (FingerTree () (Elem a) m, Elem a)
Nothing -> Maybe (FingerDeque a m, a) -> m (Maybe (FingerDeque a m, a))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (FingerDeque a m, a)
forall a. Maybe a
Nothing
      Just (FingerTree () (Elem a) m
q', Elem a
x) -> Maybe (FingerDeque a m, a) -> m (Maybe (FingerDeque a m, a))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (FingerDeque a m, a) -> m (Maybe (FingerDeque a m, a)))
-> Maybe (FingerDeque a m, a) -> m (Maybe (FingerDeque a m, a))
forall a b. (a -> b) -> a -> b
$ (FingerDeque a m, a) -> Maybe (FingerDeque a m, a)
forall a. a -> Maybe a
Just (FingerTree () (Elem a) m -> FingerDeque a m
forall a (m :: * -> *). FingerTree () (Elem a) m -> FingerDeque a m
FingerDeque FingerTree () (Elem a) m
q', a
x)
  concat :: forall (m :: * -> *) a.
MonadInherit m =>
FingerDeque a m -> FingerDeque a m -> m (FingerDeque a m)
concat (FingerDeque FingerTree () (Elem a) m
q1) (FingerDeque FingerTree () (Elem a) m
q2) = FingerTree () (Elem a) m -> FingerDeque a m
forall a (m :: * -> *). FingerTree () (Elem a) m -> FingerDeque a m
FingerDeque (FingerTree () (Elem a) m -> FingerDeque a m)
-> m (FingerTree () (Elem a) m) -> m (FingerDeque a m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FingerTree () (Elem a) m
-> FingerTree () (Elem a) m -> m (FingerTree () (Elem a) m)
forall (m :: * -> *) a v.
(MonadCredit m, Measured a v) =>
FingerTree v a m -> FingerTree v a m -> m (FingerTree v a m)
concat' FingerTree () (Elem a) m
q1 FingerTree () (Elem a) m
q2

instance D.BoundedDeque FingerDeque where
  qcost :: forall a. Size -> DequeOp a -> Credit
qcost Size
_ (D.Cons a
_) = Credit
2
  qcost Size
_ (D.Snoc a
_) = Credit
2
  qcost Size
_ DequeOp a
D.Uncons = Credit
4
  qcost Size
_ DequeOp a
D.Unsnoc = Credit
2
  qcost Size
n DequeOp a
D.Concat = Credit
5 Credit -> Credit -> Credit
forall a. Num a => a -> a -> a
* Size -> Credit
log2 Size
n

instance (MonadMemory m, MemoryCell m a) => MemoryCell m (FingerDeque a m) where
  prettyCell :: FingerDeque a m -> m Memory
prettyCell (FingerDeque FingerTree () (Elem a) m
q) = FingerTree () (Elem a) m -> m Memory
forall (m :: * -> *) a. MemoryCell m a => a -> m Memory
prettyCell FingerTree () (Elem a) m
q

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

-- Random Access

newtype Size = Size Int
  deriving (Size -> Size -> Bool
(Size -> Size -> Bool) -> (Size -> Size -> Bool) -> Eq Size
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Size -> Size -> Bool
== :: Size -> Size -> Bool
$c/= :: Size -> Size -> Bool
/= :: Size -> Size -> Bool
Eq, Eq Size
Eq Size =>
(Size -> Size -> Ordering)
-> (Size -> Size -> Bool)
-> (Size -> Size -> Bool)
-> (Size -> Size -> Bool)
-> (Size -> Size -> Bool)
-> (Size -> Size -> Size)
-> (Size -> Size -> Size)
-> Ord Size
Size -> Size -> Bool
Size -> Size -> Ordering
Size -> Size -> Size
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
$ccompare :: Size -> Size -> Ordering
compare :: Size -> Size -> Ordering
$c< :: Size -> Size -> Bool
< :: Size -> Size -> Bool
$c<= :: Size -> Size -> Bool
<= :: Size -> Size -> Bool
$c> :: Size -> Size -> Bool
> :: Size -> Size -> Bool
$c>= :: Size -> Size -> Bool
>= :: Size -> Size -> Bool
$cmax :: Size -> Size -> Size
max :: Size -> Size -> Size
$cmin :: Size -> Size -> Size
min :: Size -> Size -> Size
Ord, Int -> Size -> ShowS
[Size] -> ShowS
Size -> String
(Int -> Size -> ShowS)
-> (Size -> String) -> ([Size] -> ShowS) -> Show Size
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Size -> ShowS
showsPrec :: Int -> Size -> ShowS
$cshow :: Size -> String
show :: Size -> String
$cshowList :: [Size] -> ShowS
showList :: [Size] -> ShowS
Show, Integer -> Size
Size -> Size
Size -> Size -> Size
(Size -> Size -> Size)
-> (Size -> Size -> Size)
-> (Size -> Size -> Size)
-> (Size -> Size)
-> (Size -> Size)
-> (Size -> Size)
-> (Integer -> Size)
-> Num Size
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: Size -> Size -> Size
+ :: Size -> Size -> Size
$c- :: Size -> Size -> Size
- :: Size -> Size -> Size
$c* :: Size -> Size -> Size
* :: Size -> Size -> Size
$cnegate :: Size -> Size
negate :: Size -> Size
$cabs :: Size -> Size
abs :: Size -> Size
$csignum :: Size -> Size
signum :: Size -> Size
$cfromInteger :: Integer -> Size
fromInteger :: Integer -> Size
Num)

instance Semigroup Size where
  Size
x <> :: Size -> Size -> Size
<> Size
y = Size
x Size -> Size -> Size
forall a. Num a => a -> a -> a
+ Size
y

instance Monoid Size where
  mempty :: Size
mempty = Size
0

instance Measured (Elem a) Size where
  measure :: Elem a -> Size
measure (Elem a
x) = Size
1

newtype FingerRA a m = FingerRA (FingerTree Size (Elem a) m)

-- Contrary to Hinze and Paterson, this is not O(1) but O(log n)
-- because we need to force all thunks in the tree to get the size.
length :: MonadCredit m => FingerRA a m -> m Size
length :: forall (m :: * -> *) a. MonadCredit m => FingerRA a m -> m Size
length (FingerRA FingerTree Size (Elem a) m
t) = FingerTree Size (Elem a) m -> m Size
forall (m :: * -> *) a v.
(MonadCredit m, Measured a v) =>
FingerTree v a m -> m v
measurement FingerTree Size (Elem a) m
t

splitAt :: MonadCredit m => Int -> FingerRA a m -> m (FingerRA a m, FingerRA a m)
splitAt :: forall (m :: * -> *) a.
MonadCredit m =>
Int -> FingerRA a m -> m (FingerRA a m, FingerRA a m)
splitAt Int
i (FingerRA FingerTree Size (Elem a) m
xs) = do
   (FingerTree Size (Elem a) m
l, FingerTree Size (Elem a) m
r) <- (Size -> Bool)
-> FingerTree Size (Elem a) m
-> m (FingerTree Size (Elem a) m, FingerTree Size (Elem a) m)
forall (m :: * -> *) a v.
(MonadCredit m, Measured a v) =>
(v -> Bool)
-> FingerTree v a m -> m (FingerTree v a m, FingerTree v a m)
split (Int -> Size
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i <) FingerTree Size (Elem a) m
xs
   (FingerRA a m, FingerRA a m) -> m (FingerRA a m, FingerRA a m)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((FingerRA a m, FingerRA a m) -> m (FingerRA a m, FingerRA a m))
-> (FingerRA a m, FingerRA a m) -> m (FingerRA a m, FingerRA a m)
forall a b. (a -> b) -> a -> b
$ (FingerTree Size (Elem a) m -> FingerRA a m
forall a (m :: * -> *). FingerTree Size (Elem a) m -> FingerRA a m
FingerRA FingerTree Size (Elem a) m
l, FingerTree Size (Elem a) m -> FingerRA a m
forall a (m :: * -> *). FingerTree Size (Elem a) m -> FingerRA a m
FingerRA FingerTree Size (Elem a) m
r)

instance RA.RandomAccess FingerRA where
  empty :: forall (m :: * -> *) a. MonadCredit m => m (FingerRA a m)
empty = FingerRA a m -> m (FingerRA a m)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FingerRA a m -> m (FingerRA a m))
-> FingerRA a m -> m (FingerRA a m)
forall a b. (a -> b) -> a -> b
$ FingerTree Size (Elem a) m -> FingerRA a m
forall a (m :: * -> *). FingerTree Size (Elem a) m -> FingerRA a m
FingerRA FingerTree Size (Elem a) m
forall v a (m :: * -> *). FingerTree v a m
Empty
  cons :: forall (m :: * -> *) a.
MonadCredit m =>
a -> FingerRA a m -> m (FingerRA a m)
cons a
x (FingerRA FingerTree Size (Elem a) m
q) = FingerTree Size (Elem a) m -> FingerRA a m
forall a (m :: * -> *). FingerTree Size (Elem a) m -> FingerRA a m
FingerRA (FingerTree Size (Elem a) m -> FingerRA a m)
-> m (FingerTree Size (Elem a) m) -> m (FingerRA a m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Elem a
-> FingerTree Size (Elem a) m -> m (FingerTree Size (Elem a) m)
forall (m :: * -> *) a v.
(MonadCredit m, Measured a v) =>
a -> FingerTree v a m -> m (FingerTree v a m)
cons (a -> Elem a
forall a. a -> Elem a
Elem a
x) FingerTree Size (Elem a) m
q
  uncons :: forall (m :: * -> *) a.
MonadCredit m =>
FingerRA a m -> m (Maybe (a, FingerRA a m))
uncons (FingerRA FingerTree Size (Elem a) m
q) = do
    Maybe (Elem a, FingerTree Size (Elem a) m)
m <- FingerTree Size (Elem a) m
-> m (Maybe (Elem a, FingerTree Size (Elem a) m))
forall (m :: * -> *) a v.
(MonadCredit m, Measured a v) =>
FingerTree v a m -> m (Maybe (a, FingerTree v a m))
uncons FingerTree Size (Elem a) m
q
    case Maybe (Elem a, FingerTree Size (Elem a) m)
m of
      Maybe (Elem a, FingerTree Size (Elem a) m)
Nothing -> Maybe (a, FingerRA a m) -> m (Maybe (a, FingerRA a m))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (a, FingerRA a m)
forall a. Maybe a
Nothing
      Just (Elem a
x, FingerTree Size (Elem a) m
m') -> do
        Maybe (a, FingerRA a m) -> m (Maybe (a, FingerRA a m))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (a, FingerRA a m) -> m (Maybe (a, FingerRA a m)))
-> Maybe (a, FingerRA a m) -> m (Maybe (a, FingerRA a m))
forall a b. (a -> b) -> a -> b
$ (a, FingerRA a m) -> Maybe (a, FingerRA a m)
forall a. a -> Maybe a
Just (a
x, FingerTree Size (Elem a) m -> FingerRA a m
forall a (m :: * -> *). FingerTree Size (Elem a) m -> FingerRA a m
FingerRA FingerTree Size (Elem a) m
m')
  lookup :: forall (m :: * -> *) a.
MonadCredit m =>
Int -> FingerRA a m -> m (Maybe a)
lookup Int
i (FingerRA FingerTree Size (Elem a) m
Empty) = 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
  lookup Int
i (FingerRA FingerTree Size (Elem a) m
xs) = do
    FingerTree Size (Elem a) m -> m ()
forall (m :: * -> *) a v.
(MonadCredit m, Measured a v) =>
FingerTree v a m -> m ()
forceAll FingerTree Size (Elem a) m
xs
    (Split Size
_ FingerTree Size (Elem a) m
_ (Elem a
x) FingerTree Size (Elem a) m
_) <- (Size -> Bool)
-> Size -> FingerTree Size (Elem a) m -> m (Split Size (Elem a) m)
forall (m :: * -> *) a v.
(MonadCredit m, Measured a v) =>
(v -> Bool) -> v -> FingerTree v a m -> m (Split v a m)
splitTree (Int -> Size
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i <) Size
0 FingerTree Size (Elem a) m
xs
    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
  update :: forall (m :: * -> *) a.
MonadCredit m =>
Int -> a -> FingerRA a m -> m (FingerRA a m)
update Int
i a
a (FingerRA FingerTree Size (Elem a) m
Empty) = FingerRA a m -> m (FingerRA a m)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FingerRA a m -> m (FingerRA a m))
-> FingerRA a m -> m (FingerRA a m)
forall a b. (a -> b) -> a -> b
$ FingerTree Size (Elem a) m -> FingerRA a m
forall a (m :: * -> *). FingerTree Size (Elem a) m -> FingerRA a m
FingerRA FingerTree Size (Elem a) m
forall v a (m :: * -> *). FingerTree v a m
Empty
  update Int
i a
a (FingerRA FingerTree Size (Elem a) m
xs) = do
    FingerTree Size (Elem a) m -> m ()
forall (m :: * -> *) a v.
(MonadCredit m, Measured a v) =>
FingerTree v a m -> m ()
forceAll FingerTree Size (Elem a) m
xs
    (Split Size
ml FingerTree Size (Elem a) m
l (Elem a
x) FingerTree Size (Elem a) m
r) <- (Size -> Bool)
-> Size -> FingerTree Size (Elem a) m -> m (Split Size (Elem a) m)
forall (m :: * -> *) a v.
(MonadCredit m, Measured a v) =>
(v -> Bool) -> v -> FingerTree v a m -> m (Split v a m)
splitTree (Int -> Size
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i <) Size
0 FingerTree Size (Elem a) m
xs
    if Int -> Size
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i Size -> Size -> Bool
forall a. Ord a => a -> a -> Bool
> Size
ml
      then FingerTree Size (Elem a) m -> FingerRA a m
forall a (m :: * -> *). FingerTree Size (Elem a) m -> FingerRA a m
FingerRA (FingerTree Size (Elem a) m -> FingerRA a m)
-> m (FingerTree Size (Elem a) m) -> m (FingerRA a m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FingerTree Size (Elem a) m
-> Elem a -> m (FingerTree Size (Elem a) m)
forall (m :: * -> *) a v.
(MonadCredit m, Measured a v) =>
FingerTree v a m -> a -> m (FingerTree v a m)
snoc FingerTree Size (Elem a) m
l (a -> Elem a
forall a. a -> Elem a
Elem a
x)
      else FingerTree Size (Elem a) m -> FingerRA a m
forall a (m :: * -> *). FingerTree Size (Elem a) m -> FingerRA a m
FingerRA (FingerTree Size (Elem a) m -> FingerRA a m)
-> m (FingerTree Size (Elem a) m) -> m (FingerRA a m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FingerTree Size (Elem a) m
-> FingerTree Size (Elem a) m -> m (FingerTree Size (Elem a) m)
forall (m :: * -> *) a v.
(MonadCredit m, Measured a v) =>
FingerTree v a m -> FingerTree v a m -> m (FingerTree v a m)
concat' FingerTree Size (Elem a) m
l (FingerTree Size (Elem a) m -> m (FingerTree Size (Elem a) m))
-> m (FingerTree Size (Elem a) m) -> m (FingerTree Size (Elem a) m)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Elem a
-> FingerTree Size (Elem a) m -> m (FingerTree Size (Elem a) m)
forall (m :: * -> *) a v.
(MonadCredit m, Measured a v) =>
a -> FingerTree v a m -> m (FingerTree v a m)
cons (a -> Elem a
forall a. a -> Elem a
Elem a
a) FingerTree Size (Elem a) m
r)

instance RA.BoundedRandomAccess FingerRA where
  qcost :: forall a. Size -> RandomAccessOp a -> Credit
qcost Size
n (RA.Cons a
_) = Credit
2
  qcost Size
n RandomAccessOp a
RA.Uncons = Credit
2
  qcost Size
n (RA.Lookup Int
i) = Credit
5 Credit -> Credit -> Credit
forall a. Num a => a -> a -> a
* Size -> Credit
log2 Size
n
  qcost Size
n (RA.Update Int
i a
_) = Credit
2 Credit -> Credit -> Credit
forall a. Num a => a -> a -> a
+ Credit
10 Credit -> Credit -> Credit
forall a. Num a => a -> a -> a
* Size -> Credit
log2 Size
n

instance (MonadMemory m, MemoryCell m a) => MemoryCell m (FingerRA a m) where
  prettyCell :: FingerRA a m -> m Memory
prettyCell (FingerRA FingerTree Size (Elem a) m
q) = FingerTree Size (Elem a) m -> m Memory
forall (m :: * -> *) a. MemoryCell m a => a -> m Memory
prettyCell FingerTree Size (Elem a) m
q

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

-- Heap

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

instance Ord a => Semigroup (Prio a) where
  Prio a
MInfty <> :: Prio a -> Prio a -> Prio a
<> Prio a
p = Prio a
p
  Prio a
p <> Prio a
MInfty = Prio a
p
  Prio a
x <> Prio a
y = a -> Prio a
forall a. a -> Prio a
Prio (a -> a -> a
forall a. Ord a => a -> a -> a
min a
x a
y)

instance Ord a => Monoid (Prio a) where
  mempty :: Prio a
mempty = Prio a
forall a. Prio a
MInfty

instance Ord a => Measured (Elem a) (Prio a) where
  measure :: Elem a -> Prio a
measure (Elem a
x) = a -> Prio a
forall a. a -> Prio a
Prio a
x

newtype FingerHeap a m = FingerHeap (FingerTree (Prio a) (Elem a) m)

instance H.Heap FingerHeap where
  empty :: forall (m :: * -> *) a. MonadCredit m => m (FingerHeap a m)
empty = FingerHeap a m -> m (FingerHeap a m)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FingerHeap a m -> m (FingerHeap a m))
-> FingerHeap a m -> m (FingerHeap a m)
forall a b. (a -> b) -> a -> b
$ FingerTree (Prio a) (Elem a) m -> FingerHeap a m
forall a (m :: * -> *).
FingerTree (Prio a) (Elem a) m -> FingerHeap a m
FingerHeap FingerTree (Prio a) (Elem a) m
forall v a (m :: * -> *). FingerTree v a m
Empty
  insert :: forall (m :: * -> *) a.
(MonadCredit m, Ord a) =>
a -> FingerHeap a m -> m (FingerHeap a m)
insert a
x (FingerHeap FingerTree (Prio a) (Elem a) m
xs) = FingerTree (Prio a) (Elem a) m -> FingerHeap a m
forall a (m :: * -> *).
FingerTree (Prio a) (Elem a) m -> FingerHeap a m
FingerHeap (FingerTree (Prio a) (Elem a) m -> FingerHeap a m)
-> m (FingerTree (Prio a) (Elem a) m) -> m (FingerHeap a m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Elem a
-> FingerTree (Prio a) (Elem a) m
-> m (FingerTree (Prio a) (Elem a) m)
forall (m :: * -> *) a v.
(MonadCredit m, Measured a v) =>
a -> FingerTree v a m -> m (FingerTree v a m)
cons (a -> Elem a
forall a. a -> Elem a
Elem a
x) FingerTree (Prio a) (Elem a) m
xs
  merge :: forall (m :: * -> *) a.
(MonadCredit m, Ord a) =>
FingerHeap a m -> FingerHeap a m -> m (FingerHeap a m)
merge (FingerHeap FingerTree (Prio a) (Elem a) m
a) (FingerHeap FingerTree (Prio a) (Elem a) m
b) = FingerTree (Prio a) (Elem a) m -> FingerHeap a m
forall a (m :: * -> *).
FingerTree (Prio a) (Elem a) m -> FingerHeap a m
FingerHeap (FingerTree (Prio a) (Elem a) m -> FingerHeap a m)
-> m (FingerTree (Prio a) (Elem a) m) -> m (FingerHeap a m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FingerTree (Prio a) (Elem a) m
-> FingerTree (Prio a) (Elem a) m
-> m (FingerTree (Prio a) (Elem a) m)
forall (m :: * -> *) a v.
(MonadCredit m, Measured a v) =>
FingerTree v a m -> FingerTree v a m -> m (FingerTree v a m)
concat' FingerTree (Prio a) (Elem a) m
a FingerTree (Prio a) (Elem a) m
b
  splitMin :: forall (m :: * -> *) a.
(MonadCredit m, Ord a) =>
FingerHeap a m -> m (Maybe (a, FingerHeap a m))
splitMin (FingerHeap FingerTree (Prio a) (Elem a) m
Empty) = Maybe (a, FingerHeap a m) -> m (Maybe (a, FingerHeap a m))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (a, FingerHeap a m)
forall a. Maybe a
Nothing
  splitMin (FingerHeap FingerTree (Prio a) (Elem a) m
xs) = do
    FingerTree (Prio a) (Elem a) m -> m ()
forall (m :: * -> *) a v.
(MonadCredit m, Measured a v) =>
FingerTree v a m -> m ()
forceAll FingerTree (Prio a) (Elem a) m
xs -- 2 * log n
    Prio a
k <- FingerTree (Prio a) (Elem a) m -> m (Prio a)
forall (m :: * -> *) a v.
(MonadCredit m, Measured a v) =>
FingerTree v a m -> m v
measurement FingerTree (Prio a) (Elem a) m
xs
    (Split Prio a
_ FingerTree (Prio a) (Elem a) m
l (Elem a
x) FingerTree (Prio a) (Elem a) m
r) <- (Prio a -> Bool)
-> Prio a
-> FingerTree (Prio a) (Elem a) m
-> m (Split (Prio a) (Elem a) m)
forall (m :: * -> *) a v.
(MonadCredit m, Measured a v) =>
(v -> Bool) -> v -> FingerTree v a m -> m (Split v a m)
splitTree (Prio a
k >=) Prio a
forall a. Monoid a => a
mempty FingerTree (Prio a) (Elem a) m
xs -- 3 * log n
    FingerTree (Prio a) (Elem a) m
lr <- FingerTree (Prio a) (Elem a) m
-> FingerTree (Prio a) (Elem a) m
-> m (FingerTree (Prio a) (Elem a) m)
forall (m :: * -> *) a v.
(MonadCredit m, Measured a v) =>
FingerTree v a m -> FingerTree v a m -> m (FingerTree v a m)
concat' FingerTree (Prio a) (Elem a) m
l FingerTree (Prio a) (Elem a) m
r -- 5 log n
    Maybe (a, FingerHeap a m) -> m (Maybe (a, FingerHeap a m))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (a, FingerHeap a m) -> m (Maybe (a, FingerHeap a m)))
-> Maybe (a, FingerHeap a m) -> m (Maybe (a, FingerHeap a m))
forall a b. (a -> b) -> a -> b
$ (a, FingerHeap a m) -> Maybe (a, FingerHeap a m)
forall a. a -> Maybe a
Just (a
x, FingerTree (Prio a) (Elem a) m -> FingerHeap a m
forall a (m :: * -> *).
FingerTree (Prio a) (Elem a) m -> FingerHeap a m
FingerHeap FingerTree (Prio a) (Elem a) m
lr)

instance H.BoundedHeap FingerHeap where
  hcost :: forall a. Size -> HeapOp a -> Credit
hcost Size
n (H.Insert a
_) = Credit
2
  hcost Size
n HeapOp a
H.Merge = Credit
5 Credit -> Credit -> Credit
forall a. Num a => a -> a -> a
* Size -> Credit
log2 Size
n
  hcost Size
n HeapOp a
H.SplitMin = Credit
1 Credit -> Credit -> Credit
forall a. Num a => a -> a -> a
+ Credit
10 Credit -> Credit -> Credit
forall a. Num a => a -> a -> a
* Size -> Credit
log2 (Size
n Size -> Size -> Size
forall a. Num a => a -> a -> a
+ Size
1)

instance (MonadMemory m, MemoryCell m a) => MemoryCell m (FingerHeap a m) where
  prettyCell :: FingerHeap a m -> m Memory
prettyCell (FingerHeap FingerTree (Prio a) (Elem a) m
q) = FingerTree (Prio a) (Elem a) m -> m Memory
forall (m :: * -> *) a. MemoryCell m a => a -> m Memory
prettyCell FingerTree (Prio a) (Elem a) m
q

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

-- Sortable Collection

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

instance Semigroup (Key a) where
  Key a
k <> :: Key a -> Key a -> Key a
<> Key a
NoKey = Key a
k
  Key a
_ <> Key a
k = Key a
k

instance Monoid (Key a) where
  mempty :: Key a
mempty = Key a
forall a. Key a
NoKey

instance Measured (Elem a) (Key a) where
  measure :: Elem a -> Key a
measure (Elem a
x) = a -> Key a
forall a. a -> Key a
Key a
x

newtype FingerSort a m = FingerSort (FingerTree (Key a) (Elem a) m)

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) 

append :: MonadCredit m => [a] -> [a] -> m [a]
append :: forall (m :: * -> *) a. MonadCredit m => [a] -> [a] -> m [a]
append [] [a]
ys = [a] -> m [a]
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [a]
ys
append (a
x : [a]
xs) [a]
ys = 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] -> m [a]
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a
x:) ([a] -> [a] -> m [a]
forall (m :: * -> *) a. MonadCredit m => [a] -> [a] -> m [a]
append [a]
xs [a]
ys)

treeToList :: MonadCredit m => [b] -> (a -> m [b]) -> FingerTree v a m -> m [b]
treeToList :: forall (m :: * -> *) b a v.
MonadCredit m =>
[b] -> (a -> m [b]) -> FingerTree v a m -> m [b]
treeToList [b]
acc a -> m [b]
f FingerTree v a m
Empty = [b] -> [b] -> m [b]
forall (m :: * -> *) a. MonadCredit m => [a] -> [a] -> m [a]
rev [b]
acc []
treeToList [b]
acc a -> m [b]
f (Single a
x) = do
  [b]
fx <- a -> m [b]
f a
x
  ([b] -> [b] -> m [b]) -> [b] -> [b] -> m [b]
forall a b c. (a -> b -> c) -> b -> a -> c
flip [b] -> [b] -> m [b]
forall (m :: * -> *) a. MonadCredit m => [a] -> [a] -> m [a]
rev [] ([b] -> m [b]) -> m [b] -> m [b]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [b] -> [b] -> m [b]
forall (m :: * -> *) a. MonadCredit m => [a] -> [a] -> m [a]
append [b]
fx [b]
acc
treeToList [b]
acc a -> m [b]
f (Deep Thunk m (Lazy m) v
_ Digit a
s Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
q Digit a
u) = do
  [b]
s' <- ([[b]] -> [b]) -> m [[b]] -> m [b]
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([b] -> [b]) -> [[b]] -> [b]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap [b] -> [b]
forall a. a -> a
id) (m [[b]] -> m [b]) -> m [[b]] -> m [b]
forall a b. (a -> b) -> a -> b
$ (a -> m [b]) -> [a] -> m [[b]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse a -> m [b]
f ([a] -> m [[b]]) -> [a] -> m [[b]]
forall a b. (a -> b) -> a -> b
$ Digit a -> [a]
forall a. Digit a -> [a]
toList Digit a
s
  [b]
u' <- ([[b]] -> [b]) -> m [[b]] -> m [b]
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([b] -> [b]) -> [[b]] -> [b]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap [b] -> [b]
forall a. a -> a
id) (m [[b]] -> m [b]) -> m [[b]] -> m [b]
forall a b. (a -> b) -> a -> b
$ (a -> m [b]) -> [a] -> m [[b]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse a -> m [b]
f ([a] -> m [[b]]) -> [a] -> m [[b]]
forall a b. (a -> b) -> a -> b
$ Digit a -> [a]
forall a. Digit a -> [a]
toList Digit a
u
  Thunk m (FLazyCon m) (FingerTree v (Tuple v 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 (FLazyCon m) (FingerTree v (Tuple v a) m)
q Credit
2
  [b]
q' <- [b] -> (Tuple v a -> m [b]) -> FingerTree v (Tuple v a) m -> m [b]
forall (m :: * -> *) b a v.
MonadCredit m =>
[b] -> (a -> m [b]) -> FingerTree v a m -> m [b]
treeToList ([b]
u' [b] -> [b] -> [b]
forall a. [a] -> [a] -> [a]
++ [b]
acc) (([[b]] -> [b]) -> m [[b]] -> m [b]
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([b] -> [b]) -> [[b]] -> [b]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap [b] -> [b]
forall a. a -> a
id) (m [[b]] -> m [b]) -> (Tuple v a -> m [[b]]) -> Tuple v a -> m [b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> m [b]) -> [a] -> m [[b]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse a -> m [b]
f ([a] -> m [[b]]) -> (Tuple v a -> [a]) -> Tuple v a -> m [[b]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Digit a -> [a]
forall a. Digit a -> [a]
toList (Digit a -> [a]) -> (Tuple v a -> Digit a) -> Tuple v a -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tuple v a -> Digit a
forall v a. Tuple v a -> Digit a
toDigit) (FingerTree v (Tuple v a) m -> m [b])
-> m (FingerTree v (Tuple v a) m) -> m [b]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Thunk m (FLazyCon m) (FingerTree v (Tuple v a) m)
-> m (FingerTree v (Tuple v 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 (FLazyCon m) (FingerTree v (Tuple v a) m)
q
  [b] -> [b] -> m [b]
forall (m :: * -> *) a. MonadCredit m => [a] -> [a] -> m [a]
append [b]
s' [b]
q'

instance S.Sortable FingerSort where
  empty :: forall (m :: * -> *) a. MonadCredit m => m (FingerSort a m)
empty = FingerSort a m -> m (FingerSort a m)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FingerSort a m -> m (FingerSort a m))
-> FingerSort a m -> m (FingerSort a m)
forall a b. (a -> b) -> a -> b
$ FingerTree (Key a) (Elem a) m -> FingerSort a m
forall a (m :: * -> *).
FingerTree (Key a) (Elem a) m -> FingerSort a m
FingerSort FingerTree (Key a) (Elem a) m
forall v a (m :: * -> *). FingerTree v a m
Empty
  add :: forall (m :: * -> *) a.
(MonadCredit m, Ord a) =>
a -> FingerSort a m -> m (FingerSort a m)
add a
x (FingerSort FingerTree (Key a) (Elem a) m
xs) = do
    (FingerTree (Key a) (Elem a) m
l, FingerTree (Key a) (Elem a) m
r) <- (Key a -> Bool)
-> FingerTree (Key a) (Elem a) m
-> m (FingerTree (Key a) (Elem a) m, FingerTree (Key a) (Elem a) m)
forall (m :: * -> *) a v.
(MonadCredit m, Measured a v) =>
(v -> Bool)
-> FingerTree v a m -> m (FingerTree v a m, FingerTree v a m)
split (Key a -> Key a -> Bool
forall a. Ord a => a -> a -> Bool
>= a -> Key a
forall a. a -> Key a
Key a
x) FingerTree (Key a) (Elem a) m
xs
    FingerTree (Key a) (Elem a) m
lxr <- FingerTree (Key a) (Elem a) m
-> FingerTree (Key a) (Elem a) m
-> m (FingerTree (Key a) (Elem a) m)
forall (m :: * -> *) a v.
(MonadCredit m, Measured a v) =>
FingerTree v a m -> FingerTree v a m -> m (FingerTree v a m)
concat' FingerTree (Key a) (Elem a) m
l (FingerTree (Key a) (Elem a) m
 -> m (FingerTree (Key a) (Elem a) m))
-> m (FingerTree (Key a) (Elem a) m)
-> m (FingerTree (Key a) (Elem a) m)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Elem a
-> FingerTree (Key a) (Elem a) m
-> m (FingerTree (Key a) (Elem a) m)
forall (m :: * -> *) a v.
(MonadCredit m, Measured a v) =>
a -> FingerTree v a m -> m (FingerTree v a m)
cons (a -> Elem a
forall a. a -> Elem a
Elem a
x) FingerTree (Key a) (Elem a) m
r
    FingerSort a m -> m (FingerSort a m)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FingerSort a m -> m (FingerSort a m))
-> FingerSort a m -> m (FingerSort a m)
forall a b. (a -> b) -> a -> b
$ FingerTree (Key a) (Elem a) m -> FingerSort a m
forall a (m :: * -> *).
FingerTree (Key a) (Elem a) m -> FingerSort a m
FingerSort FingerTree (Key a) (Elem a) m
lxr
  sort :: forall (m :: * -> *) a.
(MonadCredit m, Ord a) =>
FingerSort a m -> m [a]
sort (FingerSort FingerTree (Key a) (Elem a) m
xs) = do
    [a] -> (Elem a -> m [a]) -> FingerTree (Key a) (Elem a) m -> m [a]
forall (m :: * -> *) b a v.
MonadCredit m =>
[b] -> (a -> m [b]) -> FingerTree v a m -> m [b]
treeToList [] (\(Elem a
x) -> 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] -> m [a]
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [a
Item [a]
x]) FingerTree (Key a) (Elem a) m
xs

instance S.BoundedSortable FingerSort where
  scost :: forall a. Size -> SortableOp a -> Credit
scost Size
n (S.Add a
_) = Credit
1 Credit -> Credit -> Credit
forall a. Num a => a -> a -> a
+ Credit
10 Credit -> Credit -> Credit
forall a. Num a => a -> a -> a
* Size -> Credit
log2 (Size
n Size -> Size -> Size
forall a. Num a => a -> a -> a
+ Size
1)
  scost Size
n SortableOp a
S.Sort = Credit
2 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
3 Credit -> Credit -> Credit
forall a. Num a => a -> a -> a
* Size -> Credit
linear Size
n

instance (MonadMemory m, MemoryCell m a) => MemoryCell m (FingerSort a m) where
  prettyCell :: FingerSort a m -> m Memory
prettyCell (FingerSort FingerTree (Key a) (Elem a) m
q) = FingerTree (Key a) (Elem a) m -> m Memory
forall (m :: * -> *) a. MemoryCell m a => a -> m Memory
prettyCell FingerTree (Key a) (Elem a) m
q

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