{-# LANGUAGE CPP #-}
{-# OPTIONS_HADDOCK hide #-}
module Graphics.UI.Gtk.ModelView.Sequence (
Seq,
empty,
singleton,
(<|),
(|>),
(><),
null,
ViewL(..),
viewl,
ViewR(..),
viewr,
length,
index,
adjust,
update,
take,
drop,
splitAt,
fromList,
toList,
foldr,
foldr1,
foldr',
foldrM,
foldl,
foldl1,
foldl',
foldlM,
reverse,
#if TESTING
valid,
#endif
) where
import Prelude hiding (
null, length, take, drop, splitAt, foldl, foldl1, foldr, foldr1,
reverse)
import qualified Prelude (foldr)
import Data.List (intersperse)
import qualified Data.List (foldl')
#if TESTING
import Control.Monad (liftM, liftM2, liftM3, liftM4)
import Test.QuickCheck
#endif
infixr 5 `consTree`
infixl 5 `snocTree`
infixr 5 ><
infixr 5 <|, :<
infixl 5 |>, :>
class Sized a where
size :: a -> Int
newtype Seq a = Seq (FingerTree (Elem a))
instance Functor Seq where
fmap :: (a -> b) -> Seq a -> Seq b
fmap f :: a -> b
f (Seq xs :: FingerTree (Elem a)
xs) = FingerTree (Elem b) -> Seq b
forall a. FingerTree (Elem a) -> Seq a
Seq ((Elem a -> Elem b) -> FingerTree (Elem a) -> FingerTree (Elem b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> Elem a -> Elem b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) FingerTree (Elem a)
xs)
instance Eq a => Eq (Seq a) where
xs :: Seq a
xs == :: Seq a -> Seq a -> Bool
== ys :: Seq a
ys = Seq a -> Int
forall a. Seq a -> Int
length Seq a
xs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Seq a -> Int
forall a. Seq a -> Int
length Seq a
ys Bool -> Bool -> Bool
&& Seq a -> [a]
forall a. Seq a -> [a]
toList Seq a
xs [a] -> [a] -> Bool
forall a. Eq a => a -> a -> Bool
== Seq a -> [a]
forall a. Seq a -> [a]
toList Seq a
ys
instance Ord a => Ord (Seq a) where
compare :: Seq a -> Seq a -> Ordering
compare xs :: Seq a
xs ys :: Seq a
ys = [a] -> [a] -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Seq a -> [a]
forall a. Seq a -> [a]
toList Seq a
xs) (Seq a -> [a]
forall a. Seq a -> [a]
toList Seq a
ys)
#if TESTING
instance (Show a) => Show (Seq a) where
showsPrec p (Seq x) = showsPrec p x
#else
instance Show a => Show (Seq a) where
showsPrec :: Int -> Seq a -> ShowS
showsPrec _ xs :: Seq a
xs = Char -> ShowS
showChar '<' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(String -> [ShowS] -> String) -> [ShowS] -> ShowS
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((ShowS -> ShowS) -> String -> [ShowS] -> String
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
Prelude.foldr ShowS -> ShowS
forall a b. (a -> b) -> a -> b
($)) (ShowS -> [ShowS] -> [ShowS]
forall a. a -> [a] -> [a]
intersperse (Char -> ShowS
showChar ',')
((a -> ShowS) -> [a] -> [ShowS]
forall a b. (a -> b) -> [a] -> [b]
map a -> ShowS
forall a. Show a => a -> ShowS
shows (Seq a -> [a]
forall a. Seq a -> [a]
toList Seq a
xs))) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Char -> ShowS
showChar '>'
#endif
data FingerTree a
= Empty
| Single a
| Deep {-# UNPACK #-} !Int !(Digit a) (FingerTree (Node a)) !(Digit a)
#if TESTING
deriving Show
#endif
instance Sized a => Sized (FingerTree a) where
size :: FingerTree a -> Int
size Empty = 0
size (Single x :: a
x) = a -> Int
forall a. Sized a => a -> Int
size a
x
size (Deep v :: Int
v _ _ _) = Int
v
instance Functor FingerTree where
fmap :: (a -> b) -> FingerTree a -> FingerTree b
fmap _ Empty = FingerTree b
forall a. FingerTree a
Empty
fmap f :: a -> b
f (Single x :: a
x) = b -> FingerTree b
forall a. a -> FingerTree a
Single (a -> b
f a
x)
fmap f :: a -> b
f (Deep v :: Int
v pr :: Digit a
pr m :: FingerTree (Node a)
m sf :: Digit a
sf) =
Int -> Digit b -> FingerTree (Node b) -> Digit b -> FingerTree b
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
v ((a -> b) -> Digit a -> Digit b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Digit a
pr) ((Node a -> Node b) -> FingerTree (Node a) -> FingerTree (Node b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> Node a -> Node b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) FingerTree (Node a)
m) ((a -> b) -> Digit a -> Digit b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Digit a
sf)
{-# INLINE deep #-}
deep :: Sized a => Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
deep :: Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
deep pr :: Digit a
pr m :: FingerTree (Node a)
m sf :: Digit a
sf = Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Digit a -> Int
forall a. Sized a => a -> Int
size Digit a
pr Int -> Int -> Int
forall a. Num a => a -> a -> a
+ FingerTree (Node a) -> Int
forall a. Sized a => a -> Int
size FingerTree (Node a)
m Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Digit a -> Int
forall a. Sized a => a -> Int
size Digit a
sf) Digit a
pr FingerTree (Node a)
m Digit a
sf
data Digit a
= One a
| Two a a
| Three a a a
| Four a a a a
#if TESTING
deriving Show
#endif
instance Functor Digit where
fmap :: (a -> b) -> Digit a -> Digit b
fmap f :: a -> b
f (One a :: a
a) = b -> Digit b
forall a. a -> Digit a
One (a -> b
f a
a)
fmap f :: a -> b
f (Two a :: a
a b :: a
b) = b -> b -> Digit b
forall a. a -> a -> Digit a
Two (a -> b
f a
a) (a -> b
f a
b)
fmap f :: a -> b
f (Three a :: a
a b :: a
b c :: a
c) = b -> b -> b -> Digit b
forall a. a -> a -> a -> Digit a
Three (a -> b
f a
a) (a -> b
f a
b) (a -> b
f a
c)
fmap f :: a -> b
f (Four a :: a
a b :: a
b c :: a
c d :: a
d) = b -> b -> b -> b -> Digit b
forall a. a -> a -> a -> a -> Digit a
Four (a -> b
f a
a) (a -> b
f a
b) (a -> b
f a
c) (a -> b
f a
d)
instance Sized a => Sized (Digit a) where
size :: Digit a -> Int
size xs :: Digit a
xs = (Int -> a -> Int) -> Int -> Digit a -> Int
forall a b. (a -> b -> a) -> a -> Digit b -> a
foldlDigit (\ i :: Int
i x :: a
x -> Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ a -> Int
forall a. Sized a => a -> Int
size a
x) 0 Digit a
xs
{-# SPECIALIZE digitToTree :: Digit (Elem a) -> FingerTree (Elem a) #-}
{-# SPECIALIZE digitToTree :: Digit (Node a) -> FingerTree (Node a) #-}
digitToTree :: Sized a => Digit a -> FingerTree a
digitToTree :: Digit a -> FingerTree a
digitToTree (One a :: a
a) = a -> FingerTree a
forall a. a -> FingerTree a
Single a
a
digitToTree (Two a :: a
a b :: a
b) = Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
forall a.
Sized a =>
Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
deep (a -> Digit a
forall a. a -> Digit a
One a
a) FingerTree (Node a)
forall a. FingerTree a
Empty (a -> Digit a
forall a. a -> Digit a
One a
b)
digitToTree (Three a :: a
a b :: a
b c :: a
c) = Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
forall a.
Sized a =>
Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
deep (a -> a -> Digit a
forall a. a -> a -> Digit a
Two a
a a
b) FingerTree (Node a)
forall a. FingerTree a
Empty (a -> Digit a
forall a. a -> Digit a
One a
c)
digitToTree (Four a :: a
a b :: a
b c :: a
c d :: a
d) = Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
forall a.
Sized a =>
Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
deep (a -> a -> Digit a
forall a. a -> a -> Digit a
Two a
a a
b) FingerTree (Node a)
forall a. FingerTree a
Empty (a -> a -> Digit a
forall a. a -> a -> Digit a
Two a
c a
d)
data Node a
= Node2 {-# UNPACK #-} !Int a a
| Node3 {-# UNPACK #-} !Int a a a
#if TESTING
deriving Show
#endif
instance Functor (Node) where
fmap :: (a -> b) -> Node a -> Node b
fmap f :: a -> b
f (Node2 v :: Int
v a :: a
a b :: a
b) = Int -> b -> b -> Node b
forall a. Int -> a -> a -> Node a
Node2 Int
v (a -> b
f a
a) (a -> b
f a
b)
fmap f :: a -> b
f (Node3 v :: Int
v a :: a
a b :: a
b c :: a
c) = Int -> b -> b -> b -> Node b
forall a. Int -> a -> a -> a -> Node a
Node3 Int
v (a -> b
f a
a) (a -> b
f a
b) (a -> b
f a
c)
instance Sized (Node a) where
size :: Node a -> Int
size (Node2 v :: Int
v _ _) = Int
v
size (Node3 v :: Int
v _ _ _) = Int
v
{-# INLINE node2 #-}
node2 :: Sized a => a -> a -> Node a
node2 :: a -> a -> Node a
node2 a :: a
a b :: a
b = Int -> a -> a -> Node a
forall a. Int -> a -> a -> Node a
Node2 (a -> Int
forall a. Sized a => a -> Int
size a
a Int -> Int -> Int
forall a. Num a => a -> a -> a
+ a -> Int
forall a. Sized a => a -> Int
size a
b) a
a a
b
{-# INLINE node3 #-}
node3 :: Sized a => a -> a -> a -> Node a
node3 :: a -> a -> a -> Node a
node3 a :: a
a b :: a
b c :: a
c = Int -> a -> a -> a -> Node a
forall a. Int -> a -> a -> a -> Node a
Node3 (a -> Int
forall a. Sized a => a -> Int
size a
a Int -> Int -> Int
forall a. Num a => a -> a -> a
+ a -> Int
forall a. Sized a => a -> Int
size a
b Int -> Int -> Int
forall a. Num a => a -> a -> a
+ a -> Int
forall a. Sized a => a -> Int
size a
c) a
a a
b a
c
nodeToDigit :: Node a -> Digit a
nodeToDigit :: Node a -> Digit a
nodeToDigit (Node2 _ a :: a
a b :: a
b) = a -> a -> Digit a
forall a. a -> a -> Digit a
Two a
a a
b
nodeToDigit (Node3 _ a :: a
a b :: a
b c :: a
c) = a -> a -> a -> Digit a
forall a. a -> a -> a -> Digit a
Three a
a a
b a
c
newtype Elem a = Elem { Elem a -> a
getElem :: a }
instance Sized (Elem a) where
size :: Elem a -> Int
size _ = 1
instance Functor Elem where
fmap :: (a -> b) -> Elem a -> Elem b
fmap f :: a -> b
f (Elem x :: a
x) = b -> Elem b
forall a. a -> Elem a
Elem (a -> b
f a
x)
#ifdef TESTING
instance (Show a) => Show (Elem a) where
showsPrec p (Elem x) = showsPrec p x
#endif
empty :: Seq a
empty :: Seq a
empty = FingerTree (Elem a) -> Seq a
forall a. FingerTree (Elem a) -> Seq a
Seq FingerTree (Elem a)
forall a. FingerTree a
Empty
singleton :: a -> Seq a
singleton :: a -> Seq a
singleton x :: a
x = FingerTree (Elem a) -> Seq a
forall a. FingerTree (Elem a) -> Seq a
Seq (Elem a -> FingerTree (Elem a)
forall a. a -> FingerTree a
Single (a -> Elem a
forall a. a -> Elem a
Elem a
x))
(<|) :: a -> Seq a -> Seq a
x :: a
x <| :: a -> Seq a -> Seq a
<| Seq xs :: FingerTree (Elem a)
xs = FingerTree (Elem a) -> Seq a
forall a. FingerTree (Elem a) -> Seq a
Seq (a -> Elem a
forall a. a -> Elem a
Elem a
x Elem a -> FingerTree (Elem a) -> FingerTree (Elem a)
forall a. Sized a => a -> FingerTree a -> FingerTree a
`consTree` FingerTree (Elem a)
xs)
{-# SPECIALIZE consTree :: Elem a -> FingerTree (Elem a) -> FingerTree (Elem a) #-}
{-# SPECIALIZE consTree :: Node a -> FingerTree (Node a) -> FingerTree (Node a) #-}
consTree :: Sized a => a -> FingerTree a -> FingerTree a
consTree :: a -> FingerTree a -> FingerTree a
consTree a :: a
a Empty = a -> FingerTree a
forall a. a -> FingerTree a
Single a
a
consTree a :: a
a (Single b :: a
b) = Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
forall a.
Sized a =>
Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
deep (a -> Digit a
forall a. a -> Digit a
One a
a) FingerTree (Node a)
forall a. FingerTree a
Empty (a -> Digit a
forall a. a -> Digit a
One a
b)
consTree a :: a
a (Deep s :: Int
s (Four b :: a
b c :: a
c d :: a
d e :: a
e) m :: FingerTree (Node a)
m sf :: Digit a
sf) = FingerTree (Node a)
m FingerTree (Node a) -> FingerTree a -> FingerTree a
forall a b. a -> b -> b
`seq`
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (a -> Int
forall a. Sized a => a -> Int
size a
a Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
s) (a -> a -> Digit a
forall a. a -> a -> Digit a
Two a
a a
b) (a -> a -> a -> Node a
forall a. Sized a => a -> a -> a -> Node a
node3 a
c a
d a
e Node a -> FingerTree (Node a) -> FingerTree (Node a)
forall a. Sized a => a -> FingerTree a -> FingerTree a
`consTree` FingerTree (Node a)
m) Digit a
sf
consTree a :: a
a (Deep s :: Int
s (Three b :: a
b c :: a
c d :: a
d) m :: FingerTree (Node a)
m sf :: Digit a
sf) =
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (a -> Int
forall a. Sized a => a -> Int
size a
a Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
s) (a -> a -> a -> a -> Digit a
forall a. a -> a -> a -> a -> Digit a
Four a
a a
b a
c a
d) FingerTree (Node a)
m Digit a
sf
consTree a :: a
a (Deep s :: Int
s (Two b :: a
b c :: a
c) m :: FingerTree (Node a)
m sf :: Digit a
sf) =
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (a -> Int
forall a. Sized a => a -> Int
size a
a Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
s) (a -> a -> a -> Digit a
forall a. a -> a -> a -> Digit a
Three a
a a
b a
c) FingerTree (Node a)
m Digit a
sf
consTree a :: a
a (Deep s :: Int
s (One b :: a
b) m :: FingerTree (Node a)
m sf :: Digit a
sf) =
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (a -> Int
forall a. Sized a => a -> Int
size a
a Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
s) (a -> a -> Digit a
forall a. a -> a -> Digit a
Two a
a a
b) FingerTree (Node a)
m Digit a
sf
(|>) :: Seq a -> a -> Seq a
Seq xs :: FingerTree (Elem a)
xs |> :: Seq a -> a -> Seq a
|> x :: a
x = FingerTree (Elem a) -> Seq a
forall a. FingerTree (Elem a) -> Seq a
Seq (FingerTree (Elem a)
xs FingerTree (Elem a) -> Elem a -> FingerTree (Elem a)
forall a. Sized a => FingerTree a -> a -> FingerTree a
`snocTree` a -> Elem a
forall a. a -> Elem a
Elem a
x)
{-# SPECIALIZE snocTree :: FingerTree (Elem a) -> Elem a -> FingerTree (Elem a) #-}
{-# SPECIALIZE snocTree :: FingerTree (Node a) -> Node a -> FingerTree (Node a) #-}
snocTree :: Sized a => FingerTree a -> a -> FingerTree a
snocTree :: FingerTree a -> a -> FingerTree a
snocTree Empty a :: a
a = a -> FingerTree a
forall a. a -> FingerTree a
Single a
a
snocTree (Single a :: a
a) b :: a
b = Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
forall a.
Sized a =>
Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
deep (a -> Digit a
forall a. a -> Digit a
One a
a) FingerTree (Node a)
forall a. FingerTree a
Empty (a -> Digit a
forall a. a -> Digit a
One a
b)
snocTree (Deep s :: Int
s pr :: Digit a
pr m :: FingerTree (Node a)
m (Four a :: a
a b :: a
b c :: a
c d :: a
d)) e :: a
e = FingerTree (Node a)
m FingerTree (Node a) -> FingerTree a -> FingerTree a
forall a b. a -> b -> b
`seq`
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
+ a -> Int
forall a. Sized a => a -> Int
size a
e) Digit a
pr (FingerTree (Node a)
m FingerTree (Node a) -> Node a -> FingerTree (Node a)
forall a. Sized a => FingerTree a -> a -> FingerTree a
`snocTree` a -> a -> a -> Node a
forall a. Sized a => a -> a -> a -> Node a
node3 a
a a
b a
c) (a -> a -> Digit a
forall a. a -> a -> Digit a
Two a
d a
e)
snocTree (Deep s :: Int
s pr :: Digit a
pr m :: FingerTree (Node a)
m (Three a :: a
a b :: a
b c :: a
c)) d :: a
d =
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
+ a -> Int
forall a. Sized a => a -> Int
size a
d) Digit a
pr FingerTree (Node a)
m (a -> a -> a -> a -> Digit a
forall a. a -> a -> a -> a -> Digit a
Four a
a a
b a
c a
d)
snocTree (Deep s :: Int
s pr :: Digit a
pr m :: FingerTree (Node a)
m (Two a :: a
a b :: a
b)) c :: a
c =
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
+ a -> Int
forall a. Sized a => a -> Int
size a
c) Digit a
pr FingerTree (Node a)
m (a -> a -> a -> Digit a
forall a. a -> a -> a -> Digit a
Three a
a a
b a
c)
snocTree (Deep s :: Int
s pr :: Digit a
pr m :: FingerTree (Node a)
m (One a :: a
a)) b :: a
b =
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
+ a -> Int
forall a. Sized a => a -> Int
size a
b) Digit a
pr FingerTree (Node a)
m (a -> a -> Digit a
forall a. a -> a -> Digit a
Two a
a a
b)
(><) :: Seq a -> Seq a -> Seq a
Seq xs :: FingerTree (Elem a)
xs >< :: Seq a -> Seq a -> Seq a
>< Seq ys :: FingerTree (Elem a)
ys = FingerTree (Elem a) -> Seq a
forall a. FingerTree (Elem a) -> Seq a
Seq (FingerTree (Elem a) -> FingerTree (Elem a) -> FingerTree (Elem a)
forall a.
FingerTree (Elem a) -> FingerTree (Elem a) -> FingerTree (Elem a)
appendTree0 FingerTree (Elem a)
xs FingerTree (Elem a)
ys)
appendTree0 :: FingerTree (Elem a) -> FingerTree (Elem a) -> FingerTree (Elem a)
appendTree0 :: FingerTree (Elem a) -> FingerTree (Elem a) -> FingerTree (Elem a)
appendTree0 Empty xs :: FingerTree (Elem a)
xs =
FingerTree (Elem a)
xs
appendTree0 xs :: FingerTree (Elem a)
xs Empty =
FingerTree (Elem a)
xs
appendTree0 (Single x :: Elem a
x) xs :: FingerTree (Elem a)
xs =
Elem a
x Elem a -> FingerTree (Elem a) -> FingerTree (Elem a)
forall a. Sized a => a -> FingerTree a -> FingerTree a
`consTree` FingerTree (Elem a)
xs
appendTree0 xs :: FingerTree (Elem a)
xs (Single x :: Elem a
x) =
FingerTree (Elem a)
xs FingerTree (Elem a) -> Elem a -> FingerTree (Elem a)
forall a. Sized a => FingerTree a -> a -> FingerTree a
`snocTree` Elem a
x
appendTree0 (Deep s1 :: Int
s1 pr1 :: Digit (Elem a)
pr1 m1 :: FingerTree (Node (Elem a))
m1 sf1 :: Digit (Elem a)
sf1) (Deep s2 :: Int
s2 pr2 :: Digit (Elem a)
pr2 m2 :: FingerTree (Node (Elem a))
m2 sf2 :: Digit (Elem a)
sf2) =
Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> FingerTree (Elem a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
s2) Digit (Elem a)
pr1 (FingerTree (Node (Elem a))
-> Digit (Elem a)
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> FingerTree (Node (Elem a))
forall a.
FingerTree (Node (Elem a))
-> Digit (Elem a)
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> FingerTree (Node (Elem a))
addDigits0 FingerTree (Node (Elem a))
m1 Digit (Elem a)
sf1 Digit (Elem a)
pr2 FingerTree (Node (Elem a))
m2) Digit (Elem a)
sf2
addDigits0 :: FingerTree (Node (Elem a)) -> Digit (Elem a) -> Digit (Elem a) -> FingerTree (Node (Elem a)) -> FingerTree (Node (Elem a))
addDigits0 :: FingerTree (Node (Elem a))
-> Digit (Elem a)
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> FingerTree (Node (Elem a))
addDigits0 m1 :: FingerTree (Node (Elem a))
m1 (One a :: Elem a
a) (One b :: Elem a
b) m2 :: FingerTree (Node (Elem a))
m2 =
FingerTree (Node (Elem a))
-> Node (Elem a)
-> FingerTree (Node (Elem a))
-> FingerTree (Node (Elem a))
forall a.
FingerTree (Node a)
-> Node a -> FingerTree (Node a) -> FingerTree (Node a)
appendTree1 FingerTree (Node (Elem a))
m1 (Elem a -> Elem a -> Node (Elem a)
forall a. Sized a => a -> a -> Node a
node2 Elem a
a Elem a
b) FingerTree (Node (Elem a))
m2
addDigits0 m1 :: FingerTree (Node (Elem a))
m1 (One a :: Elem a
a) (Two b :: Elem a
b c :: Elem a
c) m2 :: FingerTree (Node (Elem a))
m2 =
FingerTree (Node (Elem a))
-> Node (Elem a)
-> FingerTree (Node (Elem a))
-> FingerTree (Node (Elem a))
forall a.
FingerTree (Node a)
-> Node a -> FingerTree (Node a) -> FingerTree (Node a)
appendTree1 FingerTree (Node (Elem a))
m1 (Elem a -> Elem a -> Elem a -> Node (Elem a)
forall a. Sized a => a -> a -> a -> Node a
node3 Elem a
a Elem a
b Elem a
c) FingerTree (Node (Elem a))
m2
addDigits0 m1 :: FingerTree (Node (Elem a))
m1 (One a :: Elem a
a) (Three b :: Elem a
b c :: Elem a
c d :: Elem a
d) m2 :: FingerTree (Node (Elem a))
m2 =
FingerTree (Node (Elem a))
-> Node (Elem a)
-> Node (Elem a)
-> FingerTree (Node (Elem a))
-> FingerTree (Node (Elem a))
forall a.
FingerTree (Node a)
-> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
appendTree2 FingerTree (Node (Elem a))
m1 (Elem a -> Elem a -> Node (Elem a)
forall a. Sized a => a -> a -> Node a
node2 Elem a
a Elem a
b) (Elem a -> Elem a -> Node (Elem a)
forall a. Sized a => a -> a -> Node a
node2 Elem a
c Elem a
d) FingerTree (Node (Elem a))
m2
addDigits0 m1 :: FingerTree (Node (Elem a))
m1 (One a :: Elem a
a) (Four b :: Elem a
b c :: Elem a
c d :: Elem a
d e :: Elem a
e) m2 :: FingerTree (Node (Elem a))
m2 =
FingerTree (Node (Elem a))
-> Node (Elem a)
-> Node (Elem a)
-> FingerTree (Node (Elem a))
-> FingerTree (Node (Elem a))
forall a.
FingerTree (Node a)
-> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
appendTree2 FingerTree (Node (Elem a))
m1 (Elem a -> Elem a -> Elem a -> Node (Elem a)
forall a. Sized a => a -> a -> a -> Node a
node3 Elem a
a Elem a
b Elem a
c) (Elem a -> Elem a -> Node (Elem a)
forall a. Sized a => a -> a -> Node a
node2 Elem a
d Elem a
e) FingerTree (Node (Elem a))
m2
addDigits0 m1 :: FingerTree (Node (Elem a))
m1 (Two a :: Elem a
a b :: Elem a
b) (One c :: Elem a
c) m2 :: FingerTree (Node (Elem a))
m2 =
FingerTree (Node (Elem a))
-> Node (Elem a)
-> FingerTree (Node (Elem a))
-> FingerTree (Node (Elem a))
forall a.
FingerTree (Node a)
-> Node a -> FingerTree (Node a) -> FingerTree (Node a)
appendTree1 FingerTree (Node (Elem a))
m1 (Elem a -> Elem a -> Elem a -> Node (Elem a)
forall a. Sized a => a -> a -> a -> Node a
node3 Elem a
a Elem a
b Elem a
c) FingerTree (Node (Elem a))
m2
addDigits0 m1 :: FingerTree (Node (Elem a))
m1 (Two a :: Elem a
a b :: Elem a
b) (Two c :: Elem a
c d :: Elem a
d) m2 :: FingerTree (Node (Elem a))
m2 =
FingerTree (Node (Elem a))
-> Node (Elem a)
-> Node (Elem a)
-> FingerTree (Node (Elem a))
-> FingerTree (Node (Elem a))
forall a.
FingerTree (Node a)
-> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
appendTree2 FingerTree (Node (Elem a))
m1 (Elem a -> Elem a -> Node (Elem a)
forall a. Sized a => a -> a -> Node a
node2 Elem a
a Elem a
b) (Elem a -> Elem a -> Node (Elem a)
forall a. Sized a => a -> a -> Node a
node2 Elem a
c Elem a
d) FingerTree (Node (Elem a))
m2
addDigits0 m1 :: FingerTree (Node (Elem a))
m1 (Two a :: Elem a
a b :: Elem a
b) (Three c :: Elem a
c d :: Elem a
d e :: Elem a
e) m2 :: FingerTree (Node (Elem a))
m2 =
FingerTree (Node (Elem a))
-> Node (Elem a)
-> Node (Elem a)
-> FingerTree (Node (Elem a))
-> FingerTree (Node (Elem a))
forall a.
FingerTree (Node a)
-> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
appendTree2 FingerTree (Node (Elem a))
m1 (Elem a -> Elem a -> Elem a -> Node (Elem a)
forall a. Sized a => a -> a -> a -> Node a
node3 Elem a
a Elem a
b Elem a
c) (Elem a -> Elem a -> Node (Elem a)
forall a. Sized a => a -> a -> Node a
node2 Elem a
d Elem a
e) FingerTree (Node (Elem a))
m2
addDigits0 m1 :: FingerTree (Node (Elem a))
m1 (Two a :: Elem a
a b :: Elem a
b) (Four c :: Elem a
c d :: Elem a
d e :: Elem a
e f :: Elem a
f) m2 :: FingerTree (Node (Elem a))
m2 =
FingerTree (Node (Elem a))
-> Node (Elem a)
-> Node (Elem a)
-> FingerTree (Node (Elem a))
-> FingerTree (Node (Elem a))
forall a.
FingerTree (Node a)
-> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
appendTree2 FingerTree (Node (Elem a))
m1 (Elem a -> Elem a -> Elem a -> Node (Elem a)
forall a. Sized a => a -> a -> a -> Node a
node3 Elem a
a Elem a
b Elem a
c) (Elem a -> Elem a -> Elem a -> Node (Elem a)
forall a. Sized a => a -> a -> a -> Node a
node3 Elem a
d Elem a
e Elem a
f) FingerTree (Node (Elem a))
m2
addDigits0 m1 :: FingerTree (Node (Elem a))
m1 (Three a :: Elem a
a b :: Elem a
b c :: Elem a
c) (One d :: Elem a
d) m2 :: FingerTree (Node (Elem a))
m2 =
FingerTree (Node (Elem a))
-> Node (Elem a)
-> Node (Elem a)
-> FingerTree (Node (Elem a))
-> FingerTree (Node (Elem a))
forall a.
FingerTree (Node a)
-> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
appendTree2 FingerTree (Node (Elem a))
m1 (Elem a -> Elem a -> Node (Elem a)
forall a. Sized a => a -> a -> Node a
node2 Elem a
a Elem a
b) (Elem a -> Elem a -> Node (Elem a)
forall a. Sized a => a -> a -> Node a
node2 Elem a
c Elem a
d) FingerTree (Node (Elem a))
m2
addDigits0 m1 :: FingerTree (Node (Elem a))
m1 (Three a :: Elem a
a b :: Elem a
b c :: Elem a
c) (Two d :: Elem a
d e :: Elem a
e) m2 :: FingerTree (Node (Elem a))
m2 =
FingerTree (Node (Elem a))
-> Node (Elem a)
-> Node (Elem a)
-> FingerTree (Node (Elem a))
-> FingerTree (Node (Elem a))
forall a.
FingerTree (Node a)
-> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
appendTree2 FingerTree (Node (Elem a))
m1 (Elem a -> Elem a -> Elem a -> Node (Elem a)
forall a. Sized a => a -> a -> a -> Node a
node3 Elem a
a Elem a
b Elem a
c) (Elem a -> Elem a -> Node (Elem a)
forall a. Sized a => a -> a -> Node a
node2 Elem a
d Elem a
e) FingerTree (Node (Elem a))
m2
addDigits0 m1 :: FingerTree (Node (Elem a))
m1 (Three a :: Elem a
a b :: Elem a
b c :: Elem a
c) (Three d :: Elem a
d e :: Elem a
e f :: Elem a
f) m2 :: FingerTree (Node (Elem a))
m2 =
FingerTree (Node (Elem a))
-> Node (Elem a)
-> Node (Elem a)
-> FingerTree (Node (Elem a))
-> FingerTree (Node (Elem a))
forall a.
FingerTree (Node a)
-> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
appendTree2 FingerTree (Node (Elem a))
m1 (Elem a -> Elem a -> Elem a -> Node (Elem a)
forall a. Sized a => a -> a -> a -> Node a
node3 Elem a
a Elem a
b Elem a
c) (Elem a -> Elem a -> Elem a -> Node (Elem a)
forall a. Sized a => a -> a -> a -> Node a
node3 Elem a
d Elem a
e Elem a
f) FingerTree (Node (Elem a))
m2
addDigits0 m1 :: FingerTree (Node (Elem a))
m1 (Three a :: Elem a
a b :: Elem a
b c :: Elem a
c) (Four d :: Elem a
d e :: Elem a
e f :: Elem a
f g :: Elem a
g) m2 :: FingerTree (Node (Elem a))
m2 =
FingerTree (Node (Elem a))
-> Node (Elem a)
-> Node (Elem a)
-> Node (Elem a)
-> FingerTree (Node (Elem a))
-> FingerTree (Node (Elem a))
forall a.
FingerTree (Node a)
-> Node a
-> Node a
-> Node a
-> FingerTree (Node a)
-> FingerTree (Node a)
appendTree3 FingerTree (Node (Elem a))
m1 (Elem a -> Elem a -> Elem a -> Node (Elem a)
forall a. Sized a => a -> a -> a -> Node a
node3 Elem a
a Elem a
b Elem a
c) (Elem a -> Elem a -> Node (Elem a)
forall a. Sized a => a -> a -> Node a
node2 Elem a
d Elem a
e) (Elem a -> Elem a -> Node (Elem a)
forall a. Sized a => a -> a -> Node a
node2 Elem a
f Elem a
g) FingerTree (Node (Elem a))
m2
addDigits0 m1 :: FingerTree (Node (Elem a))
m1 (Four a :: Elem a
a b :: Elem a
b c :: Elem a
c d :: Elem a
d) (One e :: Elem a
e) m2 :: FingerTree (Node (Elem a))
m2 =
FingerTree (Node (Elem a))
-> Node (Elem a)
-> Node (Elem a)
-> FingerTree (Node (Elem a))
-> FingerTree (Node (Elem a))
forall a.
FingerTree (Node a)
-> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
appendTree2 FingerTree (Node (Elem a))
m1 (Elem a -> Elem a -> Elem a -> Node (Elem a)
forall a. Sized a => a -> a -> a -> Node a
node3 Elem a
a Elem a
b Elem a
c) (Elem a -> Elem a -> Node (Elem a)
forall a. Sized a => a -> a -> Node a
node2 Elem a
d Elem a
e) FingerTree (Node (Elem a))
m2
addDigits0 m1 :: FingerTree (Node (Elem a))
m1 (Four a :: Elem a
a b :: Elem a
b c :: Elem a
c d :: Elem a
d) (Two e :: Elem a
e f :: Elem a
f) m2 :: FingerTree (Node (Elem a))
m2 =
FingerTree (Node (Elem a))
-> Node (Elem a)
-> Node (Elem a)
-> FingerTree (Node (Elem a))
-> FingerTree (Node (Elem a))
forall a.
FingerTree (Node a)
-> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
appendTree2 FingerTree (Node (Elem a))
m1 (Elem a -> Elem a -> Elem a -> Node (Elem a)
forall a. Sized a => a -> a -> a -> Node a
node3 Elem a
a Elem a
b Elem a
c) (Elem a -> Elem a -> Elem a -> Node (Elem a)
forall a. Sized a => a -> a -> a -> Node a
node3 Elem a
d Elem a
e Elem a
f) FingerTree (Node (Elem a))
m2
addDigits0 m1 :: FingerTree (Node (Elem a))
m1 (Four a :: Elem a
a b :: Elem a
b c :: Elem a
c d :: Elem a
d) (Three e :: Elem a
e f :: Elem a
f g :: Elem a
g) m2 :: FingerTree (Node (Elem a))
m2 =
FingerTree (Node (Elem a))
-> Node (Elem a)
-> Node (Elem a)
-> Node (Elem a)
-> FingerTree (Node (Elem a))
-> FingerTree (Node (Elem a))
forall a.
FingerTree (Node a)
-> Node a
-> Node a
-> Node a
-> FingerTree (Node a)
-> FingerTree (Node a)
appendTree3 FingerTree (Node (Elem a))
m1 (Elem a -> Elem a -> Elem a -> Node (Elem a)
forall a. Sized a => a -> a -> a -> Node a
node3 Elem a
a Elem a
b Elem a
c) (Elem a -> Elem a -> Node (Elem a)
forall a. Sized a => a -> a -> Node a
node2 Elem a
d Elem a
e) (Elem a -> Elem a -> Node (Elem a)
forall a. Sized a => a -> a -> Node a
node2 Elem a
f Elem a
g) FingerTree (Node (Elem a))
m2
addDigits0 m1 :: FingerTree (Node (Elem a))
m1 (Four a :: Elem a
a b :: Elem a
b c :: Elem a
c d :: Elem a
d) (Four e :: Elem a
e f :: Elem a
f g :: Elem a
g h :: Elem a
h) m2 :: FingerTree (Node (Elem a))
m2 =
FingerTree (Node (Elem a))
-> Node (Elem a)
-> Node (Elem a)
-> Node (Elem a)
-> FingerTree (Node (Elem a))
-> FingerTree (Node (Elem a))
forall a.
FingerTree (Node a)
-> Node a
-> Node a
-> Node a
-> FingerTree (Node a)
-> FingerTree (Node a)
appendTree3 FingerTree (Node (Elem a))
m1 (Elem a -> Elem a -> Elem a -> Node (Elem a)
forall a. Sized a => a -> a -> a -> Node a
node3 Elem a
a Elem a
b Elem a
c) (Elem a -> Elem a -> Elem a -> Node (Elem a)
forall a. Sized a => a -> a -> a -> Node a
node3 Elem a
d Elem a
e Elem a
f) (Elem a -> Elem a -> Node (Elem a)
forall a. Sized a => a -> a -> Node a
node2 Elem a
g Elem a
h) FingerTree (Node (Elem a))
m2
appendTree1 :: FingerTree (Node a) -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
appendTree1 :: FingerTree (Node a)
-> Node a -> FingerTree (Node a) -> FingerTree (Node a)
appendTree1 Empty a :: Node a
a xs :: FingerTree (Node a)
xs =
Node a
a Node a -> FingerTree (Node a) -> FingerTree (Node a)
forall a. Sized a => a -> FingerTree a -> FingerTree a
`consTree` FingerTree (Node a)
xs
appendTree1 xs :: FingerTree (Node a)
xs a :: Node a
a Empty =
FingerTree (Node a)
xs FingerTree (Node a) -> Node a -> FingerTree (Node a)
forall a. Sized a => FingerTree a -> a -> FingerTree a
`snocTree` Node a
a
appendTree1 (Single x :: Node a
x) a :: Node a
a xs :: FingerTree (Node a)
xs =
Node a
x Node a -> FingerTree (Node a) -> FingerTree (Node a)
forall a. Sized a => a -> FingerTree a -> FingerTree a
`consTree` Node a
a Node a -> FingerTree (Node a) -> FingerTree (Node a)
forall a. Sized a => a -> FingerTree a -> FingerTree a
`consTree` FingerTree (Node a)
xs
appendTree1 xs :: FingerTree (Node a)
xs a :: Node a
a (Single x :: Node a
x) =
FingerTree (Node a)
xs FingerTree (Node a) -> Node a -> FingerTree (Node a)
forall a. Sized a => FingerTree a -> a -> FingerTree a
`snocTree` Node a
a FingerTree (Node a) -> Node a -> FingerTree (Node a)
forall a. Sized a => FingerTree a -> a -> FingerTree a
`snocTree` Node a
x
appendTree1 (Deep s1 :: Int
s1 pr1 :: Digit (Node a)
pr1 m1 :: FingerTree (Node (Node a))
m1 sf1 :: Digit (Node a)
sf1) a :: Node a
a (Deep s2 :: Int
s2 pr2 :: Digit (Node a)
pr2 m2 :: FingerTree (Node (Node a))
m2 sf2 :: Digit (Node a)
sf2) =
Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> FingerTree (Node a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Node a -> Int
forall a. Sized a => a -> Int
size Node a
a Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
s2) Digit (Node a)
pr1 (FingerTree (Node (Node a))
-> Digit (Node a)
-> Node a
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
FingerTree (Node (Node a))
-> Digit (Node a)
-> Node a
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
addDigits1 FingerTree (Node (Node a))
m1 Digit (Node a)
sf1 Node a
a Digit (Node a)
pr2 FingerTree (Node (Node a))
m2) Digit (Node a)
sf2
addDigits1 :: FingerTree (Node (Node a)) -> Digit (Node a) -> Node a -> Digit (Node a) -> FingerTree (Node (Node a)) -> FingerTree (Node (Node a))
addDigits1 :: FingerTree (Node (Node a))
-> Digit (Node a)
-> Node a
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
addDigits1 m1 :: FingerTree (Node (Node a))
m1 (One a :: Node a
a) b :: Node a
b (One c :: Node a
c) m2 :: FingerTree (Node (Node a))
m2 =
FingerTree (Node (Node a))
-> Node (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
FingerTree (Node a)
-> Node a -> FingerTree (Node a) -> FingerTree (Node a)
appendTree1 FingerTree (Node (Node a))
m1 (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
node3 Node a
a Node a
b Node a
c) FingerTree (Node (Node a))
m2
addDigits1 m1 :: FingerTree (Node (Node a))
m1 (One a :: Node a
a) b :: Node a
b (Two c :: Node a
c d :: Node a
d) m2 :: FingerTree (Node (Node a))
m2 =
FingerTree (Node (Node a))
-> Node (Node a)
-> Node (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
FingerTree (Node a)
-> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
appendTree2 FingerTree (Node (Node a))
m1 (Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> Node a
node2 Node a
a Node a
b) (Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> Node a
node2 Node a
c Node a
d) FingerTree (Node (Node a))
m2
addDigits1 m1 :: FingerTree (Node (Node a))
m1 (One a :: Node a
a) b :: Node a
b (Three c :: Node a
c d :: Node a
d e :: Node a
e) m2 :: FingerTree (Node (Node a))
m2 =
FingerTree (Node (Node a))
-> Node (Node a)
-> Node (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
FingerTree (Node a)
-> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
appendTree2 FingerTree (Node (Node a))
m1 (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
node3 Node a
a Node a
b Node a
c) (Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> Node a
node2 Node a
d Node a
e) FingerTree (Node (Node a))
m2
addDigits1 m1 :: FingerTree (Node (Node a))
m1 (One a :: Node a
a) b :: Node a
b (Four c :: Node a
c d :: Node a
d e :: Node a
e f :: Node a
f) m2 :: FingerTree (Node (Node a))
m2 =
FingerTree (Node (Node a))
-> Node (Node a)
-> Node (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
FingerTree (Node a)
-> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
appendTree2 FingerTree (Node (Node a))
m1 (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
node3 Node a
a Node a
b Node a
c) (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
node3 Node a
d Node a
e Node a
f) FingerTree (Node (Node a))
m2
addDigits1 m1 :: FingerTree (Node (Node a))
m1 (Two a :: Node a
a b :: Node a
b) c :: Node a
c (One d :: Node a
d) m2 :: FingerTree (Node (Node a))
m2 =
FingerTree (Node (Node a))
-> Node (Node a)
-> Node (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
FingerTree (Node a)
-> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
appendTree2 FingerTree (Node (Node a))
m1 (Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> Node a
node2 Node a
a Node a
b) (Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> Node a
node2 Node a
c Node a
d) FingerTree (Node (Node a))
m2
addDigits1 m1 :: FingerTree (Node (Node a))
m1 (Two a :: Node a
a b :: Node a
b) c :: Node a
c (Two d :: Node a
d e :: Node a
e) m2 :: FingerTree (Node (Node a))
m2 =
FingerTree (Node (Node a))
-> Node (Node a)
-> Node (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
FingerTree (Node a)
-> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
appendTree2 FingerTree (Node (Node a))
m1 (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
node3 Node a
a Node a
b Node a
c) (Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> Node a
node2 Node a
d Node a
e) FingerTree (Node (Node a))
m2
addDigits1 m1 :: FingerTree (Node (Node a))
m1 (Two a :: Node a
a b :: Node a
b) c :: Node a
c (Three d :: Node a
d e :: Node a
e f :: Node a
f) m2 :: FingerTree (Node (Node a))
m2 =
FingerTree (Node (Node a))
-> Node (Node a)
-> Node (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
FingerTree (Node a)
-> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
appendTree2 FingerTree (Node (Node a))
m1 (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
node3 Node a
a Node a
b Node a
c) (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
node3 Node a
d Node a
e Node a
f) FingerTree (Node (Node a))
m2
addDigits1 m1 :: FingerTree (Node (Node a))
m1 (Two a :: Node a
a b :: Node a
b) c :: Node a
c (Four d :: Node a
d e :: Node a
e f :: Node a
f g :: Node a
g) m2 :: FingerTree (Node (Node a))
m2 =
FingerTree (Node (Node a))
-> Node (Node a)
-> Node (Node a)
-> Node (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
FingerTree (Node a)
-> Node a
-> Node a
-> Node a
-> FingerTree (Node a)
-> FingerTree (Node a)
appendTree3 FingerTree (Node (Node a))
m1 (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
node3 Node a
a Node a
b Node a
c) (Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> Node a
node2 Node a
d Node a
e) (Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> Node a
node2 Node a
f Node a
g) FingerTree (Node (Node a))
m2
addDigits1 m1 :: FingerTree (Node (Node a))
m1 (Three a :: Node a
a b :: Node a
b c :: Node a
c) d :: Node a
d (One e :: Node a
e) m2 :: FingerTree (Node (Node a))
m2 =
FingerTree (Node (Node a))
-> Node (Node a)
-> Node (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
FingerTree (Node a)
-> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
appendTree2 FingerTree (Node (Node a))
m1 (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
node3 Node a
a Node a
b Node a
c) (Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> Node a
node2 Node a
d Node a
e) FingerTree (Node (Node a))
m2
addDigits1 m1 :: FingerTree (Node (Node a))
m1 (Three a :: Node a
a b :: Node a
b c :: Node a
c) d :: Node a
d (Two e :: Node a
e f :: Node a
f) m2 :: FingerTree (Node (Node a))
m2 =
FingerTree (Node (Node a))
-> Node (Node a)
-> Node (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
FingerTree (Node a)
-> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
appendTree2 FingerTree (Node (Node a))
m1 (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
node3 Node a
a Node a
b Node a
c) (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
node3 Node a
d Node a
e Node a
f) FingerTree (Node (Node a))
m2
addDigits1 m1 :: FingerTree (Node (Node a))
m1 (Three a :: Node a
a b :: Node a
b c :: Node a
c) d :: Node a
d (Three e :: Node a
e f :: Node a
f g :: Node a
g) m2 :: FingerTree (Node (Node a))
m2 =
FingerTree (Node (Node a))
-> Node (Node a)
-> Node (Node a)
-> Node (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
FingerTree (Node a)
-> Node a
-> Node a
-> Node a
-> FingerTree (Node a)
-> FingerTree (Node a)
appendTree3 FingerTree (Node (Node a))
m1 (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
node3 Node a
a Node a
b Node a
c) (Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> Node a
node2 Node a
d Node a
e) (Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> Node a
node2 Node a
f Node a
g) FingerTree (Node (Node a))
m2
addDigits1 m1 :: FingerTree (Node (Node a))
m1 (Three a :: Node a
a b :: Node a
b c :: Node a
c) d :: Node a
d (Four e :: Node a
e f :: Node a
f g :: Node a
g h :: Node a
h) m2 :: FingerTree (Node (Node a))
m2 =
FingerTree (Node (Node a))
-> Node (Node a)
-> Node (Node a)
-> Node (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
FingerTree (Node a)
-> Node a
-> Node a
-> Node a
-> FingerTree (Node a)
-> FingerTree (Node a)
appendTree3 FingerTree (Node (Node a))
m1 (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
node3 Node a
a Node a
b Node a
c) (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
node3 Node a
d Node a
e Node a
f) (Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> Node a
node2 Node a
g Node a
h) FingerTree (Node (Node a))
m2
addDigits1 m1 :: FingerTree (Node (Node a))
m1 (Four a :: Node a
a b :: Node a
b c :: Node a
c d :: Node a
d) e :: Node a
e (One f :: Node a
f) m2 :: FingerTree (Node (Node a))
m2 =
FingerTree (Node (Node a))
-> Node (Node a)
-> Node (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
FingerTree (Node a)
-> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
appendTree2 FingerTree (Node (Node a))
m1 (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
node3 Node a
a Node a
b Node a
c) (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
node3 Node a
d Node a
e Node a
f) FingerTree (Node (Node a))
m2
addDigits1 m1 :: FingerTree (Node (Node a))
m1 (Four a :: Node a
a b :: Node a
b c :: Node a
c d :: Node a
d) e :: Node a
e (Two f :: Node a
f g :: Node a
g) m2 :: FingerTree (Node (Node a))
m2 =
FingerTree (Node (Node a))
-> Node (Node a)
-> Node (Node a)
-> Node (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
FingerTree (Node a)
-> Node a
-> Node a
-> Node a
-> FingerTree (Node a)
-> FingerTree (Node a)
appendTree3 FingerTree (Node (Node a))
m1 (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
node3 Node a
a Node a
b Node a
c) (Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> Node a
node2 Node a
d Node a
e) (Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> Node a
node2 Node a
f Node a
g) FingerTree (Node (Node a))
m2
addDigits1 m1 :: FingerTree (Node (Node a))
m1 (Four a :: Node a
a b :: Node a
b c :: Node a
c d :: Node a
d) e :: Node a
e (Three f :: Node a
f g :: Node a
g h :: Node a
h) m2 :: FingerTree (Node (Node a))
m2 =
FingerTree (Node (Node a))
-> Node (Node a)
-> Node (Node a)
-> Node (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
FingerTree (Node a)
-> Node a
-> Node a
-> Node a
-> FingerTree (Node a)
-> FingerTree (Node a)
appendTree3 FingerTree (Node (Node a))
m1 (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
node3 Node a
a Node a
b Node a
c) (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
node3 Node a
d Node a
e Node a
f) (Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> Node a
node2 Node a
g Node a
h) FingerTree (Node (Node a))
m2
addDigits1 m1 :: FingerTree (Node (Node a))
m1 (Four a :: Node a
a b :: Node a
b c :: Node a
c d :: Node a
d) e :: Node a
e (Four f :: Node a
f g :: Node a
g h :: Node a
h i :: Node a
i) m2 :: FingerTree (Node (Node a))
m2 =
FingerTree (Node (Node a))
-> Node (Node a)
-> Node (Node a)
-> Node (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
FingerTree (Node a)
-> Node a
-> Node a
-> Node a
-> FingerTree (Node a)
-> FingerTree (Node a)
appendTree3 FingerTree (Node (Node a))
m1 (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
node3 Node a
a Node a
b Node a
c) (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
node3 Node a
d Node a
e Node a
f) (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
node3 Node a
g Node a
h Node a
i) FingerTree (Node (Node a))
m2
appendTree2 :: FingerTree (Node a) -> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
appendTree2 :: FingerTree (Node a)
-> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
appendTree2 Empty a :: Node a
a b :: Node a
b xs :: FingerTree (Node a)
xs =
Node a
a Node a -> FingerTree (Node a) -> FingerTree (Node a)
forall a. Sized a => a -> FingerTree a -> FingerTree a
`consTree` Node a
b Node a -> FingerTree (Node a) -> FingerTree (Node a)
forall a. Sized a => a -> FingerTree a -> FingerTree a
`consTree` FingerTree (Node a)
xs
appendTree2 xs :: FingerTree (Node a)
xs a :: Node a
a b :: Node a
b Empty =
FingerTree (Node a)
xs FingerTree (Node a) -> Node a -> FingerTree (Node a)
forall a. Sized a => FingerTree a -> a -> FingerTree a
`snocTree` Node a
a FingerTree (Node a) -> Node a -> FingerTree (Node a)
forall a. Sized a => FingerTree a -> a -> FingerTree a
`snocTree` Node a
b
appendTree2 (Single x :: Node a
x) a :: Node a
a b :: Node a
b xs :: FingerTree (Node a)
xs =
Node a
x Node a -> FingerTree (Node a) -> FingerTree (Node a)
forall a. Sized a => a -> FingerTree a -> FingerTree a
`consTree` Node a
a Node a -> FingerTree (Node a) -> FingerTree (Node a)
forall a. Sized a => a -> FingerTree a -> FingerTree a
`consTree` Node a
b Node a -> FingerTree (Node a) -> FingerTree (Node a)
forall a. Sized a => a -> FingerTree a -> FingerTree a
`consTree` FingerTree (Node a)
xs
appendTree2 xs :: FingerTree (Node a)
xs a :: Node a
a b :: Node a
b (Single x :: Node a
x) =
FingerTree (Node a)
xs FingerTree (Node a) -> Node a -> FingerTree (Node a)
forall a. Sized a => FingerTree a -> a -> FingerTree a
`snocTree` Node a
a FingerTree (Node a) -> Node a -> FingerTree (Node a)
forall a. Sized a => FingerTree a -> a -> FingerTree a
`snocTree` Node a
b FingerTree (Node a) -> Node a -> FingerTree (Node a)
forall a. Sized a => FingerTree a -> a -> FingerTree a
`snocTree` Node a
x
appendTree2 (Deep s1 :: Int
s1 pr1 :: Digit (Node a)
pr1 m1 :: FingerTree (Node (Node a))
m1 sf1 :: Digit (Node a)
sf1) a :: Node a
a b :: Node a
b (Deep s2 :: Int
s2 pr2 :: Digit (Node a)
pr2 m2 :: FingerTree (Node (Node a))
m2 sf2 :: Digit (Node a)
sf2) =
Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> FingerTree (Node a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Node a -> Int
forall a. Sized a => a -> Int
size Node a
a Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Node a -> Int
forall a. Sized a => a -> Int
size Node a
b Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
s2) Digit (Node a)
pr1 (FingerTree (Node (Node a))
-> Digit (Node a)
-> Node a
-> Node a
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
FingerTree (Node (Node a))
-> Digit (Node a)
-> Node a
-> Node a
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
addDigits2 FingerTree (Node (Node a))
m1 Digit (Node a)
sf1 Node a
a Node a
b Digit (Node a)
pr2 FingerTree (Node (Node a))
m2) Digit (Node a)
sf2
addDigits2 :: FingerTree (Node (Node a)) -> Digit (Node a) -> Node a -> Node a -> Digit (Node a) -> FingerTree (Node (Node a)) -> FingerTree (Node (Node a))
addDigits2 :: FingerTree (Node (Node a))
-> Digit (Node a)
-> Node a
-> Node a
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
addDigits2 m1 :: FingerTree (Node (Node a))
m1 (One a :: Node a
a) b :: Node a
b c :: Node a
c (One d :: Node a
d) m2 :: FingerTree (Node (Node a))
m2 =
FingerTree (Node (Node a))
-> Node (Node a)
-> Node (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
FingerTree (Node a)
-> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
appendTree2 FingerTree (Node (Node a))
m1 (Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> Node a
node2 Node a
a Node a
b) (Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> Node a
node2 Node a
c Node a
d) FingerTree (Node (Node a))
m2
addDigits2 m1 :: FingerTree (Node (Node a))
m1 (One a :: Node a
a) b :: Node a
b c :: Node a
c (Two d :: Node a
d e :: Node a
e) m2 :: FingerTree (Node (Node a))
m2 =
FingerTree (Node (Node a))
-> Node (Node a)
-> Node (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
FingerTree (Node a)
-> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
appendTree2 FingerTree (Node (Node a))
m1 (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
node3 Node a
a Node a
b Node a
c) (Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> Node a
node2 Node a
d Node a
e) FingerTree (Node (Node a))
m2
addDigits2 m1 :: FingerTree (Node (Node a))
m1 (One a :: Node a
a) b :: Node a
b c :: Node a
c (Three d :: Node a
d e :: Node a
e f :: Node a
f) m2 :: FingerTree (Node (Node a))
m2 =
FingerTree (Node (Node a))
-> Node (Node a)
-> Node (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
FingerTree (Node a)
-> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
appendTree2 FingerTree (Node (Node a))
m1 (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
node3 Node a
a Node a
b Node a
c) (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
node3 Node a
d Node a
e Node a
f) FingerTree (Node (Node a))
m2
addDigits2 m1 :: FingerTree (Node (Node a))
m1 (One a :: Node a
a) b :: Node a
b c :: Node a
c (Four d :: Node a
d e :: Node a
e f :: Node a
f g :: Node a
g) m2 :: FingerTree (Node (Node a))
m2 =
FingerTree (Node (Node a))
-> Node (Node a)
-> Node (Node a)
-> Node (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
FingerTree (Node a)
-> Node a
-> Node a
-> Node a
-> FingerTree (Node a)
-> FingerTree (Node a)
appendTree3 FingerTree (Node (Node a))
m1 (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
node3 Node a
a Node a
b Node a
c) (Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> Node a
node2 Node a
d Node a
e) (Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> Node a
node2 Node a
f Node a
g) FingerTree (Node (Node a))
m2
addDigits2 m1 :: FingerTree (Node (Node a))
m1 (Two a :: Node a
a b :: Node a
b) c :: Node a
c d :: Node a
d (One e :: Node a
e) m2 :: FingerTree (Node (Node a))
m2 =
FingerTree (Node (Node a))
-> Node (Node a)
-> Node (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
FingerTree (Node a)
-> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
appendTree2 FingerTree (Node (Node a))
m1 (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
node3 Node a
a Node a
b Node a
c) (Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> Node a
node2 Node a
d Node a
e) FingerTree (Node (Node a))
m2
addDigits2 m1 :: FingerTree (Node (Node a))
m1 (Two a :: Node a
a b :: Node a
b) c :: Node a
c d :: Node a
d (Two e :: Node a
e f :: Node a
f) m2 :: FingerTree (Node (Node a))
m2 =
FingerTree (Node (Node a))
-> Node (Node a)
-> Node (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
FingerTree (Node a)
-> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
appendTree2 FingerTree (Node (Node a))
m1 (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
node3 Node a
a Node a
b Node a
c) (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
node3 Node a
d Node a
e Node a
f) FingerTree (Node (Node a))
m2
addDigits2 m1 :: FingerTree (Node (Node a))
m1 (Two a :: Node a
a b :: Node a
b) c :: Node a
c d :: Node a
d (Three e :: Node a
e f :: Node a
f g :: Node a
g) m2 :: FingerTree (Node (Node a))
m2 =
FingerTree (Node (Node a))
-> Node (Node a)
-> Node (Node a)
-> Node (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
FingerTree (Node a)
-> Node a
-> Node a
-> Node a
-> FingerTree (Node a)
-> FingerTree (Node a)
appendTree3 FingerTree (Node (Node a))
m1 (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
node3 Node a
a Node a
b Node a
c) (Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> Node a
node2 Node a
d Node a
e) (Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> Node a
node2 Node a
f Node a
g) FingerTree (Node (Node a))
m2
addDigits2 m1 :: FingerTree (Node (Node a))
m1 (Two a :: Node a
a b :: Node a
b) c :: Node a
c d :: Node a
d (Four e :: Node a
e f :: Node a
f g :: Node a
g h :: Node a
h) m2 :: FingerTree (Node (Node a))
m2 =
FingerTree (Node (Node a))
-> Node (Node a)
-> Node (Node a)
-> Node (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
FingerTree (Node a)
-> Node a
-> Node a
-> Node a
-> FingerTree (Node a)
-> FingerTree (Node a)
appendTree3 FingerTree (Node (Node a))
m1 (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
node3 Node a
a Node a
b Node a
c) (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
node3 Node a
d Node a
e Node a
f) (Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> Node a
node2 Node a
g Node a
h) FingerTree (Node (Node a))
m2
addDigits2 m1 :: FingerTree (Node (Node a))
m1 (Three a :: Node a
a b :: Node a
b c :: Node a
c) d :: Node a
d e :: Node a
e (One f :: Node a
f) m2 :: FingerTree (Node (Node a))
m2 =
FingerTree (Node (Node a))
-> Node (Node a)
-> Node (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
FingerTree (Node a)
-> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
appendTree2 FingerTree (Node (Node a))
m1 (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
node3 Node a
a Node a
b Node a
c) (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
node3 Node a
d Node a
e Node a
f) FingerTree (Node (Node a))
m2
addDigits2 m1 :: FingerTree (Node (Node a))
m1 (Three a :: Node a
a b :: Node a
b c :: Node a
c) d :: Node a
d e :: Node a
e (Two f :: Node a
f g :: Node a
g) m2 :: FingerTree (Node (Node a))
m2 =
FingerTree (Node (Node a))
-> Node (Node a)
-> Node (Node a)
-> Node (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
FingerTree (Node a)
-> Node a
-> Node a
-> Node a
-> FingerTree (Node a)
-> FingerTree (Node a)
appendTree3 FingerTree (Node (Node a))
m1 (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
node3 Node a
a Node a
b Node a
c) (Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> Node a
node2 Node a
d Node a
e) (Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> Node a
node2 Node a
f Node a
g) FingerTree (Node (Node a))
m2
addDigits2 m1 :: FingerTree (Node (Node a))
m1 (Three a :: Node a
a b :: Node a
b c :: Node a
c) d :: Node a
d e :: Node a
e (Three f :: Node a
f g :: Node a
g h :: Node a
h) m2 :: FingerTree (Node (Node a))
m2 =
FingerTree (Node (Node a))
-> Node (Node a)
-> Node (Node a)
-> Node (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
FingerTree (Node a)
-> Node a
-> Node a
-> Node a
-> FingerTree (Node a)
-> FingerTree (Node a)
appendTree3 FingerTree (Node (Node a))
m1 (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
node3 Node a
a Node a
b Node a
c) (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
node3 Node a
d Node a
e Node a
f) (Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> Node a
node2 Node a
g Node a
h) FingerTree (Node (Node a))
m2
addDigits2 m1 :: FingerTree (Node (Node a))
m1 (Three a :: Node a
a b :: Node a
b c :: Node a
c) d :: Node a
d e :: Node a
e (Four f :: Node a
f g :: Node a
g h :: Node a
h i :: Node a
i) m2 :: FingerTree (Node (Node a))
m2 =
FingerTree (Node (Node a))
-> Node (Node a)
-> Node (Node a)
-> Node (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
FingerTree (Node a)
-> Node a
-> Node a
-> Node a
-> FingerTree (Node a)
-> FingerTree (Node a)
appendTree3 FingerTree (Node (Node a))
m1 (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
node3 Node a
a Node a
b Node a
c) (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
node3 Node a
d Node a
e Node a
f) (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
node3 Node a
g Node a
h Node a
i) FingerTree (Node (Node a))
m2
addDigits2 m1 :: FingerTree (Node (Node a))
m1 (Four a :: Node a
a b :: Node a
b c :: Node a
c d :: Node a
d) e :: Node a
e f :: Node a
f (One g :: Node a
g) m2 :: FingerTree (Node (Node a))
m2 =
FingerTree (Node (Node a))
-> Node (Node a)
-> Node (Node a)
-> Node (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
FingerTree (Node a)
-> Node a
-> Node a
-> Node a
-> FingerTree (Node a)
-> FingerTree (Node a)
appendTree3 FingerTree (Node (Node a))
m1 (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
node3 Node a
a Node a
b Node a
c) (Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> Node a
node2 Node a
d Node a
e) (Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> Node a
node2 Node a
f Node a
g) FingerTree (Node (Node a))
m2
addDigits2 m1 :: FingerTree (Node (Node a))
m1 (Four a :: Node a
a b :: Node a
b c :: Node a
c d :: Node a
d) e :: Node a
e f :: Node a
f (Two g :: Node a
g h :: Node a
h) m2 :: FingerTree (Node (Node a))
m2 =
FingerTree (Node (Node a))
-> Node (Node a)
-> Node (Node a)
-> Node (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
FingerTree (Node a)
-> Node a
-> Node a
-> Node a
-> FingerTree (Node a)
-> FingerTree (Node a)
appendTree3 FingerTree (Node (Node a))
m1 (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
node3 Node a
a Node a
b Node a
c) (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
node3 Node a
d Node a
e Node a
f) (Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> Node a
node2 Node a
g Node a
h) FingerTree (Node (Node a))
m2
addDigits2 m1 :: FingerTree (Node (Node a))
m1 (Four a :: Node a
a b :: Node a
b c :: Node a
c d :: Node a
d) e :: Node a
e f :: Node a
f (Three g :: Node a
g h :: Node a
h i :: Node a
i) m2 :: FingerTree (Node (Node a))
m2 =
FingerTree (Node (Node a))
-> Node (Node a)
-> Node (Node a)
-> Node (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
FingerTree (Node a)
-> Node a
-> Node a
-> Node a
-> FingerTree (Node a)
-> FingerTree (Node a)
appendTree3 FingerTree (Node (Node a))
m1 (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
node3 Node a
a Node a
b Node a
c) (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
node3 Node a
d Node a
e Node a
f) (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
node3 Node a
g Node a
h Node a
i) FingerTree (Node (Node a))
m2
addDigits2 m1 :: FingerTree (Node (Node a))
m1 (Four a :: Node a
a b :: Node a
b c :: Node a
c d :: Node a
d) e :: Node a
e f :: Node a
f (Four g :: Node a
g h :: Node a
h i :: Node a
i j :: Node a
j) m2 :: FingerTree (Node (Node a))
m2 =
FingerTree (Node (Node a))
-> Node (Node a)
-> Node (Node a)
-> Node (Node a)
-> Node (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
FingerTree (Node a)
-> Node a
-> Node a
-> Node a
-> Node a
-> FingerTree (Node a)
-> FingerTree (Node a)
appendTree4 FingerTree (Node (Node a))
m1 (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
node3 Node a
a Node a
b Node a
c) (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
node3 Node a
d Node a
e Node a
f) (Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> Node a
node2 Node a
g Node a
h) (Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> Node a
node2 Node a
i Node a
j) FingerTree (Node (Node a))
m2
appendTree3 :: FingerTree (Node a) -> Node a -> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
appendTree3 :: FingerTree (Node a)
-> Node a
-> Node a
-> Node a
-> FingerTree (Node a)
-> FingerTree (Node a)
appendTree3 Empty a :: Node a
a b :: Node a
b c :: Node a
c xs :: FingerTree (Node a)
xs =
Node a
a Node a -> FingerTree (Node a) -> FingerTree (Node a)
forall a. Sized a => a -> FingerTree a -> FingerTree a
`consTree` Node a
b Node a -> FingerTree (Node a) -> FingerTree (Node a)
forall a. Sized a => a -> FingerTree a -> FingerTree a
`consTree` Node a
c Node a -> FingerTree (Node a) -> FingerTree (Node a)
forall a. Sized a => a -> FingerTree a -> FingerTree a
`consTree` FingerTree (Node a)
xs
appendTree3 xs :: FingerTree (Node a)
xs a :: Node a
a b :: Node a
b c :: Node a
c Empty =
FingerTree (Node a)
xs FingerTree (Node a) -> Node a -> FingerTree (Node a)
forall a. Sized a => FingerTree a -> a -> FingerTree a
`snocTree` Node a
a FingerTree (Node a) -> Node a -> FingerTree (Node a)
forall a. Sized a => FingerTree a -> a -> FingerTree a
`snocTree` Node a
b FingerTree (Node a) -> Node a -> FingerTree (Node a)
forall a. Sized a => FingerTree a -> a -> FingerTree a
`snocTree` Node a
c
appendTree3 (Single x :: Node a
x) a :: Node a
a b :: Node a
b c :: Node a
c xs :: FingerTree (Node a)
xs =
Node a
x Node a -> FingerTree (Node a) -> FingerTree (Node a)
forall a. Sized a => a -> FingerTree a -> FingerTree a
`consTree` Node a
a Node a -> FingerTree (Node a) -> FingerTree (Node a)
forall a. Sized a => a -> FingerTree a -> FingerTree a
`consTree` Node a
b Node a -> FingerTree (Node a) -> FingerTree (Node a)
forall a. Sized a => a -> FingerTree a -> FingerTree a
`consTree` Node a
c Node a -> FingerTree (Node a) -> FingerTree (Node a)
forall a. Sized a => a -> FingerTree a -> FingerTree a
`consTree` FingerTree (Node a)
xs
appendTree3 xs :: FingerTree (Node a)
xs a :: Node a
a b :: Node a
b c :: Node a
c (Single x :: Node a
x) =
FingerTree (Node a)
xs FingerTree (Node a) -> Node a -> FingerTree (Node a)
forall a. Sized a => FingerTree a -> a -> FingerTree a
`snocTree` Node a
a FingerTree (Node a) -> Node a -> FingerTree (Node a)
forall a. Sized a => FingerTree a -> a -> FingerTree a
`snocTree` Node a
b FingerTree (Node a) -> Node a -> FingerTree (Node a)
forall a. Sized a => FingerTree a -> a -> FingerTree a
`snocTree` Node a
c FingerTree (Node a) -> Node a -> FingerTree (Node a)
forall a. Sized a => FingerTree a -> a -> FingerTree a
`snocTree` Node a
x
appendTree3 (Deep s1 :: Int
s1 pr1 :: Digit (Node a)
pr1 m1 :: FingerTree (Node (Node a))
m1 sf1 :: Digit (Node a)
sf1) a :: Node a
a b :: Node a
b c :: Node a
c (Deep s2 :: Int
s2 pr2 :: Digit (Node a)
pr2 m2 :: FingerTree (Node (Node a))
m2 sf2 :: Digit (Node a)
sf2) =
Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> FingerTree (Node a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Node a -> Int
forall a. Sized a => a -> Int
size Node a
a Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Node a -> Int
forall a. Sized a => a -> Int
size Node a
b Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Node a -> Int
forall a. Sized a => a -> Int
size Node a
c Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
s2) Digit (Node a)
pr1 (FingerTree (Node (Node a))
-> Digit (Node a)
-> Node a
-> Node a
-> Node a
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
FingerTree (Node (Node a))
-> Digit (Node a)
-> Node a
-> Node a
-> Node a
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
addDigits3 FingerTree (Node (Node a))
m1 Digit (Node a)
sf1 Node a
a Node a
b Node a
c Digit (Node a)
pr2 FingerTree (Node (Node a))
m2) Digit (Node a)
sf2
addDigits3 :: FingerTree (Node (Node a)) -> Digit (Node a) -> Node a -> Node a -> Node a -> Digit (Node a) -> FingerTree (Node (Node a)) -> FingerTree (Node (Node a))
addDigits3 :: FingerTree (Node (Node a))
-> Digit (Node a)
-> Node a
-> Node a
-> Node a
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
addDigits3 m1 :: FingerTree (Node (Node a))
m1 (One a :: Node a
a) b :: Node a
b c :: Node a
c d :: Node a
d (One e :: Node a
e) m2 :: FingerTree (Node (Node a))
m2 =
FingerTree (Node (Node a))
-> Node (Node a)
-> Node (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
FingerTree (Node a)
-> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
appendTree2 FingerTree (Node (Node a))
m1 (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
node3 Node a
a Node a
b Node a
c) (Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> Node a
node2 Node a
d Node a
e) FingerTree (Node (Node a))
m2
addDigits3 m1 :: FingerTree (Node (Node a))
m1 (One a :: Node a
a) b :: Node a
b c :: Node a
c d :: Node a
d (Two e :: Node a
e f :: Node a
f) m2 :: FingerTree (Node (Node a))
m2 =
FingerTree (Node (Node a))
-> Node (Node a)
-> Node (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
FingerTree (Node a)
-> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
appendTree2 FingerTree (Node (Node a))
m1 (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
node3 Node a
a Node a
b Node a
c) (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
node3 Node a
d Node a
e Node a
f) FingerTree (Node (Node a))
m2
addDigits3 m1 :: FingerTree (Node (Node a))
m1 (One a :: Node a
a) b :: Node a
b c :: Node a
c d :: Node a
d (Three e :: Node a
e f :: Node a
f g :: Node a
g) m2 :: FingerTree (Node (Node a))
m2 =
FingerTree (Node (Node a))
-> Node (Node a)
-> Node (Node a)
-> Node (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
FingerTree (Node a)
-> Node a
-> Node a
-> Node a
-> FingerTree (Node a)
-> FingerTree (Node a)
appendTree3 FingerTree (Node (Node a))
m1 (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
node3 Node a
a Node a
b Node a
c) (Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> Node a
node2 Node a
d Node a
e) (Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> Node a
node2 Node a
f Node a
g) FingerTree (Node (Node a))
m2
addDigits3 m1 :: FingerTree (Node (Node a))
m1 (One a :: Node a
a) b :: Node a
b c :: Node a
c d :: Node a
d (Four e :: Node a
e f :: Node a
f g :: Node a
g h :: Node a
h) m2 :: FingerTree (Node (Node a))
m2 =
FingerTree (Node (Node a))
-> Node (Node a)
-> Node (Node a)
-> Node (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
FingerTree (Node a)
-> Node a
-> Node a
-> Node a
-> FingerTree (Node a)
-> FingerTree (Node a)
appendTree3 FingerTree (Node (Node a))
m1 (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
node3 Node a
a Node a
b Node a
c) (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
node3 Node a
d Node a
e Node a
f) (Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> Node a
node2 Node a
g Node a
h) FingerTree (Node (Node a))
m2
addDigits3 m1 :: FingerTree (Node (Node a))
m1 (Two a :: Node a
a b :: Node a
b) c :: Node a
c d :: Node a
d e :: Node a
e (One f :: Node a
f) m2 :: FingerTree (Node (Node a))
m2 =
FingerTree (Node (Node a))
-> Node (Node a)
-> Node (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
FingerTree (Node a)
-> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
appendTree2 FingerTree (Node (Node a))
m1 (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
node3 Node a
a Node a
b Node a
c) (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
node3 Node a
d Node a
e Node a
f) FingerTree (Node (Node a))
m2
addDigits3 m1 :: FingerTree (Node (Node a))
m1 (Two a :: Node a
a b :: Node a
b) c :: Node a
c d :: Node a
d e :: Node a
e (Two f :: Node a
f g :: Node a
g) m2 :: FingerTree (Node (Node a))
m2 =
FingerTree (Node (Node a))
-> Node (Node a)
-> Node (Node a)
-> Node (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
FingerTree (Node a)
-> Node a
-> Node a
-> Node a
-> FingerTree (Node a)
-> FingerTree (Node a)
appendTree3 FingerTree (Node (Node a))
m1 (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
node3 Node a
a Node a
b Node a
c) (Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> Node a
node2 Node a
d Node a
e) (Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> Node a
node2 Node a
f Node a
g) FingerTree (Node (Node a))
m2
addDigits3 m1 :: FingerTree (Node (Node a))
m1 (Two a :: Node a
a b :: Node a
b) c :: Node a
c d :: Node a
d e :: Node a
e (Three f :: Node a
f g :: Node a
g h :: Node a
h) m2 :: FingerTree (Node (Node a))
m2 =
FingerTree (Node (Node a))
-> Node (Node a)
-> Node (Node a)
-> Node (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
FingerTree (Node a)
-> Node a
-> Node a
-> Node a
-> FingerTree (Node a)
-> FingerTree (Node a)
appendTree3 FingerTree (Node (Node a))
m1 (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
node3 Node a
a Node a
b Node a
c) (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
node3 Node a
d Node a
e Node a
f) (Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> Node a
node2 Node a
g Node a
h) FingerTree (Node (Node a))
m2
addDigits3 m1 :: FingerTree (Node (Node a))
m1 (Two a :: Node a
a b :: Node a
b) c :: Node a
c d :: Node a
d e :: Node a
e (Four f :: Node a
f g :: Node a
g h :: Node a
h i :: Node a
i) m2 :: FingerTree (Node (Node a))
m2 =
FingerTree (Node (Node a))
-> Node (Node a)
-> Node (Node a)
-> Node (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
FingerTree (Node a)
-> Node a
-> Node a
-> Node a
-> FingerTree (Node a)
-> FingerTree (Node a)
appendTree3 FingerTree (Node (Node a))
m1 (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
node3 Node a
a Node a
b Node a
c) (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
node3 Node a
d Node a
e Node a
f) (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
node3 Node a
g Node a
h Node a
i) FingerTree (Node (Node a))
m2
addDigits3 m1 :: FingerTree (Node (Node a))
m1 (Three a :: Node a
a b :: Node a
b c :: Node a
c) d :: Node a
d e :: Node a
e f :: Node a
f (One g :: Node a
g) m2 :: FingerTree (Node (Node a))
m2 =
FingerTree (Node (Node a))
-> Node (Node a)
-> Node (Node a)
-> Node (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
FingerTree (Node a)
-> Node a
-> Node a
-> Node a
-> FingerTree (Node a)
-> FingerTree (Node a)
appendTree3 FingerTree (Node (Node a))
m1 (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
node3 Node a
a Node a
b Node a
c) (Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> Node a
node2 Node a
d Node a
e) (Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> Node a
node2 Node a
f Node a
g) FingerTree (Node (Node a))
m2
addDigits3 m1 :: FingerTree (Node (Node a))
m1 (Three a :: Node a
a b :: Node a
b c :: Node a
c) d :: Node a
d e :: Node a
e f :: Node a
f (Two g :: Node a
g h :: Node a
h) m2 :: FingerTree (Node (Node a))
m2 =
FingerTree (Node (Node a))
-> Node (Node a)
-> Node (Node a)
-> Node (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
FingerTree (Node a)
-> Node a
-> Node a
-> Node a
-> FingerTree (Node a)
-> FingerTree (Node a)
appendTree3 FingerTree (Node (Node a))
m1 (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
node3 Node a
a Node a
b Node a
c) (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
node3 Node a
d Node a
e Node a
f) (Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> Node a
node2 Node a
g Node a
h) FingerTree (Node (Node a))
m2
addDigits3 m1 :: FingerTree (Node (Node a))
m1 (Three a :: Node a
a b :: Node a
b c :: Node a
c) d :: Node a
d e :: Node a
e f :: Node a
f (Three g :: Node a
g h :: Node a
h i :: Node a
i) m2 :: FingerTree (Node (Node a))
m2 =
FingerTree (Node (Node a))
-> Node (Node a)
-> Node (Node a)
-> Node (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
FingerTree (Node a)
-> Node a
-> Node a
-> Node a
-> FingerTree (Node a)
-> FingerTree (Node a)
appendTree3 FingerTree (Node (Node a))
m1 (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
node3 Node a
a Node a
b Node a
c) (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
node3 Node a
d Node a
e Node a
f) (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
node3 Node a
g Node a
h Node a
i) FingerTree (Node (Node a))
m2
addDigits3 m1 :: FingerTree (Node (Node a))
m1 (Three a :: Node a
a b :: Node a
b c :: Node a
c) d :: Node a
d e :: Node a
e f :: Node a
f (Four g :: Node a
g h :: Node a
h i :: Node a
i j :: Node a
j) m2 :: FingerTree (Node (Node a))
m2 =
FingerTree (Node (Node a))
-> Node (Node a)
-> Node (Node a)
-> Node (Node a)
-> Node (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
FingerTree (Node a)
-> Node a
-> Node a
-> Node a
-> Node a
-> FingerTree (Node a)
-> FingerTree (Node a)
appendTree4 FingerTree (Node (Node a))
m1 (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
node3 Node a
a Node a
b Node a
c) (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
node3 Node a
d Node a
e Node a
f) (Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> Node a
node2 Node a
g Node a
h) (Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> Node a
node2 Node a
i Node a
j) FingerTree (Node (Node a))
m2
addDigits3 m1 :: FingerTree (Node (Node a))
m1 (Four a :: Node a
a b :: Node a
b c :: Node a
c d :: Node a
d) e :: Node a
e f :: Node a
f g :: Node a
g (One h :: Node a
h) m2 :: FingerTree (Node (Node a))
m2 =
FingerTree (Node (Node a))
-> Node (Node a)
-> Node (Node a)
-> Node (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
FingerTree (Node a)
-> Node a
-> Node a
-> Node a
-> FingerTree (Node a)
-> FingerTree (Node a)
appendTree3 FingerTree (Node (Node a))
m1 (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
node3 Node a
a Node a
b Node a
c) (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
node3 Node a
d Node a
e Node a
f) (Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> Node a
node2 Node a
g Node a
h) FingerTree (Node (Node a))
m2
addDigits3 m1 :: FingerTree (Node (Node a))
m1 (Four a :: Node a
a b :: Node a
b c :: Node a
c d :: Node a
d) e :: Node a
e f :: Node a
f g :: Node a
g (Two h :: Node a
h i :: Node a
i) m2 :: FingerTree (Node (Node a))
m2 =
FingerTree (Node (Node a))
-> Node (Node a)
-> Node (Node a)
-> Node (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
FingerTree (Node a)
-> Node a
-> Node a
-> Node a
-> FingerTree (Node a)
-> FingerTree (Node a)
appendTree3 FingerTree (Node (Node a))
m1 (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
node3 Node a
a Node a
b Node a
c) (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
node3 Node a
d Node a
e Node a
f) (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
node3 Node a
g Node a
h Node a
i) FingerTree (Node (Node a))
m2
addDigits3 m1 :: FingerTree (Node (Node a))
m1 (Four a :: Node a
a b :: Node a
b c :: Node a
c d :: Node a
d) e :: Node a
e f :: Node a
f g :: Node a
g (Three h :: Node a
h i :: Node a
i j :: Node a
j) m2 :: FingerTree (Node (Node a))
m2 =
FingerTree (Node (Node a))
-> Node (Node a)
-> Node (Node a)
-> Node (Node a)
-> Node (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
FingerTree (Node a)
-> Node a
-> Node a
-> Node a
-> Node a
-> FingerTree (Node a)
-> FingerTree (Node a)
appendTree4 FingerTree (Node (Node a))
m1 (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
node3 Node a
a Node a
b Node a
c) (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
node3 Node a
d Node a
e Node a
f) (Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> Node a
node2 Node a
g Node a
h) (Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> Node a
node2 Node a
i Node a
j) FingerTree (Node (Node a))
m2
addDigits3 m1 :: FingerTree (Node (Node a))
m1 (Four a :: Node a
a b :: Node a
b c :: Node a
c d :: Node a
d) e :: Node a
e f :: Node a
f g :: Node a
g (Four h :: Node a
h i :: Node a
i j :: Node a
j k :: Node a
k) m2 :: FingerTree (Node (Node a))
m2 =
FingerTree (Node (Node a))
-> Node (Node a)
-> Node (Node a)
-> Node (Node a)
-> Node (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
FingerTree (Node a)
-> Node a
-> Node a
-> Node a
-> Node a
-> FingerTree (Node a)
-> FingerTree (Node a)
appendTree4 FingerTree (Node (Node a))
m1 (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
node3 Node a
a Node a
b Node a
c) (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
node3 Node a
d Node a
e Node a
f) (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
node3 Node a
g Node a
h Node a
i) (Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> Node a
node2 Node a
j Node a
k) FingerTree (Node (Node a))
m2
appendTree4 :: FingerTree (Node a) -> Node a -> Node a -> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
appendTree4 :: FingerTree (Node a)
-> Node a
-> Node a
-> Node a
-> Node a
-> FingerTree (Node a)
-> FingerTree (Node a)
appendTree4 Empty a :: Node a
a b :: Node a
b c :: Node a
c d :: Node a
d xs :: FingerTree (Node a)
xs =
Node a
a Node a -> FingerTree (Node a) -> FingerTree (Node a)
forall a. Sized a => a -> FingerTree a -> FingerTree a
`consTree` Node a
b Node a -> FingerTree (Node a) -> FingerTree (Node a)
forall a. Sized a => a -> FingerTree a -> FingerTree a
`consTree` Node a
c Node a -> FingerTree (Node a) -> FingerTree (Node a)
forall a. Sized a => a -> FingerTree a -> FingerTree a
`consTree` Node a
d Node a -> FingerTree (Node a) -> FingerTree (Node a)
forall a. Sized a => a -> FingerTree a -> FingerTree a
`consTree` FingerTree (Node a)
xs
appendTree4 xs :: FingerTree (Node a)
xs a :: Node a
a b :: Node a
b c :: Node a
c d :: Node a
d Empty =
FingerTree (Node a)
xs FingerTree (Node a) -> Node a -> FingerTree (Node a)
forall a. Sized a => FingerTree a -> a -> FingerTree a
`snocTree` Node a
a FingerTree (Node a) -> Node a -> FingerTree (Node a)
forall a. Sized a => FingerTree a -> a -> FingerTree a
`snocTree` Node a
b FingerTree (Node a) -> Node a -> FingerTree (Node a)
forall a. Sized a => FingerTree a -> a -> FingerTree a
`snocTree` Node a
c FingerTree (Node a) -> Node a -> FingerTree (Node a)
forall a. Sized a => FingerTree a -> a -> FingerTree a
`snocTree` Node a
d
appendTree4 (Single x :: Node a
x) a :: Node a
a b :: Node a
b c :: Node a
c d :: Node a
d xs :: FingerTree (Node a)
xs =
Node a
x Node a -> FingerTree (Node a) -> FingerTree (Node a)
forall a. Sized a => a -> FingerTree a -> FingerTree a
`consTree` Node a
a Node a -> FingerTree (Node a) -> FingerTree (Node a)
forall a. Sized a => a -> FingerTree a -> FingerTree a
`consTree` Node a
b Node a -> FingerTree (Node a) -> FingerTree (Node a)
forall a. Sized a => a -> FingerTree a -> FingerTree a
`consTree` Node a
c Node a -> FingerTree (Node a) -> FingerTree (Node a)
forall a. Sized a => a -> FingerTree a -> FingerTree a
`consTree` Node a
d Node a -> FingerTree (Node a) -> FingerTree (Node a)
forall a. Sized a => a -> FingerTree a -> FingerTree a
`consTree` FingerTree (Node a)
xs
appendTree4 xs :: FingerTree (Node a)
xs a :: Node a
a b :: Node a
b c :: Node a
c d :: Node a
d (Single x :: Node a
x) =
FingerTree (Node a)
xs FingerTree (Node a) -> Node a -> FingerTree (Node a)
forall a. Sized a => FingerTree a -> a -> FingerTree a
`snocTree` Node a
a FingerTree (Node a) -> Node a -> FingerTree (Node a)
forall a. Sized a => FingerTree a -> a -> FingerTree a
`snocTree` Node a
b FingerTree (Node a) -> Node a -> FingerTree (Node a)
forall a. Sized a => FingerTree a -> a -> FingerTree a
`snocTree` Node a
c FingerTree (Node a) -> Node a -> FingerTree (Node a)
forall a. Sized a => FingerTree a -> a -> FingerTree a
`snocTree` Node a
d FingerTree (Node a) -> Node a -> FingerTree (Node a)
forall a. Sized a => FingerTree a -> a -> FingerTree a
`snocTree` Node a
x
appendTree4 (Deep s1 :: Int
s1 pr1 :: Digit (Node a)
pr1 m1 :: FingerTree (Node (Node a))
m1 sf1 :: Digit (Node a)
sf1) a :: Node a
a b :: Node a
b c :: Node a
c d :: Node a
d (Deep s2 :: Int
s2 pr2 :: Digit (Node a)
pr2 m2 :: FingerTree (Node (Node a))
m2 sf2 :: Digit (Node a)
sf2) =
Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> FingerTree (Node a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Node a -> Int
forall a. Sized a => a -> Int
size Node a
a Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Node a -> Int
forall a. Sized a => a -> Int
size Node a
b Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Node a -> Int
forall a. Sized a => a -> Int
size Node a
c Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Node a -> Int
forall a. Sized a => a -> Int
size Node a
d Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
s2) Digit (Node a)
pr1 (FingerTree (Node (Node a))
-> Digit (Node a)
-> Node a
-> Node a
-> Node a
-> Node a
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
FingerTree (Node (Node a))
-> Digit (Node a)
-> Node a
-> Node a
-> Node a
-> Node a
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
addDigits4 FingerTree (Node (Node a))
m1 Digit (Node a)
sf1 Node a
a Node a
b Node a
c Node a
d Digit (Node a)
pr2 FingerTree (Node (Node a))
m2) Digit (Node a)
sf2
addDigits4 :: FingerTree (Node (Node a)) -> Digit (Node a) -> Node a -> Node a -> Node a -> Node a -> Digit (Node a) -> FingerTree (Node (Node a)) -> FingerTree (Node (Node a))
addDigits4 :: FingerTree (Node (Node a))
-> Digit (Node a)
-> Node a
-> Node a
-> Node a
-> Node a
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
addDigits4 m1 :: FingerTree (Node (Node a))
m1 (One a :: Node a
a) b :: Node a
b c :: Node a
c d :: Node a
d e :: Node a
e (One f :: Node a
f) m2 :: FingerTree (Node (Node a))
m2 =
FingerTree (Node (Node a))
-> Node (Node a)
-> Node (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
FingerTree (Node a)
-> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
appendTree2 FingerTree (Node (Node a))
m1 (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
node3 Node a
a Node a
b Node a
c) (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
node3 Node a
d Node a
e Node a
f) FingerTree (Node (Node a))
m2
addDigits4 m1 :: FingerTree (Node (Node a))
m1 (One a :: Node a
a) b :: Node a
b c :: Node a
c d :: Node a
d e :: Node a
e (Two f :: Node a
f g :: Node a
g) m2 :: FingerTree (Node (Node a))
m2 =
FingerTree (Node (Node a))
-> Node (Node a)
-> Node (Node a)
-> Node (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
FingerTree (Node a)
-> Node a
-> Node a
-> Node a
-> FingerTree (Node a)
-> FingerTree (Node a)
appendTree3 FingerTree (Node (Node a))
m1 (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
node3 Node a
a Node a
b Node a
c) (Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> Node a
node2 Node a
d Node a
e) (Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> Node a
node2 Node a
f Node a
g) FingerTree (Node (Node a))
m2
addDigits4 m1 :: FingerTree (Node (Node a))
m1 (One a :: Node a
a) b :: Node a
b c :: Node a
c d :: Node a
d e :: Node a
e (Three f :: Node a
f g :: Node a
g h :: Node a
h) m2 :: FingerTree (Node (Node a))
m2 =
FingerTree (Node (Node a))
-> Node (Node a)
-> Node (Node a)
-> Node (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
FingerTree (Node a)
-> Node a
-> Node a
-> Node a
-> FingerTree (Node a)
-> FingerTree (Node a)
appendTree3 FingerTree (Node (Node a))
m1 (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
node3 Node a
a Node a
b Node a
c) (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
node3 Node a
d Node a
e Node a
f) (Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> Node a
node2 Node a
g Node a
h) FingerTree (Node (Node a))
m2
addDigits4 m1 :: FingerTree (Node (Node a))
m1 (One a :: Node a
a) b :: Node a
b c :: Node a
c d :: Node a
d e :: Node a
e (Four f :: Node a
f g :: Node a
g h :: Node a
h i :: Node a
i) m2 :: FingerTree (Node (Node a))
m2 =
FingerTree (Node (Node a))
-> Node (Node a)
-> Node (Node a)
-> Node (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
FingerTree (Node a)
-> Node a
-> Node a
-> Node a
-> FingerTree (Node a)
-> FingerTree (Node a)
appendTree3 FingerTree (Node (Node a))
m1 (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
node3 Node a
a Node a
b Node a
c) (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
node3 Node a
d Node a
e Node a
f) (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
node3 Node a
g Node a
h Node a
i) FingerTree (Node (Node a))
m2
addDigits4 m1 :: FingerTree (Node (Node a))
m1 (Two a :: Node a
a b :: Node a
b) c :: Node a
c d :: Node a
d e :: Node a
e f :: Node a
f (One g :: Node a
g) m2 :: FingerTree (Node (Node a))
m2 =
FingerTree (Node (Node a))
-> Node (Node a)
-> Node (Node a)
-> Node (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
FingerTree (Node a)
-> Node a
-> Node a
-> Node a
-> FingerTree (Node a)
-> FingerTree (Node a)
appendTree3 FingerTree (Node (Node a))
m1 (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
node3 Node a
a Node a
b Node a
c) (Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> Node a
node2 Node a
d Node a
e) (Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> Node a
node2 Node a
f Node a
g) FingerTree (Node (Node a))
m2
addDigits4 m1 :: FingerTree (Node (Node a))
m1 (Two a :: Node a
a b :: Node a
b) c :: Node a
c d :: Node a
d e :: Node a
e f :: Node a
f (Two g :: Node a
g h :: Node a
h) m2 :: FingerTree (Node (Node a))
m2 =
FingerTree (Node (Node a))
-> Node (Node a)
-> Node (Node a)
-> Node (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
FingerTree (Node a)
-> Node a
-> Node a
-> Node a
-> FingerTree (Node a)
-> FingerTree (Node a)
appendTree3 FingerTree (Node (Node a))
m1 (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
node3 Node a
a Node a
b Node a
c) (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
node3 Node a
d Node a
e Node a
f) (Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> Node a
node2 Node a
g Node a
h) FingerTree (Node (Node a))
m2
addDigits4 m1 :: FingerTree (Node (Node a))
m1 (Two a :: Node a
a b :: Node a
b) c :: Node a
c d :: Node a
d e :: Node a
e f :: Node a
f (Three g :: Node a
g h :: Node a
h i :: Node a
i) m2 :: FingerTree (Node (Node a))
m2 =
FingerTree (Node (Node a))
-> Node (Node a)
-> Node (Node a)
-> Node (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
FingerTree (Node a)
-> Node a
-> Node a
-> Node a
-> FingerTree (Node a)
-> FingerTree (Node a)
appendTree3 FingerTree (Node (Node a))
m1 (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
node3 Node a
a Node a
b Node a
c) (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
node3 Node a
d Node a
e Node a
f) (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
node3 Node a
g Node a
h Node a
i) FingerTree (Node (Node a))
m2
addDigits4 m1 :: FingerTree (Node (Node a))
m1 (Two a :: Node a
a b :: Node a
b) c :: Node a
c d :: Node a
d e :: Node a
e f :: Node a
f (Four g :: Node a
g h :: Node a
h i :: Node a
i j :: Node a
j) m2 :: FingerTree (Node (Node a))
m2 =
FingerTree (Node (Node a))
-> Node (Node a)
-> Node (Node a)
-> Node (Node a)
-> Node (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
FingerTree (Node a)
-> Node a
-> Node a
-> Node a
-> Node a
-> FingerTree (Node a)
-> FingerTree (Node a)
appendTree4 FingerTree (Node (Node a))
m1 (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
node3 Node a
a Node a
b Node a
c) (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
node3 Node a
d Node a
e Node a
f) (Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> Node a
node2 Node a
g Node a
h) (Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> Node a
node2 Node a
i Node a
j) FingerTree (Node (Node a))
m2
addDigits4 m1 :: FingerTree (Node (Node a))
m1 (Three a :: Node a
a b :: Node a
b c :: Node a
c) d :: Node a
d e :: Node a
e f :: Node a
f g :: Node a
g (One h :: Node a
h) m2 :: FingerTree (Node (Node a))
m2 =
FingerTree (Node (Node a))
-> Node (Node a)
-> Node (Node a)
-> Node (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
FingerTree (Node a)
-> Node a
-> Node a
-> Node a
-> FingerTree (Node a)
-> FingerTree (Node a)
appendTree3 FingerTree (Node (Node a))
m1 (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
node3 Node a
a Node a
b Node a
c) (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
node3 Node a
d Node a
e Node a
f) (Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> Node a
node2 Node a
g Node a
h) FingerTree (Node (Node a))
m2
addDigits4 m1 :: FingerTree (Node (Node a))
m1 (Three a :: Node a
a b :: Node a
b c :: Node a
c) d :: Node a
d e :: Node a
e f :: Node a
f g :: Node a
g (Two h :: Node a
h i :: Node a
i) m2 :: FingerTree (Node (Node a))
m2 =
FingerTree (Node (Node a))
-> Node (Node a)
-> Node (Node a)
-> Node (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
FingerTree (Node a)
-> Node a
-> Node a
-> Node a
-> FingerTree (Node a)
-> FingerTree (Node a)
appendTree3 FingerTree (Node (Node a))
m1 (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
node3 Node a
a Node a
b Node a
c) (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
node3 Node a
d Node a
e Node a
f) (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
node3 Node a
g Node a
h Node a
i) FingerTree (Node (Node a))
m2
addDigits4 m1 :: FingerTree (Node (Node a))
m1 (Three a :: Node a
a b :: Node a
b c :: Node a
c) d :: Node a
d e :: Node a
e f :: Node a
f g :: Node a
g (Three h :: Node a
h i :: Node a
i j :: Node a
j) m2 :: FingerTree (Node (Node a))
m2 =
FingerTree (Node (Node a))
-> Node (Node a)
-> Node (Node a)
-> Node (Node a)
-> Node (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
FingerTree (Node a)
-> Node a
-> Node a
-> Node a
-> Node a
-> FingerTree (Node a)
-> FingerTree (Node a)
appendTree4 FingerTree (Node (Node a))
m1 (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
node3 Node a
a Node a
b Node a
c) (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
node3 Node a
d Node a
e Node a
f) (Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> Node a
node2 Node a
g Node a
h) (Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> Node a
node2 Node a
i Node a
j) FingerTree (Node (Node a))
m2
addDigits4 m1 :: FingerTree (Node (Node a))
m1 (Three a :: Node a
a b :: Node a
b c :: Node a
c) d :: Node a
d e :: Node a
e f :: Node a
f g :: Node a
g (Four h :: Node a
h i :: Node a
i j :: Node a
j k :: Node a
k) m2 :: FingerTree (Node (Node a))
m2 =
FingerTree (Node (Node a))
-> Node (Node a)
-> Node (Node a)
-> Node (Node a)
-> Node (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
FingerTree (Node a)
-> Node a
-> Node a
-> Node a
-> Node a
-> FingerTree (Node a)
-> FingerTree (Node a)
appendTree4 FingerTree (Node (Node a))
m1 (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
node3 Node a
a Node a
b Node a
c) (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
node3 Node a
d Node a
e Node a
f) (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
node3 Node a
g Node a
h Node a
i) (Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> Node a
node2 Node a
j Node a
k) FingerTree (Node (Node a))
m2
addDigits4 m1 :: FingerTree (Node (Node a))
m1 (Four a :: Node a
a b :: Node a
b c :: Node a
c d :: Node a
d) e :: Node a
e f :: Node a
f g :: Node a
g h :: Node a
h (One i :: Node a
i) m2 :: FingerTree (Node (Node a))
m2 =
FingerTree (Node (Node a))
-> Node (Node a)
-> Node (Node a)
-> Node (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
FingerTree (Node a)
-> Node a
-> Node a
-> Node a
-> FingerTree (Node a)
-> FingerTree (Node a)
appendTree3 FingerTree (Node (Node a))
m1 (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
node3 Node a
a Node a
b Node a
c) (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
node3 Node a
d Node a
e Node a
f) (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
node3 Node a
g Node a
h Node a
i) FingerTree (Node (Node a))
m2
addDigits4 m1 :: FingerTree (Node (Node a))
m1 (Four a :: Node a
a b :: Node a
b c :: Node a
c d :: Node a
d) e :: Node a
e f :: Node a
f g :: Node a
g h :: Node a
h (Two i :: Node a
i j :: Node a
j) m2 :: FingerTree (Node (Node a))
m2 =
FingerTree (Node (Node a))
-> Node (Node a)
-> Node (Node a)
-> Node (Node a)
-> Node (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
FingerTree (Node a)
-> Node a
-> Node a
-> Node a
-> Node a
-> FingerTree (Node a)
-> FingerTree (Node a)
appendTree4 FingerTree (Node (Node a))
m1 (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
node3 Node a
a Node a
b Node a
c) (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
node3 Node a
d Node a
e Node a
f) (Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> Node a
node2 Node a
g Node a
h) (Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> Node a
node2 Node a
i Node a
j) FingerTree (Node (Node a))
m2
addDigits4 m1 :: FingerTree (Node (Node a))
m1 (Four a :: Node a
a b :: Node a
b c :: Node a
c d :: Node a
d) e :: Node a
e f :: Node a
f g :: Node a
g h :: Node a
h (Three i :: Node a
i j :: Node a
j k :: Node a
k) m2 :: FingerTree (Node (Node a))
m2 =
FingerTree (Node (Node a))
-> Node (Node a)
-> Node (Node a)
-> Node (Node a)
-> Node (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
FingerTree (Node a)
-> Node a
-> Node a
-> Node a
-> Node a
-> FingerTree (Node a)
-> FingerTree (Node a)
appendTree4 FingerTree (Node (Node a))
m1 (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
node3 Node a
a Node a
b Node a
c) (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
node3 Node a
d Node a
e Node a
f) (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
node3 Node a
g Node a
h Node a
i) (Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> Node a
node2 Node a
j Node a
k) FingerTree (Node (Node a))
m2
addDigits4 m1 :: FingerTree (Node (Node a))
m1 (Four a :: Node a
a b :: Node a
b c :: Node a
c d :: Node a
d) e :: Node a
e f :: Node a
f g :: Node a
g h :: Node a
h (Four i :: Node a
i j :: Node a
j k :: Node a
k l :: Node a
l) m2 :: FingerTree (Node (Node a))
m2 =
FingerTree (Node (Node a))
-> Node (Node a)
-> Node (Node a)
-> Node (Node a)
-> Node (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
FingerTree (Node a)
-> Node a
-> Node a
-> Node a
-> Node a
-> FingerTree (Node a)
-> FingerTree (Node a)
appendTree4 FingerTree (Node (Node a))
m1 (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
node3 Node a
a Node a
b Node a
c) (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
node3 Node a
d Node a
e Node a
f) (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
node3 Node a
g Node a
h Node a
i) (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
node3 Node a
j Node a
k Node a
l) FingerTree (Node (Node a))
m2
null :: Seq a -> Bool
null :: Seq a -> Bool
null (Seq Empty) = Bool
True
null _ = Bool
False
length :: Seq a -> Int
length :: Seq a -> Int
length (Seq xs :: FingerTree (Elem a)
xs) = FingerTree (Elem a) -> Int
forall a. Sized a => a -> Int
size FingerTree (Elem a)
xs
data Maybe2 a b = Nothing2 | Just2 a b
data ViewL a
= EmptyL
| a :< Seq a
#ifndef __HADDOCK__
deriving (ViewL a -> ViewL a -> Bool
(ViewL a -> ViewL a -> Bool)
-> (ViewL a -> ViewL a -> Bool) -> Eq (ViewL a)
forall a. Eq a => ViewL a -> ViewL a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ViewL a -> ViewL a -> Bool
$c/= :: forall a. Eq a => ViewL a -> ViewL a -> Bool
== :: ViewL a -> ViewL a -> Bool
$c== :: forall a. Eq a => ViewL a -> ViewL a -> Bool
Eq, Int -> ViewL a -> ShowS
[ViewL a] -> ShowS
ViewL a -> String
(Int -> ViewL a -> ShowS)
-> (ViewL a -> String) -> ([ViewL a] -> ShowS) -> Show (ViewL a)
forall a. Show a => Int -> ViewL a -> ShowS
forall a. Show a => [ViewL a] -> ShowS
forall a. Show a => ViewL a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ViewL a] -> ShowS
$cshowList :: forall a. Show a => [ViewL a] -> ShowS
show :: ViewL a -> String
$cshow :: forall a. Show a => ViewL a -> String
showsPrec :: Int -> ViewL a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> ViewL a -> ShowS
Show)
#else
instance Eq a => Eq (ViewL a)
instance Show a => Show (ViewL a)
#endif
instance Functor ViewL where
fmap :: (a -> b) -> ViewL a -> ViewL b
fmap _ EmptyL = ViewL b
forall a. ViewL a
EmptyL
fmap f :: a -> b
f (x :: a
x :< xs :: Seq a
xs) = a -> b
f a
x b -> Seq b -> ViewL b
forall a. a -> Seq a -> ViewL a
:< (a -> b) -> Seq a -> Seq b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Seq a
xs
viewl :: Seq a -> ViewL a
viewl :: Seq a -> ViewL a
viewl (Seq xs :: FingerTree (Elem a)
xs) = case FingerTree (Elem a) -> Maybe2 (Elem a) (FingerTree (Elem a))
forall a. Sized a => FingerTree a -> Maybe2 a (FingerTree a)
viewLTree FingerTree (Elem a)
xs of
Nothing2 -> ViewL a
forall a. ViewL a
EmptyL
Just2 (Elem x :: a
x) xs' :: FingerTree (Elem a)
xs' -> a
x a -> Seq a -> ViewL a
forall a. a -> Seq a -> ViewL a
:< FingerTree (Elem a) -> Seq a
forall a. FingerTree (Elem a) -> Seq a
Seq FingerTree (Elem a)
xs'
{-# SPECIALIZE viewLTree :: FingerTree (Elem a) -> Maybe2 (Elem a) (FingerTree (Elem a)) #-}
{-# SPECIALIZE viewLTree :: FingerTree (Node a) -> Maybe2 (Node a) (FingerTree (Node a)) #-}
viewLTree :: Sized a => FingerTree a -> Maybe2 a (FingerTree a)
viewLTree :: FingerTree a -> Maybe2 a (FingerTree a)
viewLTree Empty = Maybe2 a (FingerTree a)
forall a b. Maybe2 a b
Nothing2
viewLTree (Single a :: a
a) = a -> FingerTree a -> Maybe2 a (FingerTree a)
forall a b. a -> b -> Maybe2 a b
Just2 a
a FingerTree a
forall a. FingerTree a
Empty
viewLTree (Deep s :: Int
s (One a :: a
a) m :: FingerTree (Node a)
m sf :: Digit a
sf) = a -> FingerTree a -> Maybe2 a (FingerTree a)
forall a b. a -> b -> Maybe2 a b
Just2 a
a (case FingerTree (Node a) -> Maybe2 (Node a) (FingerTree (Node a))
forall a. Sized a => FingerTree a -> Maybe2 a (FingerTree a)
viewLTree FingerTree (Node a)
m of
Nothing2 -> Digit a -> FingerTree a
forall a. Sized a => Digit a -> FingerTree a
digitToTree Digit a
sf
Just2 b :: Node a
b m' :: FingerTree (Node a)
m' -> Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- a -> Int
forall a. Sized a => a -> Int
size a
a) (Node a -> Digit a
forall a. Node a -> Digit a
nodeToDigit Node a
b) FingerTree (Node a)
m' Digit a
sf)
viewLTree (Deep s :: Int
s (Two a :: a
a b :: a
b) m :: FingerTree (Node a)
m sf :: Digit a
sf) =
a -> FingerTree a -> Maybe2 a (FingerTree a)
forall a b. a -> b -> Maybe2 a b
Just2 a
a (Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- a -> Int
forall a. Sized a => a -> Int
size a
a) (a -> Digit a
forall a. a -> Digit a
One a
b) FingerTree (Node a)
m Digit a
sf)
viewLTree (Deep s :: Int
s (Three a :: a
a b :: a
b c :: a
c) m :: FingerTree (Node a)
m sf :: Digit a
sf) =
a -> FingerTree a -> Maybe2 a (FingerTree a)
forall a b. a -> b -> Maybe2 a b
Just2 a
a (Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- a -> Int
forall a. Sized a => a -> Int
size a
a) (a -> a -> Digit a
forall a. a -> a -> Digit a
Two a
b a
c) FingerTree (Node a)
m Digit a
sf)
viewLTree (Deep s :: Int
s (Four a :: a
a b :: a
b c :: a
c d :: a
d) m :: FingerTree (Node a)
m sf :: Digit a
sf) =
a -> FingerTree a -> Maybe2 a (FingerTree a)
forall a b. a -> b -> Maybe2 a b
Just2 a
a (Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- a -> Int
forall a. Sized a => a -> Int
size a
a) (a -> a -> a -> Digit a
forall a. a -> a -> a -> Digit a
Three a
b a
c a
d) FingerTree (Node a)
m Digit a
sf)
data ViewR a
= EmptyR
| Seq a :> a
#ifndef __HADDOCK__
deriving (ViewR a -> ViewR a -> Bool
(ViewR a -> ViewR a -> Bool)
-> (ViewR a -> ViewR a -> Bool) -> Eq (ViewR a)
forall a. Eq a => ViewR a -> ViewR a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ViewR a -> ViewR a -> Bool
$c/= :: forall a. Eq a => ViewR a -> ViewR a -> Bool
== :: ViewR a -> ViewR a -> Bool
$c== :: forall a. Eq a => ViewR a -> ViewR a -> Bool
Eq, Int -> ViewR a -> ShowS
[ViewR a] -> ShowS
ViewR a -> String
(Int -> ViewR a -> ShowS)
-> (ViewR a -> String) -> ([ViewR a] -> ShowS) -> Show (ViewR a)
forall a. Show a => Int -> ViewR a -> ShowS
forall a. Show a => [ViewR a] -> ShowS
forall a. Show a => ViewR a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ViewR a] -> ShowS
$cshowList :: forall a. Show a => [ViewR a] -> ShowS
show :: ViewR a -> String
$cshow :: forall a. Show a => ViewR a -> String
showsPrec :: Int -> ViewR a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> ViewR a -> ShowS
Show)
#else
instance Eq a => Eq (ViewR a)
instance Show a => Show (ViewR a)
#endif
instance Functor ViewR where
fmap :: (a -> b) -> ViewR a -> ViewR b
fmap _ EmptyR = ViewR b
forall a. ViewR a
EmptyR
fmap f :: a -> b
f (xs :: Seq a
xs :> x :: a
x) = (a -> b) -> Seq a -> Seq b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Seq a
xs Seq b -> b -> ViewR b
forall a. Seq a -> a -> ViewR a
:> a -> b
f a
x
viewr :: Seq a -> ViewR a
viewr :: Seq a -> ViewR a
viewr (Seq xs :: FingerTree (Elem a)
xs) = case FingerTree (Elem a) -> Maybe2 (FingerTree (Elem a)) (Elem a)
forall a. Sized a => FingerTree a -> Maybe2 (FingerTree a) a
viewRTree FingerTree (Elem a)
xs of
Nothing2 -> ViewR a
forall a. ViewR a
EmptyR
Just2 xs' :: FingerTree (Elem a)
xs' (Elem x :: a
x) -> FingerTree (Elem a) -> Seq a
forall a. FingerTree (Elem a) -> Seq a
Seq FingerTree (Elem a)
xs' Seq a -> a -> ViewR a
forall a. Seq a -> a -> ViewR a
:> a
x
{-# SPECIALIZE viewRTree :: FingerTree (Elem a) -> Maybe2 (FingerTree (Elem a)) (Elem a) #-}
{-# SPECIALIZE viewRTree :: FingerTree (Node a) -> Maybe2 (FingerTree (Node a)) (Node a) #-}
viewRTree :: Sized a => FingerTree a -> Maybe2 (FingerTree a) a
viewRTree :: FingerTree a -> Maybe2 (FingerTree a) a
viewRTree Empty = Maybe2 (FingerTree a) a
forall a b. Maybe2 a b
Nothing2
viewRTree (Single z :: a
z) = FingerTree a -> a -> Maybe2 (FingerTree a) a
forall a b. a -> b -> Maybe2 a b
Just2 FingerTree a
forall a. FingerTree a
Empty a
z
viewRTree (Deep s :: Int
s pr :: Digit a
pr m :: FingerTree (Node a)
m (One z :: a
z)) = FingerTree a -> a -> Maybe2 (FingerTree a) a
forall a b. a -> b -> Maybe2 a b
Just2 (case FingerTree (Node a) -> Maybe2 (FingerTree (Node a)) (Node a)
forall a. Sized a => FingerTree a -> Maybe2 (FingerTree a) a
viewRTree FingerTree (Node a)
m of
Nothing2 -> Digit a -> FingerTree a
forall a. Sized a => Digit a -> FingerTree a
digitToTree Digit a
pr
Just2 m' :: FingerTree (Node a)
m' y :: Node a
y -> Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- a -> Int
forall a. Sized a => a -> Int
size a
z) Digit a
pr FingerTree (Node a)
m' (Node a -> Digit a
forall a. Node a -> Digit a
nodeToDigit Node a
y)) a
z
viewRTree (Deep s :: Int
s pr :: Digit a
pr m :: FingerTree (Node a)
m (Two y :: a
y z :: a
z)) =
FingerTree a -> a -> Maybe2 (FingerTree a) a
forall a b. a -> b -> Maybe2 a b
Just2 (Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- a -> Int
forall a. Sized a => a -> Int
size a
z) Digit a
pr FingerTree (Node a)
m (a -> Digit a
forall a. a -> Digit a
One a
y)) a
z
viewRTree (Deep s :: Int
s pr :: Digit a
pr m :: FingerTree (Node a)
m (Three x :: a
x y :: a
y z :: a
z)) =
FingerTree a -> a -> Maybe2 (FingerTree a) a
forall a b. a -> b -> Maybe2 a b
Just2 (Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- a -> Int
forall a. Sized a => a -> Int
size a
z) Digit a
pr FingerTree (Node a)
m (a -> a -> Digit a
forall a. a -> a -> Digit a
Two a
x a
y)) a
z
viewRTree (Deep s :: Int
s pr :: Digit a
pr m :: FingerTree (Node a)
m (Four w :: a
w x :: a
x y :: a
y z :: a
z)) =
FingerTree a -> a -> Maybe2 (FingerTree a) a
forall a b. a -> b -> Maybe2 a b
Just2 (Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- a -> Int
forall a. Sized a => a -> Int
size a
z) Digit a
pr FingerTree (Node a)
m (a -> a -> a -> Digit a
forall a. a -> a -> a -> Digit a
Three a
w a
x a
y)) a
z
index :: Seq a -> Int -> a
index :: Seq a -> Int -> a
index (Seq xs :: FingerTree (Elem a)
xs) i :: Int
i
| 0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
i Bool -> Bool -> Bool
&& Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< FingerTree (Elem a) -> Int
forall a. Sized a => a -> Int
size FingerTree (Elem a)
xs = case Int -> FingerTree (Elem a) -> Place (Elem a)
forall a. Sized a => Int -> FingerTree a -> Place a
lookupTree (-Int
i) FingerTree (Elem a)
xs of
Place _ (Elem x :: a
x) -> a
x
| Bool
otherwise = String -> a
forall a. HasCallStack => String -> a
error "index out of bounds"
data Place a = Place {-# UNPACK #-} !Int a
#if TESTING
deriving Show
#endif
{-# SPECIALIZE lookupTree :: Int -> FingerTree (Elem a) -> Place (Elem a) #-}
{-# SPECIALIZE lookupTree :: Int -> FingerTree (Node a) -> Place (Node a) #-}
lookupTree :: Sized a => Int -> FingerTree a -> Place a
lookupTree :: Int -> FingerTree a -> Place a
lookupTree i :: Int
i (Single x :: a
x) = Int -> a -> Place a
forall a. Int -> a -> Place a
Place Int
i a
x
lookupTree i :: Int
i (Deep _ pr :: Digit a
pr m :: FingerTree (Node a)
m sf :: Digit a
sf)
| Int
vpr Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0 = Int -> Digit a -> Place a
forall a. Sized a => Int -> Digit a -> Place a
lookupDigit Int
i Digit a
pr
| Int
vm Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0 = case Int -> FingerTree (Node a) -> Place (Node a)
forall a. Sized a => Int -> FingerTree a -> Place a
lookupTree Int
vpr FingerTree (Node a)
m of
Place i' :: Int
i' xs :: Node a
xs -> Int -> Node a -> Place a
forall a. Sized a => Int -> Node a -> Place a
lookupNode Int
i' Node a
xs
| Bool
otherwise = Int -> Digit a -> Place a
forall a. Sized a => Int -> Digit a -> Place a
lookupDigit Int
vm Digit a
sf
where vpr :: Int
vpr = Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Digit a -> Int
forall a. Sized a => a -> Int
size Digit a
pr
vm :: Int
vm = Int
vpr Int -> Int -> Int
forall a. Num a => a -> a -> a
+ FingerTree (Node a) -> Int
forall a. Sized a => a -> Int
size FingerTree (Node a)
m
{-# SPECIALIZE lookupNode :: Int -> Node (Elem a) -> Place (Elem a) #-}
{-# SPECIALIZE lookupNode :: Int -> Node (Node a) -> Place (Node a) #-}
lookupNode :: Sized a => Int -> Node a -> Place a
lookupNode :: Int -> Node a -> Place a
lookupNode i :: Int
i (Node2 _ a :: a
a b :: a
b)
| Int
va Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0 = Int -> a -> Place a
forall a. Int -> a -> Place a
Place Int
i a
a
| Bool
otherwise = Int -> a -> Place a
forall a. Int -> a -> Place a
Place Int
va a
b
where va :: Int
va = Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ a -> Int
forall a. Sized a => a -> Int
size a
a
lookupNode i :: Int
i (Node3 _ a :: a
a b :: a
b c :: a
c)
| Int
va Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0 = Int -> a -> Place a
forall a. Int -> a -> Place a
Place Int
i a
a
| Int
vab Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0 = Int -> a -> Place a
forall a. Int -> a -> Place a
Place Int
va a
b
| Bool
otherwise = Int -> a -> Place a
forall a. Int -> a -> Place a
Place Int
vab a
c
where va :: Int
va = Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ a -> Int
forall a. Sized a => a -> Int
size a
a
vab :: Int
vab = Int
va Int -> Int -> Int
forall a. Num a => a -> a -> a
+ a -> Int
forall a. Sized a => a -> Int
size a
b
{-# SPECIALIZE lookupDigit :: Int -> Digit (Elem a) -> Place (Elem a) #-}
{-# SPECIALIZE lookupDigit :: Int -> Digit (Node a) -> Place (Node a) #-}
lookupDigit :: Sized a => Int -> Digit a -> Place a
lookupDigit :: Int -> Digit a -> Place a
lookupDigit i :: Int
i (One a :: a
a) = Int -> a -> Place a
forall a. Int -> a -> Place a
Place Int
i a
a
lookupDigit i :: Int
i (Two a :: a
a b :: a
b)
| Int
va Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0 = Int -> a -> Place a
forall a. Int -> a -> Place a
Place Int
i a
a
| Bool
otherwise = Int -> a -> Place a
forall a. Int -> a -> Place a
Place Int
va a
b
where va :: Int
va = Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ a -> Int
forall a. Sized a => a -> Int
size a
a
lookupDigit i :: Int
i (Three a :: a
a b :: a
b c :: a
c)
| Int
va Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0 = Int -> a -> Place a
forall a. Int -> a -> Place a
Place Int
i a
a
| Int
vab Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0 = Int -> a -> Place a
forall a. Int -> a -> Place a
Place Int
va a
b
| Bool
otherwise = Int -> a -> Place a
forall a. Int -> a -> Place a
Place Int
vab a
c
where va :: Int
va = Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ a -> Int
forall a. Sized a => a -> Int
size a
a
vab :: Int
vab = Int
va Int -> Int -> Int
forall a. Num a => a -> a -> a
+ a -> Int
forall a. Sized a => a -> Int
size a
b
lookupDigit i :: Int
i (Four a :: a
a b :: a
b c :: a
c d :: a
d)
| Int
va Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0 = Int -> a -> Place a
forall a. Int -> a -> Place a
Place Int
i a
a
| Int
vab Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0 = Int -> a -> Place a
forall a. Int -> a -> Place a
Place Int
va a
b
| Int
vabc Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0 = Int -> a -> Place a
forall a. Int -> a -> Place a
Place Int
vab a
c
| Bool
otherwise = Int -> a -> Place a
forall a. Int -> a -> Place a
Place Int
vabc a
d
where va :: Int
va = Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ a -> Int
forall a. Sized a => a -> Int
size a
a
vab :: Int
vab = Int
va Int -> Int -> Int
forall a. Num a => a -> a -> a
+ a -> Int
forall a. Sized a => a -> Int
size a
b
vabc :: Int
vabc = Int
vab Int -> Int -> Int
forall a. Num a => a -> a -> a
+ a -> Int
forall a. Sized a => a -> Int
size a
c
update :: Int -> a -> Seq a -> Seq a
update :: Int -> a -> Seq a -> Seq a
update i :: Int
i x :: a
x = (a -> a) -> Int -> Seq a -> Seq a
forall a. (a -> a) -> Int -> Seq a -> Seq a
adjust (a -> a -> a
forall a b. a -> b -> a
const a
x) Int
i
adjust :: (a -> a) -> Int -> Seq a -> Seq a
adjust :: (a -> a) -> Int -> Seq a -> Seq a
adjust f :: a -> a
f i :: Int
i (Seq xs :: FingerTree (Elem a)
xs)
| 0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
i Bool -> Bool -> Bool
&& Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< FingerTree (Elem a) -> Int
forall a. Sized a => a -> Int
size FingerTree (Elem a)
xs = FingerTree (Elem a) -> Seq a
forall a. FingerTree (Elem a) -> Seq a
Seq ((Int -> Elem a -> Elem a)
-> Int -> FingerTree (Elem a) -> FingerTree (Elem a)
forall a.
Sized a =>
(Int -> a -> a) -> Int -> FingerTree a -> FingerTree a
adjustTree ((Elem a -> Elem a) -> Int -> Elem a -> Elem a
forall a b. a -> b -> a
const ((a -> a) -> Elem a -> Elem a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
f)) (-Int
i) FingerTree (Elem a)
xs)
| Bool
otherwise = FingerTree (Elem a) -> Seq a
forall a. FingerTree (Elem a) -> Seq a
Seq FingerTree (Elem a)
xs
{-# SPECIALIZE adjustTree :: (Int -> Elem a -> Elem a) -> Int -> FingerTree (Elem a) -> FingerTree (Elem a) #-}
{-# SPECIALIZE adjustTree :: (Int -> Node a -> Node a) -> Int -> FingerTree (Node a) -> FingerTree (Node a) #-}
adjustTree :: Sized a => (Int -> a -> a) ->
Int -> FingerTree a -> FingerTree a
adjustTree :: (Int -> a -> a) -> Int -> FingerTree a -> FingerTree a
adjustTree f :: Int -> a -> a
f i :: Int
i (Single x :: a
x) = a -> FingerTree a
forall a. a -> FingerTree a
Single (Int -> a -> a
f Int
i a
x)
adjustTree f :: Int -> a -> a
f i :: Int
i (Deep s :: Int
s pr :: Digit a
pr m :: FingerTree (Node a)
m sf :: Digit a
sf)
| Int
vpr Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0 = Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
s ((Int -> a -> a) -> Int -> Digit a -> Digit a
forall a. Sized a => (Int -> a -> a) -> Int -> Digit a -> Digit a
adjustDigit Int -> a -> a
f Int
i Digit a
pr) FingerTree (Node a)
m Digit a
sf
| Int
vm Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0 = Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
s Digit a
pr ((Int -> Node a -> Node a)
-> Int -> FingerTree (Node a) -> FingerTree (Node a)
forall a.
Sized a =>
(Int -> a -> a) -> Int -> FingerTree a -> FingerTree a
adjustTree ((Int -> a -> a) -> Int -> Node a -> Node a
forall a. Sized a => (Int -> a -> a) -> Int -> Node a -> Node a
adjustNode Int -> a -> a
f) Int
vpr FingerTree (Node a)
m) Digit a
sf
| Bool
otherwise = Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
s Digit a
pr FingerTree (Node a)
m ((Int -> a -> a) -> Int -> Digit a -> Digit a
forall a. Sized a => (Int -> a -> a) -> Int -> Digit a -> Digit a
adjustDigit Int -> a -> a
f Int
vm Digit a
sf)
where vpr :: Int
vpr = Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Digit a -> Int
forall a. Sized a => a -> Int
size Digit a
pr
vm :: Int
vm = Int
vpr Int -> Int -> Int
forall a. Num a => a -> a -> a
+ FingerTree (Node a) -> Int
forall a. Sized a => a -> Int
size FingerTree (Node a)
m
{-# SPECIALIZE adjustNode :: (Int -> Elem a -> Elem a) -> Int -> Node (Elem a) -> Node (Elem a) #-}
{-# SPECIALIZE adjustNode :: (Int -> Node a -> Node a) -> Int -> Node (Node a) -> Node (Node a) #-}
adjustNode :: Sized a => (Int -> a -> a) -> Int -> Node a -> Node a
adjustNode :: (Int -> a -> a) -> Int -> Node a -> Node a
adjustNode f :: Int -> a -> a
f i :: Int
i (Node2 s :: Int
s a :: a
a b :: a
b)
| Int
va Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0 = Int -> a -> a -> Node a
forall a. Int -> a -> a -> Node a
Node2 Int
s (Int -> a -> a
f Int
i a
a) a
b
| Bool
otherwise = Int -> a -> a -> Node a
forall a. Int -> a -> a -> Node a
Node2 Int
s a
a (Int -> a -> a
f Int
va a
b)
where va :: Int
va = Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ a -> Int
forall a. Sized a => a -> Int
size a
a
adjustNode f :: Int -> a -> a
f i :: Int
i (Node3 s :: Int
s a :: a
a b :: a
b c :: a
c)
| Int
va Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0 = Int -> a -> a -> a -> Node a
forall a. Int -> a -> a -> a -> Node a
Node3 Int
s (Int -> a -> a
f Int
i a
a) a
b a
c
| Int
vab Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0 = Int -> a -> a -> a -> Node a
forall a. Int -> a -> a -> a -> Node a
Node3 Int
s a
a (Int -> a -> a
f Int
va a
b) a
c
| Bool
otherwise = Int -> a -> a -> a -> Node a
forall a. Int -> a -> a -> a -> Node a
Node3 Int
s a
a a
b (Int -> a -> a
f Int
vab a
c)
where va :: Int
va = Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ a -> Int
forall a. Sized a => a -> Int
size a
a
vab :: Int
vab = Int
va Int -> Int -> Int
forall a. Num a => a -> a -> a
+ a -> Int
forall a. Sized a => a -> Int
size a
b
{-# SPECIALIZE adjustDigit :: (Int -> Elem a -> Elem a) -> Int -> Digit (Elem a) -> Digit (Elem a) #-}
{-# SPECIALIZE adjustDigit :: (Int -> Node a -> Node a) -> Int -> Digit (Node a) -> Digit (Node a) #-}
adjustDigit :: Sized a => (Int -> a -> a) -> Int -> Digit a -> Digit a
adjustDigit :: (Int -> a -> a) -> Int -> Digit a -> Digit a
adjustDigit f :: Int -> a -> a
f i :: Int
i (One a :: a
a) = a -> Digit a
forall a. a -> Digit a
One (Int -> a -> a
f Int
i a
a)
adjustDigit f :: Int -> a -> a
f i :: Int
i (Two a :: a
a b :: a
b)
| Int
va Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0 = a -> a -> Digit a
forall a. a -> a -> Digit a
Two (Int -> a -> a
f Int
i a
a) a
b
| Bool
otherwise = a -> a -> Digit a
forall a. a -> a -> Digit a
Two a
a (Int -> a -> a
f Int
va a
b)
where va :: Int
va = Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ a -> Int
forall a. Sized a => a -> Int
size a
a
adjustDigit f :: Int -> a -> a
f i :: Int
i (Three a :: a
a b :: a
b c :: a
c)
| Int
va Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0 = a -> a -> a -> Digit a
forall a. a -> a -> a -> Digit a
Three (Int -> a -> a
f Int
i a
a) a
b a
c
| Int
vab Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0 = a -> a -> a -> Digit a
forall a. a -> a -> a -> Digit a
Three a
a (Int -> a -> a
f Int
va a
b) a
c
| Bool
otherwise = a -> a -> a -> Digit a
forall a. a -> a -> a -> Digit a
Three a
a a
b (Int -> a -> a
f Int
vab a
c)
where va :: Int
va = Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ a -> Int
forall a. Sized a => a -> Int
size a
a
vab :: Int
vab = Int
va Int -> Int -> Int
forall a. Num a => a -> a -> a
+ a -> Int
forall a. Sized a => a -> Int
size a
b
adjustDigit f :: Int -> a -> a
f i :: Int
i (Four a :: a
a b :: a
b c :: a
c d :: a
d)
| Int
va Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0 = a -> a -> a -> a -> Digit a
forall a. a -> a -> a -> a -> Digit a
Four (Int -> a -> a
f Int
i a
a) a
b a
c a
d
| Int
vab Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0 = a -> a -> a -> a -> Digit a
forall a. a -> a -> a -> a -> Digit a
Four a
a (Int -> a -> a
f Int
va a
b) a
c a
d
| Int
vabc Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0 = a -> a -> a -> a -> Digit a
forall a. a -> a -> a -> a -> Digit a
Four a
a a
b (Int -> a -> a
f Int
vab a
c) a
d
| Bool
otherwise = a -> a -> a -> a -> Digit a
forall a. a -> a -> a -> a -> Digit a
Four a
a a
b a
c (Int -> a -> a
f Int
vabc a
d)
where va :: Int
va = Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ a -> Int
forall a. Sized a => a -> Int
size a
a
vab :: Int
vab = Int
va Int -> Int -> Int
forall a. Num a => a -> a -> a
+ a -> Int
forall a. Sized a => a -> Int
size a
b
vabc :: Int
vabc = Int
vab Int -> Int -> Int
forall a. Num a => a -> a -> a
+ a -> Int
forall a. Sized a => a -> Int
size a
c
take :: Int -> Seq a -> Seq a
take :: Int -> Seq a -> Seq a
take i :: Int
i = (Seq a, Seq a) -> Seq a
forall a b. (a, b) -> a
fst ((Seq a, Seq a) -> Seq a)
-> (Seq a -> (Seq a, Seq a)) -> Seq a -> Seq a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Seq a -> (Seq a, Seq a)
forall a. Int -> Seq a -> (Seq a, Seq a)
splitAt Int
i
drop :: Int -> Seq a -> Seq a
drop :: Int -> Seq a -> Seq a
drop i :: Int
i = (Seq a, Seq a) -> Seq a
forall a b. (a, b) -> b
snd ((Seq a, Seq a) -> Seq a)
-> (Seq a -> (Seq a, Seq a)) -> Seq a -> Seq a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Seq a -> (Seq a, Seq a)
forall a. Int -> Seq a -> (Seq a, Seq a)
splitAt Int
i
splitAt :: Int -> Seq a -> (Seq a, Seq a)
splitAt :: Int -> Seq a -> (Seq a, Seq a)
splitAt i :: Int
i (Seq xs :: FingerTree (Elem a)
xs) = (FingerTree (Elem a) -> Seq a
forall a. FingerTree (Elem a) -> Seq a
Seq FingerTree (Elem a)
l, FingerTree (Elem a) -> Seq a
forall a. FingerTree (Elem a) -> Seq a
Seq FingerTree (Elem a)
r)
where (l :: FingerTree (Elem a)
l, r :: FingerTree (Elem a)
r) = Int
-> FingerTree (Elem a)
-> (FingerTree (Elem a), FingerTree (Elem a))
forall a.
Int
-> FingerTree (Elem a)
-> (FingerTree (Elem a), FingerTree (Elem a))
split Int
i FingerTree (Elem a)
xs
split :: Int -> FingerTree (Elem a) ->
(FingerTree (Elem a), FingerTree (Elem a))
split :: Int
-> FingerTree (Elem a)
-> (FingerTree (Elem a), FingerTree (Elem a))
split i :: Int
i Empty = Int
i Int
-> (FingerTree (Elem a), FingerTree (Elem a))
-> (FingerTree (Elem a), FingerTree (Elem a))
forall a b. a -> b -> b
`seq` (FingerTree (Elem a)
forall a. FingerTree a
Empty, FingerTree (Elem a)
forall a. FingerTree a
Empty)
split i :: Int
i xs :: FingerTree (Elem a)
xs
| FingerTree (Elem a) -> Int
forall a. Sized a => a -> Int
size FingerTree (Elem a)
xs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
i = (FingerTree (Elem a)
l, Elem a -> FingerTree (Elem a) -> FingerTree (Elem a)
forall a. Sized a => a -> FingerTree a -> FingerTree a
consTree Elem a
x FingerTree (Elem a)
r)
| Bool
otherwise = (FingerTree (Elem a)
xs, FingerTree (Elem a)
forall a. FingerTree a
Empty)
where Split l :: FingerTree (Elem a)
l x :: Elem a
x r :: FingerTree (Elem a)
r = Int -> FingerTree (Elem a) -> Split (FingerTree (Elem a)) (Elem a)
forall a. Sized a => Int -> FingerTree a -> Split (FingerTree a) a
splitTree (-Int
i) FingerTree (Elem a)
xs
data Split t a = Split t a t
#if TESTING
deriving Show
#endif
{-# SPECIALIZE splitTree :: Int -> FingerTree (Elem a) -> Split (FingerTree (Elem a)) (Elem a) #-}
{-# SPECIALIZE splitTree :: Int -> FingerTree (Node a) -> Split (FingerTree (Node a)) (Node a) #-}
splitTree :: Sized a => Int -> FingerTree a -> Split (FingerTree a) a
splitTree :: Int -> FingerTree a -> Split (FingerTree a) a
splitTree i :: Int
i (Single x :: a
x) = Int
i Int -> Split (FingerTree a) a -> Split (FingerTree a) a
forall a b. a -> b -> b
`seq` FingerTree a -> a -> FingerTree a -> Split (FingerTree a) a
forall t a. t -> a -> t -> Split t a
Split FingerTree a
forall a. FingerTree a
Empty a
x FingerTree a
forall a. FingerTree a
Empty
splitTree i :: Int
i (Deep _ pr :: Digit a
pr m :: FingerTree (Node a)
m sf :: Digit a
sf)
| Int
vpr Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0 = case Int -> Digit a -> Split (Maybe (Digit a)) a
forall a. Sized a => Int -> Digit a -> Split (Maybe (Digit a)) a
splitDigit Int
i Digit a
pr of
Split l :: Maybe (Digit a)
l x :: a
x r :: Maybe (Digit a)
r -> FingerTree a -> a -> FingerTree a -> Split (FingerTree a) a
forall t a. t -> a -> t -> Split t a
Split (FingerTree a
-> (Digit a -> FingerTree a) -> Maybe (Digit a) -> FingerTree a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe FingerTree a
forall a. FingerTree a
Empty Digit a -> FingerTree a
forall a. Sized a => Digit a -> FingerTree a
digitToTree Maybe (Digit a)
l) a
x (Maybe (Digit a) -> FingerTree (Node a) -> Digit a -> FingerTree a
forall a.
Sized a =>
Maybe (Digit a) -> FingerTree (Node a) -> Digit a -> FingerTree a
deepL Maybe (Digit a)
r FingerTree (Node a)
m Digit a
sf)
| Int
vm Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0 = case Int -> FingerTree (Node a) -> Split (FingerTree (Node a)) (Node a)
forall a. Sized a => Int -> FingerTree a -> Split (FingerTree a) a
splitTree Int
vpr FingerTree (Node a)
m of
Split ml :: FingerTree (Node a)
ml xs :: Node a
xs mr :: FingerTree (Node a)
mr -> case Int -> Node a -> Split (Maybe (Digit a)) a
forall a. Sized a => Int -> Node a -> Split (Maybe (Digit a)) a
splitNode (Int
vpr Int -> Int -> Int
forall a. Num a => a -> a -> a
+ FingerTree (Node a) -> Int
forall a. Sized a => a -> Int
size FingerTree (Node a)
ml) Node a
xs of
Split l :: Maybe (Digit a)
l x :: a
x r :: Maybe (Digit a)
r -> FingerTree a -> a -> FingerTree a -> Split (FingerTree a) a
forall t a. t -> a -> t -> Split t a
Split (Digit a -> FingerTree (Node a) -> Maybe (Digit a) -> FingerTree a
forall a.
Sized a =>
Digit a -> FingerTree (Node a) -> Maybe (Digit a) -> FingerTree a
deepR Digit a
pr FingerTree (Node a)
ml Maybe (Digit a)
l) a
x (Maybe (Digit a) -> FingerTree (Node a) -> Digit a -> FingerTree a
forall a.
Sized a =>
Maybe (Digit a) -> FingerTree (Node a) -> Digit a -> FingerTree a
deepL Maybe (Digit a)
r FingerTree (Node a)
mr Digit a
sf)
| Bool
otherwise = case Int -> Digit a -> Split (Maybe (Digit a)) a
forall a. Sized a => Int -> Digit a -> Split (Maybe (Digit a)) a
splitDigit Int
vm Digit a
sf of
Split l :: Maybe (Digit a)
l x :: a
x r :: Maybe (Digit a)
r -> FingerTree a -> a -> FingerTree a -> Split (FingerTree a) a
forall t a. t -> a -> t -> Split t a
Split (Digit a -> FingerTree (Node a) -> Maybe (Digit a) -> FingerTree a
forall a.
Sized a =>
Digit a -> FingerTree (Node a) -> Maybe (Digit a) -> FingerTree a
deepR Digit a
pr FingerTree (Node a)
m Maybe (Digit a)
l) a
x (FingerTree a
-> (Digit a -> FingerTree a) -> Maybe (Digit a) -> FingerTree a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe FingerTree a
forall a. FingerTree a
Empty Digit a -> FingerTree a
forall a. Sized a => Digit a -> FingerTree a
digitToTree Maybe (Digit a)
r)
where vpr :: Int
vpr = Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Digit a -> Int
forall a. Sized a => a -> Int
size Digit a
pr
vm :: Int
vm = Int
vpr Int -> Int -> Int
forall a. Num a => a -> a -> a
+ FingerTree (Node a) -> Int
forall a. Sized a => a -> Int
size FingerTree (Node a)
m
{-# SPECIALIZE deepL :: Maybe (Digit (Elem a)) -> FingerTree (Node (Elem a)) -> Digit (Elem a) -> FingerTree (Elem a) #-}
{-# SPECIALIZE deepL :: Maybe (Digit (Node a)) -> FingerTree (Node (Node a)) -> Digit (Node a) -> FingerTree (Node a) #-}
deepL :: Sized a => Maybe (Digit a) -> FingerTree (Node a) -> Digit a -> FingerTree a
deepL :: Maybe (Digit a) -> FingerTree (Node a) -> Digit a -> FingerTree a
deepL Nothing m :: FingerTree (Node a)
m sf :: Digit a
sf = case FingerTree (Node a) -> Maybe2 (Node a) (FingerTree (Node a))
forall a. Sized a => FingerTree a -> Maybe2 a (FingerTree a)
viewLTree FingerTree (Node a)
m of
Nothing2 -> Digit a -> FingerTree a
forall a. Sized a => Digit a -> FingerTree a
digitToTree Digit a
sf
Just2 a :: Node a
a m' :: FingerTree (Node a)
m' -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
forall a.
Sized a =>
Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
deep (Node a -> Digit a
forall a. Node a -> Digit a
nodeToDigit Node a
a) FingerTree (Node a)
m' Digit a
sf
deepL (Just pr :: Digit a
pr) m :: FingerTree (Node a)
m sf :: Digit a
sf = Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
forall a.
Sized a =>
Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
deep Digit a
pr FingerTree (Node a)
m Digit a
sf
{-# SPECIALIZE deepR :: Digit (Elem a) -> FingerTree (Node (Elem a)) -> Maybe (Digit (Elem a)) -> FingerTree (Elem a) #-}
{-# SPECIALIZE deepR :: Digit (Node a) -> FingerTree (Node (Node a)) -> Maybe (Digit (Node a)) -> FingerTree (Node a) #-}
deepR :: Sized a => Digit a -> FingerTree (Node a) -> Maybe (Digit a) -> FingerTree a
deepR :: Digit a -> FingerTree (Node a) -> Maybe (Digit a) -> FingerTree a
deepR pr :: Digit a
pr m :: FingerTree (Node a)
m Nothing = case FingerTree (Node a) -> Maybe2 (FingerTree (Node a)) (Node a)
forall a. Sized a => FingerTree a -> Maybe2 (FingerTree a) a
viewRTree FingerTree (Node a)
m of
Nothing2 -> Digit a -> FingerTree a
forall a. Sized a => Digit a -> FingerTree a
digitToTree Digit a
pr
Just2 m' :: FingerTree (Node a)
m' a :: Node a
a -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
forall a.
Sized a =>
Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
deep Digit a
pr FingerTree (Node a)
m' (Node a -> Digit a
forall a. Node a -> Digit a
nodeToDigit Node a
a)
deepR pr :: Digit a
pr m :: FingerTree (Node a)
m (Just sf :: Digit a
sf) = Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
forall a.
Sized a =>
Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
deep Digit a
pr FingerTree (Node a)
m Digit a
sf
{-# SPECIALIZE splitNode :: Int -> Node (Elem a) -> Split (Maybe (Digit (Elem a))) (Elem a) #-}
{-# SPECIALIZE splitNode :: Int -> Node (Node a) -> Split (Maybe (Digit (Node a))) (Node a) #-}
splitNode :: Sized a => Int -> Node a -> Split (Maybe (Digit a)) a
splitNode :: Int -> Node a -> Split (Maybe (Digit a)) a
splitNode i :: Int
i (Node2 _ a :: a
a b :: a
b)
| Int
va Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0 = Maybe (Digit a)
-> a -> Maybe (Digit a) -> Split (Maybe (Digit a)) a
forall t a. t -> a -> t -> Split t a
Split Maybe (Digit a)
forall a. Maybe a
Nothing a
a (Digit a -> Maybe (Digit a)
forall a. a -> Maybe a
Just (a -> Digit a
forall a. a -> Digit a
One a
b))
| Bool
otherwise = Maybe (Digit a)
-> a -> Maybe (Digit a) -> Split (Maybe (Digit a)) a
forall t a. t -> a -> t -> Split t a
Split (Digit a -> Maybe (Digit a)
forall a. a -> Maybe a
Just (a -> Digit a
forall a. a -> Digit a
One a
a)) a
b Maybe (Digit a)
forall a. Maybe a
Nothing
where va :: Int
va = Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ a -> Int
forall a. Sized a => a -> Int
size a
a
splitNode i :: Int
i (Node3 _ a :: a
a b :: a
b c :: a
c)
| Int
va Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0 = Maybe (Digit a)
-> a -> Maybe (Digit a) -> Split (Maybe (Digit a)) a
forall t a. t -> a -> t -> Split t a
Split Maybe (Digit a)
forall a. Maybe a
Nothing a
a (Digit a -> Maybe (Digit a)
forall a. a -> Maybe a
Just (a -> a -> Digit a
forall a. a -> a -> Digit a
Two a
b a
c))
| Int
vab Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0 = Maybe (Digit a)
-> a -> Maybe (Digit a) -> Split (Maybe (Digit a)) a
forall t a. t -> a -> t -> Split t a
Split (Digit a -> Maybe (Digit a)
forall a. a -> Maybe a
Just (a -> Digit a
forall a. a -> Digit a
One a
a)) a
b (Digit a -> Maybe (Digit a)
forall a. a -> Maybe a
Just (a -> Digit a
forall a. a -> Digit a
One a
c))
| Bool
otherwise = Maybe (Digit a)
-> a -> Maybe (Digit a) -> Split (Maybe (Digit a)) a
forall t a. t -> a -> t -> Split t a
Split (Digit a -> Maybe (Digit a)
forall a. a -> Maybe a
Just (a -> a -> Digit a
forall a. a -> a -> Digit a
Two a
a a
b)) a
c Maybe (Digit a)
forall a. Maybe a
Nothing
where va :: Int
va = Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ a -> Int
forall a. Sized a => a -> Int
size a
a
vab :: Int
vab = Int
va Int -> Int -> Int
forall a. Num a => a -> a -> a
+ a -> Int
forall a. Sized a => a -> Int
size a
b
{-# SPECIALIZE splitDigit :: Int -> Digit (Elem a) -> Split (Maybe (Digit (Elem a))) (Elem a) #-}
{-# SPECIALIZE splitDigit :: Int -> Digit (Node a) -> Split (Maybe (Digit (Node a))) (Node a) #-}
splitDigit :: Sized a => Int -> Digit a -> Split (Maybe (Digit a)) a
splitDigit :: Int -> Digit a -> Split (Maybe (Digit a)) a
splitDigit i :: Int
i (One a :: a
a) = Int
i Int -> Split (Maybe (Digit a)) a -> Split (Maybe (Digit a)) a
forall a b. a -> b -> b
`seq` Maybe (Digit a)
-> a -> Maybe (Digit a) -> Split (Maybe (Digit a)) a
forall t a. t -> a -> t -> Split t a
Split Maybe (Digit a)
forall a. Maybe a
Nothing a
a Maybe (Digit a)
forall a. Maybe a
Nothing
splitDigit i :: Int
i (Two a :: a
a b :: a
b)
| Int
va Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0 = Maybe (Digit a)
-> a -> Maybe (Digit a) -> Split (Maybe (Digit a)) a
forall t a. t -> a -> t -> Split t a
Split Maybe (Digit a)
forall a. Maybe a
Nothing a
a (Digit a -> Maybe (Digit a)
forall a. a -> Maybe a
Just (a -> Digit a
forall a. a -> Digit a
One a
b))
| Bool
otherwise = Maybe (Digit a)
-> a -> Maybe (Digit a) -> Split (Maybe (Digit a)) a
forall t a. t -> a -> t -> Split t a
Split (Digit a -> Maybe (Digit a)
forall a. a -> Maybe a
Just (a -> Digit a
forall a. a -> Digit a
One a
a)) a
b Maybe (Digit a)
forall a. Maybe a
Nothing
where va :: Int
va = Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ a -> Int
forall a. Sized a => a -> Int
size a
a
splitDigit i :: Int
i (Three a :: a
a b :: a
b c :: a
c)
| Int
va Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0 = Maybe (Digit a)
-> a -> Maybe (Digit a) -> Split (Maybe (Digit a)) a
forall t a. t -> a -> t -> Split t a
Split Maybe (Digit a)
forall a. Maybe a
Nothing a
a (Digit a -> Maybe (Digit a)
forall a. a -> Maybe a
Just (a -> a -> Digit a
forall a. a -> a -> Digit a
Two a
b a
c))
| Int
vab Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0 = Maybe (Digit a)
-> a -> Maybe (Digit a) -> Split (Maybe (Digit a)) a
forall t a. t -> a -> t -> Split t a
Split (Digit a -> Maybe (Digit a)
forall a. a -> Maybe a
Just (a -> Digit a
forall a. a -> Digit a
One a
a)) a
b (Digit a -> Maybe (Digit a)
forall a. a -> Maybe a
Just (a -> Digit a
forall a. a -> Digit a
One a
c))
| Bool
otherwise = Maybe (Digit a)
-> a -> Maybe (Digit a) -> Split (Maybe (Digit a)) a
forall t a. t -> a -> t -> Split t a
Split (Digit a -> Maybe (Digit a)
forall a. a -> Maybe a
Just (a -> a -> Digit a
forall a. a -> a -> Digit a
Two a
a a
b)) a
c Maybe (Digit a)
forall a. Maybe a
Nothing
where va :: Int
va = Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ a -> Int
forall a. Sized a => a -> Int
size a
a
vab :: Int
vab = Int
va Int -> Int -> Int
forall a. Num a => a -> a -> a
+ a -> Int
forall a. Sized a => a -> Int
size a
b
splitDigit i :: Int
i (Four a :: a
a b :: a
b c :: a
c d :: a
d)
| Int
va Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0 = Maybe (Digit a)
-> a -> Maybe (Digit a) -> Split (Maybe (Digit a)) a
forall t a. t -> a -> t -> Split t a
Split Maybe (Digit a)
forall a. Maybe a
Nothing a
a (Digit a -> Maybe (Digit a)
forall a. a -> Maybe a
Just (a -> a -> a -> Digit a
forall a. a -> a -> a -> Digit a
Three a
b a
c a
d))
| Int
vab Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0 = Maybe (Digit a)
-> a -> Maybe (Digit a) -> Split (Maybe (Digit a)) a
forall t a. t -> a -> t -> Split t a
Split (Digit a -> Maybe (Digit a)
forall a. a -> Maybe a
Just (a -> Digit a
forall a. a -> Digit a
One a
a)) a
b (Digit a -> Maybe (Digit a)
forall a. a -> Maybe a
Just (a -> a -> Digit a
forall a. a -> a -> Digit a
Two a
c a
d))
| Int
vabc Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0 = Maybe (Digit a)
-> a -> Maybe (Digit a) -> Split (Maybe (Digit a)) a
forall t a. t -> a -> t -> Split t a
Split (Digit a -> Maybe (Digit a)
forall a. a -> Maybe a
Just (a -> a -> Digit a
forall a. a -> a -> Digit a
Two a
a a
b)) a
c (Digit a -> Maybe (Digit a)
forall a. a -> Maybe a
Just (a -> Digit a
forall a. a -> Digit a
One a
d))
| Bool
otherwise = Maybe (Digit a)
-> a -> Maybe (Digit a) -> Split (Maybe (Digit a)) a
forall t a. t -> a -> t -> Split t a
Split (Digit a -> Maybe (Digit a)
forall a. a -> Maybe a
Just (a -> a -> a -> Digit a
forall a. a -> a -> a -> Digit a
Three a
a a
b a
c)) a
d Maybe (Digit a)
forall a. Maybe a
Nothing
where va :: Int
va = Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ a -> Int
forall a. Sized a => a -> Int
size a
a
vab :: Int
vab = Int
va Int -> Int -> Int
forall a. Num a => a -> a -> a
+ a -> Int
forall a. Sized a => a -> Int
size a
b
vabc :: Int
vabc = Int
vab Int -> Int -> Int
forall a. Num a => a -> a -> a
+ a -> Int
forall a. Sized a => a -> Int
size a
c
fromList :: [a] -> Seq a
fromList :: [a] -> Seq a
fromList = (Seq a -> a -> Seq a) -> Seq a -> [a] -> Seq a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Data.List.foldl' Seq a -> a -> Seq a
forall a. Seq a -> a -> Seq a
(|>) Seq a
forall a. Seq a
empty
toList :: Seq a -> [a]
toList :: Seq a -> [a]
toList = (a -> [a] -> [a]) -> [a] -> Seq a -> [a]
forall a b. (a -> b -> b) -> b -> Seq a -> b
foldr (:) []
foldr :: (a -> b -> b) -> b -> Seq a -> b
foldr :: (a -> b -> b) -> b -> Seq a -> b
foldr f :: a -> b -> b
f z :: b
z (Seq xs :: FingerTree (Elem a)
xs) = (Elem a -> b -> b) -> b -> FingerTree (Elem a) -> b
forall a b. (a -> b -> b) -> b -> FingerTree a -> b
foldrTree Elem a -> b -> b
f' b
z FingerTree (Elem a)
xs
where f' :: Elem a -> b -> b
f' (Elem x :: a
x) y :: b
y = a -> b -> b
f a
x b
y
foldrTree :: (a -> b -> b) -> b -> FingerTree a -> b
foldrTree :: (a -> b -> b) -> b -> FingerTree a -> b
foldrTree _ z :: b
z Empty = b
z
foldrTree f :: a -> b -> b
f z :: b
z (Single x :: a
x) = a
x a -> b -> b
`f` b
z
foldrTree f :: a -> b -> b
f z :: b
z (Deep _ pr :: Digit a
pr m :: FingerTree (Node a)
m sf :: Digit a
sf) =
(a -> b -> b) -> b -> Digit a -> b
forall a b. (a -> b -> b) -> b -> Digit a -> b
foldrDigit a -> b -> b
f ((Node a -> b -> b) -> b -> FingerTree (Node a) -> b
forall a b. (a -> b -> b) -> b -> FingerTree a -> b
foldrTree ((b -> Node a -> b) -> Node a -> b -> b
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((a -> b -> b) -> b -> Node a -> b
forall a b. (a -> b -> b) -> b -> Node a -> b
foldrNode a -> b -> b
f)) ((a -> b -> b) -> b -> Digit a -> b
forall a b. (a -> b -> b) -> b -> Digit a -> b
foldrDigit a -> b -> b
f b
z Digit a
sf) FingerTree (Node a)
m) Digit a
pr
foldrDigit :: (a -> b -> b) -> b -> Digit a -> b
foldrDigit :: (a -> b -> b) -> b -> Digit a -> b
foldrDigit f :: a -> b -> b
f z :: b
z (One a :: a
a) = a
a a -> b -> b
`f` b
z
foldrDigit f :: a -> b -> b
f z :: b
z (Two a :: a
a b :: a
b) = a
a a -> b -> b
`f` (a
b a -> b -> b
`f` b
z)
foldrDigit f :: a -> b -> b
f z :: b
z (Three a :: a
a b :: a
b c :: a
c) = a
a a -> b -> b
`f` (a
b a -> b -> b
`f` (a
c a -> b -> b
`f` b
z))
foldrDigit f :: a -> b -> b
f z :: b
z (Four a :: a
a b :: a
b c :: a
c d :: a
d) = a
a a -> b -> b
`f` (a
b a -> b -> b
`f` (a
c a -> b -> b
`f` (a
d a -> b -> b
`f` b
z)))
foldrNode :: (a -> b -> b) -> b -> Node a -> b
foldrNode :: (a -> b -> b) -> b -> Node a -> b
foldrNode f :: a -> b -> b
f z :: b
z (Node2 _ a :: a
a b :: a
b) = a
a a -> b -> b
`f` (a
b a -> b -> b
`f` b
z)
foldrNode f :: a -> b -> b
f z :: b
z (Node3 _ a :: a
a b :: a
b c :: a
c) = a
a a -> b -> b
`f` (a
b a -> b -> b
`f` (a
c a -> b -> b
`f` b
z))
foldr1 :: (a -> a -> a) -> Seq a -> a
foldr1 :: (a -> a -> a) -> Seq a -> a
foldr1 f :: a -> a -> a
f (Seq xs :: FingerTree (Elem a)
xs) = Elem a -> a
forall a. Elem a -> a
getElem ((Elem a -> Elem a -> Elem a) -> FingerTree (Elem a) -> Elem a
forall a. (a -> a -> a) -> FingerTree a -> a
foldr1Tree Elem a -> Elem a -> Elem a
f' FingerTree (Elem a)
xs)
where f' :: Elem a -> Elem a -> Elem a
f' (Elem x :: a
x) (Elem y :: a
y) = a -> Elem a
forall a. a -> Elem a
Elem (a -> a -> a
f a
x a
y)
foldr1Tree :: (a -> a -> a) -> FingerTree a -> a
foldr1Tree :: (a -> a -> a) -> FingerTree a -> a
foldr1Tree _ Empty = String -> a
forall a. HasCallStack => String -> a
error "foldr1: empty sequence"
foldr1Tree _ (Single x :: a
x) = a
x
foldr1Tree f :: a -> a -> a
f (Deep _ pr :: Digit a
pr m :: FingerTree (Node a)
m sf :: Digit a
sf) =
(a -> a -> a) -> a -> Digit a -> a
forall a b. (a -> b -> b) -> b -> Digit a -> b
foldrDigit a -> a -> a
f ((Node a -> a -> a) -> a -> FingerTree (Node a) -> a
forall a b. (a -> b -> b) -> b -> FingerTree a -> b
foldrTree ((a -> Node a -> a) -> Node a -> a -> a
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((a -> a -> a) -> a -> Node a -> a
forall a b. (a -> b -> b) -> b -> Node a -> b
foldrNode a -> a -> a
f)) ((a -> a -> a) -> Digit a -> a
forall a. (a -> a -> a) -> Digit a -> a
foldr1Digit a -> a -> a
f Digit a
sf) FingerTree (Node a)
m) Digit a
pr
foldr1Digit :: (a -> a -> a) -> Digit a -> a
foldr1Digit :: (a -> a -> a) -> Digit a -> a
foldr1Digit f :: a -> a -> a
f (One a :: a
a) = a
a
foldr1Digit f :: a -> a -> a
f (Two a :: a
a b :: a
b) = a
a a -> a -> a
`f` a
b
foldr1Digit f :: a -> a -> a
f (Three a :: a
a b :: a
b c :: a
c) = a
a a -> a -> a
`f` (a
b a -> a -> a
`f` a
c)
foldr1Digit f :: a -> a -> a
f (Four a :: a
a b :: a
b c :: a
c d :: a
d) = a
a a -> a -> a
`f` (a
b a -> a -> a
`f` (a
c a -> a -> a
`f` a
d))
foldl :: (a -> b -> a) -> a -> Seq b -> a
foldl :: (a -> b -> a) -> a -> Seq b -> a
foldl f :: a -> b -> a
f z :: a
z (Seq xs :: FingerTree (Elem b)
xs) = (a -> Elem b -> a) -> a -> FingerTree (Elem b) -> a
forall a b. (a -> b -> a) -> a -> FingerTree b -> a
foldlTree a -> Elem b -> a
f' a
z FingerTree (Elem b)
xs
where f' :: a -> Elem b -> a
f' x :: a
x (Elem y :: b
y) = a -> b -> a
f a
x b
y
foldlTree :: (a -> b -> a) -> a -> FingerTree b -> a
foldlTree :: (a -> b -> a) -> a -> FingerTree b -> a
foldlTree _ z :: a
z Empty = a
z
foldlTree f :: a -> b -> a
f z :: a
z (Single x :: b
x) = a
z a -> b -> a
`f` b
x
foldlTree f :: a -> b -> a
f z :: a
z (Deep _ pr :: Digit b
pr m :: FingerTree (Node b)
m sf :: Digit b
sf) =
(a -> b -> a) -> a -> Digit b -> a
forall a b. (a -> b -> a) -> a -> Digit b -> a
foldlDigit a -> b -> a
f ((a -> Node b -> a) -> a -> FingerTree (Node b) -> a
forall a b. (a -> b -> a) -> a -> FingerTree b -> a
foldlTree ((a -> b -> a) -> a -> Node b -> a
forall a b. (a -> b -> a) -> a -> Node b -> a
foldlNode a -> b -> a
f) ((a -> b -> a) -> a -> Digit b -> a
forall a b. (a -> b -> a) -> a -> Digit b -> a
foldlDigit a -> b -> a
f a
z Digit b
pr) FingerTree (Node b)
m) Digit b
sf
foldlDigit :: (a -> b -> a) -> a -> Digit b -> a
foldlDigit :: (a -> b -> a) -> a -> Digit b -> a
foldlDigit f :: a -> b -> a
f z :: a
z (One a :: b
a) = a
z a -> b -> a
`f` b
a
foldlDigit f :: a -> b -> a
f z :: a
z (Two a :: b
a b :: b
b) = (a
z a -> b -> a
`f` b
a) a -> b -> a
`f` b
b
foldlDigit f :: a -> b -> a
f z :: a
z (Three a :: b
a b :: b
b c :: b
c) = ((a
z a -> b -> a
`f` b
a) a -> b -> a
`f` b
b) a -> b -> a
`f` b
c
foldlDigit f :: a -> b -> a
f z :: a
z (Four a :: b
a b :: b
b c :: b
c d :: b
d) = (((a
z a -> b -> a
`f` b
a) a -> b -> a
`f` b
b) a -> b -> a
`f` b
c) a -> b -> a
`f` b
d
foldlNode :: (a -> b -> a) -> a -> Node b -> a
foldlNode :: (a -> b -> a) -> a -> Node b -> a
foldlNode f :: a -> b -> a
f z :: a
z (Node2 _ a :: b
a b :: b
b) = (a
z a -> b -> a
`f` b
a) a -> b -> a
`f` b
b
foldlNode f :: a -> b -> a
f z :: a
z (Node3 _ a :: b
a b :: b
b c :: b
c) = ((a
z a -> b -> a
`f` b
a) a -> b -> a
`f` b
b) a -> b -> a
`f` b
c
foldl1 :: (a -> a -> a) -> Seq a -> a
foldl1 :: (a -> a -> a) -> Seq a -> a
foldl1 f :: a -> a -> a
f (Seq xs :: FingerTree (Elem a)
xs) = Elem a -> a
forall a. Elem a -> a
getElem ((Elem a -> Elem a -> Elem a) -> FingerTree (Elem a) -> Elem a
forall a. (a -> a -> a) -> FingerTree a -> a
foldl1Tree Elem a -> Elem a -> Elem a
f' FingerTree (Elem a)
xs)
where f' :: Elem a -> Elem a -> Elem a
f' (Elem x :: a
x) (Elem y :: a
y) = a -> Elem a
forall a. a -> Elem a
Elem (a -> a -> a
f a
x a
y)
foldl1Tree :: (a -> a -> a) -> FingerTree a -> a
foldl1Tree :: (a -> a -> a) -> FingerTree a -> a
foldl1Tree _ Empty = String -> a
forall a. HasCallStack => String -> a
error "foldl1: empty sequence"
foldl1Tree _ (Single x :: a
x) = a
x
foldl1Tree f :: a -> a -> a
f (Deep _ pr :: Digit a
pr m :: FingerTree (Node a)
m sf :: Digit a
sf) =
(a -> a -> a) -> a -> Digit a -> a
forall a b. (a -> b -> a) -> a -> Digit b -> a
foldlDigit a -> a -> a
f ((a -> Node a -> a) -> a -> FingerTree (Node a) -> a
forall a b. (a -> b -> a) -> a -> FingerTree b -> a
foldlTree ((a -> a -> a) -> a -> Node a -> a
forall a b. (a -> b -> a) -> a -> Node b -> a
foldlNode a -> a -> a
f) ((a -> a -> a) -> Digit a -> a
forall a. (a -> a -> a) -> Digit a -> a
foldl1Digit a -> a -> a
f Digit a
pr) FingerTree (Node a)
m) Digit a
sf
foldl1Digit :: (a -> a -> a) -> Digit a -> a
foldl1Digit :: (a -> a -> a) -> Digit a -> a
foldl1Digit f :: a -> a -> a
f (One a :: a
a) = a
a
foldl1Digit f :: a -> a -> a
f (Two a :: a
a b :: a
b) = a
a a -> a -> a
`f` a
b
foldl1Digit f :: a -> a -> a
f (Three a :: a
a b :: a
b c :: a
c) = (a
a a -> a -> a
`f` a
b) a -> a -> a
`f` a
c
foldl1Digit f :: a -> a -> a
f (Four a :: a
a b :: a
b c :: a
c d :: a
d) = ((a
a a -> a -> a
`f` a
b) a -> a -> a
`f` a
c) a -> a -> a
`f` a
d
foldr' :: (a -> b -> b) -> b -> Seq a -> b
foldr' :: (a -> b -> b) -> b -> Seq a -> b
foldr' f :: a -> b -> b
f z :: b
z xs :: Seq a
xs = ((b -> b) -> a -> b -> b) -> (b -> b) -> Seq a -> b -> b
forall a b. (a -> b -> a) -> a -> Seq b -> a
foldl (b -> b) -> a -> b -> b
forall b. (b -> b) -> a -> b -> b
f' b -> b
forall a. a -> a
id Seq a
xs b
z
where f' :: (b -> b) -> a -> b -> b
f' k :: b -> b
k x :: a
x z :: b
z = b -> b
k (b -> b) -> b -> b
forall a b. (a -> b) -> a -> b
$! a -> b -> b
f a
x b
z
foldrM :: Monad m => (a -> b -> m b) -> b -> Seq a -> m b
foldrM :: (a -> b -> m b) -> b -> Seq a -> m b
foldrM f :: a -> b -> m b
f z :: b
z xs :: Seq a
xs = ((b -> m b) -> a -> b -> m b) -> (b -> m b) -> Seq a -> b -> m b
forall a b. (a -> b -> a) -> a -> Seq b -> a
foldl (b -> m b) -> a -> b -> m b
forall b. (b -> m b) -> a -> b -> m b
f' b -> m b
forall (m :: * -> *) a. Monad m => a -> m a
return Seq a
xs b
z
where f' :: (b -> m b) -> a -> b -> m b
f' k :: b -> m b
k x :: a
x z :: b
z = a -> b -> m b
f a
x b
z m b -> (b -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= b -> m b
k
foldl' :: (a -> b -> a) -> a -> Seq b -> a
foldl' :: (a -> b -> a) -> a -> Seq b -> a
foldl' f :: a -> b -> a
f z :: a
z xs :: Seq b
xs = (b -> (a -> a) -> a -> a) -> (a -> a) -> Seq b -> a -> a
forall a b. (a -> b -> b) -> b -> Seq a -> b
foldr b -> (a -> a) -> a -> a
forall b. b -> (a -> b) -> a -> b
f' a -> a
forall a. a -> a
id Seq b
xs a
z
where f' :: b -> (a -> b) -> a -> b
f' x :: b
x k :: a -> b
k z :: a
z = a -> b
k (a -> b) -> a -> b
forall a b. (a -> b) -> a -> b
$! a -> b -> a
f a
z b
x
foldlM :: Monad m => (a -> b -> m a) -> a -> Seq b -> m a
foldlM :: (a -> b -> m a) -> a -> Seq b -> m a
foldlM f :: a -> b -> m a
f z :: a
z xs :: Seq b
xs = (b -> (a -> m a) -> a -> m a) -> (a -> m a) -> Seq b -> a -> m a
forall a b. (a -> b -> b) -> b -> Seq a -> b
foldr b -> (a -> m a) -> a -> m a
forall b. b -> (a -> m b) -> a -> m b
f' a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Seq b
xs a
z
where f' :: b -> (a -> m b) -> a -> m b
f' x :: b
x k :: a -> m b
k z :: a
z = a -> b -> m a
f a
z b
x m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> m b
k
reverse :: Seq a -> Seq a
reverse :: Seq a -> Seq a
reverse (Seq xs :: FingerTree (Elem a)
xs) = FingerTree (Elem a) -> Seq a
forall a. FingerTree (Elem a) -> Seq a
Seq ((Elem a -> Elem a) -> FingerTree (Elem a) -> FingerTree (Elem a)
forall a. (a -> a) -> FingerTree a -> FingerTree a
reverseTree Elem a -> Elem a
forall a. a -> a
id FingerTree (Elem a)
xs)
reverseTree :: (a -> a) -> FingerTree a -> FingerTree a
reverseTree :: (a -> a) -> FingerTree a -> FingerTree a
reverseTree _ Empty = FingerTree a
forall a. FingerTree a
Empty
reverseTree f :: a -> a
f (Single x :: a
x) = a -> FingerTree a
forall a. a -> FingerTree a
Single (a -> a
f a
x)
reverseTree f :: a -> a
f (Deep s :: Int
s pr :: Digit a
pr m :: FingerTree (Node a)
m sf :: Digit a
sf) =
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
s ((a -> a) -> Digit a -> Digit a
forall a. (a -> a) -> Digit a -> Digit a
reverseDigit a -> a
f Digit a
sf)
((Node a -> Node a) -> FingerTree (Node a) -> FingerTree (Node a)
forall a. (a -> a) -> FingerTree a -> FingerTree a
reverseTree ((a -> a) -> Node a -> Node a
forall a. (a -> a) -> Node a -> Node a
reverseNode a -> a
f) FingerTree (Node a)
m)
((a -> a) -> Digit a -> Digit a
forall a. (a -> a) -> Digit a -> Digit a
reverseDigit a -> a
f Digit a
pr)
reverseDigit :: (a -> a) -> Digit a -> Digit a
reverseDigit :: (a -> a) -> Digit a -> Digit a
reverseDigit f :: a -> a
f (One a :: a
a) = a -> Digit a
forall a. a -> Digit a
One (a -> a
f a
a)
reverseDigit f :: a -> a
f (Two a :: a
a b :: a
b) = a -> a -> Digit a
forall a. a -> a -> Digit a
Two (a -> a
f a
b) (a -> a
f a
a)
reverseDigit f :: a -> a
f (Three a :: a
a b :: a
b c :: a
c) = a -> a -> a -> Digit a
forall a. a -> a -> a -> Digit a
Three (a -> a
f a
c) (a -> a
f a
b) (a -> a
f a
a)
reverseDigit f :: a -> a
f (Four a :: a
a b :: a
b c :: a
c d :: a
d) = a -> a -> a -> a -> Digit a
forall a. a -> a -> a -> a -> Digit a
Four (a -> a
f a
d) (a -> a
f a
c) (a -> a
f a
b) (a -> a
f a
a)
reverseNode :: (a -> a) -> Node a -> Node a
reverseNode :: (a -> a) -> Node a -> Node a
reverseNode f :: a -> a
f (Node2 s :: Int
s a :: a
a b :: a
b) = Int -> a -> a -> Node a
forall a. Int -> a -> a -> Node a
Node2 Int
s (a -> a
f a
b) (a -> a
f a
a)
reverseNode f :: a -> a
f (Node3 s :: Int
s a :: a
a b :: a
b c :: a
c) = Int -> a -> a -> a -> Node a
forall a. Int -> a -> a -> a -> Node a
Node3 Int
s (a -> a
f a
c) (a -> a
f a
b) (a -> a
f a
a)
#if TESTING
instance Arbitrary a => Arbitrary (Seq a) where
arbitrary = liftM Seq arbitrary
coarbitrary (Seq x) = coarbitrary x
instance Arbitrary a => Arbitrary (Elem a) where
arbitrary = liftM Elem arbitrary
coarbitrary (Elem x) = coarbitrary x
instance (Arbitrary a, Sized a) => Arbitrary (FingerTree a) where
arbitrary = sized arb
where arb :: (Arbitrary a, Sized a) => Int -> Gen (FingerTree a)
arb 0 = return Empty
arb 1 = liftM Single arbitrary
arb n = liftM3 deep arbitrary (arb (n `div` 2)) arbitrary
coarbitrary Empty = variant 0
coarbitrary (Single x) = variant 1 . coarbitrary x
coarbitrary (Deep _ pr m sf) =
variant 2 . coarbitrary pr . coarbitrary m . coarbitrary sf
instance (Arbitrary a, Sized a) => Arbitrary (Node a) where
arbitrary = oneof [
liftM2 node2 arbitrary arbitrary,
liftM3 node3 arbitrary arbitrary arbitrary]
coarbitrary (Node2 _ a b) = variant 0 . coarbitrary a . coarbitrary b
coarbitrary (Node3 _ a b c) =
variant 1 . coarbitrary a . coarbitrary b . coarbitrary c
instance Arbitrary a => Arbitrary (Digit a) where
arbitrary = oneof [
liftM One arbitrary,
liftM2 Two arbitrary arbitrary,
liftM3 Three arbitrary arbitrary arbitrary,
liftM4 Four arbitrary arbitrary arbitrary arbitrary]
coarbitrary (One a) = variant 0 . coarbitrary a
coarbitrary (Two a b) = variant 1 . coarbitrary a . coarbitrary b
coarbitrary (Three a b c) =
variant 2 . coarbitrary a . coarbitrary b . coarbitrary c
coarbitrary (Four a b c d) =
variant 3 . coarbitrary a . coarbitrary b . coarbitrary c . coarbitrary d
class Valid a where
valid :: a -> Bool
instance Valid (Elem a) where
valid _ = True
instance Valid (Seq a) where
valid (Seq xs) = valid xs
instance (Sized a, Valid a) => Valid (FingerTree a) where
valid Empty = True
valid (Single x) = valid x
valid (Deep s pr m sf) =
s == size pr + size m + size sf && valid pr && valid m && valid sf
instance (Sized a, Valid a) => Valid (Node a) where
valid (Node2 s a b) = s == size a + size b && valid a && valid b
valid (Node3 s a b c) =
s == size a + size b + size c && valid a && valid b && valid c
instance Valid a => Valid (Digit a) where
valid (One a) = valid a
valid (Two a b) = valid a && valid b
valid (Three a b c) = valid a && valid b && valid c
valid (Four a b c d) = valid a && valid b && valid c && valid d
#endif