{-# LANGUAGE CPP #-}
{-# OPTIONS_HADDOCK hide #-}
-- #hide
-----------------------------------------------------------------------------
-- |
-- Module      :  Data.Sequence
-- Copyright   :  (c) Ross Paterson 2005
-- License     :  BSD-style
-- Maintainer  :  ross@soi.city.ac.uk
-- Stability   :  experimental
-- Portability :  portable
--
-- General purpose finite sequences.
-- Apart from being finite and having strict operations, sequences
-- also differ from lists in supporting a wider variety of operations
-- efficiently.
--
-- An amortized running time is given for each operation, with /n/ referring
-- to the length of the sequence and /i/ being the integral index used by
-- some operations.  These bounds hold even in a persistent (shared) setting.
--
-- The implementation uses 2-3 finger trees annotated with sizes,
-- as described in section 4.2 of
--
--    * Ralf Hinze and Ross Paterson,
--      \"Finger trees: a simple general-purpose data structure\",
--      submitted to /Journal of Functional Programming/.
--      <http://www.soi.city.ac.uk/~ross/papers/FingerTree.html>
--
-----------------------------------------------------------------------------

module Graphics.UI.Gtk.ModelView.Sequence (
        Seq,
        -- * Construction
        empty,          -- :: Seq a
        singleton,      -- :: a -> Seq a
        (<|),           -- :: a -> Seq a -> Seq a
        (|>),           -- :: Seq a -> a -> Seq a
        (><),           -- :: Seq a -> Seq a -> Seq a
        -- * Deconstruction
        null,           -- :: Seq a -> Bool
        -- ** Views
        ViewL(..),
        viewl,          -- :: Seq a -> ViewL a
        ViewR(..),
        viewr,          -- :: Seq a -> ViewR a
        -- ** Indexing
        length,         -- :: Seq a -> Int
        index,          -- :: Seq a -> Int -> a
        adjust,         -- :: (a -> a) -> Int -> Seq a -> Seq a
        update,         -- :: Int -> a -> Seq a -> Seq a
        take,           -- :: Int -> Seq a -> Seq a
        drop,           -- :: Int -> Seq a -> Seq a
        splitAt,        -- :: Int -> Seq a -> (Seq a, Seq a)
        -- * Lists
        fromList,       -- :: [a] -> Seq a
        toList,         -- :: Seq a -> [a]
        -- * Folds
        -- ** Right associative
        foldr,          -- :: (a -> b -> b) -> b -> Seq a -> b
        foldr1,         -- :: (a -> a -> a) -> Seq a -> a
        foldr',         -- :: (a -> b -> b) -> b -> Seq a -> b
        foldrM,         -- :: Monad m => (a -> b -> m b) -> b -> Seq a -> m b
        -- ** Left associative
        foldl,          -- :: (a -> b -> a) -> a -> Seq b -> a
        foldl1,         -- :: (a -> a -> a) -> Seq a -> a
        foldl',         -- :: (a -> b -> a) -> a -> Seq b -> a
        foldlM,         -- :: Monad m => (a -> b -> m a) -> a -> Seq b -> m a
        -- * Transformations
        reverse,        -- :: Seq a -> Seq a
#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

------------------------------------------------------------------------
-- Random access sequences
------------------------------------------------------------------------

-- | General-purpose finite sequences.
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

-- Finger trees

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

-- Digits

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)

-- Nodes

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

-- Elements

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

------------------------------------------------------------------------
-- Construction
------------------------------------------------------------------------

-- | /O(1)/. The empty sequence.
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

-- | /O(1)/. A singleton sequence.
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))

-- | /O(1)/. Add an element to the left end of a sequence.
-- Mnemonic: a triangle with the single element at the pointy end.
(<|)            :: 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

-- | /O(1)/. Add an element to the right end of a sequence.
-- Mnemonic: a triangle with the single element at the pointy end.
(|>)            :: 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)

-- | /O(log(min(n1,n2)))/. Concatenate two sequences.
(><)            :: 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)

-- The appendTree/addDigits gunk below is machine generated

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

------------------------------------------------------------------------
-- Deconstruction
------------------------------------------------------------------------

-- | /O(1)/. Is this the empty sequence?
null            :: Seq a -> Bool
null :: Seq a -> Bool
null (Seq Empty) = Bool
True
null _          =  Bool
False

-- | /O(1)/. The number of elements in the sequence.
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

-- Views

data Maybe2 a b = Nothing2 | Just2 a b

-- | View of the left end of a sequence.
data ViewL a
        = EmptyL        -- ^ empty sequence
        | a :< Seq a    -- ^ leftmost element and the rest of the sequence
#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

-- | /O(1)/. Analyse the left end of a sequence.
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)

-- | View of the right end of a sequence.
data ViewR a
        = EmptyR        -- ^ empty sequence
        | Seq a :> a    -- ^ the sequence minus the rightmost element,
                        -- and the rightmost element
#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

-- | /O(1)/. Analyse the right end of a sequence.
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

-- Indexing

-- | /O(log(min(i,n-i)))/. The element at the specified position
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

-- | /O(log(min(i,n-i)))/. Replace the element at the specified position
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

-- | /O(log(min(i,n-i)))/. Update the element at the specified position
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

-- Splitting

-- | /O(log(min(i,n-i)))/. The first @i@ elements of a sequence.
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

-- | /O(log(min(i,n-i)))/. Elements of sequence after the first @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

-- | /O(log(min(i,n-i)))/. Split a sequence at a given position.
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

------------------------------------------------------------------------
-- Lists
------------------------------------------------------------------------

-- | /O(n)/. Create a sequence from a finite list of elements.
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

-- | /O(n)/. List of elements of the sequence.
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 (:) []

------------------------------------------------------------------------
-- Folds
------------------------------------------------------------------------

-- | /O(n*t)/. Fold over the elements of a sequence,
-- associating to the right.
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))

-- | /O(n*t)/. A variant of 'foldr' that has no base case,
-- and thus may only be applied to non-empty sequences.
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))

-- | /O(n*t)/. Fold over the elements of a sequence,
-- associating to the left.
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

-- | /O(n*t)/. A variant of 'foldl' that has no base case,
-- and thus may only be applied to non-empty sequences.
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

------------------------------------------------------------------------
-- Derived folds
------------------------------------------------------------------------

-- | /O(n*t)/. Fold over the elements of a sequence,
-- associating to the right, but strictly.
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

-- | /O(n*t)/. Monadic fold over the elements of a sequence,
-- associating to the right, i.e. from right to left.
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

-- | /O(n*t)/. Fold over the elements of a sequence,
-- associating to the right, but strictly.
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

-- | /O(n*t)/. Monadic fold over the elements of a sequence,
-- associating to the left, i.e. from left to right.
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
------------------------------------------------------------------------

-- | /O(n)/. The reverse of a sequence.
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

------------------------------------------------------------------------
-- QuickCheck
------------------------------------------------------------------------

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

------------------------------------------------------------------------
-- Valid trees
------------------------------------------------------------------------

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