{-# LANGUAGE CPP #-}
#include "containers.h"
{-# LANGUAGE BangPatterns #-}
#if __GLASGOW_HASKELL__
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE Trustworthy #-}
#endif
#ifdef DEFINE_PATTERN_SYNONYMS
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ViewPatterns #-}
#endif
{-# LANGUAGE PatternGuards #-}
{-# OPTIONS_HADDOCK not-home #-}
module Data.Sequence.Internal (
Elem(..), FingerTree(..), Node(..), Digit(..), Sized(..), MaybeForce,
#if defined(DEFINE_PATTERN_SYNONYMS)
Seq (.., Empty, (:<|), (:|>)),
#else
Seq (..),
#endif
State(..),
execState,
foldDigit,
foldNode,
foldWithIndexDigit,
foldWithIndexNode,
empty,
singleton,
(<|),
(|>),
(><),
fromList,
fromFunction,
fromArray,
replicate,
replicateA,
replicateM,
cycleTaking,
iterateN,
unfoldr,
unfoldl,
null,
length,
ViewL(..),
viewl,
ViewR(..),
viewr,
scanl,
scanl1,
scanr,
scanr1,
tails,
inits,
chunksOf,
takeWhileL,
takeWhileR,
dropWhileL,
dropWhileR,
spanl,
spanr,
breakl,
breakr,
partition,
filter,
lookup,
(!?),
index,
adjust,
adjust',
update,
take,
drop,
insertAt,
deleteAt,
splitAt,
elemIndexL,
elemIndicesL,
elemIndexR,
elemIndicesR,
findIndexL,
findIndicesL,
findIndexR,
findIndicesR,
foldMapWithIndex,
foldlWithIndex,
foldrWithIndex,
mapWithIndex,
traverseWithIndex,
reverse,
intersperse,
liftA2Seq,
zip,
zipWith,
zip3,
zipWith3,
zip4,
zipWith4,
unzip,
unzipWith,
#ifdef TESTING
deep,
node2,
node3,
#endif
) where
import Prelude hiding (
Functor(..),
#if MIN_VERSION_base(4,11,0)
(<>),
#endif
#if MIN_VERSION_base(4,8,0)
Applicative, (<$>), foldMap, Monoid,
#endif
null, length, lookup, take, drop, splitAt, foldl, foldl1, foldr, foldr1,
scanl, scanl1, scanr, scanr1, replicate, zip, zipWith, zip3, zipWith3,
unzip, takeWhile, dropWhile, iterate, reverse, filter, mapM, sum, all)
import qualified Data.List
import Control.Applicative (Applicative(..), (<$>), (<**>), Alternative,
liftA2, liftA3)
import qualified Control.Applicative as Applicative
import Control.DeepSeq (NFData(rnf))
import Control.Monad (MonadPlus(..))
import Data.Monoid (Monoid(..))
import Data.Functor (Functor(..))
import Utils.Containers.Internal.State (State(..), execState)
import Data.Foldable (Foldable(foldl, foldl1, foldr, foldr1, foldMap, foldl', foldr'), toList)
#if MIN_VERSION_base(4,9,0)
import qualified Data.Semigroup as Semigroup
import Data.Functor.Classes
#endif
import Data.Traversable
import Data.Typeable
#ifdef __GLASGOW_HASKELL__
import GHC.Exts (build)
import Text.Read (Lexeme(Ident), lexP, parens, prec,
readPrec, readListPrec, readListPrecDefault)
import Data.Data
import Data.String (IsString(..))
#endif
#if __GLASGOW_HASKELL__
import GHC.Generics (Generic, Generic1)
#endif
import Data.Array (Ix, Array)
import qualified Data.Array
#ifdef __GLASGOW_HASKELL__
import qualified GHC.Arr
#endif
import Utils.Containers.Internal.Coercions ((.#), (.^#))
#if __GLASGOW_HASKELL__ >= 708
import Data.Coerce
import qualified GHC.Exts
#else
#endif
#if MIN_VERSION_base(4,8,0)
import Data.Functor.Identity (Identity(..))
#endif
#if !MIN_VERSION_base(4,8,0)
import Data.Word (Word)
#endif
import Utils.Containers.Internal.StrictPair (StrictPair (..), toPair)
import Control.Monad.Zip (MonadZip (..))
import Control.Monad.Fix (MonadFix (..), fix)
default ()
infixr 6 <>
(<>) :: Monoid m => m -> m -> m
<> :: m -> m -> m
(<>) = m -> m -> m
forall a. Monoid a => a -> a -> a
mappend
{-# INLINE (<>) #-}
infixr 5 `consTree`
infixl 5 `snocTree`
infixr 5 `appendTree0`
infixr 5 ><
infixr 5 <|, :<
infixl 5 |>, :>
#ifdef DEFINE_PATTERN_SYNONYMS
infixr 5 :<|
infixl 5 :|>
#if __GLASGOW_HASKELL__ >= 801
{-# COMPLETE (:<|), Empty #-}
{-# COMPLETE (:|>), Empty #-}
#endif
pattern Empty :: Seq a
pattern $bEmpty :: Seq a
$mEmpty :: forall r a. Seq a -> (Void# -> r) -> (Void# -> r) -> r
Empty = Seq EmptyT
pattern (:<|) :: a -> Seq a -> Seq a
pattern x $b:<| :: a -> Seq a -> Seq a
$m:<| :: forall r a. Seq a -> (a -> Seq a -> r) -> (Void# -> r) -> r
:<| xs <- (viewl -> x :< xs)
where
x :: a
x :<| xs :: Seq a
xs = a
x a -> Seq a -> Seq a
forall a. a -> Seq a -> Seq a
<| Seq a
xs
pattern (:|>) :: Seq a -> a -> Seq a
pattern xs $b:|> :: Seq a -> a -> Seq a
$m:|> :: forall r a. Seq a -> (Seq a -> a -> r) -> (Void# -> r) -> r
:|> x <- (viewr -> xs :> x)
where
xs :: Seq a
xs :|> x :: a
x = Seq a
xs Seq a -> a -> Seq a
forall a. Seq a -> a -> Seq a
|> a
x
#endif
class Sized a where
size :: a -> Int
class MaybeForce a where
maybeRwhnf :: a -> ()
mseq :: MaybeForce a => a -> b -> b
mseq :: a -> b -> b
mseq a :: a
a b :: b
b = case a -> ()
forall a. MaybeForce a => a -> ()
maybeRwhnf a
a of () -> b
b
{-# INLINE mseq #-}
infixr 0 $!?
($!?) :: MaybeForce a => (a -> b) -> a -> b
f :: a -> b
f $!? :: (a -> b) -> a -> b
$!? a :: a
a = case a -> ()
forall a. MaybeForce a => a -> ()
maybeRwhnf a
a of () -> a -> b
f a
a
{-# INLINE ($!?) #-}
instance MaybeForce (Elem a) where
maybeRwhnf :: Elem a -> ()
maybeRwhnf _ = ()
{-# INLINE maybeRwhnf #-}
instance MaybeForce (Node a) where
maybeRwhnf :: Node a -> ()
maybeRwhnf !Node a
_ = ()
{-# INLINE maybeRwhnf #-}
newtype ForceBox a = ForceBox a
instance MaybeForce (ForceBox a) where
maybeRwhnf :: ForceBox a -> ()
maybeRwhnf !ForceBox a
_ = ()
instance Sized (ForceBox a) where
size :: ForceBox a -> Int
size _ = 1
newtype Seq a = Seq (FingerTree (Elem a))
instance Functor Seq where
fmap :: (a -> b) -> Seq a -> Seq b
fmap = (a -> b) -> Seq a -> Seq b
forall a b. (a -> b) -> Seq a -> Seq b
fmapSeq
#ifdef __GLASGOW_HASKELL__
x :: a
x <$ :: a -> Seq b -> Seq a
<$ s :: Seq b
s = Int -> a -> Seq a
forall a. Int -> a -> Seq a
replicate (Seq b -> Int
forall a. Seq a -> Int
length Seq b
s) a
x
#endif
fmapSeq :: (a -> b) -> Seq a -> Seq b
fmapSeq :: (a -> b) -> Seq a -> Seq b
fmapSeq 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)
#ifdef __GLASGOW_HASKELL__
{-# NOINLINE [1] fmapSeq #-}
{-# RULES
"fmapSeq/fmapSeq" forall f g xs . fmapSeq f (fmapSeq g xs) = fmapSeq (f . g) xs
#-}
#endif
#if __GLASGOW_HASKELL__ >= 709
{-# RULES
"fmapSeq/coerce" fmapSeq coerce = coerce
#-}
#endif
getSeq :: Seq a -> FingerTree (Elem a)
getSeq :: Seq a -> FingerTree (Elem a)
getSeq (Seq xs :: FingerTree (Elem a)
xs) = FingerTree (Elem a)
xs
instance Foldable Seq where
foldMap :: (a -> m) -> Seq a -> m
foldMap f :: a -> m
f = (Elem a -> m) -> FingerTree (Elem a) -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (a -> m
f (a -> m) -> (Elem a -> a) -> Elem a -> m
forall b a c. Coercible b a => (b -> c) -> (a -> b) -> a -> c
.# Elem a -> a
forall a. Elem a -> a
getElem) (FingerTree (Elem a) -> m)
-> (Seq a -> FingerTree (Elem a)) -> Seq a -> m
forall b a c. Coercible b a => (b -> c) -> (a -> b) -> a -> c
.# Seq a -> FingerTree (Elem a)
forall a. Seq a -> FingerTree (Elem a)
getSeq
foldr :: (a -> b -> b) -> b -> Seq a -> b
foldr f :: a -> b -> b
f z :: b
z = (Elem a -> b -> b) -> b -> FingerTree (Elem a) -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (a -> b -> b
f (a -> b -> b) -> (Elem a -> a) -> Elem a -> b -> b
forall b a c. Coercible b a => (b -> c) -> (a -> b) -> a -> c
.# Elem a -> a
forall a. Elem a -> a
getElem) b
z (FingerTree (Elem a) -> b)
-> (Seq a -> FingerTree (Elem a)) -> Seq a -> b
forall b a c. Coercible b a => (b -> c) -> (a -> b) -> a -> c
.# Seq a -> FingerTree (Elem a)
forall a. Seq a -> FingerTree (Elem a)
getSeq
foldl :: (b -> a -> b) -> b -> Seq a -> b
foldl f :: b -> a -> b
f z :: b
z = (b -> Elem a -> b) -> b -> FingerTree (Elem a) -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (b -> a -> b
f (b -> a -> b) -> (Elem a -> a) -> b -> Elem a -> b
forall c b a d.
Coercible c b =>
(a -> c -> d) -> (b -> c) -> a -> b -> d
.^# Elem a -> a
forall a. Elem a -> a
getElem) b
z (FingerTree (Elem a) -> b)
-> (Seq a -> FingerTree (Elem a)) -> Seq a -> b
forall b a c. Coercible b a => (b -> c) -> (a -> b) -> a -> c
.# Seq a -> FingerTree (Elem a)
forall a. Seq a -> FingerTree (Elem a)
getSeq
#if __GLASGOW_HASKELL__
{-# INLINABLE foldMap #-}
{-# INLINABLE foldr #-}
{-# INLINABLE foldl #-}
#endif
foldr' :: (a -> b -> b) -> b -> Seq a -> b
foldr' f :: a -> b -> b
f z :: b
z = (Elem a -> b -> b) -> b -> FingerTree (Elem a) -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr' (a -> b -> b
f (a -> b -> b) -> (Elem a -> a) -> Elem a -> b -> b
forall b a c. Coercible b a => (b -> c) -> (a -> b) -> a -> c
.# Elem a -> a
forall a. Elem a -> a
getElem) b
z (FingerTree (Elem a) -> b)
-> (Seq a -> FingerTree (Elem a)) -> Seq a -> b
forall b a c. Coercible b a => (b -> c) -> (a -> b) -> a -> c
.# Seq a -> FingerTree (Elem a)
forall a. Seq a -> FingerTree (Elem a)
getSeq
foldl' :: (b -> a -> b) -> b -> Seq a -> b
foldl' f :: b -> a -> b
f z :: b
z = (b -> Elem a -> b) -> b -> FingerTree (Elem a) -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (b -> a -> b
f (b -> a -> b) -> (Elem a -> a) -> b -> Elem a -> b
forall c b a d.
Coercible c b =>
(a -> c -> d) -> (b -> c) -> a -> b -> d
.^# Elem a -> a
forall a. Elem a -> a
getElem) b
z (FingerTree (Elem a) -> b)
-> (Seq a -> FingerTree (Elem a)) -> Seq a -> b
forall b a c. Coercible b a => (b -> c) -> (a -> b) -> a -> c
.# Seq a -> FingerTree (Elem a)
forall a. Seq a -> FingerTree (Elem a)
getSeq
#if __GLASGOW_HASKELL__
{-# INLINABLE foldr' #-}
{-# INLINABLE foldl' #-}
#endif
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 (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 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)
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 (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 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)
#if MIN_VERSION_base(4,8,0)
length :: Seq a -> Int
length = Seq a -> Int
forall a. Seq a -> Int
length
{-# INLINE length #-}
null :: Seq a -> Bool
null = Seq a -> Bool
forall a. Seq a -> Bool
null
{-# INLINE null #-}
#endif
instance Traversable Seq where
#if __GLASGOW_HASKELL__
{-# INLINABLE traverse #-}
#endif
traverse :: (a -> f b) -> Seq a -> f (Seq b)
traverse _ (Seq EmptyT) = Seq b -> f (Seq b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FingerTree (Elem b) -> Seq b
forall a. FingerTree (Elem a) -> Seq a
Seq FingerTree (Elem b)
forall a. FingerTree a
EmptyT)
traverse f' :: a -> f b
f' (Seq (Single (Elem x' :: a
x'))) =
(\x'' :: b
x'' -> FingerTree (Elem b) -> Seq b
forall a. FingerTree (Elem a) -> Seq a
Seq (Elem b -> FingerTree (Elem b)
forall a. a -> FingerTree a
Single (b -> Elem b
forall a. a -> Elem a
Elem b
x''))) (b -> Seq b) -> f b -> f (Seq b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f' a
x'
traverse f' :: a -> f b
f' (Seq (Deep s' :: Int
s' pr' :: Digit (Elem a)
pr' m' :: FingerTree (Node (Elem a))
m' sf' :: Digit (Elem a)
sf')) =
(Digit (Elem b)
-> FingerTree (Node (Elem b)) -> Digit (Elem b) -> Seq b)
-> f (Digit (Elem b))
-> f (FingerTree (Node (Elem b)))
-> f (Digit (Elem b))
-> f (Seq b)
forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3
(\pr'' :: Digit (Elem b)
pr'' m'' :: FingerTree (Node (Elem b))
m'' sf'' :: Digit (Elem b)
sf'' -> FingerTree (Elem b) -> Seq b
forall a. FingerTree (Elem a) -> Seq a
Seq (Int
-> Digit (Elem b)
-> FingerTree (Node (Elem b))
-> Digit (Elem b)
-> FingerTree (Elem b)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
s' Digit (Elem b)
pr'' FingerTree (Node (Elem b))
m'' Digit (Elem b)
sf''))
((a -> f b) -> Digit (Elem a) -> f (Digit (Elem b))
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Digit (Elem a) -> f (Digit (Elem b))
traverseDigitE a -> f b
f' Digit (Elem a)
pr')
((Node (Elem a) -> f (Node (Elem b)))
-> FingerTree (Node (Elem a)) -> f (FingerTree (Node (Elem b)))
forall (f :: * -> *) a b.
Applicative f =>
(Node a -> f (Node b))
-> FingerTree (Node a) -> f (FingerTree (Node b))
traverseTree ((a -> f b) -> Node (Elem a) -> f (Node (Elem b))
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Node (Elem a) -> f (Node (Elem b))
traverseNodeE a -> f b
f') FingerTree (Node (Elem a))
m')
((a -> f b) -> Digit (Elem a) -> f (Digit (Elem b))
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Digit (Elem a) -> f (Digit (Elem b))
traverseDigitE a -> f b
f' Digit (Elem a)
sf')
where
traverseTree
:: Applicative f
=> (Node a -> f (Node b))
-> FingerTree (Node a)
-> f (FingerTree (Node b))
traverseTree :: (Node a -> f (Node b))
-> FingerTree (Node a) -> f (FingerTree (Node b))
traverseTree _ EmptyT = FingerTree (Node b) -> f (FingerTree (Node b))
forall (f :: * -> *) a. Applicative f => a -> f a
pure FingerTree (Node b)
forall a. FingerTree a
EmptyT
traverseTree f :: Node a -> f (Node b)
f (Single x :: Node a
x) = Node b -> FingerTree (Node b)
forall a. a -> FingerTree a
Single (Node b -> FingerTree (Node b))
-> f (Node b) -> f (FingerTree (Node b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Node a -> f (Node b)
f Node a
x
traverseTree f :: Node a -> f (Node b)
f (Deep s :: Int
s pr :: Digit (Node a)
pr m :: FingerTree (Node (Node a))
m sf :: Digit (Node a)
sf) =
(Digit (Node b)
-> FingerTree (Node (Node b))
-> Digit (Node b)
-> FingerTree (Node b))
-> f (Digit (Node b))
-> f (FingerTree (Node (Node b)))
-> f (Digit (Node b))
-> f (FingerTree (Node b))
forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3
(Int
-> Digit (Node b)
-> FingerTree (Node (Node b))
-> Digit (Node b)
-> FingerTree (Node b)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
s)
((Node a -> f (Node b)) -> Digit (Node a) -> f (Digit (Node b))
forall (f :: * -> *) a b.
Applicative f =>
(Node a -> f (Node b)) -> Digit (Node a) -> f (Digit (Node b))
traverseDigitN Node a -> f (Node b)
f Digit (Node a)
pr)
((Node (Node a) -> f (Node (Node b)))
-> FingerTree (Node (Node a)) -> f (FingerTree (Node (Node b)))
forall (f :: * -> *) a b.
Applicative f =>
(Node a -> f (Node b))
-> FingerTree (Node a) -> f (FingerTree (Node b))
traverseTree ((Node a -> f (Node b)) -> Node (Node a) -> f (Node (Node b))
forall (f :: * -> *) a b.
Applicative f =>
(Node a -> f (Node b)) -> Node (Node a) -> f (Node (Node b))
traverseNodeN Node a -> f (Node b)
f) FingerTree (Node (Node a))
m)
((Node a -> f (Node b)) -> Digit (Node a) -> f (Digit (Node b))
forall (f :: * -> *) a b.
Applicative f =>
(Node a -> f (Node b)) -> Digit (Node a) -> f (Digit (Node b))
traverseDigitN Node a -> f (Node b)
f Digit (Node a)
sf)
traverseDigitE
:: Applicative f
=> (a -> f b) -> Digit (Elem a) -> f (Digit (Elem b))
traverseDigitE :: (a -> f b) -> Digit (Elem a) -> f (Digit (Elem b))
traverseDigitE f :: a -> f b
f (One (Elem a :: a
a)) =
(\a' :: b
a' -> Elem b -> Digit (Elem b)
forall a. a -> Digit a
One (b -> Elem b
forall a. a -> Elem a
Elem b
a')) (b -> Digit (Elem b)) -> f b -> f (Digit (Elem b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
a -> f b
f a
a
traverseDigitE f :: a -> f b
f (Two (Elem a :: a
a) (Elem b :: a
b)) =
(b -> b -> Digit (Elem b)) -> f b -> f b -> f (Digit (Elem b))
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2
(\a' :: b
a' b' :: b
b' -> Elem b -> Elem b -> Digit (Elem b)
forall a. a -> a -> Digit a
Two (b -> Elem b
forall a. a -> Elem a
Elem b
a') (b -> Elem b
forall a. a -> Elem a
Elem b
b'))
(a -> f b
f a
a)
(a -> f b
f a
b)
traverseDigitE f :: a -> f b
f (Three (Elem a :: a
a) (Elem b :: a
b) (Elem c :: a
c)) =
(b -> b -> b -> Digit (Elem b))
-> f b -> f b -> f b -> f (Digit (Elem b))
forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3
(\a' :: b
a' b' :: b
b' c' :: b
c' ->
Elem b -> Elem b -> Elem b -> Digit (Elem b)
forall a. a -> a -> a -> Digit a
Three (b -> Elem b
forall a. a -> Elem a
Elem b
a') (b -> Elem b
forall a. a -> Elem a
Elem b
b') (b -> Elem b
forall a. a -> Elem a
Elem b
c'))
(a -> f b
f a
a)
(a -> f b
f a
b)
(a -> f b
f a
c)
traverseDigitE f :: a -> f b
f (Four (Elem a :: a
a) (Elem b :: a
b) (Elem c :: a
c) (Elem d :: a
d)) =
(b -> b -> b -> b -> Digit (Elem b))
-> f b -> f b -> f b -> f (b -> Digit (Elem b))
forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3
(\a' :: b
a' b' :: b
b' c' :: b
c' d' :: b
d' -> Elem b -> Elem b -> Elem b -> Elem b -> Digit (Elem b)
forall a. a -> a -> a -> a -> Digit a
Four (b -> Elem b
forall a. a -> Elem a
Elem b
a') (b -> Elem b
forall a. a -> Elem a
Elem b
b') (b -> Elem b
forall a. a -> Elem a
Elem b
c') (b -> Elem b
forall a. a -> Elem a
Elem b
d'))
(a -> f b
f a
a)
(a -> f b
f a
b)
(a -> f b
f a
c) f (b -> Digit (Elem b)) -> f b -> f (Digit (Elem b))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
(a -> f b
f a
d)
traverseDigitN
:: Applicative f
=> (Node a -> f (Node b)) -> Digit (Node a) -> f (Digit (Node b))
traverseDigitN :: (Node a -> f (Node b)) -> Digit (Node a) -> f (Digit (Node b))
traverseDigitN f :: Node a -> f (Node b)
f t :: Digit (Node a)
t = (Node a -> f (Node b)) -> Digit (Node a) -> f (Digit (Node b))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Node a -> f (Node b)
f Digit (Node a)
t
traverseNodeE
:: Applicative f
=> (a -> f b) -> Node (Elem a) -> f (Node (Elem b))
traverseNodeE :: (a -> f b) -> Node (Elem a) -> f (Node (Elem b))
traverseNodeE f :: a -> f b
f (Node2 s :: Int
s (Elem a :: a
a) (Elem b :: a
b)) =
(b -> b -> Node (Elem b)) -> f b -> f b -> f (Node (Elem b))
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2
(\a' :: b
a' b' :: b
b' -> Int -> Elem b -> Elem b -> Node (Elem b)
forall a. Int -> a -> a -> Node a
Node2 Int
s (b -> Elem b
forall a. a -> Elem a
Elem b
a') (b -> Elem b
forall a. a -> Elem a
Elem b
b'))
(a -> f b
f a
a)
(a -> f b
f a
b)
traverseNodeE f :: a -> f b
f (Node3 s :: Int
s (Elem a :: a
a) (Elem b :: a
b) (Elem c :: a
c)) =
(b -> b -> b -> Node (Elem b))
-> f b -> f b -> f b -> f (Node (Elem b))
forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3
(\a' :: b
a' b' :: b
b' c' :: b
c' ->
Int -> Elem b -> Elem b -> Elem b -> Node (Elem b)
forall a. Int -> a -> a -> a -> Node a
Node3 Int
s (b -> Elem b
forall a. a -> Elem a
Elem b
a') (b -> Elem b
forall a. a -> Elem a
Elem b
b') (b -> Elem b
forall a. a -> Elem a
Elem b
c'))
(a -> f b
f a
a)
(a -> f b
f a
b)
(a -> f b
f a
c)
traverseNodeN
:: Applicative f
=> (Node a -> f (Node b)) -> Node (Node a) -> f (Node (Node b))
traverseNodeN :: (Node a -> f (Node b)) -> Node (Node a) -> f (Node (Node b))
traverseNodeN f :: Node a -> f (Node b)
f t :: Node (Node a)
t = (Node a -> f (Node b)) -> Node (Node a) -> f (Node (Node b))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Node a -> f (Node b)
f Node (Node a)
t
instance NFData a => NFData (Seq a) where
rnf :: Seq a -> ()
rnf (Seq xs :: FingerTree (Elem a)
xs) = FingerTree (Elem a) -> ()
forall a. NFData a => a -> ()
rnf FingerTree (Elem a)
xs
instance Monad Seq where
return :: a -> Seq a
return = a -> Seq a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
xs :: Seq a
xs >>= :: Seq a -> (a -> Seq b) -> Seq b
>>= f :: a -> Seq b
f = (Seq b -> a -> Seq b) -> Seq b -> Seq a -> Seq b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Seq b -> a -> Seq b
add Seq b
forall a. Seq a
empty Seq a
xs
where add :: Seq b -> a -> Seq b
add ys :: Seq b
ys x :: a
x = Seq b
ys Seq b -> Seq b -> Seq b
forall a. Seq a -> Seq a -> Seq a
>< a -> Seq b
f a
x
>> :: Seq a -> Seq b -> Seq b
(>>) = Seq a -> Seq b -> Seq b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
(*>)
instance MonadFix Seq where
mfix :: (a -> Seq a) -> Seq a
mfix = (a -> Seq a) -> Seq a
forall a. (a -> Seq a) -> Seq a
mfixSeq
mfixSeq :: (a -> Seq a) -> Seq a
mfixSeq :: (a -> Seq a) -> Seq a
mfixSeq f :: a -> Seq a
f = Int -> (Int -> a) -> Seq a
forall a. Int -> (Int -> a) -> Seq a
fromFunction (Seq a -> Int
forall a. Seq a -> Int
length (a -> Seq a
f a
forall a. a
err)) (\k :: Int
k -> (a -> a) -> a
forall a. (a -> a) -> a
fix (\xk :: a
xk -> a -> Seq a
f a
xk Seq a -> Int -> a
forall a. Seq a -> Int -> a
`index` Int
k))
where
err :: a
err = [Char] -> a
forall a. HasCallStack => [Char] -> a
error "mfix for Data.Sequence.Seq applied to strict function"
instance Applicative Seq where
pure :: a -> Seq a
pure = a -> Seq a
forall a. a -> Seq a
singleton
xs :: Seq a
xs *> :: Seq a -> Seq b -> Seq b
*> ys :: Seq b
ys = Int -> Seq b -> Seq b
forall a. Int -> Seq a -> Seq a
cycleNTimes (Seq a -> Int
forall a. Seq a -> Int
length Seq a
xs) Seq b
ys
<*> :: Seq (a -> b) -> Seq a -> Seq b
(<*>) = Seq (a -> b) -> Seq a -> Seq b
forall a b. Seq (a -> b) -> Seq a -> Seq b
apSeq
#if MIN_VERSION_base(4,10,0)
liftA2 :: (a -> b -> c) -> Seq a -> Seq b -> Seq c
liftA2 = (a -> b -> c) -> Seq a -> Seq b -> Seq c
forall a b c. (a -> b -> c) -> Seq a -> Seq b -> Seq c
liftA2Seq
#endif
apSeq :: Seq (a -> b) -> Seq a -> Seq b
apSeq :: Seq (a -> b) -> Seq a -> Seq b
apSeq fs :: Seq (a -> b)
fs xs :: Seq a
xs@(Seq xsFT :: FingerTree (Elem a)
xsFT) = case Seq (a -> b) -> ViewL (a -> b)
forall a. Seq a -> ViewL a
viewl Seq (a -> b)
fs of
EmptyL -> Seq b
forall a. Seq a
empty
firstf :: a -> b
firstf :< fs' :: Seq (a -> b)
fs' -> case Seq (a -> b) -> ViewR (a -> b)
forall a. Seq a -> ViewR a
viewr Seq (a -> b)
fs' of
EmptyR -> (a -> b) -> Seq a -> Seq b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
firstf Seq a
xs
Seq fs''FT :: FingerTree (Elem (a -> b))
fs''FT :> lastf :: a -> b
lastf -> case FingerTree (Elem a) -> Rigidified (Elem a)
forall a. FingerTree (Elem a) -> Rigidified (Elem a)
rigidify FingerTree (Elem a)
xsFT of
RigidEmpty -> Seq b
forall a. Seq a
empty
RigidOne (Elem x :: a
x) -> ((a -> b) -> b) -> Seq (a -> b) -> Seq b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> a -> b
forall a b. (a -> b) -> a -> b
$a
x) Seq (a -> b)
fs
RigidTwo (Elem x1 :: a
x1) (Elem x2 :: a
x2) ->
FingerTree (Elem b) -> Seq b
forall a. FingerTree (Elem a) -> Seq a
Seq (FingerTree (Elem b) -> Seq b) -> FingerTree (Elem b) -> Seq b
forall a b. (a -> b) -> a -> b
$ (a -> b)
-> FingerTree (Elem (a -> b))
-> (a -> b)
-> (a, a)
-> FingerTree (Elem b)
forall a b.
(a -> b)
-> FingerTree (Elem (a -> b))
-> (a -> b)
-> (a, a)
-> FingerTree (Elem b)
ap2FT a -> b
firstf FingerTree (Elem (a -> b))
fs''FT a -> b
lastf (a
x1, a
x2)
RigidThree (Elem x1 :: a
x1) (Elem x2 :: a
x2) (Elem x3 :: a
x3) ->
FingerTree (Elem b) -> Seq b
forall a. FingerTree (Elem a) -> Seq a
Seq (FingerTree (Elem b) -> Seq b) -> FingerTree (Elem b) -> Seq b
forall a b. (a -> b) -> a -> b
$ (a -> b)
-> FingerTree (Elem (a -> b))
-> (a -> b)
-> (a, a, a)
-> FingerTree (Elem b)
forall a b.
(a -> b)
-> FingerTree (Elem (a -> b))
-> (a -> b)
-> (a, a, a)
-> FingerTree (Elem b)
ap3FT a -> b
firstf FingerTree (Elem (a -> b))
fs''FT a -> b
lastf (a
x1, a
x2, a
x3)
RigidFull r :: Rigid (Elem a)
r@(Rigid s :: Int
s pr :: Digit23 (Elem a)
pr _m :: Thin (Digit23 (Elem a))
_m sf :: Digit23 (Elem a)
sf) -> FingerTree (Elem b) -> Seq b
forall a. FingerTree (Elem a) -> Seq a
Seq (FingerTree (Elem b) -> Seq b) -> FingerTree (Elem b) -> Seq b
forall a b. (a -> b) -> a -> b
$
Int
-> Digit (Elem b)
-> FingerTree (Node (Elem b))
-> Digit (Elem b)
-> FingerTree (Elem b)
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
* Seq (a -> b) -> Int
forall a. Seq a -> Int
length Seq (a -> b)
fs)
((Elem a -> Elem b) -> Digit (Elem a) -> Digit (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
firstf) (Digit23 (Elem a) -> Digit (Elem a)
forall a. Node a -> Digit a
nodeToDigit Digit23 (Elem a)
pr))
((Elem a -> Elem b)
-> (Elem a -> Elem b)
-> ((a -> b) -> Elem a -> Elem b)
-> FingerTree (Elem (a -> b))
-> Rigid (Elem a)
-> FingerTree (Node (Elem b))
forall b c a.
(b -> c)
-> (b -> c)
-> (a -> b -> c)
-> FingerTree (Elem a)
-> Rigid b
-> FingerTree (Node c)
aptyMiddle ((a -> b) -> Elem a -> Elem b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
firstf) ((a -> b) -> Elem a -> Elem b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
lastf) (a -> b) -> Elem a -> Elem b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FingerTree (Elem (a -> b))
fs''FT Rigid (Elem a)
r)
((Elem a -> Elem b) -> Digit (Elem a) -> Digit (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
lastf) (Digit23 (Elem a) -> Digit (Elem a)
forall a. Node a -> Digit a
nodeToDigit Digit23 (Elem a)
sf))
{-# NOINLINE [1] apSeq #-}
{-# RULES
"ap/fmap1" forall f xs ys . apSeq (fmapSeq f xs) ys = liftA2Seq f xs ys
"ap/fmap2" forall f gs xs . apSeq gs (fmapSeq f xs) =
liftA2Seq (\g x -> g (f x)) gs xs
"fmap/ap" forall f gs xs . fmapSeq f (gs `apSeq` xs) =
liftA2Seq (\g x -> f (g x)) gs xs
"fmap/liftA2" forall f g m n . fmapSeq f (liftA2Seq g m n) =
liftA2Seq (\x y -> f (g x y)) m n
"liftA2/fmap1" forall f g m n . liftA2Seq f (fmapSeq g m) n =
liftA2Seq (\x y -> f (g x) y) m n
"liftA2/fmap2" forall f g m n . liftA2Seq f m (fmapSeq g n) =
liftA2Seq (\x y -> f x (g y)) m n
#-}
ap2FT :: (a -> b) -> FingerTree (Elem (a->b)) -> (a -> b) -> (a,a) -> FingerTree (Elem b)
ap2FT :: (a -> b)
-> FingerTree (Elem (a -> b))
-> (a -> b)
-> (a, a)
-> FingerTree (Elem b)
ap2FT firstf :: a -> b
firstf fs :: FingerTree (Elem (a -> b))
fs lastf :: a -> b
lastf (x :: a
x,y :: a
y) =
Int
-> Digit (Elem b)
-> FingerTree (Node (Elem b))
-> Digit (Elem b)
-> FingerTree (Elem b)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (FingerTree (Elem (a -> b)) -> Int
forall a. Sized a => a -> Int
size FingerTree (Elem (a -> b))
fs Int -> Int -> Int
forall a. Num a => a -> a -> a
* 2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 4)
(Elem b -> Elem b -> Digit (Elem b)
forall a. a -> a -> Digit a
Two (b -> Elem b
forall a. a -> Elem a
Elem (b -> Elem b) -> b -> Elem b
forall a b. (a -> b) -> a -> b
$ a -> b
firstf a
x) (b -> Elem b
forall a. a -> Elem a
Elem (b -> Elem b) -> b -> Elem b
forall a b. (a -> b) -> a -> b
$ a -> b
firstf a
y))
(Int
-> (Elem (a -> b) -> Node (Elem b))
-> FingerTree (Elem (a -> b))
-> FingerTree (Node (Elem b))
forall a b. Int -> (a -> b) -> FingerTree a -> FingerTree b
mapMulFT 2 (\(Elem f :: a -> b
f) -> Int -> Elem b -> Elem b -> Node (Elem b)
forall a. Int -> a -> a -> Node a
Node2 2 (b -> Elem b
forall a. a -> Elem a
Elem (a -> b
f a
x)) (b -> Elem b
forall a. a -> Elem a
Elem (a -> b
f a
y))) FingerTree (Elem (a -> b))
fs)
(Elem b -> Elem b -> Digit (Elem b)
forall a. a -> a -> Digit a
Two (b -> Elem b
forall a. a -> Elem a
Elem (b -> Elem b) -> b -> Elem b
forall a b. (a -> b) -> a -> b
$ a -> b
lastf a
x) (b -> Elem b
forall a. a -> Elem a
Elem (b -> Elem b) -> b -> Elem b
forall a b. (a -> b) -> a -> b
$ a -> b
lastf a
y))
ap3FT :: (a -> b) -> FingerTree (Elem (a->b)) -> (a -> b) -> (a,a,a) -> FingerTree (Elem b)
ap3FT :: (a -> b)
-> FingerTree (Elem (a -> b))
-> (a -> b)
-> (a, a, a)
-> FingerTree (Elem b)
ap3FT firstf :: a -> b
firstf fs :: FingerTree (Elem (a -> b))
fs lastf :: a -> b
lastf (x :: a
x,y :: a
y,z :: a
z) = Int
-> Digit (Elem b)
-> FingerTree (Node (Elem b))
-> Digit (Elem b)
-> FingerTree (Elem b)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (FingerTree (Elem (a -> b)) -> Int
forall a. Sized a => a -> Int
size FingerTree (Elem (a -> b))
fs Int -> Int -> Int
forall a. Num a => a -> a -> a
* 3 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 6)
(Elem b -> Elem b -> Elem b -> Digit (Elem b)
forall a. a -> a -> a -> Digit a
Three (b -> Elem b
forall a. a -> Elem a
Elem (b -> Elem b) -> b -> Elem b
forall a b. (a -> b) -> a -> b
$ a -> b
firstf a
x) (b -> Elem b
forall a. a -> Elem a
Elem (b -> Elem b) -> b -> Elem b
forall a b. (a -> b) -> a -> b
$ a -> b
firstf a
y) (b -> Elem b
forall a. a -> Elem a
Elem (b -> Elem b) -> b -> Elem b
forall a b. (a -> b) -> a -> b
$ a -> b
firstf a
z))
(Int
-> (Elem (a -> b) -> Node (Elem b))
-> FingerTree (Elem (a -> b))
-> FingerTree (Node (Elem b))
forall a b. Int -> (a -> b) -> FingerTree a -> FingerTree b
mapMulFT 3 (\(Elem f :: a -> b
f) -> Int -> Elem b -> Elem b -> Elem b -> Node (Elem b)
forall a. Int -> a -> a -> a -> Node a
Node3 3 (b -> Elem b
forall a. a -> Elem a
Elem (a -> b
f a
x)) (b -> Elem b
forall a. a -> Elem a
Elem (a -> b
f a
y)) (b -> Elem b
forall a. a -> Elem a
Elem (a -> b
f a
z))) FingerTree (Elem (a -> b))
fs)
(Elem b -> Elem b -> Elem b -> Digit (Elem b)
forall a. a -> a -> a -> Digit a
Three (b -> Elem b
forall a. a -> Elem a
Elem (b -> Elem b) -> b -> Elem b
forall a b. (a -> b) -> a -> b
$ a -> b
lastf a
x) (b -> Elem b
forall a. a -> Elem a
Elem (b -> Elem b) -> b -> Elem b
forall a b. (a -> b) -> a -> b
$ a -> b
lastf a
y) (b -> Elem b
forall a. a -> Elem a
Elem (b -> Elem b) -> b -> Elem b
forall a b. (a -> b) -> a -> b
$ a -> b
lastf a
z))
lift2FT :: (a -> b -> c) -> a -> FingerTree (Elem a) -> a -> (b,b) -> FingerTree (Elem c)
lift2FT :: (a -> b -> c)
-> a -> FingerTree (Elem a) -> a -> (b, b) -> FingerTree (Elem c)
lift2FT f :: a -> b -> c
f firstx :: a
firstx xs :: FingerTree (Elem a)
xs lastx :: a
lastx (y1 :: b
y1,y2 :: b
y2) =
Int
-> Digit (Elem c)
-> FingerTree (Node (Elem c))
-> Digit (Elem c)
-> FingerTree (Elem c)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (FingerTree (Elem a) -> Int
forall a. Sized a => a -> Int
size FingerTree (Elem a)
xs Int -> Int -> Int
forall a. Num a => a -> a -> a
* 2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 4)
(Elem c -> Elem c -> Digit (Elem c)
forall a. a -> a -> Digit a
Two (c -> Elem c
forall a. a -> Elem a
Elem (c -> Elem c) -> c -> Elem c
forall a b. (a -> b) -> a -> b
$ a -> b -> c
f a
firstx b
y1) (c -> Elem c
forall a. a -> Elem a
Elem (c -> Elem c) -> c -> Elem c
forall a b. (a -> b) -> a -> b
$ a -> b -> c
f a
firstx b
y2))
(Int
-> (Elem a -> Node (Elem c))
-> FingerTree (Elem a)
-> FingerTree (Node (Elem c))
forall a b. Int -> (a -> b) -> FingerTree a -> FingerTree b
mapMulFT 2 (\(Elem x :: a
x) -> Int -> Elem c -> Elem c -> Node (Elem c)
forall a. Int -> a -> a -> Node a
Node2 2 (c -> Elem c
forall a. a -> Elem a
Elem (a -> b -> c
f a
x b
y1)) (c -> Elem c
forall a. a -> Elem a
Elem (a -> b -> c
f a
x b
y2))) FingerTree (Elem a)
xs)
(Elem c -> Elem c -> Digit (Elem c)
forall a. a -> a -> Digit a
Two (c -> Elem c
forall a. a -> Elem a
Elem (c -> Elem c) -> c -> Elem c
forall a b. (a -> b) -> a -> b
$ a -> b -> c
f a
lastx b
y1) (c -> Elem c
forall a. a -> Elem a
Elem (c -> Elem c) -> c -> Elem c
forall a b. (a -> b) -> a -> b
$ a -> b -> c
f a
lastx b
y2))
lift3FT :: (a -> b -> c) -> a -> FingerTree (Elem a) -> a -> (b,b,b) -> FingerTree (Elem c)
lift3FT :: (a -> b -> c)
-> a
-> FingerTree (Elem a)
-> a
-> (b, b, b)
-> FingerTree (Elem c)
lift3FT f :: a -> b -> c
f firstx :: a
firstx xs :: FingerTree (Elem a)
xs lastx :: a
lastx (y1 :: b
y1,y2 :: b
y2,y3 :: b
y3) =
Int
-> Digit (Elem c)
-> FingerTree (Node (Elem c))
-> Digit (Elem c)
-> FingerTree (Elem c)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (FingerTree (Elem a) -> Int
forall a. Sized a => a -> Int
size FingerTree (Elem a)
xs Int -> Int -> Int
forall a. Num a => a -> a -> a
* 3 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 6)
(Elem c -> Elem c -> Elem c -> Digit (Elem c)
forall a. a -> a -> a -> Digit a
Three (c -> Elem c
forall a. a -> Elem a
Elem (c -> Elem c) -> c -> Elem c
forall a b. (a -> b) -> a -> b
$ a -> b -> c
f a
firstx b
y1) (c -> Elem c
forall a. a -> Elem a
Elem (c -> Elem c) -> c -> Elem c
forall a b. (a -> b) -> a -> b
$ a -> b -> c
f a
firstx b
y2) (c -> Elem c
forall a. a -> Elem a
Elem (c -> Elem c) -> c -> Elem c
forall a b. (a -> b) -> a -> b
$ a -> b -> c
f a
firstx b
y3))
(Int
-> (Elem a -> Node (Elem c))
-> FingerTree (Elem a)
-> FingerTree (Node (Elem c))
forall a b. Int -> (a -> b) -> FingerTree a -> FingerTree b
mapMulFT 3 (\(Elem x :: a
x) -> Int -> Elem c -> Elem c -> Elem c -> Node (Elem c)
forall a. Int -> a -> a -> a -> Node a
Node3 3 (c -> Elem c
forall a. a -> Elem a
Elem (a -> b -> c
f a
x b
y1)) (c -> Elem c
forall a. a -> Elem a
Elem (a -> b -> c
f a
x b
y2)) (c -> Elem c
forall a. a -> Elem a
Elem (a -> b -> c
f a
x b
y3))) FingerTree (Elem a)
xs)
(Elem c -> Elem c -> Elem c -> Digit (Elem c)
forall a. a -> a -> a -> Digit a
Three (c -> Elem c
forall a. a -> Elem a
Elem (c -> Elem c) -> c -> Elem c
forall a b. (a -> b) -> a -> b
$ a -> b -> c
f a
lastx b
y1) (c -> Elem c
forall a. a -> Elem a
Elem (c -> Elem c) -> c -> Elem c
forall a b. (a -> b) -> a -> b
$ a -> b -> c
f a
lastx b
y2) (c -> Elem c
forall a. a -> Elem a
Elem (c -> Elem c) -> c -> Elem c
forall a b. (a -> b) -> a -> b
$ a -> b -> c
f a
lastx b
y3))
liftA2Seq :: (a -> b -> c) -> Seq a -> Seq b -> Seq c
liftA2Seq :: (a -> b -> c) -> Seq a -> Seq b -> Seq c
liftA2Seq f :: a -> b -> c
f xs :: Seq a
xs ys :: Seq b
ys@(Seq ysFT :: FingerTree (Elem b)
ysFT) = case Seq a -> ViewL a
forall a. Seq a -> ViewL a
viewl Seq a
xs of
EmptyL -> Seq c
forall a. Seq a
empty
firstx :: a
firstx :< xs' :: Seq a
xs' -> case Seq a -> ViewR a
forall a. Seq a -> ViewR a
viewr Seq a
xs' of
EmptyR -> a -> b -> c
f a
firstx (b -> c) -> Seq b -> Seq c
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Seq b
ys
Seq xs''FT :: FingerTree (Elem a)
xs''FT :> lastx :: a
lastx -> case FingerTree (Elem b) -> Rigidified (Elem b)
forall a. FingerTree (Elem a) -> Rigidified (Elem a)
rigidify FingerTree (Elem b)
ysFT of
RigidEmpty -> Seq c
forall a. Seq a
empty
RigidOne (Elem y :: b
y) -> (a -> c) -> Seq a -> Seq c
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\x :: a
x -> a -> b -> c
f a
x b
y) Seq a
xs
RigidTwo (Elem y1 :: b
y1) (Elem y2 :: b
y2) ->
FingerTree (Elem c) -> Seq c
forall a. FingerTree (Elem a) -> Seq a
Seq (FingerTree (Elem c) -> Seq c) -> FingerTree (Elem c) -> Seq c
forall a b. (a -> b) -> a -> b
$ (a -> b -> c)
-> a -> FingerTree (Elem a) -> a -> (b, b) -> FingerTree (Elem c)
forall a b c.
(a -> b -> c)
-> a -> FingerTree (Elem a) -> a -> (b, b) -> FingerTree (Elem c)
lift2FT a -> b -> c
f a
firstx FingerTree (Elem a)
xs''FT a
lastx (b
y1, b
y2)
RigidThree (Elem y1 :: b
y1) (Elem y2 :: b
y2) (Elem y3 :: b
y3) ->
FingerTree (Elem c) -> Seq c
forall a. FingerTree (Elem a) -> Seq a
Seq (FingerTree (Elem c) -> Seq c) -> FingerTree (Elem c) -> Seq c
forall a b. (a -> b) -> a -> b
$ (a -> b -> c)
-> a
-> FingerTree (Elem a)
-> a
-> (b, b, b)
-> FingerTree (Elem c)
forall a b c.
(a -> b -> c)
-> a
-> FingerTree (Elem a)
-> a
-> (b, b, b)
-> FingerTree (Elem c)
lift3FT a -> b -> c
f a
firstx FingerTree (Elem a)
xs''FT a
lastx (b
y1, b
y2, b
y3)
RigidFull r :: Rigid (Elem b)
r@(Rigid s :: Int
s pr :: Digit23 (Elem b)
pr _m :: Thin (Digit23 (Elem b))
_m sf :: Digit23 (Elem b)
sf) -> FingerTree (Elem c) -> Seq c
forall a. FingerTree (Elem a) -> Seq a
Seq (FingerTree (Elem c) -> Seq c) -> FingerTree (Elem c) -> Seq c
forall a b. (a -> b) -> a -> b
$
Int
-> Digit (Elem c)
-> FingerTree (Node (Elem c))
-> Digit (Elem c)
-> FingerTree (Elem c)
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
* Seq a -> Int
forall a. Seq a -> Int
length Seq a
xs)
((Elem b -> Elem c) -> Digit (Elem b) -> Digit (Elem c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((b -> c) -> Elem b -> Elem c
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> b -> c
f a
firstx)) (Digit23 (Elem b) -> Digit (Elem b)
forall a. Node a -> Digit a
nodeToDigit Digit23 (Elem b)
pr))
((Elem b -> Elem c)
-> (Elem b -> Elem c)
-> (a -> Elem b -> Elem c)
-> FingerTree (Elem a)
-> Rigid (Elem b)
-> FingerTree (Node (Elem c))
forall b c a.
(b -> c)
-> (b -> c)
-> (a -> b -> c)
-> FingerTree (Elem a)
-> Rigid b
-> FingerTree (Node c)
aptyMiddle ((b -> c) -> Elem b -> Elem c
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> b -> c
f a
firstx)) ((b -> c) -> Elem b -> Elem c
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> b -> c
f a
lastx)) ((a -> b -> c) -> a -> Elem b -> Elem c
forall a b c. (a -> b -> c) -> a -> Elem b -> Elem c
lift_elem a -> b -> c
f) FingerTree (Elem a)
xs''FT Rigid (Elem b)
r)
((Elem b -> Elem c) -> Digit (Elem b) -> Digit (Elem c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((b -> c) -> Elem b -> Elem c
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> b -> c
f a
lastx)) (Digit23 (Elem b) -> Digit (Elem b)
forall a. Node a -> Digit a
nodeToDigit Digit23 (Elem b)
sf))
where
lift_elem :: (a -> b -> c) -> a -> Elem b -> Elem c
#if __GLASGOW_HASKELL__ >= 708
lift_elem :: (a -> b -> c) -> a -> Elem b -> Elem c
lift_elem = (a -> b -> c) -> a -> Elem b -> Elem c
forall a b. Coercible a b => a -> b
coerce
#else
lift_elem f x (Elem y) = Elem (f x y)
#endif
{-# NOINLINE [1] liftA2Seq #-}
data Rigidified a = RigidEmpty
| RigidOne a
| RigidTwo a a
| RigidThree a a a
| RigidFull (Rigid a)
#ifdef TESTING
deriving Show
#endif
data Rigid a = Rigid {-# UNPACK #-} !Int !(Digit23 a) (Thin (Node a)) !(Digit23 a)
#ifdef TESTING
deriving Show
#endif
data Thin a = EmptyTh
| SingleTh a
| DeepTh {-# UNPACK #-} !Int !(Digit12 a) (Thin (Node a)) !(Digit12 a)
#ifdef TESTING
deriving Show
#endif
data Digit12 a = One12 a | Two12 a a
#ifdef TESTING
deriving Show
#endif
type Digit23 a = Node a
aptyMiddle
:: (b -> c)
-> (b -> c)
-> (a -> b -> c)
-> FingerTree (Elem a)
-> Rigid b
-> FingerTree (Node c)
aptyMiddle :: (b -> c)
-> (b -> c)
-> (a -> b -> c)
-> FingerTree (Elem a)
-> Rigid b
-> FingerTree (Node c)
aptyMiddle firstf :: b -> c
firstf
lastf :: b -> c
lastf
map23 :: a -> b -> c
map23
fs :: FingerTree (Elem a)
fs
(Rigid s :: Int
s pr :: Digit23 b
pr (DeepTh sm :: Int
sm prm :: Digit12 (Digit23 b)
prm mm :: Thin (Node (Digit23 b))
mm sfm :: Digit12 (Digit23 b)
sfm) sf :: Digit23 b
sf)
= Int
-> Digit (Node c)
-> FingerTree (Node (Node c))
-> Digit (Node c)
-> FingerTree (Node c)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
sm Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
* (FingerTree (Elem a) -> Int
forall a. Sized a => a -> Int
size FingerTree (Elem a)
fs Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1))
((Digit23 b -> Node c) -> Digit (Digit23 b) -> Digit (Node c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((b -> c) -> Digit23 b -> Node c
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> c
firstf) (Digit12 (Digit23 b) -> Digit (Digit23 b)
forall a. Digit12 a -> Digit a
digit12ToDigit Digit12 (Digit23 b)
prm))
((Digit23 b -> Node c)
-> (Digit23 b -> Node c)
-> (a -> Digit23 b -> Node c)
-> FingerTree (Elem a)
-> Rigid (Digit23 b)
-> FingerTree (Node (Node c))
forall b c a.
(b -> c)
-> (b -> c)
-> (a -> b -> c)
-> FingerTree (Elem a)
-> Rigid b
-> FingerTree (Node c)
aptyMiddle ((b -> c) -> Digit23 b -> Node c
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> c
firstf)
((b -> c) -> Digit23 b -> Node c
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> c
lastf)
((b -> c) -> Digit23 b -> Node c
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((b -> c) -> Digit23 b -> Node c)
-> (a -> b -> c) -> a -> Digit23 b -> Node c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b -> c
map23)
FingerTree (Elem a)
fs
(Int
-> Node (Digit23 b)
-> Thin (Node (Digit23 b))
-> Node (Digit23 b)
-> Rigid (Digit23 b)
forall a.
Int -> Digit23 a -> Thin (Digit23 a) -> Digit23 a -> Rigid a
Rigid Int
s (Digit23 b -> Digit12 (Digit23 b) -> Node (Digit23 b)
forall a. Digit23 a -> Digit12 (Digit23 a) -> Digit23 (Digit23 a)
squashL Digit23 b
pr Digit12 (Digit23 b)
prm) Thin (Node (Digit23 b))
mm (Digit12 (Digit23 b) -> Digit23 b -> Node (Digit23 b)
forall a. Digit12 (Node a) -> Node a -> Digit23 (Node a)
squashR Digit12 (Digit23 b)
sfm Digit23 b
sf)))
((Digit23 b -> Node c) -> Digit (Digit23 b) -> Digit (Node c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((b -> c) -> Digit23 b -> Node c
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> c
lastf) (Digit12 (Digit23 b) -> Digit (Digit23 b)
forall a. Digit12 a -> Digit a
digit12ToDigit Digit12 (Digit23 b)
sfm))
aptyMiddle firstf :: b -> c
firstf
lastf :: b -> c
lastf
map23 :: a -> b -> c
map23
fs :: FingerTree (Elem a)
fs
(Rigid s :: Int
s pr :: Digit23 b
pr EmptyTh sf :: Digit23 b
sf)
= Digit (Node c)
-> FingerTree (Node (Node c))
-> Digit (Node c)
-> FingerTree (Node c)
forall a.
Sized a =>
Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
deep
(Node c -> Digit (Node c)
forall a. a -> Digit a
One ((b -> c) -> Digit23 b -> Node c
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> c
firstf Digit23 b
sf))
(Int
-> (Elem a -> Node (Node c))
-> FingerTree (Elem a)
-> FingerTree (Node (Node c))
forall a b. Int -> (a -> b) -> FingerTree a -> FingerTree b
mapMulFT Int
s (\(Elem f :: a
f) -> (Digit23 b -> Node c) -> Node (Digit23 b) -> Node (Node c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((b -> c) -> Digit23 b -> Node c
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> b -> c
map23 a
f)) Node (Digit23 b)
converted) FingerTree (Elem a)
fs)
(Node c -> Digit (Node c)
forall a. a -> Digit a
One ((b -> c) -> Digit23 b -> Node c
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> c
lastf Digit23 b
pr))
where converted :: Node (Digit23 b)
converted = Digit23 b -> Digit23 b -> Node (Digit23 b)
forall a. Sized a => a -> a -> Node a
node2 Digit23 b
pr Digit23 b
sf
aptyMiddle firstf :: b -> c
firstf
lastf :: b -> c
lastf
map23 :: a -> b -> c
map23
fs :: FingerTree (Elem a)
fs
(Rigid s :: Int
s pr :: Digit23 b
pr (SingleTh q :: Digit23 b
q) sf :: Digit23 b
sf)
= Digit (Node c)
-> FingerTree (Node (Node c))
-> Digit (Node c)
-> FingerTree (Node c)
forall a.
Sized a =>
Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
deep
(Node c -> Node c -> Digit (Node c)
forall a. a -> a -> Digit a
Two ((b -> c) -> Digit23 b -> Node c
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> c
firstf Digit23 b
q) ((b -> c) -> Digit23 b -> Node c
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> c
firstf Digit23 b
sf))
(Int
-> (Elem a -> Node (Node c))
-> FingerTree (Elem a)
-> FingerTree (Node (Node c))
forall a b. Int -> (a -> b) -> FingerTree a -> FingerTree b
mapMulFT Int
s (\(Elem f :: a
f) -> (Digit23 b -> Node c) -> Node (Digit23 b) -> Node (Node c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((b -> c) -> Digit23 b -> Node c
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> b -> c
map23 a
f)) Node (Digit23 b)
converted) FingerTree (Elem a)
fs)
(Node c -> Node c -> Digit (Node c)
forall a. a -> a -> Digit a
Two ((b -> c) -> Digit23 b -> Node c
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> c
lastf Digit23 b
pr) ((b -> c) -> Digit23 b -> Node c
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> c
lastf Digit23 b
q))
where converted :: Node (Digit23 b)
converted = Digit23 b -> Digit23 b -> Digit23 b -> Node (Digit23 b)
forall a. Sized a => a -> a -> a -> Node a
node3 Digit23 b
pr Digit23 b
q Digit23 b
sf
digit12ToDigit :: Digit12 a -> Digit a
digit12ToDigit :: Digit12 a -> Digit a
digit12ToDigit (One12 a :: a
a) = a -> Digit a
forall a. a -> Digit a
One a
a
digit12ToDigit (Two12 a :: a
a b :: a
b) = a -> a -> Digit a
forall a. a -> a -> Digit a
Two a
a a
b
squashL :: Digit23 a -> Digit12 (Node a) -> Digit23 (Node a)
squashL :: Digit23 a -> Digit12 (Digit23 a) -> Digit23 (Digit23 a)
squashL m :: Digit23 a
m (One12 n :: Digit23 a
n) = Digit23 a -> Digit23 a -> Digit23 (Digit23 a)
forall a. Sized a => a -> a -> Node a
node2 Digit23 a
m Digit23 a
n
squashL m :: Digit23 a
m (Two12 n1 :: Digit23 a
n1 n2 :: Digit23 a
n2) = Digit23 a -> Digit23 a -> Digit23 a -> Digit23 (Digit23 a)
forall a. Sized a => a -> a -> a -> Node a
node3 Digit23 a
m Digit23 a
n1 Digit23 a
n2
squashR :: Digit12 (Node a) -> Digit23 a -> Digit23 (Node a)
squashR :: Digit12 (Node a) -> Node a -> Digit23 (Node a)
squashR (One12 n :: Node a
n) m :: Node a
m = Node a -> Node a -> Digit23 (Node a)
forall a. Sized a => a -> a -> Node a
node2 Node a
n Node a
m
squashR (Two12 n1 :: Node a
n1 n2 :: Node a
n2) m :: Node a
m = Node a -> Node a -> Node a -> Digit23 (Node a)
forall a. Sized a => a -> a -> a -> Node a
node3 Node a
n1 Node a
n2 Node a
m
mapMulFT :: Int -> (a -> b) -> FingerTree a -> FingerTree b
mapMulFT :: Int -> (a -> b) -> FingerTree a -> FingerTree b
mapMulFT _ _ EmptyT = FingerTree b
forall a. FingerTree a
EmptyT
mapMulFT _mul :: Int
_mul f :: a -> b
f (Single a :: a
a) = b -> FingerTree b
forall a. a -> FingerTree a
Single (a -> b
f a
a)
mapMulFT mul :: Int
mul f :: a -> b
f (Deep s :: Int
s 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
mul Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
s) ((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) (Int
-> (Node a -> Node b) -> FingerTree (Node a) -> FingerTree (Node b)
forall a b. Int -> (a -> b) -> FingerTree a -> FingerTree b
mapMulFT Int
mul (Int -> (a -> b) -> Node a -> Node b
forall a b. Int -> (a -> b) -> Node a -> Node b
mapMulNode Int
mul 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)
mapMulNode :: Int -> (a -> b) -> Node a -> Node b
mapMulNode :: Int -> (a -> b) -> Node a -> Node b
mapMulNode mul :: Int
mul f :: a -> b
f (Node2 s :: Int
s a :: a
a b :: a
b) = Int -> b -> b -> Node b
forall a. Int -> a -> a -> Node a
Node2 (Int
mul Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
s) (a -> b
f a
a) (a -> b
f a
b)
mapMulNode mul :: Int
mul f :: a -> b
f (Node3 s :: Int
s 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
mul Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
s) (a -> b
f a
a) (a -> b
f a
b) (a -> b
f a
c)
rigidify :: FingerTree (Elem a) -> Rigidified (Elem a)
rigidify :: FingerTree (Elem a) -> Rigidified (Elem a)
rigidify EmptyT = Rigidified (Elem a)
forall a. Rigidified a
RigidEmpty
rigidify (Single q :: Elem a
q) = Elem a -> Rigidified (Elem a)
forall a. a -> Rigidified a
RigidOne Elem a
q
rigidify (Deep s :: Int
s (Two a :: Elem a
a b :: Elem a
b) m :: FingerTree (Node (Elem a))
m sf :: Digit (Elem a)
sf) = Int
-> Node (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> Rigidified (Elem a)
forall a.
Int
-> Digit23 (Elem a)
-> FingerTree (Digit23 (Elem a))
-> Digit (Elem a)
-> Rigidified (Elem a)
rigidifyRight Int
s (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))
m Digit (Elem a)
sf
rigidify (Deep s :: Int
s (Three a :: Elem a
a b :: Elem a
b c :: Elem a
c) m :: FingerTree (Node (Elem a))
m sf :: Digit (Elem a)
sf) = Int
-> Node (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> Rigidified (Elem a)
forall a.
Int
-> Digit23 (Elem a)
-> FingerTree (Digit23 (Elem a))
-> Digit (Elem a)
-> Rigidified (Elem a)
rigidifyRight Int
s (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))
m Digit (Elem a)
sf
rigidify (Deep s :: Int
s (Four a :: Elem a
a b :: Elem a
b c :: Elem a
c d :: Elem a
d) m :: FingerTree (Node (Elem a))
m sf :: Digit (Elem a)
sf) = Int
-> Node (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> Rigidified (Elem a)
forall a.
Int
-> Digit23 (Elem a)
-> FingerTree (Digit23 (Elem a))
-> Digit (Elem a)
-> Rigidified (Elem a)
rigidifyRight Int
s (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 Node (Elem a)
-> FingerTree (Node (Elem a)) -> FingerTree (Node (Elem a))
forall a. Sized a => a -> FingerTree a -> FingerTree a
`consTree` FingerTree (Node (Elem a))
m) Digit (Elem a)
sf
rigidify (Deep s :: Int
s (One a :: Elem a
a) m :: FingerTree (Node (Elem a))
m sf :: Digit (Elem a)
sf) = case FingerTree (Node (Elem a)) -> ViewLTree (Node (Elem a))
forall a. Sized a => FingerTree a -> ViewLTree a
viewLTree FingerTree (Node (Elem a))
m of
ConsLTree (Node2 _ b :: Elem a
b c :: Elem a
c) m' :: FingerTree (Node (Elem a))
m' -> Int
-> Node (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> Rigidified (Elem a)
forall a.
Int
-> Digit23 (Elem a)
-> FingerTree (Digit23 (Elem a))
-> Digit (Elem a)
-> Rigidified (Elem a)
rigidifyRight Int
s (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))
m' Digit (Elem a)
sf
ConsLTree (Node3 _ b :: Elem a
b c :: Elem a
c d :: Elem a
d) m' :: FingerTree (Node (Elem a))
m' -> Int
-> Node (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> Rigidified (Elem a)
forall a.
Int
-> Digit23 (Elem a)
-> FingerTree (Digit23 (Elem a))
-> Digit (Elem a)
-> Rigidified (Elem a)
rigidifyRight Int
s (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 Node (Elem a)
-> FingerTree (Node (Elem a)) -> FingerTree (Node (Elem a))
forall a. Sized a => a -> FingerTree a -> FingerTree a
`consTree` FingerTree (Node (Elem a))
m') Digit (Elem a)
sf
EmptyLTree -> case Digit (Elem a)
sf of
One b :: Elem a
b -> Elem a -> Elem a -> Rigidified (Elem a)
forall a. a -> a -> Rigidified a
RigidTwo Elem a
a Elem a
b
Two b :: Elem a
b c :: Elem a
c -> Elem a -> Elem a -> Elem a -> Rigidified (Elem a)
forall a. a -> a -> a -> Rigidified a
RigidThree Elem a
a Elem a
b Elem a
c
Three b :: Elem a
b c :: Elem a
c d :: Elem a
d -> Rigid (Elem a) -> Rigidified (Elem a)
forall a. Rigid a -> Rigidified a
RigidFull (Rigid (Elem a) -> Rigidified (Elem a))
-> Rigid (Elem a) -> Rigidified (Elem a)
forall a b. (a -> b) -> a -> b
$ Int
-> Node (Elem a)
-> Thin (Node (Elem a))
-> Node (Elem a)
-> Rigid (Elem a)
forall a.
Int -> Digit23 a -> Thin (Digit23 a) -> Digit23 a -> Rigid a
Rigid Int
s (Elem a -> Elem a -> Node (Elem a)
forall a. Sized a => a -> a -> Node a
node2 Elem a
a Elem a
b) Thin (Node (Elem a))
forall a. Thin a
EmptyTh (Elem a -> Elem a -> Node (Elem a)
forall a. Sized a => a -> a -> Node a
node2 Elem a
c Elem a
d)
Four b :: Elem a
b c :: Elem a
c d :: Elem a
d e :: Elem a
e -> Rigid (Elem a) -> Rigidified (Elem a)
forall a. Rigid a -> Rigidified a
RigidFull (Rigid (Elem a) -> Rigidified (Elem a))
-> Rigid (Elem a) -> Rigidified (Elem a)
forall a b. (a -> b) -> a -> b
$ Int
-> Node (Elem a)
-> Thin (Node (Elem a))
-> Node (Elem a)
-> Rigid (Elem a)
forall a.
Int -> Digit23 a -> Thin (Digit23 a) -> Digit23 a -> Rigid a
Rigid Int
s (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) Thin (Node (Elem a))
forall a. Thin a
EmptyTh (Elem a -> Elem a -> Node (Elem a)
forall a. Sized a => a -> a -> Node a
node2 Elem a
d Elem a
e)
rigidifyRight :: Int -> Digit23 (Elem a) -> FingerTree (Node (Elem a)) -> Digit (Elem a) -> Rigidified (Elem a)
rigidifyRight :: Int
-> Digit23 (Elem a)
-> FingerTree (Digit23 (Elem a))
-> Digit (Elem a)
-> Rigidified (Elem a)
rigidifyRight s :: Int
s pr :: Digit23 (Elem a)
pr m :: FingerTree (Digit23 (Elem a))
m (Two a :: Elem a
a b :: Elem a
b) = Rigid (Elem a) -> Rigidified (Elem a)
forall a. Rigid a -> Rigidified a
RigidFull (Rigid (Elem a) -> Rigidified (Elem a))
-> Rigid (Elem a) -> Rigidified (Elem a)
forall a b. (a -> b) -> a -> b
$ Int
-> Digit23 (Elem a)
-> Thin (Digit23 (Elem a))
-> Digit23 (Elem a)
-> Rigid (Elem a)
forall a.
Int -> Digit23 a -> Thin (Digit23 a) -> Digit23 a -> Rigid a
Rigid Int
s Digit23 (Elem a)
pr (FingerTree (Digit23 (Elem a)) -> Thin (Digit23 (Elem a))
forall a. Sized a => FingerTree a -> Thin a
thin FingerTree (Digit23 (Elem a))
m) (Elem a -> Elem a -> Digit23 (Elem a)
forall a. Sized a => a -> a -> Node a
node2 Elem a
a Elem a
b)
rigidifyRight s :: Int
s pr :: Digit23 (Elem a)
pr m :: FingerTree (Digit23 (Elem a))
m (Three a :: Elem a
a b :: Elem a
b c :: Elem a
c) = Rigid (Elem a) -> Rigidified (Elem a)
forall a. Rigid a -> Rigidified a
RigidFull (Rigid (Elem a) -> Rigidified (Elem a))
-> Rigid (Elem a) -> Rigidified (Elem a)
forall a b. (a -> b) -> a -> b
$ Int
-> Digit23 (Elem a)
-> Thin (Digit23 (Elem a))
-> Digit23 (Elem a)
-> Rigid (Elem a)
forall a.
Int -> Digit23 a -> Thin (Digit23 a) -> Digit23 a -> Rigid a
Rigid Int
s Digit23 (Elem a)
pr (FingerTree (Digit23 (Elem a)) -> Thin (Digit23 (Elem a))
forall a. Sized a => FingerTree a -> Thin a
thin FingerTree (Digit23 (Elem a))
m) (Elem a -> Elem a -> Elem a -> Digit23 (Elem a)
forall a. Sized a => a -> a -> a -> Node a
node3 Elem a
a Elem a
b Elem a
c)
rigidifyRight s :: Int
s pr :: Digit23 (Elem a)
pr m :: FingerTree (Digit23 (Elem a))
m (Four a :: Elem a
a b :: Elem a
b c :: Elem a
c d :: Elem a
d) = Rigid (Elem a) -> Rigidified (Elem a)
forall a. Rigid a -> Rigidified a
RigidFull (Rigid (Elem a) -> Rigidified (Elem a))
-> Rigid (Elem a) -> Rigidified (Elem a)
forall a b. (a -> b) -> a -> b
$ Int
-> Digit23 (Elem a)
-> Thin (Digit23 (Elem a))
-> Digit23 (Elem a)
-> Rigid (Elem a)
forall a.
Int -> Digit23 a -> Thin (Digit23 a) -> Digit23 a -> Rigid a
Rigid Int
s Digit23 (Elem a)
pr (FingerTree (Digit23 (Elem a)) -> Thin (Digit23 (Elem a))
forall a. Sized a => FingerTree a -> Thin a
thin (FingerTree (Digit23 (Elem a)) -> Thin (Digit23 (Elem a)))
-> FingerTree (Digit23 (Elem a)) -> Thin (Digit23 (Elem a))
forall a b. (a -> b) -> a -> b
$ FingerTree (Digit23 (Elem a))
m FingerTree (Digit23 (Elem a))
-> Digit23 (Elem a) -> FingerTree (Digit23 (Elem a))
forall a. Sized a => FingerTree a -> a -> FingerTree a
`snocTree` Elem a -> Elem a -> Digit23 (Elem a)
forall a. Sized a => a -> a -> Node a
node2 Elem a
a Elem a
b) (Elem a -> Elem a -> Digit23 (Elem a)
forall a. Sized a => a -> a -> Node a
node2 Elem a
c Elem a
d)
rigidifyRight s :: Int
s pr :: Digit23 (Elem a)
pr m :: FingerTree (Digit23 (Elem a))
m (One e :: Elem a
e) = case FingerTree (Digit23 (Elem a)) -> ViewRTree (Digit23 (Elem a))
forall a. Sized a => FingerTree a -> ViewRTree a
viewRTree FingerTree (Digit23 (Elem a))
m of
SnocRTree m' :: FingerTree (Digit23 (Elem a))
m' (Node2 _ a :: Elem a
a b :: Elem a
b) -> Rigid (Elem a) -> Rigidified (Elem a)
forall a. Rigid a -> Rigidified a
RigidFull (Rigid (Elem a) -> Rigidified (Elem a))
-> Rigid (Elem a) -> Rigidified (Elem a)
forall a b. (a -> b) -> a -> b
$ Int
-> Digit23 (Elem a)
-> Thin (Digit23 (Elem a))
-> Digit23 (Elem a)
-> Rigid (Elem a)
forall a.
Int -> Digit23 a -> Thin (Digit23 a) -> Digit23 a -> Rigid a
Rigid Int
s Digit23 (Elem a)
pr (FingerTree (Digit23 (Elem a)) -> Thin (Digit23 (Elem a))
forall a. Sized a => FingerTree a -> Thin a
thin FingerTree (Digit23 (Elem a))
m') (Elem a -> Elem a -> Elem a -> Digit23 (Elem a)
forall a. Sized a => a -> a -> a -> Node a
node3 Elem a
a Elem a
b Elem a
e)
SnocRTree m' :: FingerTree (Digit23 (Elem a))
m' (Node3 _ a :: Elem a
a b :: Elem a
b c :: Elem a
c) -> Rigid (Elem a) -> Rigidified (Elem a)
forall a. Rigid a -> Rigidified a
RigidFull (Rigid (Elem a) -> Rigidified (Elem a))
-> Rigid (Elem a) -> Rigidified (Elem a)
forall a b. (a -> b) -> a -> b
$ Int
-> Digit23 (Elem a)
-> Thin (Digit23 (Elem a))
-> Digit23 (Elem a)
-> Rigid (Elem a)
forall a.
Int -> Digit23 a -> Thin (Digit23 a) -> Digit23 a -> Rigid a
Rigid Int
s Digit23 (Elem a)
pr (FingerTree (Digit23 (Elem a)) -> Thin (Digit23 (Elem a))
forall a. Sized a => FingerTree a -> Thin a
thin (FingerTree (Digit23 (Elem a)) -> Thin (Digit23 (Elem a)))
-> FingerTree (Digit23 (Elem a)) -> Thin (Digit23 (Elem a))
forall a b. (a -> b) -> a -> b
$ FingerTree (Digit23 (Elem a))
m' FingerTree (Digit23 (Elem a))
-> Digit23 (Elem a) -> FingerTree (Digit23 (Elem a))
forall a. Sized a => FingerTree a -> a -> FingerTree a
`snocTree` Elem a -> Elem a -> Digit23 (Elem a)
forall a. Sized a => a -> a -> Node a
node2 Elem a
a Elem a
b) (Elem a -> Elem a -> Digit23 (Elem a)
forall a. Sized a => a -> a -> Node a
node2 Elem a
c Elem a
e)
EmptyRTree -> case Digit23 (Elem a)
pr of
Node2 _ a :: Elem a
a b :: Elem a
b -> Elem a -> Elem a -> Elem a -> Rigidified (Elem a)
forall a. a -> a -> a -> Rigidified a
RigidThree Elem a
a Elem a
b Elem a
e
Node3 _ a :: Elem a
a b :: Elem a
b c :: Elem a
c -> Rigid (Elem a) -> Rigidified (Elem a)
forall a. Rigid a -> Rigidified a
RigidFull (Rigid (Elem a) -> Rigidified (Elem a))
-> Rigid (Elem a) -> Rigidified (Elem a)
forall a b. (a -> b) -> a -> b
$ Int
-> Digit23 (Elem a)
-> Thin (Digit23 (Elem a))
-> Digit23 (Elem a)
-> Rigid (Elem a)
forall a.
Int -> Digit23 a -> Thin (Digit23 a) -> Digit23 a -> Rigid a
Rigid Int
s (Elem a -> Elem a -> Digit23 (Elem a)
forall a. Sized a => a -> a -> Node a
node2 Elem a
a Elem a
b) Thin (Digit23 (Elem a))
forall a. Thin a
EmptyTh (Elem a -> Elem a -> Digit23 (Elem a)
forall a. Sized a => a -> a -> Node a
node2 Elem a
c Elem a
e)
thin :: Sized a => FingerTree a -> Thin a
thin :: FingerTree a -> Thin a
thin EmptyT = Thin a
forall a. Thin a
EmptyTh
thin (Single a :: a
a) = a -> Thin a
forall a. a -> Thin a
SingleTh a
a
thin (Deep s :: Int
s pr :: Digit a
pr m :: FingerTree (Node a)
m sf :: Digit a
sf) =
case Digit a
pr of
One a :: a
a -> Int -> Digit12 a -> FingerTree (Node a) -> Digit a -> Thin a
forall a.
Sized a =>
Int -> Digit12 a -> FingerTree (Node a) -> Digit a -> Thin a
thin12 Int
s (a -> Digit12 a
forall a. a -> Digit12 a
One12 a
a) FingerTree (Node a)
m Digit a
sf
Two a :: a
a b :: a
b -> Int -> Digit12 a -> FingerTree (Node a) -> Digit a -> Thin a
forall a.
Sized a =>
Int -> Digit12 a -> FingerTree (Node a) -> Digit a -> Thin a
thin12 Int
s (a -> a -> Digit12 a
forall a. a -> a -> Digit12 a
Two12 a
a a
b) FingerTree (Node a)
m Digit a
sf
Three a :: a
a b :: a
b c :: a
c -> Int -> Digit12 a -> FingerTree (Node a) -> Digit a -> Thin a
forall a.
Sized a =>
Int -> Digit12 a -> FingerTree (Node a) -> Digit a -> Thin a
thin12 Int
s (a -> Digit12 a
forall a. a -> Digit12 a
One12 a
a) (a -> a -> Node a
forall a. Sized a => a -> a -> Node a
node2 a
b a
c 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
Four a :: a
a b :: a
b c :: a
c d :: a
d -> Int -> Digit12 a -> FingerTree (Node a) -> Digit a -> Thin a
forall a.
Sized a =>
Int -> Digit12 a -> FingerTree (Node a) -> Digit a -> Thin a
thin12 Int
s (a -> a -> Digit12 a
forall a. a -> a -> Digit12 a
Two12 a
a a
b) (a -> a -> Node a
forall a. Sized a => a -> a -> Node a
node2 a
c a
d 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
thin12 :: Sized a => Int -> Digit12 a -> FingerTree (Node a) -> Digit a -> Thin a
thin12 :: Int -> Digit12 a -> FingerTree (Node a) -> Digit a -> Thin a
thin12 s :: Int
s pr :: Digit12 a
pr m :: FingerTree (Node a)
m (One a :: a
a) = Int -> Digit12 a -> Thin (Node a) -> Digit12 a -> Thin a
forall a. Int -> Digit12 a -> Thin (Node a) -> Digit12 a -> Thin a
DeepTh Int
s Digit12 a
pr (FingerTree (Node a) -> Thin (Node a)
forall a. Sized a => FingerTree a -> Thin a
thin FingerTree (Node a)
m) (a -> Digit12 a
forall a. a -> Digit12 a
One12 a
a)
thin12 s :: Int
s pr :: Digit12 a
pr m :: FingerTree (Node a)
m (Two a :: a
a b :: a
b) = Int -> Digit12 a -> Thin (Node a) -> Digit12 a -> Thin a
forall a. Int -> Digit12 a -> Thin (Node a) -> Digit12 a -> Thin a
DeepTh Int
s Digit12 a
pr (FingerTree (Node a) -> Thin (Node a)
forall a. Sized a => FingerTree a -> Thin a
thin FingerTree (Node a)
m) (a -> a -> Digit12 a
forall a. a -> a -> Digit12 a
Two12 a
a a
b)
thin12 s :: Int
s pr :: Digit12 a
pr m :: FingerTree (Node a)
m (Three a :: a
a b :: a
b c :: a
c) = Int -> Digit12 a -> Thin (Node a) -> Digit12 a -> Thin a
forall a. Int -> Digit12 a -> Thin (Node a) -> Digit12 a -> Thin a
DeepTh Int
s Digit12 a
pr (FingerTree (Node a) -> Thin (Node a)
forall a. Sized a => FingerTree a -> Thin a
thin (FingerTree (Node a) -> Thin (Node a))
-> FingerTree (Node a) -> Thin (Node a)
forall a b. (a -> b) -> a -> b
$ FingerTree (Node a)
m FingerTree (Node a) -> Node a -> FingerTree (Node a)
forall a. Sized a => FingerTree a -> a -> FingerTree a
`snocTree` a -> a -> Node a
forall a. Sized a => a -> a -> Node a
node2 a
a a
b) (a -> Digit12 a
forall a. a -> Digit12 a
One12 a
c)
thin12 s :: Int
s pr :: Digit12 a
pr m :: FingerTree (Node a)
m (Four a :: a
a b :: a
b c :: a
c d :: a
d) = Int -> Digit12 a -> Thin (Node a) -> Digit12 a -> Thin a
forall a. Int -> Digit12 a -> Thin (Node a) -> Digit12 a -> Thin a
DeepTh Int
s Digit12 a
pr (FingerTree (Node a) -> Thin (Node a)
forall a. Sized a => FingerTree a -> Thin a
thin (FingerTree (Node a) -> Thin (Node a))
-> FingerTree (Node a) -> Thin (Node a)
forall a b. (a -> b) -> a -> b
$ FingerTree (Node a)
m FingerTree (Node a) -> Node a -> FingerTree (Node a)
forall a. Sized a => FingerTree a -> a -> FingerTree a
`snocTree` a -> a -> Node a
forall a. Sized a => a -> a -> Node a
node2 a
a a
b) (a -> a -> Digit12 a
forall a. a -> a -> Digit12 a
Two12 a
c a
d)
intersperse :: a -> Seq a -> Seq a
intersperse :: a -> Seq a -> Seq a
intersperse y :: a
y xs :: Seq a
xs = case Seq a -> ViewL a
forall a. Seq a -> ViewL a
viewl Seq a
xs of
EmptyL -> Seq a
forall a. Seq a
empty
p :: a
p :< ps :: Seq a
ps -> a
p a -> Seq a -> Seq a
forall a. a -> Seq a -> Seq a
<| (Seq a
ps Seq a -> Seq (a -> a) -> Seq a
forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**> (a -> a -> a
forall a b. a -> b -> a
const a
y (a -> a) -> Seq (a -> a) -> Seq (a -> a)
forall a. a -> Seq a -> Seq a
<| (a -> a) -> Seq (a -> a)
forall a. a -> Seq a
singleton a -> a
forall a. a -> a
id))
instance MonadPlus Seq where
mzero :: Seq a
mzero = Seq a
forall a. Seq a
empty
mplus :: Seq a -> Seq a -> Seq a
mplus = Seq a -> Seq a -> Seq a
forall a. Seq a -> Seq a -> Seq a
(><)
instance Alternative Seq where
empty :: Seq a
empty = Seq a
forall a. Seq a
empty
<|> :: Seq a -> Seq a -> Seq a
(<|>) = Seq a -> Seq a -> Seq a
forall a. Seq a -> Seq a -> Seq a
(><)
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 (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq a
xs [a] -> [a] -> Bool
forall a. Eq a => a -> a -> Bool
== Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t 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 (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq a
xs) (Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq a
ys)
#ifdef 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 p :: Int
p xs :: Seq a
xs = Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
[Char] -> ShowS
showString "fromList " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> ShowS
forall a. Show a => a -> ShowS
shows (Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq a
xs)
#endif
#if MIN_VERSION_base(4,9,0)
instance Show1 Seq where
liftShowsPrec :: (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> Seq a -> ShowS
liftShowsPrec _shwsPrc :: Int -> a -> ShowS
_shwsPrc shwList :: [a] -> ShowS
shwList p :: Int
p xs :: Seq a
xs = Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
[Char] -> ShowS
showString "fromList " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> ShowS
shwList (Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq a
xs)
instance Eq1 Seq where
liftEq :: (a -> b -> Bool) -> Seq a -> Seq b -> Bool
liftEq eq :: a -> b -> Bool
eq xs :: Seq a
xs ys :: Seq b
ys = Seq a -> Int
forall a. Seq a -> Int
length Seq a
xs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Seq b -> Int
forall a. Seq a -> Int
length Seq b
ys Bool -> Bool -> Bool
&& (a -> b -> Bool) -> [a] -> [b] -> Bool
forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq a -> b -> Bool
eq (Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq a
xs) (Seq b -> [b]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq b
ys)
instance Ord1 Seq where
liftCompare :: (a -> b -> Ordering) -> Seq a -> Seq b -> Ordering
liftCompare cmp :: a -> b -> Ordering
cmp xs :: Seq a
xs ys :: Seq b
ys = (a -> b -> Ordering) -> [a] -> [b] -> Ordering
forall (f :: * -> *) a b.
Ord1 f =>
(a -> b -> Ordering) -> f a -> f b -> Ordering
liftCompare a -> b -> Ordering
cmp (Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq a
xs) (Seq b -> [b]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq b
ys)
#endif
instance Read a => Read (Seq a) where
#ifdef __GLASGOW_HASKELL__
readPrec :: ReadPrec (Seq a)
readPrec = ReadPrec (Seq a) -> ReadPrec (Seq a)
forall a. ReadPrec a -> ReadPrec a
parens (ReadPrec (Seq a) -> ReadPrec (Seq a))
-> ReadPrec (Seq a) -> ReadPrec (Seq a)
forall a b. (a -> b) -> a -> b
$ Int -> ReadPrec (Seq a) -> ReadPrec (Seq a)
forall a. Int -> ReadPrec a -> ReadPrec a
prec 10 (ReadPrec (Seq a) -> ReadPrec (Seq a))
-> ReadPrec (Seq a) -> ReadPrec (Seq a)
forall a b. (a -> b) -> a -> b
$ do
Ident "fromList" <- ReadPrec Lexeme
lexP
[a]
xs <- ReadPrec [a]
forall a. Read a => ReadPrec a
readPrec
Seq a -> ReadPrec (Seq a)
forall (m :: * -> *) a. Monad m => a -> m a
return ([a] -> Seq a
forall a. [a] -> Seq a
fromList [a]
xs)
readListPrec :: ReadPrec [Seq a]
readListPrec = ReadPrec [Seq a]
forall a. Read a => ReadPrec [a]
readListPrecDefault
#else
readsPrec p = readParen (p > 10) $ \ r -> do
("fromList",s) <- lex r
(xs,t) <- reads s
return (fromList xs,t)
#endif
#if MIN_VERSION_base(4,9,0)
instance Read1 Seq where
liftReadsPrec :: (Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (Seq a)
liftReadsPrec _rp :: Int -> ReadS a
_rp readLst :: ReadS [a]
readLst p :: Int
p = Bool -> ReadS (Seq a) -> ReadS (Seq a)
forall a. Bool -> ReadS a -> ReadS a
readParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 10) (ReadS (Seq a) -> ReadS (Seq a)) -> ReadS (Seq a) -> ReadS (Seq a)
forall a b. (a -> b) -> a -> b
$ \r :: [Char]
r -> do
("fromList",s :: [Char]
s) <- ReadS [Char]
lex [Char]
r
(xs :: [a]
xs,t :: [Char]
t) <- ReadS [a]
readLst [Char]
s
(Seq a, [Char]) -> [(Seq a, [Char])]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([a] -> Seq a
forall a. [a] -> Seq a
fromList [a]
xs, [Char]
t)
#endif
instance Monoid (Seq a) where
mempty :: Seq a
mempty = Seq a
forall a. Seq a
empty
mappend :: Seq a -> Seq a -> Seq a
mappend = Seq a -> Seq a -> Seq a
forall a. Seq a -> Seq a -> Seq a
(><)
#if MIN_VERSION_base(4,9,0)
instance Semigroup.Semigroup (Seq a) where
<> :: Seq a -> Seq a -> Seq a
(<>) = Seq a -> Seq a -> Seq a
forall a. Seq a -> Seq a -> Seq a
(><)
stimes :: b -> Seq a -> Seq a
stimes = Int -> Seq a -> Seq a
forall a. Int -> Seq a -> Seq a
cycleNTimes (Int -> Seq a -> Seq a) -> (b -> Int) -> b -> Seq a -> Seq a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral
#endif
INSTANCE_TYPEABLE1(Seq)
#if __GLASGOW_HASKELL__
instance Data a => Data (Seq a) where
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Seq a -> c (Seq a)
gfoldl f :: forall d b. Data d => c (d -> b) -> d -> c b
f z :: forall g. g -> c g
z s :: Seq a
s = case Seq a -> ViewL a
forall a. Seq a -> ViewL a
viewl Seq a
s of
EmptyL -> Seq a -> c (Seq a)
forall g. g -> c g
z Seq a
forall a. Seq a
empty
x :: a
x :< xs :: Seq a
xs -> (a -> Seq a -> Seq a) -> c (a -> Seq a -> Seq a)
forall g. g -> c g
z a -> Seq a -> Seq a
forall a. a -> Seq a -> Seq a
(<|) c (a -> Seq a -> Seq a) -> a -> c (Seq a -> Seq a)
forall d b. Data d => c (d -> b) -> d -> c b
`f` a
x c (Seq a -> Seq a) -> Seq a -> c (Seq a)
forall d b. Data d => c (d -> b) -> d -> c b
`f` Seq a
xs
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Seq a)
gunfold k :: forall b r. Data b => c (b -> r) -> c r
k z :: forall r. r -> c r
z c :: Constr
c = case Constr -> Int
constrIndex Constr
c of
1 -> Seq a -> c (Seq a)
forall r. r -> c r
z Seq a
forall a. Seq a
empty
2 -> c (Seq a -> Seq a) -> c (Seq a)
forall b r. Data b => c (b -> r) -> c r
k (c (a -> Seq a -> Seq a) -> c (Seq a -> Seq a)
forall b r. Data b => c (b -> r) -> c r
k ((a -> Seq a -> Seq a) -> c (a -> Seq a -> Seq a)
forall r. r -> c r
z a -> Seq a -> Seq a
forall a. a -> Seq a -> Seq a
(<|)))
_ -> [Char] -> c (Seq a)
forall a. HasCallStack => [Char] -> a
error "gunfold"
toConstr :: Seq a -> Constr
toConstr xs :: Seq a
xs
| Seq a -> Bool
forall a. Seq a -> Bool
null Seq a
xs = Constr
emptyConstr
| Bool
otherwise = Constr
consConstr
dataTypeOf :: Seq a -> DataType
dataTypeOf _ = DataType
seqDataType
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c (Seq a))
dataCast1 f :: forall d. Data d => c (t d)
f = c (t a) -> Maybe (c (Seq a))
forall k1 k2 (c :: k1 -> *) (t :: k2 -> k1) (t' :: k2 -> k1)
(a :: k2).
(Typeable t, Typeable t') =>
c (t a) -> Maybe (c (t' a))
gcast1 c (t a)
forall d. Data d => c (t d)
f
emptyConstr, consConstr :: Constr
emptyConstr :: Constr
emptyConstr = DataType -> [Char] -> [[Char]] -> Fixity -> Constr
mkConstr DataType
seqDataType "empty" [] Fixity
Prefix
consConstr :: Constr
consConstr = DataType -> [Char] -> [[Char]] -> Fixity -> Constr
mkConstr DataType
seqDataType "<|" [] Fixity
Infix
seqDataType :: DataType
seqDataType :: DataType
seqDataType = [Char] -> [Constr] -> DataType
mkDataType "Data.Sequence.Seq" [Constr
emptyConstr, Constr
consConstr]
#endif
data FingerTree a
= EmptyT
| Single a
| Deep {-# UNPACK #-} !Int !(Digit a) (FingerTree (Node a)) !(Digit a)
#ifdef TESTING
deriving Show
#endif
#ifdef __GLASGOW_HASKELL__
deriving instance Generic1 FingerTree
deriving instance Generic (FingerTree a)
#endif
instance Sized a => Sized (FingerTree a) where
{-# SPECIALIZE instance Sized (FingerTree (Elem a)) #-}
{-# SPECIALIZE instance Sized (FingerTree (Node a)) #-}
size :: FingerTree a -> Int
size EmptyT = 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 Foldable FingerTree where
foldMap :: (a -> m) -> FingerTree a -> m
foldMap _ EmptyT = m
forall a. Monoid a => a
mempty
foldMap f' :: a -> m
f' (Single x' :: a
x') = a -> m
f' a
x'
foldMap f' :: a -> m
f' (Deep _ pr' :: Digit a
pr' m' :: FingerTree (Node a)
m' sf' :: Digit a
sf') =
(a -> m) -> Digit a -> m
forall m a. Monoid m => (a -> m) -> Digit a -> m
foldMapDigit a -> m
f' Digit a
pr' m -> m -> m
forall a. Monoid a => a -> a -> a
<>
(Node a -> m) -> FingerTree (Node a) -> m
forall m a. Monoid m => (Node a -> m) -> FingerTree (Node a) -> m
foldMapTree ((a -> m) -> Node a -> m
forall m a. Monoid m => (a -> m) -> Node a -> m
foldMapNode a -> m
f') FingerTree (Node a)
m' m -> m -> m
forall a. Monoid a => a -> a -> a
<>
(a -> m) -> Digit a -> m
forall m a. Monoid m => (a -> m) -> Digit a -> m
foldMapDigit a -> m
f' Digit a
sf'
where
foldMapTree :: Monoid m => (Node a -> m) -> FingerTree (Node a) -> m
foldMapTree :: (Node a -> m) -> FingerTree (Node a) -> m
foldMapTree _ EmptyT = m
forall a. Monoid a => a
mempty
foldMapTree f :: Node a -> m
f (Single x :: Node a
x) = Node a -> m
f Node a
x
foldMapTree f :: Node a -> m
f (Deep _ pr :: Digit (Node a)
pr m :: FingerTree (Node (Node a))
m sf :: Digit (Node a)
sf) =
(Node a -> m) -> Digit (Node a) -> m
forall m a. Monoid m => (Node a -> m) -> Digit (Node a) -> m
foldMapDigitN Node a -> m
f Digit (Node a)
pr m -> m -> m
forall a. Monoid a => a -> a -> a
<>
(Node (Node a) -> m) -> FingerTree (Node (Node a)) -> m
forall m a. Monoid m => (Node a -> m) -> FingerTree (Node a) -> m
foldMapTree ((Node a -> m) -> Node (Node a) -> m
forall m a. Monoid m => (Node a -> m) -> Node (Node a) -> m
foldMapNodeN Node a -> m
f) FingerTree (Node (Node a))
m m -> m -> m
forall a. Monoid a => a -> a -> a
<>
(Node a -> m) -> Digit (Node a) -> m
forall m a. Monoid m => (Node a -> m) -> Digit (Node a) -> m
foldMapDigitN Node a -> m
f Digit (Node a)
sf
foldMapDigit :: Monoid m => (a -> m) -> Digit a -> m
foldMapDigit :: (a -> m) -> Digit a -> m
foldMapDigit f :: a -> m
f t :: Digit a
t = (m -> m -> m) -> (a -> m) -> Digit a -> m
forall b a. (b -> b -> b) -> (a -> b) -> Digit a -> b
foldDigit m -> m -> m
forall a. Monoid a => a -> a -> a
(<>) a -> m
f Digit a
t
foldMapDigitN :: Monoid m => (Node a -> m) -> Digit (Node a) -> m
foldMapDigitN :: (Node a -> m) -> Digit (Node a) -> m
foldMapDigitN f :: Node a -> m
f t :: Digit (Node a)
t = (m -> m -> m) -> (Node a -> m) -> Digit (Node a) -> m
forall b a. (b -> b -> b) -> (a -> b) -> Digit a -> b
foldDigit m -> m -> m
forall a. Monoid a => a -> a -> a
(<>) Node a -> m
f Digit (Node a)
t
foldMapNode :: Monoid m => (a -> m) -> Node a -> m
foldMapNode :: (a -> m) -> Node a -> m
foldMapNode f :: a -> m
f t :: Node a
t = (m -> m -> m) -> (a -> m) -> Node a -> m
forall b a. (b -> b -> b) -> (a -> b) -> Node a -> b
foldNode m -> m -> m
forall a. Monoid a => a -> a -> a
(<>) a -> m
f Node a
t
foldMapNodeN :: Monoid m => (Node a -> m) -> Node (Node a) -> m
foldMapNodeN :: (Node a -> m) -> Node (Node a) -> m
foldMapNodeN f :: Node a -> m
f t :: Node (Node a)
t = (m -> m -> m) -> (Node a -> m) -> Node (Node a) -> m
forall b a. (b -> b -> b) -> (a -> b) -> Node a -> b
foldNode m -> m -> m
forall a. Monoid a => a -> a -> a
(<>) Node a -> m
f Node (Node a)
t
#if __GLASGOW_HASKELL__
{-# INLINABLE foldMap #-}
#endif
foldr :: (a -> b -> b) -> b -> FingerTree a -> b
foldr _ z' :: b
z' EmptyT = b
z'
foldr f' :: a -> b -> b
f' z' :: b
z' (Single x' :: a
x') = a
x' a -> b -> b
`f'` b
z'
foldr 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. (Node a -> b -> b) -> b -> FingerTree (Node a) -> b
foldrTree ((a -> b -> b) -> Node a -> b -> b
forall a b. (a -> b -> b) -> Node a -> b -> 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'
where
foldrTree :: (Node a -> b -> b) -> b -> FingerTree (Node a) -> b
foldrTree :: (Node a -> b -> b) -> b -> FingerTree (Node a) -> b
foldrTree _ z :: b
z EmptyT = b
z
foldrTree f :: Node a -> b -> b
f z :: b
z (Single x :: Node a
x) = Node a
x Node a -> b -> b
`f` b
z
foldrTree f :: Node a -> b -> b
f z :: b
z (Deep _ pr :: Digit (Node a)
pr m :: FingerTree (Node (Node a))
m sf :: Digit (Node a)
sf) =
(Node a -> b -> b) -> b -> Digit (Node a) -> b
forall a b. (Node a -> b -> b) -> b -> Digit (Node a) -> b
foldrDigitN Node a -> b -> b
f ((Node (Node a) -> b -> b) -> b -> FingerTree (Node (Node a)) -> b
forall a b. (Node a -> b -> b) -> b -> FingerTree (Node a) -> b
foldrTree ((Node a -> b -> b) -> Node (Node a) -> b -> b
forall a b. (Node a -> b -> b) -> Node (Node a) -> b -> b
foldrNodeN Node a -> b -> b
f) ((Node a -> b -> b) -> b -> Digit (Node a) -> b
forall a b. (Node a -> b -> b) -> b -> Digit (Node a) -> b
foldrDigitN Node a -> b -> b
f b
z Digit (Node a)
sf) FingerTree (Node (Node a))
m) Digit (Node 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 t :: Digit a
t = (a -> b -> b) -> b -> Digit a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> b -> b
f b
z Digit a
t
foldrDigitN :: (Node a -> b -> b) -> b -> Digit (Node a) -> b
foldrDigitN :: (Node a -> b -> b) -> b -> Digit (Node a) -> b
foldrDigitN f :: Node a -> b -> b
f z :: b
z t :: Digit (Node a)
t = (Node a -> b -> b) -> b -> Digit (Node a) -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Node a -> b -> b
f b
z Digit (Node a)
t
foldrNode :: (a -> b -> b) -> Node a -> b -> b
foldrNode :: (a -> b -> b) -> Node a -> b -> b
foldrNode f :: a -> b -> b
f t :: Node a
t z :: b
z = (a -> b -> b) -> b -> Node a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> b -> b
f b
z Node a
t
foldrNodeN :: (Node a -> b -> b) -> Node (Node a) -> b -> b
foldrNodeN :: (Node a -> b -> b) -> Node (Node a) -> b -> b
foldrNodeN f :: Node a -> b -> b
f t :: Node (Node a)
t z :: b
z = (Node a -> b -> b) -> b -> Node (Node a) -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Node a -> b -> b
f b
z Node (Node a)
t
{-# INLINE foldr #-}
foldl :: (b -> a -> b) -> b -> FingerTree a -> b
foldl _ z' :: b
z' EmptyT = b
z'
foldl f' :: b -> a -> b
f' z' :: b
z' (Single x' :: a
x') = b
z' b -> a -> b
`f'` a
x'
foldl f' :: b -> a -> b
f' z' :: b
z' (Deep _ pr' :: Digit a
pr' m' :: FingerTree (Node a)
m' sf' :: Digit a
sf') =
(b -> a -> b) -> b -> Digit a -> b
forall b a. (b -> a -> b) -> b -> Digit a -> b
foldlDigit b -> a -> b
f' ((b -> Node a -> b) -> b -> FingerTree (Node a) -> b
forall b a. (b -> Node a -> b) -> b -> FingerTree (Node a) -> b
foldlTree ((b -> a -> b) -> b -> Node a -> b
forall b a. (b -> a -> b) -> b -> Node a -> b
foldlNode b -> a -> b
f') ((b -> a -> b) -> b -> Digit a -> b
forall b a. (b -> a -> b) -> b -> Digit a -> b
foldlDigit b -> a -> b
f' b
z' Digit a
pr') FingerTree (Node a)
m') Digit a
sf'
where
foldlTree :: (b -> Node a -> b) -> b -> FingerTree (Node a) -> b
foldlTree :: (b -> Node a -> b) -> b -> FingerTree (Node a) -> b
foldlTree _ z :: b
z EmptyT = b
z
foldlTree f :: b -> Node a -> b
f z :: b
z (Single x :: Node a
x) = b
z b -> Node a -> b
`f` Node a
x
foldlTree f :: b -> Node a -> b
f z :: b
z (Deep _ pr :: Digit (Node a)
pr m :: FingerTree (Node (Node a))
m sf :: Digit (Node a)
sf) =
(b -> Node a -> b) -> b -> Digit (Node a) -> b
forall b a. (b -> Node a -> b) -> b -> Digit (Node a) -> b
foldlDigitN b -> Node a -> b
f ((b -> Node (Node a) -> b) -> b -> FingerTree (Node (Node a)) -> b
forall b a. (b -> Node a -> b) -> b -> FingerTree (Node a) -> b
foldlTree ((b -> Node a -> b) -> b -> Node (Node a) -> b
forall b a. (b -> Node a -> b) -> b -> Node (Node a) -> b
foldlNodeN b -> Node a -> b
f) ((b -> Node a -> b) -> b -> Digit (Node a) -> b
forall b a. (b -> Node a -> b) -> b -> Digit (Node a) -> b
foldlDigitN b -> Node a -> b
f b
z Digit (Node a)
pr) FingerTree (Node (Node a))
m) Digit (Node a)
sf
foldlDigit :: (b -> a -> b) -> b -> Digit a -> b
foldlDigit :: (b -> a -> b) -> b -> Digit a -> b
foldlDigit f :: b -> a -> b
f z :: b
z t :: Digit a
t = (b -> a -> b) -> b -> Digit a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl b -> a -> b
f b
z Digit a
t
foldlDigitN :: (b -> Node a -> b) -> b -> Digit (Node a) -> b
foldlDigitN :: (b -> Node a -> b) -> b -> Digit (Node a) -> b
foldlDigitN f :: b -> Node a -> b
f z :: b
z t :: Digit (Node a)
t = (b -> Node a -> b) -> b -> Digit (Node a) -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl b -> Node a -> b
f b
z Digit (Node a)
t
foldlNode :: (b -> a -> b) -> b -> Node a -> b
foldlNode :: (b -> a -> b) -> b -> Node a -> b
foldlNode f :: b -> a -> b
f z :: b
z t :: Node a
t = (b -> a -> b) -> b -> Node a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl b -> a -> b
f b
z Node a
t
foldlNodeN :: (b -> Node a -> b) -> b -> Node (Node a) -> b
foldlNodeN :: (b -> Node a -> b) -> b -> Node (Node a) -> b
foldlNodeN f :: b -> Node a -> b
f z :: b
z t :: Node (Node a)
t = (b -> Node a -> b) -> b -> Node (Node a) -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl b -> Node a -> b
f b
z Node (Node a)
t
{-# INLINE foldl #-}
foldr' :: (a -> b -> b) -> b -> FingerTree a -> b
foldr' _ z' :: b
z' EmptyT = b
z'
foldr' f' :: a -> b -> b
f' z' :: b
z' (Single x' :: a
x') = a -> b -> b
f' a
x' b
z'
foldr' 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' (b -> Digit a -> b) -> b -> Digit a -> b
forall a b. (a -> b) -> a -> b
$! ((Node a -> b -> b) -> b -> FingerTree (Node a) -> b
forall a b. (Node a -> b -> b) -> b -> FingerTree (Node a) -> b
foldrTree' ((a -> b -> b) -> Node a -> b -> b
forall a b. (a -> b -> b) -> Node a -> b -> b
foldrNode' a -> b -> b
f') (b -> FingerTree (Node a) -> b) -> b -> FingerTree (Node a) -> b
forall a b. (a -> b) -> a -> b
$! ((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'
where
foldrTree' :: (Node a -> b -> b) -> b -> FingerTree (Node a) -> b
foldrTree' :: (Node a -> b -> b) -> b -> FingerTree (Node a) -> b
foldrTree' _ z :: b
z EmptyT = b
z
foldrTree' f :: Node a -> b -> b
f z :: b
z (Single x :: Node a
x) = Node a -> b -> b
f Node a
x (b -> b) -> b -> b
forall a b. (a -> b) -> a -> b
$! b
z
foldrTree' f :: Node a -> b -> b
f z :: b
z (Deep _ pr :: Digit (Node a)
pr m :: FingerTree (Node (Node a))
m sf :: Digit (Node a)
sf) =
((Node a -> b -> b) -> b -> Digit (Node a) -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr' Node a -> b -> b
f (b -> Digit (Node a) -> b) -> b -> Digit (Node a) -> b
forall a b. (a -> b) -> a -> b
$! ((Node (Node a) -> b -> b) -> b -> FingerTree (Node (Node a)) -> b
forall a b. (Node a -> b -> b) -> b -> FingerTree (Node a) -> b
foldrTree' ((Node a -> b -> b) -> Node (Node a) -> b -> b
forall a b. (Node a -> b -> b) -> Node (Node a) -> b -> b
foldrNodeN' Node a -> b -> b
f) (b -> FingerTree (Node (Node a)) -> b)
-> b -> FingerTree (Node (Node a)) -> b
forall a b. (a -> b) -> a -> b
$! ((Node a -> b -> b) -> b -> Digit (Node a) -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr' Node a -> b -> b
f (b -> Digit (Node a) -> b) -> b -> Digit (Node a) -> b
forall a b. (a -> b) -> a -> b
$! b
z) Digit (Node a)
sf) FingerTree (Node (Node a))
m) Digit (Node 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 t :: Digit a
t = (a -> b -> b) -> b -> Digit a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr' a -> b -> b
f b
z Digit a
t
foldrNode' :: (a -> b -> b) -> Node a -> b -> b
foldrNode' :: (a -> b -> b) -> Node a -> b -> b
foldrNode' f :: a -> b -> b
f t :: Node a
t z :: b
z = (a -> b -> b) -> b -> Node a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr' a -> b -> b
f b
z Node a
t
foldrNodeN' :: (Node a -> b -> b) -> Node (Node a) -> b -> b
foldrNodeN' :: (Node a -> b -> b) -> Node (Node a) -> b -> b
foldrNodeN' f :: Node a -> b -> b
f t :: Node (Node a)
t z :: b
z = (Node a -> b -> b) -> b -> Node (Node a) -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr' Node a -> b -> b
f b
z Node (Node a)
t
{-# INLINE foldr' #-}
foldl' :: (b -> a -> b) -> b -> FingerTree a -> b
foldl' _ z' :: b
z' EmptyT = b
z'
foldl' f' :: b -> a -> b
f' z' :: b
z' (Single x' :: a
x') = b -> a -> b
f' b
z' a
x'
foldl' f' :: b -> a -> b
f' z' :: b
z' (Deep _ pr' :: Digit a
pr' m' :: FingerTree (Node a)
m' sf' :: Digit a
sf') =
((b -> a -> b) -> b -> Digit a -> b
forall b a. (b -> a -> b) -> b -> Digit a -> b
foldlDigit' b -> a -> b
f' (b -> Digit a -> b) -> b -> Digit a -> b
forall a b. (a -> b) -> a -> b
$!
((b -> Node a -> b) -> b -> FingerTree (Node a) -> b
forall b a. (b -> Node a -> b) -> b -> FingerTree (Node a) -> b
foldlTree' ((b -> a -> b) -> b -> Node a -> b
forall b a. (b -> a -> b) -> b -> Node a -> b
foldlNode' b -> a -> b
f') (b -> FingerTree (Node a) -> b) -> b -> FingerTree (Node a) -> b
forall a b. (a -> b) -> a -> b
$! ((b -> a -> b) -> b -> Digit a -> b
forall b a. (b -> a -> b) -> b -> Digit a -> b
foldlDigit' b -> a -> b
f' b
z') Digit a
pr') FingerTree (Node a)
m')
Digit a
sf'
where
foldlTree' :: (b -> Node a -> b) -> b -> FingerTree (Node a) -> b
foldlTree' :: (b -> Node a -> b) -> b -> FingerTree (Node a) -> b
foldlTree' _ z :: b
z EmptyT = b
z
foldlTree' f :: b -> Node a -> b
f z :: b
z (Single xs :: Node a
xs) = b -> Node a -> b
f b
z Node a
xs
foldlTree' f :: b -> Node a -> b
f z :: b
z (Deep _ pr :: Digit (Node a)
pr m :: FingerTree (Node (Node a))
m sf :: Digit (Node a)
sf) =
((b -> Node a -> b) -> b -> Digit (Node a) -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' b -> Node a -> b
f (b -> Digit (Node a) -> b) -> b -> Digit (Node a) -> b
forall a b. (a -> b) -> a -> b
$! ((b -> Node (Node a) -> b) -> b -> FingerTree (Node (Node a)) -> b
forall b a. (b -> Node a -> b) -> b -> FingerTree (Node a) -> b
foldlTree' ((b -> Node a -> b) -> b -> Node (Node a) -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' b -> Node a -> b
f) (b -> FingerTree (Node (Node a)) -> b)
-> b -> FingerTree (Node (Node a)) -> b
forall a b. (a -> b) -> a -> b
$! (b -> Node a -> b) -> b -> Digit (Node a) -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' b -> Node a -> b
f b
z Digit (Node a)
pr) FingerTree (Node (Node a))
m) Digit (Node a)
sf
foldlDigit' :: (b -> a -> b) -> b -> Digit a -> b
foldlDigit' :: (b -> a -> b) -> b -> Digit a -> b
foldlDigit' f :: b -> a -> b
f z :: b
z t :: Digit a
t = (b -> a -> b) -> b -> Digit a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' b -> a -> b
f b
z Digit a
t
foldlNode' :: (b -> a -> b) -> b -> Node a -> b
foldlNode' :: (b -> a -> b) -> b -> Node a -> b
foldlNode' f :: b -> a -> b
f z :: b
z t :: Node a
t = (b -> a -> b) -> b -> Node a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' b -> a -> b
f b
z Node a
t
{-# INLINE foldl' #-}
foldr1 :: (a -> a -> a) -> FingerTree a -> a
foldr1 _ EmptyT = [Char] -> a
forall a. HasCallStack => [Char] -> a
error "foldr1: empty sequence"
foldr1 _ (Single x :: a
x) = a
x
foldr1 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 (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> a -> a
f ((Node a -> a -> a) -> a -> FingerTree (Node a) -> a
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((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 (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> a -> a
f)) ((a -> a -> a) -> Digit a -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 a -> a -> a
f Digit a
sf) FingerTree (Node a)
m) Digit a
pr
foldl1 :: (a -> a -> a) -> FingerTree a -> a
foldl1 _ EmptyT = [Char] -> a
forall a. HasCallStack => [Char] -> a
error "foldl1: empty sequence"
foldl1 _ (Single x :: a
x) = a
x
foldl1 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 (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl a -> a -> a
f ((a -> Node a -> a) -> a -> FingerTree (Node a) -> a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl ((a -> a -> a) -> a -> Node a -> a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl a -> a -> a
f) ((a -> a -> a) -> Digit a -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 a -> a -> a
f Digit a
pr) FingerTree (Node a)
m) Digit a
sf
instance Functor FingerTree where
fmap :: (a -> b) -> FingerTree a -> FingerTree b
fmap _ EmptyT = FingerTree b
forall a. FingerTree a
EmptyT
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)
instance Traversable FingerTree where
traverse :: (a -> f b) -> FingerTree a -> f (FingerTree b)
traverse _ EmptyT = FingerTree b -> f (FingerTree b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure FingerTree b
forall a. FingerTree a
EmptyT
traverse f :: a -> f b
f (Single x :: a
x) = b -> FingerTree b
forall a. a -> FingerTree a
Single (b -> FingerTree b) -> f b -> f (FingerTree b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
x
traverse f :: a -> f b
f (Deep v :: Int
v pr :: Digit a
pr m :: FingerTree (Node a)
m sf :: Digit a
sf) =
(Digit b -> FingerTree (Node b) -> Digit b -> FingerTree b)
-> f (Digit b)
-> f (FingerTree (Node b))
-> f (Digit b)
-> f (FingerTree b)
forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3 (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 -> f b) -> Digit a -> f (Digit b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
f Digit a
pr) ((Node a -> f (Node b))
-> FingerTree (Node a) -> f (FingerTree (Node b))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((a -> f b) -> Node a -> f (Node b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
f) FingerTree (Node a)
m)
((a -> f b) -> Digit a -> f (Digit b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
f Digit a
sf)
instance NFData a => NFData (FingerTree a) where
rnf :: FingerTree a -> ()
rnf EmptyT = ()
rnf (Single x :: a
x) = a -> ()
forall a. NFData a => a -> ()
rnf a
x
rnf (Deep _ pr :: Digit a
pr m :: FingerTree (Node a)
m sf :: Digit a
sf) = Digit a -> ()
forall a. NFData a => a -> ()
rnf Digit a
pr () -> () -> ()
forall a b. a -> b -> b
`seq` Digit a -> ()
forall a. NFData a => a -> ()
rnf Digit a
sf () -> () -> ()
forall a b. a -> b -> b
`seq` FingerTree (Node a) -> ()
forall a. NFData a => a -> ()
rnf FingerTree (Node a)
m
{-# 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
{-# INLINE pullL #-}
pullL :: Int -> FingerTree (Node a) -> Digit a -> FingerTree a
pullL :: Int -> FingerTree (Node a) -> Digit a -> FingerTree a
pullL s :: Int
s m :: FingerTree (Node a)
m sf :: Digit a
sf = case FingerTree (Node a) -> ViewLTree (Node a)
forall a. Sized a => FingerTree a -> ViewLTree a
viewLTree FingerTree (Node a)
m of
EmptyLTree -> Int -> Digit a -> FingerTree a
forall a. Int -> Digit a -> FingerTree a
digitToTree' Int
s Digit a
sf
ConsLTree pr :: Node a
pr 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 (Node a -> Digit a
forall a. Node a -> Digit a
nodeToDigit Node a
pr) FingerTree (Node a)
m' Digit a
sf
{-# INLINE pullR #-}
pullR :: Int -> Digit a -> FingerTree (Node a) -> FingerTree a
pullR :: Int -> Digit a -> FingerTree (Node a) -> FingerTree a
pullR s :: Int
s pr :: Digit a
pr m :: FingerTree (Node a)
m = case FingerTree (Node a) -> ViewRTree (Node a)
forall a. Sized a => FingerTree a -> ViewRTree a
viewRTree FingerTree (Node a)
m of
EmptyRTree -> Int -> Digit a -> FingerTree a
forall a. Int -> Digit a -> FingerTree a
digitToTree' Int
s Digit a
pr
SnocRTree m' :: FingerTree (Node a)
m' sf :: Node 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 Digit a
pr FingerTree (Node a)
m' (Node a -> Digit a
forall a. Node a -> Digit a
nodeToDigit Node a
sf)
data Digit a
= One a
| Two a a
| Three a a a
| Four a a a a
#ifdef TESTING
deriving Show
#endif
#ifdef __GLASGOW_HASKELL__
deriving instance Generic1 Digit
deriving instance Generic (Digit a)
#endif
foldDigit :: (b -> b -> b) -> (a -> b) -> Digit a -> b
foldDigit :: (b -> b -> b) -> (a -> b) -> Digit a -> b
foldDigit _ f :: a -> b
f (One a :: a
a) = a -> b
f a
a
foldDigit <+> :: b -> b -> b
(<+>) f :: a -> b
f (Two a :: a
a b :: a
b) = a -> b
f a
a b -> b -> b
<+> a -> b
f a
b
foldDigit <+> :: b -> b -> b
(<+>) f :: a -> b
f (Three a :: a
a b :: a
b c :: a
c) = a -> b
f a
a b -> b -> b
<+> a -> b
f a
b b -> b -> b
<+> a -> b
f a
c
foldDigit <+> :: b -> b -> b
(<+>) f :: a -> b
f (Four a :: a
a b :: a
b c :: a
c d :: a
d) = a -> b
f a
a b -> b -> b
<+> a -> b
f a
b b -> b -> b
<+> a -> b
f a
c b -> b -> b
<+> a -> b
f a
d
{-# INLINE foldDigit #-}
instance Foldable Digit where
foldMap :: (a -> m) -> Digit a -> m
foldMap = (m -> m -> m) -> (a -> m) -> Digit a -> m
forall b a. (b -> b -> b) -> (a -> b) -> Digit a -> b
foldDigit m -> m -> m
forall a. Monoid a => a -> a -> a
mappend
foldr :: (a -> b -> b) -> b -> Digit a -> b
foldr f :: a -> b -> b
f z :: b
z (One a :: a
a) = a
a a -> b -> b
`f` b
z
foldr 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)
foldr 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))
foldr 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)))
{-# INLINE foldr #-}
foldl :: (b -> a -> b) -> b -> Digit a -> b
foldl f :: b -> a -> b
f z :: b
z (One a :: a
a) = b
z b -> a -> b
`f` a
a
foldl f :: b -> a -> b
f z :: b
z (Two a :: a
a b :: a
b) = (b
z b -> a -> b
`f` a
a) b -> a -> b
`f` a
b
foldl f :: b -> a -> b
f z :: b
z (Three a :: a
a b :: a
b c :: a
c) = ((b
z b -> a -> b
`f` a
a) b -> a -> b
`f` a
b) b -> a -> b
`f` a
c
foldl f :: b -> a -> b
f z :: b
z (Four a :: a
a b :: a
b c :: a
c d :: a
d) = (((b
z b -> a -> b
`f` a
a) b -> a -> b
`f` a
b) b -> a -> b
`f` a
c) b -> a -> b
`f` a
d
{-# INLINE foldl #-}
foldr' :: (a -> b -> b) -> b -> Digit a -> b
foldr' f :: a -> b -> b
f z :: b
z (One a :: a
a) = a -> b -> b
f a
a b
z
foldr' f :: a -> b -> b
f z :: b
z (Two a :: a
a b :: a
b) = a -> b -> b
f a
a (b -> b) -> b -> b
forall a b. (a -> b) -> a -> b
$! a -> b -> b
f a
b b
z
foldr' f :: a -> b -> b
f z :: b
z (Three a :: a
a b :: a
b c :: a
c) = a -> b -> b
f a
a (b -> b) -> b -> b
forall a b. (a -> b) -> a -> b
$! a -> b -> b
f a
b (b -> b) -> b -> b
forall a b. (a -> b) -> a -> b
$! a -> b -> b
f a
c b
z
foldr' f :: a -> b -> b
f z :: b
z (Four a :: a
a b :: a
b c :: a
c d :: a
d) = a -> b -> b
f a
a (b -> b) -> b -> b
forall a b. (a -> b) -> a -> b
$! a -> b -> b
f a
b (b -> b) -> b -> b
forall a b. (a -> b) -> a -> b
$! a -> b -> b
f a
c (b -> b) -> b -> b
forall a b. (a -> b) -> a -> b
$! a -> b -> b
f a
d b
z
{-# INLINE foldr' #-}
foldl' :: (b -> a -> b) -> b -> Digit a -> b
foldl' f :: b -> a -> b
f z :: b
z (One a :: a
a) = b -> a -> b
f b
z a
a
foldl' f :: b -> a -> b
f z :: b
z (Two a :: a
a b :: a
b) = (b -> a -> b
f (b -> a -> b) -> b -> a -> b
forall a b. (a -> b) -> a -> b
$! b -> a -> b
f b
z a
a) a
b
foldl' f :: b -> a -> b
f z :: b
z (Three a :: a
a b :: a
b c :: a
c) = (b -> a -> b
f (b -> a -> b) -> b -> a -> b
forall a b. (a -> b) -> a -> b
$! (b -> a -> b
f (b -> a -> b) -> b -> a -> b
forall a b. (a -> b) -> a -> b
$! b -> a -> b
f b
z a
a) a
b) a
c
foldl' f :: b -> a -> b
f z :: b
z (Four a :: a
a b :: a
b c :: a
c d :: a
d) = (b -> a -> b
f (b -> a -> b) -> b -> a -> b
forall a b. (a -> b) -> a -> b
$! (b -> a -> b
f (b -> a -> b) -> b -> a -> b
forall a b. (a -> b) -> a -> b
$! (b -> a -> b
f (b -> a -> b) -> b -> a -> b
forall a b. (a -> b) -> a -> b
$! b -> a -> b
f b
z a
a) a
b) a
c) a
d
{-# INLINE foldl' #-}
foldr1 :: (a -> a -> a) -> Digit a -> a
foldr1 _ (One a :: a
a) = a
a
foldr1 f :: a -> a -> a
f (Two a :: a
a b :: a
b) = a
a a -> a -> a
`f` a
b
foldr1 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)
foldr1 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))
foldl1 :: (a -> a -> a) -> Digit a -> a
foldl1 _ (One a :: a
a) = a
a
foldl1 f :: a -> a -> a
f (Two a :: a
a b :: a
b) = a
a a -> a -> a
`f` a
b
foldl1 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
foldl1 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
instance Functor Digit where
{-# INLINE fmap #-}
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 Traversable Digit where
{-# INLINE traverse #-}
traverse :: (a -> f b) -> Digit a -> f (Digit b)
traverse f :: a -> f b
f (One a :: a
a) = b -> Digit b
forall a. a -> Digit a
One (b -> Digit b) -> f b -> f (Digit b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
a
traverse f :: a -> f b
f (Two a :: a
a b :: a
b) = (b -> b -> Digit b) -> f b -> f b -> f (Digit b)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 b -> b -> Digit b
forall a. a -> a -> Digit a
Two (a -> f b
f a
a) (a -> f b
f a
b)
traverse f :: a -> f b
f (Three a :: a
a b :: a
b c :: a
c) = (b -> b -> b -> Digit b) -> f b -> f b -> f b -> f (Digit b)
forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3 b -> b -> b -> Digit b
forall a. a -> a -> a -> Digit a
Three (a -> f b
f a
a) (a -> f b
f a
b) (a -> f b
f a
c)
traverse f :: a -> f b
f (Four a :: a
a b :: a
b c :: a
c d :: a
d) = (b -> b -> b -> b -> Digit b)
-> f b -> f b -> f b -> f (b -> Digit b)
forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3 b -> b -> b -> b -> Digit b
forall a. a -> a -> a -> a -> Digit a
Four (a -> f b
f a
a) (a -> f b
f a
b) (a -> f b
f a
c) f (b -> Digit b) -> f b -> f (Digit b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> f b
f a
d
instance NFData a => NFData (Digit a) where
rnf :: Digit a -> ()
rnf (One a :: a
a) = a -> ()
forall a. NFData a => a -> ()
rnf a
a
rnf (Two a :: a
a b :: a
b) = a -> ()
forall a. NFData a => a -> ()
rnf a
a () -> () -> ()
forall a b. a -> b -> b
`seq` a -> ()
forall a. NFData a => a -> ()
rnf a
b
rnf (Three a :: a
a b :: a
b c :: a
c) = a -> ()
forall a. NFData a => a -> ()
rnf a
a () -> () -> ()
forall a b. a -> b -> b
`seq` a -> ()
forall a. NFData a => a -> ()
rnf a
b () -> () -> ()
forall a b. a -> b -> b
`seq` a -> ()
forall a. NFData a => a -> ()
rnf a
c
rnf (Four a :: a
a b :: a
b c :: a
c d :: a
d) = a -> ()
forall a. NFData a => a -> ()
rnf a
a () -> () -> ()
forall a b. a -> b -> b
`seq` a -> ()
forall a. NFData a => a -> ()
rnf a
b () -> () -> ()
forall a b. a -> b -> b
`seq` a -> ()
forall a. NFData a => a -> ()
rnf a
c () -> () -> ()
forall a b. a -> b -> b
`seq` a -> ()
forall a. NFData a => a -> ()
rnf a
d
instance Sized a => Sized (Digit a) where
{-# INLINE size #-}
size :: Digit a -> Int
size = (Int -> Int -> Int) -> Digit Int -> Int
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) (Digit Int -> Int) -> (Digit a -> Digit Int) -> Digit a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Int) -> Digit a -> Digit Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Int
forall a. Sized a => a -> Int
size
{-# 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
EmptyT (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
EmptyT (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
EmptyT (a -> a -> Digit a
forall a. a -> a -> Digit a
Two a
c a
d)
digitToTree' :: Int -> Digit a -> FingerTree a
digitToTree' :: Int -> Digit a -> FingerTree a
digitToTree' n :: Int
n (Four 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
n (a -> a -> Digit a
forall a. a -> a -> Digit a
Two a
a a
b) FingerTree (Node a)
forall a. FingerTree a
EmptyT (a -> a -> Digit a
forall a. a -> a -> Digit a
Two a
c a
d)
digitToTree' n :: Int
n (Three 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
n (a -> a -> Digit a
forall a. a -> a -> Digit a
Two a
a a
b) FingerTree (Node a)
forall a. FingerTree a
EmptyT (a -> Digit a
forall a. a -> Digit a
One a
c)
digitToTree' n :: Int
n (Two 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
n (a -> Digit a
forall a. a -> Digit a
One a
a) FingerTree (Node a)
forall a. FingerTree a
EmptyT (a -> Digit a
forall a. a -> Digit a
One a
b)
digitToTree' !Int
_n (One a :: a
a) = a -> FingerTree a
forall a. a -> FingerTree a
Single a
a
data Node a
= Node2 {-# UNPACK #-} !Int a a
| Node3 {-# UNPACK #-} !Int a a a
#ifdef TESTING
deriving Show
#endif
#ifdef __GLASGOW_HASKELL__
deriving instance Generic1 Node
deriving instance Generic (Node a)
#endif
foldNode :: (b -> b -> b) -> (a -> b) -> Node a -> b
foldNode :: (b -> b -> b) -> (a -> b) -> Node a -> b
foldNode <+> :: b -> b -> b
(<+>) f :: a -> b
f (Node2 _ a :: a
a b :: a
b) = a -> b
f a
a b -> b -> b
<+> a -> b
f a
b
foldNode <+> :: b -> b -> b
(<+>) f :: a -> b
f (Node3 _ a :: a
a b :: a
b c :: a
c) = a -> b
f a
a b -> b -> b
<+> a -> b
f a
b b -> b -> b
<+> a -> b
f a
c
{-# INLINE foldNode #-}
instance Foldable Node where
foldMap :: (a -> m) -> Node a -> m
foldMap = (m -> m -> m) -> (a -> m) -> Node a -> m
forall b a. (b -> b -> b) -> (a -> b) -> Node a -> b
foldNode m -> m -> m
forall a. Monoid a => a -> a -> a
mappend
foldr :: (a -> b -> b) -> b -> Node a -> b
foldr 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)
foldr 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))
{-# INLINE foldr #-}
foldl :: (b -> a -> b) -> b -> Node a -> b
foldl f :: b -> a -> b
f z :: b
z (Node2 _ a :: a
a b :: a
b) = (b
z b -> a -> b
`f` a
a) b -> a -> b
`f` a
b
foldl f :: b -> a -> b
f z :: b
z (Node3 _ a :: a
a b :: a
b c :: a
c) = ((b
z b -> a -> b
`f` a
a) b -> a -> b
`f` a
b) b -> a -> b
`f` a
c
{-# INLINE foldl #-}
foldr' :: (a -> b -> b) -> b -> Node a -> b
foldr' f :: a -> b -> b
f z :: b
z (Node2 _ a :: a
a b :: a
b) = a -> b -> b
f a
a (b -> b) -> b -> b
forall a b. (a -> b) -> a -> b
$! a -> b -> b
f a
b b
z
foldr' f :: a -> b -> b
f z :: b
z (Node3 _ a :: a
a b :: a
b c :: a
c) = a -> b -> b
f a
a (b -> b) -> b -> b
forall a b. (a -> b) -> a -> b
$! a -> b -> b
f a
b (b -> b) -> b -> b
forall a b. (a -> b) -> a -> b
$! a -> b -> b
f a
c b
z
{-# INLINE foldr' #-}
foldl' :: (b -> a -> b) -> b -> Node a -> b
foldl' f :: b -> a -> b
f z :: b
z (Node2 _ a :: a
a b :: a
b) = (b -> a -> b
f (b -> a -> b) -> b -> a -> b
forall a b. (a -> b) -> a -> b
$! b -> a -> b
f b
z a
a) a
b
foldl' f :: b -> a -> b
f z :: b
z (Node3 _ a :: a
a b :: a
b c :: a
c) = (b -> a -> b
f (b -> a -> b) -> b -> a -> b
forall a b. (a -> b) -> a -> b
$! (b -> a -> b
f (b -> a -> b) -> b -> a -> b
forall a b. (a -> b) -> a -> b
$! b -> a -> b
f b
z a
a) a
b) a
c
{-# INLINE foldl' #-}
instance Functor Node where
{-# INLINE fmap #-}
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 Traversable Node where
{-# INLINE traverse #-}
traverse :: (a -> f b) -> Node a -> f (Node b)
traverse f :: a -> f b
f (Node2 v :: Int
v a :: a
a b :: a
b) = (b -> b -> Node b) -> f b -> f b -> f (Node b)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (Int -> b -> b -> Node b
forall a. Int -> a -> a -> Node a
Node2 Int
v) (a -> f b
f a
a) (a -> f b
f a
b)
traverse f :: a -> f b
f (Node3 v :: Int
v a :: a
a b :: a
b c :: a
c) = (b -> b -> b -> Node b) -> f b -> f b -> f b -> f (Node b)
forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3 (Int -> b -> b -> b -> Node b
forall a. Int -> a -> a -> a -> Node a
Node3 Int
v) (a -> f b
f a
a) (a -> f b
f a
b) (a -> f b
f a
c)
instance NFData a => NFData (Node a) where
rnf :: Node a -> ()
rnf (Node2 _ a :: a
a b :: a
b) = a -> ()
forall a. NFData a => a -> ()
rnf a
a () -> () -> ()
forall a b. a -> b -> b
`seq` a -> ()
forall a. NFData a => a -> ()
rnf a
b
rnf (Node3 _ a :: a
a b :: a
b c :: a
c) = a -> ()
forall a. NFData a => a -> ()
rnf a
a () -> () -> ()
forall a b. a -> b -> b
`seq` a -> ()
forall a. NFData a => a -> ()
rnf a
b () -> () -> ()
forall a b. a -> b -> b
`seq` a -> ()
forall a. NFData a => a -> ()
rnf a
c
instance Sized (Node a) where
size :: Node a -> Int
size (Node2 v :: Int
v _ _) = Int
v
size (Node3 v :: Int
v _ _ _) = Int
v
{-# INLINE node2 #-}
node2 :: Sized a => a -> a -> Node a
node2 :: a -> a -> Node a
node2 a :: a
a b :: a
b = Int -> a -> a -> Node a
forall a. Int -> a -> a -> Node a
Node2 (a -> Int
forall a. Sized a => a -> Int
size a
a Int -> Int -> Int
forall a. Num a => a -> a -> a
+ a -> Int
forall a. Sized a => a -> Int
size a
b) a
a a
b
{-# INLINE node3 #-}
node3 :: Sized a => a -> a -> a -> Node a
node3 :: a -> a -> a -> Node a
node3 a :: a
a b :: a
b c :: a
c = Int -> a -> a -> a -> Node a
forall a. Int -> a -> a -> a -> Node a
Node3 (a -> Int
forall a. Sized a => a -> Int
size a
a Int -> Int -> Int
forall a. Num a => a -> a -> a
+ a -> Int
forall a. Sized a => a -> Int
size a
b Int -> Int -> Int
forall a. Num a => a -> a -> a
+ a -> Int
forall a. Sized a => a -> Int
size a
c) a
a a
b a
c
nodeToDigit :: Node a -> Digit a
nodeToDigit :: Node a -> Digit a
nodeToDigit (Node2 _ a :: a
a b :: a
b) = a -> a -> Digit a
forall a. a -> a -> Digit a
Two a
a a
b
nodeToDigit (Node3 _ a :: a
a b :: a
b c :: a
c) = a -> a -> a -> Digit a
forall a. a -> a -> a -> Digit a
Three a
a a
b a
c
newtype Elem a = Elem { Elem a -> a
getElem :: a }
#ifdef TESTING
deriving Show
#endif
#ifdef __GLASGOW_HASKELL__
deriving instance Generic1 Elem
deriving instance Generic (Elem a)
#endif
instance Sized (Elem a) where
size :: Elem a -> Int
size _ = 1
instance Functor Elem where
#if __GLASGOW_HASKELL__ >= 708
fmap :: (a -> b) -> Elem a -> Elem b
fmap = (a -> b) -> Elem a -> Elem b
forall a b. Coercible a b => a -> b
coerce
#else
fmap f (Elem x) = Elem (f x)
#endif
instance Foldable Elem where
foldr :: (a -> b -> b) -> b -> Elem a -> b
foldr f :: a -> b -> b
f z :: b
z (Elem x :: a
x) = a -> b -> b
f a
x b
z
#if __GLASGOW_HASKELL__ >= 708
foldMap :: (a -> m) -> Elem a -> m
foldMap = (a -> m) -> Elem a -> m
forall a b. Coercible a b => a -> b
coerce
foldl :: (b -> a -> b) -> b -> Elem a -> b
foldl = (b -> a -> b) -> b -> Elem a -> b
forall a b. Coercible a b => a -> b
coerce
foldl' :: (b -> a -> b) -> b -> Elem a -> b
foldl' = (b -> a -> b) -> b -> Elem a -> b
forall a b. Coercible a b => a -> b
coerce
#else
foldMap f (Elem x) = f x
foldl f z (Elem x) = f z x
foldl' f z (Elem x) = f z x
#endif
instance Traversable Elem where
traverse :: (a -> f b) -> Elem a -> f (Elem b)
traverse f :: a -> f b
f (Elem x :: a
x) = b -> Elem b
forall a. a -> Elem a
Elem (b -> Elem b) -> f b -> f (Elem b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
x
instance NFData a => NFData (Elem a) where
rnf :: Elem a -> ()
rnf (Elem x :: a
x) = a -> ()
forall a. NFData a => a -> ()
rnf a
x
#if !MIN_VERSION_base(4,8,0)
newtype Identity a = Identity {runIdentity :: a}
instance Functor Identity where
fmap f (Identity x) = Identity (f x)
instance Applicative Identity where
pure = Identity
Identity f <*> Identity x = Identity (f x)
#endif
{-# SPECIALIZE applicativeTree :: Int -> Int -> State s a -> State s (FingerTree a) #-}
{-# SPECIALIZE applicativeTree :: Int -> Int -> Identity a -> Identity (FingerTree a) #-}
applicativeTree :: Applicative f => Int -> Int -> f a -> f (FingerTree a)
applicativeTree :: Int -> Int -> f a -> f (FingerTree a)
applicativeTree n :: Int
n !Int
mSize m :: f a
m = case Int
n of
0 -> FingerTree a -> f (FingerTree a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure FingerTree a
forall a. FingerTree a
EmptyT
1 -> (a -> FingerTree a) -> f a -> f (FingerTree a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> FingerTree a
forall a. a -> FingerTree a
Single f a
m
2 -> f (Digit a)
-> f (FingerTree (Node a)) -> f (Digit a) -> f (FingerTree a)
deepA f (Digit a)
one f (FingerTree (Node a))
forall a. f (FingerTree a)
emptyTree f (Digit a)
one
3 -> f (Digit a)
-> f (FingerTree (Node a)) -> f (Digit a) -> f (FingerTree a)
deepA f (Digit a)
two f (FingerTree (Node a))
forall a. f (FingerTree a)
emptyTree f (Digit a)
one
4 -> f (Digit a)
-> f (FingerTree (Node a)) -> f (Digit a) -> f (FingerTree a)
deepA f (Digit a)
two f (FingerTree (Node a))
forall a. f (FingerTree a)
emptyTree f (Digit a)
two
5 -> f (Digit a)
-> f (FingerTree (Node a)) -> f (Digit a) -> f (FingerTree a)
deepA f (Digit a)
three f (FingerTree (Node a))
forall a. f (FingerTree a)
emptyTree f (Digit a)
two
6 -> f (Digit a)
-> f (FingerTree (Node a)) -> f (Digit a) -> f (FingerTree a)
deepA f (Digit a)
three f (FingerTree (Node a))
forall a. f (FingerTree a)
emptyTree f (Digit a)
three
_ -> case Int
n Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`quotRem` 3 of
(q :: Int
q,0) -> f (Digit a)
-> f (FingerTree (Node a)) -> f (Digit a) -> f (FingerTree a)
deepA f (Digit a)
three (Int -> Int -> f (Node a) -> f (FingerTree (Node a))
forall (f :: * -> *) a.
Applicative f =>
Int -> Int -> f a -> f (FingerTree a)
applicativeTree (Int
q Int -> Int -> Int
forall a. Num a => a -> a -> a
- 2) Int
mSize' f (Node a)
n3) f (Digit a)
three
(q :: Int
q,1) -> f (Digit a)
-> f (FingerTree (Node a)) -> f (Digit a) -> f (FingerTree a)
deepA f (Digit a)
two (Int -> Int -> f (Node a) -> f (FingerTree (Node a))
forall (f :: * -> *) a.
Applicative f =>
Int -> Int -> f a -> f (FingerTree a)
applicativeTree (Int
q Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) Int
mSize' f (Node a)
n3) f (Digit a)
two
(q :: Int
q,_) -> f (Digit a)
-> f (FingerTree (Node a)) -> f (Digit a) -> f (FingerTree a)
deepA f (Digit a)
three (Int -> Int -> f (Node a) -> f (FingerTree (Node a))
forall (f :: * -> *) a.
Applicative f =>
Int -> Int -> f a -> f (FingerTree a)
applicativeTree (Int
q Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) Int
mSize' f (Node a)
n3) f (Digit a)
two
where !mSize' :: Int
mSize' = 3 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
mSize
n3 :: f (Node a)
n3 = (a -> a -> a -> Node a) -> f a -> f a -> f a -> f (Node a)
forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3 (Int -> a -> a -> a -> Node a
forall a. Int -> a -> a -> a -> Node a
Node3 Int
mSize') f a
m f a
m f a
m
where
one :: f (Digit a)
one = (a -> Digit a) -> f a -> f (Digit a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Digit a
forall a. a -> Digit a
One f a
m
two :: f (Digit a)
two = (a -> a -> Digit a) -> f a -> f a -> f (Digit a)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> Digit a
forall a. a -> a -> Digit a
Two f a
m f a
m
three :: f (Digit a)
three = (a -> a -> a -> Digit a) -> f a -> f a -> f a -> f (Digit a)
forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3 a -> a -> a -> Digit a
forall a. a -> a -> a -> Digit a
Three f a
m f a
m f a
m
deepA :: f (Digit a)
-> f (FingerTree (Node a)) -> f (Digit a) -> f (FingerTree a)
deepA = (Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a)
-> f (Digit a)
-> f (FingerTree (Node a))
-> f (Digit a)
-> f (FingerTree a)
forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3 (Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
mSize))
emptyTree :: f (FingerTree a)
emptyTree = FingerTree a -> f (FingerTree a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure FingerTree a
forall a. FingerTree a
EmptyT
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
EmptyT
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))
replicate :: Int -> a -> Seq a
replicate :: Int -> a -> Seq a
replicate n :: Int
n x :: a
x
| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 0 = Identity (Seq a) -> Seq a
forall a. Identity a -> a
runIdentity (Int -> Identity a -> Identity (Seq a)
forall (f :: * -> *) a. Applicative f => Int -> f a -> f (Seq a)
replicateA Int
n (a -> Identity a
forall a. a -> Identity a
Identity a
x))
| Bool
otherwise = [Char] -> Seq a
forall a. HasCallStack => [Char] -> a
error "replicate takes a nonnegative integer argument"
replicateA :: Applicative f => Int -> f a -> f (Seq a)
replicateA :: Int -> f a -> f (Seq a)
replicateA n :: Int
n x :: f a
x
| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 0 = FingerTree (Elem a) -> Seq a
forall a. FingerTree (Elem a) -> Seq a
Seq (FingerTree (Elem a) -> Seq a)
-> f (FingerTree (Elem a)) -> f (Seq a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Int -> f (Elem a) -> f (FingerTree (Elem a))
forall (f :: * -> *) a.
Applicative f =>
Int -> Int -> f a -> f (FingerTree a)
applicativeTree Int
n 1 (a -> Elem a
forall a. a -> Elem a
Elem (a -> Elem a) -> f a -> f (Elem a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f a
x)
| Bool
otherwise = [Char] -> f (Seq a)
forall a. HasCallStack => [Char] -> a
error "replicateA takes a nonnegative integer argument"
{-# SPECIALIZE replicateA :: Int -> State a b -> State a (Seq b) #-}
#if MIN_VERSION_base(4,8,0)
replicateM :: Applicative m => Int -> m a -> m (Seq a)
replicateM :: Int -> m a -> m (Seq a)
replicateM = Int -> m a -> m (Seq a)
forall (f :: * -> *) a. Applicative f => Int -> f a -> f (Seq a)
replicateA
#else
replicateM :: Monad m => Int -> m a -> m (Seq a)
replicateM n x
| n >= 0 = Applicative.unwrapMonad (replicateA n (Applicative.WrapMonad x))
| otherwise = error "replicateM takes a nonnegative integer argument"
#endif
cycleTaking :: Int -> Seq a -> Seq a
cycleTaking :: Int -> Seq a -> Seq a
cycleTaking n :: Int
n !Seq a
_xs | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 0 = Seq a
forall a. Seq a
empty
cycleTaking _n :: Int
_n xs :: Seq a
xs | Seq a -> Bool
forall a. Seq a -> Bool
null Seq a
xs = [Char] -> Seq a
forall a. HasCallStack => [Char] -> a
error "cycleTaking cannot take a positive number of elements from an empty cycle."
cycleTaking n :: Int
n xs :: Seq a
xs = Int -> Seq a -> Seq a
forall a. Int -> Seq a -> Seq a
cycleNTimes Int
reps Seq a
xs Seq a -> Seq a -> Seq a
forall a. Seq a -> Seq a -> Seq a
>< Int -> Seq a -> Seq a
forall a. Int -> Seq a -> Seq a
take Int
final Seq a
xs
where
(reps :: Int
reps, final :: Int
final) = Int
n Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Seq a -> Int
forall a. Seq a -> Int
length Seq a
xs
cycleNTimes :: Int -> Seq a -> Seq a
cycleNTimes :: Int -> Seq a -> Seq a
cycleNTimes n :: Int
n !Seq a
xs
| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 0 = Seq a
forall a. Seq a
empty
| Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 1 = Seq a
xs
cycleNTimes n :: Int
n (Seq xsFT :: FingerTree (Elem a)
xsFT) = case FingerTree (Elem a) -> Rigidified (Elem a)
forall a. FingerTree (Elem a) -> Rigidified (Elem a)
rigidify FingerTree (Elem a)
xsFT of
RigidEmpty -> Seq a
forall a. Seq a
empty
RigidOne (Elem x :: a
x) -> Int -> a -> Seq a
forall a. Int -> a -> Seq a
replicate Int
n a
x
RigidTwo x1 :: Elem a
x1 x2 :: Elem a
x2 -> FingerTree (Elem a) -> Seq a
forall a. FingerTree (Elem a) -> Seq a
Seq (FingerTree (Elem a) -> Seq a) -> FingerTree (Elem a) -> Seq a
forall a b. (a -> b) -> a -> b
$
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
nInt -> Int -> Int
forall a. Num a => a -> a -> a
*2) Digit (Elem a)
pair
(Identity (FingerTree (Node (Elem a))) -> FingerTree (Node (Elem a))
forall a. Identity a -> a
runIdentity (Identity (FingerTree (Node (Elem a)))
-> FingerTree (Node (Elem a)))
-> Identity (FingerTree (Node (Elem a)))
-> FingerTree (Node (Elem a))
forall a b. (a -> b) -> a -> b
$ Int
-> Int
-> Identity (Node (Elem a))
-> Identity (FingerTree (Node (Elem a)))
forall (f :: * -> *) a.
Applicative f =>
Int -> Int -> f a -> f (FingerTree a)
applicativeTree (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-2) 2 (Node (Elem a) -> Identity (Node (Elem a))
forall a. a -> Identity a
Identity (Elem a -> Elem a -> Node (Elem a)
forall a. Sized a => a -> a -> Node a
node2 Elem a
x1 Elem a
x2)))
Digit (Elem a)
pair
where pair :: Digit (Elem a)
pair = Elem a -> Elem a -> Digit (Elem a)
forall a. a -> a -> Digit a
Two Elem a
x1 Elem a
x2
RigidThree x1 :: Elem a
x1 x2 :: Elem a
x2 x3 :: Elem a
x3 -> FingerTree (Elem a) -> Seq a
forall a. FingerTree (Elem a) -> Seq a
Seq (FingerTree (Elem a) -> Seq a) -> FingerTree (Elem a) -> Seq a
forall a b. (a -> b) -> a -> b
$
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
nInt -> Int -> Int
forall a. Num a => a -> a -> a
*3) Digit (Elem a)
triple
(Identity (FingerTree (Node (Elem a))) -> FingerTree (Node (Elem a))
forall a. Identity a -> a
runIdentity (Identity (FingerTree (Node (Elem a)))
-> FingerTree (Node (Elem a)))
-> Identity (FingerTree (Node (Elem a)))
-> FingerTree (Node (Elem a))
forall a b. (a -> b) -> a -> b
$ Int
-> Int
-> Identity (Node (Elem a))
-> Identity (FingerTree (Node (Elem a)))
forall (f :: * -> *) a.
Applicative f =>
Int -> Int -> f a -> f (FingerTree a)
applicativeTree (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-2) 3 (Node (Elem a) -> Identity (Node (Elem a))
forall a. a -> Identity a
Identity (Elem a -> Elem a -> Elem a -> Node (Elem a)
forall a. Sized a => a -> a -> a -> Node a
node3 Elem a
x1 Elem a
x2 Elem a
x3)))
Digit (Elem a)
triple
where triple :: Digit (Elem a)
triple = Elem a -> Elem a -> Elem a -> Digit (Elem a)
forall a. a -> a -> a -> Digit a
Three Elem a
x1 Elem a
x2 Elem a
x3
RigidFull r :: Rigid (Elem a)
r@(Rigid s :: Int
s pr :: Node (Elem a)
pr _m :: Thin (Node (Elem a))
_m sf :: Node (Elem a)
sf) -> FingerTree (Elem a) -> Seq a
forall a. FingerTree (Elem a) -> Seq a
Seq (FingerTree (Elem a) -> Seq a) -> FingerTree (Elem a) -> Seq a
forall a b. (a -> b) -> a -> b
$
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
nInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
s)
(Node (Elem a) -> Digit (Elem a)
forall a. Node a -> Digit a
nodeToDigit Node (Elem a)
pr)
(Int -> Rigid (Elem a) -> FingerTree (Node (Elem a))
forall c. Int -> Rigid c -> FingerTree (Node c)
cycleNMiddle (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-2) Rigid (Elem a)
r)
(Node (Elem a) -> Digit (Elem a)
forall a. Node a -> Digit a
nodeToDigit Node (Elem a)
sf)
cycleNMiddle
:: Int
-> Rigid c
-> FingerTree (Node c)
cycleNMiddle :: Int -> Rigid c -> FingerTree (Node c)
cycleNMiddle !Int
n
(Rigid s :: Int
s pr :: Node c
pr (DeepTh sm :: Int
sm prm :: Digit12 (Node c)
prm mm :: Thin (Node (Node c))
mm sfm :: Digit12 (Node c)
sfm) sf :: Node c
sf)
= Int
-> Digit (Node c)
-> FingerTree (Node (Node c))
-> Digit (Node c)
-> FingerTree (Node c)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
sm Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1))
(Digit12 (Node c) -> Digit (Node c)
forall a. Digit12 a -> Digit a
digit12ToDigit Digit12 (Node c)
prm)
(Int -> Rigid (Node c) -> FingerTree (Node (Node c))
forall c. Int -> Rigid c -> FingerTree (Node c)
cycleNMiddle Int
n
(Int
-> Node (Node c)
-> Thin (Node (Node c))
-> Node (Node c)
-> Rigid (Node c)
forall a.
Int -> Digit23 a -> Thin (Digit23 a) -> Digit23 a -> Rigid a
Rigid Int
s (Node c -> Digit12 (Node c) -> Node (Node c)
forall a. Digit23 a -> Digit12 (Digit23 a) -> Digit23 (Digit23 a)
squashL Node c
pr Digit12 (Node c)
prm) Thin (Node (Node c))
mm (Digit12 (Node c) -> Node c -> Node (Node c)
forall a. Digit12 (Node a) -> Node a -> Digit23 (Node a)
squashR Digit12 (Node c)
sfm Node c
sf)))
(Digit12 (Node c) -> Digit (Node c)
forall a. Digit12 a -> Digit a
digit12ToDigit Digit12 (Node c)
sfm)
cycleNMiddle n :: Int
n
(Rigid s :: Int
s pr :: Node c
pr EmptyTh sf :: Node c
sf)
= Digit (Node c)
-> FingerTree (Node (Node c))
-> Digit (Node c)
-> FingerTree (Node c)
forall a.
Sized a =>
Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
deep
(Node c -> Digit (Node c)
forall a. a -> Digit a
One Node c
sf)
(Identity (FingerTree (Node (Node c))) -> FingerTree (Node (Node c))
forall a. Identity a -> a
runIdentity (Identity (FingerTree (Node (Node c)))
-> FingerTree (Node (Node c)))
-> Identity (FingerTree (Node (Node c)))
-> FingerTree (Node (Node c))
forall a b. (a -> b) -> a -> b
$ Int
-> Int
-> Identity (Node (Node c))
-> Identity (FingerTree (Node (Node c)))
forall (f :: * -> *) a.
Applicative f =>
Int -> Int -> f a -> f (FingerTree a)
applicativeTree Int
n Int
s (Node (Node c) -> Identity (Node (Node c))
forall a. a -> Identity a
Identity Node (Node c)
converted))
(Node c -> Digit (Node c)
forall a. a -> Digit a
One Node c
pr)
where converted :: Node (Node c)
converted = Node c -> Node c -> Node (Node c)
forall a. Sized a => a -> a -> Node a
node2 Node c
pr Node c
sf
cycleNMiddle n :: Int
n
(Rigid s :: Int
s pr :: Node c
pr (SingleTh q :: Node c
q) sf :: Node c
sf)
= Digit (Node c)
-> FingerTree (Node (Node c))
-> Digit (Node c)
-> FingerTree (Node c)
forall a.
Sized a =>
Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
deep
(Node c -> Node c -> Digit (Node c)
forall a. a -> a -> Digit a
Two Node c
q Node c
sf)
(Identity (FingerTree (Node (Node c))) -> FingerTree (Node (Node c))
forall a. Identity a -> a
runIdentity (Identity (FingerTree (Node (Node c)))
-> FingerTree (Node (Node c)))
-> Identity (FingerTree (Node (Node c)))
-> FingerTree (Node (Node c))
forall a b. (a -> b) -> a -> b
$ Int
-> Int
-> Identity (Node (Node c))
-> Identity (FingerTree (Node (Node c)))
forall (f :: * -> *) a.
Applicative f =>
Int -> Int -> f a -> f (FingerTree a)
applicativeTree Int
n Int
s (Node (Node c) -> Identity (Node (Node c))
forall a. a -> Identity a
Identity Node (Node c)
converted))
(Node c -> Node c -> Digit (Node c)
forall a. a -> a -> Digit a
Two Node c
pr Node c
q)
where converted :: Node (Node c)
converted = Node c -> Node c -> Node c -> Node (Node c)
forall a. Sized a => a -> a -> a -> Node a
node3 Node c
pr Node c
q Node c
sf
(<|) :: 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 EmptyT = 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
EmptyT (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
cons' :: a -> Seq a -> Seq a
cons' :: a -> Seq a -> Seq a
cons' x :: a
x (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)
snoc' :: Seq a -> a -> Seq a
snoc' :: Seq a -> a -> Seq a
snoc' (Seq xs :: FingerTree (Elem a)
xs) 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 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 EmptyT = 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
EmptyT (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) =
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
where !m' :: FingerTree (Node a)
m' = Node a
abc Node a -> FingerTree (Node a) -> FingerTree (Node a)
forall a. Sized a => a -> FingerTree a -> FingerTree a
`consTree'` FingerTree (Node a)
m
!abc :: Node a
abc = a -> a -> a -> Node a
forall a. Sized a => a -> a -> a -> Node a
node3 a
c a
d a
e
consTree' a :: a
a (Deep s :: Int
s (Three b :: a
b c :: a
c d :: a
d) m :: FingerTree (Node a)
m sf :: Digit a
sf) =
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (a -> Int
forall a. Sized a => a -> Int
size a
a Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
s) (a -> a -> a -> a -> Digit a
forall a. a -> a -> a -> a -> Digit a
Four a
a a
b a
c a
d) FingerTree (Node a)
m Digit a
sf
consTree' a :: a
a (Deep s :: Int
s (Two b :: a
b c :: a
c) m :: FingerTree (Node a)
m sf :: Digit a
sf) =
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (a -> Int
forall a. Sized a => a -> Int
size a
a Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
s) (a -> a -> a -> Digit a
forall a. a -> a -> a -> Digit a
Three a
a a
b a
c) FingerTree (Node a)
m Digit a
sf
consTree' a :: a
a (Deep s :: Int
s (One b :: a
b) m :: FingerTree (Node a)
m sf :: Digit a
sf) =
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (a -> Int
forall a. Sized a => a -> Int
size a
a Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
s) (a -> a -> Digit a
forall a. a -> a -> Digit a
Two a
a a
b) FingerTree (Node a)
m Digit a
sf
(|>) :: Seq a -> a -> Seq a
Seq xs :: FingerTree (Elem a)
xs |> :: Seq a -> a -> Seq a
|> x :: a
x = FingerTree (Elem a) -> Seq a
forall a. FingerTree (Elem a) -> Seq a
Seq (FingerTree (Elem a)
xs FingerTree (Elem a) -> Elem a -> FingerTree (Elem a)
forall a. Sized a => FingerTree a -> a -> FingerTree a
`snocTree` a -> Elem a
forall a. a -> Elem a
Elem a
x)
{-# SPECIALIZE snocTree :: FingerTree (Elem a) -> Elem a -> FingerTree (Elem a) #-}
{-# SPECIALIZE snocTree :: FingerTree (Node a) -> Node a -> FingerTree (Node a) #-}
snocTree :: Sized a => FingerTree a -> a -> FingerTree a
snocTree :: FingerTree a -> a -> FingerTree a
snocTree EmptyT 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
EmptyT (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)
{-# 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' EmptyT 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
EmptyT (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 =
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' (a -> a -> Digit a
forall a. a -> a -> Digit a
Two a
d a
e)
where !m' :: FingerTree (Node a)
m' = FingerTree (Node a)
m FingerTree (Node a) -> Node a -> FingerTree (Node a)
forall a. Sized a => FingerTree a -> a -> FingerTree a
`snocTree'` Node a
abc
!abc :: Node a
abc = a -> a -> a -> Node a
forall a. Sized a => a -> a -> a -> Node a
node3 a
a a
b a
c
snocTree' (Deep s :: Int
s pr :: Digit a
pr m :: FingerTree (Node a)
m (Three a :: a
a b :: a
b c :: a
c)) d :: a
d =
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
+ a -> Int
forall a. Sized a => a -> Int
size a
d) Digit a
pr FingerTree (Node a)
m (a -> a -> a -> a -> Digit a
forall a. a -> a -> a -> a -> Digit a
Four a
a a
b a
c a
d)
snocTree' (Deep s :: Int
s pr :: Digit a
pr m :: FingerTree (Node a)
m (Two a :: a
a b :: a
b)) c :: a
c =
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
+ a -> Int
forall a. Sized a => a -> Int
size a
c) Digit a
pr FingerTree (Node a)
m (a -> a -> a -> Digit a
forall a. a -> a -> a -> Digit a
Three a
a a
b a
c)
snocTree' (Deep s :: Int
s pr :: Digit a
pr m :: FingerTree (Node a)
m (One a :: a
a)) b :: a
b =
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
+ a -> Int
forall a. Sized a => a -> Int
size a
b) Digit a
pr FingerTree (Node a)
m (a -> a -> Digit a
forall a. a -> a -> Digit a
Two a
a a
b)
(><) :: Seq a -> Seq a -> Seq a
Seq xs :: FingerTree (Elem a)
xs >< :: Seq a -> Seq a -> Seq a
>< Seq ys :: FingerTree (Elem a)
ys = FingerTree (Elem a) -> Seq a
forall a. FingerTree (Elem a) -> Seq a
Seq (FingerTree (Elem a) -> FingerTree (Elem a) -> FingerTree (Elem a)
forall a.
FingerTree (Elem a) -> FingerTree (Elem a) -> FingerTree (Elem a)
appendTree0 FingerTree (Elem a)
xs FingerTree (Elem a)
ys)
appendTree0 :: FingerTree (Elem a) -> FingerTree (Elem a) -> FingerTree (Elem a)
appendTree0 :: FingerTree (Elem a) -> FingerTree (Elem a) -> FingerTree (Elem a)
appendTree0 EmptyT xs :: FingerTree (Elem a)
xs =
FingerTree (Elem a)
xs
appendTree0 xs :: FingerTree (Elem a)
xs EmptyT =
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))
m Digit (Elem a)
sf2
where !m :: FingerTree (Node (Elem a))
m = 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
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 EmptyT !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 !Node a
a EmptyT =
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) !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 !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))
m Digit (Node a)
sf2
where !m :: FingerTree (Node (Node a))
m = 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
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 EmptyT !Node a
a !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 !Node a
a !Node a
b EmptyT =
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))
m Digit (Node a)
sf2
where !m :: FingerTree (Node (Node a))
m = 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
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 EmptyT !Node a
a !Node a
b !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 !Node a
a !Node a
b !Node a
c EmptyT =
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))
m Digit (Node a)
sf2
where !m :: FingerTree (Node (Node a))
m = 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
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) !Node a
b !Node a
c !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) !Node a
c !Node a
d !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) !Node a
d !Node a
e !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) !Node a
e !Node a
f !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 EmptyT !Node a
a !Node a
b !Node a
c !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 !Node a
a !Node a
b !Node a
c !Node a
d EmptyT =
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))
m Digit (Node a)
sf2
where !m :: FingerTree (Node (Node a))
m = 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
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) !Node a
b !Node a
c !Node a
d !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) !Node a
c !Node a
d !Node a
e !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) !Node a
d !Node a
e !Node a
f !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) !Node a
e !Node a
f !Node a
g !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) !Node a
e !Node a
f !Node a
g !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) !Node a
e !Node a
f !Node a
g !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) !Node a
e !Node a
f !Node a
g !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
unfoldr :: (b -> Maybe (a, b)) -> b -> Seq a
unfoldr :: (b -> Maybe (a, b)) -> b -> Seq a
unfoldr f :: b -> Maybe (a, b)
f = Seq a -> b -> Seq a
unfoldr' Seq a
forall a. Seq a
empty
where unfoldr' :: Seq a -> b -> Seq a
unfoldr' !Seq a
as b :: b
b = Seq a -> ((a, b) -> Seq a) -> Maybe (a, b) -> Seq a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Seq a
as (\ (a :: a
a, b' :: b
b') -> Seq a -> b -> Seq a
unfoldr' (Seq a
as Seq a -> a -> Seq a
forall a. Seq a -> a -> Seq a
`snoc'` a
a) b
b') (b -> Maybe (a, b)
f b
b)
unfoldl :: (b -> Maybe (b, a)) -> b -> Seq a
unfoldl :: (b -> Maybe (b, a)) -> b -> Seq a
unfoldl f :: b -> Maybe (b, a)
f = Seq a -> b -> Seq a
unfoldl' Seq a
forall a. Seq a
empty
where unfoldl' :: Seq a -> b -> Seq a
unfoldl' !Seq a
as b :: b
b = Seq a -> ((b, a) -> Seq a) -> Maybe (b, a) -> Seq a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Seq a
as (\ (b' :: b
b', a :: a
a) -> Seq a -> b -> Seq a
unfoldl' (a
a a -> Seq a -> Seq a
forall a. a -> Seq a -> Seq a
`cons'` Seq a
as) b
b') (b -> Maybe (b, a)
f b
b)
iterateN :: Int -> (a -> a) -> a -> Seq a
iterateN :: Int -> (a -> a) -> a -> Seq a
iterateN n :: Int
n f :: a -> a
f x :: a
x
| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 0 = Int -> State a a -> State a (Seq a)
forall (f :: * -> *) a. Applicative f => Int -> f a -> f (Seq a)
replicateA Int
n ((a -> (a, a)) -> State a a
forall s a. (s -> (s, a)) -> State s a
State (\ y :: a
y -> (a -> a
f a
y, a
y))) State a (Seq a) -> a -> Seq a
forall s a. State s a -> s -> a
`execState` a
x
| Bool
otherwise = [Char] -> Seq a
forall a. HasCallStack => [Char] -> a
error "iterateN takes a nonnegative integer argument"
null :: Seq a -> Bool
null :: Seq a -> Bool
null (Seq EmptyT) = Bool
True
null _ = Bool
False
length :: Seq a -> Int
length :: Seq a -> Int
length (Seq xs :: FingerTree (Elem a)
xs) = FingerTree (Elem a) -> Int
forall a. Sized a => a -> Int
size FingerTree (Elem a)
xs
data ViewLTree a = ConsLTree a (FingerTree a) | EmptyLTree
data ViewRTree a = SnocRTree (FingerTree a) a | EmptyRTree
data ViewL a
= EmptyL
| a :< Seq a
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, Eq (ViewL a)
Eq (ViewL a) =>
(ViewL a -> ViewL a -> Ordering)
-> (ViewL a -> ViewL a -> Bool)
-> (ViewL a -> ViewL a -> Bool)
-> (ViewL a -> ViewL a -> Bool)
-> (ViewL a -> ViewL a -> Bool)
-> (ViewL a -> ViewL a -> ViewL a)
-> (ViewL a -> ViewL a -> ViewL a)
-> Ord (ViewL a)
ViewL a -> ViewL a -> Bool
ViewL a -> ViewL a -> Ordering
ViewL a -> ViewL a -> ViewL a
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (ViewL a)
forall a. Ord a => ViewL a -> ViewL a -> Bool
forall a. Ord a => ViewL a -> ViewL a -> Ordering
forall a. Ord a => ViewL a -> ViewL a -> ViewL a
min :: ViewL a -> ViewL a -> ViewL a
$cmin :: forall a. Ord a => ViewL a -> ViewL a -> ViewL a
max :: ViewL a -> ViewL a -> ViewL a
$cmax :: forall a. Ord a => ViewL a -> ViewL a -> ViewL a
>= :: ViewL a -> ViewL a -> Bool
$c>= :: forall a. Ord a => ViewL a -> ViewL a -> Bool
> :: ViewL a -> ViewL a -> Bool
$c> :: forall a. Ord a => ViewL a -> ViewL a -> Bool
<= :: ViewL a -> ViewL a -> Bool
$c<= :: forall a. Ord a => ViewL a -> ViewL a -> Bool
< :: ViewL a -> ViewL a -> Bool
$c< :: forall a. Ord a => ViewL a -> ViewL a -> Bool
compare :: ViewL a -> ViewL a -> Ordering
$ccompare :: forall a. Ord a => ViewL a -> ViewL a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (ViewL a)
Ord, Int -> ViewL a -> ShowS
[ViewL a] -> ShowS
ViewL a -> [Char]
(Int -> ViewL a -> ShowS)
-> (ViewL a -> [Char]) -> ([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 -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [ViewL a] -> ShowS
$cshowList :: forall a. Show a => [ViewL a] -> ShowS
show :: ViewL a -> [Char]
$cshow :: forall a. Show a => ViewL a -> [Char]
showsPrec :: Int -> ViewL a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> ViewL a -> ShowS
Show, ReadPrec [ViewL a]
ReadPrec (ViewL a)
Int -> ReadS (ViewL a)
ReadS [ViewL a]
(Int -> ReadS (ViewL a))
-> ReadS [ViewL a]
-> ReadPrec (ViewL a)
-> ReadPrec [ViewL a]
-> Read (ViewL a)
forall a. Read a => ReadPrec [ViewL a]
forall a. Read a => ReadPrec (ViewL a)
forall a. Read a => Int -> ReadS (ViewL a)
forall a. Read a => ReadS [ViewL a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ViewL a]
$creadListPrec :: forall a. Read a => ReadPrec [ViewL a]
readPrec :: ReadPrec (ViewL a)
$creadPrec :: forall a. Read a => ReadPrec (ViewL a)
readList :: ReadS [ViewL a]
$creadList :: forall a. Read a => ReadS [ViewL a]
readsPrec :: Int -> ReadS (ViewL a)
$creadsPrec :: forall a. Read a => Int -> ReadS (ViewL a)
Read)
#ifdef __GLASGOW_HASKELL__
deriving instance Data a => Data (ViewL a)
deriving instance Generic1 ViewL
deriving instance Generic (ViewL a)
#endif
INSTANCE_TYPEABLE1(ViewL)
instance Functor ViewL where
{-# INLINE fmap #-}
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
instance Foldable ViewL where
foldr :: (a -> b -> b) -> b -> ViewL a -> b
foldr _ z :: b
z EmptyL = b
z
foldr f :: a -> b -> b
f z :: b
z (x :: a
x :< xs :: Seq a
xs) = a -> b -> b
f a
x ((a -> b -> b) -> b -> Seq a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> b -> b
f b
z Seq a
xs)
foldl :: (b -> a -> b) -> b -> ViewL a -> b
foldl _ z :: b
z EmptyL = b
z
foldl f :: b -> a -> b
f z :: b
z (x :: a
x :< xs :: Seq a
xs) = (b -> a -> b) -> b -> Seq a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl b -> a -> b
f (b -> a -> b
f b
z a
x) Seq a
xs
foldl1 :: (a -> a -> a) -> ViewL a -> a
foldl1 _ EmptyL = [Char] -> a
forall a. HasCallStack => [Char] -> a
error "foldl1: empty view"
foldl1 f :: a -> a -> a
f (x :: a
x :< xs :: Seq a
xs) = (a -> a -> a) -> a -> Seq a -> a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl a -> a -> a
f a
x Seq a
xs
#if MIN_VERSION_base(4,8,0)
null :: ViewL a -> Bool
null EmptyL = Bool
True
null (_ :< _) = Bool
False
length :: ViewL a -> Int
length EmptyL = 0
length (_ :< xs :: Seq a
xs) = 1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Seq a -> Int
forall a. Seq a -> Int
length Seq a
xs
#endif
instance Traversable ViewL where
traverse :: (a -> f b) -> ViewL a -> f (ViewL b)
traverse _ EmptyL = ViewL b -> f (ViewL b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ViewL b
forall a. ViewL a
EmptyL
traverse f :: a -> f b
f (x :: a
x :< xs :: Seq a
xs) = (b -> Seq b -> ViewL b) -> f b -> f (Seq b) -> f (ViewL b)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 b -> Seq b -> ViewL b
forall a. a -> Seq a -> ViewL a
(:<) (a -> f b
f a
x) ((a -> f b) -> Seq a -> f (Seq b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
f Seq a
xs)
viewl :: Seq a -> ViewL a
viewl :: Seq a -> ViewL a
viewl (Seq xs :: FingerTree (Elem a)
xs) = case FingerTree (Elem a) -> ViewLTree (Elem a)
forall a. Sized a => FingerTree a -> ViewLTree a
viewLTree FingerTree (Elem a)
xs of
EmptyLTree -> ViewL a
forall a. ViewL a
EmptyL
ConsLTree (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) -> ViewLTree (Elem a) #-}
{-# SPECIALIZE viewLTree :: FingerTree (Node a) -> ViewLTree (Node a) #-}
viewLTree :: Sized a => FingerTree a -> ViewLTree a
viewLTree :: FingerTree a -> ViewLTree a
viewLTree EmptyT = ViewLTree a
forall a. ViewLTree a
EmptyLTree
viewLTree (Single a :: a
a) = a -> FingerTree a -> ViewLTree a
forall a. a -> FingerTree a -> ViewLTree a
ConsLTree a
a FingerTree a
forall a. FingerTree a
EmptyT
viewLTree (Deep s :: Int
s (One a :: a
a) m :: FingerTree (Node a)
m sf :: Digit a
sf) = a -> FingerTree a -> ViewLTree a
forall a. a -> FingerTree a -> ViewLTree a
ConsLTree a
a (Int -> FingerTree (Node a) -> Digit a -> FingerTree a
forall a. Int -> FingerTree (Node a) -> Digit a -> FingerTree a
pullL (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- a -> Int
forall a. Sized a => a -> Int
size a
a) 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 -> ViewLTree a
forall a. a -> FingerTree a -> ViewLTree a
ConsLTree 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 -> ViewLTree a
forall a. a -> FingerTree a -> ViewLTree a
ConsLTree 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 -> ViewLTree a
forall a. a -> FingerTree a -> ViewLTree a
ConsLTree a
a (Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- a -> Int
forall a. Sized a => a -> Int
size a
a) (a -> a -> a -> Digit a
forall a. a -> a -> a -> Digit a
Three a
b a
c a
d) FingerTree (Node a)
m Digit a
sf)
data ViewR a
= EmptyR
| Seq a :> a
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, Eq (ViewR a)
Eq (ViewR a) =>
(ViewR a -> ViewR a -> Ordering)
-> (ViewR a -> ViewR a -> Bool)
-> (ViewR a -> ViewR a -> Bool)
-> (ViewR a -> ViewR a -> Bool)
-> (ViewR a -> ViewR a -> Bool)
-> (ViewR a -> ViewR a -> ViewR a)
-> (ViewR a -> ViewR a -> ViewR a)
-> Ord (ViewR a)
ViewR a -> ViewR a -> Bool
ViewR a -> ViewR a -> Ordering
ViewR a -> ViewR a -> ViewR a
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (ViewR a)
forall a. Ord a => ViewR a -> ViewR a -> Bool
forall a. Ord a => ViewR a -> ViewR a -> Ordering
forall a. Ord a => ViewR a -> ViewR a -> ViewR a
min :: ViewR a -> ViewR a -> ViewR a
$cmin :: forall a. Ord a => ViewR a -> ViewR a -> ViewR a
max :: ViewR a -> ViewR a -> ViewR a
$cmax :: forall a. Ord a => ViewR a -> ViewR a -> ViewR a
>= :: ViewR a -> ViewR a -> Bool
$c>= :: forall a. Ord a => ViewR a -> ViewR a -> Bool
> :: ViewR a -> ViewR a -> Bool
$c> :: forall a. Ord a => ViewR a -> ViewR a -> Bool
<= :: ViewR a -> ViewR a -> Bool
$c<= :: forall a. Ord a => ViewR a -> ViewR a -> Bool
< :: ViewR a -> ViewR a -> Bool
$c< :: forall a. Ord a => ViewR a -> ViewR a -> Bool
compare :: ViewR a -> ViewR a -> Ordering
$ccompare :: forall a. Ord a => ViewR a -> ViewR a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (ViewR a)
Ord, Int -> ViewR a -> ShowS
[ViewR a] -> ShowS
ViewR a -> [Char]
(Int -> ViewR a -> ShowS)
-> (ViewR a -> [Char]) -> ([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 -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [ViewR a] -> ShowS
$cshowList :: forall a. Show a => [ViewR a] -> ShowS
show :: ViewR a -> [Char]
$cshow :: forall a. Show a => ViewR a -> [Char]
showsPrec :: Int -> ViewR a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> ViewR a -> ShowS
Show, ReadPrec [ViewR a]
ReadPrec (ViewR a)
Int -> ReadS (ViewR a)
ReadS [ViewR a]
(Int -> ReadS (ViewR a))
-> ReadS [ViewR a]
-> ReadPrec (ViewR a)
-> ReadPrec [ViewR a]
-> Read (ViewR a)
forall a. Read a => ReadPrec [ViewR a]
forall a. Read a => ReadPrec (ViewR a)
forall a. Read a => Int -> ReadS (ViewR a)
forall a. Read a => ReadS [ViewR a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ViewR a]
$creadListPrec :: forall a. Read a => ReadPrec [ViewR a]
readPrec :: ReadPrec (ViewR a)
$creadPrec :: forall a. Read a => ReadPrec (ViewR a)
readList :: ReadS [ViewR a]
$creadList :: forall a. Read a => ReadS [ViewR a]
readsPrec :: Int -> ReadS (ViewR a)
$creadsPrec :: forall a. Read a => Int -> ReadS (ViewR a)
Read)
#ifdef __GLASGOW_HASKELL__
deriving instance Data a => Data (ViewR a)
deriving instance Generic1 ViewR
deriving instance Generic (ViewR a)
#endif
INSTANCE_TYPEABLE1(ViewR)
instance Functor ViewR where
{-# INLINE fmap #-}
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
instance Foldable ViewR where
foldMap :: (a -> m) -> ViewR a -> m
foldMap _ EmptyR = m
forall a. Monoid a => a
mempty
foldMap f :: a -> m
f (xs :: Seq a
xs :> x :: a
x) = (a -> m) -> Seq a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f Seq a
xs m -> m -> m
forall a. Monoid a => a -> a -> a
<> a -> m
f a
x
foldr :: (a -> b -> b) -> b -> ViewR a -> b
foldr _ z :: b
z EmptyR = b
z
foldr f :: a -> b -> b
f z :: b
z (xs :: Seq a
xs :> x :: a
x) = (a -> b -> b) -> b -> Seq a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> b -> b
f (a -> b -> b
f a
x b
z) Seq a
xs
foldl :: (b -> a -> b) -> b -> ViewR a -> b
foldl _ z :: b
z EmptyR = b
z
foldl f :: b -> a -> b
f z :: b
z (xs :: Seq a
xs :> x :: a
x) = (b -> a -> b) -> b -> Seq a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl b -> a -> b
f b
z Seq a
xs b -> a -> b
`f` a
x
foldr1 :: (a -> a -> a) -> ViewR a -> a
foldr1 _ EmptyR = [Char] -> a
forall a. HasCallStack => [Char] -> a
error "foldr1: empty view"
foldr1 f :: a -> a -> a
f (xs :: Seq a
xs :> x :: a
x) = (a -> a -> a) -> a -> Seq a -> a
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> a -> a
f a
x Seq a
xs
#if MIN_VERSION_base(4,8,0)
null :: ViewR a -> Bool
null EmptyR = Bool
True
null (_ :> _) = Bool
False
length :: ViewR a -> Int
length EmptyR = 0
length (xs :: Seq a
xs :> _) = Seq a -> Int
forall a. Seq a -> Int
length Seq a
xs Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1
#endif
instance Traversable ViewR where
traverse :: (a -> f b) -> ViewR a -> f (ViewR b)
traverse _ EmptyR = ViewR b -> f (ViewR b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ViewR b
forall a. ViewR a
EmptyR
traverse f :: a -> f b
f (xs :: Seq a
xs :> x :: a
x) = (Seq b -> b -> ViewR b) -> f (Seq b) -> f b -> f (ViewR b)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Seq b -> b -> ViewR b
forall a. Seq a -> a -> ViewR a
(:>) ((a -> f b) -> Seq a -> f (Seq b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
f Seq a
xs) (a -> f b
f a
x)
viewr :: Seq a -> ViewR a
viewr :: Seq a -> ViewR a
viewr (Seq xs :: FingerTree (Elem a)
xs) = case FingerTree (Elem a) -> ViewRTree (Elem a)
forall a. Sized a => FingerTree a -> ViewRTree a
viewRTree FingerTree (Elem a)
xs of
EmptyRTree -> ViewR a
forall a. ViewR a
EmptyR
SnocRTree 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) -> ViewRTree (Elem a) #-}
{-# SPECIALIZE viewRTree :: FingerTree (Node a) -> ViewRTree (Node a) #-}
viewRTree :: Sized a => FingerTree a -> ViewRTree a
viewRTree :: FingerTree a -> ViewRTree a
viewRTree EmptyT = ViewRTree a
forall a. ViewRTree a
EmptyRTree
viewRTree (Single z :: a
z) = FingerTree a -> a -> ViewRTree a
forall a. FingerTree a -> a -> ViewRTree a
SnocRTree FingerTree a
forall a. FingerTree a
EmptyT a
z
viewRTree (Deep s :: Int
s pr :: Digit a
pr m :: FingerTree (Node a)
m (One z :: a
z)) = FingerTree a -> a -> ViewRTree a
forall a. FingerTree a -> a -> ViewRTree a
SnocRTree (Int -> Digit a -> FingerTree (Node a) -> FingerTree a
forall a. Int -> Digit a -> FingerTree (Node a) -> FingerTree a
pullR (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
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 -> ViewRTree a
forall a. FingerTree a -> a -> ViewRTree a
SnocRTree (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 -> ViewRTree a
forall a. FingerTree a -> a -> ViewRTree a
SnocRTree (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 -> ViewRTree a
forall a. FingerTree a -> a -> ViewRTree a
SnocRTree (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
scanl :: (a -> b -> a) -> a -> Seq b -> Seq a
scanl :: (a -> b -> a) -> a -> Seq b -> Seq a
scanl f :: a -> b -> a
f z0 :: a
z0 xs :: Seq b
xs = a
z0 a -> Seq a -> Seq a
forall a. a -> Seq a -> Seq a
<| (a, Seq a) -> Seq a
forall a b. (a, b) -> b
snd ((a -> b -> (a, a)) -> a -> Seq b -> (a, Seq a)
forall (t :: * -> *) a b c.
Traversable t =>
(a -> b -> (a, c)) -> a -> t b -> (a, t c)
mapAccumL (\ x :: a
x z :: b
z -> let x' :: a
x' = a -> b -> a
f a
x b
z in (a
x', a
x')) a
z0 Seq b
xs)
scanl1 :: (a -> a -> a) -> Seq a -> Seq a
scanl1 :: (a -> a -> a) -> Seq a -> Seq a
scanl1 f :: a -> a -> a
f xs :: Seq a
xs = case Seq a -> ViewL a
forall a. Seq a -> ViewL a
viewl Seq a
xs of
EmptyL -> [Char] -> Seq a
forall a. HasCallStack => [Char] -> a
error "scanl1 takes a nonempty sequence as an argument"
x :: a
x :< xs' :: Seq a
xs' -> (a -> a -> a) -> a -> Seq a -> Seq a
forall a b. (a -> b -> a) -> a -> Seq b -> Seq a
scanl a -> a -> a
f a
x Seq a
xs'
scanr :: (a -> b -> b) -> b -> Seq a -> Seq b
scanr :: (a -> b -> b) -> b -> Seq a -> Seq b
scanr f :: a -> b -> b
f z0 :: b
z0 xs :: Seq a
xs = (b, Seq b) -> Seq b
forall a b. (a, b) -> b
snd ((b -> a -> (b, b)) -> b -> Seq a -> (b, Seq b)
forall (t :: * -> *) a b c.
Traversable t =>
(a -> b -> (a, c)) -> a -> t b -> (a, t c)
mapAccumR (\ z :: b
z x :: a
x -> let z' :: b
z' = a -> b -> b
f a
x b
z in (b
z', b
z')) b
z0 Seq a
xs) Seq b -> b -> Seq b
forall a. Seq a -> a -> Seq a
|> b
z0
scanr1 :: (a -> a -> a) -> Seq a -> Seq a
scanr1 :: (a -> a -> a) -> Seq a -> Seq a
scanr1 f :: a -> a -> a
f xs :: Seq a
xs = case Seq a -> ViewR a
forall a. Seq a -> ViewR a
viewr Seq a
xs of
EmptyR -> [Char] -> Seq a
forall a. HasCallStack => [Char] -> a
error "scanr1 takes a nonempty sequence as an argument"
xs' :: Seq a
xs' :> x :: a
x -> (a -> a -> a) -> a -> Seq a -> Seq a
forall a b. (a -> b -> b) -> b -> Seq a -> Seq b
scanr a -> a -> a
f a
x Seq a
xs'
index :: Seq a -> Int -> a
index :: Seq a -> Int -> a
index (Seq xs :: FingerTree (Elem a)
xs) i :: Int
i
| Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
< (Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (FingerTree (Elem a) -> Int
forall a. Sized a => a -> Int
size FingerTree (Elem a)
xs) :: Word) = 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 =
[Char] -> a
forall a. HasCallStack => [Char] -> a
error ([Char] -> a) -> [Char] -> a
forall a b. (a -> b) -> a -> b
$ "index out of bounds in call to: Data.Sequence.index " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
i
lookup :: Int -> Seq a -> Maybe a
lookup :: Int -> Seq a -> Maybe a
lookup i :: Int
i (Seq xs :: FingerTree (Elem a)
xs)
| Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
< (Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (FingerTree (Elem a) -> Int
forall a. Sized a => a -> Int
size FingerTree (Elem a)
xs) :: Word) = 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 -> Maybe a
forall a. a -> Maybe a
Just a
x
| Bool
otherwise = Maybe a
forall a. Maybe a
Nothing
(!?) :: Seq a -> Int -> Maybe a
!? :: Seq a -> Int -> Maybe a
(!?) = (Int -> Seq a -> Maybe a) -> Seq a -> Int -> Maybe a
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> Seq a -> Maybe a
forall a. Int -> Seq a -> Maybe a
lookup
data Place a = Place {-# UNPACK #-} !Int a
#ifdef 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 !Int
_ EmptyT = [Char] -> Place a
forall a. HasCallStack => [Char] -> a
error "lookupTree of empty tree"
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
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
spr = Int -> Digit a -> Place a
forall a. Sized a => Int -> Digit a -> Place a
lookupDigit Int
i Digit a
pr
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
spm = case Int -> FingerTree (Node a) -> Place (Node a)
forall a. Sized a => Int -> FingerTree a -> Place a
lookupTree (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
spr) 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
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
spm) Digit a
sf
where
spr :: Int
spr = Digit a -> Int
forall a. Sized a => a -> Int
size Digit a
pr
spm :: Int
spm = Int
spr 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
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
sa = 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
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sa) a
b
where
sa :: Int
sa = 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
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
sa = Int -> a -> Place a
forall a. Int -> a -> Place a
Place Int
i a
a
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
sab = Int -> a -> Place a
forall a. Int -> a -> Place a
Place (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sa) a
b
| Bool
otherwise = Int -> a -> Place a
forall a. Int -> a -> Place a
Place (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sab) a
c
where
sa :: Int
sa = a -> Int
forall a. Sized a => a -> Int
size a
a
sab :: Int
sab = Int
sa 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
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
sa = 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
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sa) a
b
where
sa :: Int
sa = 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
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
sa = Int -> a -> Place a
forall a. Int -> a -> Place a
Place Int
i a
a
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
sab = Int -> a -> Place a
forall a. Int -> a -> Place a
Place (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sa) a
b
| Bool
otherwise = Int -> a -> Place a
forall a. Int -> a -> Place a
Place (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sab) a
c
where
sa :: Int
sa = a -> Int
forall a. Sized a => a -> Int
size a
a
sab :: Int
sab = Int
sa 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
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
sa = Int -> a -> Place a
forall a. Int -> a -> Place a
Place Int
i a
a
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
sab = Int -> a -> Place a
forall a. Int -> a -> Place a
Place (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sa) a
b
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
sabc = Int -> a -> Place a
forall a. Int -> a -> Place a
Place (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sab) a
c
| Bool
otherwise = Int -> a -> Place a
forall a. Int -> a -> Place a
Place (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sabc) a
d
where
sa :: Int
sa = a -> Int
forall a. Sized a => a -> Int
size a
a
sab :: Int
sab = Int
sa Int -> Int -> Int
forall a. Num a => a -> a -> a
+ a -> Int
forall a. Sized a => a -> Int
size a
b
sabc :: Int
sabc = Int
sab Int -> Int -> Int
forall a. Num a => a -> a -> a
+ a -> Int
forall a. Sized a => a -> Int
size a
c
update :: Int -> a -> Seq a -> Seq a
update :: Int -> a -> Seq a -> Seq a
update i :: Int
i x :: a
x (Seq xs :: FingerTree (Elem a)
xs)
| Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
< (Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (FingerTree (Elem a) -> Int
forall a. Sized a => a -> Int
size FingerTree (Elem a)
xs) :: Word) = FingerTree (Elem a) -> Seq a
forall a. FingerTree (Elem a) -> Seq a
Seq (Elem a -> Int -> FingerTree (Elem a) -> FingerTree (Elem a)
forall a.
Elem a -> Int -> FingerTree (Elem a) -> FingerTree (Elem a)
updateTree (a -> Elem a
forall a. a -> Elem a
Elem a
x) 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
updateTree :: Elem a -> Int -> FingerTree (Elem a) -> FingerTree (Elem a)
updateTree :: Elem a -> Int -> FingerTree (Elem a) -> FingerTree (Elem a)
updateTree _ !Int
_ EmptyT = FingerTree (Elem a)
forall a. FingerTree a
EmptyT
updateTree v :: Elem a
v _i :: Int
_i (Single _) = Elem a -> FingerTree (Elem a)
forall a. a -> FingerTree a
Single Elem a
v
updateTree v :: Elem a
v i :: Int
i (Deep s :: Int
s pr :: Digit (Elem a)
pr m :: FingerTree (Node (Elem a))
m sf :: Digit (Elem a)
sf)
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
spr = 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
s (Elem a -> Int -> Digit (Elem a) -> Digit (Elem a)
forall a. Elem a -> Int -> Digit (Elem a) -> Digit (Elem a)
updateDigit Elem a
v Int
i Digit (Elem a)
pr) FingerTree (Node (Elem a))
m Digit (Elem a)
sf
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
spm = let !m' :: FingerTree (Node (Elem a))
m' = (Int -> Node (Elem a) -> Node (Elem a))
-> Int -> FingerTree (Node (Elem a)) -> FingerTree (Node (Elem a))
forall a.
(Sized a, MaybeForce a) =>
(Int -> a -> a) -> Int -> FingerTree a -> FingerTree a
adjustTree (Elem a -> Int -> Node (Elem a) -> Node (Elem a)
forall a. Elem a -> Int -> Node (Elem a) -> Node (Elem a)
updateNode Elem a
v) (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
spr) FingerTree (Node (Elem a))
m
in 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
s Digit (Elem a)
pr FingerTree (Node (Elem a))
m' Digit (Elem a)
sf
| Bool
otherwise = 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
s Digit (Elem a)
pr FingerTree (Node (Elem a))
m (Elem a -> Int -> Digit (Elem a) -> Digit (Elem a)
forall a. Elem a -> Int -> Digit (Elem a) -> Digit (Elem a)
updateDigit Elem a
v (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
spm) Digit (Elem a)
sf)
where
spr :: Int
spr = Digit (Elem a) -> Int
forall a. Sized a => a -> Int
size Digit (Elem a)
pr
spm :: Int
spm = Int
spr Int -> Int -> Int
forall a. Num a => a -> a -> a
+ FingerTree (Node (Elem a)) -> Int
forall a. Sized a => a -> Int
size FingerTree (Node (Elem a))
m
updateNode :: Elem a -> Int -> Node (Elem a) -> Node (Elem a)
updateNode :: Elem a -> Int -> Node (Elem a) -> Node (Elem a)
updateNode v :: Elem a
v i :: Int
i (Node2 s :: Int
s a :: Elem a
a b :: Elem a
b)
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
sa = Int -> Elem a -> Elem a -> Node (Elem a)
forall a. Int -> a -> a -> Node a
Node2 Int
s Elem a
v Elem a
b
| Bool
otherwise = Int -> Elem a -> Elem a -> Node (Elem a)
forall a. Int -> a -> a -> Node a
Node2 Int
s Elem a
a Elem a
v
where
sa :: Int
sa = Elem a -> Int
forall a. Sized a => a -> Int
size Elem a
a
updateNode v :: Elem a
v i :: Int
i (Node3 s :: Int
s a :: Elem a
a b :: Elem a
b c :: Elem a
c)
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
sa = Int -> Elem a -> Elem a -> Elem a -> Node (Elem a)
forall a. Int -> a -> a -> a -> Node a
Node3 Int
s Elem a
v Elem a
b Elem a
c
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
sab = Int -> Elem a -> Elem a -> Elem a -> Node (Elem a)
forall a. Int -> a -> a -> a -> Node a
Node3 Int
s Elem a
a Elem a
v Elem a
c
| Bool
otherwise = Int -> Elem a -> Elem a -> Elem a -> Node (Elem a)
forall a. Int -> a -> a -> a -> Node a
Node3 Int
s Elem a
a Elem a
b Elem a
v
where
sa :: Int
sa = Elem a -> Int
forall a. Sized a => a -> Int
size Elem a
a
sab :: Int
sab = Int
sa Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Elem a -> Int
forall a. Sized a => a -> Int
size Elem a
b
updateDigit :: Elem a -> Int -> Digit (Elem a) -> Digit (Elem a)
updateDigit :: Elem a -> Int -> Digit (Elem a) -> Digit (Elem a)
updateDigit v :: Elem a
v !Int
_i (One _) = Elem a -> Digit (Elem a)
forall a. a -> Digit a
One Elem a
v
updateDigit v :: Elem a
v i :: Int
i (Two a :: Elem a
a b :: Elem a
b)
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
sa = Elem a -> Elem a -> Digit (Elem a)
forall a. a -> a -> Digit a
Two Elem a
v Elem a
b
| Bool
otherwise = Elem a -> Elem a -> Digit (Elem a)
forall a. a -> a -> Digit a
Two Elem a
a Elem a
v
where
sa :: Int
sa = Elem a -> Int
forall a. Sized a => a -> Int
size Elem a
a
updateDigit v :: Elem a
v i :: Int
i (Three a :: Elem a
a b :: Elem a
b c :: Elem a
c)
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
sa = Elem a -> Elem a -> Elem a -> Digit (Elem a)
forall a. a -> a -> a -> Digit a
Three Elem a
v Elem a
b Elem a
c
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
sab = Elem a -> Elem a -> Elem a -> Digit (Elem a)
forall a. a -> a -> a -> Digit a
Three Elem a
a Elem a
v Elem a
c
| Bool
otherwise = Elem a -> Elem a -> Elem a -> Digit (Elem a)
forall a. a -> a -> a -> Digit a
Three Elem a
a Elem a
b Elem a
v
where
sa :: Int
sa = Elem a -> Int
forall a. Sized a => a -> Int
size Elem a
a
sab :: Int
sab = Int
sa Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Elem a -> Int
forall a. Sized a => a -> Int
size Elem a
b
updateDigit v :: Elem a
v i :: Int
i (Four a :: Elem a
a b :: Elem a
b c :: Elem a
c d :: Elem a
d)
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
sa = Elem a -> Elem a -> Elem a -> Elem a -> Digit (Elem a)
forall a. a -> a -> a -> a -> Digit a
Four Elem a
v Elem a
b Elem a
c Elem a
d
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
sab = Elem a -> Elem a -> Elem a -> Elem a -> Digit (Elem a)
forall a. a -> a -> a -> a -> Digit a
Four Elem a
a Elem a
v Elem a
c Elem a
d
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
sabc = Elem a -> Elem a -> Elem a -> Elem a -> Digit (Elem a)
forall a. a -> a -> a -> a -> Digit a
Four Elem a
a Elem a
b Elem a
v Elem a
d
| Bool
otherwise = Elem a -> Elem a -> Elem a -> Elem a -> Digit (Elem a)
forall a. a -> a -> a -> a -> Digit a
Four Elem a
a Elem a
b Elem a
c Elem a
v
where
sa :: Int
sa = Elem a -> Int
forall a. Sized a => a -> Int
size Elem a
a
sab :: Int
sab = Int
sa Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Elem a -> Int
forall a. Sized a => a -> Int
size Elem a
b
sabc :: Int
sabc = Int
sab Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Elem a -> Int
forall a. Sized a => a -> Int
size Elem a
c
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)
| Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
< (Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (FingerTree (Elem a) -> Int
forall a. Sized a => a -> Int
size FingerTree (Elem a)
xs) :: Word) = 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, MaybeForce a) =>
(Int -> a -> a) -> Int -> FingerTree a -> FingerTree a
adjustTree (Int -> (Elem a -> Elem a) -> Elem a -> Elem a
forall a b. a -> b -> b
`seq` (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
adjust' :: forall a . (a -> a) -> Int -> Seq a -> Seq a
#if __GLASGOW_HASKELL__ >= 708
adjust' :: (a -> a) -> Int -> Seq a -> Seq a
adjust' f :: a -> a
f i :: Int
i xs :: Seq a
xs
| Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
< (Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Seq a -> Int
forall a. Seq a -> Int
length Seq a
xs) :: Word) =
FingerTree (ForceBox a) -> Seq a
forall a b. Coercible a b => a -> b
coerce (FingerTree (ForceBox a) -> Seq a)
-> FingerTree (ForceBox a) -> Seq a
forall a b. (a -> b) -> a -> b
$ (Int -> ForceBox a -> ForceBox a)
-> Int -> FingerTree (ForceBox a) -> FingerTree (ForceBox a)
forall a.
(Sized a, MaybeForce a) =>
(Int -> a -> a) -> Int -> FingerTree a -> FingerTree a
adjustTree (\ !Int
_k (ForceBox a :: a
a) -> a -> ForceBox a
forall a. a -> ForceBox a
ForceBox (a -> a
f a
a)) Int
i (Seq a -> FingerTree (ForceBox a)
forall a b. Coercible a b => a -> b
coerce Seq a
xs)
| Bool
otherwise = Seq a
xs
#else
adjust' f i xs =
case xs !? i of
Nothing -> xs
Just x -> let !x' = f x
in update i x' xs
#endif
{-# SPECIALIZE adjustTree :: (Int -> ForceBox a -> ForceBox a) -> Int -> FingerTree (ForceBox a) -> FingerTree (ForceBox a) #-}
{-# 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, MaybeForce a) => (Int -> a -> a) ->
Int -> FingerTree a -> FingerTree a
adjustTree :: (Int -> a -> a) -> Int -> FingerTree a -> FingerTree a
adjustTree _ !Int
_ EmptyT = FingerTree a
forall a. FingerTree a
EmptyT
adjustTree f :: Int -> a -> a
f i :: Int
i (Single x :: a
x) = a -> FingerTree a
forall a. a -> FingerTree a
Single (a -> FingerTree a) -> a -> FingerTree a
forall a b. MaybeForce a => (a -> b) -> a -> b
$!? 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
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
spr = 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, MaybeForce 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
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
spm = let !m' :: FingerTree (Node a)
m' = (Int -> Node a -> Node a)
-> Int -> FingerTree (Node a) -> FingerTree (Node a)
forall a.
(Sized a, MaybeForce a) =>
(Int -> a -> a) -> Int -> FingerTree a -> FingerTree a
adjustTree ((Int -> a -> a) -> Int -> Node a -> Node a
forall a.
(Sized a, MaybeForce a) =>
(Int -> a -> a) -> Int -> Node a -> Node a
adjustNode Int -> a -> a
f) (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
spr) FingerTree (Node a)
m
in 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' 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, MaybeForce a) =>
(Int -> a -> a) -> Int -> Digit a -> Digit a
adjustDigit Int -> a -> a
f (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
spm) Digit a
sf)
where
spr :: Int
spr = Digit a -> Int
forall a. Sized a => a -> Int
size Digit a
pr
spm :: Int
spm = Int
spr 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, MaybeForce 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
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
sa = let fia :: a
fia = Int -> a -> a
f Int
i a
a in a
fia a -> Node a -> Node a
forall a b. MaybeForce a => a -> b -> b
`mseq` Int -> a -> a -> Node a
forall a. Int -> a -> a -> Node a
Node2 Int
s a
fia a
b
| Bool
otherwise = let fisab :: a
fisab = Int -> a -> a
f (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sa) a
b in a
fisab a -> Node a -> Node a
forall a b. MaybeForce a => a -> b -> b
`mseq` Int -> a -> a -> Node a
forall a. Int -> a -> a -> Node a
Node2 Int
s a
a a
fisab
where
sa :: Int
sa = 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
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
sa = let fia :: a
fia = Int -> a -> a
f Int
i a
a in a
fia a -> Node a -> Node a
forall a b. MaybeForce a => a -> b -> b
`mseq` Int -> a -> a -> a -> Node a
forall a. Int -> a -> a -> a -> Node a
Node3 Int
s a
fia a
b a
c
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
sab = let fisab :: a
fisab = Int -> a -> a
f (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sa) a
b in a
fisab a -> Node a -> Node a
forall a b. MaybeForce a => a -> b -> b
`mseq` Int -> a -> a -> a -> Node a
forall a. Int -> a -> a -> a -> Node a
Node3 Int
s a
a a
fisab a
c
| Bool
otherwise = let fisabc :: a
fisabc = Int -> a -> a
f (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sab) a
c in a
fisabc a -> Node a -> Node a
forall a b. MaybeForce a => a -> b -> b
`mseq` Int -> a -> a -> a -> Node a
forall a. Int -> a -> a -> a -> Node a
Node3 Int
s a
a a
b a
fisabc
where
sa :: Int
sa = a -> Int
forall a. Sized a => a -> Int
size a
a
sab :: Int
sab = Int
sa 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, MaybeForce a) => (Int -> a -> a) -> Int -> Digit a -> Digit a
adjustDigit :: (Int -> a -> a) -> Int -> Digit a -> Digit a
adjustDigit f :: Int -> a -> a
f !Int
i (One a :: a
a) = a -> Digit a
forall a. a -> Digit a
One (a -> Digit a) -> a -> Digit a
forall a b. MaybeForce a => (a -> b) -> a -> b
$!? 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
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
sa = let fia :: a
fia = Int -> a -> a
f Int
i a
a in a
fia a -> Digit a -> Digit a
forall a b. MaybeForce a => a -> b -> b
`mseq` a -> a -> Digit a
forall a. a -> a -> Digit a
Two a
fia a
b
| Bool
otherwise = let fisab :: a
fisab = Int -> a -> a
f (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sa) a
b in a
fisab a -> Digit a -> Digit a
forall a b. MaybeForce a => a -> b -> b
`mseq` a -> a -> Digit a
forall a. a -> a -> Digit a
Two a
a a
fisab
where
sa :: Int
sa = 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
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
sa = let fia :: a
fia = Int -> a -> a
f Int
i a
a in a
fia a -> Digit a -> Digit a
forall a b. MaybeForce a => a -> b -> b
`mseq` a -> a -> a -> Digit a
forall a. a -> a -> a -> Digit a
Three a
fia a
b a
c
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
sab = let fisab :: a
fisab = Int -> a -> a
f (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sa) a
b in a
fisab a -> Digit a -> Digit a
forall a b. MaybeForce a => a -> b -> b
`mseq` a -> a -> a -> Digit a
forall a. a -> a -> a -> Digit a
Three a
a a
fisab a
c
| Bool
otherwise = let fisabc :: a
fisabc = Int -> a -> a
f (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sab) a
c in a
fisabc a -> Digit a -> Digit a
forall a b. MaybeForce a => a -> b -> b
`mseq` a -> a -> a -> Digit a
forall a. a -> a -> a -> Digit a
Three a
a a
b a
fisabc
where
sa :: Int
sa = a -> Int
forall a. Sized a => a -> Int
size a
a
sab :: Int
sab = Int
sa 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
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
sa = let fia :: a
fia = Int -> a -> a
f Int
i a
a in a
fia a -> Digit a -> Digit a
forall a b. MaybeForce a => a -> b -> b
`mseq` a -> a -> a -> a -> Digit a
forall a. a -> a -> a -> a -> Digit a
Four a
fia a
b a
c a
d
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
sab = let fisab :: a
fisab = Int -> a -> a
f (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sa) a
b in a
fisab a -> Digit a -> Digit a
forall a b. MaybeForce a => a -> b -> b
`mseq` a -> a -> a -> a -> Digit a
forall a. a -> a -> a -> a -> Digit a
Four a
a a
fisab a
c a
d
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
sabc = let fisabc :: a
fisabc = Int -> a -> a
f (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sab) a
c in a
fisabc a -> Digit a -> Digit a
forall a b. MaybeForce a => a -> b -> b
`mseq` a -> a -> a -> a -> Digit a
forall a. a -> a -> a -> a -> Digit a
Four a
a a
b a
fisabc a
d
| Bool
otherwise = let fisabcd :: a
fisabcd = Int -> a -> a
f (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sabc) a
d in a
fisabcd a -> Digit a -> Digit a
forall a b. MaybeForce a => a -> b -> b
`mseq` a -> a -> a -> a -> Digit a
forall a. a -> a -> a -> a -> Digit a
Four a
a a
b a
c a
fisabcd
where
sa :: Int
sa = a -> Int
forall a. Sized a => a -> Int
size a
a
sab :: Int
sab = Int
sa Int -> Int -> Int
forall a. Num a => a -> a -> a
+ a -> Int
forall a. Sized a => a -> Int
size a
b
sabc :: Int
sabc = Int
sab Int -> Int -> Int
forall a. Num a => a -> a -> a
+ a -> Int
forall a. Sized a => a -> Int
size a
c
insertAt :: Int -> a -> Seq a -> Seq a
insertAt :: Int -> a -> Seq a -> Seq a
insertAt i :: Int
i a :: a
a s :: Seq a
s@(Seq xs :: FingerTree (Elem a)
xs)
| Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
< (Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (FingerTree (Elem a) -> Int
forall a. Sized a => a -> Int
size FingerTree (Elem a)
xs) :: Word)
= FingerTree (Elem a) -> Seq a
forall a. FingerTree (Elem a) -> Seq a
Seq ((Int -> Elem a -> Ins (Elem a))
-> Int -> FingerTree (Elem a) -> FingerTree (Elem a)
forall a.
Sized a =>
(Int -> a -> Ins a) -> Int -> FingerTree a -> FingerTree a
insTree (Int -> (Elem a -> Ins (Elem a)) -> Elem a -> Ins (Elem a)
forall a b. a -> b -> b
`seq` Elem a -> Elem a -> Ins (Elem a)
forall a. a -> a -> Ins a
InsTwo (a -> Elem a
forall a. a -> Elem a
Elem a
a)) Int
i FingerTree (Elem a)
xs)
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 0 = a
a a -> Seq a -> Seq a
forall a. a -> Seq a -> Seq a
<| Seq a
s
| Bool
otherwise = Seq a
s Seq a -> a -> Seq a
forall a. Seq a -> a -> Seq a
|> a
a
data Ins a = InsOne a | InsTwo a a
{-# SPECIALIZE insTree :: (Int -> Elem a -> Ins (Elem a)) -> Int -> FingerTree (Elem a) -> FingerTree (Elem a) #-}
{-# SPECIALIZE insTree :: (Int -> Node a -> Ins (Node a)) -> Int -> FingerTree (Node a) -> FingerTree (Node a) #-}
insTree :: Sized a => (Int -> a -> Ins a) ->
Int -> FingerTree a -> FingerTree a
insTree :: (Int -> a -> Ins a) -> Int -> FingerTree a -> FingerTree a
insTree _ !Int
_ EmptyT = FingerTree a
forall a. FingerTree a
EmptyT
insTree f :: Int -> a -> Ins a
f i :: Int
i (Single x :: a
x) = case Int -> a -> Ins a
f Int
i a
x of
InsOne x' :: a
x' -> a -> FingerTree a
forall a. a -> FingerTree a
Single a
x'
InsTwo m :: a
m n :: a
n -> 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
m) FingerTree (Node a)
forall a. FingerTree a
EmptyT (a -> Digit a
forall a. a -> Digit a
One a
n)
insTree f :: Int -> a -> Ins a
f i :: Int
i (Deep s :: Int
s pr :: Digit a
pr m :: FingerTree (Node a)
m sf :: Digit a
sf)
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
spr = case (Int -> a -> Ins a) -> Int -> Digit a -> InsDigNode a
forall a.
Sized a =>
(Int -> a -> Ins a) -> Int -> Digit a -> InsDigNode a
insLeftDigit Int -> a -> Ins a
f Int
i Digit a
pr of
InsLeftDig pr' :: Digit a
pr' -> 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
+ 1) Digit a
pr' FingerTree (Node a)
m Digit a
sf
InsDigNode pr' :: Digit a
pr' n :: Node a
n -> 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
+ 1) Digit a
pr' (Node a
n 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
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
spm = let !m' :: FingerTree (Node a)
m' = (Int -> Node a -> Ins (Node a))
-> Int -> FingerTree (Node a) -> FingerTree (Node a)
forall a.
Sized a =>
(Int -> a -> Ins a) -> Int -> FingerTree a -> FingerTree a
insTree ((Int -> a -> Ins a) -> Int -> Node a -> Ins (Node a)
forall a.
Sized a =>
(Int -> a -> Ins a) -> Int -> Node a -> Ins (Node a)
insNode Int -> a -> Ins a
f) (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
spr) FingerTree (Node a)
m
in 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
+ 1) Digit a
pr FingerTree (Node a)
m' Digit a
sf
| Bool
otherwise = case (Int -> a -> Ins a) -> Int -> Digit a -> InsNodeDig a
forall a.
Sized a =>
(Int -> a -> Ins a) -> Int -> Digit a -> InsNodeDig a
insRightDigit Int -> a -> Ins a
f (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
spm) Digit a
sf of
InsRightDig 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 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1) Digit a
pr FingerTree (Node a)
m Digit a
sf'
InsNodeDig n :: Node a
n 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 (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1) 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` Node a
n) Digit a
sf'
where
spr :: Int
spr = Digit a -> Int
forall a. Sized a => a -> Int
size Digit a
pr
spm :: Int
spm = Int
spr 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 insNode :: (Int -> Elem a -> Ins (Elem a)) -> Int -> Node (Elem a) -> Ins (Node (Elem a)) #-}
{-# SPECIALIZE insNode :: (Int -> Node a -> Ins (Node a)) -> Int -> Node (Node a) -> Ins (Node (Node a)) #-}
insNode :: Sized a => (Int -> a -> Ins a) -> Int -> Node a -> Ins (Node a)
insNode :: (Int -> a -> Ins a) -> Int -> Node a -> Ins (Node a)
insNode f :: Int -> a -> Ins a
f i :: Int
i (Node2 s :: Int
s a :: a
a b :: a
b)
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
sa = case Int -> a -> Ins a
f Int
i a
a of
InsOne n :: a
n -> Node a -> Ins (Node a)
forall a. a -> Ins a
InsOne (Node a -> Ins (Node a)) -> Node a -> Ins (Node a)
forall a b. (a -> b) -> a -> b
$ Int -> a -> a -> Node a
forall a. Int -> a -> a -> Node a
Node2 (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1) a
n a
b
InsTwo m :: a
m n :: a
n -> Node a -> Ins (Node a)
forall a. a -> Ins a
InsOne (Node a -> Ins (Node a)) -> Node a -> Ins (Node a)
forall a b. (a -> b) -> a -> b
$ Int -> a -> a -> a -> Node a
forall a. Int -> a -> a -> a -> Node a
Node3 (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1) a
m a
n a
b
| Bool
otherwise = case Int -> a -> Ins a
f (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sa) a
b of
InsOne n :: a
n -> Node a -> Ins (Node a)
forall a. a -> Ins a
InsOne (Node a -> Ins (Node a)) -> Node a -> Ins (Node a)
forall a b. (a -> b) -> a -> b
$ Int -> a -> a -> Node a
forall a. Int -> a -> a -> Node a
Node2 (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1) a
a a
n
InsTwo m :: a
m n :: a
n -> Node a -> Ins (Node a)
forall a. a -> Ins a
InsOne (Node a -> Ins (Node a)) -> Node a -> Ins (Node a)
forall a b. (a -> b) -> a -> b
$ Int -> a -> a -> a -> Node a
forall a. Int -> a -> a -> a -> Node a
Node3 (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1) a
a a
m a
n
where sa :: Int
sa = a -> Int
forall a. Sized a => a -> Int
size a
a
insNode f :: Int -> a -> Ins a
f i :: Int
i (Node3 s :: Int
s a :: a
a b :: a
b c :: a
c)
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
sa = case Int -> a -> Ins a
f Int
i a
a of
InsOne n :: a
n -> Node a -> Ins (Node a)
forall a. a -> Ins a
InsOne (Node a -> Ins (Node a)) -> Node a -> Ins (Node a)
forall a b. (a -> b) -> a -> b
$ Int -> a -> a -> a -> Node a
forall a. Int -> a -> a -> a -> Node a
Node3 (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1) a
n a
b a
c
InsTwo m :: a
m n :: a
n -> Node a -> Node a -> Ins (Node a)
forall a. a -> a -> Ins a
InsTwo (Int -> a -> a -> Node a
forall a. Int -> a -> a -> Node a
Node2 (Int
sa Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1) a
m a
n) (Int -> a -> a -> Node a
forall a. Int -> a -> a -> Node a
Node2 (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sa) a
b a
c)
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
sab = case Int -> a -> Ins a
f (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sa) a
b of
InsOne n :: a
n -> Node a -> Ins (Node a)
forall a. a -> Ins a
InsOne (Node a -> Ins (Node a)) -> Node a -> Ins (Node a)
forall a b. (a -> b) -> a -> b
$ Int -> a -> a -> a -> Node a
forall a. Int -> a -> a -> a -> Node a
Node3 (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1) a
a a
n a
c
InsTwo m :: a
m n :: a
n -> Node a -> Node a -> Ins (Node a)
forall a. a -> a -> Ins a
InsTwo Node a
am Node a
nc
where !am :: Node a
am = a -> a -> Node a
forall a. Sized a => a -> a -> Node a
node2 a
a a
m
!nc :: Node a
nc = a -> a -> Node a
forall a. Sized a => a -> a -> Node a
node2 a
n a
c
| Bool
otherwise = case Int -> a -> Ins a
f (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sab) a
c of
InsOne n :: a
n -> Node a -> Ins (Node a)
forall a. a -> Ins a
InsOne (Node a -> Ins (Node a)) -> Node a -> Ins (Node a)
forall a b. (a -> b) -> a -> b
$ Int -> a -> a -> a -> Node a
forall a. Int -> a -> a -> a -> Node a
Node3 (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1) a
a a
b a
n
InsTwo m :: a
m n :: a
n -> Node a -> Node a -> Ins (Node a)
forall a. a -> a -> Ins a
InsTwo (Int -> a -> a -> Node a
forall a. Int -> a -> a -> Node a
Node2 Int
sab a
a a
b) (Int -> a -> a -> Node a
forall a. Int -> a -> a -> Node a
Node2 (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sab Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1) a
m a
n)
where sa :: Int
sa = a -> Int
forall a. Sized a => a -> Int
size a
a
sab :: Int
sab = Int
sa Int -> Int -> Int
forall a. Num a => a -> a -> a
+ a -> Int
forall a. Sized a => a -> Int
size a
b
data InsDigNode a = InsLeftDig !(Digit a) | InsDigNode !(Digit a) !(Node a)
{-# SPECIALIZE insLeftDigit :: (Int -> Elem a -> Ins (Elem a)) -> Int -> Digit (Elem a) -> InsDigNode (Elem a) #-}
{-# SPECIALIZE insLeftDigit :: (Int -> Node a -> Ins (Node a)) -> Int -> Digit (Node a) -> InsDigNode (Node a) #-}
insLeftDigit :: Sized a => (Int -> a -> Ins a) -> Int -> Digit a -> InsDigNode a
insLeftDigit :: (Int -> a -> Ins a) -> Int -> Digit a -> InsDigNode a
insLeftDigit f :: Int -> a -> Ins a
f !Int
i (One a :: a
a) = case Int -> a -> Ins a
f Int
i a
a of
InsOne a' :: a
a' -> Digit a -> InsDigNode a
forall a. Digit a -> InsDigNode a
InsLeftDig (Digit a -> InsDigNode a) -> Digit a -> InsDigNode a
forall a b. (a -> b) -> a -> b
$ a -> Digit a
forall a. a -> Digit a
One a
a'
InsTwo a1 :: a
a1 a2 :: a
a2 -> Digit a -> InsDigNode a
forall a. Digit a -> InsDigNode a
InsLeftDig (Digit a -> InsDigNode a) -> Digit a -> InsDigNode a
forall a b. (a -> b) -> a -> b
$ a -> a -> Digit a
forall a. a -> a -> Digit a
Two a
a1 a
a2
insLeftDigit f :: Int -> a -> Ins a
f i :: Int
i (Two a :: a
a b :: a
b)
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
sa = case Int -> a -> Ins a
f Int
i a
a of
InsOne a' :: a
a' -> Digit a -> InsDigNode a
forall a. Digit a -> InsDigNode a
InsLeftDig (Digit a -> InsDigNode a) -> Digit a -> InsDigNode a
forall a b. (a -> b) -> a -> b
$ a -> a -> Digit a
forall a. a -> a -> Digit a
Two a
a' a
b
InsTwo a1 :: a
a1 a2 :: a
a2 -> Digit a -> InsDigNode a
forall a. Digit a -> InsDigNode a
InsLeftDig (Digit a -> InsDigNode a) -> Digit a -> InsDigNode a
forall a b. (a -> b) -> a -> b
$ a -> a -> a -> Digit a
forall a. a -> a -> a -> Digit a
Three a
a1 a
a2 a
b
| Bool
otherwise = case Int -> a -> Ins a
f (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sa) a
b of
InsOne b' :: a
b' -> Digit a -> InsDigNode a
forall a. Digit a -> InsDigNode a
InsLeftDig (Digit a -> InsDigNode a) -> Digit a -> InsDigNode a
forall a b. (a -> b) -> a -> b
$ a -> a -> Digit a
forall a. a -> a -> Digit a
Two a
a a
b'
InsTwo b1 :: a
b1 b2 :: a
b2 -> Digit a -> InsDigNode a
forall a. Digit a -> InsDigNode a
InsLeftDig (Digit a -> InsDigNode a) -> Digit a -> InsDigNode a
forall a b. (a -> b) -> a -> b
$ a -> a -> a -> Digit a
forall a. a -> a -> a -> Digit a
Three a
a a
b1 a
b2
where sa :: Int
sa = a -> Int
forall a. Sized a => a -> Int
size a
a
insLeftDigit f :: Int -> a -> Ins a
f i :: Int
i (Three a :: a
a b :: a
b c :: a
c)
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
sa = case Int -> a -> Ins a
f Int
i a
a of
InsOne a' :: a
a' -> Digit a -> InsDigNode a
forall a. Digit a -> InsDigNode a
InsLeftDig (Digit a -> InsDigNode a) -> Digit a -> InsDigNode a
forall a b. (a -> b) -> a -> b
$ a -> a -> a -> Digit a
forall a. a -> a -> a -> Digit a
Three a
a' a
b a
c
InsTwo a1 :: a
a1 a2 :: a
a2 -> Digit a -> InsDigNode a
forall a. Digit a -> InsDigNode a
InsLeftDig (Digit a -> InsDigNode a) -> Digit a -> InsDigNode a
forall a b. (a -> b) -> a -> b
$ a -> a -> a -> a -> Digit a
forall a. a -> a -> a -> a -> Digit a
Four a
a1 a
a2 a
b a
c
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
sab = case Int -> a -> Ins a
f (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sa) a
b of
InsOne b' :: a
b' -> Digit a -> InsDigNode a
forall a. Digit a -> InsDigNode a
InsLeftDig (Digit a -> InsDigNode a) -> Digit a -> InsDigNode a
forall a b. (a -> b) -> a -> b
$ a -> a -> a -> Digit a
forall a. a -> a -> a -> Digit a
Three a
a a
b' a
c
InsTwo b1 :: a
b1 b2 :: a
b2 -> Digit a -> InsDigNode a
forall a. Digit a -> InsDigNode a
InsLeftDig (Digit a -> InsDigNode a) -> Digit a -> InsDigNode a
forall a b. (a -> b) -> a -> b
$ a -> a -> a -> a -> Digit a
forall a. a -> a -> a -> a -> Digit a
Four a
a a
b1 a
b2 a
c
| Bool
otherwise = case Int -> a -> Ins a
f (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sab) a
c of
InsOne c' :: a
c' -> Digit a -> InsDigNode a
forall a. Digit a -> InsDigNode a
InsLeftDig (Digit a -> InsDigNode a) -> Digit a -> InsDigNode a
forall a b. (a -> b) -> a -> b
$ a -> a -> a -> Digit a
forall a. a -> a -> a -> Digit a
Three a
a a
b a
c'
InsTwo c1 :: a
c1 c2 :: a
c2 -> Digit a -> InsDigNode a
forall a. Digit a -> InsDigNode a
InsLeftDig (Digit a -> InsDigNode a) -> Digit a -> InsDigNode a
forall a b. (a -> b) -> a -> b
$ a -> a -> a -> a -> Digit a
forall a. a -> a -> a -> a -> Digit a
Four a
a a
b a
c1 a
c2
where sa :: Int
sa = a -> Int
forall a. Sized a => a -> Int
size a
a
sab :: Int
sab = Int
sa Int -> Int -> Int
forall a. Num a => a -> a -> a
+ a -> Int
forall a. Sized a => a -> Int
size a
b
insLeftDigit f :: Int -> a -> Ins a
f i :: Int
i (Four a :: a
a b :: a
b c :: a
c d :: a
d)
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
sa = case Int -> a -> Ins a
f Int
i a
a of
InsOne a' :: a
a' -> Digit a -> InsDigNode a
forall a. Digit a -> InsDigNode a
InsLeftDig (Digit a -> InsDigNode a) -> Digit a -> InsDigNode a
forall a b. (a -> b) -> a -> b
$ a -> a -> a -> a -> Digit a
forall a. a -> a -> a -> a -> Digit a
Four a
a' a
b a
c a
d
InsTwo a1 :: a
a1 a2 :: a
a2 -> Digit a -> Node a -> InsDigNode a
forall a. Digit a -> Node a -> InsDigNode a
InsDigNode (a -> a -> Digit a
forall a. a -> a -> Digit a
Two a
a1 a
a2) (a -> a -> a -> Node a
forall a. Sized a => a -> a -> a -> Node a
node3 a
b a
c a
d)
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
sab = case Int -> a -> Ins a
f (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sa) a
b of
InsOne b' :: a
b' -> Digit a -> InsDigNode a
forall a. Digit a -> InsDigNode a
InsLeftDig (Digit a -> InsDigNode a) -> Digit a -> InsDigNode a
forall a b. (a -> b) -> a -> b
$ a -> a -> a -> a -> Digit a
forall a. a -> a -> a -> a -> Digit a
Four a
a a
b' a
c a
d
InsTwo b1 :: a
b1 b2 :: a
b2 -> Digit a -> Node a -> InsDigNode a
forall a. Digit a -> Node a -> InsDigNode a
InsDigNode (a -> a -> Digit a
forall a. a -> a -> Digit a
Two a
a a
b1) (a -> a -> a -> Node a
forall a. Sized a => a -> a -> a -> Node a
node3 a
b2 a
c a
d)
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
sabc = case Int -> a -> Ins a
f (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sab) a
c of
InsOne c' :: a
c' -> Digit a -> InsDigNode a
forall a. Digit a -> InsDigNode a
InsLeftDig (Digit a -> InsDigNode a) -> Digit a -> InsDigNode a
forall a b. (a -> b) -> a -> b
$ a -> a -> a -> a -> Digit a
forall a. a -> a -> a -> a -> Digit a
Four a
a a
b a
c' a
d
InsTwo c1 :: a
c1 c2 :: a
c2 -> Digit a -> Node a -> InsDigNode a
forall a. Digit a -> Node a -> InsDigNode a
InsDigNode (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
c1 a
c2 a
d)
| Bool
otherwise = case Int -> a -> Ins a
f (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sabc) a
d of
InsOne d' :: a
d' -> Digit a -> InsDigNode a
forall a. Digit a -> InsDigNode a
InsLeftDig (Digit a -> InsDigNode a) -> Digit a -> InsDigNode a
forall a b. (a -> b) -> a -> b
$ a -> a -> a -> a -> Digit a
forall a. a -> a -> a -> a -> Digit a
Four a
a a
b a
c a
d'
InsTwo d1 :: a
d1 d2 :: a
d2 -> Digit a -> Node a -> InsDigNode a
forall a. Digit a -> Node a -> InsDigNode a
InsDigNode (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
d1 a
d2)
where sa :: Int
sa = a -> Int
forall a. Sized a => a -> Int
size a
a
sab :: Int
sab = Int
sa Int -> Int -> Int
forall a. Num a => a -> a -> a
+ a -> Int
forall a. Sized a => a -> Int
size a
b
sabc :: Int
sabc = Int
sab Int -> Int -> Int
forall a. Num a => a -> a -> a
+ a -> Int
forall a. Sized a => a -> Int
size a
c
data InsNodeDig a = InsRightDig !(Digit a) | InsNodeDig !(Node a) !(Digit a)
{-# SPECIALIZE insRightDigit :: (Int -> Elem a -> Ins (Elem a)) -> Int -> Digit (Elem a) -> InsNodeDig (Elem a) #-}
{-# SPECIALIZE insRightDigit :: (Int -> Node a -> Ins (Node a)) -> Int -> Digit (Node a) -> InsNodeDig (Node a) #-}
insRightDigit :: Sized a => (Int -> a -> Ins a) -> Int -> Digit a -> InsNodeDig a
insRightDigit :: (Int -> a -> Ins a) -> Int -> Digit a -> InsNodeDig a
insRightDigit f :: Int -> a -> Ins a
f !Int
i (One a :: a
a) = case Int -> a -> Ins a
f Int
i a
a of
InsOne a' :: a
a' -> Digit a -> InsNodeDig a
forall a. Digit a -> InsNodeDig a
InsRightDig (Digit a -> InsNodeDig a) -> Digit a -> InsNodeDig a
forall a b. (a -> b) -> a -> b
$ a -> Digit a
forall a. a -> Digit a
One a
a'
InsTwo a1 :: a
a1 a2 :: a
a2 -> Digit a -> InsNodeDig a
forall a. Digit a -> InsNodeDig a
InsRightDig (Digit a -> InsNodeDig a) -> Digit a -> InsNodeDig a
forall a b. (a -> b) -> a -> b
$ a -> a -> Digit a
forall a. a -> a -> Digit a
Two a
a1 a
a2
insRightDigit f :: Int -> a -> Ins a
f i :: Int
i (Two a :: a
a b :: a
b)
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
sa = case Int -> a -> Ins a
f Int
i a
a of
InsOne a' :: a
a' -> Digit a -> InsNodeDig a
forall a. Digit a -> InsNodeDig a
InsRightDig (Digit a -> InsNodeDig a) -> Digit a -> InsNodeDig a
forall a b. (a -> b) -> a -> b
$ a -> a -> Digit a
forall a. a -> a -> Digit a
Two a
a' a
b
InsTwo a1 :: a
a1 a2 :: a
a2 -> Digit a -> InsNodeDig a
forall a. Digit a -> InsNodeDig a
InsRightDig (Digit a -> InsNodeDig a) -> Digit a -> InsNodeDig a
forall a b. (a -> b) -> a -> b
$ a -> a -> a -> Digit a
forall a. a -> a -> a -> Digit a
Three a
a1 a
a2 a
b
| Bool
otherwise = case Int -> a -> Ins a
f (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sa) a
b of
InsOne b' :: a
b' -> Digit a -> InsNodeDig a
forall a. Digit a -> InsNodeDig a
InsRightDig (Digit a -> InsNodeDig a) -> Digit a -> InsNodeDig a
forall a b. (a -> b) -> a -> b
$ a -> a -> Digit a
forall a. a -> a -> Digit a
Two a
a a
b'
InsTwo b1 :: a
b1 b2 :: a
b2 -> Digit a -> InsNodeDig a
forall a. Digit a -> InsNodeDig a
InsRightDig (Digit a -> InsNodeDig a) -> Digit a -> InsNodeDig a
forall a b. (a -> b) -> a -> b
$ a -> a -> a -> Digit a
forall a. a -> a -> a -> Digit a
Three a
a a
b1 a
b2
where sa :: Int
sa = a -> Int
forall a. Sized a => a -> Int
size a
a
insRightDigit f :: Int -> a -> Ins a
f i :: Int
i (Three a :: a
a b :: a
b c :: a
c)
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
sa = case Int -> a -> Ins a
f Int
i a
a of
InsOne a' :: a
a' -> Digit a -> InsNodeDig a
forall a. Digit a -> InsNodeDig a
InsRightDig (Digit a -> InsNodeDig a) -> Digit a -> InsNodeDig a
forall a b. (a -> b) -> a -> b
$ a -> a -> a -> Digit a
forall a. a -> a -> a -> Digit a
Three a
a' a
b a
c
InsTwo a1 :: a
a1 a2 :: a
a2 -> Digit a -> InsNodeDig a
forall a. Digit a -> InsNodeDig a
InsRightDig (Digit a -> InsNodeDig a) -> Digit a -> InsNodeDig a
forall a b. (a -> b) -> a -> b
$ a -> a -> a -> a -> Digit a
forall a. a -> a -> a -> a -> Digit a
Four a
a1 a
a2 a
b a
c
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
sab = case Int -> a -> Ins a
f (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sa) a
b of
InsOne b' :: a
b' -> Digit a -> InsNodeDig a
forall a. Digit a -> InsNodeDig a
InsRightDig (Digit a -> InsNodeDig a) -> Digit a -> InsNodeDig a
forall a b. (a -> b) -> a -> b
$ a -> a -> a -> Digit a
forall a. a -> a -> a -> Digit a
Three a
a a
b' a
c
InsTwo b1 :: a
b1 b2 :: a
b2 -> Digit a -> InsNodeDig a
forall a. Digit a -> InsNodeDig a
InsRightDig (Digit a -> InsNodeDig a) -> Digit a -> InsNodeDig a
forall a b. (a -> b) -> a -> b
$ a -> a -> a -> a -> Digit a
forall a. a -> a -> a -> a -> Digit a
Four a
a a
b1 a
b2 a
c
| Bool
otherwise = case Int -> a -> Ins a
f (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sab) a
c of
InsOne c' :: a
c' -> Digit a -> InsNodeDig a
forall a. Digit a -> InsNodeDig a
InsRightDig (Digit a -> InsNodeDig a) -> Digit a -> InsNodeDig a
forall a b. (a -> b) -> a -> b
$ a -> a -> a -> Digit a
forall a. a -> a -> a -> Digit a
Three a
a a
b a
c'
InsTwo c1 :: a
c1 c2 :: a
c2 -> Digit a -> InsNodeDig a
forall a. Digit a -> InsNodeDig a
InsRightDig (Digit a -> InsNodeDig a) -> Digit a -> InsNodeDig a
forall a b. (a -> b) -> a -> b
$ a -> a -> a -> a -> Digit a
forall a. a -> a -> a -> a -> Digit a
Four a
a a
b a
c1 a
c2
where sa :: Int
sa = a -> Int
forall a. Sized a => a -> Int
size a
a
sab :: Int
sab = Int
sa Int -> Int -> Int
forall a. Num a => a -> a -> a
+ a -> Int
forall a. Sized a => a -> Int
size a
b
insRightDigit f :: Int -> a -> Ins a
f i :: Int
i (Four a :: a
a b :: a
b c :: a
c d :: a
d)
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
sa = case Int -> a -> Ins a
f Int
i a
a of
InsOne a' :: a
a' -> Digit a -> InsNodeDig a
forall a. Digit a -> InsNodeDig a
InsRightDig (Digit a -> InsNodeDig a) -> Digit a -> InsNodeDig a
forall a b. (a -> b) -> a -> b
$ a -> a -> a -> a -> Digit a
forall a. a -> a -> a -> a -> Digit a
Four a
a' a
b a
c a
d
InsTwo a1 :: a
a1 a2 :: a
a2 -> Node a -> Digit a -> InsNodeDig a
forall a. Node a -> Digit a -> InsNodeDig a
InsNodeDig (a -> a -> a -> Node a
forall a. Sized a => a -> a -> a -> Node a
node3 a
a1 a
a2 a
b) (a -> a -> Digit a
forall a. a -> a -> Digit a
Two a
c a
d)
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
sab = case Int -> a -> Ins a
f (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sa) a
b of
InsOne b' :: a
b' -> Digit a -> InsNodeDig a
forall a. Digit a -> InsNodeDig a
InsRightDig (Digit a -> InsNodeDig a) -> Digit a -> InsNodeDig a
forall a b. (a -> b) -> a -> b
$ a -> a -> a -> a -> Digit a
forall a. a -> a -> a -> a -> Digit a
Four a
a a
b' a
c a
d
InsTwo b1 :: a
b1 b2 :: a
b2 -> Node a -> Digit a -> InsNodeDig a
forall a. Node a -> Digit a -> InsNodeDig a
InsNodeDig (a -> a -> a -> Node a
forall a. Sized a => a -> a -> a -> Node a
node3 a
a a
b1 a
b2) (a -> a -> Digit a
forall a. a -> a -> Digit a
Two a
c a
d)
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
sabc = case Int -> a -> Ins a
f (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sab) a
c of
InsOne c' :: a
c' -> Digit a -> InsNodeDig a
forall a. Digit a -> InsNodeDig a
InsRightDig (Digit a -> InsNodeDig a) -> Digit a -> InsNodeDig a
forall a b. (a -> b) -> a -> b
$ a -> a -> a -> a -> Digit a
forall a. a -> a -> a -> a -> Digit a
Four a
a a
b a
c' a
d
InsTwo c1 :: a
c1 c2 :: a
c2 -> Node a -> Digit a -> InsNodeDig a
forall a. Node a -> Digit a -> InsNodeDig a
InsNodeDig (a -> a -> a -> Node a
forall a. Sized a => a -> a -> a -> Node a
node3 a
a a
b a
c1) (a -> a -> Digit a
forall a. a -> a -> Digit a
Two a
c2 a
d)
| Bool
otherwise = case Int -> a -> Ins a
f (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sabc) a
d of
InsOne d' :: a
d' -> Digit a -> InsNodeDig a
forall a. Digit a -> InsNodeDig a
InsRightDig (Digit a -> InsNodeDig a) -> Digit a -> InsNodeDig a
forall a b. (a -> b) -> a -> b
$ a -> a -> a -> a -> Digit a
forall a. a -> a -> a -> a -> Digit a
Four a
a a
b a
c a
d'
InsTwo d1 :: a
d1 d2 :: a
d2 -> Node a -> Digit a -> InsNodeDig a
forall a. Node a -> Digit a -> InsNodeDig a
InsNodeDig (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
d1 a
d2)
where sa :: Int
sa = a -> Int
forall a. Sized a => a -> Int
size a
a
sab :: Int
sab = Int
sa Int -> Int -> Int
forall a. Num a => a -> a -> a
+ a -> Int
forall a. Sized a => a -> Int
size a
b
sabc :: Int
sabc = Int
sab Int -> Int -> Int
forall a. Num a => a -> a -> a
+ a -> Int
forall a. Sized a => a -> Int
size a
c
deleteAt :: Int -> Seq a -> Seq a
deleteAt :: Int -> Seq a -> Seq a
deleteAt i :: Int
i (Seq xs :: FingerTree (Elem a)
xs)
| Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
< (Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (FingerTree (Elem a) -> Int
forall a. Sized a => a -> Int
size FingerTree (Elem a)
xs) :: Word) = FingerTree (Elem a) -> Seq a
forall a. FingerTree (Elem a) -> Seq a
Seq (FingerTree (Elem a) -> Seq a) -> FingerTree (Elem a) -> Seq a
forall a b. (a -> b) -> a -> b
$ Int -> FingerTree (Elem a) -> FingerTree (Elem a)
forall a. Int -> FingerTree (Elem a) -> FingerTree (Elem a)
delTreeE 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
delTreeE :: Int -> FingerTree (Elem a) -> FingerTree (Elem a)
delTreeE :: Int -> FingerTree (Elem a) -> FingerTree (Elem a)
delTreeE !Int
_i EmptyT = FingerTree (Elem a)
forall a. FingerTree a
EmptyT
delTreeE _i :: Int
_i Single{} = FingerTree (Elem a)
forall a. FingerTree a
EmptyT
delTreeE i :: Int
i (Deep s :: Int
s pr :: Digit (Elem a)
pr m :: FingerTree (Node (Elem a))
m sf :: Digit (Elem a)
sf)
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
spr = Int
-> Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> FingerTree (Elem a)
forall a.
Int
-> Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> FingerTree (Elem a)
delLeftDigitE Int
i Int
s Digit (Elem a)
pr FingerTree (Node (Elem a))
m Digit (Elem a)
sf
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
spm = case (Int -> Node (Elem a) -> Del (Elem a))
-> Int -> FingerTree (Node (Elem a)) -> DelTree (Elem a)
forall a.
Sized a =>
(Int -> Node a -> Del a) -> Int -> FingerTree (Node a) -> DelTree a
delTree Int -> Node (Elem a) -> Del (Elem a)
forall a. Int -> Node (Elem a) -> Del (Elem a)
delNodeE (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
spr) FingerTree (Node (Elem a))
m of
FullTree m' :: FingerTree (Node (Elem a))
m' -> 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
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) Digit (Elem a)
pr FingerTree (Node (Elem a))
m' Digit (Elem a)
sf
DefectTree e :: Elem a
e -> Int
-> Digit (Elem a)
-> Elem a
-> Digit (Elem a)
-> FingerTree (Elem a)
forall a. Sized a => Int -> Digit a -> a -> Digit a -> FingerTree a
delRebuildMiddle (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) Digit (Elem a)
pr Elem a
e Digit (Elem a)
sf
| Bool
otherwise = Int
-> Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> FingerTree (Elem a)
forall a.
Int
-> Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> FingerTree (Elem a)
delRightDigitE (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
spm) Int
s Digit (Elem a)
pr FingerTree (Node (Elem a))
m Digit (Elem a)
sf
where spr :: Int
spr = Digit (Elem a) -> Int
forall a. Sized a => a -> Int
size Digit (Elem a)
pr
spm :: Int
spm = Int
spr Int -> Int -> Int
forall a. Num a => a -> a -> a
+ FingerTree (Node (Elem a)) -> Int
forall a. Sized a => a -> Int
size FingerTree (Node (Elem a))
m
delNodeE :: Int -> Node (Elem a) -> Del (Elem a)
delNodeE :: Int -> Node (Elem a) -> Del (Elem a)
delNodeE i :: Int
i (Node3 _ a :: Elem a
a b :: Elem a
b c :: Elem a
c) = case Int
i of
0 -> Node (Elem a) -> Del (Elem a)
forall a. Node a -> Del a
Full (Node (Elem a) -> Del (Elem a)) -> Node (Elem a) -> Del (Elem a)
forall a b. (a -> b) -> a -> b
$ Int -> Elem a -> Elem a -> Node (Elem a)
forall a. Int -> a -> a -> Node a
Node2 2 Elem a
b Elem a
c
1 -> Node (Elem a) -> Del (Elem a)
forall a. Node a -> Del a
Full (Node (Elem a) -> Del (Elem a)) -> Node (Elem a) -> Del (Elem a)
forall a b. (a -> b) -> a -> b
$ Int -> Elem a -> Elem a -> Node (Elem a)
forall a. Int -> a -> a -> Node a
Node2 2 Elem a
a Elem a
c
_ -> Node (Elem a) -> Del (Elem a)
forall a. Node a -> Del a
Full (Node (Elem a) -> Del (Elem a)) -> Node (Elem a) -> Del (Elem a)
forall a b. (a -> b) -> a -> b
$ Int -> Elem a -> Elem a -> Node (Elem a)
forall a. Int -> a -> a -> Node a
Node2 2 Elem a
a Elem a
b
delNodeE i :: Int
i (Node2 _ a :: Elem a
a b :: Elem a
b) = case Int
i of
0 -> Elem a -> Del (Elem a)
forall a. a -> Del a
Defect Elem a
b
_ -> Elem a -> Del (Elem a)
forall a. a -> Del a
Defect Elem a
a
delLeftDigitE :: Int -> Int -> Digit (Elem a) -> FingerTree (Node (Elem a)) -> Digit (Elem a) -> FingerTree (Elem a)
delLeftDigitE :: Int
-> Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> FingerTree (Elem a)
delLeftDigitE !Int
_i s :: Int
s One{} m :: FingerTree (Node (Elem a))
m sf :: Digit (Elem a)
sf = Int
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> FingerTree (Elem a)
forall a. Int -> FingerTree (Node a) -> Digit a -> FingerTree a
pullL (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) FingerTree (Node (Elem a))
m Digit (Elem a)
sf
delLeftDigitE i :: Int
i s :: Int
s (Two a :: Elem a
a b :: Elem a
b) m :: FingerTree (Node (Elem a))
m sf :: Digit (Elem a)
sf
| Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0 = 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
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) (Elem a -> Digit (Elem a)
forall a. a -> Digit a
One Elem a
b) FingerTree (Node (Elem a))
m Digit (Elem a)
sf
| Bool
otherwise = 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
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) (Elem a -> Digit (Elem a)
forall a. a -> Digit a
One Elem a
a) FingerTree (Node (Elem a))
m Digit (Elem a)
sf
delLeftDigitE i :: Int
i s :: Int
s (Three a :: Elem a
a b :: Elem a
b c :: Elem a
c) m :: FingerTree (Node (Elem a))
m sf :: Digit (Elem a)
sf
| Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0 = 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
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) (Elem a -> Elem a -> Digit (Elem a)
forall a. a -> a -> Digit a
Two Elem a
b Elem a
c) FingerTree (Node (Elem a))
m Digit (Elem a)
sf
| Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 1 = 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
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) (Elem a -> Elem a -> Digit (Elem a)
forall a. a -> a -> Digit a
Two Elem a
a Elem a
c) FingerTree (Node (Elem a))
m Digit (Elem a)
sf
| Bool
otherwise = 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
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) (Elem a -> Elem a -> Digit (Elem a)
forall a. a -> a -> Digit a
Two Elem a
a Elem a
b) FingerTree (Node (Elem a))
m Digit (Elem a)
sf
delLeftDigitE i :: Int
i s :: Int
s (Four a :: Elem a
a b :: Elem a
b c :: Elem a
c d :: Elem a
d) m :: FingerTree (Node (Elem a))
m sf :: Digit (Elem a)
sf
| Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0 = 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
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) (Elem a -> Elem a -> Elem a -> Digit (Elem a)
forall a. a -> a -> a -> Digit a
Three Elem a
b Elem a
c Elem a
d) FingerTree (Node (Elem a))
m Digit (Elem a)
sf
| Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 1 = 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
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) (Elem a -> Elem a -> Elem a -> Digit (Elem a)
forall a. a -> a -> a -> Digit a
Three Elem a
a Elem a
c Elem a
d) FingerTree (Node (Elem a))
m Digit (Elem a)
sf
| Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 2 = 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
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) (Elem a -> Elem a -> Elem a -> Digit (Elem a)
forall a. a -> a -> a -> Digit a
Three Elem a
a Elem a
b Elem a
d) FingerTree (Node (Elem a))
m Digit (Elem a)
sf
| Bool
otherwise = 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
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) (Elem a -> Elem a -> Elem a -> Digit (Elem a)
forall a. a -> a -> a -> Digit a
Three Elem a
a Elem a
b Elem a
c) FingerTree (Node (Elem a))
m Digit (Elem a)
sf
delRightDigitE :: Int -> Int -> Digit (Elem a) -> FingerTree (Node (Elem a)) -> Digit (Elem a) -> FingerTree (Elem a)
delRightDigitE :: Int
-> Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> FingerTree (Elem a)
delRightDigitE !Int
_i s :: Int
s pr :: Digit (Elem a)
pr m :: FingerTree (Node (Elem a))
m One{} = Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> FingerTree (Elem a)
forall a. Int -> Digit a -> FingerTree (Node a) -> FingerTree a
pullR (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) Digit (Elem a)
pr FingerTree (Node (Elem a))
m
delRightDigitE i :: Int
i s :: Int
s pr :: Digit (Elem a)
pr m :: FingerTree (Node (Elem a))
m (Two a :: Elem a
a b :: Elem a
b)
| Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0 = 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
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) Digit (Elem a)
pr FingerTree (Node (Elem a))
m (Elem a -> Digit (Elem a)
forall a. a -> Digit a
One Elem a
b)
| Bool
otherwise = 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
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) Digit (Elem a)
pr FingerTree (Node (Elem a))
m (Elem a -> Digit (Elem a)
forall a. a -> Digit a
One Elem a
a)
delRightDigitE i :: Int
i s :: Int
s pr :: Digit (Elem a)
pr m :: FingerTree (Node (Elem a))
m (Three a :: Elem a
a b :: Elem a
b c :: Elem a
c)
| Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0 = 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
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) Digit (Elem a)
pr FingerTree (Node (Elem a))
m (Elem a -> Elem a -> Digit (Elem a)
forall a. a -> a -> Digit a
Two Elem a
b Elem a
c)
| Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 1 = 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
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) Digit (Elem a)
pr FingerTree (Node (Elem a))
m (Elem a -> Elem a -> Digit (Elem a)
forall a. a -> a -> Digit a
Two Elem a
a Elem a
c)
| Bool
otherwise = Digit (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> FingerTree (Elem a)
forall a.
Sized a =>
Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
deep Digit (Elem a)
pr FingerTree (Node (Elem a))
m (Elem a -> Elem a -> Digit (Elem a)
forall a. a -> a -> Digit a
Two Elem a
a Elem a
b)
delRightDigitE i :: Int
i s :: Int
s pr :: Digit (Elem a)
pr m :: FingerTree (Node (Elem a))
m (Four a :: Elem a
a b :: Elem a
b c :: Elem a
c d :: Elem a
d)
| Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0 = 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
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) Digit (Elem a)
pr FingerTree (Node (Elem a))
m (Elem a -> Elem a -> Elem a -> Digit (Elem a)
forall a. a -> a -> a -> Digit a
Three Elem a
b Elem a
c Elem a
d)
| Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 1 = 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
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) Digit (Elem a)
pr FingerTree (Node (Elem a))
m (Elem a -> Elem a -> Elem a -> Digit (Elem a)
forall a. a -> a -> a -> Digit a
Three Elem a
a Elem a
c Elem a
d)
| Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 2 = 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
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) Digit (Elem a)
pr FingerTree (Node (Elem a))
m (Elem a -> Elem a -> Elem a -> Digit (Elem a)
forall a. a -> a -> a -> Digit a
Three Elem a
a Elem a
b Elem a
d)
| Bool
otherwise = 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
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) Digit (Elem a)
pr FingerTree (Node (Elem a))
m (Elem a -> Elem a -> Elem a -> Digit (Elem a)
forall a. a -> a -> a -> Digit a
Three Elem a
a Elem a
b Elem a
c)
data DelTree a = FullTree !(FingerTree (Node a)) | DefectTree a
{-# SPECIALIZE delTree :: (Int -> Node (Elem a) -> Del (Elem a)) -> Int -> FingerTree (Node (Elem a)) -> DelTree (Elem a) #-}
{-# SPECIALIZE delTree :: (Int -> Node (Node a) -> Del (Node a)) -> Int -> FingerTree (Node (Node a)) -> DelTree (Node a) #-}
delTree :: Sized a => (Int -> Node a -> Del a) -> Int -> FingerTree (Node a) -> DelTree a
delTree :: (Int -> Node a -> Del a) -> Int -> FingerTree (Node a) -> DelTree a
delTree _f :: Int -> Node a -> Del a
_f !Int
_i EmptyT = FingerTree (Node a) -> DelTree a
forall a. FingerTree (Node a) -> DelTree a
FullTree FingerTree (Node a)
forall a. FingerTree a
EmptyT
delTree f :: Int -> Node a -> Del a
f i :: Int
i (Single a :: Node a
a) = case Int -> Node a -> Del a
f Int
i Node a
a of
Full a' :: Node a
a' -> FingerTree (Node a) -> DelTree a
forall a. FingerTree (Node a) -> DelTree a
FullTree (Node a -> FingerTree (Node a)
forall a. a -> FingerTree a
Single Node a
a')
Defect e :: a
e -> a -> DelTree a
forall a. a -> DelTree a
DefectTree a
e
delTree f :: Int -> Node a -> Del a
f i :: Int
i (Deep s :: Int
s pr :: Digit (Node a)
pr m :: FingerTree (Node (Node a))
m sf :: Digit (Node a)
sf)
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
spr = case (Int -> Node a -> Del a) -> Int -> Digit (Node a) -> DelDig a
forall a.
Sized a =>
(Int -> Node a -> Del a) -> Int -> Digit (Node a) -> DelDig a
delDigit Int -> Node a -> Del a
f Int
i Digit (Node a)
pr of
FullDig pr' :: Digit (Node a)
pr' -> FingerTree (Node a) -> DelTree a
forall a. FingerTree (Node a) -> DelTree a
FullTree (FingerTree (Node a) -> DelTree a)
-> FingerTree (Node a) -> DelTree a
forall a b. (a -> b) -> a -> b
$ 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
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) Digit (Node a)
pr' FingerTree (Node (Node a))
m Digit (Node a)
sf
DefectDig e :: a
e -> case FingerTree (Node (Node a)) -> ViewLTree (Node (Node a))
forall a. Sized a => FingerTree a -> ViewLTree a
viewLTree FingerTree (Node (Node a))
m of
EmptyLTree -> FingerTree (Node a) -> DelTree a
forall a. FingerTree (Node a) -> DelTree a
FullTree (FingerTree (Node a) -> DelTree a)
-> FingerTree (Node a) -> DelTree a
forall a b. (a -> b) -> a -> b
$ Int -> a -> Digit (Node a) -> FingerTree (Node a)
forall a.
Sized a =>
Int -> a -> Digit (Node a) -> FingerTree (Node a)
delRebuildRightDigit (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) a
e Digit (Node a)
sf
ConsLTree n :: Node (Node a)
n m' :: FingerTree (Node (Node a))
m' -> FingerTree (Node a) -> DelTree a
forall a. FingerTree (Node a) -> DelTree a
FullTree (FingerTree (Node a) -> DelTree a)
-> FingerTree (Node a) -> DelTree a
forall a b. (a -> b) -> a -> b
$ Int
-> a
-> Node (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> FingerTree (Node a)
forall a.
Sized a =>
Int
-> a
-> Node (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> FingerTree (Node a)
delRebuildLeftSide (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) a
e Node (Node a)
n FingerTree (Node (Node a))
m' Digit (Node a)
sf
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
spm = case (Int -> Node (Node a) -> Del (Node a))
-> Int -> FingerTree (Node (Node a)) -> DelTree (Node a)
forall a.
Sized a =>
(Int -> Node a -> Del a) -> Int -> FingerTree (Node a) -> DelTree a
delTree ((Int -> Node a -> Del a) -> Int -> Node (Node a) -> Del (Node a)
forall a.
Sized a =>
(Int -> Node a -> Del a) -> Int -> Node (Node a) -> Del (Node a)
delNode Int -> Node a -> Del a
f) (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
spr) FingerTree (Node (Node a))
m of
FullTree m' :: FingerTree (Node (Node a))
m' -> FingerTree (Node a) -> DelTree a
forall a. FingerTree (Node a) -> DelTree a
FullTree (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
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) Digit (Node a)
pr FingerTree (Node (Node a))
m' Digit (Node a)
sf)
DefectTree e :: Node a
e -> FingerTree (Node a) -> DelTree a
forall a. FingerTree (Node a) -> DelTree a
FullTree (FingerTree (Node a) -> DelTree a)
-> FingerTree (Node a) -> DelTree a
forall a b. (a -> b) -> a -> b
$ Int
-> Digit (Node a)
-> Node a
-> Digit (Node a)
-> FingerTree (Node a)
forall a. Sized a => Int -> Digit a -> a -> Digit a -> FingerTree a
delRebuildMiddle (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) Digit (Node a)
pr Node a
e Digit (Node a)
sf
| Bool
otherwise = case (Int -> Node a -> Del a) -> Int -> Digit (Node a) -> DelDig a
forall a.
Sized a =>
(Int -> Node a -> Del a) -> Int -> Digit (Node a) -> DelDig a
delDigit Int -> Node a -> Del a
f (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
spm) Digit (Node a)
sf of
FullDig sf' :: Digit (Node a)
sf' -> FingerTree (Node a) -> DelTree a
forall a. FingerTree (Node a) -> DelTree a
FullTree (FingerTree (Node a) -> DelTree a)
-> FingerTree (Node a) -> DelTree a
forall a b. (a -> b) -> a -> b
$ 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
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) Digit (Node a)
pr FingerTree (Node (Node a))
m Digit (Node a)
sf'
DefectDig e :: a
e -> case FingerTree (Node (Node a)) -> ViewRTree (Node (Node a))
forall a. Sized a => FingerTree a -> ViewRTree a
viewRTree FingerTree (Node (Node a))
m of
EmptyRTree -> FingerTree (Node a) -> DelTree a
forall a. FingerTree (Node a) -> DelTree a
FullTree (FingerTree (Node a) -> DelTree a)
-> FingerTree (Node a) -> DelTree a
forall a b. (a -> b) -> a -> b
$ Int -> Digit (Node a) -> a -> FingerTree (Node a)
forall a.
Sized a =>
Int -> Digit (Node a) -> a -> FingerTree (Node a)
delRebuildLeftDigit (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) Digit (Node a)
pr a
e
SnocRTree m' :: FingerTree (Node (Node a))
m' n :: Node (Node a)
n -> FingerTree (Node a) -> DelTree a
forall a. FingerTree (Node a) -> DelTree a
FullTree (FingerTree (Node a) -> DelTree a)
-> FingerTree (Node a) -> DelTree a
forall a b. (a -> b) -> a -> b
$ Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> Node (Node a)
-> a
-> FingerTree (Node a)
forall a.
Sized a =>
Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> Node (Node a)
-> a
-> FingerTree (Node a)
delRebuildRightSide (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) Digit (Node a)
pr FingerTree (Node (Node a))
m' Node (Node a)
n a
e
where spr :: Int
spr = Digit (Node a) -> Int
forall a. Sized a => a -> Int
size Digit (Node a)
pr
spm :: Int
spm = Int
spr Int -> Int -> Int
forall a. Num a => a -> a -> a
+ FingerTree (Node (Node a)) -> Int
forall a. Sized a => a -> Int
size FingerTree (Node (Node a))
m
data Del a = Full !(Node a) | Defect a
{-# SPECIALIZE delNode :: (Int -> Node (Elem a) -> Del (Elem a)) -> Int -> Node (Node (Elem a)) -> Del (Node (Elem a)) #-}
{-# SPECIALIZE delNode :: (Int -> Node (Node a) -> Del (Node a)) -> Int -> Node (Node (Node a)) -> Del (Node (Node a)) #-}
delNode :: Sized a => (Int -> Node a -> Del a) -> Int -> Node (Node a) -> Del (Node a)
delNode :: (Int -> Node a -> Del a) -> Int -> Node (Node a) -> Del (Node a)
delNode f :: Int -> Node a -> Del a
f i :: Int
i (Node3 s :: Int
s a :: Node a
a b :: Node a
b c :: Node a
c)
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
sa = case Int -> Node a -> Del a
f Int
i Node a
a of
Full a' :: Node a
a' -> Node (Node a) -> Del (Node a)
forall a. Node a -> Del a
Full (Node (Node a) -> Del (Node a)) -> Node (Node a) -> Del (Node a)
forall a b. (a -> b) -> a -> b
$ Int -> Node a -> Node a -> Node a -> Node (Node a)
forall a. Int -> a -> a -> a -> Node a
Node3 (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) Node a
a' Node a
b Node a
c
Defect e :: a
e -> let !se :: Int
se = a -> Int
forall a. Sized a => a -> Int
size a
e in case Node a
b of
Node3 sxyz :: Int
sxyz x :: a
x y :: a
y z :: a
z -> Node (Node a) -> Del (Node a)
forall a. Node a -> Del a
Full (Node (Node a) -> Del (Node a)) -> Node (Node a) -> Del (Node a)
forall a b. (a -> b) -> a -> b
$ Int -> Node a -> Node a -> Node a -> Node (Node a)
forall a. Int -> a -> a -> a -> Node a
Node3 (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) (Int -> a -> a -> Node a
forall a. Int -> a -> a -> Node a
Node2 (Int
se Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
sx) a
e a
x) (Int -> a -> a -> Node a
forall a. Int -> a -> a -> Node a
Node2 (Int
sxyz Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sx) a
y a
z) Node a
c
where !sx :: Int
sx = a -> Int
forall a. Sized a => a -> Int
size a
x
Node2 sxy :: Int
sxy x :: a
x y :: a
y -> Node (Node a) -> Del (Node a)
forall a. Node a -> Del a
Full (Node (Node a) -> Del (Node a)) -> Node (Node a) -> Del (Node a)
forall a b. (a -> b) -> a -> b
$ Int -> Node a -> Node a -> Node (Node a)
forall a. Int -> a -> a -> Node a
Node2 (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) (Int -> a -> a -> a -> Node a
forall a. Int -> a -> a -> a -> Node a
Node3 (Int
sxy Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
se) a
e a
x a
y) Node a
c
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
sab = case Int -> Node a -> Del a
f (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sa) Node a
b of
Full b' :: Node a
b' -> Node (Node a) -> Del (Node a)
forall a. Node a -> Del a
Full (Node (Node a) -> Del (Node a)) -> Node (Node a) -> Del (Node a)
forall a b. (a -> b) -> a -> b
$ Int -> Node a -> Node a -> Node a -> Node (Node a)
forall a. Int -> a -> a -> a -> Node a
Node3 (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) Node a
a Node a
b' Node a
c
Defect e :: a
e -> let !se :: Int
se = a -> Int
forall a. Sized a => a -> Int
size a
e in case Node a
a of
Node3 sxyz :: Int
sxyz x :: a
x y :: a
y z :: a
z -> Node (Node a) -> Del (Node a)
forall a. Node a -> Del a
Full (Node (Node a) -> Del (Node a)) -> Node (Node a) -> Del (Node a)
forall a b. (a -> b) -> a -> b
$ Int -> Node a -> Node a -> Node a -> Node (Node a)
forall a. Int -> a -> a -> a -> Node a
Node3 (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) (Int -> a -> a -> Node a
forall a. Int -> a -> a -> Node a
Node2 (Int
sxyz Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sz) a
x a
y) (Int -> a -> a -> Node a
forall a. Int -> a -> a -> Node a
Node2 (Int
sz Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
se) a
z a
e) Node a
c
where !sz :: Int
sz = a -> Int
forall a. Sized a => a -> Int
size a
z
Node2 sxy :: Int
sxy x :: a
x y :: a
y -> Node (Node a) -> Del (Node a)
forall a. Node a -> Del a
Full (Node (Node a) -> Del (Node a)) -> Node (Node a) -> Del (Node a)
forall a b. (a -> b) -> a -> b
$ Int -> Node a -> Node a -> Node (Node a)
forall a. Int -> a -> a -> Node a
Node2 (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) (Int -> a -> a -> a -> Node a
forall a. Int -> a -> a -> a -> Node a
Node3 (Int
sxy Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
se) a
x a
y a
e) Node a
c
| Bool
otherwise = case Int -> Node a -> Del a
f (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sab) Node a
c of
Full c' :: Node a
c' -> Node (Node a) -> Del (Node a)
forall a. Node a -> Del a
Full (Node (Node a) -> Del (Node a)) -> Node (Node a) -> Del (Node a)
forall a b. (a -> b) -> a -> b
$ Int -> Node a -> Node a -> Node a -> Node (Node a)
forall a. Int -> a -> a -> a -> Node a
Node3 (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) Node a
a Node a
b Node a
c'
Defect e :: a
e -> let !se :: Int
se = a -> Int
forall a. Sized a => a -> Int
size a
e in case Node a
b of
Node3 sxyz :: Int
sxyz x :: a
x y :: a
y z :: a
z -> Node (Node a) -> Del (Node a)
forall a. Node a -> Del a
Full (Node (Node a) -> Del (Node a)) -> Node (Node a) -> Del (Node a)
forall a b. (a -> b) -> a -> b
$ Int -> Node a -> Node a -> Node a -> Node (Node a)
forall a. Int -> a -> a -> a -> Node a
Node3 (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) Node a
a (Int -> a -> a -> Node a
forall a. Int -> a -> a -> Node a
Node2 (Int
sxyz Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sz) a
x a
y) (Int -> a -> a -> Node a
forall a. Int -> a -> a -> Node a
Node2 (Int
sz Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
se) a
z a
e)
where !sz :: Int
sz = a -> Int
forall a. Sized a => a -> Int
size a
z
Node2 sxy :: Int
sxy x :: a
x y :: a
y -> Node (Node a) -> Del (Node a)
forall a. Node a -> Del a
Full (Node (Node a) -> Del (Node a)) -> Node (Node a) -> Del (Node a)
forall a b. (a -> b) -> a -> b
$ Int -> Node a -> Node a -> Node (Node a)
forall a. Int -> a -> a -> Node a
Node2 (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) Node a
a (Int -> a -> a -> a -> Node a
forall a. Int -> a -> a -> a -> Node a
Node3 (Int
sxy Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
se) a
x a
y a
e)
where sa :: Int
sa = Node a -> Int
forall a. Sized a => a -> Int
size Node a
a
sab :: Int
sab = Int
sa Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Node a -> Int
forall a. Sized a => a -> Int
size Node a
b
delNode f :: Int -> Node a -> Del a
f i :: Int
i (Node2 s :: Int
s a :: Node a
a b :: Node a
b)
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
sa = case Int -> Node a -> Del a
f Int
i Node a
a of
Full a' :: Node a
a' -> Node (Node a) -> Del (Node a)
forall a. Node a -> Del a
Full (Node (Node a) -> Del (Node a)) -> Node (Node a) -> Del (Node a)
forall a b. (a -> b) -> a -> b
$ Int -> Node a -> Node a -> Node (Node a)
forall a. Int -> a -> a -> Node a
Node2 (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) Node a
a' Node a
b
Defect e :: a
e -> let !se :: Int
se = a -> Int
forall a. Sized a => a -> Int
size a
e in case Node a
b of
Node3 sxyz :: Int
sxyz x :: a
x y :: a
y z :: a
z -> Node (Node a) -> Del (Node a)
forall a. Node a -> Del a
Full (Node (Node a) -> Del (Node a)) -> Node (Node a) -> Del (Node a)
forall a b. (a -> b) -> a -> b
$ Int -> Node a -> Node a -> Node (Node a)
forall a. Int -> a -> a -> Node a
Node2 (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) (Int -> a -> a -> Node a
forall a. Int -> a -> a -> Node a
Node2 (Int
se Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
sx) a
e a
x) (Int -> a -> a -> Node a
forall a. Int -> a -> a -> Node a
Node2 (Int
sxyz Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sx) a
y a
z)
where !sx :: Int
sx = a -> Int
forall a. Sized a => a -> Int
size a
x
Node2 _ x :: a
x y :: a
y -> Node a -> Del (Node a)
forall a. a -> Del a
Defect (Node a -> Del (Node a)) -> Node a -> Del (Node a)
forall a b. (a -> b) -> a -> b
$ Int -> a -> a -> a -> Node a
forall a. Int -> a -> a -> a -> Node a
Node3 (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) a
e a
x a
y
| Bool
otherwise = case Int -> Node a -> Del a
f (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sa) Node a
b of
Full b' :: Node a
b' -> Node (Node a) -> Del (Node a)
forall a. Node a -> Del a
Full (Node (Node a) -> Del (Node a)) -> Node (Node a) -> Del (Node a)
forall a b. (a -> b) -> a -> b
$ Int -> Node a -> Node a -> Node (Node a)
forall a. Int -> a -> a -> Node a
Node2 (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) Node a
a Node a
b'
Defect e :: a
e -> let !se :: Int
se = a -> Int
forall a. Sized a => a -> Int
size a
e in case Node a
a of
Node3 sxyz :: Int
sxyz x :: a
x y :: a
y z :: a
z -> Node (Node a) -> Del (Node a)
forall a. Node a -> Del a
Full (Node (Node a) -> Del (Node a)) -> Node (Node a) -> Del (Node a)
forall a b. (a -> b) -> a -> b
$ Int -> Node a -> Node a -> Node (Node a)
forall a. Int -> a -> a -> Node a
Node2 (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) (Int -> a -> a -> Node a
forall a. Int -> a -> a -> Node a
Node2 (Int
sxyz Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sz) a
x a
y) (Int -> a -> a -> Node a
forall a. Int -> a -> a -> Node a
Node2 (Int
sz Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
se) a
z a
e)
where !sz :: Int
sz = a -> Int
forall a. Sized a => a -> Int
size a
z
Node2 _ x :: a
x y :: a
y -> Node a -> Del (Node a)
forall a. a -> Del a
Defect (Node a -> Del (Node a)) -> Node a -> Del (Node a)
forall a b. (a -> b) -> a -> b
$ Int -> a -> a -> a -> Node a
forall a. Int -> a -> a -> a -> Node a
Node3 (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) a
x a
y a
e
where sa :: Int
sa = Node a -> Int
forall a. Sized a => a -> Int
size Node a
a
{-# SPECIALIZE delRebuildRightDigit :: Int -> Elem a -> Digit (Node (Elem a)) -> FingerTree (Node (Elem a)) #-}
{-# SPECIALIZE delRebuildRightDigit :: Int -> Node a -> Digit (Node (Node a)) -> FingerTree (Node (Node a)) #-}
delRebuildRightDigit :: Sized a => Int -> a -> Digit (Node a) -> FingerTree (Node a)
delRebuildRightDigit :: Int -> a -> Digit (Node a) -> FingerTree (Node a)
delRebuildRightDigit s :: Int
s p :: a
p (One a :: Node a
a) = let !sp :: Int
sp = a -> Int
forall a. Sized a => a -> Int
size a
p in case Node a
a of
Node3 sxyz :: Int
sxyz x :: a
x y :: a
y z :: a
z -> 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
s (Node a -> Digit (Node a)
forall a. a -> Digit a
One (Int -> a -> a -> Node a
forall a. Int -> a -> a -> Node a
Node2 (Int
sp Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
sx) a
p a
x)) FingerTree (Node (Node a))
forall a. FingerTree a
EmptyT (Node a -> Digit (Node a)
forall a. a -> Digit a
One (Int -> a -> a -> Node a
forall a. Int -> a -> a -> Node a
Node2 (Int
sxyz Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sx) a
y a
z))
where !sx :: Int
sx = a -> Int
forall a. Sized a => a -> Int
size a
x
Node2 sxy :: Int
sxy x :: a
x y :: a
y -> Node a -> FingerTree (Node a)
forall a. a -> FingerTree a
Single (Int -> a -> a -> a -> Node a
forall a. Int -> a -> a -> a -> Node a
Node3 (Int
sp Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
sxy) a
p a
x a
y)
delRebuildRightDigit s :: Int
s p :: a
p (Two a :: Node a
a b :: Node a
b) = let !sp :: Int
sp = a -> Int
forall a. Sized a => a -> Int
size a
p in case Node a
a of
Node3 sxyz :: Int
sxyz x :: a
x y :: a
y z :: a
z -> 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
s (Node a -> Node a -> Digit (Node a)
forall a. a -> a -> Digit a
Two (Int -> a -> a -> Node a
forall a. Int -> a -> a -> Node a
Node2 (Int
sp Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
sx) a
p a
x) (Int -> a -> a -> Node a
forall a. Int -> a -> a -> Node a
Node2 (Int
sxyz Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sx) a
y a
z)) FingerTree (Node (Node a))
forall a. FingerTree a
EmptyT (Node a -> Digit (Node a)
forall a. a -> Digit a
One Node a
b)
where !sx :: Int
sx = a -> Int
forall a. Sized a => a -> Int
size a
x
Node2 sxy :: Int
sxy x :: a
x y :: a
y -> 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
s (Node a -> Digit (Node a)
forall a. a -> Digit a
One (Int -> a -> a -> a -> Node a
forall a. Int -> a -> a -> a -> Node a
Node3 (Int
sp Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
sxy) a
p a
x a
y)) FingerTree (Node (Node a))
forall a. FingerTree a
EmptyT (Node a -> Digit (Node a)
forall a. a -> Digit a
One Node a
b)
delRebuildRightDigit s :: Int
s p :: a
p (Three a :: Node a
a b :: Node a
b c :: Node a
c) = let !sp :: Int
sp = a -> Int
forall a. Sized a => a -> Int
size a
p in case Node a
a of
Node3 sxyz :: Int
sxyz x :: a
x y :: a
y z :: a
z -> 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
s (Node a -> Node a -> Digit (Node a)
forall a. a -> a -> Digit a
Two (Int -> a -> a -> Node a
forall a. Int -> a -> a -> Node a
Node2 (Int
sp Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
sx) a
p a
x) (Int -> a -> a -> Node a
forall a. Int -> a -> a -> Node a
Node2 (Int
sxyz Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sx) a
y a
z)) FingerTree (Node (Node a))
forall a. FingerTree a
EmptyT (Node a -> Node a -> Digit (Node a)
forall a. a -> a -> Digit a
Two Node a
b Node a
c)
where !sx :: Int
sx = a -> Int
forall a. Sized a => a -> Int
size a
x
Node2 sxy :: Int
sxy x :: a
x y :: a
y -> 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
s (Node a -> Node a -> Digit (Node a)
forall a. a -> a -> Digit a
Two (Int -> a -> a -> a -> Node a
forall a. Int -> a -> a -> a -> Node a
Node3 (Int
sp Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
sxy) a
p a
x a
y) Node a
b) FingerTree (Node (Node a))
forall a. FingerTree a
EmptyT (Node a -> Digit (Node a)
forall a. a -> Digit a
One Node a
c)
delRebuildRightDigit s :: Int
s p :: a
p (Four a :: Node a
a b :: Node a
b c :: Node a
c d :: Node a
d) = let !sp :: Int
sp = a -> Int
forall a. Sized a => a -> Int
size a
p in case Node a
a of
Node3 sxyz :: Int
sxyz x :: a
x y :: a
y z :: a
z -> 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
s (Node a -> Node a -> Node a -> Digit (Node a)
forall a. a -> a -> a -> Digit a
Three (Int -> a -> a -> Node a
forall a. Int -> a -> a -> Node a
Node2 (Int
sp Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
sx) a
p a
x) (Int -> a -> a -> Node a
forall a. Int -> a -> a -> Node a
Node2 (Int
sxyz Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sx) a
y a
z) Node a
b) FingerTree (Node (Node a))
forall a. FingerTree a
EmptyT (Node a -> Node a -> Digit (Node a)
forall a. a -> a -> Digit a
Two Node a
c Node a
d)
where !sx :: Int
sx = a -> Int
forall a. Sized a => a -> Int
size a
x
Node2 sxy :: Int
sxy x :: a
x y :: a
y -> 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
s (Node a -> Node a -> Digit (Node a)
forall a. a -> a -> Digit a
Two (Int -> a -> a -> a -> Node a
forall a. Int -> a -> a -> a -> Node a
Node3 (Int
sp Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
sxy) a
p a
x a
y) Node a
b) FingerTree (Node (Node a))
forall a. FingerTree a
EmptyT (Node a -> Node a -> Digit (Node a)
forall a. a -> a -> Digit a
Two Node a
c Node a
d)
{-# SPECIALIZE delRebuildLeftDigit :: Int -> Digit (Node (Elem a)) -> Elem a -> FingerTree (Node (Elem a)) #-}
{-# SPECIALIZE delRebuildLeftDigit :: Int -> Digit (Node (Node a)) -> Node a -> FingerTree (Node (Node a)) #-}
delRebuildLeftDigit :: Sized a => Int -> Digit (Node a) -> a -> FingerTree (Node a)
delRebuildLeftDigit :: Int -> Digit (Node a) -> a -> FingerTree (Node a)
delRebuildLeftDigit s :: Int
s (One a :: Node a
a) p :: a
p = let !sp :: Int
sp = a -> Int
forall a. Sized a => a -> Int
size a
p in case Node a
a of
Node3 sxyz :: Int
sxyz x :: a
x y :: a
y z :: a
z -> 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
s (Node a -> Digit (Node a)
forall a. a -> Digit a
One (Int -> a -> a -> Node a
forall a. Int -> a -> a -> Node a
Node2 (Int
sxyz Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sz) a
x a
y)) FingerTree (Node (Node a))
forall a. FingerTree a
EmptyT (Node a -> Digit (Node a)
forall a. a -> Digit a
One (Int -> a -> a -> Node a
forall a. Int -> a -> a -> Node a
Node2 (Int
sz Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
sp) a
z a
p))
where !sz :: Int
sz = a -> Int
forall a. Sized a => a -> Int
size a
z
Node2 sxy :: Int
sxy x :: a
x y :: a
y -> Node a -> FingerTree (Node a)
forall a. a -> FingerTree a
Single (Int -> a -> a -> a -> Node a
forall a. Int -> a -> a -> a -> Node a
Node3 (Int
sxy Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
sp) a
x a
y a
p)
delRebuildLeftDigit s :: Int
s (Two a :: Node a
a b :: Node a
b) p :: a
p = let !sp :: Int
sp = a -> Int
forall a. Sized a => a -> Int
size a
p in case Node a
b of
Node3 sxyz :: Int
sxyz x :: a
x y :: a
y z :: a
z -> 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
s (Node a -> Node a -> Digit (Node a)
forall a. a -> a -> Digit a
Two Node a
a (Int -> a -> a -> Node a
forall a. Int -> a -> a -> Node a
Node2 (Int
sxyz Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sz) a
x a
y)) FingerTree (Node (Node a))
forall a. FingerTree a
EmptyT (Node a -> Digit (Node a)
forall a. a -> Digit a
One (Int -> a -> a -> Node a
forall a. Int -> a -> a -> Node a
Node2 (Int
sz Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
sp) a
z a
p))
where !sz :: Int
sz = a -> Int
forall a. Sized a => a -> Int
size a
z
Node2 sxy :: Int
sxy x :: a
x y :: a
y -> 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
s (Node a -> Digit (Node a)
forall a. a -> Digit a
One Node a
a) FingerTree (Node (Node a))
forall a. FingerTree a
EmptyT (Node a -> Digit (Node a)
forall a. a -> Digit a
One (Int -> a -> a -> a -> Node a
forall a. Int -> a -> a -> a -> Node a
Node3 (Int
sxy Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
sp) a
x a
y a
p))
delRebuildLeftDigit s :: Int
s (Three a :: Node a
a b :: Node a
b c :: Node a
c) p :: a
p = let !sp :: Int
sp = a -> Int
forall a. Sized a => a -> Int
size a
p in case Node a
c of
Node3 sxyz :: Int
sxyz x :: a
x y :: a
y z :: a
z -> 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
s (Node a -> Node a -> Digit (Node a)
forall a. a -> a -> Digit a
Two Node a
a Node a
b) FingerTree (Node (Node a))
forall a. FingerTree a
EmptyT (Node a -> Node a -> Digit (Node a)
forall a. a -> a -> Digit a
Two (Int -> a -> a -> Node a
forall a. Int -> a -> a -> Node a
Node2 (Int
sxyz Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sz) a
x a
y) (Int -> a -> a -> Node a
forall a. Int -> a -> a -> Node a
Node2 (Int
sz Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
sp) a
z a
p))
where !sz :: Int
sz = a -> Int
forall a. Sized a => a -> Int
size a
z
Node2 sxy :: Int
sxy x :: a
x y :: a
y -> 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
s (Node a -> Node a -> Digit (Node a)
forall a. a -> a -> Digit a
Two Node a
a Node a
b) FingerTree (Node (Node a))
forall a. FingerTree a
EmptyT (Node a -> Digit (Node a)
forall a. a -> Digit a
One (Int -> a -> a -> a -> Node a
forall a. Int -> a -> a -> a -> Node a
Node3 (Int
sxy Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
sp) a
x a
y a
p))
delRebuildLeftDigit s :: Int
s (Four a :: Node a
a b :: Node a
b c :: Node a
c d :: Node a
d) p :: a
p = let !sp :: Int
sp = a -> Int
forall a. Sized a => a -> Int
size a
p in case Node a
d of
Node3 sxyz :: Int
sxyz x :: a
x y :: a
y z :: a
z -> 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
s (Node a -> Node a -> Node a -> Digit (Node a)
forall a. a -> a -> a -> Digit a
Three Node a
a Node a
b Node a
c) FingerTree (Node (Node a))
forall a. FingerTree a
EmptyT (Node a -> Node a -> Digit (Node a)
forall a. a -> a -> Digit a
Two (Int -> a -> a -> Node a
forall a. Int -> a -> a -> Node a
Node2 (Int
sxyz Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sz) a
x a
y) (Int -> a -> a -> Node a
forall a. Int -> a -> a -> Node a
Node2 (Int
sz Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
sp) a
z a
p))
where !sz :: Int
sz = a -> Int
forall a. Sized a => a -> Int
size a
z
Node2 sxy :: Int
sxy x :: a
x y :: a
y -> 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
s (Node a -> Node a -> Digit (Node a)
forall a. a -> a -> Digit a
Two Node a
a Node a
b) FingerTree (Node (Node a))
forall a. FingerTree a
EmptyT (Node a -> Node a -> Digit (Node a)
forall a. a -> a -> Digit a
Two Node a
c (Int -> a -> a -> a -> Node a
forall a. Int -> a -> a -> a -> Node a
Node3 (Int
sxy Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
sp) a
x a
y a
p))
delRebuildLeftSide :: Sized a
=> Int -> a -> Node (Node a) -> FingerTree (Node (Node a)) -> Digit (Node a)
-> FingerTree (Node a)
delRebuildLeftSide :: Int
-> a
-> Node (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> FingerTree (Node a)
delRebuildLeftSide s :: Int
s p :: a
p (Node2 _ a :: Node a
a b :: Node a
b) m :: FingerTree (Node (Node a))
m sf :: Digit (Node a)
sf = let !sp :: Int
sp = a -> Int
forall a. Sized a => a -> Int
size a
p in case Node a
a of
Node2 sxy :: Int
sxy x :: a
x y :: a
y -> 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
s (Node a -> Node a -> Digit (Node a)
forall a. a -> a -> Digit a
Two (Int -> a -> a -> a -> Node a
forall a. Int -> a -> a -> a -> Node a
Node3 (Int
sp Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
sxy) a
p a
x a
y) Node a
b) FingerTree (Node (Node a))
m Digit (Node a)
sf
Node3 sxyz :: Int
sxyz x :: a
x y :: a
y z :: a
z -> 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
s (Node a -> Node a -> Node a -> Digit (Node a)
forall a. a -> a -> a -> Digit a
Three (Int -> a -> a -> Node a
forall a. Int -> a -> a -> Node a
Node2 (Int
sp Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
sx) a
p a
x) (Int -> a -> a -> Node a
forall a. Int -> a -> a -> Node a
Node2 (Int
sxyz Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sx) a
y a
z) Node a
b) FingerTree (Node (Node a))
m Digit (Node a)
sf
where !sx :: Int
sx = a -> Int
forall a. Sized a => a -> Int
size a
x
delRebuildLeftSide s :: Int
s p :: a
p (Node3 _ a :: Node a
a b :: Node a
b c :: Node a
c) m :: FingerTree (Node (Node a))
m sf :: Digit (Node a)
sf = let !sp :: Int
sp = a -> Int
forall a. Sized a => a -> Int
size a
p in case Node a
a of
Node2 sxy :: Int
sxy x :: a
x y :: a
y -> 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
s (Node a -> Node a -> Node a -> Digit (Node a)
forall a. a -> a -> a -> Digit a
Three (Int -> a -> a -> a -> Node a
forall a. Int -> a -> a -> a -> Node a
Node3 (Int
sp Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
sxy) a
p a
x a
y) Node a
b Node a
c) FingerTree (Node (Node a))
m Digit (Node a)
sf
Node3 sxyz :: Int
sxyz x :: a
x y :: a
y z :: a
z -> 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
s (Node a -> Node a -> Node a -> Node a -> Digit (Node a)
forall a. a -> a -> a -> a -> Digit a
Four (Int -> a -> a -> Node a
forall a. Int -> a -> a -> Node a
Node2 (Int
sp Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
sx) a
p a
x) (Int -> a -> a -> Node a
forall a. Int -> a -> a -> Node a
Node2 (Int
sxyz Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sx) a
y a
z) Node a
b Node a
c) FingerTree (Node (Node a))
m Digit (Node a)
sf
where !sx :: Int
sx = a -> Int
forall a. Sized a => a -> Int
size a
x
delRebuildRightSide :: Sized a
=> Int -> Digit (Node a) -> FingerTree (Node (Node a)) -> Node (Node a) -> a
-> FingerTree (Node a)
delRebuildRightSide :: Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> Node (Node a)
-> a
-> FingerTree (Node a)
delRebuildRightSide s :: Int
s pr :: Digit (Node a)
pr m :: FingerTree (Node (Node a))
m (Node2 _ a :: Node a
a b :: Node a
b) p :: a
p = let !sp :: Int
sp = a -> Int
forall a. Sized a => a -> Int
size a
p in case Node a
b of
Node2 sxy :: Int
sxy x :: a
x y :: a
y -> 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
s Digit (Node a)
pr FingerTree (Node (Node a))
m (Node a -> Node a -> Digit (Node a)
forall a. a -> a -> Digit a
Two Node a
a (Int -> a -> a -> a -> Node a
forall a. Int -> a -> a -> a -> Node a
Node3 (Int
sxy Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
sp) a
x a
y a
p))
Node3 sxyz :: Int
sxyz x :: a
x y :: a
y z :: a
z -> 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
s Digit (Node a)
pr FingerTree (Node (Node a))
m (Node a -> Node a -> Node a -> Digit (Node a)
forall a. a -> a -> a -> Digit a
Three Node a
a (Int -> a -> a -> Node a
forall a. Int -> a -> a -> Node a
Node2 (Int
sxyz Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sz) a
x a
y) (Int -> a -> a -> Node a
forall a. Int -> a -> a -> Node a
Node2 (Int
sz Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
sp) a
z a
p))
where !sz :: Int
sz = a -> Int
forall a. Sized a => a -> Int
size a
z
delRebuildRightSide s :: Int
s pr :: Digit (Node a)
pr m :: FingerTree (Node (Node a))
m (Node3 _ a :: Node a
a b :: Node a
b c :: Node a
c) p :: a
p = let !sp :: Int
sp = a -> Int
forall a. Sized a => a -> Int
size a
p in case Node a
c of
Node2 sxy :: Int
sxy x :: a
x y :: a
y -> 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
s Digit (Node a)
pr FingerTree (Node (Node a))
m (Node a -> Node a -> Node a -> Digit (Node a)
forall a. a -> a -> a -> Digit a
Three Node a
a Node a
b (Int -> a -> a -> a -> Node a
forall a. Int -> a -> a -> a -> Node a
Node3 (Int
sxy Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
sp) a
x a
y a
p))
Node3 sxyz :: Int
sxyz x :: a
x y :: a
y z :: a
z -> 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
s Digit (Node a)
pr FingerTree (Node (Node a))
m (Node a -> Node a -> Node a -> Node a -> Digit (Node a)
forall a. a -> a -> a -> a -> Digit a
Four Node a
a Node a
b (Int -> a -> a -> Node a
forall a. Int -> a -> a -> Node a
Node2 (Int
sxyz Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sz) a
x a
y) (Int -> a -> a -> Node a
forall a. Int -> a -> a -> Node a
Node2 (Int
sz Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
sp) a
z a
p))
where !sz :: Int
sz = a -> Int
forall a. Sized a => a -> Int
size a
z
delRebuildMiddle :: Sized a
=> Int -> Digit a -> a -> Digit a
-> FingerTree a
delRebuildMiddle :: Int -> Digit a -> a -> Digit a -> FingerTree a
delRebuildMiddle s :: Int
s (One a :: a
a) e :: a
e 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
forall a. a -> a -> Digit a
Two a
a a
e) FingerTree (Node a)
forall a. FingerTree a
EmptyT Digit a
sf
delRebuildMiddle s :: Int
s (Two a :: a
a b :: a
b) e :: a
e 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 -> a -> Digit a
forall a. a -> a -> a -> Digit a
Three a
a a
b a
e) FingerTree (Node a)
forall a. FingerTree a
EmptyT Digit a
sf
delRebuildMiddle s :: Int
s (Three a :: a
a b :: a
b c :: a
c) e :: a
e 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 -> a -> a -> Digit a
forall a. a -> a -> a -> a -> Digit a
Four a
a a
b a
c a
e) FingerTree (Node a)
forall a. FingerTree a
EmptyT Digit a
sf
delRebuildMiddle s :: Int
s (Four a :: a
a b :: a
b c :: a
c d :: a
d) e :: a
e 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
forall a. a -> a -> Digit a
Two a
a a
b) (Node a -> FingerTree (Node a)
forall a. a -> FingerTree a
Single (a -> a -> a -> Node a
forall a. Sized a => a -> a -> a -> Node a
node3 a
c a
d a
e)) Digit a
sf
data DelDig a = FullDig !(Digit (Node a)) | DefectDig a
{-# SPECIALIZE delDigit :: (Int -> Node (Elem a) -> Del (Elem a)) -> Int -> Digit (Node (Elem a)) -> DelDig (Elem a) #-}
{-# SPECIALIZE delDigit :: (Int -> Node (Node a) -> Del (Node a)) -> Int -> Digit (Node (Node a)) -> DelDig (Node a) #-}
delDigit :: Sized a => (Int -> Node a -> Del a) -> Int -> Digit (Node a) -> DelDig a
delDigit :: (Int -> Node a -> Del a) -> Int -> Digit (Node a) -> DelDig a
delDigit f :: Int -> Node a -> Del a
f !Int
i (One a :: Node a
a) = case Int -> Node a -> Del a
f Int
i Node a
a of
Full a' :: Node a
a' -> Digit (Node a) -> DelDig a
forall a. Digit (Node a) -> DelDig a
FullDig (Digit (Node a) -> DelDig a) -> Digit (Node a) -> DelDig a
forall a b. (a -> b) -> a -> b
$ Node a -> Digit (Node a)
forall a. a -> Digit a
One Node a
a'
Defect e :: a
e -> a -> DelDig a
forall a. a -> DelDig a
DefectDig a
e
delDigit f :: Int -> Node a -> Del a
f i :: Int
i (Two a :: Node a
a b :: Node a
b)
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
sa = case Int -> Node a -> Del a
f Int
i Node a
a of
Full a' :: Node a
a' -> Digit (Node a) -> DelDig a
forall a. Digit (Node a) -> DelDig a
FullDig (Digit (Node a) -> DelDig a) -> Digit (Node a) -> DelDig a
forall a b. (a -> b) -> a -> b
$ Node a -> Node a -> Digit (Node a)
forall a. a -> a -> Digit a
Two Node a
a' Node a
b
Defect e :: a
e -> let !se :: Int
se = a -> Int
forall a. Sized a => a -> Int
size a
e in case Node a
b of
Node3 sxyz :: Int
sxyz x :: a
x y :: a
y z :: a
z -> Digit (Node a) -> DelDig a
forall a. Digit (Node a) -> DelDig a
FullDig (Digit (Node a) -> DelDig a) -> Digit (Node a) -> DelDig a
forall a b. (a -> b) -> a -> b
$ Node a -> Node a -> Digit (Node a)
forall a. a -> a -> Digit a
Two (Int -> a -> a -> Node a
forall a. Int -> a -> a -> Node a
Node2 (Int
se Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
sx) a
e a
x) (Int -> a -> a -> Node a
forall a. Int -> a -> a -> Node a
Node2 (Int
sxyz Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sx) a
y a
z)
where !sx :: Int
sx = a -> Int
forall a. Sized a => a -> Int
size a
x
Node2 sxy :: Int
sxy x :: a
x y :: a
y -> Digit (Node a) -> DelDig a
forall a. Digit (Node a) -> DelDig a
FullDig (Digit (Node a) -> DelDig a) -> Digit (Node a) -> DelDig a
forall a b. (a -> b) -> a -> b
$ Node a -> Digit (Node a)
forall a. a -> Digit a
One (Int -> a -> a -> a -> Node a
forall a. Int -> a -> a -> a -> Node a
Node3 (Int
se Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
sxy) a
e a
x a
y)
| Bool
otherwise = case Int -> Node a -> Del a
f (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sa) Node a
b of
Full b' :: Node a
b' -> Digit (Node a) -> DelDig a
forall a. Digit (Node a) -> DelDig a
FullDig (Digit (Node a) -> DelDig a) -> Digit (Node a) -> DelDig a
forall a b. (a -> b) -> a -> b
$ Node a -> Node a -> Digit (Node a)
forall a. a -> a -> Digit a
Two Node a
a Node a
b'
Defect e :: a
e -> let !se :: Int
se = a -> Int
forall a. Sized a => a -> Int
size a
e in case Node a
a of
Node3 sxyz :: Int
sxyz x :: a
x y :: a
y z :: a
z -> Digit (Node a) -> DelDig a
forall a. Digit (Node a) -> DelDig a
FullDig (Digit (Node a) -> DelDig a) -> Digit (Node a) -> DelDig a
forall a b. (a -> b) -> a -> b
$ Node a -> Node a -> Digit (Node a)
forall a. a -> a -> Digit a
Two (Int -> a -> a -> Node a
forall a. Int -> a -> a -> Node a
Node2 (Int
sxyz Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sz) a
x a
y) (Int -> a -> a -> Node a
forall a. Int -> a -> a -> Node a
Node2 (Int
sz Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
se) a
z a
e)
where !sz :: Int
sz = a -> Int
forall a. Sized a => a -> Int
size a
z
Node2 sxy :: Int
sxy x :: a
x y :: a
y -> Digit (Node a) -> DelDig a
forall a. Digit (Node a) -> DelDig a
FullDig (Digit (Node a) -> DelDig a) -> Digit (Node a) -> DelDig a
forall a b. (a -> b) -> a -> b
$ Node a -> Digit (Node a)
forall a. a -> Digit a
One (Int -> a -> a -> a -> Node a
forall a. Int -> a -> a -> a -> Node a
Node3 (Int
sxy Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
se) a
x a
y a
e)
where sa :: Int
sa = Node a -> Int
forall a. Sized a => a -> Int
size Node a
a
delDigit f :: Int -> Node a -> Del a
f i :: Int
i (Three a :: Node a
a b :: Node a
b c :: Node a
c)
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
sa = case Int -> Node a -> Del a
f Int
i Node a
a of
Full a' :: Node a
a' -> Digit (Node a) -> DelDig a
forall a. Digit (Node a) -> DelDig a
FullDig (Digit (Node a) -> DelDig a) -> Digit (Node a) -> DelDig a
forall a b. (a -> b) -> a -> b
$ Node a -> Node a -> Node a -> Digit (Node a)
forall a. a -> a -> a -> Digit a
Three Node a
a' Node a
b Node a
c
Defect e :: a
e -> let !se :: Int
se = a -> Int
forall a. Sized a => a -> Int
size a
e in case Node a
b of
Node3 sxyz :: Int
sxyz x :: a
x y :: a
y z :: a
z -> Digit (Node a) -> DelDig a
forall a. Digit (Node a) -> DelDig a
FullDig (Digit (Node a) -> DelDig a) -> Digit (Node a) -> DelDig a
forall a b. (a -> b) -> a -> b
$ Node a -> Node a -> Node a -> Digit (Node a)
forall a. a -> a -> a -> Digit a
Three (Int -> a -> a -> Node a
forall a. Int -> a -> a -> Node a
Node2 (Int
se Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
sx) a
e a
x) (Int -> a -> a -> Node a
forall a. Int -> a -> a -> Node a
Node2 (Int
sxyz Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sx) a
y a
z) Node a
c
where !sx :: Int
sx = a -> Int
forall a. Sized a => a -> Int
size a
x
Node2 sxy :: Int
sxy x :: a
x y :: a
y -> Digit (Node a) -> DelDig a
forall a. Digit (Node a) -> DelDig a
FullDig (Digit (Node a) -> DelDig a) -> Digit (Node a) -> DelDig a
forall a b. (a -> b) -> a -> b
$ Node a -> Node a -> Digit (Node a)
forall a. a -> a -> Digit a
Two (Int -> a -> a -> a -> Node a
forall a. Int -> a -> a -> a -> Node a
Node3 (Int
se Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
sxy) a
e a
x a
y) Node a
c
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
sab = case Int -> Node a -> Del a
f (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sa) Node a
b of
Full b' :: Node a
b' -> Digit (Node a) -> DelDig a
forall a. Digit (Node a) -> DelDig a
FullDig (Digit (Node a) -> DelDig a) -> Digit (Node a) -> DelDig a
forall a b. (a -> b) -> a -> b
$ Node a -> Node a -> Node a -> Digit (Node a)
forall a. a -> a -> a -> Digit a
Three Node a
a Node a
b' Node a
c
Defect e :: a
e -> let !se :: Int
se = a -> Int
forall a. Sized a => a -> Int
size a
e in case Node a
a of
Node3 sxyz :: Int
sxyz x :: a
x y :: a
y z :: a
z -> Digit (Node a) -> DelDig a
forall a. Digit (Node a) -> DelDig a
FullDig (Digit (Node a) -> DelDig a) -> Digit (Node a) -> DelDig a
forall a b. (a -> b) -> a -> b
$ Node a -> Node a -> Node a -> Digit (Node a)
forall a. a -> a -> a -> Digit a
Three (Int -> a -> a -> Node a
forall a. Int -> a -> a -> Node a
Node2 (Int
sxyz Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sz) a
x a
y) (Int -> a -> a -> Node a
forall a. Int -> a -> a -> Node a
Node2 (Int
sz Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
se) a
z a
e) Node a
c
where !sz :: Int
sz = a -> Int
forall a. Sized a => a -> Int
size a
z
Node2 sxy :: Int
sxy x :: a
x y :: a
y -> Digit (Node a) -> DelDig a
forall a. Digit (Node a) -> DelDig a
FullDig (Digit (Node a) -> DelDig a) -> Digit (Node a) -> DelDig a
forall a b. (a -> b) -> a -> b
$ Node a -> Node a -> Digit (Node a)
forall a. a -> a -> Digit a
Two (Int -> a -> a -> a -> Node a
forall a. Int -> a -> a -> a -> Node a
Node3 (Int
sxy Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
se) a
x a
y a
e) Node a
c
| Bool
otherwise = case Int -> Node a -> Del a
f (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sab) Node a
c of
Full c' :: Node a
c' -> Digit (Node a) -> DelDig a
forall a. Digit (Node a) -> DelDig a
FullDig (Digit (Node a) -> DelDig a) -> Digit (Node a) -> DelDig a
forall a b. (a -> b) -> a -> b
$ Node a -> Node a -> Node a -> Digit (Node a)
forall a. a -> a -> a -> Digit a
Three Node a
a Node a
b Node a
c'
Defect e :: a
e -> let !se :: Int
se = a -> Int
forall a. Sized a => a -> Int
size a
e in case Node a
b of
Node3 sxyz :: Int
sxyz x :: a
x y :: a
y z :: a
z -> Digit (Node a) -> DelDig a
forall a. Digit (Node a) -> DelDig a
FullDig (Digit (Node a) -> DelDig a) -> Digit (Node a) -> DelDig a
forall a b. (a -> b) -> a -> b
$ Node a -> Node a -> Node a -> Digit (Node a)
forall a. a -> a -> a -> Digit a
Three Node a
a (Int -> a -> a -> Node a
forall a. Int -> a -> a -> Node a
Node2 (Int
sxyz Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sz) a
x a
y) (Int -> a -> a -> Node a
forall a. Int -> a -> a -> Node a
Node2 (Int
sz Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
se) a
z a
e)
where !sz :: Int
sz = a -> Int
forall a. Sized a => a -> Int
size a
z
Node2 sxy :: Int
sxy x :: a
x y :: a
y -> Digit (Node a) -> DelDig a
forall a. Digit (Node a) -> DelDig a
FullDig (Digit (Node a) -> DelDig a) -> Digit (Node a) -> DelDig a
forall a b. (a -> b) -> a -> b
$ Node a -> Node a -> Digit (Node a)
forall a. a -> a -> Digit a
Two Node a
a (Int -> a -> a -> a -> Node a
forall a. Int -> a -> a -> a -> Node a
Node3 (Int
sxy Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
se) a
x a
y a
e)
where sa :: Int
sa = Node a -> Int
forall a. Sized a => a -> Int
size Node a
a
sab :: Int
sab = Int
sa Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Node a -> Int
forall a. Sized a => a -> Int
size Node a
b
delDigit f :: Int -> Node a -> Del a
f i :: Int
i (Four a :: Node a
a b :: Node a
b c :: Node a
c d :: Node a
d)
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
sa = case Int -> Node a -> Del a
f Int
i Node a
a of
Full a' :: Node a
a' -> Digit (Node a) -> DelDig a
forall a. Digit (Node a) -> DelDig a
FullDig (Digit (Node a) -> DelDig a) -> Digit (Node a) -> DelDig a
forall a b. (a -> b) -> a -> b
$ Node a -> Node a -> Node a -> Node a -> Digit (Node a)
forall a. a -> a -> a -> a -> Digit a
Four Node a
a' Node a
b Node a
c Node a
d
Defect e :: a
e -> let !se :: Int
se = a -> Int
forall a. Sized a => a -> Int
size a
e in case Node a
b of
Node3 sxyz :: Int
sxyz x :: a
x y :: a
y z :: a
z -> Digit (Node a) -> DelDig a
forall a. Digit (Node a) -> DelDig a
FullDig (Digit (Node a) -> DelDig a) -> Digit (Node a) -> DelDig a
forall a b. (a -> b) -> a -> b
$ Node a -> Node a -> Node a -> Node a -> Digit (Node a)
forall a. a -> a -> a -> a -> Digit a
Four (Int -> a -> a -> Node a
forall a. Int -> a -> a -> Node a
Node2 (Int
se Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
sx) a
e a
x) (Int -> a -> a -> Node a
forall a. Int -> a -> a -> Node a
Node2 (Int
sxyz Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sx) a
y a
z) Node a
c Node a
d
where !sx :: Int
sx = a -> Int
forall a. Sized a => a -> Int
size a
x
Node2 sxy :: Int
sxy x :: a
x y :: a
y -> Digit (Node a) -> DelDig a
forall a. Digit (Node a) -> DelDig a
FullDig (Digit (Node a) -> DelDig a) -> Digit (Node a) -> DelDig a
forall a b. (a -> b) -> a -> b
$ Node a -> Node a -> Node a -> Digit (Node a)
forall a. a -> a -> a -> Digit a
Three (Int -> a -> a -> a -> Node a
forall a. Int -> a -> a -> a -> Node a
Node3 (Int
se Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
sxy) a
e a
x a
y) Node a
c Node a
d
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
sab = case Int -> Node a -> Del a
f (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sa) Node a
b of
Full b' :: Node a
b' -> Digit (Node a) -> DelDig a
forall a. Digit (Node a) -> DelDig a
FullDig (Digit (Node a) -> DelDig a) -> Digit (Node a) -> DelDig a
forall a b. (a -> b) -> a -> b
$ Node a -> Node a -> Node a -> Node a -> Digit (Node a)
forall a. a -> a -> a -> a -> Digit a
Four Node a
a Node a
b' Node a
c Node a
d
Defect e :: a
e -> let !se :: Int
se = a -> Int
forall a. Sized a => a -> Int
size a
e in case Node a
a of
Node3 sxyz :: Int
sxyz x :: a
x y :: a
y z :: a
z -> Digit (Node a) -> DelDig a
forall a. Digit (Node a) -> DelDig a
FullDig (Digit (Node a) -> DelDig a) -> Digit (Node a) -> DelDig a
forall a b. (a -> b) -> a -> b
$ Node a -> Node a -> Node a -> Node a -> Digit (Node a)
forall a. a -> a -> a -> a -> Digit a
Four (Int -> a -> a -> Node a
forall a. Int -> a -> a -> Node a
Node2 (Int
sxyz Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sz) a
x a
y) (Int -> a -> a -> Node a
forall a. Int -> a -> a -> Node a
Node2 (Int
sz Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
se) a
z a
e) Node a
c Node a
d
where !sz :: Int
sz = a -> Int
forall a. Sized a => a -> Int
size a
z
Node2 sxy :: Int
sxy x :: a
x y :: a
y -> Digit (Node a) -> DelDig a
forall a. Digit (Node a) -> DelDig a
FullDig (Digit (Node a) -> DelDig a) -> Digit (Node a) -> DelDig a
forall a b. (a -> b) -> a -> b
$ Node a -> Node a -> Node a -> Digit (Node a)
forall a. a -> a -> a -> Digit a
Three (Int -> a -> a -> a -> Node a
forall a. Int -> a -> a -> a -> Node a
Node3 (Int
sxy Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
se) a
x a
y a
e) Node a
c Node a
d
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
sabc = case Int -> Node a -> Del a
f (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sab) Node a
c of
Full c' :: Node a
c' -> Digit (Node a) -> DelDig a
forall a. Digit (Node a) -> DelDig a
FullDig (Digit (Node a) -> DelDig a) -> Digit (Node a) -> DelDig a
forall a b. (a -> b) -> a -> b
$ Node a -> Node a -> Node a -> Node a -> Digit (Node a)
forall a. a -> a -> a -> a -> Digit a
Four Node a
a Node a
b Node a
c' Node a
d
Defect e :: a
e -> let !se :: Int
se = a -> Int
forall a. Sized a => a -> Int
size a
e in case Node a
b of
Node3 sxyz :: Int
sxyz x :: a
x y :: a
y z :: a
z -> Digit (Node a) -> DelDig a
forall a. Digit (Node a) -> DelDig a
FullDig (Digit (Node a) -> DelDig a) -> Digit (Node a) -> DelDig a
forall a b. (a -> b) -> a -> b
$ Node a -> Node a -> Node a -> Node a -> Digit (Node a)
forall a. a -> a -> a -> a -> Digit a
Four Node a
a (Int -> a -> a -> Node a
forall a. Int -> a -> a -> Node a
Node2 (Int
sxyz Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sz) a
x a
y) (Int -> a -> a -> Node a
forall a. Int -> a -> a -> Node a
Node2 (Int
sz Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
se) a
z a
e) Node a
d
where !sz :: Int
sz = a -> Int
forall a. Sized a => a -> Int
size a
z
Node2 sxy :: Int
sxy x :: a
x y :: a
y -> Digit (Node a) -> DelDig a
forall a. Digit (Node a) -> DelDig a
FullDig (Digit (Node a) -> DelDig a) -> Digit (Node a) -> DelDig a
forall a b. (a -> b) -> a -> b
$ Node a -> Node a -> Node a -> Digit (Node a)
forall a. a -> a -> a -> Digit a
Three Node a
a (Int -> a -> a -> a -> Node a
forall a. Int -> a -> a -> a -> Node a
Node3 (Int
sxy Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
se) a
x a
y a
e) Node a
d
| Bool
otherwise = case Int -> Node a -> Del a
f (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sabc) Node a
d of
Full d' :: Node a
d' -> Digit (Node a) -> DelDig a
forall a. Digit (Node a) -> DelDig a
FullDig (Digit (Node a) -> DelDig a) -> Digit (Node a) -> DelDig a
forall a b. (a -> b) -> a -> b
$ Node a -> Node a -> Node a -> Node a -> Digit (Node a)
forall a. a -> a -> a -> a -> Digit a
Four Node a
a Node a
b Node a
c Node a
d'
Defect e :: a
e -> let !se :: Int
se = a -> Int
forall a. Sized a => a -> Int
size a
e in case Node a
c of
Node3 sxyz :: Int
sxyz x :: a
x y :: a
y z :: a
z -> Digit (Node a) -> DelDig a
forall a. Digit (Node a) -> DelDig a
FullDig (Digit (Node a) -> DelDig a) -> Digit (Node a) -> DelDig a
forall a b. (a -> b) -> a -> b
$ Node a -> Node a -> Node a -> Node a -> Digit (Node a)
forall a. a -> a -> a -> a -> Digit a
Four Node a
a Node a
b (Int -> a -> a -> Node a
forall a. Int -> a -> a -> Node a
Node2 (Int
sxyz Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sz) a
x a
y) (Int -> a -> a -> Node a
forall a. Int -> a -> a -> Node a
Node2 (Int
sz Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
se) a
z a
e)
where !sz :: Int
sz = a -> Int
forall a. Sized a => a -> Int
size a
z
Node2 sxy :: Int
sxy x :: a
x y :: a
y -> Digit (Node a) -> DelDig a
forall a. Digit (Node a) -> DelDig a
FullDig (Digit (Node a) -> DelDig a) -> Digit (Node a) -> DelDig a
forall a b. (a -> b) -> a -> b
$ Node a -> Node a -> Node a -> Digit (Node a)
forall a. a -> a -> a -> Digit a
Three Node a
a Node a
b (Int -> a -> a -> a -> Node a
forall a. Int -> a -> a -> a -> Node a
Node3 (Int
sxy Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
se) a
x a
y a
e)
where sa :: Int
sa = Node a -> Int
forall a. Sized a => a -> Int
size Node a
a
sab :: Int
sab = Int
sa Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Node a -> Int
forall a. Sized a => a -> Int
size Node a
b
sabc :: Int
sabc = Int
sab Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Node a -> Int
forall a. Sized a => a -> Int
size Node a
c
mapWithIndex :: (Int -> a -> b) -> Seq a -> Seq b
mapWithIndex :: (Int -> a -> b) -> Seq a -> Seq b
mapWithIndex f' :: Int -> a -> b
f' (Seq xs' :: FingerTree (Elem a)
xs') = FingerTree (Elem b) -> Seq b
forall a. FingerTree (Elem a) -> Seq a
Seq (FingerTree (Elem b) -> Seq b) -> FingerTree (Elem b) -> Seq b
forall a b. (a -> b) -> a -> b
$ (Int -> Elem a -> Elem b)
-> Int -> FingerTree (Elem a) -> FingerTree (Elem b)
forall a b.
Sized a =>
(Int -> a -> b) -> Int -> FingerTree a -> FingerTree b
mapWithIndexTree (\s :: Int
s (Elem a :: a
a) -> b -> Elem b
forall a. a -> Elem a
Elem (Int -> a -> b
f' Int
s a
a)) 0 FingerTree (Elem a)
xs'
where
{-# SPECIALIZE mapWithIndexTree :: (Int -> Elem y -> b) -> Int -> FingerTree (Elem y) -> FingerTree b #-}
{-# SPECIALIZE mapWithIndexTree :: (Int -> Node y -> b) -> Int -> FingerTree (Node y) -> FingerTree b #-}
mapWithIndexTree :: Sized a => (Int -> a -> b) -> Int -> FingerTree a -> FingerTree b
mapWithIndexTree :: (Int -> a -> b) -> Int -> FingerTree a -> FingerTree b
mapWithIndexTree _ !Int
_s EmptyT = FingerTree b
forall a. FingerTree a
EmptyT
mapWithIndexTree f :: Int -> a -> b
f s :: Int
s (Single xs :: a
xs) = b -> FingerTree b
forall a. a -> FingerTree a
Single (b -> FingerTree b) -> b -> FingerTree b
forall a b. (a -> b) -> a -> b
$ Int -> a -> b
f Int
s a
xs
mapWithIndexTree f :: Int -> a -> b
f s :: Int
s (Deep n :: Int
n 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
n
((Int -> a -> b) -> Int -> Digit a -> Digit b
forall a b. Sized a => (Int -> a -> b) -> Int -> Digit a -> Digit b
mapWithIndexDigit Int -> a -> b
f Int
s Digit a
pr)
((Int -> Node a -> Node b)
-> Int -> FingerTree (Node a) -> FingerTree (Node b)
forall a b.
Sized a =>
(Int -> a -> b) -> Int -> FingerTree a -> FingerTree b
mapWithIndexTree ((Int -> a -> b) -> Int -> Node a -> Node b
forall a b. Sized a => (Int -> a -> b) -> Int -> Node a -> Node b
mapWithIndexNode Int -> a -> b
f) Int
sPspr FingerTree (Node a)
m)
((Int -> a -> b) -> Int -> Digit a -> Digit b
forall a b. Sized a => (Int -> a -> b) -> Int -> Digit a -> Digit b
mapWithIndexDigit Int -> a -> b
f Int
sPsprm Digit a
sf)
where
!sPspr :: Int
sPspr = Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Digit a -> Int
forall a. Sized a => a -> Int
size Digit a
pr
!sPsprm :: Int
sPsprm = Int
sPspr 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 mapWithIndexDigit :: (Int -> Elem y -> b) -> Int -> Digit (Elem y) -> Digit b #-}
{-# SPECIALIZE mapWithIndexDigit :: (Int -> Node y -> b) -> Int -> Digit (Node y) -> Digit b #-}
mapWithIndexDigit :: Sized a => (Int -> a -> b) -> Int -> Digit a -> Digit b
mapWithIndexDigit :: (Int -> a -> b) -> Int -> Digit a -> Digit b
mapWithIndexDigit f :: Int -> a -> b
f !Int
s (One a :: a
a) = b -> Digit b
forall a. a -> Digit a
One (Int -> a -> b
f Int
s a
a)
mapWithIndexDigit f :: Int -> a -> b
f s :: Int
s (Two a :: a
a b :: a
b) = b -> b -> Digit b
forall a. a -> a -> Digit a
Two (Int -> a -> b
f Int
s a
a) (Int -> a -> b
f Int
sPsa a
b)
where
!sPsa :: Int
sPsa = Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
+ a -> Int
forall a. Sized a => a -> Int
size a
a
mapWithIndexDigit f :: Int -> a -> b
f s :: Int
s (Three a :: a
a b :: a
b c :: a
c) =
b -> b -> b -> Digit b
forall a. a -> a -> a -> Digit a
Three (Int -> a -> b
f Int
s a
a) (Int -> a -> b
f Int
sPsa a
b) (Int -> a -> b
f Int
sPsab a
c)
where
!sPsa :: Int
sPsa = Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
+ a -> Int
forall a. Sized a => a -> Int
size a
a
!sPsab :: Int
sPsab = Int
sPsa Int -> Int -> Int
forall a. Num a => a -> a -> a
+ a -> Int
forall a. Sized a => a -> Int
size a
b
mapWithIndexDigit f :: Int -> a -> b
f s :: Int
s (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 (Int -> a -> b
f Int
s a
a) (Int -> a -> b
f Int
sPsa a
b) (Int -> a -> b
f Int
sPsab a
c) (Int -> a -> b
f Int
sPsabc a
d)
where
!sPsa :: Int
sPsa = Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
+ a -> Int
forall a. Sized a => a -> Int
size a
a
!sPsab :: Int
sPsab = Int
sPsa Int -> Int -> Int
forall a. Num a => a -> a -> a
+ a -> Int
forall a. Sized a => a -> Int
size a
b
!sPsabc :: Int
sPsabc = Int
sPsab Int -> Int -> Int
forall a. Num a => a -> a -> a
+ a -> Int
forall a. Sized a => a -> Int
size a
c
{-# SPECIALIZE mapWithIndexNode :: (Int -> Elem y -> b) -> Int -> Node (Elem y) -> Node b #-}
{-# SPECIALIZE mapWithIndexNode :: (Int -> Node y -> b) -> Int -> Node (Node y) -> Node b #-}
mapWithIndexNode :: Sized a => (Int -> a -> b) -> Int -> Node a -> Node b
mapWithIndexNode :: (Int -> a -> b) -> Int -> Node a -> Node b
mapWithIndexNode f :: Int -> a -> b
f s :: Int
s (Node2 ns :: Int
ns a :: a
a b :: a
b) = Int -> b -> b -> Node b
forall a. Int -> a -> a -> Node a
Node2 Int
ns (Int -> a -> b
f Int
s a
a) (Int -> a -> b
f Int
sPsa a
b)
where
!sPsa :: Int
sPsa = Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
+ a -> Int
forall a. Sized a => a -> Int
size a
a
mapWithIndexNode f :: Int -> a -> b
f s :: Int
s (Node3 ns :: Int
ns 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
ns (Int -> a -> b
f Int
s a
a) (Int -> a -> b
f Int
sPsa a
b) (Int -> a -> b
f Int
sPsab a
c)
where
!sPsa :: Int
sPsa = Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
+ a -> Int
forall a. Sized a => a -> Int
size a
a
!sPsab :: Int
sPsab = Int
sPsa Int -> Int -> Int
forall a. Num a => a -> a -> a
+ a -> Int
forall a. Sized a => a -> Int
size a
b
#ifdef __GLASGOW_HASKELL__
{-# NOINLINE [1] mapWithIndex #-}
{-# RULES
"mapWithIndex/mapWithIndex" forall f g xs . mapWithIndex f (mapWithIndex g xs) =
mapWithIndex (\k a -> f k (g k a)) xs
"mapWithIndex/fmapSeq" forall f g xs . mapWithIndex f (fmapSeq g xs) =
mapWithIndex (\k a -> f k (g a)) xs
"fmapSeq/mapWithIndex" forall f g xs . fmapSeq f (mapWithIndex g xs) =
mapWithIndex (\k a -> f (g k a)) xs
#-}
#endif
{-# INLINE foldWithIndexDigit #-}
foldWithIndexDigit :: Sized a => (b -> b -> b) -> (Int -> a -> b) -> Int -> Digit a -> b
foldWithIndexDigit :: (b -> b -> b) -> (Int -> a -> b) -> Int -> Digit a -> b
foldWithIndexDigit _ f :: Int -> a -> b
f !Int
s (One a :: a
a) = Int -> a -> b
f Int
s a
a
foldWithIndexDigit <+> :: b -> b -> b
(<+>) f :: Int -> a -> b
f s :: Int
s (Two a :: a
a b :: a
b) = Int -> a -> b
f Int
s a
a b -> b -> b
<+> Int -> a -> b
f Int
sPsa a
b
where
!sPsa :: Int
sPsa = Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
+ a -> Int
forall a. Sized a => a -> Int
size a
a
foldWithIndexDigit <+> :: b -> b -> b
(<+>) f :: Int -> a -> b
f s :: Int
s (Three a :: a
a b :: a
b c :: a
c) = Int -> a -> b
f Int
s a
a b -> b -> b
<+> Int -> a -> b
f Int
sPsa a
b b -> b -> b
<+> Int -> a -> b
f Int
sPsab a
c
where
!sPsa :: Int
sPsa = Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
+ a -> Int
forall a. Sized a => a -> Int
size a
a
!sPsab :: Int
sPsab = Int
sPsa Int -> Int -> Int
forall a. Num a => a -> a -> a
+ a -> Int
forall a. Sized a => a -> Int
size a
b
foldWithIndexDigit <+> :: b -> b -> b
(<+>) f :: Int -> a -> b
f s :: Int
s (Four a :: a
a b :: a
b c :: a
c d :: a
d) =
Int -> a -> b
f Int
s a
a b -> b -> b
<+> Int -> a -> b
f Int
sPsa a
b b -> b -> b
<+> Int -> a -> b
f Int
sPsab a
c b -> b -> b
<+> Int -> a -> b
f Int
sPsabc a
d
where
!sPsa :: Int
sPsa = Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
+ a -> Int
forall a. Sized a => a -> Int
size a
a
!sPsab :: Int
sPsab = Int
sPsa Int -> Int -> Int
forall a. Num a => a -> a -> a
+ a -> Int
forall a. Sized a => a -> Int
size a
b
!sPsabc :: Int
sPsabc = Int
sPsab Int -> Int -> Int
forall a. Num a => a -> a -> a
+ a -> Int
forall a. Sized a => a -> Int
size a
c
{-# INLINE foldWithIndexNode #-}
foldWithIndexNode :: Sized a => (m -> m -> m) -> (Int -> a -> m) -> Int -> Node a -> m
foldWithIndexNode :: (m -> m -> m) -> (Int -> a -> m) -> Int -> Node a -> m
foldWithIndexNode <+> :: m -> m -> m
(<+>) f :: Int -> a -> m
f !Int
s (Node2 _ a :: a
a b :: a
b) = Int -> a -> m
f Int
s a
a m -> m -> m
<+> Int -> a -> m
f Int
sPsa a
b
where
!sPsa :: Int
sPsa = Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
+ a -> Int
forall a. Sized a => a -> Int
size a
a
foldWithIndexNode <+> :: m -> m -> m
(<+>) f :: Int -> a -> m
f s :: Int
s (Node3 _ a :: a
a b :: a
b c :: a
c) = Int -> a -> m
f Int
s a
a m -> m -> m
<+> Int -> a -> m
f Int
sPsa a
b m -> m -> m
<+> Int -> a -> m
f Int
sPsab a
c
where
!sPsa :: Int
sPsa = Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
+ a -> Int
forall a. Sized a => a -> Int
size a
a
!sPsab :: Int
sPsab = Int
sPsa Int -> Int -> Int
forall a. Num a => a -> a -> a
+ a -> Int
forall a. Sized a => a -> Int
size a
b
foldMapWithIndex :: Monoid m => (Int -> a -> m) -> Seq a -> m
foldMapWithIndex :: (Int -> a -> m) -> Seq a -> m
foldMapWithIndex f' :: Int -> a -> m
f' (Seq xs' :: FingerTree (Elem a)
xs') = (Int -> Elem a -> m) -> Int -> FingerTree (Elem a) -> m
forall m a.
Monoid m =>
(Int -> Elem a -> m) -> Int -> FingerTree (Elem a) -> m
foldMapWithIndexTreeE ((Int -> a -> m) -> Int -> Elem a -> m
forall a m. (Int -> a -> m) -> Int -> Elem a -> m
lift_elem Int -> a -> m
f') 0 FingerTree (Elem a)
xs'
where
lift_elem :: (Int -> a -> m) -> (Int -> Elem a -> m)
#if __GLASGOW_HASKELL__ >= 708
lift_elem :: (Int -> a -> m) -> Int -> Elem a -> m
lift_elem g :: Int -> a -> m
g = (Int -> a -> m) -> Int -> Elem a -> m
forall a b. Coercible a b => a -> b
coerce Int -> a -> m
g
#else
lift_elem g = \s (Elem a) -> g s a
#endif
{-# INLINE lift_elem #-}
foldMapWithIndexTreeE :: Monoid m => (Int -> Elem a -> m) -> Int -> FingerTree (Elem a) -> m
foldMapWithIndexTreeE :: (Int -> Elem a -> m) -> Int -> FingerTree (Elem a) -> m
foldMapWithIndexTreeE _ !Int
_s EmptyT = m
forall a. Monoid a => a
mempty
foldMapWithIndexTreeE f :: Int -> Elem a -> m
f s :: Int
s (Single xs :: Elem a
xs) = Int -> Elem a -> m
f Int
s Elem a
xs
foldMapWithIndexTreeE f :: Int -> Elem a -> m
f s :: Int
s (Deep _ pr :: Digit (Elem a)
pr m :: FingerTree (Node (Elem a))
m sf :: Digit (Elem a)
sf) =
(Int -> Elem a -> m) -> Int -> Digit (Elem a) -> m
forall m a.
Monoid m =>
(Int -> Elem a -> m) -> Int -> Digit (Elem a) -> m
foldMapWithIndexDigitE Int -> Elem a -> m
f Int
s Digit (Elem a)
pr m -> m -> m
forall a. Monoid a => a -> a -> a
<>
(Int -> Node (Elem a) -> m)
-> Int -> FingerTree (Node (Elem a)) -> m
forall m a.
Monoid m =>
(Int -> Node a -> m) -> Int -> FingerTree (Node a) -> m
foldMapWithIndexTreeN ((Int -> Elem a -> m) -> Int -> Node (Elem a) -> m
forall m a.
Monoid m =>
(Int -> Elem a -> m) -> Int -> Node (Elem a) -> m
foldMapWithIndexNodeE Int -> Elem a -> m
f) Int
sPspr FingerTree (Node (Elem a))
m m -> m -> m
forall a. Monoid a => a -> a -> a
<>
(Int -> Elem a -> m) -> Int -> Digit (Elem a) -> m
forall m a.
Monoid m =>
(Int -> Elem a -> m) -> Int -> Digit (Elem a) -> m
foldMapWithIndexDigitE Int -> Elem a -> m
f Int
sPsprm Digit (Elem a)
sf
where
!sPspr :: Int
sPspr = Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Digit (Elem a) -> Int
forall a. Sized a => a -> Int
size Digit (Elem a)
pr
!sPsprm :: Int
sPsprm = Int
sPspr Int -> Int -> Int
forall a. Num a => a -> a -> a
+ FingerTree (Node (Elem a)) -> Int
forall a. Sized a => a -> Int
size FingerTree (Node (Elem a))
m
foldMapWithIndexTreeN :: Monoid m => (Int -> Node a -> m) -> Int -> FingerTree (Node a) -> m
foldMapWithIndexTreeN :: (Int -> Node a -> m) -> Int -> FingerTree (Node a) -> m
foldMapWithIndexTreeN _ !Int
_s EmptyT = m
forall a. Monoid a => a
mempty
foldMapWithIndexTreeN f :: Int -> Node a -> m
f s :: Int
s (Single xs :: Node a
xs) = Int -> Node a -> m
f Int
s Node a
xs
foldMapWithIndexTreeN f :: Int -> Node a -> m
f s :: Int
s (Deep _ pr :: Digit (Node a)
pr m :: FingerTree (Node (Node a))
m sf :: Digit (Node a)
sf) =
(Int -> Node a -> m) -> Int -> Digit (Node a) -> m
forall m a.
Monoid m =>
(Int -> Node a -> m) -> Int -> Digit (Node a) -> m
foldMapWithIndexDigitN Int -> Node a -> m
f Int
s Digit (Node a)
pr m -> m -> m
forall a. Monoid a => a -> a -> a
<>
(Int -> Node (Node a) -> m)
-> Int -> FingerTree (Node (Node a)) -> m
forall m a.
Monoid m =>
(Int -> Node a -> m) -> Int -> FingerTree (Node a) -> m
foldMapWithIndexTreeN ((Int -> Node a -> m) -> Int -> Node (Node a) -> m
forall m a.
Monoid m =>
(Int -> Node a -> m) -> Int -> Node (Node a) -> m
foldMapWithIndexNodeN Int -> Node a -> m
f) Int
sPspr FingerTree (Node (Node a))
m m -> m -> m
forall a. Monoid a => a -> a -> a
<>
(Int -> Node a -> m) -> Int -> Digit (Node a) -> m
forall m a.
Monoid m =>
(Int -> Node a -> m) -> Int -> Digit (Node a) -> m
foldMapWithIndexDigitN Int -> Node a -> m
f Int
sPsprm Digit (Node a)
sf
where
!sPspr :: Int
sPspr = Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Digit (Node a) -> Int
forall a. Sized a => a -> Int
size Digit (Node a)
pr
!sPsprm :: Int
sPsprm = Int
sPspr Int -> Int -> Int
forall a. Num a => a -> a -> a
+ FingerTree (Node (Node a)) -> Int
forall a. Sized a => a -> Int
size FingerTree (Node (Node a))
m
foldMapWithIndexDigitE :: Monoid m => (Int -> Elem a -> m) -> Int -> Digit (Elem a) -> m
foldMapWithIndexDigitE :: (Int -> Elem a -> m) -> Int -> Digit (Elem a) -> m
foldMapWithIndexDigitE f :: Int -> Elem a -> m
f i :: Int
i t :: Digit (Elem a)
t = (m -> m -> m) -> (Int -> Elem a -> m) -> Int -> Digit (Elem a) -> m
forall a b.
Sized a =>
(b -> b -> b) -> (Int -> a -> b) -> Int -> Digit a -> b
foldWithIndexDigit m -> m -> m
forall a. Monoid a => a -> a -> a
(<>) Int -> Elem a -> m
f Int
i Digit (Elem a)
t
foldMapWithIndexDigitN :: Monoid m => (Int -> Node a -> m) -> Int -> Digit (Node a) -> m
foldMapWithIndexDigitN :: (Int -> Node a -> m) -> Int -> Digit (Node a) -> m
foldMapWithIndexDigitN f :: Int -> Node a -> m
f i :: Int
i t :: Digit (Node a)
t = (m -> m -> m) -> (Int -> Node a -> m) -> Int -> Digit (Node a) -> m
forall a b.
Sized a =>
(b -> b -> b) -> (Int -> a -> b) -> Int -> Digit a -> b
foldWithIndexDigit m -> m -> m
forall a. Monoid a => a -> a -> a
(<>) Int -> Node a -> m
f Int
i Digit (Node a)
t
foldMapWithIndexNodeE :: Monoid m => (Int -> Elem a -> m) -> Int -> Node (Elem a) -> m
foldMapWithIndexNodeE :: (Int -> Elem a -> m) -> Int -> Node (Elem a) -> m
foldMapWithIndexNodeE f :: Int -> Elem a -> m
f i :: Int
i t :: Node (Elem a)
t = (m -> m -> m) -> (Int -> Elem a -> m) -> Int -> Node (Elem a) -> m
forall a m.
Sized a =>
(m -> m -> m) -> (Int -> a -> m) -> Int -> Node a -> m
foldWithIndexNode m -> m -> m
forall a. Monoid a => a -> a -> a
(<>) Int -> Elem a -> m
f Int
i Node (Elem a)
t
foldMapWithIndexNodeN :: Monoid m => (Int -> Node a -> m) -> Int -> Node (Node a) -> m
foldMapWithIndexNodeN :: (Int -> Node a -> m) -> Int -> Node (Node a) -> m
foldMapWithIndexNodeN f :: Int -> Node a -> m
f i :: Int
i t :: Node (Node a)
t = (m -> m -> m) -> (Int -> Node a -> m) -> Int -> Node (Node a) -> m
forall a m.
Sized a =>
(m -> m -> m) -> (Int -> a -> m) -> Int -> Node a -> m
foldWithIndexNode m -> m -> m
forall a. Monoid a => a -> a -> a
(<>) Int -> Node a -> m
f Int
i Node (Node a)
t
#if __GLASGOW_HASKELL__
{-# INLINABLE foldMapWithIndex #-}
#endif
traverseWithIndex :: Applicative f => (Int -> a -> f b) -> Seq a -> f (Seq b)
traverseWithIndex :: (Int -> a -> f b) -> Seq a -> f (Seq b)
traverseWithIndex f' :: Int -> a -> f b
f' (Seq xs' :: FingerTree (Elem a)
xs') = FingerTree (Elem b) -> Seq b
forall a. FingerTree (Elem a) -> Seq a
Seq (FingerTree (Elem b) -> Seq b)
-> f (FingerTree (Elem b)) -> f (Seq b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> Elem a -> f (Elem b))
-> Int -> FingerTree (Elem a) -> f (FingerTree (Elem b))
forall (f :: * -> *) a b.
Applicative f =>
(Int -> Elem a -> f b)
-> Int -> FingerTree (Elem a) -> f (FingerTree b)
traverseWithIndexTreeE (\s :: Int
s (Elem a :: a
a) -> b -> Elem b
forall a. a -> Elem a
Elem (b -> Elem b) -> f b -> f (Elem b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> a -> f b
f' Int
s a
a) 0 FingerTree (Elem a)
xs'
where
traverseWithIndexTreeE :: Applicative f => (Int -> Elem a -> f b) -> Int -> FingerTree (Elem a) -> f (FingerTree b)
traverseWithIndexTreeE :: (Int -> Elem a -> f b)
-> Int -> FingerTree (Elem a) -> f (FingerTree b)
traverseWithIndexTreeE _ !Int
_s EmptyT = FingerTree b -> f (FingerTree b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure FingerTree b
forall a. FingerTree a
EmptyT
traverseWithIndexTreeE f :: Int -> Elem a -> f b
f s :: Int
s (Single xs :: Elem a
xs) = b -> FingerTree b
forall a. a -> FingerTree a
Single (b -> FingerTree b) -> f b -> f (FingerTree b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Elem a -> f b
f Int
s Elem a
xs
traverseWithIndexTreeE f :: Int -> Elem a -> f b
f s :: Int
s (Deep n :: Int
n pr :: Digit (Elem a)
pr m :: FingerTree (Node (Elem a))
m sf :: Digit (Elem a)
sf) =
(Digit b -> FingerTree (Node b) -> Digit b -> FingerTree b)
-> f (Digit b)
-> f (FingerTree (Node b))
-> f (Digit b)
-> f (FingerTree b)
forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3 (Int -> Digit b -> FingerTree (Node b) -> Digit b -> FingerTree b
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
n)
((Int -> Elem a -> f b) -> Int -> Digit (Elem a) -> f (Digit b)
forall (f :: * -> *) a b.
Applicative f =>
(Int -> Elem a -> f b) -> Int -> Digit (Elem a) -> f (Digit b)
traverseWithIndexDigitE Int -> Elem a -> f b
f Int
s Digit (Elem a)
pr)
((Int -> Node (Elem a) -> f (Node b))
-> Int -> FingerTree (Node (Elem a)) -> f (FingerTree (Node b))
forall (f :: * -> *) a b.
Applicative f =>
(Int -> Node a -> f b)
-> Int -> FingerTree (Node a) -> f (FingerTree b)
traverseWithIndexTreeN ((Int -> Elem a -> f b) -> Int -> Node (Elem a) -> f (Node b)
forall (f :: * -> *) a b.
Applicative f =>
(Int -> Elem a -> f b) -> Int -> Node (Elem a) -> f (Node b)
traverseWithIndexNodeE Int -> Elem a -> f b
f) Int
sPspr FingerTree (Node (Elem a))
m)
((Int -> Elem a -> f b) -> Int -> Digit (Elem a) -> f (Digit b)
forall (f :: * -> *) a b.
Applicative f =>
(Int -> Elem a -> f b) -> Int -> Digit (Elem a) -> f (Digit b)
traverseWithIndexDigitE Int -> Elem a -> f b
f Int
sPsprm Digit (Elem a)
sf)
where
!sPspr :: Int
sPspr = Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Digit (Elem a) -> Int
forall a. Sized a => a -> Int
size Digit (Elem a)
pr
!sPsprm :: Int
sPsprm = Int
sPspr Int -> Int -> Int
forall a. Num a => a -> a -> a
+ FingerTree (Node (Elem a)) -> Int
forall a. Sized a => a -> Int
size FingerTree (Node (Elem a))
m
traverseWithIndexTreeN :: Applicative f => (Int -> Node a -> f b) -> Int -> FingerTree (Node a) -> f (FingerTree b)
traverseWithIndexTreeN :: (Int -> Node a -> f b)
-> Int -> FingerTree (Node a) -> f (FingerTree b)
traverseWithIndexTreeN _ !Int
_s EmptyT = FingerTree b -> f (FingerTree b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure FingerTree b
forall a. FingerTree a
EmptyT
traverseWithIndexTreeN f :: Int -> Node a -> f b
f s :: Int
s (Single xs :: Node a
xs) = b -> FingerTree b
forall a. a -> FingerTree a
Single (b -> FingerTree b) -> f b -> f (FingerTree b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Node a -> f b
f Int
s Node a
xs
traverseWithIndexTreeN f :: Int -> Node a -> f b
f s :: Int
s (Deep n :: Int
n pr :: Digit (Node a)
pr m :: FingerTree (Node (Node a))
m sf :: Digit (Node a)
sf) =
(Digit b -> FingerTree (Node b) -> Digit b -> FingerTree b)
-> f (Digit b)
-> f (FingerTree (Node b))
-> f (Digit b)
-> f (FingerTree b)
forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3 (Int -> Digit b -> FingerTree (Node b) -> Digit b -> FingerTree b
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
n)
((Int -> Node a -> f b) -> Int -> Digit (Node a) -> f (Digit b)
forall (f :: * -> *) a b.
Applicative f =>
(Int -> Node a -> f b) -> Int -> Digit (Node a) -> f (Digit b)
traverseWithIndexDigitN Int -> Node a -> f b
f Int
s Digit (Node a)
pr)
((Int -> Node (Node a) -> f (Node b))
-> Int -> FingerTree (Node (Node a)) -> f (FingerTree (Node b))
forall (f :: * -> *) a b.
Applicative f =>
(Int -> Node a -> f b)
-> Int -> FingerTree (Node a) -> f (FingerTree b)
traverseWithIndexTreeN ((Int -> Node a -> f b) -> Int -> Node (Node a) -> f (Node b)
forall (f :: * -> *) a b.
Applicative f =>
(Int -> Node a -> f b) -> Int -> Node (Node a) -> f (Node b)
traverseWithIndexNodeN Int -> Node a -> f b
f) Int
sPspr FingerTree (Node (Node a))
m)
((Int -> Node a -> f b) -> Int -> Digit (Node a) -> f (Digit b)
forall (f :: * -> *) a b.
Applicative f =>
(Int -> Node a -> f b) -> Int -> Digit (Node a) -> f (Digit b)
traverseWithIndexDigitN Int -> Node a -> f b
f Int
sPsprm Digit (Node a)
sf)
where
!sPspr :: Int
sPspr = Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Digit (Node a) -> Int
forall a. Sized a => a -> Int
size Digit (Node a)
pr
!sPsprm :: Int
sPsprm = Int
sPspr Int -> Int -> Int
forall a. Num a => a -> a -> a
+ FingerTree (Node (Node a)) -> Int
forall a. Sized a => a -> Int
size FingerTree (Node (Node a))
m
traverseWithIndexDigitE :: Applicative f => (Int -> Elem a -> f b) -> Int -> Digit (Elem a) -> f (Digit b)
traverseWithIndexDigitE :: (Int -> Elem a -> f b) -> Int -> Digit (Elem a) -> f (Digit b)
traverseWithIndexDigitE f :: Int -> Elem a -> f b
f i :: Int
i t :: Digit (Elem a)
t = (Int -> Elem a -> f b) -> Int -> Digit (Elem a) -> f (Digit b)
forall (f :: * -> *) a b.
(Applicative f, Sized a) =>
(Int -> a -> f b) -> Int -> Digit a -> f (Digit b)
traverseWithIndexDigit Int -> Elem a -> f b
f Int
i Digit (Elem a)
t
traverseWithIndexDigitN :: Applicative f => (Int -> Node a -> f b) -> Int -> Digit (Node a) -> f (Digit b)
traverseWithIndexDigitN :: (Int -> Node a -> f b) -> Int -> Digit (Node a) -> f (Digit b)
traverseWithIndexDigitN f :: Int -> Node a -> f b
f i :: Int
i t :: Digit (Node a)
t = (Int -> Node a -> f b) -> Int -> Digit (Node a) -> f (Digit b)
forall (f :: * -> *) a b.
(Applicative f, Sized a) =>
(Int -> a -> f b) -> Int -> Digit a -> f (Digit b)
traverseWithIndexDigit Int -> Node a -> f b
f Int
i Digit (Node a)
t
{-# INLINE traverseWithIndexDigit #-}
traverseWithIndexDigit :: (Applicative f, Sized a) => (Int -> a -> f b) -> Int -> Digit a -> f (Digit b)
traverseWithIndexDigit :: (Int -> a -> f b) -> Int -> Digit a -> f (Digit b)
traverseWithIndexDigit f :: Int -> a -> f b
f !Int
s (One a :: a
a) = b -> Digit b
forall a. a -> Digit a
One (b -> Digit b) -> f b -> f (Digit b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> a -> f b
f Int
s a
a
traverseWithIndexDigit f :: Int -> a -> f b
f s :: Int
s (Two a :: a
a b :: a
b) = (b -> b -> Digit b) -> f b -> f b -> f (Digit b)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 b -> b -> Digit b
forall a. a -> a -> Digit a
Two (Int -> a -> f b
f Int
s a
a) (Int -> a -> f b
f Int
sPsa a
b)
where
!sPsa :: Int
sPsa = Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
+ a -> Int
forall a. Sized a => a -> Int
size a
a
traverseWithIndexDigit f :: Int -> a -> f b
f s :: Int
s (Three a :: a
a b :: a
b c :: a
c) =
(b -> b -> b -> Digit b) -> f b -> f b -> f b -> f (Digit b)
forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3 b -> b -> b -> Digit b
forall a. a -> a -> a -> Digit a
Three (Int -> a -> f b
f Int
s a
a) (Int -> a -> f b
f Int
sPsa a
b) (Int -> a -> f b
f Int
sPsab a
c)
where
!sPsa :: Int
sPsa = Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
+ a -> Int
forall a. Sized a => a -> Int
size a
a
!sPsab :: Int
sPsab = Int
sPsa Int -> Int -> Int
forall a. Num a => a -> a -> a
+ a -> Int
forall a. Sized a => a -> Int
size a
b
traverseWithIndexDigit f :: Int -> a -> f b
f s :: Int
s (Four a :: a
a b :: a
b c :: a
c d :: a
d) =
(b -> b -> b -> b -> Digit b)
-> f b -> f b -> f b -> f (b -> Digit b)
forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3 b -> b -> b -> b -> Digit b
forall a. a -> a -> a -> a -> Digit a
Four (Int -> a -> f b
f Int
s a
a) (Int -> a -> f b
f Int
sPsa a
b) (Int -> a -> f b
f Int
sPsab a
c) f (b -> Digit b) -> f b -> f (Digit b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> a -> f b
f Int
sPsabc a
d
where
!sPsa :: Int
sPsa = Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
+ a -> Int
forall a. Sized a => a -> Int
size a
a
!sPsab :: Int
sPsab = Int
sPsa Int -> Int -> Int
forall a. Num a => a -> a -> a
+ a -> Int
forall a. Sized a => a -> Int
size a
b
!sPsabc :: Int
sPsabc = Int
sPsab Int -> Int -> Int
forall a. Num a => a -> a -> a
+ a -> Int
forall a. Sized a => a -> Int
size a
c
traverseWithIndexNodeE :: Applicative f => (Int -> Elem a -> f b) -> Int -> Node (Elem a) -> f (Node b)
traverseWithIndexNodeE :: (Int -> Elem a -> f b) -> Int -> Node (Elem a) -> f (Node b)
traverseWithIndexNodeE f :: Int -> Elem a -> f b
f i :: Int
i t :: Node (Elem a)
t = (Int -> Elem a -> f b) -> Int -> Node (Elem a) -> f (Node b)
forall (f :: * -> *) a b.
(Applicative f, Sized a) =>
(Int -> a -> f b) -> Int -> Node a -> f (Node b)
traverseWithIndexNode Int -> Elem a -> f b
f Int
i Node (Elem a)
t
traverseWithIndexNodeN :: Applicative f => (Int -> Node a -> f b) -> Int -> Node (Node a) -> f (Node b)
traverseWithIndexNodeN :: (Int -> Node a -> f b) -> Int -> Node (Node a) -> f (Node b)
traverseWithIndexNodeN f :: Int -> Node a -> f b
f i :: Int
i t :: Node (Node a)
t = (Int -> Node a -> f b) -> Int -> Node (Node a) -> f (Node b)
forall (f :: * -> *) a b.
(Applicative f, Sized a) =>
(Int -> a -> f b) -> Int -> Node a -> f (Node b)
traverseWithIndexNode Int -> Node a -> f b
f Int
i Node (Node a)
t
{-# INLINE traverseWithIndexNode #-}
traverseWithIndexNode :: (Applicative f, Sized a) => (Int -> a -> f b) -> Int -> Node a -> f (Node b)
traverseWithIndexNode :: (Int -> a -> f b) -> Int -> Node a -> f (Node b)
traverseWithIndexNode f :: Int -> a -> f b
f !Int
s (Node2 ns :: Int
ns a :: a
a b :: a
b) = (b -> b -> Node b) -> f b -> f b -> f (Node b)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (Int -> b -> b -> Node b
forall a. Int -> a -> a -> Node a
Node2 Int
ns) (Int -> a -> f b
f Int
s a
a) (Int -> a -> f b
f Int
sPsa a
b)
where
!sPsa :: Int
sPsa = Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
+ a -> Int
forall a. Sized a => a -> Int
size a
a
traverseWithIndexNode f :: Int -> a -> f b
f s :: Int
s (Node3 ns :: Int
ns a :: a
a b :: a
b c :: a
c) =
(b -> b -> b -> Node b) -> f b -> f b -> f b -> f (Node b)
forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3 (Int -> b -> b -> b -> Node b
forall a. Int -> a -> a -> a -> Node a
Node3 Int
ns) (Int -> a -> f b
f Int
s a
a) (Int -> a -> f b
f Int
sPsa a
b) (Int -> a -> f b
f Int
sPsab a
c)
where
!sPsa :: Int
sPsa = Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
+ a -> Int
forall a. Sized a => a -> Int
size a
a
!sPsab :: Int
sPsab = Int
sPsa Int -> Int -> Int
forall a. Num a => a -> a -> a
+ a -> Int
forall a. Sized a => a -> Int
size a
b
#ifdef __GLASGOW_HASKELL__
{-# INLINABLE [1] traverseWithIndex #-}
#else
{-# INLINE [1] traverseWithIndex #-}
#endif
#ifdef __GLASGOW_HASKELL__
{-# RULES
"travWithIndex/mapWithIndex" forall f g xs . traverseWithIndex f (mapWithIndex g xs) =
traverseWithIndex (\k a -> f k (g k a)) xs
"travWithIndex/fmapSeq" forall f g xs . traverseWithIndex f (fmapSeq g xs) =
traverseWithIndex (\k a -> f k (g a)) xs
#-}
#endif
fromFunction :: Int -> (Int -> a) -> Seq a
fromFunction :: Int -> (Int -> a) -> Seq a
fromFunction len :: Int
len f :: Int -> a
f | Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 0 = [Char] -> Seq a
forall a. HasCallStack => [Char] -> a
error "Data.Sequence.fromFunction called with negative len"
| Int
len Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0 = Seq a
forall a. Seq a
empty
| Bool
otherwise = FingerTree (Elem a) -> Seq a
forall a. FingerTree (Elem a) -> Seq a
Seq (FingerTree (Elem a) -> Seq a) -> FingerTree (Elem a) -> Seq a
forall a b. (a -> b) -> a -> b
$ (Int -> Elem a) -> Int -> Int -> Int -> FingerTree (Elem a)
forall a. (Int -> a) -> Int -> Int -> Int -> FingerTree a
create ((Int -> a) -> Int -> Elem a
forall a. (Int -> a) -> Int -> Elem a
lift_elem Int -> a
f) 1 0 Int
len
where
create :: (Int -> a) -> Int -> Int -> Int -> FingerTree a
create :: (Int -> a) -> Int -> Int -> Int -> FingerTree a
create b :: Int -> a
b !Int
s !Int
i trees :: Int
trees = case Int
trees of
1 -> a -> FingerTree a
forall a. a -> FingerTree a
Single (a -> FingerTree a) -> a -> FingerTree a
forall a b. (a -> b) -> a -> b
$ Int -> a
b Int
i
2 -> Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
s) (a -> Digit a
forall a. a -> Digit a
One (Int -> a
b Int
i)) FingerTree (Node a)
forall a. FingerTree a
EmptyT (a -> Digit a
forall a. a -> Digit a
One (Int -> a
b (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
s)))
3 -> Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (3Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
s) (Int -> Digit a
createTwo Int
i) FingerTree (Node a)
forall a. FingerTree a
EmptyT (a -> Digit a
forall a. a -> Digit a
One (Int -> a
b (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
s)))
4 -> Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (4Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
s) (Int -> Digit a
createTwo Int
i) FingerTree (Node a)
forall a. FingerTree a
EmptyT (Int -> Digit a
createTwo (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
s))
5 -> Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (5Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
s) (Int -> Digit a
createThree Int
i) FingerTree (Node a)
forall a. FingerTree a
EmptyT (Int -> Digit a
createTwo (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+3Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
s))
6 -> Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (6Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
s) (Int -> Digit a
createThree Int
i) FingerTree (Node a)
forall a. FingerTree a
EmptyT (Int -> Digit a
createThree (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+3Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
s))
_ -> case Int
trees Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`quotRem` 3 of
(trees' :: Int
trees', 1) -> Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
treesInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
s) (Int -> Digit a
createTwo Int
i)
((Int -> Node a) -> Int -> Int -> Int -> FingerTree (Node a)
forall a. (Int -> a) -> Int -> Int -> Int -> FingerTree a
create Int -> Node a
mb (3Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
s) (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
s) (Int
trees'Int -> Int -> Int
forall a. Num a => a -> a -> a
-1))
(Int -> Digit a
createTwo (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+(2Int -> Int -> Int
forall a. Num a => a -> a -> a
+3Int -> Int -> Int
forall a. Num a => a -> a -> a
*(Int
trees'Int -> Int -> Int
forall a. Num a => a -> a -> a
-1))Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
s))
(trees' :: Int
trees', 2) -> Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
treesInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
s) (Int -> Digit a
createThree Int
i)
((Int -> Node a) -> Int -> Int -> Int -> FingerTree (Node a)
forall a. (Int -> a) -> Int -> Int -> Int -> FingerTree a
create Int -> Node a
mb (3Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
s) (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+3Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
s) (Int
trees'Int -> Int -> Int
forall a. Num a => a -> a -> a
-1))
(Int -> Digit a
createTwo (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+(3Int -> Int -> Int
forall a. Num a => a -> a -> a
+3Int -> Int -> Int
forall a. Num a => a -> a -> a
*(Int
trees'Int -> Int -> Int
forall a. Num a => a -> a -> a
-1))Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
s))
(trees' :: Int
trees', _) -> Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
treesInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
s) (Int -> Digit a
createThree Int
i)
((Int -> Node a) -> Int -> Int -> Int -> FingerTree (Node a)
forall a. (Int -> a) -> Int -> Int -> Int -> FingerTree a
create Int -> Node a
mb (3Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
s) (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+3Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
s) (Int
trees'Int -> Int -> Int
forall a. Num a => a -> a -> a
-2))
(Int -> Digit a
createThree (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+(3Int -> Int -> Int
forall a. Num a => a -> a -> a
+3Int -> Int -> Int
forall a. Num a => a -> a -> a
*(Int
trees'Int -> Int -> Int
forall a. Num a => a -> a -> a
-2))Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
s))
where
createTwo :: Int -> Digit a
createTwo j :: Int
j = a -> a -> Digit a
forall a. a -> a -> Digit a
Two (Int -> a
b Int
j) (Int -> a
b (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
s))
{-# INLINE createTwo #-}
createThree :: Int -> Digit a
createThree j :: Int
j = a -> a -> a -> Digit a
forall a. a -> a -> a -> Digit a
Three (Int -> a
b Int
j) (Int -> a
b (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
s)) (Int -> a
b (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
s))
{-# INLINE createThree #-}
mb :: Int -> Node a
mb j :: Int
j = Int -> a -> a -> a -> Node a
forall a. Int -> a -> a -> a -> Node a
Node3 (3Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
s) (Int -> a
b Int
j) (Int -> a
b (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
s)) (Int -> a
b (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
s))
{-# INLINE mb #-}
lift_elem :: (Int -> a) -> (Int -> Elem a)
#if __GLASGOW_HASKELL__ >= 708
lift_elem :: (Int -> a) -> Int -> Elem a
lift_elem g :: Int -> a
g = (Int -> a) -> Int -> Elem a
forall a b. Coercible a b => a -> b
coerce Int -> a
g
#else
lift_elem g = Elem . g
#endif
{-# INLINE lift_elem #-}
fromArray :: Ix i => Array i a -> Seq a
#ifdef __GLASGOW_HASKELL__
fromArray :: Array i a -> Seq a
fromArray a :: Array i a
a = Int -> (Int -> a) -> Seq a
forall a. Int -> (Int -> a) -> Seq a
fromFunction (Array i a -> Int
forall i e. Array i e -> Int
GHC.Arr.numElements Array i a
a) (Array i a -> Int -> a
forall i e. Array i e -> Int -> e
GHC.Arr.unsafeAt Array i a
a)
where
Int
_ = (i, i) -> Int
forall a. Ix a => (a, a) -> Int
Data.Array.rangeSize (Array i a -> (i, i)
forall i e. Array i e -> (i, i)
Data.Array.bounds Array i a
a)
#else
fromArray a = fromList2 (Data.Array.rangeSize (Data.Array.bounds a)) (Data.Array.elems a)
#endif
take :: Int -> Seq a -> Seq a
take :: Int -> Seq a -> Seq a
take i :: Int
i xs :: Seq a
xs@(Seq t :: FingerTree (Elem a)
t)
| Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i Word -> Word -> Word
forall a. Num a => a -> a -> a
- 1 Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
< (Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Seq a -> Int
forall a. Seq a -> Int
length Seq a
xs) Word -> Word -> Word
forall a. Num a => a -> a -> a
- 1 :: Word) =
FingerTree (Elem a) -> Seq a
forall a. FingerTree (Elem a) -> Seq a
Seq (Int -> FingerTree (Elem a) -> FingerTree (Elem a)
forall a. Int -> FingerTree (Elem a) -> FingerTree (Elem a)
takeTreeE Int
i FingerTree (Elem a)
t)
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 0 = Seq a
forall a. Seq a
empty
| Bool
otherwise = Seq a
xs
takeTreeE :: Int -> FingerTree (Elem a) -> FingerTree (Elem a)
takeTreeE :: Int -> FingerTree (Elem a) -> FingerTree (Elem a)
takeTreeE !Int
_i EmptyT = FingerTree (Elem a)
forall a. FingerTree a
EmptyT
takeTreeE i :: Int
i t :: FingerTree (Elem a)
t@(Single _)
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 0 = FingerTree (Elem a)
forall a. FingerTree a
EmptyT
| Bool
otherwise = FingerTree (Elem a)
t
takeTreeE i :: Int
i (Deep s :: Int
s pr :: Digit (Elem a)
pr m :: FingerTree (Node (Elem a))
m sf :: Digit (Elem a)
sf)
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
spr = Int -> Digit (Elem a) -> FingerTree (Elem a)
forall a. Int -> Digit (Elem a) -> FingerTree (Elem a)
takePrefixE Int
i Digit (Elem a)
pr
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
spm = case Int
-> FingerTree (Node (Elem a))
-> StrictPair (FingerTree (Node (Elem a))) (Node (Elem a))
forall a.
Int
-> FingerTree (Node a) -> StrictPair (FingerTree (Node a)) (Node a)
takeTreeN Int
im FingerTree (Node (Elem a))
m of
ml :: FingerTree (Node (Elem a))
ml :*: xs :: Node (Elem a)
xs -> Int
-> Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> Node (Elem a)
-> FingerTree (Elem a)
forall a.
Int
-> Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> Node (Elem a)
-> FingerTree (Elem a)
takeMiddleE (Int
im Int -> Int -> Int
forall a. Num a => a -> a -> a
- FingerTree (Node (Elem a)) -> Int
forall a. Sized a => a -> Int
size FingerTree (Node (Elem a))
ml) Int
spr Digit (Elem a)
pr FingerTree (Node (Elem a))
ml Node (Elem a)
xs
| Bool
otherwise = Int
-> Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> FingerTree (Elem a)
forall a.
Int
-> Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> FingerTree (Elem a)
takeSuffixE (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
spm) Int
s Digit (Elem a)
pr FingerTree (Node (Elem a))
m Digit (Elem a)
sf
where
spr :: Int
spr = Digit (Elem a) -> Int
forall a. Sized a => a -> Int
size Digit (Elem a)
pr
spm :: Int
spm = Int
spr Int -> Int -> Int
forall a. Num a => a -> a -> a
+ FingerTree (Node (Elem a)) -> Int
forall a. Sized a => a -> Int
size FingerTree (Node (Elem a))
m
im :: Int
im = Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
spr
takeTreeN :: Int -> FingerTree (Node a) -> StrictPair (FingerTree (Node a)) (Node a)
takeTreeN :: Int
-> FingerTree (Node a) -> StrictPair (FingerTree (Node a)) (Node a)
takeTreeN !Int
_i EmptyT = [Char] -> StrictPair (FingerTree (Node a)) (Node a)
forall a. HasCallStack => [Char] -> a
error "takeTreeN of empty tree"
takeTreeN _i :: Int
_i (Single x :: Node a
x) = FingerTree (Node a)
forall a. FingerTree a
EmptyT FingerTree (Node a)
-> Node a -> StrictPair (FingerTree (Node a)) (Node a)
forall a b. a -> b -> StrictPair a b
:*: Node a
x
takeTreeN i :: Int
i (Deep s :: Int
s pr :: Digit (Node a)
pr m :: FingerTree (Node (Node a))
m sf :: Digit (Node a)
sf)
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
spr = Int -> Digit (Node a) -> StrictPair (FingerTree (Node a)) (Node a)
forall a.
Int -> Digit (Node a) -> StrictPair (FingerTree (Node a)) (Node a)
takePrefixN Int
i Digit (Node a)
pr
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
spm = case Int
-> FingerTree (Node (Node a))
-> StrictPair (FingerTree (Node (Node a))) (Node (Node a))
forall a.
Int
-> FingerTree (Node a) -> StrictPair (FingerTree (Node a)) (Node a)
takeTreeN Int
im FingerTree (Node (Node a))
m of
ml :: FingerTree (Node (Node a))
ml :*: xs :: Node (Node a)
xs -> Int
-> Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> Node (Node a)
-> StrictPair (FingerTree (Node a)) (Node a)
forall a.
Int
-> Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> Node (Node a)
-> StrictPair (FingerTree (Node a)) (Node a)
takeMiddleN (Int
im Int -> Int -> Int
forall a. Num a => a -> a -> a
- FingerTree (Node (Node a)) -> Int
forall a. Sized a => a -> Int
size FingerTree (Node (Node a))
ml) Int
spr Digit (Node a)
pr FingerTree (Node (Node a))
ml Node (Node a)
xs
| Bool
otherwise = Int
-> Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> StrictPair (FingerTree (Node a)) (Node a)
forall a.
Int
-> Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> StrictPair (FingerTree (Node a)) (Node a)
takeSuffixN (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
spm) Int
s Digit (Node a)
pr FingerTree (Node (Node a))
m Digit (Node a)
sf where
spr :: Int
spr = Digit (Node a) -> Int
forall a. Sized a => a -> Int
size Digit (Node a)
pr
spm :: Int
spm = Int
spr Int -> Int -> Int
forall a. Num a => a -> a -> a
+ FingerTree (Node (Node a)) -> Int
forall a. Sized a => a -> Int
size FingerTree (Node (Node a))
m
im :: Int
im = Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
spr
takeMiddleN :: Int -> Int
-> Digit (Node a) -> FingerTree (Node (Node a)) -> Node (Node a)
-> StrictPair (FingerTree (Node a)) (Node a)
takeMiddleN :: Int
-> Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> Node (Node a)
-> StrictPair (FingerTree (Node a)) (Node a)
takeMiddleN i :: Int
i spr :: Int
spr pr :: Digit (Node a)
pr ml :: FingerTree (Node (Node a))
ml (Node2 _ a :: Node a
a b :: Node a
b)
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
sa = Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node a)
forall a. Int -> Digit a -> FingerTree (Node a) -> FingerTree a
pullR Int
sprml Digit (Node a)
pr FingerTree (Node (Node a))
ml FingerTree (Node a)
-> Node a -> StrictPair (FingerTree (Node a)) (Node a)
forall a b. a -> b -> StrictPair a b
:*: Node a
a
| Bool
otherwise = 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
sprmla Digit (Node a)
pr FingerTree (Node (Node a))
ml (Node a -> Digit (Node a)
forall a. a -> Digit a
One Node a
a) FingerTree (Node a)
-> Node a -> StrictPair (FingerTree (Node a)) (Node a)
forall a b. a -> b -> StrictPair a b
:*: Node a
b
where
sa :: Int
sa = Node a -> Int
forall a. Sized a => a -> Int
size Node a
a
sprml :: Int
sprml = Int
spr Int -> Int -> Int
forall a. Num a => a -> a -> a
+ FingerTree (Node (Node a)) -> Int
forall a. Sized a => a -> Int
size FingerTree (Node (Node a))
ml
sprmla :: Int
sprmla = Int
sa Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
sprml
takeMiddleN i :: Int
i spr :: Int
spr pr :: Digit (Node a)
pr ml :: FingerTree (Node (Node a))
ml (Node3 _ a :: Node a
a b :: Node a
b c :: Node a
c)
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
sa = Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node a)
forall a. Int -> Digit a -> FingerTree (Node a) -> FingerTree a
pullR Int
sprml Digit (Node a)
pr FingerTree (Node (Node a))
ml FingerTree (Node a)
-> Node a -> StrictPair (FingerTree (Node a)) (Node a)
forall a b. a -> b -> StrictPair a b
:*: Node a
a
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
sab = 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
sprmla Digit (Node a)
pr FingerTree (Node (Node a))
ml (Node a -> Digit (Node a)
forall a. a -> Digit a
One Node a
a) FingerTree (Node a)
-> Node a -> StrictPair (FingerTree (Node a)) (Node a)
forall a b. a -> b -> StrictPair a b
:*: Node a
b
| Bool
otherwise = 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
sprmlab Digit (Node a)
pr FingerTree (Node (Node a))
ml (Node a -> Node a -> Digit (Node a)
forall a. a -> a -> Digit a
Two Node a
a Node a
b) FingerTree (Node a)
-> Node a -> StrictPair (FingerTree (Node a)) (Node a)
forall a b. a -> b -> StrictPair a b
:*: Node a
c
where
sa :: Int
sa = Node a -> Int
forall a. Sized a => a -> Int
size Node a
a
sab :: Int
sab = Int
sa Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Node a -> Int
forall a. Sized a => a -> Int
size Node a
b
sprml :: Int
sprml = Int
spr Int -> Int -> Int
forall a. Num a => a -> a -> a
+ FingerTree (Node (Node a)) -> Int
forall a. Sized a => a -> Int
size FingerTree (Node (Node a))
ml
sprmla :: Int
sprmla = Int
sa Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
sprml
sprmlab :: Int
sprmlab = Int
sprmla Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Node a -> Int
forall a. Sized a => a -> Int
size Node a
b
takeMiddleE :: Int -> Int
-> Digit (Elem a) -> FingerTree (Node (Elem a)) -> Node (Elem a)
-> FingerTree (Elem a)
takeMiddleE :: Int
-> Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> Node (Elem a)
-> FingerTree (Elem a)
takeMiddleE i :: Int
i spr :: Int
spr pr :: Digit (Elem a)
pr ml :: FingerTree (Node (Elem a))
ml (Node2 _ a :: Elem a
a _)
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 1 = Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> FingerTree (Elem a)
forall a. Int -> Digit a -> FingerTree (Node a) -> FingerTree a
pullR Int
sprml Digit (Elem a)
pr FingerTree (Node (Elem a))
ml
| Bool
otherwise = 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
sprmla Digit (Elem a)
pr FingerTree (Node (Elem a))
ml (Elem a -> Digit (Elem a)
forall a. a -> Digit a
One Elem a
a)
where
sprml :: Int
sprml = Int
spr Int -> Int -> Int
forall a. Num a => a -> a -> a
+ FingerTree (Node (Elem a)) -> Int
forall a. Sized a => a -> Int
size FingerTree (Node (Elem a))
ml
sprmla :: Int
sprmla = 1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
sprml
takeMiddleE i :: Int
i spr :: Int
spr pr :: Digit (Elem a)
pr ml :: FingerTree (Node (Elem a))
ml (Node3 _ a :: Elem a
a b :: Elem a
b _)
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 1 = Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> FingerTree (Elem a)
forall a. Int -> Digit a -> FingerTree (Node a) -> FingerTree a
pullR Int
sprml Digit (Elem a)
pr FingerTree (Node (Elem a))
ml
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 2 = 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
sprmla Digit (Elem a)
pr FingerTree (Node (Elem a))
ml (Elem a -> Digit (Elem a)
forall a. a -> Digit a
One Elem a
a)
| Bool
otherwise = 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
sprmlab Digit (Elem a)
pr FingerTree (Node (Elem a))
ml (Elem a -> Elem a -> Digit (Elem a)
forall a. a -> a -> Digit a
Two Elem a
a Elem a
b)
where
sprml :: Int
sprml = Int
spr Int -> Int -> Int
forall a. Num a => a -> a -> a
+ FingerTree (Node (Elem a)) -> Int
forall a. Sized a => a -> Int
size FingerTree (Node (Elem a))
ml
sprmla :: Int
sprmla = 1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
sprml
sprmlab :: Int
sprmlab = Int
sprmla Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1
takePrefixE :: Int -> Digit (Elem a) -> FingerTree (Elem a)
takePrefixE :: Int -> Digit (Elem a) -> FingerTree (Elem a)
takePrefixE !Int
_i (One _) = FingerTree (Elem a)
forall a. FingerTree a
EmptyT
takePrefixE i :: Int
i (Two a :: Elem a
a _)
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 1 = FingerTree (Elem a)
forall a. FingerTree a
EmptyT
| Bool
otherwise = Elem a -> FingerTree (Elem a)
forall a. a -> FingerTree a
Single Elem a
a
takePrefixE i :: Int
i (Three a :: Elem a
a b :: Elem a
b _)
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 1 = FingerTree (Elem a)
forall a. FingerTree a
EmptyT
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 2 = Elem a -> FingerTree (Elem a)
forall a. a -> FingerTree a
Single Elem a
a
| Bool
otherwise = 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 2 (Elem a -> Digit (Elem a)
forall a. a -> Digit a
One Elem a
a) FingerTree (Node (Elem a))
forall a. FingerTree a
EmptyT (Elem a -> Digit (Elem a)
forall a. a -> Digit a
One Elem a
b)
takePrefixE i :: Int
i (Four a :: Elem a
a b :: Elem a
b c :: Elem a
c _)
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 1 = FingerTree (Elem a)
forall a. FingerTree a
EmptyT
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 2 = Elem a -> FingerTree (Elem a)
forall a. a -> FingerTree a
Single Elem a
a
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 3 = 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 2 (Elem a -> Digit (Elem a)
forall a. a -> Digit a
One Elem a
a) FingerTree (Node (Elem a))
forall a. FingerTree a
EmptyT (Elem a -> Digit (Elem a)
forall a. a -> Digit a
One Elem a
b)
| Bool
otherwise = 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 3 (Elem a -> Elem a -> Digit (Elem a)
forall a. a -> a -> Digit a
Two Elem a
a Elem a
b) FingerTree (Node (Elem a))
forall a. FingerTree a
EmptyT (Elem a -> Digit (Elem a)
forall a. a -> Digit a
One Elem a
c)
takePrefixN :: Int -> Digit (Node a)
-> StrictPair (FingerTree (Node a)) (Node a)
takePrefixN :: Int -> Digit (Node a) -> StrictPair (FingerTree (Node a)) (Node a)
takePrefixN !Int
_i (One a :: Node a
a) = FingerTree (Node a)
forall a. FingerTree a
EmptyT FingerTree (Node a)
-> Node a -> StrictPair (FingerTree (Node a)) (Node a)
forall a b. a -> b -> StrictPair a b
:*: Node a
a
takePrefixN i :: Int
i (Two a :: Node a
a b :: Node a
b)
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
sa = FingerTree (Node a)
forall a. FingerTree a
EmptyT FingerTree (Node a)
-> Node a -> StrictPair (FingerTree (Node a)) (Node a)
forall a b. a -> b -> StrictPair a b
:*: Node a
a
| Bool
otherwise = Node a -> FingerTree (Node a)
forall a. a -> FingerTree a
Single Node a
a FingerTree (Node a)
-> Node a -> StrictPair (FingerTree (Node a)) (Node a)
forall a b. a -> b -> StrictPair a b
:*: Node a
b
where
sa :: Int
sa = Node a -> Int
forall a. Sized a => a -> Int
size Node a
a
takePrefixN i :: Int
i (Three a :: Node a
a b :: Node a
b c :: Node a
c)
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
sa = FingerTree (Node a)
forall a. FingerTree a
EmptyT FingerTree (Node a)
-> Node a -> StrictPair (FingerTree (Node a)) (Node a)
forall a b. a -> b -> StrictPair a b
:*: Node a
a
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
sab = Node a -> FingerTree (Node a)
forall a. a -> FingerTree a
Single Node a
a FingerTree (Node a)
-> Node a -> StrictPair (FingerTree (Node a)) (Node a)
forall a b. a -> b -> StrictPair a b
:*: Node a
b
| Bool
otherwise = 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
sab (Node a -> Digit (Node a)
forall a. a -> Digit a
One Node a
a) FingerTree (Node (Node a))
forall a. FingerTree a
EmptyT (Node a -> Digit (Node a)
forall a. a -> Digit a
One Node a
b) FingerTree (Node a)
-> Node a -> StrictPair (FingerTree (Node a)) (Node a)
forall a b. a -> b -> StrictPair a b
:*: Node a
c
where
sa :: Int
sa = Node a -> Int
forall a. Sized a => a -> Int
size Node a
a
sab :: Int
sab = Int
sa Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Node a -> Int
forall a. Sized a => a -> Int
size Node a
b
takePrefixN i :: Int
i (Four a :: Node a
a b :: Node a
b c :: Node a
c d :: Node a
d)
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
sa = FingerTree (Node a)
forall a. FingerTree a
EmptyT FingerTree (Node a)
-> Node a -> StrictPair (FingerTree (Node a)) (Node a)
forall a b. a -> b -> StrictPair a b
:*: Node a
a
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
sab = Node a -> FingerTree (Node a)
forall a. a -> FingerTree a
Single Node a
a FingerTree (Node a)
-> Node a -> StrictPair (FingerTree (Node a)) (Node a)
forall a b. a -> b -> StrictPair a b
:*: Node a
b
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
sabc = 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
sab (Node a -> Digit (Node a)
forall a. a -> Digit a
One Node a
a) FingerTree (Node (Node a))
forall a. FingerTree a
EmptyT (Node a -> Digit (Node a)
forall a. a -> Digit a
One Node a
b) FingerTree (Node a)
-> Node a -> StrictPair (FingerTree (Node a)) (Node a)
forall a b. a -> b -> StrictPair a b
:*: Node a
c
| Bool
otherwise = 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
sabc (Node a -> Node a -> Digit (Node a)
forall a. a -> a -> Digit a
Two Node a
a Node a
b) FingerTree (Node (Node a))
forall a. FingerTree a
EmptyT (Node a -> Digit (Node a)
forall a. a -> Digit a
One Node a
c) FingerTree (Node a)
-> Node a -> StrictPair (FingerTree (Node a)) (Node a)
forall a b. a -> b -> StrictPair a b
:*: Node a
d
where
sa :: Int
sa = Node a -> Int
forall a. Sized a => a -> Int
size Node a
a
sab :: Int
sab = Int
sa Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Node a -> Int
forall a. Sized a => a -> Int
size Node a
b
sabc :: Int
sabc = Int
sab Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Node a -> Int
forall a. Sized a => a -> Int
size Node a
c
takeSuffixE :: Int -> Int -> Digit (Elem a) -> FingerTree (Node (Elem a)) -> Digit (Elem a) ->
FingerTree (Elem a)
takeSuffixE :: Int
-> Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> FingerTree (Elem a)
takeSuffixE !Int
_i !Int
s pr :: Digit (Elem a)
pr m :: FingerTree (Node (Elem a))
m (One _) = Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> FingerTree (Elem a)
forall a. Int -> Digit a -> FingerTree (Node a) -> FingerTree a
pullR (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) Digit (Elem a)
pr FingerTree (Node (Elem a))
m
takeSuffixE i :: Int
i s :: Int
s pr :: Digit (Elem a)
pr m :: FingerTree (Node (Elem a))
m (Two a :: Elem a
a _)
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 1 = Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> FingerTree (Elem a)
forall a. Int -> Digit a -> FingerTree (Node a) -> FingerTree a
pullR (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- 2) Digit (Elem a)
pr FingerTree (Node (Elem a))
m
| Bool
otherwise = 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
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) Digit (Elem a)
pr FingerTree (Node (Elem a))
m (Elem a -> Digit (Elem a)
forall a. a -> Digit a
One Elem a
a)
takeSuffixE i :: Int
i s :: Int
s pr :: Digit (Elem a)
pr m :: FingerTree (Node (Elem a))
m (Three a :: Elem a
a b :: Elem a
b _)
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 1 = Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> FingerTree (Elem a)
forall a. Int -> Digit a -> FingerTree (Node a) -> FingerTree a
pullR (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- 3) Digit (Elem a)
pr FingerTree (Node (Elem a))
m
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 2 = 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
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- 2) Digit (Elem a)
pr FingerTree (Node (Elem a))
m (Elem a -> Digit (Elem a)
forall a. a -> Digit a
One Elem a
a)
| Bool
otherwise = 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
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) Digit (Elem a)
pr FingerTree (Node (Elem a))
m (Elem a -> Elem a -> Digit (Elem a)
forall a. a -> a -> Digit a
Two Elem a
a Elem a
b)
takeSuffixE i :: Int
i s :: Int
s pr :: Digit (Elem a)
pr m :: FingerTree (Node (Elem a))
m (Four a :: Elem a
a b :: Elem a
b c :: Elem a
c _)
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 1 = Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> FingerTree (Elem a)
forall a. Int -> Digit a -> FingerTree (Node a) -> FingerTree a
pullR (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- 4) Digit (Elem a)
pr FingerTree (Node (Elem a))
m
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 2 = 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
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- 3) Digit (Elem a)
pr FingerTree (Node (Elem a))
m (Elem a -> Digit (Elem a)
forall a. a -> Digit a
One Elem a
a)
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 3 = 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
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- 2) Digit (Elem a)
pr FingerTree (Node (Elem a))
m (Elem a -> Elem a -> Digit (Elem a)
forall a. a -> a -> Digit a
Two Elem a
a Elem a
b)
| Bool
otherwise = 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
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) Digit (Elem a)
pr FingerTree (Node (Elem a))
m (Elem a -> Elem a -> Elem a -> Digit (Elem a)
forall a. a -> a -> a -> Digit a
Three Elem a
a Elem a
b Elem a
c)
takeSuffixN :: Int -> Int -> Digit (Node a) -> FingerTree (Node (Node a)) -> Digit (Node a) ->
StrictPair (FingerTree (Node a)) (Node a)
takeSuffixN :: Int
-> Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> StrictPair (FingerTree (Node a)) (Node a)
takeSuffixN !Int
_i !Int
s pr :: Digit (Node a)
pr m :: FingerTree (Node (Node a))
m (One a :: Node a
a) = Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node a)
forall a. Int -> Digit a -> FingerTree (Node a) -> FingerTree a
pullR (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- Node a -> Int
forall a. Sized a => a -> Int
size Node a
a) Digit (Node a)
pr FingerTree (Node (Node a))
m FingerTree (Node a)
-> Node a -> StrictPair (FingerTree (Node a)) (Node a)
forall a b. a -> b -> StrictPair a b
:*: Node a
a
takeSuffixN i :: Int
i s :: Int
s pr :: Digit (Node a)
pr m :: FingerTree (Node (Node a))
m (Two a :: Node a
a b :: Node a
b)
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
sa = Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node a)
forall a. Int -> Digit a -> FingerTree (Node a) -> FingerTree a
pullR (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sa Int -> Int -> Int
forall a. Num a => a -> a -> a
- Node a -> Int
forall a. Sized a => a -> Int
size Node a
b) Digit (Node a)
pr FingerTree (Node (Node a))
m FingerTree (Node a)
-> Node a -> StrictPair (FingerTree (Node a)) (Node a)
forall a b. a -> b -> StrictPair a b
:*: Node a
a
| Bool
otherwise = 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
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- Node a -> Int
forall a. Sized a => a -> Int
size Node a
b) Digit (Node a)
pr FingerTree (Node (Node a))
m (Node a -> Digit (Node a)
forall a. a -> Digit a
One Node a
a) FingerTree (Node a)
-> Node a -> StrictPair (FingerTree (Node a)) (Node a)
forall a b. a -> b -> StrictPair a b
:*: Node a
b
where
sa :: Int
sa = Node a -> Int
forall a. Sized a => a -> Int
size Node a
a
takeSuffixN i :: Int
i s :: Int
s pr :: Digit (Node a)
pr m :: FingerTree (Node (Node a))
m (Three a :: Node a
a b :: Node a
b c :: Node a
c)
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
sa = Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node a)
forall a. Int -> Digit a -> FingerTree (Node a) -> FingerTree a
pullR (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sab Int -> Int -> Int
forall a. Num a => a -> a -> a
- Node a -> Int
forall a. Sized a => a -> Int
size Node a
c) Digit (Node a)
pr FingerTree (Node (Node a))
m FingerTree (Node a)
-> Node a -> StrictPair (FingerTree (Node a)) (Node a)
forall a b. a -> b -> StrictPair a b
:*: Node a
a
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
sab = 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
s 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) Digit (Node a)
pr FingerTree (Node (Node a))
m (Node a -> Digit (Node a)
forall a. a -> Digit a
One Node a
a) FingerTree (Node a)
-> Node a -> StrictPair (FingerTree (Node a)) (Node a)
forall a b. a -> b -> StrictPair a b
:*: Node a
b
| Bool
otherwise = 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
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- Node a -> Int
forall a. Sized a => a -> Int
size Node a
c) Digit (Node a)
pr FingerTree (Node (Node a))
m (Node a -> Node a -> Digit (Node a)
forall a. a -> a -> Digit a
Two Node a
a Node a
b) FingerTree (Node a)
-> Node a -> StrictPair (FingerTree (Node a)) (Node a)
forall a b. a -> b -> StrictPair a b
:*: Node a
c
where
sa :: Int
sa = Node a -> Int
forall a. Sized a => a -> Int
size Node a
a
sab :: Int
sab = Int
sa Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Node a -> Int
forall a. Sized a => a -> Int
size Node a
b
takeSuffixN i :: Int
i s :: Int
s pr :: Digit (Node a)
pr m :: FingerTree (Node (Node a))
m (Four a :: Node a
a b :: Node a
b c :: Node a
c d :: Node a
d)
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
sa = Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node a)
forall a. Int -> Digit a -> FingerTree (Node a) -> FingerTree a
pullR (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sa Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sbcd) Digit (Node a)
pr FingerTree (Node (Node a))
m FingerTree (Node a)
-> Node a -> StrictPair (FingerTree (Node a)) (Node a)
forall a b. a -> b -> StrictPair a b
:*: Node a
a
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
sab = 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
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sbcd) Digit (Node a)
pr FingerTree (Node (Node a))
m (Node a -> Digit (Node a)
forall a. a -> Digit a
One Node a
a) FingerTree (Node a)
-> Node a -> StrictPair (FingerTree (Node a)) (Node a)
forall a b. a -> b -> StrictPair a b
:*: Node a
b
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
sabc = 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
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
scd) Digit (Node a)
pr FingerTree (Node (Node a))
m (Node a -> Node a -> Digit (Node a)
forall a. a -> a -> Digit a
Two Node a
a Node a
b) FingerTree (Node a)
-> Node a -> StrictPair (FingerTree (Node a)) (Node a)
forall a b. a -> b -> StrictPair a b
:*: Node a
c
| Bool
otherwise = 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
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sd) Digit (Node a)
pr FingerTree (Node (Node a))
m (Node a -> Node a -> Node a -> Digit (Node a)
forall a. a -> a -> a -> Digit a
Three Node a
a Node a
b Node a
c) FingerTree (Node a)
-> Node a -> StrictPair (FingerTree (Node a)) (Node a)
forall a b. a -> b -> StrictPair a b
:*: Node a
d
where
sa :: Int
sa = Node a -> Int
forall a. Sized a => a -> Int
size Node a
a
sab :: Int
sab = Int
sa Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Node a -> Int
forall a. Sized a => a -> Int
size Node a
b
sabc :: Int
sabc = Int
sab Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Node a -> Int
forall a. Sized a => a -> Int
size Node a
c
sd :: Int
sd = Node a -> Int
forall a. Sized a => a -> Int
size Node a
d
scd :: Int
scd = Node a -> Int
forall a. Sized a => a -> Int
size Node a
c Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
sd
sbcd :: Int
sbcd = Node a -> Int
forall a. Sized a => a -> Int
size Node a
b Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
scd
drop :: Int -> Seq a -> Seq a
drop :: Int -> Seq a -> Seq a
drop i :: Int
i xs :: Seq a
xs@(Seq t :: FingerTree (Elem a)
t)
| Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i Word -> Word -> Word
forall a. Num a => a -> a -> a
- 1 Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
< (Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Seq a -> Int
forall a. Seq a -> Int
length Seq a
xs) Word -> Word -> Word
forall a. Num a => a -> a -> a
- 1 :: Word) =
FingerTree (Elem a) -> Seq a
forall a. FingerTree (Elem a) -> Seq a
Seq (Int -> FingerTree (Elem a) -> FingerTree (Elem a)
forall a. Int -> FingerTree (Elem a) -> FingerTree (Elem a)
takeTreeER (Seq a -> Int
forall a. Seq a -> Int
length Seq a
xs Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i) FingerTree (Elem a)
t)
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 0 = Seq a
xs
| Bool
otherwise = Seq a
forall a. Seq a
empty
takeTreeER :: Int -> FingerTree (Elem a) -> FingerTree (Elem a)
takeTreeER :: Int -> FingerTree (Elem a) -> FingerTree (Elem a)
takeTreeER !Int
_i EmptyT = FingerTree (Elem a)
forall a. FingerTree a
EmptyT
takeTreeER i :: Int
i t :: FingerTree (Elem a)
t@(Single _)
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 0 = FingerTree (Elem a)
forall a. FingerTree a
EmptyT
| Bool
otherwise = FingerTree (Elem a)
t
takeTreeER i :: Int
i (Deep s :: Int
s pr :: Digit (Elem a)
pr m :: FingerTree (Node (Elem a))
m sf :: Digit (Elem a)
sf)
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
ssf = Int -> Digit (Elem a) -> FingerTree (Elem a)
forall a. Int -> Digit (Elem a) -> FingerTree (Elem a)
takeSuffixER Int
i Digit (Elem a)
sf
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
ssm = case Int
-> FingerTree (Node (Elem a))
-> StrictPair (Node (Elem a)) (FingerTree (Node (Elem a)))
forall a.
Int
-> FingerTree (Node a) -> StrictPair (Node a) (FingerTree (Node a))
takeTreeNR Int
im FingerTree (Node (Elem a))
m of
xs :: Node (Elem a)
xs :*: mr :: FingerTree (Node (Elem a))
mr -> Int
-> Int
-> Node (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> FingerTree (Elem a)
forall a.
Int
-> Int
-> Node (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> FingerTree (Elem a)
takeMiddleER (Int
im Int -> Int -> Int
forall a. Num a => a -> a -> a
- FingerTree (Node (Elem a)) -> Int
forall a. Sized a => a -> Int
size FingerTree (Node (Elem a))
mr) Int
ssf Node (Elem a)
xs FingerTree (Node (Elem a))
mr Digit (Elem a)
sf
| Bool
otherwise = Int
-> Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> FingerTree (Elem a)
forall a.
Int
-> Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> FingerTree (Elem a)
takePrefixER (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
ssm) Int
s Digit (Elem a)
pr FingerTree (Node (Elem a))
m Digit (Elem a)
sf
where
ssf :: Int
ssf = Digit (Elem a) -> Int
forall a. Sized a => a -> Int
size Digit (Elem a)
sf
ssm :: Int
ssm = Int
ssf Int -> Int -> Int
forall a. Num a => a -> a -> a
+ FingerTree (Node (Elem a)) -> Int
forall a. Sized a => a -> Int
size FingerTree (Node (Elem a))
m
im :: Int
im = Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
ssf
takeTreeNR :: Int -> FingerTree (Node a) -> StrictPair (Node a) (FingerTree (Node a))
takeTreeNR :: Int
-> FingerTree (Node a) -> StrictPair (Node a) (FingerTree (Node a))
takeTreeNR !Int
_i EmptyT = [Char] -> StrictPair (Node a) (FingerTree (Node a))
forall a. HasCallStack => [Char] -> a
error "takeTreeNR of empty tree"
takeTreeNR _i :: Int
_i (Single x :: Node a
x) = Node a
x Node a
-> FingerTree (Node a) -> StrictPair (Node a) (FingerTree (Node a))
forall a b. a -> b -> StrictPair a b
:*: FingerTree (Node a)
forall a. FingerTree a
EmptyT
takeTreeNR i :: Int
i (Deep s :: Int
s pr :: Digit (Node a)
pr m :: FingerTree (Node (Node a))
m sf :: Digit (Node a)
sf)
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
ssf = Int -> Digit (Node a) -> StrictPair (Node a) (FingerTree (Node a))
forall a.
Int -> Digit (Node a) -> StrictPair (Node a) (FingerTree (Node a))
takeSuffixNR Int
i Digit (Node a)
sf
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
ssm = case Int
-> FingerTree (Node (Node a))
-> StrictPair (Node (Node a)) (FingerTree (Node (Node a)))
forall a.
Int
-> FingerTree (Node a) -> StrictPair (Node a) (FingerTree (Node a))
takeTreeNR Int
im FingerTree (Node (Node a))
m of
xs :: Node (Node a)
xs :*: mr :: FingerTree (Node (Node a))
mr -> Int
-> Int
-> Node (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> StrictPair (Node a) (FingerTree (Node a))
forall a.
Int
-> Int
-> Node (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> StrictPair (Node a) (FingerTree (Node a))
takeMiddleNR (Int
im Int -> Int -> Int
forall a. Num a => a -> a -> a
- FingerTree (Node (Node a)) -> Int
forall a. Sized a => a -> Int
size FingerTree (Node (Node a))
mr) Int
ssf Node (Node a)
xs FingerTree (Node (Node a))
mr Digit (Node a)
sf
| Bool
otherwise = Int
-> Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> StrictPair (Node a) (FingerTree (Node a))
forall a.
Int
-> Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> StrictPair (Node a) (FingerTree (Node a))
takePrefixNR (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
ssm) Int
s Digit (Node a)
pr FingerTree (Node (Node a))
m Digit (Node a)
sf where
ssf :: Int
ssf = Digit (Node a) -> Int
forall a. Sized a => a -> Int
size Digit (Node a)
sf
ssm :: Int
ssm = Int
ssf Int -> Int -> Int
forall a. Num a => a -> a -> a
+ FingerTree (Node (Node a)) -> Int
forall a. Sized a => a -> Int
size FingerTree (Node (Node a))
m
im :: Int
im = Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
ssf
takeMiddleNR :: Int -> Int
-> Node (Node a) -> FingerTree (Node (Node a)) -> Digit (Node a)
-> StrictPair (Node a) (FingerTree (Node a))
takeMiddleNR :: Int
-> Int
-> Node (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> StrictPair (Node a) (FingerTree (Node a))
takeMiddleNR i :: Int
i ssf :: Int
ssf (Node2 _ a :: Node a
a b :: Node a
b) mr :: FingerTree (Node (Node a))
mr sf :: Digit (Node a)
sf
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
sb = Node a
b Node a
-> FingerTree (Node a) -> StrictPair (Node a) (FingerTree (Node a))
forall a b. a -> b -> StrictPair a b
:*: Int
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> FingerTree (Node a)
forall a. Int -> FingerTree (Node a) -> Digit a -> FingerTree a
pullL Int
ssfmr FingerTree (Node (Node a))
mr Digit (Node a)
sf
| Bool
otherwise = Node a
a Node a
-> FingerTree (Node a) -> StrictPair (Node a) (FingerTree (Node a))
forall a b. a -> b -> StrictPair a b
:*: 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
ssfmrb (Node a -> Digit (Node a)
forall a. a -> Digit a
One Node a
b) FingerTree (Node (Node a))
mr Digit (Node a)
sf
where
sb :: Int
sb = Node a -> Int
forall a. Sized a => a -> Int
size Node a
b
ssfmr :: Int
ssfmr = Int
ssf Int -> Int -> Int
forall a. Num a => a -> a -> a
+ FingerTree (Node (Node a)) -> Int
forall a. Sized a => a -> Int
size FingerTree (Node (Node a))
mr
ssfmrb :: Int
ssfmrb = Int
sb Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
ssfmr
takeMiddleNR i :: Int
i ssf :: Int
ssf (Node3 _ a :: Node a
a b :: Node a
b c :: Node a
c) mr :: FingerTree (Node (Node a))
mr sf :: Digit (Node a)
sf
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
sc = Node a
c Node a
-> FingerTree (Node a) -> StrictPair (Node a) (FingerTree (Node a))
forall a b. a -> b -> StrictPair a b
:*: Int
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> FingerTree (Node a)
forall a. Int -> FingerTree (Node a) -> Digit a -> FingerTree a
pullL Int
ssfmr FingerTree (Node (Node a))
mr Digit (Node a)
sf
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
sbc = Node a
b Node a
-> FingerTree (Node a) -> StrictPair (Node a) (FingerTree (Node a))
forall a b. a -> b -> StrictPair a b
:*: 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
ssfmrc (Node a -> Digit (Node a)
forall a. a -> Digit a
One Node a
c) FingerTree (Node (Node a))
mr Digit (Node a)
sf
| Bool
otherwise = Node a
a Node a
-> FingerTree (Node a) -> StrictPair (Node a) (FingerTree (Node a))
forall a b. a -> b -> StrictPair a b
:*: 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
ssfmrbc (Node a -> Node a -> Digit (Node a)
forall a. a -> a -> Digit a
Two Node a
b Node a
c) FingerTree (Node (Node a))
mr Digit (Node a)
sf
where
sc :: Int
sc = Node a -> Int
forall a. Sized a => a -> Int
size Node a
c
sbc :: Int
sbc = Int
sc Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Node a -> Int
forall a. Sized a => a -> Int
size Node a
b
ssfmr :: Int
ssfmr = Int
ssf Int -> Int -> Int
forall a. Num a => a -> a -> a
+ FingerTree (Node (Node a)) -> Int
forall a. Sized a => a -> Int
size FingerTree (Node (Node a))
mr
ssfmrc :: Int
ssfmrc = Int
sc Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
ssfmr
ssfmrbc :: Int
ssfmrbc = Int
ssfmrc Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Node a -> Int
forall a. Sized a => a -> Int
size Node a
b
takeMiddleER :: Int -> Int
-> Node (Elem a) -> FingerTree (Node (Elem a)) -> Digit (Elem a)
-> FingerTree (Elem a)
takeMiddleER :: Int
-> Int
-> Node (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> FingerTree (Elem a)
takeMiddleER i :: Int
i ssf :: Int
ssf (Node2 _ _ b :: Elem a
b) mr :: FingerTree (Node (Elem a))
mr sf :: Digit (Elem a)
sf
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 1 = Int
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> FingerTree (Elem a)
forall a. Int -> FingerTree (Node a) -> Digit a -> FingerTree a
pullL Int
ssfmr FingerTree (Node (Elem a))
mr Digit (Elem a)
sf
| Bool
otherwise = 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
ssfmrb (Elem a -> Digit (Elem a)
forall a. a -> Digit a
One Elem a
b) FingerTree (Node (Elem a))
mr Digit (Elem a)
sf
where
ssfmr :: Int
ssfmr = Int
ssf Int -> Int -> Int
forall a. Num a => a -> a -> a
+ FingerTree (Node (Elem a)) -> Int
forall a. Sized a => a -> Int
size FingerTree (Node (Elem a))
mr
ssfmrb :: Int
ssfmrb = 1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
ssfmr
takeMiddleER i :: Int
i ssf :: Int
ssf (Node3 _ _ b :: Elem a
b c :: Elem a
c) mr :: FingerTree (Node (Elem a))
mr sf :: Digit (Elem a)
sf
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 1 = Int
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> FingerTree (Elem a)
forall a. Int -> FingerTree (Node a) -> Digit a -> FingerTree a
pullL Int
ssfmr FingerTree (Node (Elem a))
mr Digit (Elem a)
sf
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 2 = 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
ssfmrc (Elem a -> Digit (Elem a)
forall a. a -> Digit a
One Elem a
c) FingerTree (Node (Elem a))
mr Digit (Elem a)
sf
| Bool
otherwise = 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
ssfmrbc (Elem a -> Elem a -> Digit (Elem a)
forall a. a -> a -> Digit a
Two Elem a
b Elem a
c) FingerTree (Node (Elem a))
mr Digit (Elem a)
sf
where
ssfmr :: Int
ssfmr = Int
ssf Int -> Int -> Int
forall a. Num a => a -> a -> a
+ FingerTree (Node (Elem a)) -> Int
forall a. Sized a => a -> Int
size FingerTree (Node (Elem a))
mr
ssfmrc :: Int
ssfmrc = 1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
ssfmr
ssfmrbc :: Int
ssfmrbc = Int
ssfmr Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 2
takeSuffixER :: Int -> Digit (Elem a) -> FingerTree (Elem a)
takeSuffixER :: Int -> Digit (Elem a) -> FingerTree (Elem a)
takeSuffixER !Int
_i (One _) = FingerTree (Elem a)
forall a. FingerTree a
EmptyT
takeSuffixER i :: Int
i (Two _ b :: Elem a
b)
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 1 = FingerTree (Elem a)
forall a. FingerTree a
EmptyT
| Bool
otherwise = Elem a -> FingerTree (Elem a)
forall a. a -> FingerTree a
Single Elem a
b
takeSuffixER i :: Int
i (Three _ b :: Elem a
b c :: Elem a
c)
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 1 = FingerTree (Elem a)
forall a. FingerTree a
EmptyT
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 2 = Elem a -> FingerTree (Elem a)
forall a. a -> FingerTree a
Single Elem a
c
| Bool
otherwise = 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 2 (Elem a -> Digit (Elem a)
forall a. a -> Digit a
One Elem a
b) FingerTree (Node (Elem a))
forall a. FingerTree a
EmptyT (Elem a -> Digit (Elem a)
forall a. a -> Digit a
One Elem a
c)
takeSuffixER i :: Int
i (Four _ b :: Elem a
b c :: Elem a
c d :: Elem a
d)
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 1 = FingerTree (Elem a)
forall a. FingerTree a
EmptyT
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 2 = Elem a -> FingerTree (Elem a)
forall a. a -> FingerTree a
Single Elem a
d
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 3 = 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 2 (Elem a -> Digit (Elem a)
forall a. a -> Digit a
One Elem a
c) FingerTree (Node (Elem a))
forall a. FingerTree a
EmptyT (Elem a -> Digit (Elem a)
forall a. a -> Digit a
One Elem a
d)
| Bool
otherwise = 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 3 (Elem a -> Elem a -> Digit (Elem a)
forall a. a -> a -> Digit a
Two Elem a
b Elem a
c) FingerTree (Node (Elem a))
forall a. FingerTree a
EmptyT (Elem a -> Digit (Elem a)
forall a. a -> Digit a
One Elem a
d)
takeSuffixNR :: Int -> Digit (Node a)
-> StrictPair (Node a) (FingerTree (Node a))
takeSuffixNR :: Int -> Digit (Node a) -> StrictPair (Node a) (FingerTree (Node a))
takeSuffixNR !Int
_i (One a :: Node a
a) = Node a
a Node a
-> FingerTree (Node a) -> StrictPair (Node a) (FingerTree (Node a))
forall a b. a -> b -> StrictPair a b
:*: FingerTree (Node a)
forall a. FingerTree a
EmptyT
takeSuffixNR i :: Int
i (Two a :: Node a
a b :: Node a
b)
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
sb = Node a
b Node a
-> FingerTree (Node a) -> StrictPair (Node a) (FingerTree (Node a))
forall a b. a -> b -> StrictPair a b
:*: FingerTree (Node a)
forall a. FingerTree a
EmptyT
| Bool
otherwise = Node a
a Node a
-> FingerTree (Node a) -> StrictPair (Node a) (FingerTree (Node a))
forall a b. a -> b -> StrictPair a b
:*: Node a -> FingerTree (Node a)
forall a. a -> FingerTree a
Single Node a
b
where
sb :: Int
sb = Node a -> Int
forall a. Sized a => a -> Int
size Node a
b
takeSuffixNR i :: Int
i (Three a :: Node a
a b :: Node a
b c :: Node a
c)
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
sc = Node a
c Node a
-> FingerTree (Node a) -> StrictPair (Node a) (FingerTree (Node a))
forall a b. a -> b -> StrictPair a b
:*: FingerTree (Node a)
forall a. FingerTree a
EmptyT
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
sbc = Node a
b Node a
-> FingerTree (Node a) -> StrictPair (Node a) (FingerTree (Node a))
forall a b. a -> b -> StrictPair a b
:*: Node a -> FingerTree (Node a)
forall a. a -> FingerTree a
Single Node a
c
| Bool
otherwise = Node a
a Node a
-> FingerTree (Node a) -> StrictPair (Node a) (FingerTree (Node a))
forall a b. a -> b -> StrictPair a b
:*: 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
sbc (Node a -> Digit (Node a)
forall a. a -> Digit a
One Node a
b) FingerTree (Node (Node a))
forall a. FingerTree a
EmptyT (Node a -> Digit (Node a)
forall a. a -> Digit a
One Node a
c)
where
sc :: Int
sc = Node a -> Int
forall a. Sized a => a -> Int
size Node a
c
sbc :: Int
sbc = Int
sc Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Node a -> Int
forall a. Sized a => a -> Int
size Node a
b
takeSuffixNR i :: Int
i (Four a :: Node a
a b :: Node a
b c :: Node a
c d :: Node a
d)
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
sd = Node a
d Node a
-> FingerTree (Node a) -> StrictPair (Node a) (FingerTree (Node a))
forall a b. a -> b -> StrictPair a b
:*: FingerTree (Node a)
forall a. FingerTree a
EmptyT
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
scd = Node a
c Node a
-> FingerTree (Node a) -> StrictPair (Node a) (FingerTree (Node a))
forall a b. a -> b -> StrictPair a b
:*: Node a -> FingerTree (Node a)
forall a. a -> FingerTree a
Single Node a
d
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
sbcd = Node a
b Node a
-> FingerTree (Node a) -> StrictPair (Node a) (FingerTree (Node a))
forall a b. a -> b -> StrictPair a b
:*: 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
scd (Node a -> Digit (Node a)
forall a. a -> Digit a
One Node a
c) FingerTree (Node (Node a))
forall a. FingerTree a
EmptyT (Node a -> Digit (Node a)
forall a. a -> Digit a
One Node a
d)
| Bool
otherwise = Node a
a Node a
-> FingerTree (Node a) -> StrictPair (Node a) (FingerTree (Node a))
forall a b. a -> b -> StrictPair a b
:*: 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
sbcd (Node a -> Node a -> Digit (Node a)
forall a. a -> a -> Digit a
Two Node a
b Node a
c) FingerTree (Node (Node a))
forall a. FingerTree a
EmptyT (Node a -> Digit (Node a)
forall a. a -> Digit a
One Node a
d)
where
sd :: Int
sd = Node a -> Int
forall a. Sized a => a -> Int
size Node a
d
scd :: Int
scd = Int
sd Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Node a -> Int
forall a. Sized a => a -> Int
size Node a
c
sbcd :: Int
sbcd = Int
scd Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Node a -> Int
forall a. Sized a => a -> Int
size Node a
b
takePrefixER :: Int -> Int -> Digit (Elem a) -> FingerTree (Node (Elem a)) -> Digit (Elem a) ->
FingerTree (Elem a)
takePrefixER :: Int
-> Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> FingerTree (Elem a)
takePrefixER !Int
_i !Int
s (One _) m :: FingerTree (Node (Elem a))
m sf :: Digit (Elem a)
sf = Int
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> FingerTree (Elem a)
forall a. Int -> FingerTree (Node a) -> Digit a -> FingerTree a
pullL (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) FingerTree (Node (Elem a))
m Digit (Elem a)
sf
takePrefixER i :: Int
i s :: Int
s (Two _ b :: Elem a
b) m :: FingerTree (Node (Elem a))
m sf :: Digit (Elem a)
sf
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 1 = Int
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> FingerTree (Elem a)
forall a. Int -> FingerTree (Node a) -> Digit a -> FingerTree a
pullL (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- 2) FingerTree (Node (Elem a))
m Digit (Elem a)
sf
| Bool
otherwise = 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
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) (Elem a -> Digit (Elem a)
forall a. a -> Digit a
One Elem a
b) FingerTree (Node (Elem a))
m Digit (Elem a)
sf
takePrefixER i :: Int
i s :: Int
s (Three _ b :: Elem a
b c :: Elem a
c) m :: FingerTree (Node (Elem a))
m sf :: Digit (Elem a)
sf
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 1 = Int
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> FingerTree (Elem a)
forall a. Int -> FingerTree (Node a) -> Digit a -> FingerTree a
pullL (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- 3) FingerTree (Node (Elem a))
m Digit (Elem a)
sf
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 2 = 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
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- 2) (Elem a -> Digit (Elem a)
forall a. a -> Digit a
One Elem a
c) FingerTree (Node (Elem a))
m Digit (Elem a)
sf
| Bool
otherwise = 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
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) (Elem a -> Elem a -> Digit (Elem a)
forall a. a -> a -> Digit a
Two Elem a
b Elem a
c) FingerTree (Node (Elem a))
m Digit (Elem a)
sf
takePrefixER i :: Int
i s :: Int
s (Four _ b :: Elem a
b c :: Elem a
c d :: Elem a
d) m :: FingerTree (Node (Elem a))
m sf :: Digit (Elem a)
sf
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 1 = Int
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> FingerTree (Elem a)
forall a. Int -> FingerTree (Node a) -> Digit a -> FingerTree a
pullL (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- 4) FingerTree (Node (Elem a))
m Digit (Elem a)
sf
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 2 = 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
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- 3) (Elem a -> Digit (Elem a)
forall a. a -> Digit a
One Elem a
d) FingerTree (Node (Elem a))
m Digit (Elem a)
sf
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 3 = 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
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- 2) (Elem a -> Elem a -> Digit (Elem a)
forall a. a -> a -> Digit a
Two Elem a
c Elem a
d) FingerTree (Node (Elem a))
m Digit (Elem a)
sf
| Bool
otherwise = 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
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) (Elem a -> Elem a -> Elem a -> Digit (Elem a)
forall a. a -> a -> a -> Digit a
Three Elem a
b Elem a
c Elem a
d) FingerTree (Node (Elem a))
m Digit (Elem a)
sf
takePrefixNR :: Int -> Int -> Digit (Node a) -> FingerTree (Node (Node a)) -> Digit (Node a) ->
StrictPair (Node a) (FingerTree (Node a))
takePrefixNR :: Int
-> Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> StrictPair (Node a) (FingerTree (Node a))
takePrefixNR !Int
_i !Int
s (One a :: Node a
a) m :: FingerTree (Node (Node a))
m sf :: Digit (Node a)
sf = Node a
a Node a
-> FingerTree (Node a) -> StrictPair (Node a) (FingerTree (Node a))
forall a b. a -> b -> StrictPair a b
:*: Int
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> FingerTree (Node a)
forall a. Int -> FingerTree (Node a) -> Digit a -> FingerTree a
pullL (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- Node a -> Int
forall a. Sized a => a -> Int
size Node a
a) FingerTree (Node (Node a))
m Digit (Node a)
sf
takePrefixNR i :: Int
i s :: Int
s (Two a :: Node a
a b :: Node a
b) m :: FingerTree (Node (Node a))
m sf :: Digit (Node a)
sf
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
sb = Node a
b Node a
-> FingerTree (Node a) -> StrictPair (Node a) (FingerTree (Node a))
forall a b. a -> b -> StrictPair a b
:*: Int
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> FingerTree (Node a)
forall a. Int -> FingerTree (Node a) -> Digit a -> FingerTree a
pullL (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sb Int -> Int -> Int
forall a. Num a => a -> a -> a
- Node a -> Int
forall a. Sized a => a -> Int
size Node a
a) FingerTree (Node (Node a))
m Digit (Node a)
sf
| Bool
otherwise = Node a
a Node a
-> FingerTree (Node a) -> StrictPair (Node a) (FingerTree (Node a))
forall a b. a -> b -> StrictPair a b
:*: 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
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- Node a -> Int
forall a. Sized a => a -> Int
size Node a
a) (Node a -> Digit (Node a)
forall a. a -> Digit a
One Node a
b) FingerTree (Node (Node a))
m Digit (Node a)
sf
where
sb :: Int
sb = Node a -> Int
forall a. Sized a => a -> Int
size Node a
b
takePrefixNR i :: Int
i s :: Int
s (Three a :: Node a
a b :: Node a
b c :: Node a
c) m :: FingerTree (Node (Node a))
m sf :: Digit (Node a)
sf
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
sc = Node a
c Node a
-> FingerTree (Node a) -> StrictPair (Node a) (FingerTree (Node a))
forall a b. a -> b -> StrictPair a b
:*: Int
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> FingerTree (Node a)
forall a. Int -> FingerTree (Node a) -> Digit a -> FingerTree a
pullL (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sbc Int -> Int -> Int
forall a. Num a => a -> a -> a
- Node a -> Int
forall a. Sized a => a -> Int
size Node a
a) FingerTree (Node (Node a))
m Digit (Node a)
sf
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
sbc = Node a
b Node a
-> FingerTree (Node a) -> StrictPair (Node a) (FingerTree (Node a))
forall a b. a -> b -> StrictPair a b
:*: 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
s 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
a) (Node a -> Digit (Node a)
forall a. a -> Digit a
One Node a
c) FingerTree (Node (Node a))
m Digit (Node a)
sf
| Bool
otherwise = Node a
a Node a
-> FingerTree (Node a) -> StrictPair (Node a) (FingerTree (Node a))
forall a b. a -> b -> StrictPair a b
:*: 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
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- Node a -> Int
forall a. Sized a => a -> Int
size Node a
a) (Node a -> Node a -> Digit (Node a)
forall a. a -> a -> Digit a
Two Node a
b Node a
c) FingerTree (Node (Node a))
m Digit (Node a)
sf
where
sc :: Int
sc = Node a -> Int
forall a. Sized a => a -> Int
size Node a
c
sbc :: Int
sbc = Int
sc Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Node a -> Int
forall a. Sized a => a -> Int
size Node a
b
takePrefixNR i :: Int
i s :: Int
s (Four a :: Node a
a b :: Node a
b c :: Node a
c d :: Node a
d) m :: FingerTree (Node (Node a))
m sf :: Digit (Node a)
sf
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
sd = Node a
d Node a
-> FingerTree (Node a) -> StrictPair (Node a) (FingerTree (Node a))
forall a b. a -> b -> StrictPair a b
:*: Int
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> FingerTree (Node a)
forall a. Int -> FingerTree (Node a) -> Digit a -> FingerTree a
pullL (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sd Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sabc) FingerTree (Node (Node a))
m Digit (Node a)
sf
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
scd = Node a
c Node a
-> FingerTree (Node a) -> StrictPair (Node a) (FingerTree (Node a))
forall a b. a -> b -> StrictPair a b
:*: 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
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sabc) (Node a -> Digit (Node a)
forall a. a -> Digit a
One Node a
d) FingerTree (Node (Node a))
m Digit (Node a)
sf
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
sbcd = Node a
b Node a
-> FingerTree (Node a) -> StrictPair (Node a) (FingerTree (Node a))
forall a b. a -> b -> StrictPair a b
:*: 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
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sab) (Node a -> Node a -> Digit (Node a)
forall a. a -> a -> Digit a
Two Node a
c Node a
d) FingerTree (Node (Node a))
m Digit (Node a)
sf
| Bool
otherwise = Node a
a Node a
-> FingerTree (Node a) -> StrictPair (Node a) (FingerTree (Node a))
forall a b. a -> b -> StrictPair a b
:*: 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
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sa) (Node a -> Node a -> Node a -> Digit (Node a)
forall a. a -> a -> a -> Digit a
Three Node a
b Node a
c Node a
d) FingerTree (Node (Node a))
m Digit (Node a)
sf
where
sa :: Int
sa = Node a -> Int
forall a. Sized a => a -> Int
size Node a
a
sab :: Int
sab = Int
sa Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Node a -> Int
forall a. Sized a => a -> Int
size Node a
b
sabc :: Int
sabc = Int
sab Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Node a -> Int
forall a. Sized a => a -> Int
size Node a
c
sd :: Int
sd = Node a -> Int
forall a. Sized a => a -> Int
size Node a
d
scd :: Int
scd = Node a -> Int
forall a. Sized a => a -> Int
size Node a
c Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
sd
sbcd :: Int
sbcd = Node a -> Int
forall a. Sized a => a -> Int
size Node a
b Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
scd
splitAt :: Int -> Seq a -> (Seq a, Seq a)
splitAt :: Int -> Seq a -> (Seq a, Seq a)
splitAt i :: Int
i xs :: Seq a
xs@(Seq t :: FingerTree (Elem a)
t)
| Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i Word -> Word -> Word
forall a. Num a => a -> a -> a
- 1 Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
< (Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Seq a -> Int
forall a. Seq a -> Int
length Seq a
xs) Word -> Word -> Word
forall a. Num a => a -> a -> a
- 1 :: Word) =
case Int
-> FingerTree (Elem a)
-> StrictPair (FingerTree (Elem a)) (FingerTree (Elem a))
forall a.
Int
-> FingerTree (Elem a)
-> StrictPair (FingerTree (Elem a)) (FingerTree (Elem a))
splitTreeE Int
i FingerTree (Elem a)
t of
l :: FingerTree (Elem a)
l :*: r :: FingerTree (Elem a)
r -> (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)
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 0 = (Seq a
forall a. Seq a
empty, Seq a
xs)
| Bool
otherwise = (Seq a
xs, Seq a
forall a. Seq a
empty)
uncheckedSplitAt :: Int -> Seq a -> (Seq a, Seq a)
uncheckedSplitAt :: Int -> Seq a -> (Seq a, Seq a)
uncheckedSplitAt i :: Int
i (Seq xs :: FingerTree (Elem a)
xs) = case Int
-> FingerTree (Elem a)
-> StrictPair (FingerTree (Elem a)) (FingerTree (Elem a))
forall a.
Int
-> FingerTree (Elem a)
-> StrictPair (FingerTree (Elem a)) (FingerTree (Elem a))
splitTreeE Int
i FingerTree (Elem a)
xs of
l :: FingerTree (Elem a)
l :*: r :: FingerTree (Elem a)
r -> (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)
data Split a = Split !(FingerTree (Node a)) !(Node a) !(FingerTree (Node a))
#ifdef TESTING
deriving Show
#endif
splitTreeE :: Int -> FingerTree (Elem a) -> StrictPair (FingerTree (Elem a)) (FingerTree (Elem a))
splitTreeE :: Int
-> FingerTree (Elem a)
-> StrictPair (FingerTree (Elem a)) (FingerTree (Elem a))
splitTreeE !Int
_i EmptyT = FingerTree (Elem a)
forall a. FingerTree a
EmptyT FingerTree (Elem a)
-> FingerTree (Elem a)
-> StrictPair (FingerTree (Elem a)) (FingerTree (Elem a))
forall a b. a -> b -> StrictPair a b
:*: FingerTree (Elem a)
forall a. FingerTree a
EmptyT
splitTreeE i :: Int
i t :: FingerTree (Elem a)
t@(Single _)
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 0 = FingerTree (Elem a)
forall a. FingerTree a
EmptyT FingerTree (Elem a)
-> FingerTree (Elem a)
-> StrictPair (FingerTree (Elem a)) (FingerTree (Elem a))
forall a b. a -> b -> StrictPair a b
:*: FingerTree (Elem a)
t
| Bool
otherwise = FingerTree (Elem a)
t FingerTree (Elem a)
-> FingerTree (Elem a)
-> StrictPair (FingerTree (Elem a)) (FingerTree (Elem a))
forall a b. a -> b -> StrictPair a b
:*: FingerTree (Elem a)
forall a. FingerTree a
EmptyT
splitTreeE i :: Int
i (Deep s :: Int
s pr :: Digit (Elem a)
pr m :: FingerTree (Node (Elem a))
m sf :: Digit (Elem a)
sf)
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
spr = Int
-> Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> StrictPair (FingerTree (Elem a)) (FingerTree (Elem a))
forall a.
Int
-> Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> StrictPair (FingerTree (Elem a)) (FingerTree (Elem a))
splitPrefixE Int
i Int
s Digit (Elem a)
pr FingerTree (Node (Elem a))
m Digit (Elem a)
sf
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
spm = case Int -> FingerTree (Node (Elem a)) -> Split (Elem a)
forall a. Int -> FingerTree (Node a) -> Split a
splitTreeN Int
im FingerTree (Node (Elem a))
m of
Split ml :: FingerTree (Node (Elem a))
ml xs :: Node (Elem a)
xs mr :: FingerTree (Node (Elem a))
mr -> Int
-> Int
-> Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> Node (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> StrictPair (FingerTree (Elem a)) (FingerTree (Elem a))
forall a.
Int
-> Int
-> Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> Node (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> StrictPair (FingerTree (Elem a)) (FingerTree (Elem a))
splitMiddleE (Int
im Int -> Int -> Int
forall a. Num a => a -> a -> a
- FingerTree (Node (Elem a)) -> Int
forall a. Sized a => a -> Int
size FingerTree (Node (Elem a))
ml) Int
s Int
spr Digit (Elem a)
pr FingerTree (Node (Elem a))
ml Node (Elem a)
xs FingerTree (Node (Elem a))
mr Digit (Elem a)
sf
| Bool
otherwise = Int
-> Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> StrictPair (FingerTree (Elem a)) (FingerTree (Elem a))
forall a.
Int
-> Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> StrictPair (FingerTree (Elem a)) (FingerTree (Elem a))
splitSuffixE (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
spm) Int
s Digit (Elem a)
pr FingerTree (Node (Elem a))
m Digit (Elem a)
sf
where
spr :: Int
spr = Digit (Elem a) -> Int
forall a. Sized a => a -> Int
size Digit (Elem a)
pr
spm :: Int
spm = Int
spr Int -> Int -> Int
forall a. Num a => a -> a -> a
+ FingerTree (Node (Elem a)) -> Int
forall a. Sized a => a -> Int
size FingerTree (Node (Elem a))
m
im :: Int
im = Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
spr
splitTreeN :: Int -> FingerTree (Node a) -> Split a
splitTreeN :: Int -> FingerTree (Node a) -> Split a
splitTreeN !Int
_i EmptyT = [Char] -> Split a
forall a. HasCallStack => [Char] -> a
error "splitTreeN of empty tree"
splitTreeN _i :: Int
_i (Single x :: Node a
x) = FingerTree (Node a) -> Node a -> FingerTree (Node a) -> Split a
forall a.
FingerTree (Node a) -> Node a -> FingerTree (Node a) -> Split a
Split FingerTree (Node a)
forall a. FingerTree a
EmptyT Node a
x FingerTree (Node a)
forall a. FingerTree a
EmptyT
splitTreeN i :: Int
i (Deep s :: Int
s pr :: Digit (Node a)
pr m :: FingerTree (Node (Node a))
m sf :: Digit (Node a)
sf)
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
spr = Int
-> Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> Split a
forall a.
Int
-> Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> Split a
splitPrefixN Int
i Int
s Digit (Node a)
pr FingerTree (Node (Node a))
m Digit (Node a)
sf
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
spm = case Int -> FingerTree (Node (Node a)) -> Split (Node a)
forall a. Int -> FingerTree (Node a) -> Split a
splitTreeN Int
im FingerTree (Node (Node a))
m of
Split ml :: FingerTree (Node (Node a))
ml xs :: Node (Node a)
xs mr :: FingerTree (Node (Node a))
mr -> Int
-> Int
-> Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> Node (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> Split a
forall a.
Int
-> Int
-> Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> Node (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> Split a
splitMiddleN (Int
im Int -> Int -> Int
forall a. Num a => a -> a -> a
- FingerTree (Node (Node a)) -> Int
forall a. Sized a => a -> Int
size FingerTree (Node (Node a))
ml) Int
s Int
spr Digit (Node a)
pr FingerTree (Node (Node a))
ml Node (Node a)
xs FingerTree (Node (Node a))
mr Digit (Node a)
sf
| Bool
otherwise = Int
-> Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> Split a
forall a.
Int
-> Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> Split a
splitSuffixN (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
spm) Int
s Digit (Node a)
pr FingerTree (Node (Node a))
m Digit (Node a)
sf where
spr :: Int
spr = Digit (Node a) -> Int
forall a. Sized a => a -> Int
size Digit (Node a)
pr
spm :: Int
spm = Int
spr Int -> Int -> Int
forall a. Num a => a -> a -> a
+ FingerTree (Node (Node a)) -> Int
forall a. Sized a => a -> Int
size FingerTree (Node (Node a))
m
im :: Int
im = Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
spr
splitMiddleN :: Int -> Int -> Int
-> Digit (Node a) -> FingerTree (Node (Node a)) -> Node (Node a) -> FingerTree (Node (Node a)) -> Digit (Node a)
-> Split a
splitMiddleN :: Int
-> Int
-> Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> Node (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> Split a
splitMiddleN i :: Int
i s :: Int
s spr :: Int
spr pr :: Digit (Node a)
pr ml :: FingerTree (Node (Node a))
ml (Node2 _ a :: Node a
a b :: Node a
b) mr :: FingerTree (Node (Node a))
mr sf :: Digit (Node a)
sf
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
sa = FingerTree (Node a) -> Node a -> FingerTree (Node a) -> Split a
forall a.
FingerTree (Node a) -> Node a -> FingerTree (Node a) -> Split a
Split (Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node a)
forall a. Int -> Digit a -> FingerTree (Node a) -> FingerTree a
pullR Int
sprml Digit (Node a)
pr FingerTree (Node (Node a))
ml) Node a
a (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
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sprmla) (Node a -> Digit (Node a)
forall a. a -> Digit a
One Node a
b) FingerTree (Node (Node a))
mr Digit (Node a)
sf)
| Bool
otherwise = FingerTree (Node a) -> Node a -> FingerTree (Node a) -> Split a
forall a.
FingerTree (Node a) -> Node a -> FingerTree (Node a) -> Split a
Split (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
sprmla Digit (Node a)
pr FingerTree (Node (Node a))
ml (Node a -> Digit (Node a)
forall a. a -> Digit a
One Node a
a)) Node a
b (Int
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> FingerTree (Node a)
forall a. Int -> FingerTree (Node a) -> Digit a -> FingerTree a
pullL (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sprmla Int -> Int -> Int
forall a. Num a => a -> a -> a
- Node a -> Int
forall a. Sized a => a -> Int
size Node a
b) FingerTree (Node (Node a))
mr Digit (Node a)
sf)
where
sa :: Int
sa = Node a -> Int
forall a. Sized a => a -> Int
size Node a
a
sprml :: Int
sprml = Int
spr Int -> Int -> Int
forall a. Num a => a -> a -> a
+ FingerTree (Node (Node a)) -> Int
forall a. Sized a => a -> Int
size FingerTree (Node (Node a))
ml
sprmla :: Int
sprmla = Int
sa Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
sprml
splitMiddleN i :: Int
i s :: Int
s spr :: Int
spr pr :: Digit (Node a)
pr ml :: FingerTree (Node (Node a))
ml (Node3 _ a :: Node a
a b :: Node a
b c :: Node a
c) mr :: FingerTree (Node (Node a))
mr sf :: Digit (Node a)
sf
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
sa = FingerTree (Node a) -> Node a -> FingerTree (Node a) -> Split a
forall a.
FingerTree (Node a) -> Node a -> FingerTree (Node a) -> Split a
Split (Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node a)
forall a. Int -> Digit a -> FingerTree (Node a) -> FingerTree a
pullR Int
sprml Digit (Node a)
pr FingerTree (Node (Node a))
ml) Node a
a (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
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sprmla) (Node a -> Node a -> Digit (Node a)
forall a. a -> a -> Digit a
Two Node a
b Node a
c) FingerTree (Node (Node a))
mr Digit (Node a)
sf)
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
sab = FingerTree (Node a) -> Node a -> FingerTree (Node a) -> Split a
forall a.
FingerTree (Node a) -> Node a -> FingerTree (Node a) -> Split a
Split (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
sprmla Digit (Node a)
pr FingerTree (Node (Node a))
ml (Node a -> Digit (Node a)
forall a. a -> Digit a
One Node a
a)) Node a
b (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
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sprmlab) (Node a -> Digit (Node a)
forall a. a -> Digit a
One Node a
c) FingerTree (Node (Node a))
mr Digit (Node a)
sf)
| Bool
otherwise = FingerTree (Node a) -> Node a -> FingerTree (Node a) -> Split a
forall a.
FingerTree (Node a) -> Node a -> FingerTree (Node a) -> Split a
Split (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
sprmlab Digit (Node a)
pr FingerTree (Node (Node a))
ml (Node a -> Node a -> Digit (Node a)
forall a. a -> a -> Digit a
Two Node a
a Node a
b)) Node a
c (Int
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> FingerTree (Node a)
forall a. Int -> FingerTree (Node a) -> Digit a -> FingerTree a
pullL (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sprmlab Int -> Int -> Int
forall a. Num a => a -> a -> a
- Node a -> Int
forall a. Sized a => a -> Int
size Node a
c) FingerTree (Node (Node a))
mr Digit (Node a)
sf)
where
sa :: Int
sa = Node a -> Int
forall a. Sized a => a -> Int
size Node a
a
sab :: Int
sab = Int
sa Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Node a -> Int
forall a. Sized a => a -> Int
size Node a
b
sprml :: Int
sprml = Int
spr Int -> Int -> Int
forall a. Num a => a -> a -> a
+ FingerTree (Node (Node a)) -> Int
forall a. Sized a => a -> Int
size FingerTree (Node (Node a))
ml
sprmla :: Int
sprmla = Int
sa Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
sprml
sprmlab :: Int
sprmlab = Int
sprmla Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Node a -> Int
forall a. Sized a => a -> Int
size Node a
b
splitMiddleE :: Int -> Int -> Int
-> Digit (Elem a) -> FingerTree (Node (Elem a)) -> Node (Elem a) -> FingerTree (Node (Elem a)) -> Digit (Elem a)
-> StrictPair (FingerTree (Elem a)) (FingerTree (Elem a))
splitMiddleE :: Int
-> Int
-> Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> Node (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> StrictPair (FingerTree (Elem a)) (FingerTree (Elem a))
splitMiddleE i :: Int
i s :: Int
s spr :: Int
spr pr :: Digit (Elem a)
pr ml :: FingerTree (Node (Elem a))
ml (Node2 _ a :: Elem a
a b :: Elem a
b) mr :: FingerTree (Node (Elem a))
mr sf :: Digit (Elem a)
sf
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 1 = Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> FingerTree (Elem a)
forall a. Int -> Digit a -> FingerTree (Node a) -> FingerTree a
pullR Int
sprml Digit (Elem a)
pr FingerTree (Node (Elem a))
ml FingerTree (Elem a)
-> FingerTree (Elem a)
-> StrictPair (FingerTree (Elem a)) (FingerTree (Elem a))
forall a b. a -> b -> StrictPair a b
:*: 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
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sprml) (Elem a -> Elem a -> Digit (Elem a)
forall a. a -> a -> Digit a
Two Elem a
a Elem a
b) FingerTree (Node (Elem a))
mr Digit (Elem a)
sf
| Bool
otherwise = 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
sprmla Digit (Elem a)
pr FingerTree (Node (Elem a))
ml (Elem a -> Digit (Elem a)
forall a. a -> Digit a
One Elem a
a) FingerTree (Elem a)
-> FingerTree (Elem a)
-> StrictPair (FingerTree (Elem a)) (FingerTree (Elem a))
forall a b. a -> b -> StrictPair a b
:*: 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
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sprmla) (Elem a -> Digit (Elem a)
forall a. a -> Digit a
One Elem a
b) FingerTree (Node (Elem a))
mr Digit (Elem a)
sf
where
sprml :: Int
sprml = Int
spr Int -> Int -> Int
forall a. Num a => a -> a -> a
+ FingerTree (Node (Elem a)) -> Int
forall a. Sized a => a -> Int
size FingerTree (Node (Elem a))
ml
sprmla :: Int
sprmla = 1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
sprml
splitMiddleE i :: Int
i s :: Int
s spr :: Int
spr pr :: Digit (Elem a)
pr ml :: FingerTree (Node (Elem a))
ml (Node3 _ a :: Elem a
a b :: Elem a
b c :: Elem a
c) mr :: FingerTree (Node (Elem a))
mr sf :: Digit (Elem a)
sf = case Int
i of
0 -> Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> FingerTree (Elem a)
forall a. Int -> Digit a -> FingerTree (Node a) -> FingerTree a
pullR Int
sprml Digit (Elem a)
pr FingerTree (Node (Elem a))
ml FingerTree (Elem a)
-> FingerTree (Elem a)
-> StrictPair (FingerTree (Elem a)) (FingerTree (Elem a))
forall a b. a -> b -> StrictPair a b
:*: 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
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sprml) (Elem a -> Elem a -> Elem a -> Digit (Elem a)
forall a. a -> a -> a -> Digit a
Three Elem a
a Elem a
b Elem a
c) FingerTree (Node (Elem a))
mr Digit (Elem a)
sf
1 -> 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
sprmla Digit (Elem a)
pr FingerTree (Node (Elem a))
ml (Elem a -> Digit (Elem a)
forall a. a -> Digit a
One Elem a
a) FingerTree (Elem a)
-> FingerTree (Elem a)
-> StrictPair (FingerTree (Elem a)) (FingerTree (Elem a))
forall a b. a -> b -> StrictPair a b
:*: 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
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sprmla) (Elem a -> Elem a -> Digit (Elem a)
forall a. a -> a -> Digit a
Two Elem a
b Elem a
c) FingerTree (Node (Elem a))
mr Digit (Elem a)
sf
_ -> 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
sprmlab Digit (Elem a)
pr FingerTree (Node (Elem a))
ml (Elem a -> Elem a -> Digit (Elem a)
forall a. a -> a -> Digit a
Two Elem a
a Elem a
b) FingerTree (Elem a)
-> FingerTree (Elem a)
-> StrictPair (FingerTree (Elem a)) (FingerTree (Elem a))
forall a b. a -> b -> StrictPair a b
:*: 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
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sprmlab) (Elem a -> Digit (Elem a)
forall a. a -> Digit a
One Elem a
c) FingerTree (Node (Elem a))
mr Digit (Elem a)
sf
where
sprml :: Int
sprml = Int
spr Int -> Int -> Int
forall a. Num a => a -> a -> a
+ FingerTree (Node (Elem a)) -> Int
forall a. Sized a => a -> Int
size FingerTree (Node (Elem a))
ml
sprmla :: Int
sprmla = 1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
sprml
sprmlab :: Int
sprmlab = Int
sprmla Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1
splitPrefixE :: Int -> Int -> Digit (Elem a) -> FingerTree (Node (Elem a)) -> Digit (Elem a) ->
StrictPair (FingerTree (Elem a)) (FingerTree (Elem a))
splitPrefixE :: Int
-> Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> StrictPair (FingerTree (Elem a)) (FingerTree (Elem a))
splitPrefixE !Int
_i !Int
s (One a :: Elem a
a) m :: FingerTree (Node (Elem a))
m sf :: Digit (Elem a)
sf = FingerTree (Elem a)
forall a. FingerTree a
EmptyT FingerTree (Elem a)
-> FingerTree (Elem a)
-> StrictPair (FingerTree (Elem a)) (FingerTree (Elem a))
forall a b. a -> b -> StrictPair a b
:*: 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
s (Elem a -> Digit (Elem a)
forall a. a -> Digit a
One Elem a
a) FingerTree (Node (Elem a))
m Digit (Elem a)
sf
splitPrefixE i :: Int
i s :: Int
s (Two a :: Elem a
a b :: Elem a
b) m :: FingerTree (Node (Elem a))
m sf :: Digit (Elem a)
sf = case Int
i of
0 -> FingerTree (Elem a)
forall a. FingerTree a
EmptyT FingerTree (Elem a)
-> FingerTree (Elem a)
-> StrictPair (FingerTree (Elem a)) (FingerTree (Elem a))
forall a b. a -> b -> StrictPair a b
:*: 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
s (Elem a -> Elem a -> Digit (Elem a)
forall a. a -> a -> Digit a
Two Elem a
a Elem a
b) FingerTree (Node (Elem a))
m Digit (Elem a)
sf
_ -> Elem a -> FingerTree (Elem a)
forall a. a -> FingerTree a
Single Elem a
a FingerTree (Elem a)
-> FingerTree (Elem a)
-> StrictPair (FingerTree (Elem a)) (FingerTree (Elem a))
forall a b. a -> b -> StrictPair a b
:*: 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
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) (Elem a -> Digit (Elem a)
forall a. a -> Digit a
One Elem a
b) FingerTree (Node (Elem a))
m Digit (Elem a)
sf
splitPrefixE i :: Int
i s :: Int
s (Three a :: Elem a
a b :: Elem a
b c :: Elem a
c) m :: FingerTree (Node (Elem a))
m sf :: Digit (Elem a)
sf = case Int
i of
0 -> FingerTree (Elem a)
forall a. FingerTree a
EmptyT FingerTree (Elem a)
-> FingerTree (Elem a)
-> StrictPair (FingerTree (Elem a)) (FingerTree (Elem a))
forall a b. a -> b -> StrictPair a b
:*: 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
s (Elem a -> Elem a -> Elem a -> Digit (Elem a)
forall a. a -> a -> a -> Digit a
Three Elem a
a Elem a
b Elem a
c) FingerTree (Node (Elem a))
m Digit (Elem a)
sf
1 -> Elem a -> FingerTree (Elem a)
forall a. a -> FingerTree a
Single Elem a
a FingerTree (Elem a)
-> FingerTree (Elem a)
-> StrictPair (FingerTree (Elem a)) (FingerTree (Elem a))
forall a b. a -> b -> StrictPair a b
:*: 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
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) (Elem a -> Elem a -> Digit (Elem a)
forall a. a -> a -> Digit a
Two Elem a
b Elem a
c) FingerTree (Node (Elem a))
m Digit (Elem a)
sf
_ -> 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 2 (Elem a -> Digit (Elem a)
forall a. a -> Digit a
One Elem a
a) FingerTree (Node (Elem a))
forall a. FingerTree a
EmptyT (Elem a -> Digit (Elem a)
forall a. a -> Digit a
One Elem a
b) FingerTree (Elem a)
-> FingerTree (Elem a)
-> StrictPair (FingerTree (Elem a)) (FingerTree (Elem a))
forall a b. a -> b -> StrictPair a b
:*: 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
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- 2) (Elem a -> Digit (Elem a)
forall a. a -> Digit a
One Elem a
c) FingerTree (Node (Elem a))
m Digit (Elem a)
sf
splitPrefixE i :: Int
i s :: Int
s (Four a :: Elem a
a b :: Elem a
b c :: Elem a
c d :: Elem a
d) m :: FingerTree (Node (Elem a))
m sf :: Digit (Elem a)
sf = case Int
i of
0 -> FingerTree (Elem a)
forall a. FingerTree a
EmptyT FingerTree (Elem a)
-> FingerTree (Elem a)
-> StrictPair (FingerTree (Elem a)) (FingerTree (Elem a))
forall a b. a -> b -> StrictPair a b
:*: 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
s (Elem a -> Elem a -> Elem a -> Elem a -> Digit (Elem a)
forall a. a -> a -> a -> a -> Digit a
Four Elem a
a Elem a
b Elem a
c Elem a
d) FingerTree (Node (Elem a))
m Digit (Elem a)
sf
1 -> Elem a -> FingerTree (Elem a)
forall a. a -> FingerTree a
Single Elem a
a FingerTree (Elem a)
-> FingerTree (Elem a)
-> StrictPair (FingerTree (Elem a)) (FingerTree (Elem a))
forall a b. a -> b -> StrictPair a b
:*: 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
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) (Elem a -> Elem a -> Elem a -> Digit (Elem a)
forall a. a -> a -> a -> Digit a
Three Elem a
b Elem a
c Elem a
d) FingerTree (Node (Elem a))
m Digit (Elem a)
sf
2 -> 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 2 (Elem a -> Digit (Elem a)
forall a. a -> Digit a
One Elem a
a) FingerTree (Node (Elem a))
forall a. FingerTree a
EmptyT (Elem a -> Digit (Elem a)
forall a. a -> Digit a
One Elem a
b) FingerTree (Elem a)
-> FingerTree (Elem a)
-> StrictPair (FingerTree (Elem a)) (FingerTree (Elem a))
forall a b. a -> b -> StrictPair a b
:*: 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
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- 2) (Elem a -> Elem a -> Digit (Elem a)
forall a. a -> a -> Digit a
Two Elem a
c Elem a
d) FingerTree (Node (Elem a))
m Digit (Elem a)
sf
_ -> 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 3 (Elem a -> Elem a -> Digit (Elem a)
forall a. a -> a -> Digit a
Two Elem a
a Elem a
b) FingerTree (Node (Elem a))
forall a. FingerTree a
EmptyT (Elem a -> Digit (Elem a)
forall a. a -> Digit a
One Elem a
c) FingerTree (Elem a)
-> FingerTree (Elem a)
-> StrictPair (FingerTree (Elem a)) (FingerTree (Elem a))
forall a b. a -> b -> StrictPair a b
:*: 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
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- 3) (Elem a -> Digit (Elem a)
forall a. a -> Digit a
One Elem a
d) FingerTree (Node (Elem a))
m Digit (Elem a)
sf
splitPrefixN :: Int -> Int -> Digit (Node a) -> FingerTree (Node (Node a)) -> Digit (Node a) ->
Split a
splitPrefixN :: Int
-> Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> Split a
splitPrefixN !Int
_i !Int
s (One a :: Node a
a) m :: FingerTree (Node (Node a))
m sf :: Digit (Node a)
sf = FingerTree (Node a) -> Node a -> FingerTree (Node a) -> Split a
forall a.
FingerTree (Node a) -> Node a -> FingerTree (Node a) -> Split a
Split FingerTree (Node a)
forall a. FingerTree a
EmptyT Node a
a (Int
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> FingerTree (Node a)
forall a. Int -> FingerTree (Node a) -> Digit a -> FingerTree a
pullL (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- Node a -> Int
forall a. Sized a => a -> Int
size Node a
a) FingerTree (Node (Node a))
m Digit (Node a)
sf)
splitPrefixN i :: Int
i s :: Int
s (Two a :: Node a
a b :: Node a
b) m :: FingerTree (Node (Node a))
m sf :: Digit (Node a)
sf
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
sa = FingerTree (Node a) -> Node a -> FingerTree (Node a) -> Split a
forall a.
FingerTree (Node a) -> Node a -> FingerTree (Node a) -> Split a
Split FingerTree (Node a)
forall a. FingerTree a
EmptyT Node a
a (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
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sa) (Node a -> Digit (Node a)
forall a. a -> Digit a
One Node a
b) FingerTree (Node (Node a))
m Digit (Node a)
sf)
| Bool
otherwise = FingerTree (Node a) -> Node a -> FingerTree (Node a) -> Split a
forall a.
FingerTree (Node a) -> Node a -> FingerTree (Node a) -> Split a
Split (Node a -> FingerTree (Node a)
forall a. a -> FingerTree a
Single Node a
a) Node a
b (Int
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> FingerTree (Node a)
forall a. Int -> FingerTree (Node a) -> Digit a -> FingerTree a
pullL (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sa Int -> Int -> Int
forall a. Num a => a -> a -> a
- Node a -> Int
forall a. Sized a => a -> Int
size Node a
b) FingerTree (Node (Node a))
m Digit (Node a)
sf)
where
sa :: Int
sa = Node a -> Int
forall a. Sized a => a -> Int
size Node a
a
splitPrefixN i :: Int
i s :: Int
s (Three a :: Node a
a b :: Node a
b c :: Node a
c) m :: FingerTree (Node (Node a))
m sf :: Digit (Node a)
sf
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
sa = FingerTree (Node a) -> Node a -> FingerTree (Node a) -> Split a
forall a.
FingerTree (Node a) -> Node a -> FingerTree (Node a) -> Split a
Split FingerTree (Node a)
forall a. FingerTree a
EmptyT Node a
a (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
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sa) (Node a -> Node a -> Digit (Node a)
forall a. a -> a -> Digit a
Two Node a
b Node a
c) FingerTree (Node (Node a))
m Digit (Node a)
sf)
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
sab = FingerTree (Node a) -> Node a -> FingerTree (Node a) -> Split a
forall a.
FingerTree (Node a) -> Node a -> FingerTree (Node a) -> Split a
Split (Node a -> FingerTree (Node a)
forall a. a -> FingerTree a
Single Node a
a) Node a
b (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
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sab) (Node a -> Digit (Node a)
forall a. a -> Digit a
One Node a
c) FingerTree (Node (Node a))
m Digit (Node a)
sf)
| Bool
otherwise = FingerTree (Node a) -> Node a -> FingerTree (Node a) -> Split a
forall a.
FingerTree (Node a) -> Node a -> FingerTree (Node a) -> Split a
Split (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
sab (Node a -> Digit (Node a)
forall a. a -> Digit a
One Node a
a) FingerTree (Node (Node a))
forall a. FingerTree a
EmptyT (Node a -> Digit (Node a)
forall a. a -> Digit a
One Node a
b)) Node a
c (Int
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> FingerTree (Node a)
forall a. Int -> FingerTree (Node a) -> Digit a -> FingerTree a
pullL (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sab Int -> Int -> Int
forall a. Num a => a -> a -> a
- Node a -> Int
forall a. Sized a => a -> Int
size Node a
c) FingerTree (Node (Node a))
m Digit (Node a)
sf)
where
sa :: Int
sa = Node a -> Int
forall a. Sized a => a -> Int
size Node a
a
sab :: Int
sab = Int
sa Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Node a -> Int
forall a. Sized a => a -> Int
size Node a
b
splitPrefixN i :: Int
i s :: Int
s (Four a :: Node a
a b :: Node a
b c :: Node a
c d :: Node a
d) m :: FingerTree (Node (Node a))
m sf :: Digit (Node a)
sf
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
sa = FingerTree (Node a) -> Node a -> FingerTree (Node a) -> Split a
forall a.
FingerTree (Node a) -> Node a -> FingerTree (Node a) -> Split a
Split FingerTree (Node a)
forall a. FingerTree a
EmptyT Node a
a (FingerTree (Node a) -> Split a) -> FingerTree (Node a) -> Split a
forall a b. (a -> b) -> a -> b
$ 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
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sa) (Node a -> Node a -> Node a -> Digit (Node a)
forall a. a -> a -> a -> Digit a
Three Node a
b Node a
c Node a
d) FingerTree (Node (Node a))
m Digit (Node a)
sf
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
sab = FingerTree (Node a) -> Node a -> FingerTree (Node a) -> Split a
forall a.
FingerTree (Node a) -> Node a -> FingerTree (Node a) -> Split a
Split (Node a -> FingerTree (Node a)
forall a. a -> FingerTree a
Single Node a
a) Node a
b (FingerTree (Node a) -> Split a) -> FingerTree (Node a) -> Split a
forall a b. (a -> b) -> a -> b
$ 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
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sab) (Node a -> Node a -> Digit (Node a)
forall a. a -> a -> Digit a
Two Node a
c Node a
d) FingerTree (Node (Node a))
m Digit (Node a)
sf
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
sabc = FingerTree (Node a) -> Node a -> FingerTree (Node a) -> Split a
forall a.
FingerTree (Node a) -> Node a -> FingerTree (Node a) -> Split a
Split (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
sab (Node a -> Digit (Node a)
forall a. a -> Digit a
One Node a
a) FingerTree (Node (Node a))
forall a. FingerTree a
EmptyT (Node a -> Digit (Node a)
forall a. a -> Digit a
One Node a
b)) Node a
c (FingerTree (Node a) -> Split a) -> FingerTree (Node a) -> Split a
forall a b. (a -> b) -> a -> b
$ 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
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sabc) (Node a -> Digit (Node a)
forall a. a -> Digit a
One Node a
d) FingerTree (Node (Node a))
m Digit (Node a)
sf
| Bool
otherwise = FingerTree (Node a) -> Node a -> FingerTree (Node a) -> Split a
forall a.
FingerTree (Node a) -> Node a -> FingerTree (Node a) -> Split a
Split (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
sabc (Node a -> Node a -> Digit (Node a)
forall a. a -> a -> Digit a
Two Node a
a Node a
b) FingerTree (Node (Node a))
forall a. FingerTree a
EmptyT (Node a -> Digit (Node a)
forall a. a -> Digit a
One Node a
c)) Node a
d (FingerTree (Node a) -> Split a) -> FingerTree (Node a) -> Split a
forall a b. (a -> b) -> a -> b
$ Int
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> FingerTree (Node a)
forall a. Int -> FingerTree (Node a) -> Digit a -> FingerTree a
pullL (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sabc Int -> Int -> Int
forall a. Num a => a -> a -> a
- Node a -> Int
forall a. Sized a => a -> Int
size Node a
d) FingerTree (Node (Node a))
m Digit (Node a)
sf
where
sa :: Int
sa = Node a -> Int
forall a. Sized a => a -> Int
size Node a
a
sab :: Int
sab = Int
sa Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Node a -> Int
forall a. Sized a => a -> Int
size Node a
b
sabc :: Int
sabc = Int
sab Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Node a -> Int
forall a. Sized a => a -> Int
size Node a
c
splitSuffixE :: Int -> Int -> Digit (Elem a) -> FingerTree (Node (Elem a)) -> Digit (Elem a) ->
StrictPair (FingerTree (Elem a)) (FingerTree (Elem a))
splitSuffixE :: Int
-> Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> StrictPair (FingerTree (Elem a)) (FingerTree (Elem a))
splitSuffixE !Int
_i !Int
s pr :: Digit (Elem a)
pr m :: FingerTree (Node (Elem a))
m (One a :: Elem a
a) = Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> FingerTree (Elem a)
forall a. Int -> Digit a -> FingerTree (Node a) -> FingerTree a
pullR (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) Digit (Elem a)
pr FingerTree (Node (Elem a))
m FingerTree (Elem a)
-> FingerTree (Elem a)
-> StrictPair (FingerTree (Elem a)) (FingerTree (Elem a))
forall a b. a -> b -> StrictPair a b
:*: Elem a -> FingerTree (Elem a)
forall a. a -> FingerTree a
Single Elem a
a
splitSuffixE i :: Int
i s :: Int
s pr :: Digit (Elem a)
pr m :: FingerTree (Node (Elem a))
m (Two a :: Elem a
a b :: Elem a
b) = case Int
i of
0 -> Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> FingerTree (Elem a)
forall a. Int -> Digit a -> FingerTree (Node a) -> FingerTree a
pullR (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- 2) Digit (Elem a)
pr FingerTree (Node (Elem a))
m FingerTree (Elem a)
-> FingerTree (Elem a)
-> StrictPair (FingerTree (Elem a)) (FingerTree (Elem a))
forall a b. a -> b -> StrictPair a b
:*: 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 2 (Elem a -> Digit (Elem a)
forall a. a -> Digit a
One Elem a
a) FingerTree (Node (Elem a))
forall a. FingerTree a
EmptyT (Elem a -> Digit (Elem a)
forall a. a -> Digit a
One Elem a
b)
_ -> 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
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) Digit (Elem a)
pr FingerTree (Node (Elem a))
m (Elem a -> Digit (Elem a)
forall a. a -> Digit a
One Elem a
a) FingerTree (Elem a)
-> FingerTree (Elem a)
-> StrictPair (FingerTree (Elem a)) (FingerTree (Elem a))
forall a b. a -> b -> StrictPair a b
:*: Elem a -> FingerTree (Elem a)
forall a. a -> FingerTree a
Single Elem a
b
splitSuffixE i :: Int
i s :: Int
s pr :: Digit (Elem a)
pr m :: FingerTree (Node (Elem a))
m (Three a :: Elem a
a b :: Elem a
b c :: Elem a
c) = case Int
i of
0 -> Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> FingerTree (Elem a)
forall a. Int -> Digit a -> FingerTree (Node a) -> FingerTree a
pullR (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- 3) Digit (Elem a)
pr FingerTree (Node (Elem a))
m FingerTree (Elem a)
-> FingerTree (Elem a)
-> StrictPair (FingerTree (Elem a)) (FingerTree (Elem a))
forall a b. a -> b -> StrictPair a b
:*: 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 3 (Elem a -> Elem a -> Digit (Elem a)
forall a. a -> a -> Digit a
Two Elem a
a Elem a
b) FingerTree (Node (Elem a))
forall a. FingerTree a
EmptyT (Elem a -> Digit (Elem a)
forall a. a -> Digit a
One Elem a
c)
1 -> 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
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- 2) Digit (Elem a)
pr FingerTree (Node (Elem a))
m (Elem a -> Digit (Elem a)
forall a. a -> Digit a
One Elem a
a) FingerTree (Elem a)
-> FingerTree (Elem a)
-> StrictPair (FingerTree (Elem a)) (FingerTree (Elem a))
forall a b. a -> b -> StrictPair a b
:*: 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 2 (Elem a -> Digit (Elem a)
forall a. a -> Digit a
One Elem a
b) FingerTree (Node (Elem a))
forall a. FingerTree a
EmptyT (Elem a -> Digit (Elem a)
forall a. a -> Digit a
One Elem a
c)
_ -> 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
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) Digit (Elem a)
pr FingerTree (Node (Elem a))
m (Elem a -> Elem a -> Digit (Elem a)
forall a. a -> a -> Digit a
Two Elem a
a Elem a
b) FingerTree (Elem a)
-> FingerTree (Elem a)
-> StrictPair (FingerTree (Elem a)) (FingerTree (Elem a))
forall a b. a -> b -> StrictPair a b
:*: Elem a -> FingerTree (Elem a)
forall a. a -> FingerTree a
Single Elem a
c
splitSuffixE i :: Int
i s :: Int
s pr :: Digit (Elem a)
pr m :: FingerTree (Node (Elem a))
m (Four a :: Elem a
a b :: Elem a
b c :: Elem a
c d :: Elem a
d) = case Int
i of
0 -> Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> FingerTree (Elem a)
forall a. Int -> Digit a -> FingerTree (Node a) -> FingerTree a
pullR (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- 4) Digit (Elem a)
pr FingerTree (Node (Elem a))
m FingerTree (Elem a)
-> FingerTree (Elem a)
-> StrictPair (FingerTree (Elem a)) (FingerTree (Elem a))
forall a b. a -> b -> StrictPair a b
:*: 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 4 (Elem a -> Elem a -> Digit (Elem a)
forall a. a -> a -> Digit a
Two Elem a
a Elem a
b) FingerTree (Node (Elem a))
forall a. FingerTree a
EmptyT (Elem a -> Elem a -> Digit (Elem a)
forall a. a -> a -> Digit a
Two Elem a
c Elem a
d)
1 -> 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
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- 3) Digit (Elem a)
pr FingerTree (Node (Elem a))
m (Elem a -> Digit (Elem a)
forall a. a -> Digit a
One Elem a
a) FingerTree (Elem a)
-> FingerTree (Elem a)
-> StrictPair (FingerTree (Elem a)) (FingerTree (Elem a))
forall a b. a -> b -> StrictPair a b
:*: 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 3 (Elem a -> Elem a -> Digit (Elem a)
forall a. a -> a -> Digit a
Two Elem a
b Elem a
c) FingerTree (Node (Elem a))
forall a. FingerTree a
EmptyT (Elem a -> Digit (Elem a)
forall a. a -> Digit a
One Elem a
d)
2 -> 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
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- 2) Digit (Elem a)
pr FingerTree (Node (Elem a))
m (Elem a -> Elem a -> Digit (Elem a)
forall a. a -> a -> Digit a
Two Elem a
a Elem a
b) FingerTree (Elem a)
-> FingerTree (Elem a)
-> StrictPair (FingerTree (Elem a)) (FingerTree (Elem a))
forall a b. a -> b -> StrictPair a b
:*: 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 2 (Elem a -> Digit (Elem a)
forall a. a -> Digit a
One Elem a
c) FingerTree (Node (Elem a))
forall a. FingerTree a
EmptyT (Elem a -> Digit (Elem a)
forall a. a -> Digit a
One Elem a
d)
_ -> 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
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) Digit (Elem a)
pr FingerTree (Node (Elem a))
m (Elem a -> Elem a -> Elem a -> Digit (Elem a)
forall a. a -> a -> a -> Digit a
Three Elem a
a Elem a
b Elem a
c) FingerTree (Elem a)
-> FingerTree (Elem a)
-> StrictPair (FingerTree (Elem a)) (FingerTree (Elem a))
forall a b. a -> b -> StrictPair a b
:*: Elem a -> FingerTree (Elem a)
forall a. a -> FingerTree a
Single Elem a
d
splitSuffixN :: Int -> Int -> Digit (Node a) -> FingerTree (Node (Node a)) -> Digit (Node a) ->
Split a
splitSuffixN :: Int
-> Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> Split a
splitSuffixN !Int
_i !Int
s pr :: Digit (Node a)
pr m :: FingerTree (Node (Node a))
m (One a :: Node a
a) = FingerTree (Node a) -> Node a -> FingerTree (Node a) -> Split a
forall a.
FingerTree (Node a) -> Node a -> FingerTree (Node a) -> Split a
Split (Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node a)
forall a. Int -> Digit a -> FingerTree (Node a) -> FingerTree a
pullR (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- Node a -> Int
forall a. Sized a => a -> Int
size Node a
a) Digit (Node a)
pr FingerTree (Node (Node a))
m) Node a
a FingerTree (Node a)
forall a. FingerTree a
EmptyT
splitSuffixN i :: Int
i s :: Int
s pr :: Digit (Node a)
pr m :: FingerTree (Node (Node a))
m (Two a :: Node a
a b :: Node a
b)
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
sa = FingerTree (Node a) -> Node a -> FingerTree (Node a) -> Split a
forall a.
FingerTree (Node a) -> Node a -> FingerTree (Node a) -> Split a
Split (Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node a)
forall a. Int -> Digit a -> FingerTree (Node a) -> FingerTree a
pullR (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sa Int -> Int -> Int
forall a. Num a => a -> a -> a
- Node a -> Int
forall a. Sized a => a -> Int
size Node a
b) Digit (Node a)
pr FingerTree (Node (Node a))
m) Node a
a (Node a -> FingerTree (Node a)
forall a. a -> FingerTree a
Single Node a
b)
| Bool
otherwise = FingerTree (Node a) -> Node a -> FingerTree (Node a) -> Split a
forall a.
FingerTree (Node a) -> Node a -> FingerTree (Node a) -> Split a
Split (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
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- Node a -> Int
forall a. Sized a => a -> Int
size Node a
b) Digit (Node a)
pr FingerTree (Node (Node a))
m (Node a -> Digit (Node a)
forall a. a -> Digit a
One Node a
a)) Node a
b FingerTree (Node a)
forall a. FingerTree a
EmptyT
where
sa :: Int
sa = Node a -> Int
forall a. Sized a => a -> Int
size Node a
a
splitSuffixN i :: Int
i s :: Int
s pr :: Digit (Node a)
pr m :: FingerTree (Node (Node a))
m (Three a :: Node a
a b :: Node a
b c :: Node a
c)
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
sa = FingerTree (Node a) -> Node a -> FingerTree (Node a) -> Split a
forall a.
FingerTree (Node a) -> Node a -> FingerTree (Node a) -> Split a
Split (Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node a)
forall a. Int -> Digit a -> FingerTree (Node a) -> FingerTree a
pullR (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sab Int -> Int -> Int
forall a. Num a => a -> a -> a
- Node a -> Int
forall a. Sized a => a -> Int
size Node a
c) Digit (Node a)
pr FingerTree (Node (Node a))
m) Node a
a (Digit (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> FingerTree (Node a)
forall a.
Sized a =>
Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
deep (Node a -> Digit (Node a)
forall a. a -> Digit a
One Node a
b) FingerTree (Node (Node a))
forall a. FingerTree a
EmptyT (Node a -> Digit (Node a)
forall a. a -> Digit a
One Node a
c))
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
sab = FingerTree (Node a) -> Node a -> FingerTree (Node a) -> Split a
forall a.
FingerTree (Node a) -> Node a -> FingerTree (Node a) -> Split a
Split (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
s 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) Digit (Node a)
pr FingerTree (Node (Node a))
m (Node a -> Digit (Node a)
forall a. a -> Digit a
One Node a
a)) Node a
b (Node a -> FingerTree (Node a)
forall a. a -> FingerTree a
Single Node a
c)
| Bool
otherwise = FingerTree (Node a) -> Node a -> FingerTree (Node a) -> Split a
forall a.
FingerTree (Node a) -> Node a -> FingerTree (Node a) -> Split a
Split (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
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- Node a -> Int
forall a. Sized a => a -> Int
size Node a
c) Digit (Node a)
pr FingerTree (Node (Node a))
m (Node a -> Node a -> Digit (Node a)
forall a. a -> a -> Digit a
Two Node a
a Node a
b)) Node a
c FingerTree (Node a)
forall a. FingerTree a
EmptyT
where
sa :: Int
sa = Node a -> Int
forall a. Sized a => a -> Int
size Node a
a
sab :: Int
sab = Int
sa Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Node a -> Int
forall a. Sized a => a -> Int
size Node a
b
splitSuffixN i :: Int
i s :: Int
s pr :: Digit (Node a)
pr m :: FingerTree (Node (Node a))
m (Four a :: Node a
a b :: Node a
b c :: Node a
c d :: Node a
d)
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
sa = FingerTree (Node a) -> Node a -> FingerTree (Node a) -> Split a
forall a.
FingerTree (Node a) -> Node a -> FingerTree (Node a) -> Split a
Split (Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node a)
forall a. Int -> Digit a -> FingerTree (Node a) -> FingerTree a
pullR (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sa Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sbcd) Digit (Node a)
pr FingerTree (Node (Node a))
m) Node a
a (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
sbcd (Node a -> Node a -> Digit (Node a)
forall a. a -> a -> Digit a
Two Node a
b Node a
c) FingerTree (Node (Node a))
forall a. FingerTree a
EmptyT (Node a -> Digit (Node a)
forall a. a -> Digit a
One Node a
d))
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
sab = FingerTree (Node a) -> Node a -> FingerTree (Node a) -> Split a
forall a.
FingerTree (Node a) -> Node a -> FingerTree (Node a) -> Split a
Split (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
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sbcd) Digit (Node a)
pr FingerTree (Node (Node a))
m (Node a -> Digit (Node a)
forall a. a -> Digit a
One Node a
a)) Node a
b (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
scd (Node a -> Digit (Node a)
forall a. a -> Digit a
One Node a
c) FingerTree (Node (Node a))
forall a. FingerTree a
EmptyT (Node a -> Digit (Node a)
forall a. a -> Digit a
One Node a
d))
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
sabc = FingerTree (Node a) -> Node a -> FingerTree (Node a) -> Split a
forall a.
FingerTree (Node a) -> Node a -> FingerTree (Node a) -> Split a
Split (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
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
scd) Digit (Node a)
pr FingerTree (Node (Node a))
m (Node a -> Node a -> Digit (Node a)
forall a. a -> a -> Digit a
Two Node a
a Node a
b)) Node a
c (Node a -> FingerTree (Node a)
forall a. a -> FingerTree a
Single Node a
d)
| Bool
otherwise = FingerTree (Node a) -> Node a -> FingerTree (Node a) -> Split a
forall a.
FingerTree (Node a) -> Node a -> FingerTree (Node a) -> Split a
Split (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
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sd) Digit (Node a)
pr FingerTree (Node (Node a))
m (Node a -> Node a -> Node a -> Digit (Node a)
forall a. a -> a -> a -> Digit a
Three Node a
a Node a
b Node a
c)) Node a
d FingerTree (Node a)
forall a. FingerTree a
EmptyT
where
sa :: Int
sa = Node a -> Int
forall a. Sized a => a -> Int
size Node a
a
sab :: Int
sab = Int
sa Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Node a -> Int
forall a. Sized a => a -> Int
size Node a
b
sabc :: Int
sabc = Int
sab Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Node a -> Int
forall a. Sized a => a -> Int
size Node a
c
sd :: Int
sd = Node a -> Int
forall a. Sized a => a -> Int
size Node a
d
scd :: Int
scd = Node a -> Int
forall a. Sized a => a -> Int
size Node a
c Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
sd
sbcd :: Int
sbcd = Node a -> Int
forall a. Sized a => a -> Int
size Node a
b Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
scd
chunksOf :: Int -> Seq a -> Seq (Seq a)
chunksOf :: Int -> Seq a -> Seq (Seq a)
chunksOf n :: Int
n xs :: Seq a
xs | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 0 =
if Seq a -> Bool
forall a. Seq a -> Bool
null Seq a
xs
then Seq (Seq a)
forall a. Seq a
empty
else [Char] -> Seq (Seq a)
forall a. HasCallStack => [Char] -> a
error "chunksOf: A non-empty sequence can only be broken up into positively-sized chunks."
chunksOf 1 s :: Seq a
s = (a -> Seq a) -> Seq a -> Seq (Seq a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Seq a
forall a. a -> Seq a
singleton Seq a
s
chunksOf n :: Int
n s :: Seq a
s = (Int -> Seq a -> (Seq a, Seq a))
-> (Seq a -> () -> Seq a) -> Seq a -> Seq () -> Seq (Seq a)
forall s a' b'.
(Int -> s -> (s, s)) -> (s -> a' -> b') -> s -> Seq a' -> Seq b'
splitMap (Int -> Seq a -> (Seq a, Seq a)
forall a. Int -> Seq a -> (Seq a, Seq a)
uncheckedSplitAt (Int -> Seq a -> (Seq a, Seq a))
-> (Int -> Int) -> Int -> Seq a -> (Seq a, Seq a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
n)) Seq a -> () -> Seq a
forall a b. a -> b -> a
const Seq a
most (Int -> () -> Seq ()
forall a. Int -> a -> Seq a
replicate Int
numReps ())
Seq (Seq a) -> Seq (Seq a) -> Seq (Seq a)
forall a. Seq a -> Seq a -> Seq a
>< if Seq a -> Bool
forall a. Seq a -> Bool
null Seq a
end then Seq (Seq a)
forall a. Seq a
empty else Seq a -> Seq (Seq a)
forall a. a -> Seq a
singleton Seq a
end
where
(numReps :: Int
numReps, endLength :: Int
endLength) = Seq a -> Int
forall a. Seq a -> Int
length Seq a
s Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Int
n
(most :: Seq a
most, end :: Seq a
end) = Int -> Seq a -> (Seq a, Seq a)
forall a. Int -> Seq a -> (Seq a, Seq a)
splitAt (Seq a -> Int
forall a. Seq a -> Int
length Seq a
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
endLength) Seq a
s
tails :: Seq a -> Seq (Seq a)
tails :: Seq a -> Seq (Seq a)
tails (Seq xs :: FingerTree (Elem a)
xs) = FingerTree (Elem (Seq a)) -> Seq (Seq a)
forall a. FingerTree (Elem a) -> Seq a
Seq ((FingerTree (Elem a) -> Elem (Seq a))
-> FingerTree (Elem a) -> FingerTree (Elem (Seq a))
forall a b.
Sized a =>
(FingerTree a -> b) -> FingerTree a -> FingerTree b
tailsTree (Seq a -> Elem (Seq a)
forall a. a -> Elem a
Elem (Seq a -> Elem (Seq a))
-> (FingerTree (Elem a) -> Seq a)
-> FingerTree (Elem a)
-> Elem (Seq a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FingerTree (Elem a) -> Seq a
forall a. FingerTree (Elem a) -> Seq a
Seq) FingerTree (Elem a)
xs) Seq (Seq a) -> Seq a -> Seq (Seq a)
forall a. Seq a -> a -> Seq a
|> Seq a
forall a. Seq a
empty
inits :: Seq a -> Seq (Seq a)
inits :: Seq a -> Seq (Seq a)
inits (Seq xs :: FingerTree (Elem a)
xs) = Seq a
forall a. Seq a
empty Seq a -> Seq (Seq a) -> Seq (Seq a)
forall a. a -> Seq a -> Seq a
<| FingerTree (Elem (Seq a)) -> Seq (Seq a)
forall a. FingerTree (Elem a) -> Seq a
Seq ((FingerTree (Elem a) -> Elem (Seq a))
-> FingerTree (Elem a) -> FingerTree (Elem (Seq a))
forall a b.
Sized a =>
(FingerTree a -> b) -> FingerTree a -> FingerTree b
initsTree (Seq a -> Elem (Seq a)
forall a. a -> Elem a
Elem (Seq a -> Elem (Seq a))
-> (FingerTree (Elem a) -> Seq a)
-> FingerTree (Elem a)
-> Elem (Seq a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FingerTree (Elem a) -> Seq a
forall a. FingerTree (Elem a) -> Seq a
Seq) FingerTree (Elem a)
xs)
tailsDigit :: Digit a -> Digit (Digit a)
tailsDigit :: Digit a -> Digit (Digit a)
tailsDigit (One a :: a
a) = Digit a -> Digit (Digit a)
forall a. a -> Digit a
One (a -> Digit a
forall a. a -> Digit a
One a
a)
tailsDigit (Two a :: a
a b :: a
b) = Digit a -> Digit a -> Digit (Digit a)
forall a. a -> a -> Digit a
Two (a -> a -> Digit a
forall a. a -> a -> Digit a
Two a
a a
b) (a -> Digit a
forall a. a -> Digit a
One a
b)
tailsDigit (Three a :: a
a b :: a
b c :: a
c) = Digit a -> Digit a -> Digit a -> Digit (Digit a)
forall a. a -> a -> a -> Digit a
Three (a -> a -> a -> Digit a
forall a. a -> a -> a -> Digit a
Three a
a a
b a
c) (a -> a -> Digit a
forall a. a -> a -> Digit a
Two a
b a
c) (a -> Digit a
forall a. a -> Digit a
One a
c)
tailsDigit (Four a :: a
a b :: a
b c :: a
c d :: a
d) = Digit a -> Digit a -> Digit a -> Digit a -> Digit (Digit a)
forall a. a -> a -> a -> a -> Digit a
Four (a -> a -> a -> a -> Digit a
forall a. a -> a -> a -> a -> Digit a
Four a
a a
b a
c a
d) (a -> a -> a -> Digit a
forall a. a -> a -> a -> Digit a
Three a
b a
c a
d) (a -> a -> Digit a
forall a. a -> a -> Digit a
Two a
c a
d) (a -> Digit a
forall a. a -> Digit a
One a
d)
initsDigit :: Digit a -> Digit (Digit a)
initsDigit :: Digit a -> Digit (Digit a)
initsDigit (One a :: a
a) = Digit a -> Digit (Digit a)
forall a. a -> Digit a
One (a -> Digit a
forall a. a -> Digit a
One a
a)
initsDigit (Two a :: a
a b :: a
b) = Digit a -> Digit a -> Digit (Digit a)
forall a. a -> a -> Digit a
Two (a -> Digit a
forall a. a -> Digit a
One a
a) (a -> a -> Digit a
forall a. a -> a -> Digit a
Two a
a a
b)
initsDigit (Three a :: a
a b :: a
b c :: a
c) = Digit a -> Digit a -> Digit a -> Digit (Digit a)
forall a. a -> a -> a -> Digit a
Three (a -> Digit a
forall a. a -> Digit a
One a
a) (a -> a -> Digit a
forall a. a -> a -> Digit a
Two a
a a
b) (a -> a -> a -> Digit a
forall a. a -> a -> a -> Digit a
Three a
a a
b a
c)
initsDigit (Four a :: a
a b :: a
b c :: a
c d :: a
d) = Digit a -> Digit a -> Digit a -> Digit a -> Digit (Digit a)
forall a. a -> a -> a -> a -> Digit a
Four (a -> Digit a
forall a. a -> Digit a
One a
a) (a -> a -> Digit a
forall a. a -> a -> Digit a
Two a
a a
b) (a -> a -> a -> Digit a
forall a. a -> a -> a -> Digit a
Three a
a a
b a
c) (a -> a -> a -> a -> Digit a
forall a. a -> a -> a -> a -> Digit a
Four a
a a
b a
c a
d)
tailsNode :: Node a -> Node (Digit a)
tailsNode :: Node a -> Node (Digit a)
tailsNode (Node2 s :: Int
s a :: a
a b :: a
b) = Int -> Digit a -> Digit a -> Node (Digit a)
forall a. Int -> a -> a -> Node a
Node2 Int
s (a -> a -> Digit a
forall a. a -> a -> Digit a
Two a
a a
b) (a -> Digit a
forall a. a -> Digit a
One a
b)
tailsNode (Node3 s :: Int
s a :: a
a b :: a
b c :: a
c) = Int -> Digit a -> Digit a -> Digit a -> Node (Digit a)
forall a. Int -> a -> a -> a -> Node a
Node3 Int
s (a -> a -> a -> Digit a
forall a. a -> a -> a -> Digit a
Three a
a a
b a
c) (a -> a -> Digit a
forall a. a -> a -> Digit a
Two a
b a
c) (a -> Digit a
forall a. a -> Digit a
One a
c)
initsNode :: Node a -> Node (Digit a)
initsNode :: Node a -> Node (Digit a)
initsNode (Node2 s :: Int
s a :: a
a b :: a
b) = Int -> Digit a -> Digit a -> Node (Digit a)
forall a. Int -> a -> a -> Node a
Node2 Int
s (a -> Digit a
forall a. a -> Digit a
One a
a) (a -> a -> Digit a
forall a. a -> a -> Digit a
Two a
a a
b)
initsNode (Node3 s :: Int
s a :: a
a b :: a
b c :: a
c) = Int -> Digit a -> Digit a -> Digit a -> Node (Digit a)
forall a. Int -> a -> a -> a -> Node a
Node3 Int
s (a -> Digit a
forall a. a -> Digit a
One a
a) (a -> a -> Digit a
forall a. a -> a -> Digit a
Two a
a a
b) (a -> a -> a -> Digit a
forall a. a -> a -> a -> Digit a
Three a
a a
b a
c)
{-# SPECIALIZE tailsTree :: (FingerTree (Elem a) -> Elem b) -> FingerTree (Elem a) -> FingerTree (Elem b) #-}
{-# SPECIALIZE tailsTree :: (FingerTree (Node a) -> Node b) -> FingerTree (Node a) -> FingerTree (Node b) #-}
tailsTree :: Sized a => (FingerTree a -> b) -> FingerTree a -> FingerTree b
tailsTree :: (FingerTree a -> b) -> FingerTree a -> FingerTree b
tailsTree _ EmptyT = FingerTree b
forall a. FingerTree a
EmptyT
tailsTree f :: FingerTree a -> b
f (Single x :: a
x) = b -> FingerTree b
forall a. a -> FingerTree a
Single (FingerTree a -> b
f (a -> FingerTree a
forall a. a -> FingerTree a
Single a
x))
tailsTree f :: FingerTree a -> b
f (Deep n :: Int
n 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
n ((Digit a -> b) -> Digit (Digit a) -> Digit b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\ pr' :: Digit a
pr' -> FingerTree a -> b
f (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)) (Digit a -> Digit (Digit a)
forall a. Digit a -> Digit (Digit a)
tailsDigit Digit a
pr))
((FingerTree (Node a) -> Node b)
-> FingerTree (Node a) -> FingerTree (Node b)
forall a b.
Sized a =>
(FingerTree a -> b) -> FingerTree a -> FingerTree b
tailsTree FingerTree (Node a) -> Node b
f' FingerTree (Node a)
m)
((Digit a -> b) -> Digit (Digit a) -> Digit b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FingerTree a -> b
f (FingerTree a -> b) -> (Digit a -> FingerTree a) -> Digit a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Digit a -> FingerTree a
forall a. Sized a => Digit a -> FingerTree a
digitToTree) (Digit a -> Digit (Digit a)
forall a. Digit a -> Digit (Digit a)
tailsDigit Digit a
sf))
where
f' :: FingerTree (Node a) -> Node b
f' ms :: FingerTree (Node a)
ms = let ConsLTree node :: Node a
node m' :: FingerTree (Node a)
m' = FingerTree (Node a) -> ViewLTree (Node a)
forall a. Sized a => FingerTree a -> ViewLTree a
viewLTree FingerTree (Node a)
ms in
(Digit a -> b) -> Node (Digit a) -> Node b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\ pr' :: Digit a
pr' -> FingerTree a -> b
f (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)) (Node a -> Node (Digit a)
forall a. Node a -> Node (Digit a)
tailsNode Node a
node)
{-# SPECIALIZE initsTree :: (FingerTree (Elem a) -> Elem b) -> FingerTree (Elem a) -> FingerTree (Elem b) #-}
{-# SPECIALIZE initsTree :: (FingerTree (Node a) -> Node b) -> FingerTree (Node a) -> FingerTree (Node b) #-}
initsTree :: Sized a => (FingerTree a -> b) -> FingerTree a -> FingerTree b
initsTree :: (FingerTree a -> b) -> FingerTree a -> FingerTree b
initsTree _ EmptyT = FingerTree b
forall a. FingerTree a
EmptyT
initsTree f :: FingerTree a -> b
f (Single x :: a
x) = b -> FingerTree b
forall a. a -> FingerTree a
Single (FingerTree a -> b
f (a -> FingerTree a
forall a. a -> FingerTree a
Single a
x))
initsTree f :: FingerTree a -> b
f (Deep n :: Int
n 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
n ((Digit a -> b) -> Digit (Digit a) -> Digit b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FingerTree a -> b
f (FingerTree a -> b) -> (Digit a -> FingerTree a) -> Digit a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Digit a -> FingerTree a
forall a. Sized a => Digit a -> FingerTree a
digitToTree) (Digit a -> Digit (Digit a)
forall a. Digit a -> Digit (Digit a)
initsDigit Digit a
pr))
((FingerTree (Node a) -> Node b)
-> FingerTree (Node a) -> FingerTree (Node b)
forall a b.
Sized a =>
(FingerTree a -> b) -> FingerTree a -> FingerTree b
initsTree FingerTree (Node a) -> Node b
f' FingerTree (Node a)
m)
((Digit a -> b) -> Digit (Digit a) -> Digit b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FingerTree a -> b
f (FingerTree a -> b) -> (Digit a -> FingerTree a) -> Digit a -> b
forall b c a. (b -> c) -> (a -> b) -> 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 Digit a
pr FingerTree (Node a)
m) (Digit a -> Digit (Digit a)
forall a. Digit a -> Digit (Digit a)
initsDigit Digit a
sf))
where
f' :: FingerTree (Node a) -> Node b
f' ms :: FingerTree (Node a)
ms = let SnocRTree m' :: FingerTree (Node a)
m' node :: Node a
node = FingerTree (Node a) -> ViewRTree (Node a)
forall a. Sized a => FingerTree a -> ViewRTree a
viewRTree FingerTree (Node a)
ms in
(Digit a -> b) -> Node (Digit a) -> Node b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\ sf' :: Digit a
sf' -> FingerTree a -> b
f (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')) (Node a -> Node (Digit a)
forall a. Node a -> Node (Digit a)
initsNode Node a
node)
{-# INLINE foldlWithIndex #-}
foldlWithIndex :: (b -> Int -> a -> b) -> b -> Seq a -> b
foldlWithIndex :: (b -> Int -> a -> b) -> b -> Seq a -> b
foldlWithIndex f :: b -> Int -> a -> b
f z :: b
z xs :: Seq a
xs = ((Int -> b) -> a -> Int -> b) -> (Int -> b) -> Seq a -> Int -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\ g :: Int -> b
g x :: a
x !Int
i -> b -> Int -> a -> b
f (Int -> b
g (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1)) Int
i a
x) (b -> Int -> b
forall a b. a -> b -> a
const b
z) Seq a
xs (Seq a -> Int
forall a. Seq a -> Int
length Seq a
xs Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1)
{-# INLINE foldrWithIndex #-}
foldrWithIndex :: (Int -> a -> b -> b) -> b -> Seq a -> b
foldrWithIndex :: (Int -> a -> b -> b) -> b -> Seq a -> b
foldrWithIndex f :: Int -> a -> b -> b
f z :: b
z xs :: Seq a
xs = (a -> (Int -> b) -> Int -> b) -> (Int -> b) -> Seq a -> Int -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\ x :: a
x g :: Int -> b
g !Int
i -> Int -> a -> b -> b
f Int
i a
x (Int -> b
g (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+1))) (b -> Int -> b
forall a b. a -> b -> a
const b
z) Seq a
xs 0
{-# INLINE listToMaybe' #-}
listToMaybe' :: [a] -> Maybe a
listToMaybe' :: [a] -> Maybe a
listToMaybe' = (a -> Maybe a -> Maybe a) -> Maybe a -> [a] -> Maybe a
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\ x :: a
x _ -> a -> Maybe a
forall a. a -> Maybe a
Just a
x) Maybe a
forall a. Maybe a
Nothing
takeWhileL :: (a -> Bool) -> Seq a -> Seq a
takeWhileL :: (a -> Bool) -> Seq a -> Seq a
takeWhileL p :: a -> Bool
p = (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
. (a -> Bool) -> Seq a -> (Seq a, Seq a)
forall a. (a -> Bool) -> Seq a -> (Seq a, Seq a)
spanl a -> Bool
p
takeWhileR :: (a -> Bool) -> Seq a -> Seq a
takeWhileR :: (a -> Bool) -> Seq a -> Seq a
takeWhileR p :: a -> Bool
p = (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
. (a -> Bool) -> Seq a -> (Seq a, Seq a)
forall a. (a -> Bool) -> Seq a -> (Seq a, Seq a)
spanr a -> Bool
p
dropWhileL :: (a -> Bool) -> Seq a -> Seq a
dropWhileL :: (a -> Bool) -> Seq a -> Seq a
dropWhileL p :: a -> Bool
p = (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
. (a -> Bool) -> Seq a -> (Seq a, Seq a)
forall a. (a -> Bool) -> Seq a -> (Seq a, Seq a)
spanl a -> Bool
p
dropWhileR :: (a -> Bool) -> Seq a -> Seq a
dropWhileR :: (a -> Bool) -> Seq a -> Seq a
dropWhileR p :: a -> Bool
p = (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
. (a -> Bool) -> Seq a -> (Seq a, Seq a)
forall a. (a -> Bool) -> Seq a -> (Seq a, Seq a)
spanr a -> Bool
p
spanl :: (a -> Bool) -> Seq a -> (Seq a, Seq a)
spanl :: (a -> Bool) -> Seq a -> (Seq a, Seq a)
spanl p :: a -> Bool
p = (a -> Bool) -> Seq a -> (Seq a, Seq a)
forall a. (a -> Bool) -> Seq a -> (Seq a, Seq a)
breakl (Bool -> Bool
not (Bool -> Bool) -> (a -> Bool) -> a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Bool
p)
spanr :: (a -> Bool) -> Seq a -> (Seq a, Seq a)
spanr :: (a -> Bool) -> Seq a -> (Seq a, Seq a)
spanr p :: a -> Bool
p = (a -> Bool) -> Seq a -> (Seq a, Seq a)
forall a. (a -> Bool) -> Seq a -> (Seq a, Seq a)
breakr (Bool -> Bool
not (Bool -> Bool) -> (a -> Bool) -> a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Bool
p)
{-# INLINE breakl #-}
breakl :: (a -> Bool) -> Seq a -> (Seq a, Seq a)
breakl :: (a -> Bool) -> Seq a -> (Seq a, Seq a)
breakl p :: a -> Bool
p xs :: Seq a
xs = (Int -> (Seq a, Seq a) -> (Seq a, Seq a))
-> (Seq a, Seq a) -> [Int] -> (Seq a, Seq a)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\ i :: Int
i _ -> Int -> Seq a -> (Seq a, Seq a)
forall a. Int -> Seq a -> (Seq a, Seq a)
splitAt Int
i Seq a
xs) (Seq a
xs, Seq a
forall a. Seq a
empty) ((a -> Bool) -> Seq a -> [Int]
forall a. (a -> Bool) -> Seq a -> [Int]
findIndicesL a -> Bool
p Seq a
xs)
{-# INLINE breakr #-}
breakr :: (a -> Bool) -> Seq a -> (Seq a, Seq a)
breakr :: (a -> Bool) -> Seq a -> (Seq a, Seq a)
breakr p :: a -> Bool
p xs :: Seq a
xs = (Int -> (Seq a, Seq a) -> (Seq a, Seq a))
-> (Seq a, Seq a) -> [Int] -> (Seq a, Seq a)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\ i :: Int
i _ -> (Seq a, Seq a) -> (Seq a, Seq a)
forall b a. (b, a) -> (a, b)
flipPair (Int -> Seq a -> (Seq a, Seq a)
forall a. Int -> Seq a -> (Seq a, Seq a)
splitAt (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1) Seq a
xs)) (Seq a
xs, Seq a
forall a. Seq a
empty) ((a -> Bool) -> Seq a -> [Int]
forall a. (a -> Bool) -> Seq a -> [Int]
findIndicesR a -> Bool
p Seq a
xs)
where flipPair :: (b, a) -> (a, b)
flipPair (x :: b
x, y :: a
y) = (a
y, b
x)
partition :: (a -> Bool) -> Seq a -> (Seq a, Seq a)
partition :: (a -> Bool) -> Seq a -> (Seq a, Seq a)
partition p :: a -> Bool
p = StrictPair (Seq a) (Seq a) -> (Seq a, Seq a)
forall a b. StrictPair a b -> (a, b)
toPair (StrictPair (Seq a) (Seq a) -> (Seq a, Seq a))
-> (Seq a -> StrictPair (Seq a) (Seq a)) -> Seq a -> (Seq a, Seq a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrictPair (Seq a) (Seq a) -> a -> StrictPair (Seq a) (Seq a))
-> StrictPair (Seq a) (Seq a)
-> Seq a
-> StrictPair (Seq a) (Seq a)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' StrictPair (Seq a) (Seq a) -> a -> StrictPair (Seq a) (Seq a)
part (Seq a
forall a. Seq a
empty Seq a -> Seq a -> StrictPair (Seq a) (Seq a)
forall a b. a -> b -> StrictPair a b
:*: Seq a
forall a. Seq a
empty)
where
part :: StrictPair (Seq a) (Seq a) -> a -> StrictPair (Seq a) (Seq a)
part (xs :: Seq a
xs :*: ys :: Seq a
ys) x :: a
x
| a -> Bool
p a
x = (Seq a
xs Seq a -> a -> Seq a
forall a. Seq a -> a -> Seq a
`snoc'` a
x) Seq a -> Seq a -> StrictPair (Seq a) (Seq a)
forall a b. a -> b -> StrictPair a b
:*: Seq a
ys
| Bool
otherwise = Seq a
xs Seq a -> Seq a -> StrictPair (Seq a) (Seq a)
forall a b. a -> b -> StrictPair a b
:*: (Seq a
ys Seq a -> a -> Seq a
forall a. Seq a -> a -> Seq a
`snoc'` a
x)
filter :: (a -> Bool) -> Seq a -> Seq a
filter :: (a -> Bool) -> Seq a -> Seq a
filter p :: a -> Bool
p = (Seq a -> a -> Seq a) -> Seq a -> Seq a -> Seq a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\ xs :: Seq a
xs x :: a
x -> if a -> Bool
p a
x then Seq a
xs Seq a -> a -> Seq a
forall a. Seq a -> a -> Seq a
`snoc'` a
x else Seq a
xs) Seq a
forall a. Seq a
empty
elemIndexL :: Eq a => a -> Seq a -> Maybe Int
elemIndexL :: a -> Seq a -> Maybe Int
elemIndexL x :: a
x = (a -> Bool) -> Seq a -> Maybe Int
forall a. (a -> Bool) -> Seq a -> Maybe Int
findIndexL (a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
==)
elemIndexR :: Eq a => a -> Seq a -> Maybe Int
elemIndexR :: a -> Seq a -> Maybe Int
elemIndexR x :: a
x = (a -> Bool) -> Seq a -> Maybe Int
forall a. (a -> Bool) -> Seq a -> Maybe Int
findIndexR (a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
==)
elemIndicesL :: Eq a => a -> Seq a -> [Int]
elemIndicesL :: a -> Seq a -> [Int]
elemIndicesL x :: a
x = (a -> Bool) -> Seq a -> [Int]
forall a. (a -> Bool) -> Seq a -> [Int]
findIndicesL (a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
==)
elemIndicesR :: Eq a => a -> Seq a -> [Int]
elemIndicesR :: a -> Seq a -> [Int]
elemIndicesR x :: a
x = (a -> Bool) -> Seq a -> [Int]
forall a. (a -> Bool) -> Seq a -> [Int]
findIndicesR (a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
==)
findIndexL :: (a -> Bool) -> Seq a -> Maybe Int
findIndexL :: (a -> Bool) -> Seq a -> Maybe Int
findIndexL p :: a -> Bool
p = [Int] -> Maybe Int
forall a. [a] -> Maybe a
listToMaybe' ([Int] -> Maybe Int) -> (Seq a -> [Int]) -> Seq a -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Bool) -> Seq a -> [Int]
forall a. (a -> Bool) -> Seq a -> [Int]
findIndicesL a -> Bool
p
findIndexR :: (a -> Bool) -> Seq a -> Maybe Int
findIndexR :: (a -> Bool) -> Seq a -> Maybe Int
findIndexR p :: a -> Bool
p = [Int] -> Maybe Int
forall a. [a] -> Maybe a
listToMaybe' ([Int] -> Maybe Int) -> (Seq a -> [Int]) -> Seq a -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Bool) -> Seq a -> [Int]
forall a. (a -> Bool) -> Seq a -> [Int]
findIndicesR a -> Bool
p
{-# INLINE findIndicesL #-}
findIndicesL :: (a -> Bool) -> Seq a -> [Int]
#if __GLASGOW_HASKELL__
findIndicesL :: (a -> Bool) -> Seq a -> [Int]
findIndicesL p :: a -> Bool
p xs :: Seq a
xs = (forall b. (Int -> b -> b) -> b -> b) -> [Int]
forall a. (forall b. (a -> b -> b) -> b -> b) -> [a]
build (\ c :: Int -> b -> b
c n :: b
n -> let g :: Int -> a -> b -> b
g i :: Int
i x :: a
x z :: b
z = if a -> Bool
p a
x then Int -> b -> b
c Int
i b
z else b
z in
(Int -> a -> b -> b) -> b -> Seq a -> b
forall a b. (Int -> a -> b -> b) -> b -> Seq a -> b
foldrWithIndex Int -> a -> b -> b
g b
n Seq a
xs)
#else
findIndicesL p xs = foldrWithIndex g [] xs
where g i x is = if p x then i:is else is
#endif
{-# INLINE findIndicesR #-}
findIndicesR :: (a -> Bool) -> Seq a -> [Int]
#if __GLASGOW_HASKELL__
findIndicesR :: (a -> Bool) -> Seq a -> [Int]
findIndicesR p :: a -> Bool
p xs :: Seq a
xs = (forall b. (Int -> b -> b) -> b -> b) -> [Int]
forall a. (forall b. (a -> b -> b) -> b -> b) -> [a]
build (\ c :: Int -> b -> b
c n :: b
n ->
let g :: b -> Int -> a -> b
g z :: b
z i :: Int
i x :: a
x = if a -> Bool
p a
x then Int -> b -> b
c Int
i b
z else b
z in (b -> Int -> a -> b) -> b -> Seq a -> b
forall b a. (b -> Int -> a -> b) -> b -> Seq a -> b
foldlWithIndex b -> Int -> a -> b
g b
n Seq a
xs)
#else
findIndicesR p xs = foldlWithIndex g [] xs
where g is i x = if p x then i:is else is
#endif
fromList :: [a] -> Seq a
fromList :: [a] -> Seq a
fromList = FingerTree (Elem a) -> Seq a
forall a. FingerTree (Elem a) -> Seq a
Seq (FingerTree (Elem a) -> Seq a)
-> ([a] -> FingerTree (Elem a)) -> [a] -> Seq a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Elem a] -> FingerTree (Elem a)
forall a'. [Elem a'] -> FingerTree (Elem a')
mkTree ([Elem a] -> FingerTree (Elem a))
-> ([a] -> [Elem a]) -> [a] -> FingerTree (Elem a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [Elem a]
forall a. [a] -> [Elem a]
map_elem
where
#ifdef __GLASGOW_HASKELL__
mkTree :: forall a' . [Elem a'] -> FingerTree (Elem a')
#else
mkTree :: [Elem a] -> FingerTree (Elem a)
#endif
mkTree :: [Elem a'] -> FingerTree (Elem a')
mkTree [] = FingerTree (Elem a')
forall a. FingerTree a
EmptyT
mkTree [x1 :: Elem a'
x1] = Elem a' -> FingerTree (Elem a')
forall a. a -> FingerTree a
Single Elem a'
x1
mkTree [x1 :: Elem a'
x1, x2 :: Elem a'
x2] = 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 2 (Elem a' -> Digit (Elem a')
forall a. a -> Digit a
One Elem a'
x1) FingerTree (Node (Elem a'))
forall a. FingerTree a
EmptyT (Elem a' -> Digit (Elem a')
forall a. a -> Digit a
One Elem a'
x2)
mkTree [x1 :: Elem a'
x1, x2 :: Elem a'
x2, x3 :: Elem a'
x3] = 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 3 (Elem a' -> Elem a' -> Digit (Elem a')
forall a. a -> a -> Digit a
Two Elem a'
x1 Elem a'
x2) FingerTree (Node (Elem a'))
forall a. FingerTree a
EmptyT (Elem a' -> Digit (Elem a')
forall a. a -> Digit a
One Elem a'
x3)
mkTree [x1 :: Elem a'
x1, x2 :: Elem a'
x2, x3 :: Elem a'
x3, x4 :: Elem a'
x4] = 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 4 (Elem a' -> Elem a' -> Digit (Elem a')
forall a. a -> a -> Digit a
Two Elem a'
x1 Elem a'
x2) FingerTree (Node (Elem a'))
forall a. FingerTree a
EmptyT (Elem a' -> Elem a' -> Digit (Elem a')
forall a. a -> a -> Digit a
Two Elem a'
x3 Elem a'
x4)
mkTree [x1 :: Elem a'
x1, x2 :: Elem a'
x2, x3 :: Elem a'
x3, x4 :: Elem a'
x4, x5 :: Elem a'
x5] = 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 5 (Elem a' -> Elem a' -> Elem a' -> Digit (Elem a')
forall a. a -> a -> a -> Digit a
Three Elem a'
x1 Elem a'
x2 Elem a'
x3) FingerTree (Node (Elem a'))
forall a. FingerTree a
EmptyT (Elem a' -> Elem a' -> Digit (Elem a')
forall a. a -> a -> Digit a
Two Elem a'
x4 Elem a'
x5)
mkTree [x1 :: Elem a'
x1, x2 :: Elem a'
x2, x3 :: Elem a'
x3, x4 :: Elem a'
x4, x5 :: Elem a'
x5, x6 :: Elem a'
x6] =
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 6 (Elem a' -> Elem a' -> Elem a' -> Digit (Elem a')
forall a. a -> a -> a -> Digit a
Three Elem a'
x1 Elem a'
x2 Elem a'
x3) FingerTree (Node (Elem a'))
forall a. FingerTree a
EmptyT (Elem a' -> Elem a' -> Elem a' -> Digit (Elem a')
forall a. a -> a -> a -> Digit a
Three Elem a'
x4 Elem a'
x5 Elem a'
x6)
mkTree [x1 :: Elem a'
x1, x2 :: Elem a'
x2, x3 :: Elem a'
x3, x4 :: Elem a'
x4, x5 :: Elem a'
x5, x6 :: Elem a'
x6, x7 :: Elem a'
x7] =
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 7 (Elem a' -> Elem a' -> Digit (Elem a')
forall a. a -> a -> Digit a
Two Elem a'
x1 Elem a'
x2) (Node (Elem a') -> FingerTree (Node (Elem a'))
forall a. a -> FingerTree a
Single (Int -> Elem a' -> Elem a' -> Elem a' -> Node (Elem a')
forall a. Int -> a -> a -> a -> Node a
Node3 3 Elem a'
x3 Elem a'
x4 Elem a'
x5)) (Elem a' -> Elem a' -> Digit (Elem a')
forall a. a -> a -> Digit a
Two Elem a'
x6 Elem a'
x7)
mkTree [x1 :: Elem a'
x1, x2 :: Elem a'
x2, x3 :: Elem a'
x3, x4 :: Elem a'
x4, x5 :: Elem a'
x5, x6 :: Elem a'
x6, x7 :: Elem a'
x7, x8 :: Elem a'
x8] =
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 8 (Elem a' -> Elem a' -> Elem a' -> Digit (Elem a')
forall a. a -> a -> a -> Digit a
Three Elem a'
x1 Elem a'
x2 Elem a'
x3) (Node (Elem a') -> FingerTree (Node (Elem a'))
forall a. a -> FingerTree a
Single (Int -> Elem a' -> Elem a' -> Elem a' -> Node (Elem a')
forall a. Int -> a -> a -> a -> Node a
Node3 3 Elem a'
x4 Elem a'
x5 Elem a'
x6)) (Elem a' -> Elem a' -> Digit (Elem a')
forall a. a -> a -> Digit a
Two Elem a'
x7 Elem a'
x8)
mkTree [x1 :: Elem a'
x1, x2 :: Elem a'
x2, x3 :: Elem a'
x3, x4 :: Elem a'
x4, x5 :: Elem a'
x5, x6 :: Elem a'
x6, x7 :: Elem a'
x7, x8 :: Elem a'
x8, x9 :: Elem a'
x9] =
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 9 (Elem a' -> Elem a' -> Elem a' -> Digit (Elem a')
forall a. a -> a -> a -> Digit a
Three Elem a'
x1 Elem a'
x2 Elem a'
x3) (Node (Elem a') -> FingerTree (Node (Elem a'))
forall a. a -> FingerTree a
Single (Int -> Elem a' -> Elem a' -> Elem a' -> Node (Elem a')
forall a. Int -> a -> a -> a -> Node a
Node3 3 Elem a'
x4 Elem a'
x5 Elem a'
x6)) (Elem a' -> Elem a' -> Elem a' -> Digit (Elem a')
forall a. a -> a -> a -> Digit a
Three Elem a'
x7 Elem a'
x8 Elem a'
x9)
mkTree [x1 :: Elem a'
x1, x2 :: Elem a'
x2, x3 :: Elem a'
x3, x4 :: Elem a'
x4, x5 :: Elem a'
x5, x6 :: Elem a'
x6, x7 :: Elem a'
x7, x8 :: Elem a'
x8, y0 :: Elem a'
y0, y1 :: Elem a'
y1] =
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 10 (Elem a' -> Elem a' -> Digit (Elem a')
forall a. a -> a -> Digit a
Two Elem a'
x1 Elem a'
x2)
(Int
-> Digit (Node (Elem a'))
-> FingerTree (Node (Node (Elem a')))
-> Digit (Node (Elem a'))
-> FingerTree (Node (Elem a'))
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep 6 (Node (Elem a') -> Digit (Node (Elem a'))
forall a. a -> Digit a
One (Int -> Elem a' -> Elem a' -> Elem a' -> Node (Elem a')
forall a. Int -> a -> a -> a -> Node a
Node3 3 Elem a'
x3 Elem a'
x4 Elem a'
x5)) FingerTree (Node (Node (Elem a')))
forall a. FingerTree a
EmptyT (Node (Elem a') -> Digit (Node (Elem a'))
forall a. a -> Digit a
One (Int -> Elem a' -> Elem a' -> Elem a' -> Node (Elem a')
forall a. Int -> a -> a -> a -> Node a
Node3 3 Elem a'
x6 Elem a'
x7 Elem a'
x8)))
(Elem a' -> Elem a' -> Digit (Elem a')
forall a. a -> a -> Digit a
Two Elem a'
y0 Elem a'
y1)
mkTree [x1 :: Elem a'
x1, x2 :: Elem a'
x2, x3 :: Elem a'
x3, x4 :: Elem a'
x4, x5 :: Elem a'
x5, x6 :: Elem a'
x6, x7 :: Elem a'
x7, x8 :: Elem a'
x8, x9 :: Elem a'
x9, y0 :: Elem a'
y0, y1 :: Elem a'
y1] =
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 11 (Elem a' -> Elem a' -> Elem a' -> Digit (Elem a')
forall a. a -> a -> a -> Digit a
Three Elem a'
x1 Elem a'
x2 Elem a'
x3)
(Int
-> Digit (Node (Elem a'))
-> FingerTree (Node (Node (Elem a')))
-> Digit (Node (Elem a'))
-> FingerTree (Node (Elem a'))
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep 6 (Node (Elem a') -> Digit (Node (Elem a'))
forall a. a -> Digit a
One (Int -> Elem a' -> Elem a' -> Elem a' -> Node (Elem a')
forall a. Int -> a -> a -> a -> Node a
Node3 3 Elem a'
x4 Elem a'
x5 Elem a'
x6)) FingerTree (Node (Node (Elem a')))
forall a. FingerTree a
EmptyT (Node (Elem a') -> Digit (Node (Elem a'))
forall a. a -> Digit a
One (Int -> Elem a' -> Elem a' -> Elem a' -> Node (Elem a')
forall a. Int -> a -> a -> a -> Node a
Node3 3 Elem a'
x7 Elem a'
x8 Elem a'
x9)))
(Elem a' -> Elem a' -> Digit (Elem a')
forall a. a -> a -> Digit a
Two Elem a'
y0 Elem a'
y1)
mkTree [x1 :: Elem a'
x1, x2 :: Elem a'
x2, x3 :: Elem a'
x3, x4 :: Elem a'
x4, x5 :: Elem a'
x5, x6 :: Elem a'
x6, x7 :: Elem a'
x7, x8 :: Elem a'
x8, x9 :: Elem a'
x9, y0 :: Elem a'
y0, y1 :: Elem a'
y1, y2 :: Elem a'
y2] =
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 12 (Elem a' -> Elem a' -> Elem a' -> Digit (Elem a')
forall a. a -> a -> a -> Digit a
Three Elem a'
x1 Elem a'
x2 Elem a'
x3)
(Int
-> Digit (Node (Elem a'))
-> FingerTree (Node (Node (Elem a')))
-> Digit (Node (Elem a'))
-> FingerTree (Node (Elem a'))
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep 6 (Node (Elem a') -> Digit (Node (Elem a'))
forall a. a -> Digit a
One (Int -> Elem a' -> Elem a' -> Elem a' -> Node (Elem a')
forall a. Int -> a -> a -> a -> Node a
Node3 3 Elem a'
x4 Elem a'
x5 Elem a'
x6)) FingerTree (Node (Node (Elem a')))
forall a. FingerTree a
EmptyT (Node (Elem a') -> Digit (Node (Elem a'))
forall a. a -> Digit a
One (Int -> Elem a' -> Elem a' -> Elem a' -> Node (Elem a')
forall a. Int -> a -> a -> a -> Node a
Node3 3 Elem a'
x7 Elem a'
x8 Elem a'
x9)))
(Elem a' -> Elem a' -> Elem a' -> Digit (Elem a')
forall a. a -> a -> a -> Digit a
Three Elem a'
y0 Elem a'
y1 Elem a'
y2)
mkTree [x1 :: Elem a'
x1, x2 :: Elem a'
x2, x3 :: Elem a'
x3, x4 :: Elem a'
x4, x5 :: Elem a'
x5, x6 :: Elem a'
x6, x7 :: Elem a'
x7, x8 :: Elem a'
x8, y0 :: Elem a'
y0, y1 :: Elem a'
y1, y2 :: Elem a'
y2, y3 :: Elem a'
y3, y4 :: Elem a'
y4] =
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 13 (Elem a' -> Elem a' -> Digit (Elem a')
forall a. a -> a -> Digit a
Two Elem a'
x1 Elem a'
x2)
(Int
-> Digit (Node (Elem a'))
-> FingerTree (Node (Node (Elem a')))
-> Digit (Node (Elem a'))
-> FingerTree (Node (Elem a'))
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep 9 (Node (Elem a') -> Node (Elem a') -> Digit (Node (Elem a'))
forall a. a -> a -> Digit a
Two (Int -> Elem a' -> Elem a' -> Elem a' -> Node (Elem a')
forall a. Int -> a -> a -> a -> Node a
Node3 3 Elem a'
x3 Elem a'
x4 Elem a'
x5) (Int -> Elem a' -> Elem a' -> Elem a' -> Node (Elem a')
forall a. Int -> a -> a -> a -> Node a
Node3 3 Elem a'
x6 Elem a'
x7 Elem a'
x8)) FingerTree (Node (Node (Elem a')))
forall a. FingerTree a
EmptyT (Node (Elem a') -> Digit (Node (Elem a'))
forall a. a -> Digit a
One (Int -> Elem a' -> Elem a' -> Elem a' -> Node (Elem a')
forall a. Int -> a -> a -> a -> Node a
Node3 3 Elem a'
y0 Elem a'
y1 Elem a'
y2)))
(Elem a' -> Elem a' -> Digit (Elem a')
forall a. a -> a -> Digit a
Two Elem a'
y3 Elem a'
y4)
mkTree [x1 :: Elem a'
x1, x2 :: Elem a'
x2, x3 :: Elem a'
x3, x4 :: Elem a'
x4, x5 :: Elem a'
x5, x6 :: Elem a'
x6, x7 :: Elem a'
x7, x8 :: Elem a'
x8, x9 :: Elem a'
x9, y0 :: Elem a'
y0, y1 :: Elem a'
y1, y2 :: Elem a'
y2, y3 :: Elem a'
y3, y4 :: Elem a'
y4] =
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 14 (Elem a' -> Elem a' -> Elem a' -> Digit (Elem a')
forall a. a -> a -> a -> Digit a
Three Elem a'
x1 Elem a'
x2 Elem a'
x3)
(Int
-> Digit (Node (Elem a'))
-> FingerTree (Node (Node (Elem a')))
-> Digit (Node (Elem a'))
-> FingerTree (Node (Elem a'))
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep 9 (Node (Elem a') -> Node (Elem a') -> Digit (Node (Elem a'))
forall a. a -> a -> Digit a
Two (Int -> Elem a' -> Elem a' -> Elem a' -> Node (Elem a')
forall a. Int -> a -> a -> a -> Node a
Node3 3 Elem a'
x4 Elem a'
x5 Elem a'
x6) (Int -> Elem a' -> Elem a' -> Elem a' -> Node (Elem a')
forall a. Int -> a -> a -> a -> Node a
Node3 3 Elem a'
x7 Elem a'
x8 Elem a'
x9)) FingerTree (Node (Node (Elem a')))
forall a. FingerTree a
EmptyT (Node (Elem a') -> Digit (Node (Elem a'))
forall a. a -> Digit a
One (Int -> Elem a' -> Elem a' -> Elem a' -> Node (Elem a')
forall a. Int -> a -> a -> a -> Node a
Node3 3 Elem a'
y0 Elem a'
y1 Elem a'
y2)))
(Elem a' -> Elem a' -> Digit (Elem a')
forall a. a -> a -> Digit a
Two Elem a'
y3 Elem a'
y4)
mkTree [x1 :: Elem a'
x1, x2 :: Elem a'
x2, x3 :: Elem a'
x3, x4 :: Elem a'
x4, x5 :: Elem a'
x5, x6 :: Elem a'
x6, x7 :: Elem a'
x7, x8 :: Elem a'
x8, x9 :: Elem a'
x9, y0 :: Elem a'
y0, y1 :: Elem a'
y1, y2 :: Elem a'
y2, y3 :: Elem a'
y3, y4 :: Elem a'
y4, y5 :: Elem a'
y5] =
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 15 (Elem a' -> Elem a' -> Elem a' -> Digit (Elem a')
forall a. a -> a -> a -> Digit a
Three Elem a'
x1 Elem a'
x2 Elem a'
x3)
(Int
-> Digit (Node (Elem a'))
-> FingerTree (Node (Node (Elem a')))
-> Digit (Node (Elem a'))
-> FingerTree (Node (Elem a'))
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep 9 (Node (Elem a') -> Node (Elem a') -> Digit (Node (Elem a'))
forall a. a -> a -> Digit a
Two (Int -> Elem a' -> Elem a' -> Elem a' -> Node (Elem a')
forall a. Int -> a -> a -> a -> Node a
Node3 3 Elem a'
x4 Elem a'
x5 Elem a'
x6) (Int -> Elem a' -> Elem a' -> Elem a' -> Node (Elem a')
forall a. Int -> a -> a -> a -> Node a
Node3 3 Elem a'
x7 Elem a'
x8 Elem a'
x9)) FingerTree (Node (Node (Elem a')))
forall a. FingerTree a
EmptyT (Node (Elem a') -> Digit (Node (Elem a'))
forall a. a -> Digit a
One (Int -> Elem a' -> Elem a' -> Elem a' -> Node (Elem a')
forall a. Int -> a -> a -> a -> Node a
Node3 3 Elem a'
y0 Elem a'
y1 Elem a'
y2)))
(Elem a' -> Elem a' -> Elem a' -> Digit (Elem a')
forall a. a -> a -> a -> Digit a
Three Elem a'
y3 Elem a'
y4 Elem a'
y5)
mkTree (x1 :: Elem a'
x1:x2 :: Elem a'
x2:x3 :: Elem a'
x3:x4 :: Elem a'
x4:x5 :: Elem a'
x5:x6 :: Elem a'
x6:x7 :: Elem a'
x7:x8 :: Elem a'
x8:x9 :: Elem a'
x9:y0 :: Elem a'
y0:y1 :: Elem a'
y1:y2 :: Elem a'
y2:y3 :: Elem a'
y3:y4 :: Elem a'
y4:y5 :: Elem a'
y5:y6 :: Elem a'
y6:xs :: [Elem a']
xs) =
((Digit (Node (Elem a')), Digit (Elem a'))
-> FingerTree (Node (Node (Elem a'))) -> FingerTree (Elem a'))
-> Int
-> ListFinal
(Node (Node (Elem a'))) (Digit (Node (Elem a')), Digit (Elem a'))
-> FingerTree (Elem a')
forall a b c.
(b -> FingerTree (Node a) -> c) -> Int -> ListFinal (Node a) b -> c
mkTreeC (Digit (Node (Elem a')), Digit (Elem a'))
-> FingerTree (Node (Node (Elem a'))) -> FingerTree (Elem a')
cont 9 (Int
-> Node (Elem a')
-> Elem a'
-> [Elem a']
-> ListFinal
(Node (Node (Elem a'))) (Digit (Node (Elem a')), Digit (Elem a'))
forall a.
Int
-> Node a
-> a
-> [a]
-> ListFinal (Node (Node a)) (Digit (Node a), Digit a)
getNodes 3 (Int -> Elem a' -> Elem a' -> Elem a' -> Node (Elem a')
forall a. Int -> a -> a -> a -> Node a
Node3 3 Elem a'
y3 Elem a'
y4 Elem a'
y5) Elem a'
y6 [Elem a']
xs)
where
d2 :: Digit (Elem a')
d2 = Elem a' -> Elem a' -> Elem a' -> Digit (Elem a')
forall a. a -> a -> a -> Digit a
Three Elem a'
x1 Elem a'
x2 Elem a'
x3
d1 :: Digit (Node (Elem a'))
d1 = Node (Elem a')
-> Node (Elem a') -> Node (Elem a') -> Digit (Node (Elem a'))
forall a. a -> a -> a -> Digit a
Three (Int -> Elem a' -> Elem a' -> Elem a' -> Node (Elem a')
forall a. Int -> a -> a -> a -> Node a
Node3 3 Elem a'
x4 Elem a'
x5 Elem a'
x6) (Int -> Elem a' -> Elem a' -> Elem a' -> Node (Elem a')
forall a. Int -> a -> a -> a -> Node a
Node3 3 Elem a'
x7 Elem a'
x8 Elem a'
x9) (Int -> Elem a' -> Elem a' -> Elem a' -> Node (Elem a')
forall a. Int -> a -> a -> a -> Node a
Node3 3 Elem a'
y0 Elem a'
y1 Elem a'
y2)
#ifdef __GLASGOW_HASKELL__
cont :: (Digit (Node (Elem a')), Digit (Elem a')) -> FingerTree (Node (Node (Elem a'))) -> FingerTree (Elem a')
#endif
cont :: (Digit (Node (Elem a')), Digit (Elem a'))
-> FingerTree (Node (Node (Elem a'))) -> FingerTree (Elem a')
cont (!Digit (Node (Elem a'))
r1, !Digit (Elem a')
r2) !FingerTree (Node (Node (Elem a')))
sub =
let !sub1 :: FingerTree (Node (Elem a'))
sub1 = Int
-> Digit (Node (Elem a'))
-> FingerTree (Node (Node (Elem a')))
-> Digit (Node (Elem a'))
-> FingerTree (Node (Elem a'))
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (9 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Digit (Node (Elem a')) -> Int
forall a. Sized a => a -> Int
size Digit (Node (Elem a'))
r1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ FingerTree (Node (Node (Elem a'))) -> Int
forall a. Sized a => a -> Int
size FingerTree (Node (Node (Elem a')))
sub) Digit (Node (Elem a'))
d1 FingerTree (Node (Node (Elem a')))
sub Digit (Node (Elem a'))
r1
in 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 (3 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Digit (Elem a') -> Int
forall a. Sized a => a -> Int
size Digit (Elem a')
r2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ FingerTree (Node (Elem a')) -> Int
forall a. Sized a => a -> Int
size FingerTree (Node (Elem a'))
sub1) Digit (Elem a')
d2 FingerTree (Node (Elem a'))
sub1 Digit (Elem a')
r2
getNodes :: forall a . Int
-> Node a
-> a
-> [a]
-> ListFinal (Node (Node a)) (Digit (Node a), Digit a)
getNodes :: Int
-> Node a
-> a
-> [a]
-> ListFinal (Node (Node a)) (Digit (Node a), Digit a)
getNodes !Int
_ n1 :: Node a
n1 x1 :: a
x1 [] = (Digit (Node a), Digit a)
-> ListFinal (Node (Node a)) (Digit (Node a), Digit a)
forall a cont. cont -> ListFinal a cont
LFinal (Node a -> Digit (Node a)
forall a. a -> Digit a
One Node a
n1, a -> Digit a
forall a. a -> Digit a
One a
x1)
getNodes _ n1 :: Node a
n1 x1 :: a
x1 [x2 :: a
x2] = (Digit (Node a), Digit a)
-> ListFinal (Node (Node a)) (Digit (Node a), Digit a)
forall a cont. cont -> ListFinal a cont
LFinal (Node a -> Digit (Node a)
forall a. a -> Digit a
One Node a
n1, a -> a -> Digit a
forall a. a -> a -> Digit a
Two a
x1 a
x2)
getNodes _ n1 :: Node a
n1 x1 :: a
x1 [x2 :: a
x2, x3 :: a
x3] = (Digit (Node a), Digit a)
-> ListFinal (Node (Node a)) (Digit (Node a), Digit a)
forall a cont. cont -> ListFinal a cont
LFinal (Node a -> Digit (Node a)
forall a. a -> Digit a
One Node a
n1, a -> a -> a -> Digit a
forall a. a -> a -> a -> Digit a
Three a
x1 a
x2 a
x3)
getNodes s :: Int
s n1 :: Node a
n1 x1 :: a
x1 [x2 :: a
x2, x3 :: a
x3, x4 :: a
x4] = (Digit (Node a), Digit a)
-> ListFinal (Node (Node a)) (Digit (Node a), Digit a)
forall a cont. cont -> ListFinal a cont
LFinal (Node a -> Node a -> Digit (Node a)
forall a. a -> a -> Digit a
Two Node a
n1 (Int -> a -> a -> a -> Node a
forall a. Int -> a -> a -> a -> Node a
Node3 Int
s a
x1 a
x2 a
x3), a -> Digit a
forall a. a -> Digit a
One a
x4)
getNodes s :: Int
s n1 :: Node a
n1 x1 :: a
x1 [x2 :: a
x2, x3 :: a
x3, x4 :: a
x4, x5 :: a
x5] = (Digit (Node a), Digit a)
-> ListFinal (Node (Node a)) (Digit (Node a), Digit a)
forall a cont. cont -> ListFinal a cont
LFinal (Node a -> Node a -> Digit (Node a)
forall a. a -> a -> Digit a
Two Node a
n1 (Int -> a -> a -> a -> Node a
forall a. Int -> a -> a -> a -> Node a
Node3 Int
s a
x1 a
x2 a
x3), a -> a -> Digit a
forall a. a -> a -> Digit a
Two a
x4 a
x5)
getNodes s :: Int
s n1 :: Node a
n1 x1 :: a
x1 [x2 :: a
x2, x3 :: a
x3, x4 :: a
x4, x5 :: a
x5, x6 :: a
x6] = (Digit (Node a), Digit a)
-> ListFinal (Node (Node a)) (Digit (Node a), Digit a)
forall a cont. cont -> ListFinal a cont
LFinal (Node a -> Node a -> Digit (Node a)
forall a. a -> a -> Digit a
Two Node a
n1 (Int -> a -> a -> a -> Node a
forall a. Int -> a -> a -> a -> Node a
Node3 Int
s a
x1 a
x2 a
x3), a -> a -> a -> Digit a
forall a. a -> a -> a -> Digit a
Three a
x4 a
x5 a
x6)
getNodes s :: Int
s n1 :: Node a
n1 x1 :: a
x1 [x2 :: a
x2, x3 :: a
x3, x4 :: a
x4, x5 :: a
x5, x6 :: a
x6, x7 :: a
x7] = (Digit (Node a), Digit a)
-> ListFinal (Node (Node a)) (Digit (Node a), Digit a)
forall a cont. cont -> ListFinal a cont
LFinal (Node a -> Node a -> Node a -> Digit (Node a)
forall a. a -> a -> a -> Digit a
Three Node a
n1 (Int -> a -> a -> a -> Node a
forall a. Int -> a -> a -> a -> Node a
Node3 Int
s a
x1 a
x2 a
x3) (Int -> a -> a -> a -> Node a
forall a. Int -> a -> a -> a -> Node a
Node3 Int
s a
x4 a
x5 a
x6), a -> Digit a
forall a. a -> Digit a
One a
x7)
getNodes s :: Int
s n1 :: Node a
n1 x1 :: a
x1 [x2 :: a
x2, x3 :: a
x3, x4 :: a
x4, x5 :: a
x5, x6 :: a
x6, x7 :: a
x7, x8 :: a
x8] = (Digit (Node a), Digit a)
-> ListFinal (Node (Node a)) (Digit (Node a), Digit a)
forall a cont. cont -> ListFinal a cont
LFinal (Node a -> Node a -> Node a -> Digit (Node a)
forall a. a -> a -> a -> Digit a
Three Node a
n1 (Int -> a -> a -> a -> Node a
forall a. Int -> a -> a -> a -> Node a
Node3 Int
s a
x1 a
x2 a
x3) (Int -> a -> a -> a -> Node a
forall a. Int -> a -> a -> a -> Node a
Node3 Int
s a
x4 a
x5 a
x6), a -> a -> Digit a
forall a. a -> a -> Digit a
Two a
x7 a
x8)
getNodes s :: Int
s n1 :: Node a
n1 x1 :: a
x1 [x2 :: a
x2, x3 :: a
x3, x4 :: a
x4, x5 :: a
x5, x6 :: a
x6, x7 :: a
x7, x8 :: a
x8, x9 :: a
x9] = (Digit (Node a), Digit a)
-> ListFinal (Node (Node a)) (Digit (Node a), Digit a)
forall a cont. cont -> ListFinal a cont
LFinal (Node a -> Node a -> Node a -> Digit (Node a)
forall a. a -> a -> a -> Digit a
Three Node a
n1 (Int -> a -> a -> a -> Node a
forall a. Int -> a -> a -> a -> Node a
Node3 Int
s a
x1 a
x2 a
x3) (Int -> a -> a -> a -> Node a
forall a. Int -> a -> a -> a -> Node a
Node3 Int
s a
x4 a
x5 a
x6), a -> a -> a -> Digit a
forall a. a -> a -> a -> Digit a
Three a
x7 a
x8 a
x9)
getNodes s :: Int
s n1 :: Node a
n1 x1 :: a
x1 (x2 :: a
x2:x3 :: a
x3:x4 :: a
x4:x5 :: a
x5:x6 :: a
x6:x7 :: a
x7:x8 :: a
x8:x9 :: a
x9:x10 :: a
x10:xs :: [a]
xs) = Node (Node a)
-> ListFinal (Node (Node a)) (Digit (Node a), Digit a)
-> ListFinal (Node (Node a)) (Digit (Node a), Digit a)
forall a cont. a -> ListFinal a cont -> ListFinal a cont
LCons Node (Node a)
n10 (Int
-> Node a
-> a
-> [a]
-> ListFinal (Node (Node a)) (Digit (Node a), Digit a)
forall a.
Int
-> Node a
-> a
-> [a]
-> ListFinal (Node (Node a)) (Digit (Node a), Digit a)
getNodes Int
s (Int -> a -> a -> a -> Node a
forall a. Int -> a -> a -> a -> Node a
Node3 Int
s a
x7 a
x8 a
x9) a
x10 [a]
xs)
where !n2 :: Node a
n2 = Int -> a -> a -> a -> Node a
forall a. Int -> a -> a -> a -> Node a
Node3 Int
s a
x1 a
x2 a
x3
!n3 :: Node a
n3 = Int -> a -> a -> a -> Node a
forall a. Int -> a -> a -> a -> Node a
Node3 Int
s a
x4 a
x5 a
x6
!n10 :: Node (Node a)
n10 = Int -> Node a -> Node a -> Node a -> Node (Node a)
forall a. Int -> a -> a -> a -> Node a
Node3 (3Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
s) Node a
n1 Node a
n2 Node a
n3
mkTreeC ::
#ifdef __GLASGOW_HASKELL__
forall a b c .
#endif
(b -> FingerTree (Node a) -> c)
-> Int
-> ListFinal (Node a) b
-> c
mkTreeC :: (b -> FingerTree (Node a) -> c) -> Int -> ListFinal (Node a) b -> c
mkTreeC cont :: b -> FingerTree (Node a) -> c
cont !Int
_ (LFinal b :: b
b) =
b -> FingerTree (Node a) -> c
cont b
b FingerTree (Node a)
forall a. FingerTree a
EmptyT
mkTreeC cont :: b -> FingerTree (Node a) -> c
cont _ (LCons x1 :: Node a
x1 (LFinal b :: b
b)) =
b -> FingerTree (Node a) -> c
cont b
b (Node a -> FingerTree (Node a)
forall a. a -> FingerTree a
Single Node a
x1)
mkTreeC cont :: b -> FingerTree (Node a) -> c
cont s :: Int
s (LCons x1 :: Node a
x1 (LCons x2 :: Node a
x2 (LFinal b :: b
b))) =
b -> FingerTree (Node a) -> c
cont b
b (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 (2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
s) (Node a -> Digit (Node a)
forall a. a -> Digit a
One Node a
x1) FingerTree (Node (Node a))
forall a. FingerTree a
EmptyT (Node a -> Digit (Node a)
forall a. a -> Digit a
One Node a
x2))
mkTreeC cont :: b -> FingerTree (Node a) -> c
cont s :: Int
s (LCons x1 :: Node a
x1 (LCons x2 :: Node a
x2 (LCons x3 :: Node a
x3 (LFinal b :: b
b)))) =
b -> FingerTree (Node a) -> c
cont b
b (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 (3Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
s) (Node a -> Node a -> Digit (Node a)
forall a. a -> a -> Digit a
Two Node a
x1 Node a
x2) FingerTree (Node (Node a))
forall a. FingerTree a
EmptyT (Node a -> Digit (Node a)
forall a. a -> Digit a
One Node a
x3))
mkTreeC cont :: b -> FingerTree (Node a) -> c
cont s :: Int
s (LCons x1 :: Node a
x1 (LCons x2 :: Node a
x2 (LCons x3 :: Node a
x3 (LCons x4 :: Node a
x4 (LFinal b :: b
b))))) =
b -> FingerTree (Node a) -> c
cont b
b (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 (4Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
s) (Node a -> Node a -> Digit (Node a)
forall a. a -> a -> Digit a
Two Node a
x1 Node a
x2) FingerTree (Node (Node a))
forall a. FingerTree a
EmptyT (Node a -> Node a -> Digit (Node a)
forall a. a -> a -> Digit a
Two Node a
x3 Node a
x4))
mkTreeC cont :: b -> FingerTree (Node a) -> c
cont s :: Int
s (LCons x1 :: Node a
x1 (LCons x2 :: Node a
x2 (LCons x3 :: Node a
x3 (LCons x4 :: Node a
x4 (LCons x5 :: Node a
x5 (LFinal b :: b
b)))))) =
b -> FingerTree (Node a) -> c
cont b
b (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 (5Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
s) (Node a -> Node a -> Node a -> Digit (Node a)
forall a. a -> a -> a -> Digit a
Three Node a
x1 Node a
x2 Node a
x3) FingerTree (Node (Node a))
forall a. FingerTree a
EmptyT (Node a -> Node a -> Digit (Node a)
forall a. a -> a -> Digit a
Two Node a
x4 Node a
x5))
mkTreeC cont :: b -> FingerTree (Node a) -> c
cont s :: Int
s (LCons x1 :: Node a
x1 (LCons x2 :: Node a
x2 (LCons x3 :: Node a
x3 (LCons x4 :: Node a
x4 (LCons x5 :: Node a
x5 (LCons x6 :: Node a
x6 (LFinal b :: b
b))))))) =
b -> FingerTree (Node a) -> c
cont b
b (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 (6Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
s) (Node a -> Node a -> Node a -> Digit (Node a)
forall a. a -> a -> a -> Digit a
Three Node a
x1 Node a
x2 Node a
x3) FingerTree (Node (Node a))
forall a. FingerTree a
EmptyT (Node a -> Node a -> Node a -> Digit (Node a)
forall a. a -> a -> a -> Digit a
Three Node a
x4 Node a
x5 Node a
x6))
mkTreeC cont :: b -> FingerTree (Node a) -> c
cont s :: Int
s (LCons x1 :: Node a
x1 (LCons x2 :: Node a
x2 (LCons x3 :: Node a
x3 (LCons x4 :: Node a
x4 (LCons x5 :: Node a
x5 (LCons x6 :: Node a
x6 (LCons x7 :: Node a
x7 (LFinal b :: b
b)))))))) =
b -> FingerTree (Node a) -> c
cont b
b (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 (7Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
s) (Node a -> Node a -> Digit (Node a)
forall a. a -> a -> Digit a
Two Node a
x1 Node a
x2) (Node (Node a) -> FingerTree (Node (Node a))
forall a. a -> FingerTree a
Single (Int -> Node a -> Node a -> Node a -> Node (Node a)
forall a. Int -> a -> a -> a -> Node a
Node3 (3Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
s) Node a
x3 Node a
x4 Node a
x5)) (Node a -> Node a -> Digit (Node a)
forall a. a -> a -> Digit a
Two Node a
x6 Node a
x7))
mkTreeC cont :: b -> FingerTree (Node a) -> c
cont s :: Int
s (LCons x1 :: Node a
x1 (LCons x2 :: Node a
x2 (LCons x3 :: Node a
x3 (LCons x4 :: Node a
x4 (LCons x5 :: Node a
x5 (LCons x6 :: Node a
x6 (LCons x7 :: Node a
x7 (LCons x8 :: Node a
x8 (LFinal b :: b
b))))))))) =
b -> FingerTree (Node a) -> c
cont b
b (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 (8Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
s) (Node a -> Node a -> Node a -> Digit (Node a)
forall a. a -> a -> a -> Digit a
Three Node a
x1 Node a
x2 Node a
x3) (Node (Node a) -> FingerTree (Node (Node a))
forall a. a -> FingerTree a
Single (Int -> Node a -> Node a -> Node a -> Node (Node a)
forall a. Int -> a -> a -> a -> Node a
Node3 (3Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
s) Node a
x4 Node a
x5 Node a
x6)) (Node a -> Node a -> Digit (Node a)
forall a. a -> a -> Digit a
Two Node a
x7 Node a
x8))
mkTreeC cont :: b -> FingerTree (Node a) -> c
cont s :: Int
s (LCons x1 :: Node a
x1 (LCons x2 :: Node a
x2 (LCons x3 :: Node a
x3 (LCons x4 :: Node a
x4 (LCons x5 :: Node a
x5 (LCons x6 :: Node a
x6 (LCons x7 :: Node a
x7 (LCons x8 :: Node a
x8 (LCons x9 :: Node a
x9 (LFinal b :: b
b)))))))))) =
b -> FingerTree (Node a) -> c
cont b
b (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 (9Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
s) (Node a -> Node a -> Node a -> Digit (Node a)
forall a. a -> a -> a -> Digit a
Three Node a
x1 Node a
x2 Node a
x3) (Node (Node a) -> FingerTree (Node (Node a))
forall a. a -> FingerTree a
Single (Int -> Node a -> Node a -> Node a -> Node (Node a)
forall a. Int -> a -> a -> a -> Node a
Node3 (3Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
s) Node a
x4 Node a
x5 Node a
x6)) (Node a -> Node a -> Node a -> Digit (Node a)
forall a. a -> a -> a -> Digit a
Three Node a
x7 Node a
x8 Node a
x9))
mkTreeC cont :: b -> FingerTree (Node a) -> c
cont s :: Int
s (LCons x1 :: Node a
x1 (LCons x2 :: Node a
x2 (LCons x3 :: Node a
x3 (LCons x4 :: Node a
x4 (LCons x5 :: Node a
x5 (LCons x6 :: Node a
x6 (LCons x7 :: Node a
x7 (LCons x8 :: Node a
x8 (LCons y0 :: Node a
y0 (LCons y1 :: Node a
y1 (LFinal b :: b
b))))))))))) =
b -> FingerTree (Node a) -> c
cont b
b (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 (10Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
s) (Node a -> Node a -> Digit (Node a)
forall a. a -> a -> Digit a
Two Node a
x1 Node a
x2) (Int
-> Digit (Node (Node a))
-> FingerTree (Node (Node (Node a)))
-> Digit (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (6Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
s) (Node (Node a) -> Digit (Node (Node a))
forall a. a -> Digit a
One (Int -> Node a -> Node a -> Node a -> Node (Node a)
forall a. Int -> a -> a -> a -> Node a
Node3 (3Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
s) Node a
x3 Node a
x4 Node a
x5)) FingerTree (Node (Node (Node a)))
forall a. FingerTree a
EmptyT (Node (Node a) -> Digit (Node (Node a))
forall a. a -> Digit a
One (Int -> Node a -> Node a -> Node a -> Node (Node a)
forall a. Int -> a -> a -> a -> Node a
Node3 (3Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
s) Node a
x6 Node a
x7 Node a
x8))) (Node a -> Node a -> Digit (Node a)
forall a. a -> a -> Digit a
Two Node a
y0 Node a
y1))
mkTreeC cont :: b -> FingerTree (Node a) -> c
cont s :: Int
s (LCons x1 :: Node a
x1 (LCons x2 :: Node a
x2 (LCons x3 :: Node a
x3 (LCons x4 :: Node a
x4 (LCons x5 :: Node a
x5 (LCons x6 :: Node a
x6 (LCons x7 :: Node a
x7 (LCons x8 :: Node a
x8 (LCons x9 :: Node a
x9 (LCons y0 :: Node a
y0 (LCons y1 :: Node a
y1 (LFinal b :: b
b)))))))))))) =
b -> FingerTree (Node a) -> c
cont b
b (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 (11Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
s) (Node a -> Node a -> Node a -> Digit (Node a)
forall a. a -> a -> a -> Digit a
Three Node a
x1 Node a
x2 Node a
x3) (Int
-> Digit (Node (Node a))
-> FingerTree (Node (Node (Node a)))
-> Digit (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (6Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
s) (Node (Node a) -> Digit (Node (Node a))
forall a. a -> Digit a
One (Int -> Node a -> Node a -> Node a -> Node (Node a)
forall a. Int -> a -> a -> a -> Node a
Node3 (3Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
s) Node a
x4 Node a
x5 Node a
x6)) FingerTree (Node (Node (Node a)))
forall a. FingerTree a
EmptyT (Node (Node a) -> Digit (Node (Node a))
forall a. a -> Digit a
One (Int -> Node a -> Node a -> Node a -> Node (Node a)
forall a. Int -> a -> a -> a -> Node a
Node3 (3Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
s) Node a
x7 Node a
x8 Node a
x9))) (Node a -> Node a -> Digit (Node a)
forall a. a -> a -> Digit a
Two Node a
y0 Node a
y1))
mkTreeC cont :: b -> FingerTree (Node a) -> c
cont s :: Int
s (LCons x1 :: Node a
x1 (LCons x2 :: Node a
x2 (LCons x3 :: Node a
x3 (LCons x4 :: Node a
x4 (LCons x5 :: Node a
x5 (LCons x6 :: Node a
x6 (LCons x7 :: Node a
x7 (LCons x8 :: Node a
x8 (LCons x9 :: Node a
x9 (LCons y0 :: Node a
y0 (LCons y1 :: Node a
y1 (LCons y2 :: Node a
y2 (LFinal b :: b
b))))))))))))) =
b -> FingerTree (Node a) -> c
cont b
b (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 (12Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
s) (Node a -> Node a -> Node a -> Digit (Node a)
forall a. a -> a -> a -> Digit a
Three Node a
x1 Node a
x2 Node a
x3) (Int
-> Digit (Node (Node a))
-> FingerTree (Node (Node (Node a)))
-> Digit (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (6Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
s) (Node (Node a) -> Digit (Node (Node a))
forall a. a -> Digit a
One (Int -> Node a -> Node a -> Node a -> Node (Node a)
forall a. Int -> a -> a -> a -> Node a
Node3 (3Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
s) Node a
x4 Node a
x5 Node a
x6)) FingerTree (Node (Node (Node a)))
forall a. FingerTree a
EmptyT (Node (Node a) -> Digit (Node (Node a))
forall a. a -> Digit a
One (Int -> Node a -> Node a -> Node a -> Node (Node a)
forall a. Int -> a -> a -> a -> Node a
Node3 (3Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
s) Node a
x7 Node a
x8 Node a
x9))) (Node a -> Node a -> Node a -> Digit (Node a)
forall a. a -> a -> a -> Digit a
Three Node a
y0 Node a
y1 Node a
y2))
mkTreeC cont :: b -> FingerTree (Node a) -> c
cont s :: Int
s (LCons x1 :: Node a
x1 (LCons x2 :: Node a
x2 (LCons x3 :: Node a
x3 (LCons x4 :: Node a
x4 (LCons x5 :: Node a
x5 (LCons x6 :: Node a
x6 (LCons x7 :: Node a
x7 (LCons x8 :: Node a
x8 (LCons y0 :: Node a
y0 (LCons y1 :: Node a
y1 (LCons y2 :: Node a
y2 (LCons y3 :: Node a
y3 (LCons y4 :: Node a
y4 (LFinal b :: b
b)))))))))))))) =
b -> FingerTree (Node a) -> c
cont b
b (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 (13Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
s) (Node a -> Node a -> Digit (Node a)
forall a. a -> a -> Digit a
Two Node a
x1 Node a
x2) (Int
-> Digit (Node (Node a))
-> FingerTree (Node (Node (Node a)))
-> Digit (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (9Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
s) (Node (Node a) -> Node (Node a) -> Digit (Node (Node a))
forall a. a -> a -> Digit a
Two (Int -> Node a -> Node a -> Node a -> Node (Node a)
forall a. Int -> a -> a -> a -> Node a
Node3 (3Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
s) Node a
x3 Node a
x4 Node a
x5) (Int -> Node a -> Node a -> Node a -> Node (Node a)
forall a. Int -> a -> a -> a -> Node a
Node3 (3Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
s) Node a
x6 Node a
x7 Node a
x8)) FingerTree (Node (Node (Node a)))
forall a. FingerTree a
EmptyT (Node (Node a) -> Digit (Node (Node a))
forall a. a -> Digit a
One (Int -> Node a -> Node a -> Node a -> Node (Node a)
forall a. Int -> a -> a -> a -> Node a
Node3 (3Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
s) Node a
y0 Node a
y1 Node a
y2))) (Node a -> Node a -> Digit (Node a)
forall a. a -> a -> Digit a
Two Node a
y3 Node a
y4))
mkTreeC cont :: b -> FingerTree (Node a) -> c
cont s :: Int
s (LCons x1 :: Node a
x1 (LCons x2 :: Node a
x2 (LCons x3 :: Node a
x3 (LCons x4 :: Node a
x4 (LCons x5 :: Node a
x5 (LCons x6 :: Node a
x6 (LCons x7 :: Node a
x7 (LCons x8 :: Node a
x8 (LCons x9 :: Node a
x9 (LCons y0 :: Node a
y0 (LCons y1 :: Node a
y1 (LCons y2 :: Node a
y2 (LCons y3 :: Node a
y3 (LCons y4 :: Node a
y4 (LFinal b :: b
b))))))))))))))) =
b -> FingerTree (Node a) -> c
cont b
b (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 (14Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
s) (Node a -> Node a -> Node a -> Digit (Node a)
forall a. a -> a -> a -> Digit a
Three Node a
x1 Node a
x2 Node a
x3) (Int
-> Digit (Node (Node a))
-> FingerTree (Node (Node (Node a)))
-> Digit (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (9Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
s) (Node (Node a) -> Node (Node a) -> Digit (Node (Node a))
forall a. a -> a -> Digit a
Two (Int -> Node a -> Node a -> Node a -> Node (Node a)
forall a. Int -> a -> a -> a -> Node a
Node3 (3Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
s) Node a
x4 Node a
x5 Node a
x6) (Int -> Node a -> Node a -> Node a -> Node (Node a)
forall a. Int -> a -> a -> a -> Node a
Node3 (3Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
s) Node a
x7 Node a
x8 Node a
x9)) FingerTree (Node (Node (Node a)))
forall a. FingerTree a
EmptyT (Node (Node a) -> Digit (Node (Node a))
forall a. a -> Digit a
One (Int -> Node a -> Node a -> Node a -> Node (Node a)
forall a. Int -> a -> a -> a -> Node a
Node3 (3Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
s) Node a
y0 Node a
y1 Node a
y2))) (Node a -> Node a -> Digit (Node a)
forall a. a -> a -> Digit a
Two Node a
y3 Node a
y4))
mkTreeC cont :: b -> FingerTree (Node a) -> c
cont s :: Int
s (LCons x1 :: Node a
x1 (LCons x2 :: Node a
x2 (LCons x3 :: Node a
x3 (LCons x4 :: Node a
x4 (LCons x5 :: Node a
x5 (LCons x6 :: Node a
x6 (LCons x7 :: Node a
x7 (LCons x8 :: Node a
x8 (LCons x9 :: Node a
x9 (LCons y0 :: Node a
y0 (LCons y1 :: Node a
y1 (LCons y2 :: Node a
y2 (LCons y3 :: Node a
y3 (LCons y4 :: Node a
y4 (LCons y5 :: Node a
y5 (LFinal b :: b
b)))))))))))))))) =
b -> FingerTree (Node a) -> c
cont b
b (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 (15Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
s) (Node a -> Node a -> Node a -> Digit (Node a)
forall a. a -> a -> a -> Digit a
Three Node a
x1 Node a
x2 Node a
x3) (Int
-> Digit (Node (Node a))
-> FingerTree (Node (Node (Node a)))
-> Digit (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (9Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
s) (Node (Node a) -> Node (Node a) -> Digit (Node (Node a))
forall a. a -> a -> Digit a
Two (Int -> Node a -> Node a -> Node a -> Node (Node a)
forall a. Int -> a -> a -> a -> Node a
Node3 (3Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
s) Node a
x4 Node a
x5 Node a
x6) (Int -> Node a -> Node a -> Node a -> Node (Node a)
forall a. Int -> a -> a -> a -> Node a
Node3 (3Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
s) Node a
x7 Node a
x8 Node a
x9)) FingerTree (Node (Node (Node a)))
forall a. FingerTree a
EmptyT (Node (Node a) -> Digit (Node (Node a))
forall a. a -> Digit a
One (Int -> Node a -> Node a -> Node a -> Node (Node a)
forall a. Int -> a -> a -> a -> Node a
Node3 (3Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
s) Node a
y0 Node a
y1 Node a
y2))) (Node a -> Node a -> Node a -> Digit (Node a)
forall a. a -> a -> a -> Digit a
Three Node a
y3 Node a
y4 Node a
y5))
mkTreeC cont :: b -> FingerTree (Node a) -> c
cont s :: Int
s (LCons x1 :: Node a
x1 (LCons x2 :: Node a
x2 (LCons x3 :: Node a
x3 (LCons x4 :: Node a
x4 (LCons x5 :: Node a
x5 (LCons x6 :: Node a
x6 (LCons x7 :: Node a
x7 (LCons x8 :: Node a
x8 (LCons x9 :: Node a
x9 (LCons y0 :: Node a
y0 (LCons y1 :: Node a
y1 (LCons y2 :: Node a
y2 (LCons y3 :: Node a
y3 (LCons y4 :: Node a
y4 (LCons y5 :: Node a
y5 (LCons y6 :: Node a
y6 xs :: ListFinal (Node a) b
xs)))))))))))))))) =
((b, Digit (Node (Node a)), Digit (Node a))
-> FingerTree (Node (Node (Node a))) -> c)
-> Int
-> ListFinal
(Node (Node (Node a))) (b, Digit (Node (Node a)), Digit (Node a))
-> c
forall a b c.
(b -> FingerTree (Node a) -> c) -> Int -> ListFinal (Node a) b -> c
mkTreeC (b, Digit (Node (Node a)), Digit (Node a))
-> FingerTree (Node (Node (Node a))) -> c
cont2 (9Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
s) (Int
-> Node (Node a)
-> Node a
-> ListFinal (Node a) b
-> ListFinal
(Node (Node (Node a))) (b, Digit (Node (Node a)), Digit (Node a))
forall a b.
Int
-> Node a
-> a
-> ListFinal a b
-> ListFinal (Node (Node a)) (b, Digit (Node a), Digit a)
getNodesC (3Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
s) (Int -> Node a -> Node a -> Node a -> Node (Node a)
forall a. Int -> a -> a -> a -> Node a
Node3 (3Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
s) Node a
y3 Node a
y4 Node a
y5) Node a
y6 ListFinal (Node a) b
xs)
where
#ifdef __GLASGOW_HASKELL__
cont2 :: (b, Digit (Node (Node a)), Digit (Node a)) -> FingerTree (Node (Node (Node a))) -> c
#endif
cont2 :: (b, Digit (Node (Node a)), Digit (Node a))
-> FingerTree (Node (Node (Node a))) -> c
cont2 (b :: b
b, r1 :: Digit (Node (Node a))
r1, r2 :: Digit (Node a)
r2) !FingerTree (Node (Node (Node a)))
sub =
let d2 :: Digit (Node a)
d2 = Node a -> Node a -> Node a -> Digit (Node a)
forall a. a -> a -> a -> Digit a
Three Node a
x1 Node a
x2 Node a
x3
d1 :: Digit (Node (Node a))
d1 = Node (Node a)
-> Node (Node a) -> Node (Node a) -> Digit (Node (Node a))
forall a. a -> a -> a -> Digit a
Three (Int -> Node a -> Node a -> Node a -> Node (Node a)
forall a. Int -> a -> a -> a -> Node a
Node3 (3Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
s) Node a
x4 Node a
x5 Node a
x6) (Int -> Node a -> Node a -> Node a -> Node (Node a)
forall a. Int -> a -> a -> a -> Node a
Node3 (3Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
s) Node a
x7 Node a
x8 Node a
x9) (Int -> Node a -> Node a -> Node a -> Node (Node a)
forall a. Int -> a -> a -> a -> Node a
Node3 (3Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
s) Node a
y0 Node a
y1 Node a
y2)
!sub1 :: FingerTree (Node (Node a))
sub1 = Int
-> Digit (Node (Node a))
-> FingerTree (Node (Node (Node a)))
-> Digit (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (9Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Digit (Node (Node a)) -> Int
forall a. Sized a => a -> Int
size Digit (Node (Node a))
r1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ FingerTree (Node (Node (Node a))) -> Int
forall a. Sized a => a -> Int
size FingerTree (Node (Node (Node a)))
sub) Digit (Node (Node a))
d1 FingerTree (Node (Node (Node a)))
sub Digit (Node (Node a))
r1
in b -> FingerTree (Node a) -> c
cont b
b (FingerTree (Node a) -> c) -> FingerTree (Node a) -> c
forall a b. (a -> b) -> a -> b
$! 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 (3Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Digit (Node a) -> Int
forall a. Sized a => a -> Int
size Digit (Node a)
r2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ FingerTree (Node (Node a)) -> Int
forall a. Sized a => a -> Int
size FingerTree (Node (Node a))
sub1) Digit (Node a)
d2 FingerTree (Node (Node a))
sub1 Digit (Node a)
r2
getNodesC :: Int
-> Node a
-> a
-> ListFinal a b
-> ListFinal (Node (Node a)) (b, Digit (Node a), Digit a)
getNodesC :: Int
-> Node a
-> a
-> ListFinal a b
-> ListFinal (Node (Node a)) (b, Digit (Node a), Digit a)
getNodesC !Int
_ n1 :: Node a
n1 x1 :: a
x1 (LFinal b :: b
b) = (b, Digit (Node a), Digit a)
-> ListFinal (Node (Node a)) (b, Digit (Node a), Digit a)
forall a cont. cont -> ListFinal a cont
LFinal ((b, Digit (Node a), Digit a)
-> ListFinal (Node (Node a)) (b, Digit (Node a), Digit a))
-> (b, Digit (Node a), Digit a)
-> ListFinal (Node (Node a)) (b, Digit (Node a), Digit a)
forall a b. (a -> b) -> a -> b
$ (b
b, Node a -> Digit (Node a)
forall a. a -> Digit a
One Node a
n1, a -> Digit a
forall a. a -> Digit a
One a
x1)
getNodesC _ n1 :: Node a
n1 x1 :: a
x1 (LCons x2 :: a
x2 (LFinal b :: b
b)) = (b, Digit (Node a), Digit a)
-> ListFinal (Node (Node a)) (b, Digit (Node a), Digit a)
forall a cont. cont -> ListFinal a cont
LFinal ((b, Digit (Node a), Digit a)
-> ListFinal (Node (Node a)) (b, Digit (Node a), Digit a))
-> (b, Digit (Node a), Digit a)
-> ListFinal (Node (Node a)) (b, Digit (Node a), Digit a)
forall a b. (a -> b) -> a -> b
$ (b
b, Node a -> Digit (Node a)
forall a. a -> Digit a
One Node a
n1, a -> a -> Digit a
forall a. a -> a -> Digit a
Two a
x1 a
x2)
getNodesC _ n1 :: Node a
n1 x1 :: a
x1 (LCons x2 :: a
x2 (LCons x3 :: a
x3 (LFinal b :: b
b))) = (b, Digit (Node a), Digit a)
-> ListFinal (Node (Node a)) (b, Digit (Node a), Digit a)
forall a cont. cont -> ListFinal a cont
LFinal ((b, Digit (Node a), Digit a)
-> ListFinal (Node (Node a)) (b, Digit (Node a), Digit a))
-> (b, Digit (Node a), Digit a)
-> ListFinal (Node (Node a)) (b, Digit (Node a), Digit a)
forall a b. (a -> b) -> a -> b
$ (b
b, Node a -> Digit (Node a)
forall a. a -> Digit a
One Node a
n1, a -> a -> a -> Digit a
forall a. a -> a -> a -> Digit a
Three a
x1 a
x2 a
x3)
getNodesC s :: Int
s n1 :: Node a
n1 x1 :: a
x1 (LCons x2 :: a
x2 (LCons x3 :: a
x3 (LCons x4 :: a
x4 (LFinal b :: b
b)))) =
let !n2 :: Node a
n2 = Int -> a -> a -> a -> Node a
forall a. Int -> a -> a -> a -> Node a
Node3 Int
s a
x1 a
x2 a
x3
in (b, Digit (Node a), Digit a)
-> ListFinal (Node (Node a)) (b, Digit (Node a), Digit a)
forall a cont. cont -> ListFinal a cont
LFinal ((b, Digit (Node a), Digit a)
-> ListFinal (Node (Node a)) (b, Digit (Node a), Digit a))
-> (b, Digit (Node a), Digit a)
-> ListFinal (Node (Node a)) (b, Digit (Node a), Digit a)
forall a b. (a -> b) -> a -> b
$ (b
b, Node a -> Node a -> Digit (Node a)
forall a. a -> a -> Digit a
Two Node a
n1 Node a
n2, a -> Digit a
forall a. a -> Digit a
One a
x4)
getNodesC s :: Int
s n1 :: Node a
n1 x1 :: a
x1 (LCons x2 :: a
x2 (LCons x3 :: a
x3 (LCons x4 :: a
x4 (LCons x5 :: a
x5 (LFinal b :: b
b))))) =
let !n2 :: Node a
n2 = Int -> a -> a -> a -> Node a
forall a. Int -> a -> a -> a -> Node a
Node3 Int
s a
x1 a
x2 a
x3
in (b, Digit (Node a), Digit a)
-> ListFinal (Node (Node a)) (b, Digit (Node a), Digit a)
forall a cont. cont -> ListFinal a cont
LFinal ((b, Digit (Node a), Digit a)
-> ListFinal (Node (Node a)) (b, Digit (Node a), Digit a))
-> (b, Digit (Node a), Digit a)
-> ListFinal (Node (Node a)) (b, Digit (Node a), Digit a)
forall a b. (a -> b) -> a -> b
$ (b
b, Node a -> Node a -> Digit (Node a)
forall a. a -> a -> Digit a
Two Node a
n1 Node a
n2, a -> a -> Digit a
forall a. a -> a -> Digit a
Two a
x4 a
x5)
getNodesC s :: Int
s n1 :: Node a
n1 x1 :: a
x1 (LCons x2 :: a
x2 (LCons x3 :: a
x3 (LCons x4 :: a
x4 (LCons x5 :: a
x5 (LCons x6 :: a
x6 (LFinal b :: b
b)))))) =
let !n2 :: Node a
n2 = Int -> a -> a -> a -> Node a
forall a. Int -> a -> a -> a -> Node a
Node3 Int
s a
x1 a
x2 a
x3
in (b, Digit (Node a), Digit a)
-> ListFinal (Node (Node a)) (b, Digit (Node a), Digit a)
forall a cont. cont -> ListFinal a cont
LFinal ((b, Digit (Node a), Digit a)
-> ListFinal (Node (Node a)) (b, Digit (Node a), Digit a))
-> (b, Digit (Node a), Digit a)
-> ListFinal (Node (Node a)) (b, Digit (Node a), Digit a)
forall a b. (a -> b) -> a -> b
$ (b
b, Node a -> Node a -> Digit (Node a)
forall a. a -> a -> Digit a
Two Node a
n1 Node a
n2, a -> a -> a -> Digit a
forall a. a -> a -> a -> Digit a
Three a
x4 a
x5 a
x6)
getNodesC s :: Int
s n1 :: Node a
n1 x1 :: a
x1 (LCons x2 :: a
x2 (LCons x3 :: a
x3 (LCons x4 :: a
x4 (LCons x5 :: a
x5 (LCons x6 :: a
x6 (LCons x7 :: a
x7 (LFinal b :: b
b))))))) =
let !n2 :: Node a
n2 = Int -> a -> a -> a -> Node a
forall a. Int -> a -> a -> a -> Node a
Node3 Int
s a
x1 a
x2 a
x3
!n3 :: Node a
n3 = Int -> a -> a -> a -> Node a
forall a. Int -> a -> a -> a -> Node a
Node3 Int
s a
x4 a
x5 a
x6
in (b, Digit (Node a), Digit a)
-> ListFinal (Node (Node a)) (b, Digit (Node a), Digit a)
forall a cont. cont -> ListFinal a cont
LFinal ((b, Digit (Node a), Digit a)
-> ListFinal (Node (Node a)) (b, Digit (Node a), Digit a))
-> (b, Digit (Node a), Digit a)
-> ListFinal (Node (Node a)) (b, Digit (Node a), Digit a)
forall a b. (a -> b) -> a -> b
$ (b
b, Node a -> Node a -> Node a -> Digit (Node a)
forall a. a -> a -> a -> Digit a
Three Node a
n1 Node a
n2 Node a
n3, a -> Digit a
forall a. a -> Digit a
One a
x7)
getNodesC s :: Int
s n1 :: Node a
n1 x1 :: a
x1 (LCons x2 :: a
x2 (LCons x3 :: a
x3 (LCons x4 :: a
x4 (LCons x5 :: a
x5 (LCons x6 :: a
x6 (LCons x7 :: a
x7 (LCons x8 :: a
x8 (LFinal b :: b
b)))))))) =
let !n2 :: Node a
n2 = Int -> a -> a -> a -> Node a
forall a. Int -> a -> a -> a -> Node a
Node3 Int
s a
x1 a
x2 a
x3
!n3 :: Node a
n3 = Int -> a -> a -> a -> Node a
forall a. Int -> a -> a -> a -> Node a
Node3 Int
s a
x4 a
x5 a
x6
in (b, Digit (Node a), Digit a)
-> ListFinal (Node (Node a)) (b, Digit (Node a), Digit a)
forall a cont. cont -> ListFinal a cont
LFinal ((b, Digit (Node a), Digit a)
-> ListFinal (Node (Node a)) (b, Digit (Node a), Digit a))
-> (b, Digit (Node a), Digit a)
-> ListFinal (Node (Node a)) (b, Digit (Node a), Digit a)
forall a b. (a -> b) -> a -> b
$ (b
b, Node a -> Node a -> Node a -> Digit (Node a)
forall a. a -> a -> a -> Digit a
Three Node a
n1 Node a
n2 Node a
n3, a -> a -> Digit a
forall a. a -> a -> Digit a
Two a
x7 a
x8)
getNodesC s :: Int
s n1 :: Node a
n1 x1 :: a
x1 (LCons x2 :: a
x2 (LCons x3 :: a
x3 (LCons x4 :: a
x4 (LCons x5 :: a
x5 (LCons x6 :: a
x6 (LCons x7 :: a
x7 (LCons x8 :: a
x8 (LCons x9 :: a
x9 (LFinal b :: b
b))))))))) =
let !n2 :: Node a
n2 = Int -> a -> a -> a -> Node a
forall a. Int -> a -> a -> a -> Node a
Node3 Int
s a
x1 a
x2 a
x3
!n3 :: Node a
n3 = Int -> a -> a -> a -> Node a
forall a. Int -> a -> a -> a -> Node a
Node3 Int
s a
x4 a
x5 a
x6
in (b, Digit (Node a), Digit a)
-> ListFinal (Node (Node a)) (b, Digit (Node a), Digit a)
forall a cont. cont -> ListFinal a cont
LFinal ((b, Digit (Node a), Digit a)
-> ListFinal (Node (Node a)) (b, Digit (Node a), Digit a))
-> (b, Digit (Node a), Digit a)
-> ListFinal (Node (Node a)) (b, Digit (Node a), Digit a)
forall a b. (a -> b) -> a -> b
$ (b
b, Node a -> Node a -> Node a -> Digit (Node a)
forall a. a -> a -> a -> Digit a
Three Node a
n1 Node a
n2 Node a
n3, a -> a -> a -> Digit a
forall a. a -> a -> a -> Digit a
Three a
x7 a
x8 a
x9)
getNodesC s :: Int
s n1 :: Node a
n1 x1 :: a
x1 (LCons x2 :: a
x2 (LCons x3 :: a
x3 (LCons x4 :: a
x4 (LCons x5 :: a
x5 (LCons x6 :: a
x6 (LCons x7 :: a
x7 (LCons x8 :: a
x8 (LCons x9 :: a
x9 (LCons x10 :: a
x10 xs :: ListFinal a b
xs))))))))) =
Node (Node a)
-> ListFinal (Node (Node a)) (b, Digit (Node a), Digit a)
-> ListFinal (Node (Node a)) (b, Digit (Node a), Digit a)
forall a cont. a -> ListFinal a cont -> ListFinal a cont
LCons Node (Node a)
n10 (ListFinal (Node (Node a)) (b, Digit (Node a), Digit a)
-> ListFinal (Node (Node a)) (b, Digit (Node a), Digit a))
-> ListFinal (Node (Node a)) (b, Digit (Node a), Digit a)
-> ListFinal (Node (Node a)) (b, Digit (Node a), Digit a)
forall a b. (a -> b) -> a -> b
$ Int
-> Node a
-> a
-> ListFinal a b
-> ListFinal (Node (Node a)) (b, Digit (Node a), Digit a)
forall a b.
Int
-> Node a
-> a
-> ListFinal a b
-> ListFinal (Node (Node a)) (b, Digit (Node a), Digit a)
getNodesC Int
s (Int -> a -> a -> a -> Node a
forall a. Int -> a -> a -> a -> Node a
Node3 Int
s a
x7 a
x8 a
x9) a
x10 ListFinal a b
xs
where !n2 :: Node a
n2 = Int -> a -> a -> a -> Node a
forall a. Int -> a -> a -> a -> Node a
Node3 Int
s a
x1 a
x2 a
x3
!n3 :: Node a
n3 = Int -> a -> a -> a -> Node a
forall a. Int -> a -> a -> a -> Node a
Node3 Int
s a
x4 a
x5 a
x6
!n10 :: Node (Node a)
n10 = Int -> Node a -> Node a -> Node a -> Node (Node a)
forall a. Int -> a -> a -> a -> Node a
Node3 (3Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
s) Node a
n1 Node a
n2 Node a
n3
map_elem :: [a] -> [Elem a]
#if __GLASGOW_HASKELL__ >= 708
map_elem :: [a] -> [Elem a]
map_elem xs :: [a]
xs = [a] -> [Elem a]
forall a b. Coercible a b => a -> b
coerce [a]
xs
#else
map_elem xs = Data.List.map Elem xs
#endif
{-# INLINE map_elem #-}
data ListFinal a cont = LFinal !cont | LCons !a (ListFinal a cont)
#if __GLASGOW_HASKELL__ >= 708
instance GHC.Exts.IsList (Seq a) where
type Item (Seq a) = a
fromList :: [Item (Seq a)] -> Seq a
fromList = [Item (Seq a)] -> Seq a
forall a. [a] -> Seq a
fromList
fromListN :: Int -> [Item (Seq a)] -> Seq a
fromListN = Int -> [Item (Seq a)] -> Seq a
forall a. Int -> [a] -> Seq a
fromList2
toList :: Seq a -> [Item (Seq a)]
toList = Seq a -> [Item (Seq a)]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList
#endif
#ifdef __GLASGOW_HASKELL__
instance a ~ Char => IsString (Seq a) where
fromString :: [Char] -> Seq a
fromString = [Char] -> Seq a
forall a. [a] -> Seq a
fromList
#endif
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 b. (a -> b) -> FingerTree a -> FingerTree b
fmapReverseTree Elem a -> Elem a
forall a. a -> a
id FingerTree (Elem a)
xs)
#ifdef __GLASGOW_HASKELL__
{-# NOINLINE [1] reverse #-}
fmapReverse :: (a -> b) -> Seq a -> Seq b
fmapReverse :: (a -> b) -> Seq a -> Seq b
fmapReverse 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 a b. (a -> b) -> FingerTree a -> FingerTree b
fmapReverseTree ((a -> b) -> Elem a -> Elem b
forall a b. (a -> b) -> Elem a -> Elem b
lift_elem a -> b
f) FingerTree (Elem a)
xs)
where
lift_elem :: (a -> b) -> (Elem a -> Elem b)
#if __GLASGOW_HASKELL__ >= 708
lift_elem :: (a -> b) -> Elem a -> Elem b
lift_elem = (a -> b) -> Elem a -> Elem b
forall a b. Coercible a b => a -> b
coerce
#else
lift_elem g (Elem a) = Elem (g a)
#endif
{-# RULES
"fmapSeq/reverse" forall f xs . fmapSeq f (reverse xs) = fmapReverse f xs
"reverse/fmapSeq" forall f xs . reverse (fmapSeq f xs) = fmapReverse f xs
#-}
#endif
fmapReverseTree :: (a -> b) -> FingerTree a -> FingerTree b
fmapReverseTree :: (a -> b) -> FingerTree a -> FingerTree b
fmapReverseTree _ EmptyT = FingerTree b
forall a. FingerTree a
EmptyT
fmapReverseTree f :: a -> b
f (Single x :: a
x) = b -> FingerTree b
forall a. a -> FingerTree a
Single (a -> b
f a
x)
fmapReverseTree f :: a -> b
f (Deep s :: Int
s 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
s ((a -> b) -> Digit a -> Digit b
forall a b. (a -> b) -> Digit a -> Digit b
reverseDigit a -> b
f Digit a
sf)
((Node a -> Node b) -> FingerTree (Node a) -> FingerTree (Node b)
forall a b. (a -> b) -> FingerTree a -> FingerTree b
fmapReverseTree ((a -> b) -> Node a -> Node b
forall a b. (a -> b) -> Node a -> Node b
reverseNode a -> b
f) FingerTree (Node a)
m)
((a -> b) -> Digit a -> Digit b
forall a b. (a -> b) -> Digit a -> Digit b
reverseDigit a -> b
f Digit a
pr)
{-# INLINE reverseDigit #-}
reverseDigit :: (a -> b) -> Digit a -> Digit b
reverseDigit :: (a -> b) -> Digit a -> Digit b
reverseDigit f :: a -> b
f (One a :: a
a) = b -> Digit b
forall a. a -> Digit a
One (a -> b
f a
a)
reverseDigit 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
b) (a -> b
f a
a)
reverseDigit 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
c) (a -> b
f a
b) (a -> b
f a
a)
reverseDigit 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
d) (a -> b
f a
c) (a -> b
f a
b) (a -> b
f a
a)
reverseNode :: (a -> b) -> Node a -> Node b
reverseNode :: (a -> b) -> Node a -> Node b
reverseNode f :: a -> b
f (Node2 s :: Int
s a :: a
a b :: a
b) = Int -> b -> b -> Node b
forall a. Int -> a -> a -> Node a
Node2 Int
s (a -> b
f a
b) (a -> b
f a
a)
reverseNode f :: a -> b
f (Node3 s :: Int
s 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
s (a -> b
f a
c) (a -> b
f a
b) (a -> b
f a
a)
#ifdef __GLASGOW_HASKELL__
{-# INLINE splitMap #-}
splitMap :: forall s a' b' . (Int -> s -> (s,s)) -> (s -> a' -> b') -> s -> Seq a' -> Seq b'
splitMap :: (Int -> s -> (s, s)) -> (s -> a' -> b') -> s -> Seq a' -> Seq b'
splitMap splt :: Int -> s -> (s, s)
splt f0 :: s -> a' -> b'
f0 s0 :: s
s0 (Seq xs0 :: FingerTree (Elem a')
xs0) = FingerTree (Elem b') -> Seq b'
forall a. FingerTree (Elem a) -> Seq a
Seq (FingerTree (Elem b') -> Seq b') -> FingerTree (Elem b') -> Seq b'
forall a b. (a -> b) -> a -> b
$ (s -> Elem a' -> Elem b')
-> s -> FingerTree (Elem a') -> FingerTree (Elem b')
forall y b.
(s -> Elem y -> b) -> s -> FingerTree (Elem y) -> FingerTree b
splitMapTreeE (\s' :: s
s' (Elem a :: a'
a) -> b' -> Elem b'
forall a. a -> Elem a
Elem (s -> a' -> b'
f0 s
s' a'
a)) s
s0 FingerTree (Elem a')
xs0
where
{-# INLINE splitMapTreeE #-}
splitMapTreeE :: (s -> Elem y -> b) -> s -> FingerTree (Elem y) -> FingerTree b
splitMapTreeE :: (s -> Elem y -> b) -> s -> FingerTree (Elem y) -> FingerTree b
splitMapTreeE _ _ EmptyT = FingerTree b
forall a. FingerTree a
EmptyT
splitMapTreeE f :: s -> Elem y -> b
f s :: s
s (Single xs :: Elem y
xs) = b -> FingerTree b
forall a. a -> FingerTree a
Single (b -> FingerTree b) -> b -> FingerTree b
forall a b. (a -> b) -> a -> b
$ s -> Elem y -> b
f s
s Elem y
xs
splitMapTreeE f :: s -> Elem y -> b
f s :: s
s (Deep n :: Int
n pr :: Digit (Elem y)
pr m :: FingerTree (Node (Elem y))
m sf :: Digit (Elem y)
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
n ((s -> Elem y -> b) -> s -> Digit (Elem y) -> Digit b
forall a b. Sized a => (s -> a -> b) -> s -> Digit a -> Digit b
splitMapDigit s -> Elem y -> b
f s
prs Digit (Elem y)
pr) ((s -> Node (Elem y) -> Node b)
-> s -> FingerTree (Node (Elem y)) -> FingerTree (Node b)
forall a b.
(s -> Node a -> b) -> s -> FingerTree (Node a) -> FingerTree b
splitMapTreeN (\eta1 :: s
eta1 eta2 :: Node (Elem y)
eta2 -> (s -> Elem y -> b) -> s -> Node (Elem y) -> Node b
forall a b. Sized a => (s -> a -> b) -> s -> Node a -> Node b
splitMapNode s -> Elem y -> b
f s
eta1 Node (Elem y)
eta2) s
ms FingerTree (Node (Elem y))
m) ((s -> Elem y -> b) -> s -> Digit (Elem y) -> Digit b
forall a b. Sized a => (s -> a -> b) -> s -> Digit a -> Digit b
splitMapDigit s -> Elem y -> b
f s
sfs Digit (Elem y)
sf)
where
!spr :: Int
spr = Digit (Elem y) -> Int
forall a. Sized a => a -> Int
size Digit (Elem y)
pr
!sm :: Int
sm = Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
spr Int -> Int -> Int
forall a. Num a => a -> a -> a
- Digit (Elem y) -> Int
forall a. Sized a => a -> Int
size Digit (Elem y)
sf
(prs :: s
prs, r :: s
r) = Int -> s -> (s, s)
splt Int
spr s
s
(ms :: s
ms, sfs :: s
sfs) = Int -> s -> (s, s)
splt Int
sm s
r
splitMapTreeN :: (s -> Node a -> b) -> s -> FingerTree (Node a) -> FingerTree b
splitMapTreeN :: (s -> Node a -> b) -> s -> FingerTree (Node a) -> FingerTree b
splitMapTreeN _ _ EmptyT = FingerTree b
forall a. FingerTree a
EmptyT
splitMapTreeN f :: s -> Node a -> b
f s :: s
s (Single xs :: Node a
xs) = b -> FingerTree b
forall a. a -> FingerTree a
Single (b -> FingerTree b) -> b -> FingerTree b
forall a b. (a -> b) -> a -> b
$ s -> Node a -> b
f s
s Node a
xs
splitMapTreeN f :: s -> Node a -> b
f s :: s
s (Deep n :: Int
n pr :: Digit (Node a)
pr m :: FingerTree (Node (Node a))
m sf :: Digit (Node 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
n ((s -> Node a -> b) -> s -> Digit (Node a) -> Digit b
forall a b. Sized a => (s -> a -> b) -> s -> Digit a -> Digit b
splitMapDigit s -> Node a -> b
f s
prs Digit (Node a)
pr) ((s -> Node (Node a) -> Node b)
-> s -> FingerTree (Node (Node a)) -> FingerTree (Node b)
forall a b.
(s -> Node a -> b) -> s -> FingerTree (Node a) -> FingerTree b
splitMapTreeN (\eta1 :: s
eta1 eta2 :: Node (Node a)
eta2 -> (s -> Node a -> b) -> s -> Node (Node a) -> Node b
forall a b. Sized a => (s -> a -> b) -> s -> Node a -> Node b
splitMapNode s -> Node a -> b
f s
eta1 Node (Node a)
eta2) s
ms FingerTree (Node (Node a))
m) ((s -> Node a -> b) -> s -> Digit (Node a) -> Digit b
forall a b. Sized a => (s -> a -> b) -> s -> Digit a -> Digit b
splitMapDigit s -> Node a -> b
f s
sfs Digit (Node a)
sf)
where
(prs :: s
prs, r :: s
r) = Int -> s -> (s, s)
splt (Digit (Node a) -> Int
forall a. Sized a => a -> Int
size Digit (Node a)
pr) s
s
(ms :: s
ms, sfs :: s
sfs) = Int -> s -> (s, s)
splt (FingerTree (Node (Node a)) -> Int
forall a. Sized a => a -> Int
size FingerTree (Node (Node a))
m) s
r
{-# INLINE splitMapDigit #-}
splitMapDigit :: Sized a => (s -> a -> b) -> s -> Digit a -> Digit b
splitMapDigit :: (s -> a -> b) -> s -> Digit a -> Digit b
splitMapDigit f :: s -> a -> b
f s :: s
s (One a :: a
a) = b -> Digit b
forall a. a -> Digit a
One (s -> a -> b
f s
s a
a)
splitMapDigit f :: s -> a -> b
f s :: s
s (Two a :: a
a b :: a
b) = b -> b -> Digit b
forall a. a -> a -> Digit a
Two (s -> a -> b
f s
first a
a) (s -> a -> b
f s
second a
b)
where
(first :: s
first, second :: s
second) = Int -> s -> (s, s)
splt (a -> Int
forall a. Sized a => a -> Int
size a
a) s
s
splitMapDigit f :: s -> a -> b
f s :: s
s (Three a :: a
a b :: a
b c :: a
c) = b -> b -> b -> Digit b
forall a. a -> a -> a -> Digit a
Three (s -> a -> b
f s
first a
a) (s -> a -> b
f s
second a
b) (s -> a -> b
f s
third a
c)
where
(first :: s
first, r :: s
r) = Int -> s -> (s, s)
splt (a -> Int
forall a. Sized a => a -> Int
size a
a) s
s
(second :: s
second, third :: s
third) = Int -> s -> (s, s)
splt (a -> Int
forall a. Sized a => a -> Int
size a
b) s
r
splitMapDigit f :: s -> a -> b
f s :: s
s (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 (s -> a -> b
f s
first a
a) (s -> a -> b
f s
second a
b) (s -> a -> b
f s
third a
c) (s -> a -> b
f s
fourth a
d)
where
(first :: s
first, s' :: s
s') = Int -> s -> (s, s)
splt (a -> Int
forall a. Sized a => a -> Int
size a
a) s
s
(middle :: s
middle, fourth :: s
fourth) = Int -> s -> (s, s)
splt (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) s
s'
(second :: s
second, third :: s
third) = Int -> s -> (s, s)
splt (a -> Int
forall a. Sized a => a -> Int
size a
b) s
middle
{-# INLINE splitMapNode #-}
splitMapNode :: Sized a => (s -> a -> b) -> s -> Node a -> Node b
splitMapNode :: (s -> a -> b) -> s -> Node a -> Node b
splitMapNode f :: s -> a -> b
f s :: s
s (Node2 ns :: Int
ns a :: a
a b :: a
b) = Int -> b -> b -> Node b
forall a. Int -> a -> a -> Node a
Node2 Int
ns (s -> a -> b
f s
first a
a) (s -> a -> b
f s
second a
b)
where
(first :: s
first, second :: s
second) = Int -> s -> (s, s)
splt (a -> Int
forall a. Sized a => a -> Int
size a
a) s
s
splitMapNode f :: s -> a -> b
f s :: s
s (Node3 ns :: Int
ns 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
ns (s -> a -> b
f s
first a
a) (s -> a -> b
f s
second a
b) (s -> a -> b
f s
third a
c)
where
(first :: s
first, r :: s
r) = Int -> s -> (s, s)
splt (a -> Int
forall a. Sized a => a -> Int
size a
a) s
s
(second :: s
second, third :: s
third) = Int -> s -> (s, s)
splt (a -> Int
forall a. Sized a => a -> Int
size a
b) s
r
#else
{-# INLINE splitMap #-}
splitMap :: (Int -> s -> (s,s)) -> (s -> a -> b) -> s -> Seq a -> Seq b
splitMap splt' f0 s0 (Seq xs0) = Seq $ splitMapTreeE splt' (\s' (Elem a) -> Elem (f0 s' a)) s0 xs0
{-# INLINE splitMapTreeE #-}
splitMapTreeE :: (Int -> s -> (s,s)) -> (s -> Elem y -> b) -> s -> FingerTree (Elem y) -> FingerTree b
splitMapTreeE _ _ _ EmptyT = EmptyT
splitMapTreeE _ f s (Single xs) = Single $ f s xs
splitMapTreeE splt f s (Deep n pr m sf) = Deep n (splitMapDigit splt f prs pr) (splitMapTreeN splt (\eta1 eta2 -> splitMapNode splt f eta1 eta2) ms m) (splitMapDigit splt f sfs sf)
where
!spr = size pr
sm = n - spr - size sf
(prs, r) = splt spr s
(ms, sfs) = splt sm r
splitMapTreeN :: (Int -> s -> (s,s)) -> (s -> Node a -> b) -> s -> FingerTree (Node a) -> FingerTree b
splitMapTreeN _ _ _ EmptyT = EmptyT
splitMapTreeN _ f s (Single xs) = Single $ f s xs
splitMapTreeN splt f s (Deep n pr m sf) = Deep n (splitMapDigit splt f prs pr) (splitMapTreeN splt (\eta1 eta2 -> splitMapNode splt f eta1 eta2) ms m) (splitMapDigit splt f sfs sf)
where
(prs, r) = splt (size pr) s
(ms, sfs) = splt (size m) r
{-# INLINE splitMapDigit #-}
splitMapDigit :: Sized a => (Int -> s -> (s,s)) -> (s -> a -> b) -> s -> Digit a -> Digit b
splitMapDigit _ f s (One a) = One (f s a)
splitMapDigit splt f s (Two a b) = Two (f first a) (f second b)
where
(first, second) = splt (size a) s
splitMapDigit splt f s (Three a b c) = Three (f first a) (f second b) (f third c)
where
(first, r) = splt (size a) s
(second, third) = splt (size b) r
splitMapDigit splt f s (Four a b c d) = Four (f first a) (f second b) (f third c) (f fourth d)
where
(first, s') = splt (size a) s
(middle, fourth) = splt (size b + size c) s'
(second, third) = splt (size b) middle
{-# INLINE splitMapNode #-}
splitMapNode :: Sized a => (Int -> s -> (s,s)) -> (s -> a -> b) -> s -> Node a -> Node b
splitMapNode splt f s (Node2 ns a b) = Node2 ns (f first a) (f second b)
where
(first, second) = splt (size a) s
splitMapNode splt f s (Node3 ns a b c) = Node3 ns (f first a) (f second b) (f third c)
where
(first, r) = splt (size a) s
(second, third) = splt (size b) r
#endif
instance MonadZip Seq where
mzipWith :: (a -> b -> c) -> Seq a -> Seq b -> Seq c
mzipWith = (a -> b -> c) -> Seq a -> Seq b -> Seq c
forall a b c. (a -> b -> c) -> Seq a -> Seq b -> Seq c
zipWith
munzip :: Seq (a, b) -> (Seq a, Seq b)
munzip = Seq (a, b) -> (Seq a, Seq b)
forall a b. Seq (a, b) -> (Seq a, Seq b)
unzip
unzip :: Seq (a, b) -> (Seq a, Seq b)
unzip :: Seq (a, b) -> (Seq a, Seq b)
unzip xs :: Seq (a, b)
xs = ((a, b) -> (a, b)) -> Seq (a, b) -> (Seq a, Seq b)
forall a b c. (a -> (b, c)) -> Seq a -> (Seq b, Seq c)
unzipWith (a, b) -> (a, b)
forall a. a -> a
id Seq (a, b)
xs
unzipWith :: (a -> (b, c)) -> Seq a -> (Seq b, Seq c)
unzipWith :: (a -> (b, c)) -> Seq a -> (Seq b, Seq c)
unzipWith f :: a -> (b, c)
f = (a -> (b, c)) -> Seq a -> (Seq b, Seq c)
forall (f :: * -> *) x a b.
UnzipWith f =>
(x -> (a, b)) -> f x -> (f a, f b)
unzipWith' (\x :: a
x ->
let
{-# NOINLINE fx #-}
fx :: (b, c)
fx = a -> (b, c)
f a
x
(y :: b
y,z :: c
z) = (b, c)
fx
in (b
y,c
z))
#ifdef __GLASGOW_HASKELL__
{-# NOINLINE [1] unzipWith #-}
{-# RULES
"unzipWith/fmapSeq" forall f g xs. unzipWith f (fmapSeq g xs) =
unzipWith (f . g) xs
#-}
#endif
class UnzipWith f where
unzipWith' :: (x -> (a, b)) -> f x -> (f a, f b)
instance UnzipWith Elem where
#if __GLASGOW_HASKELL__ >= 708
unzipWith' :: (x -> (a, b)) -> Elem x -> (Elem a, Elem b)
unzipWith' = (x -> (a, b)) -> Elem x -> (Elem a, Elem b)
forall a b. Coercible a b => a -> b
coerce
#else
unzipWith' f (Elem a) = case f a of (x, y) -> (Elem x, Elem y)
#endif
instance UnzipWith Node where
unzipWith' :: (x -> (a, b)) -> Node x -> (Node a, Node b)
unzipWith' f :: x -> (a, b)
f (Node2 s :: Int
s x :: x
x y :: x
y) =
( Int -> a -> a -> Node a
forall a. Int -> a -> a -> Node a
Node2 Int
s a
x1 a
y1
, Int -> b -> b -> Node b
forall a. Int -> a -> a -> Node a
Node2 Int
s b
x2 b
y2)
where
{-# NOINLINE fx #-}
{-# NOINLINE fy #-}
fx :: (a, b)
fx = (a, b) -> (a, b)
forall a b. (a, b) -> (a, b)
strictifyPair (x -> (a, b)
f x
x)
fy :: (a, b)
fy = (a, b) -> (a, b)
forall a b. (a, b) -> (a, b)
strictifyPair (x -> (a, b)
f x
y)
(x1 :: a
x1, x2 :: b
x2) = (a, b)
fx
(y1 :: a
y1, y2 :: b
y2) = (a, b)
fy
unzipWith' f :: x -> (a, b)
f (Node3 s :: Int
s x :: x
x y :: x
y z :: x
z) =
( Int -> a -> a -> a -> Node a
forall a. Int -> a -> a -> a -> Node a
Node3 Int
s a
x1 a
y1 a
z1
, Int -> b -> b -> b -> Node b
forall a. Int -> a -> a -> a -> Node a
Node3 Int
s b
x2 b
y2 b
z2)
where
{-# NOINLINE fx #-}
{-# NOINLINE fy #-}
{-# NOINLINE fz #-}
fx :: (a, b)
fx = (a, b) -> (a, b)
forall a b. (a, b) -> (a, b)
strictifyPair (x -> (a, b)
f x
x)
fy :: (a, b)
fy = (a, b) -> (a, b)
forall a b. (a, b) -> (a, b)
strictifyPair (x -> (a, b)
f x
y)
fz :: (a, b)
fz = (a, b) -> (a, b)
forall a b. (a, b) -> (a, b)
strictifyPair (x -> (a, b)
f x
z)
(x1 :: a
x1, x2 :: b
x2) = (a, b)
fx
(y1 :: a
y1, y2 :: b
y2) = (a, b)
fy
(z1 :: a
z1, z2 :: b
z2) = (a, b)
fz
strictifyPair :: (a, b) -> (a, b)
strictifyPair :: (a, b) -> (a, b)
strictifyPair (!a
x, !b
y) = (a
x, b
y)
instance UnzipWith Digit where
unzipWith' :: (x -> (a, b)) -> Digit x -> (Digit a, Digit b)
unzipWith' f :: x -> (a, b)
f (One x :: x
x)
| (x1 :: a
x1, x2 :: b
x2) <- x -> (a, b)
f x
x
= (a -> Digit a
forall a. a -> Digit a
One a
x1, b -> Digit b
forall a. a -> Digit a
One b
x2)
unzipWith' f :: x -> (a, b)
f (Two x :: x
x y :: x
y)
| (x1 :: a
x1, x2 :: b
x2) <- x -> (a, b)
f x
x
, (y1 :: a
y1, y2 :: b
y2) <- x -> (a, b)
f x
y
= ( a -> a -> Digit a
forall a. a -> a -> Digit a
Two a
x1 a
y1
, b -> b -> Digit b
forall a. a -> a -> Digit a
Two b
x2 b
y2)
unzipWith' f :: x -> (a, b)
f (Three x :: x
x y :: x
y z :: x
z)
| (x1 :: a
x1, x2 :: b
x2) <- x -> (a, b)
f x
x
, (y1 :: a
y1, y2 :: b
y2) <- x -> (a, b)
f x
y
, (z1 :: a
z1, z2 :: b
z2) <- x -> (a, b)
f x
z
= ( a -> a -> a -> Digit a
forall a. a -> a -> a -> Digit a
Three a
x1 a
y1 a
z1
, b -> b -> b -> Digit b
forall a. a -> a -> a -> Digit a
Three b
x2 b
y2 b
z2)
unzipWith' f :: x -> (a, b)
f (Four x :: x
x y :: x
y z :: x
z w :: x
w)
| (x1 :: a
x1, x2 :: b
x2) <- x -> (a, b)
f x
x
, (y1 :: a
y1, y2 :: b
y2) <- x -> (a, b)
f x
y
, (z1 :: a
z1, z2 :: b
z2) <- x -> (a, b)
f x
z
, (w1 :: a
w1, w2 :: b
w2) <- x -> (a, b)
f x
w
= ( a -> a -> a -> a -> Digit a
forall a. a -> a -> a -> a -> Digit a
Four a
x1 a
y1 a
z1 a
w1
, b -> b -> b -> b -> Digit b
forall a. a -> a -> a -> a -> Digit a
Four b
x2 b
y2 b
z2 b
w2)
instance UnzipWith FingerTree where
unzipWith' :: (x -> (a, b)) -> FingerTree x -> (FingerTree a, FingerTree b)
unzipWith' _ EmptyT = (FingerTree a
forall a. FingerTree a
EmptyT, FingerTree b
forall a. FingerTree a
EmptyT)
unzipWith' f :: x -> (a, b)
f (Single x :: x
x)
| (x1 :: a
x1, x2 :: b
x2) <- x -> (a, b)
f x
x
= (a -> FingerTree a
forall a. a -> FingerTree a
Single a
x1, b -> FingerTree b
forall a. a -> FingerTree a
Single b
x2)
unzipWith' f :: x -> (a, b)
f (Deep s :: Int
s pr :: Digit x
pr m :: FingerTree (Node x)
m sf :: Digit x
sf)
| (!Digit a
pr1, !Digit b
pr2) <- (x -> (a, b)) -> Digit x -> (Digit a, Digit b)
forall (f :: * -> *) x a b.
UnzipWith f =>
(x -> (a, b)) -> f x -> (f a, f b)
unzipWith' x -> (a, b)
f Digit x
pr
, (!Digit a
sf1, !Digit b
sf2) <- (x -> (a, b)) -> Digit x -> (Digit a, Digit b)
forall (f :: * -> *) x a b.
UnzipWith f =>
(x -> (a, b)) -> f x -> (f a, f b)
unzipWith' x -> (a, b)
f Digit x
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 Digit a
pr1 FingerTree (Node a)
m1 Digit a
sf1, Int -> Digit b -> FingerTree (Node b) -> Digit b -> FingerTree b
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
s Digit b
pr2 FingerTree (Node b)
m2 Digit b
sf2)
where
{-# NOINLINE m1m2 #-}
m1m2 :: (FingerTree (Node a), FingerTree (Node b))
m1m2 = (FingerTree (Node a), FingerTree (Node b))
-> (FingerTree (Node a), FingerTree (Node b))
forall a b. (a, b) -> (a, b)
strictifyPair ((FingerTree (Node a), FingerTree (Node b))
-> (FingerTree (Node a), FingerTree (Node b)))
-> (FingerTree (Node a), FingerTree (Node b))
-> (FingerTree (Node a), FingerTree (Node b))
forall a b. (a -> b) -> a -> b
$ (Node x -> (Node a, Node b))
-> FingerTree (Node x)
-> (FingerTree (Node a), FingerTree (Node b))
forall (f :: * -> *) x a b.
UnzipWith f =>
(x -> (a, b)) -> f x -> (f a, f b)
unzipWith' ((x -> (a, b)) -> Node x -> (Node a, Node b)
forall (f :: * -> *) x a b.
UnzipWith f =>
(x -> (a, b)) -> f x -> (f a, f b)
unzipWith' x -> (a, b)
f) FingerTree (Node x)
m
(m1 :: FingerTree (Node a)
m1, m2 :: FingerTree (Node b)
m2) = (FingerTree (Node a), FingerTree (Node b))
m1m2
instance UnzipWith Seq where
unzipWith' :: (x -> (a, b)) -> Seq x -> (Seq a, Seq b)
unzipWith' _ (Seq EmptyT) = (Seq a
forall a. Seq a
empty, Seq b
forall a. Seq a
empty)
unzipWith' f :: x -> (a, b)
f (Seq (Single (Elem x :: x
x)))
| (x1 :: a
x1, x2 :: b
x2) <- x -> (a, b)
f x
x
= (a -> Seq a
forall a. a -> Seq a
singleton a
x1, b -> Seq b
forall a. a -> Seq a
singleton b
x2)
unzipWith' f :: x -> (a, b)
f (Seq (Deep s :: Int
s pr :: Digit (Elem x)
pr m :: FingerTree (Node (Elem x))
m sf :: Digit (Elem x)
sf))
| (!Digit (Elem a)
pr1, !Digit (Elem b)
pr2) <- (Elem x -> (Elem a, Elem b))
-> Digit (Elem x) -> (Digit (Elem a), Digit (Elem b))
forall (f :: * -> *) x a b.
UnzipWith f =>
(x -> (a, b)) -> f x -> (f a, f b)
unzipWith' ((x -> (a, b)) -> Elem x -> (Elem a, Elem b)
forall (f :: * -> *) x a b.
UnzipWith f =>
(x -> (a, b)) -> f x -> (f a, f b)
unzipWith' x -> (a, b)
f) Digit (Elem x)
pr
, (!Digit (Elem a)
sf1, !Digit (Elem b)
sf2) <- (Elem x -> (Elem a, Elem b))
-> Digit (Elem x) -> (Digit (Elem a), Digit (Elem b))
forall (f :: * -> *) x a b.
UnzipWith f =>
(x -> (a, b)) -> f x -> (f a, f b)
unzipWith' ((x -> (a, b)) -> Elem x -> (Elem a, Elem b)
forall (f :: * -> *) x a b.
UnzipWith f =>
(x -> (a, b)) -> f x -> (f a, f b)
unzipWith' x -> (a, b)
f) Digit (Elem x)
sf
= (FingerTree (Elem a) -> Seq a
forall a. FingerTree (Elem a) -> Seq a
Seq (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
s Digit (Elem a)
pr1 FingerTree (Node (Elem a))
m1 Digit (Elem a)
sf1), FingerTree (Elem b) -> Seq b
forall a. FingerTree (Elem a) -> Seq a
Seq (Int
-> Digit (Elem b)
-> FingerTree (Node (Elem b))
-> Digit (Elem b)
-> FingerTree (Elem b)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
s Digit (Elem b)
pr2 FingerTree (Node (Elem b))
m2 Digit (Elem b)
sf2))
where
{-# NOINLINE m1m2 #-}
m1m2 :: (FingerTree (Node (Elem a)), FingerTree (Node (Elem b)))
m1m2 = (FingerTree (Node (Elem a)), FingerTree (Node (Elem b)))
-> (FingerTree (Node (Elem a)), FingerTree (Node (Elem b)))
forall a b. (a, b) -> (a, b)
strictifyPair ((FingerTree (Node (Elem a)), FingerTree (Node (Elem b)))
-> (FingerTree (Node (Elem a)), FingerTree (Node (Elem b))))
-> (FingerTree (Node (Elem a)), FingerTree (Node (Elem b)))
-> (FingerTree (Node (Elem a)), FingerTree (Node (Elem b)))
forall a b. (a -> b) -> a -> b
$ (Node (Elem x) -> (Node (Elem a), Node (Elem b)))
-> FingerTree (Node (Elem x))
-> (FingerTree (Node (Elem a)), FingerTree (Node (Elem b)))
forall (f :: * -> *) x a b.
UnzipWith f =>
(x -> (a, b)) -> f x -> (f a, f b)
unzipWith' ((x -> (a, b)) -> Node (Elem x) -> (Node (Elem a), Node (Elem b))
forall x a b.
(x -> (a, b)) -> Node (Elem x) -> (Node (Elem a), Node (Elem b))
unzipWithNodeElem x -> (a, b)
f) FingerTree (Node (Elem x))
m
(m1 :: FingerTree (Node (Elem a))
m1, m2 :: FingerTree (Node (Elem b))
m2) = (FingerTree (Node (Elem a)), FingerTree (Node (Elem b)))
m1m2
unzipWithNodeElem :: (x -> (a, b))
-> Node (Elem x) -> (Node (Elem a), Node (Elem b))
unzipWithNodeElem :: (x -> (a, b)) -> Node (Elem x) -> (Node (Elem a), Node (Elem b))
unzipWithNodeElem f :: x -> (a, b)
f (Node2 s :: Int
s (Elem x :: x
x) (Elem y :: x
y))
| (x1 :: a
x1, x2 :: b
x2) <- x -> (a, b)
f x
x
, (y1 :: a
y1, y2 :: b
y2) <- x -> (a, b)
f x
y
= ( Int -> Elem a -> Elem a -> Node (Elem a)
forall a. Int -> a -> a -> Node a
Node2 Int
s (a -> Elem a
forall a. a -> Elem a
Elem a
x1) (a -> Elem a
forall a. a -> Elem a
Elem a
y1)
, Int -> Elem b -> Elem b -> Node (Elem b)
forall a. Int -> a -> a -> Node a
Node2 Int
s (b -> Elem b
forall a. a -> Elem a
Elem b
x2) (b -> Elem b
forall a. a -> Elem a
Elem b
y2))
unzipWithNodeElem f :: x -> (a, b)
f (Node3 s :: Int
s (Elem x :: x
x) (Elem y :: x
y) (Elem z :: x
z))
| (x1 :: a
x1, x2 :: b
x2) <- x -> (a, b)
f x
x
, (y1 :: a
y1, y2 :: b
y2) <- x -> (a, b)
f x
y
, (z1 :: a
z1, z2 :: b
z2) <- x -> (a, b)
f x
z
= ( Int -> Elem a -> Elem a -> Elem a -> Node (Elem a)
forall a. Int -> a -> a -> a -> Node a
Node3 Int
s (a -> Elem a
forall a. a -> Elem a
Elem a
x1) (a -> Elem a
forall a. a -> Elem a
Elem a
y1) (a -> Elem a
forall a. a -> Elem a
Elem a
z1)
, Int -> Elem b -> Elem b -> Elem b -> Node (Elem b)
forall a. Int -> a -> a -> a -> Node a
Node3 Int
s (b -> Elem b
forall a. a -> Elem a
Elem b
x2) (b -> Elem b
forall a. a -> Elem a
Elem b
y2) (b -> Elem b
forall a. a -> Elem a
Elem b
z2))
zip :: Seq a -> Seq b -> Seq (a, b)
zip :: Seq a -> Seq b -> Seq (a, b)
zip = (a -> b -> (a, b)) -> Seq a -> Seq b -> Seq (a, b)
forall a b c. (a -> b -> c) -> Seq a -> Seq b -> Seq c
zipWith (,)
zipWith :: (a -> b -> c) -> Seq a -> Seq b -> Seq c
zipWith :: (a -> b -> c) -> Seq a -> Seq b -> Seq c
zipWith f :: a -> b -> c
f s1 :: Seq a
s1 s2 :: Seq b
s2 = (a -> b -> c) -> Seq a -> Seq b -> Seq c
forall a b c. (a -> b -> c) -> Seq a -> Seq b -> Seq c
zipWith' a -> b -> c
f Seq a
s1' Seq b
s2'
where
minLen :: Int
minLen = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (Seq a -> Int
forall a. Seq a -> Int
length Seq a
s1) (Seq b -> Int
forall a. Seq a -> Int
length Seq b
s2)
s1' :: Seq a
s1' = Int -> Seq a -> Seq a
forall a. Int -> Seq a -> Seq a
take Int
minLen Seq a
s1
s2' :: Seq b
s2' = Int -> Seq b -> Seq b
forall a. Int -> Seq a -> Seq a
take Int
minLen Seq b
s2
zipWith' :: (a -> b -> c) -> Seq a -> Seq b -> Seq c
zipWith' :: (a -> b -> c) -> Seq a -> Seq b -> Seq c
zipWith' f :: a -> b -> c
f s1 :: Seq a
s1 s2 :: Seq b
s2 = (Int -> Seq b -> (Seq b, Seq b))
-> (Seq b -> a -> c) -> Seq b -> Seq a -> Seq c
forall s a' b'.
(Int -> s -> (s, s)) -> (s -> a' -> b') -> s -> Seq a' -> Seq b'
splitMap Int -> Seq b -> (Seq b, Seq b)
forall a. Int -> Seq a -> (Seq a, Seq a)
uncheckedSplitAt Seq b -> a -> c
goLeaf Seq b
s2 Seq a
s1
where
goLeaf :: Seq b -> a -> c
goLeaf (Seq (Single (Elem b :: b
b))) a :: a
a = a -> b -> c
f a
a b
b
goLeaf _ _ = [Char] -> c
forall a. HasCallStack => [Char] -> a
error "Data.Sequence.zipWith'.goLeaf internal error: not a singleton"
zip3 :: Seq a -> Seq b -> Seq c -> Seq (a,b,c)
zip3 :: Seq a -> Seq b -> Seq c -> Seq (a, b, c)
zip3 = (a -> b -> c -> (a, b, c))
-> Seq a -> Seq b -> Seq c -> Seq (a, b, c)
forall a b c d.
(a -> b -> c -> d) -> Seq a -> Seq b -> Seq c -> Seq d
zipWith3 (,,)
zipWith3 :: (a -> b -> c -> d) -> Seq a -> Seq b -> Seq c -> Seq d
zipWith3 :: (a -> b -> c -> d) -> Seq a -> Seq b -> Seq c -> Seq d
zipWith3 f :: a -> b -> c -> d
f s1 :: Seq a
s1 s2 :: Seq b
s2 s3 :: Seq c
s3 = ((c -> d) -> c -> d) -> Seq (c -> d) -> Seq c -> Seq d
forall a b c. (a -> b -> c) -> Seq a -> Seq b -> Seq c
zipWith' (c -> d) -> c -> d
forall a b. (a -> b) -> a -> b
($) ((a -> b -> c -> d) -> Seq a -> Seq b -> Seq (c -> d)
forall a b c. (a -> b -> c) -> Seq a -> Seq b -> Seq c
zipWith' a -> b -> c -> d
f Seq a
s1' Seq b
s2') Seq c
s3'
where
minLen :: Int
minLen = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [Seq a -> Int
forall a. Seq a -> Int
length Seq a
s1, Seq b -> Int
forall a. Seq a -> Int
length Seq b
s2, Seq c -> Int
forall a. Seq a -> Int
length Seq c
s3]
s1' :: Seq a
s1' = Int -> Seq a -> Seq a
forall a. Int -> Seq a -> Seq a
take Int
minLen Seq a
s1
s2' :: Seq b
s2' = Int -> Seq b -> Seq b
forall a. Int -> Seq a -> Seq a
take Int
minLen Seq b
s2
s3' :: Seq c
s3' = Int -> Seq c -> Seq c
forall a. Int -> Seq a -> Seq a
take Int
minLen Seq c
s3
zipWith3' :: (a -> b -> c -> d) -> Seq a -> Seq b -> Seq c -> Seq d
zipWith3' :: (a -> b -> c -> d) -> Seq a -> Seq b -> Seq c -> Seq d
zipWith3' f :: a -> b -> c -> d
f s1 :: Seq a
s1 s2 :: Seq b
s2 s3 :: Seq c
s3 = ((c -> d) -> c -> d) -> Seq (c -> d) -> Seq c -> Seq d
forall a b c. (a -> b -> c) -> Seq a -> Seq b -> Seq c
zipWith' (c -> d) -> c -> d
forall a b. (a -> b) -> a -> b
($) ((a -> b -> c -> d) -> Seq a -> Seq b -> Seq (c -> d)
forall a b c. (a -> b -> c) -> Seq a -> Seq b -> Seq c
zipWith' a -> b -> c -> d
f Seq a
s1 Seq b
s2) Seq c
s3
zip4 :: Seq a -> Seq b -> Seq c -> Seq d -> Seq (a,b,c,d)
zip4 :: Seq a -> Seq b -> Seq c -> Seq d -> Seq (a, b, c, d)
zip4 = (a -> b -> c -> d -> (a, b, c, d))
-> Seq a -> Seq b -> Seq c -> Seq d -> Seq (a, b, c, d)
forall a b c d e.
(a -> b -> c -> d -> e)
-> Seq a -> Seq b -> Seq c -> Seq d -> Seq e
zipWith4 (,,,)
zipWith4 :: (a -> b -> c -> d -> e) -> Seq a -> Seq b -> Seq c -> Seq d -> Seq e
zipWith4 :: (a -> b -> c -> d -> e)
-> Seq a -> Seq b -> Seq c -> Seq d -> Seq e
zipWith4 f :: a -> b -> c -> d -> e
f s1 :: Seq a
s1 s2 :: Seq b
s2 s3 :: Seq c
s3 s4 :: Seq d
s4 = ((d -> e) -> d -> e) -> Seq (d -> e) -> Seq d -> Seq e
forall a b c. (a -> b -> c) -> Seq a -> Seq b -> Seq c
zipWith' (d -> e) -> d -> e
forall a b. (a -> b) -> a -> b
($) ((a -> b -> c -> d -> e) -> Seq a -> Seq b -> Seq c -> Seq (d -> e)
forall a b c d.
(a -> b -> c -> d) -> Seq a -> Seq b -> Seq c -> Seq d
zipWith3' a -> b -> c -> d -> e
f Seq a
s1' Seq b
s2' Seq c
s3') Seq d
s4'
where
minLen :: Int
minLen = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [Seq a -> Int
forall a. Seq a -> Int
length Seq a
s1, Seq b -> Int
forall a. Seq a -> Int
length Seq b
s2, Seq c -> Int
forall a. Seq a -> Int
length Seq c
s3, Seq d -> Int
forall a. Seq a -> Int
length Seq d
s4]
s1' :: Seq a
s1' = Int -> Seq a -> Seq a
forall a. Int -> Seq a -> Seq a
take Int
minLen Seq a
s1
s2' :: Seq b
s2' = Int -> Seq b -> Seq b
forall a. Int -> Seq a -> Seq a
take Int
minLen Seq b
s2
s3' :: Seq c
s3' = Int -> Seq c -> Seq c
forall a. Int -> Seq a -> Seq a
take Int
minLen Seq c
s3
s4' :: Seq d
s4' = Int -> Seq d -> Seq d
forall a. Int -> Seq a -> Seq a
take Int
minLen Seq d
s4
fromList2 :: Int -> [a] -> Seq a
fromList2 :: Int -> [a] -> Seq a
fromList2 n :: Int
n = State [a] (Seq a) -> [a] -> Seq a
forall s a. State s a -> s -> a
execState (Int -> State [a] a -> State [a] (Seq a)
forall (f :: * -> *) a. Applicative f => Int -> f a -> f (Seq a)
replicateA Int
n (([a] -> ([a], a)) -> State [a] a
forall s a. (s -> (s, a)) -> State s a
State [a] -> ([a], a)
forall b. [b] -> ([b], b)
ht))
where
ht :: [b] -> ([b], b)
ht (x :: b
x:xs :: [b]
xs) = ([b]
xs, b
x)
ht [] = [Char] -> ([b], b)
forall a. HasCallStack => [Char] -> a
error "fromList2: short list"