{-# 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 #-}
{-# OPTIONS_GHC -fno-warn-incomplete-uni-patterns #-}
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 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)
import qualified Data.Foldable as F
#if !(__GLASGOW_HASKELL__ >= 708)
import qualified Data.List
#endif
#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
<> :: forall m. Monoid m => m -> m -> m
(<>) = forall m. Monoid m => m -> m -> m
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 $mEmpty :: forall {r} {a}. Seq a -> ((# #) -> r) -> ((# #) -> r) -> r
$bEmpty :: forall a. Seq a
Empty = Seq EmptyT
pattern (:<|) :: a -> Seq a -> Seq a
pattern x $m:<| :: forall {r} {a}. Seq a -> (a -> Seq a -> r) -> ((# #) -> r) -> r
$b:<| :: forall a. a -> Seq a -> Seq a
:<| xs <- (viewl -> x :< xs)
where
a
x :<| Seq a
xs = a
x forall a. a -> Seq a -> Seq a
<| Seq a
xs
pattern (:|>) :: Seq a -> a -> Seq a
pattern xs $m:|> :: forall {r} {a}. Seq a -> (Seq a -> a -> r) -> ((# #) -> r) -> r
$b:|> :: forall a. Seq a -> a -> Seq a
:|> x <- (viewr -> xs :> x)
where
Seq a
xs :|> a
x = Seq a
xs 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 :: forall a b. MaybeForce a => a -> b -> b
mseq a
a b
b = case forall a. MaybeForce a => a -> ()
maybeRwhnf a
a of () -> b
b
{-# INLINE mseq #-}
infixr 0 $!?
($!?) :: MaybeForce a => (a -> b) -> a -> b
a -> b
f $!? :: forall a b. MaybeForce a => (a -> b) -> a -> b
$!? a
a = case forall a. MaybeForce a => a -> ()
maybeRwhnf a
a of () -> a -> b
f a
a
{-# INLINE ($!?) #-}
instance MaybeForce (Elem a) where
maybeRwhnf :: Elem a -> ()
maybeRwhnf Elem a
_ = ()
{-# 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 ForceBox a
_ = Int
1
newtype Seq a = Seq (FingerTree (Elem a))
instance Functor Seq where
fmap :: forall a b. (a -> b) -> Seq a -> Seq b
fmap = forall a b. (a -> b) -> Seq a -> Seq b
fmapSeq
#ifdef __GLASGOW_HASKELL__
a
x <$ :: forall a b. a -> Seq b -> Seq a
<$ Seq b
s = forall a. Int -> a -> Seq a
replicate (forall a. Seq a -> Int
length Seq b
s) a
x
#endif
fmapSeq :: (a -> b) -> Seq a -> Seq b
fmapSeq :: forall a b. (a -> b) -> Seq a -> Seq b
fmapSeq a -> b
f (Seq FingerTree (Elem a)
xs) = forall a. FingerTree (Elem a) -> Seq a
Seq (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (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 :: forall a. Seq a -> FingerTree (Elem a)
getSeq (Seq FingerTree (Elem a)
xs) = FingerTree (Elem a)
xs
instance Foldable Seq where
foldMap :: forall m a. Monoid m => (a -> m) -> Seq a -> m
foldMap a -> m
f = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (a -> m
f forall b a c. Coercible b a => (b -> c) -> (a -> b) -> a -> c
.# forall a. Elem a -> a
getElem) forall b a c. Coercible b a => (b -> c) -> (a -> b) -> a -> c
.# forall a. Seq a -> FingerTree (Elem a)
getSeq
foldr :: forall a b. (a -> b -> b) -> b -> Seq a -> b
foldr a -> b -> b
f b
z = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (a -> b -> b
f forall b a c. Coercible b a => (b -> c) -> (a -> b) -> a -> c
.# forall a. Elem a -> a
getElem) b
z forall b a c. Coercible b a => (b -> c) -> (a -> b) -> a -> c
.# forall a. Seq a -> FingerTree (Elem a)
getSeq
foldl :: forall b a. (b -> a -> b) -> b -> Seq a -> b
foldl b -> a -> b
f b
z = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (b -> a -> b
f forall c b a d.
Coercible c b =>
(a -> c -> d) -> (b -> c) -> a -> b -> d
.^# forall a. Elem a -> a
getElem) b
z forall b a c. Coercible b a => (b -> c) -> (a -> b) -> a -> c
.# forall a. Seq a -> FingerTree (Elem a)
getSeq
#if __GLASGOW_HASKELL__
{-# INLINABLE foldMap #-}
{-# INLINABLE foldr #-}
{-# INLINABLE foldl #-}
#endif
foldr' :: forall a b. (a -> b -> b) -> b -> Seq a -> b
foldr' a -> b -> b
f b
z = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr' (a -> b -> b
f forall b a c. Coercible b a => (b -> c) -> (a -> b) -> a -> c
.# forall a. Elem a -> a
getElem) b
z forall b a c. Coercible b a => (b -> c) -> (a -> b) -> a -> c
.# forall a. Seq a -> FingerTree (Elem a)
getSeq
foldl' :: forall b a. (b -> a -> b) -> b -> Seq a -> b
foldl' b -> a -> b
f b
z = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (b -> a -> b
f forall c b a d.
Coercible c b =>
(a -> c -> d) -> (b -> c) -> a -> b -> d
.^# forall a. Elem a -> a
getElem) b
z forall b a c. Coercible b a => (b -> c) -> (a -> b) -> a -> c
.# forall a. Seq a -> FingerTree (Elem a)
getSeq
#if __GLASGOW_HASKELL__
{-# INLINABLE foldr' #-}
{-# INLINABLE foldl' #-}
#endif
foldr1 :: forall a. (a -> a -> a) -> Seq a -> a
foldr1 a -> a -> a
f (Seq FingerTree (Elem a)
xs) = forall a. Elem a -> a
getElem (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 a
x) (Elem a
y) = forall a. a -> Elem a
Elem (a -> a -> a
f a
x a
y)
foldl1 :: forall a. (a -> a -> a) -> Seq a -> a
foldl1 a -> a -> a
f (Seq FingerTree (Elem a)
xs) = forall a. Elem a -> a
getElem (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 a
x) (Elem a
y) = forall a. a -> Elem a
Elem (a -> a -> a
f a
x a
y)
#if MIN_VERSION_base(4,8,0)
length :: forall a. Seq a -> Int
length = forall a. Seq a -> Int
length
{-# INLINE length #-}
null :: forall a. Seq a -> Bool
null = forall a. Seq a -> Bool
null
{-# INLINE null #-}
#endif
instance Traversable Seq where
#if __GLASGOW_HASKELL__
{-# INLINABLE traverse #-}
#endif
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Seq a -> f (Seq b)
traverse a -> f b
_ (Seq FingerTree (Elem a)
EmptyT) = forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. FingerTree (Elem a) -> Seq a
Seq forall a. FingerTree a
EmptyT)
traverse a -> f b
f' (Seq (Single (Elem a
x'))) =
(\b
x'' -> forall a. FingerTree (Elem a) -> Seq a
Seq (forall a. a -> FingerTree a
Single (forall a. a -> Elem a
Elem b
x''))) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f' a
x'
traverse a -> f b
f' (Seq (Deep Int
s' Digit (Elem a)
pr' FingerTree (Node (Elem a))
m' Digit (Elem a)
sf')) =
forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3
(\Digit (Elem b)
pr'' FingerTree (Node (Elem b))
m'' Digit (Elem b)
sf'' -> forall a. FingerTree (Elem a) -> Seq a
Seq (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''))
(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')
(forall (f :: * -> *) a b.
Applicative f =>
(Node a -> f (Node b))
-> FingerTree (Node a) -> f (FingerTree (Node b))
traverseTree (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')
(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 :: forall (f :: * -> *) a b.
Applicative f =>
(Node a -> f (Node b))
-> FingerTree (Node a) -> f (FingerTree (Node b))
traverseTree Node a -> f (Node b)
_ FingerTree (Node a)
EmptyT = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. FingerTree a
EmptyT
traverseTree Node a -> f (Node b)
f (Single Node a
x) = forall a. a -> FingerTree a
Single forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Node a -> f (Node b)
f Node a
x
traverseTree Node a -> f (Node b)
f (Deep Int
s Digit (Node a)
pr FingerTree (Node (Node a))
m Digit (Node a)
sf) =
forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3
(forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
s)
(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)
(forall (f :: * -> *) a b.
Applicative f =>
(Node a -> f (Node b))
-> FingerTree (Node a) -> f (FingerTree (Node b))
traverseTree (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)
(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 :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Digit (Elem a) -> f (Digit (Elem b))
traverseDigitE a -> f b
f (One (Elem a
a)) =
(\b
a' -> forall a. a -> Digit a
One (forall a. a -> Elem a
Elem b
a')) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
a -> f b
f a
a
traverseDigitE a -> f b
f (Two (Elem a
a) (Elem a
b)) =
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2
(\b
a' b
b' -> forall a. a -> a -> Digit a
Two (forall a. a -> Elem a
Elem b
a') (forall a. a -> Elem a
Elem b
b'))
(a -> f b
f a
a)
(a -> f b
f a
b)
traverseDigitE a -> f b
f (Three (Elem a
a) (Elem a
b) (Elem a
c)) =
forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3
(\b
a' b
b' b
c' ->
forall a. a -> a -> a -> Digit a
Three (forall a. a -> Elem a
Elem b
a') (forall a. a -> Elem a
Elem b
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 a -> f b
f (Four (Elem a
a) (Elem a
b) (Elem a
c) (Elem a
d)) =
forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3
(\b
a' b
b' b
c' b
d' -> forall a. a -> a -> a -> a -> Digit a
Four (forall a. a -> Elem a
Elem b
a') (forall a. a -> Elem a
Elem b
b') (forall a. a -> Elem a
Elem b
c') (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) 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 :: 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)
t = 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 :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Node (Elem a) -> f (Node (Elem b))
traverseNodeE a -> f b
f (Node2 Int
s (Elem a
a) (Elem a
b)) =
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2
(\b
a' b
b' -> forall a. Int -> a -> a -> Node a
Node2 Int
s (forall a. a -> Elem a
Elem b
a') (forall a. a -> Elem a
Elem b
b'))
(a -> f b
f a
a)
(a -> f b
f a
b)
traverseNodeE a -> f b
f (Node3 Int
s (Elem a
a) (Elem a
b) (Elem a
c)) =
forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3
(\b
a' b
b' b
c' ->
forall a. Int -> a -> a -> a -> Node a
Node3 Int
s (forall a. a -> Elem a
Elem b
a') (forall a. a -> Elem a
Elem b
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 :: 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 Node (Node a)
t = 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 FingerTree (Elem a)
xs) = forall a. NFData a => a -> ()
rnf FingerTree (Elem a)
xs
instance Monad Seq where
return :: forall a. a -> Seq a
return = forall (f :: * -> *) a. Applicative f => a -> f a
pure
Seq a
xs >>= :: forall a b. Seq a -> (a -> Seq b) -> Seq b
>>= a -> Seq b
f = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Seq b -> a -> Seq b
add forall a. Seq a
empty Seq a
xs
where add :: Seq b -> a -> Seq b
add Seq b
ys a
x = Seq b
ys forall a. Seq a -> Seq a -> Seq a
>< a -> Seq b
f a
x
>> :: forall a b. Seq a -> Seq b -> Seq b
(>>) = forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
(*>)
instance MonadFix Seq where
mfix :: forall a. (a -> Seq a) -> Seq a
mfix = forall a. (a -> Seq a) -> Seq a
mfixSeq
mfixSeq :: (a -> Seq a) -> Seq a
mfixSeq :: forall a. (a -> Seq a) -> Seq a
mfixSeq a -> Seq a
f = forall a. Int -> (Int -> a) -> Seq a
fromFunction (forall a. Seq a -> Int
length (a -> Seq a
f forall {a}. a
err)) (\Int
k -> forall a. (a -> a) -> a
fix (\a
xk -> a -> Seq a
f a
xk forall a. Seq a -> Int -> a
`index` Int
k))
where
err :: a
err = forall a. HasCallStack => [Char] -> a
error [Char]
"mfix for Data.Sequence.Seq applied to strict function"
instance Applicative Seq where
pure :: forall a. a -> Seq a
pure = forall a. a -> Seq a
singleton
Seq a
xs *> :: forall a b. Seq a -> Seq b -> Seq b
*> Seq b
ys = forall a. Int -> Seq a -> Seq a
cycleNTimes (forall a. Seq a -> Int
length Seq a
xs) Seq b
ys
<*> :: forall a 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 :: forall a b c. (a -> b -> c) -> Seq a -> Seq b -> Seq c
liftA2 = forall a b c. (a -> b -> c) -> Seq a -> Seq b -> Seq c
liftA2Seq
#endif
Seq a
xs <* :: forall a b. Seq a -> Seq b -> Seq a
<* Seq b
ys = forall a b. Seq a -> Seq b -> Seq a
beforeSeq Seq a
xs Seq b
ys
apSeq :: Seq (a -> b) -> Seq a -> Seq b
apSeq :: forall a b. Seq (a -> b) -> Seq a -> Seq b
apSeq Seq (a -> b)
fs xs :: Seq a
xs@(Seq FingerTree (Elem a)
xsFT) = case forall a. Seq a -> ViewL a
viewl Seq (a -> b)
fs of
ViewL (a -> b)
EmptyL -> forall a. Seq a
empty
a -> b
firstf :< Seq (a -> b)
fs' -> case forall a. Seq a -> ViewR a
viewr Seq (a -> b)
fs' of
ViewR (a -> b)
EmptyR -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
firstf Seq a
xs
Seq FingerTree (Elem (a -> b))
fs''FT :> a -> b
lastf -> case forall a. FingerTree (Elem a) -> Rigidified (Elem a)
rigidify FingerTree (Elem a)
xsFT of
Rigidified (Elem a)
RigidEmpty -> forall a. Seq a
empty
RigidOne (Elem a
x) -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. (a -> b) -> a -> b
$ a
x) Seq (a -> b)
fs
RigidTwo (Elem a
x1) (Elem a
x2) ->
forall a. FingerTree (Elem a) -> Seq a
Seq forall a b. (a -> b) -> a -> 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 a
x1) (Elem a
x2) (Elem a
x3) ->
forall a. FingerTree (Elem a) -> Seq a
Seq forall a b. (a -> b) -> a -> 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 Int
s Digit23 (Elem a)
pr Thin (Digit23 (Elem a))
_m Digit23 (Elem a)
sf) -> forall a. FingerTree (Elem a) -> Seq a
Seq forall a b. (a -> b) -> a -> b
$
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s forall a. Num a => a -> a -> a
* forall a. Seq a -> Int
length Seq (a -> b)
fs)
(forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
firstf) (forall a. Node a -> Digit a
nodeToDigit Digit23 (Elem a)
pr))
(forall b c a.
(b -> c)
-> (b -> c)
-> (a -> b -> c)
-> FingerTree (Elem a)
-> Rigid b
-> FingerTree (Node c)
liftA2Middle (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
firstf) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
lastf) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FingerTree (Elem (a -> b))
fs''FT Rigid (Elem a)
r)
(forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
lastf) (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 :: 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 a -> b
lastf (a
x,a
y) =
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (forall a. Sized a => a -> Int
size FingerTree (Elem (a -> b))
fs forall a. Num a => a -> a -> a
* Int
2 forall a. Num a => a -> a -> a
+ Int
4)
(forall a. a -> a -> Digit a
Two (forall a. a -> Elem a
Elem forall a b. (a -> b) -> a -> b
$ a -> b
firstf a
x) (forall a. a -> Elem a
Elem forall a b. (a -> b) -> a -> b
$ a -> b
firstf a
y))
(forall a b. Int -> (a -> b) -> FingerTree a -> FingerTree b
mapMulFT Int
2 (\(Elem a -> b
f) -> forall a. Int -> a -> a -> Node a
Node2 Int
2 (forall a. a -> Elem a
Elem (a -> b
f a
x)) (forall a. a -> Elem a
Elem (a -> b
f a
y))) FingerTree (Elem (a -> b))
fs)
(forall a. a -> a -> Digit a
Two (forall a. a -> Elem a
Elem forall a b. (a -> b) -> a -> b
$ a -> b
lastf a
x) (forall a. a -> Elem a
Elem 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 :: 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 a -> b
lastf (a
x,a
y,a
z) = forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (forall a. Sized a => a -> Int
size FingerTree (Elem (a -> b))
fs forall a. Num a => a -> a -> a
* Int
3 forall a. Num a => a -> a -> a
+ Int
6)
(forall a. a -> a -> a -> Digit a
Three (forall a. a -> Elem a
Elem forall a b. (a -> b) -> a -> b
$ a -> b
firstf a
x) (forall a. a -> Elem a
Elem forall a b. (a -> b) -> a -> b
$ a -> b
firstf a
y) (forall a. a -> Elem a
Elem forall a b. (a -> b) -> a -> b
$ a -> b
firstf a
z))
(forall a b. Int -> (a -> b) -> FingerTree a -> FingerTree b
mapMulFT Int
3 (\(Elem a -> b
f) -> forall a. Int -> a -> a -> a -> Node a
Node3 Int
3 (forall a. a -> Elem a
Elem (a -> b
f a
x)) (forall a. a -> Elem a
Elem (a -> b
f a
y)) (forall a. a -> Elem a
Elem (a -> b
f a
z))) FingerTree (Elem (a -> b))
fs)
(forall a. a -> a -> a -> Digit a
Three (forall a. a -> Elem a
Elem forall a b. (a -> b) -> a -> b
$ a -> b
lastf a
x) (forall a. a -> Elem a
Elem forall a b. (a -> b) -> a -> b
$ a -> b
lastf a
y) (forall a. a -> Elem a
Elem 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 :: 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 a
lastx (b
y1,b
y2) =
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (forall a. Sized a => a -> Int
size FingerTree (Elem a)
xs forall a. Num a => a -> a -> a
* Int
2 forall a. Num a => a -> a -> a
+ Int
4)
(forall a. a -> a -> Digit a
Two (forall a. a -> Elem a
Elem forall a b. (a -> b) -> a -> b
$ a -> b -> c
f a
firstx b
y1) (forall a. a -> Elem a
Elem forall a b. (a -> b) -> a -> b
$ a -> b -> c
f a
firstx b
y2))
(forall a b. Int -> (a -> b) -> FingerTree a -> FingerTree b
mapMulFT Int
2 (\(Elem a
x) -> forall a. Int -> a -> a -> Node a
Node2 Int
2 (forall a. a -> Elem a
Elem (a -> b -> c
f a
x b
y1)) (forall a. a -> Elem a
Elem (a -> b -> c
f a
x b
y2))) FingerTree (Elem a)
xs)
(forall a. a -> a -> Digit a
Two (forall a. a -> Elem a
Elem forall a b. (a -> b) -> a -> b
$ a -> b -> c
f a
lastx b
y1) (forall a. a -> Elem a
Elem 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 :: 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 a
lastx (b
y1,b
y2,b
y3) =
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (forall a. Sized a => a -> Int
size FingerTree (Elem a)
xs forall a. Num a => a -> a -> a
* Int
3 forall a. Num a => a -> a -> a
+ Int
6)
(forall a. a -> a -> a -> Digit a
Three (forall a. a -> Elem a
Elem forall a b. (a -> b) -> a -> b
$ a -> b -> c
f a
firstx b
y1) (forall a. a -> Elem a
Elem forall a b. (a -> b) -> a -> b
$ a -> b -> c
f a
firstx b
y2) (forall a. a -> Elem a
Elem forall a b. (a -> b) -> a -> b
$ a -> b -> c
f a
firstx b
y3))
(forall a b. Int -> (a -> b) -> FingerTree a -> FingerTree b
mapMulFT Int
3 (\(Elem a
x) -> forall a. Int -> a -> a -> a -> Node a
Node3 Int
3 (forall a. a -> Elem a
Elem (a -> b -> c
f a
x b
y1)) (forall a. a -> Elem a
Elem (a -> b -> c
f a
x b
y2)) (forall a. a -> Elem a
Elem (a -> b -> c
f a
x b
y3))) FingerTree (Elem a)
xs)
(forall a. a -> a -> a -> Digit a
Three (forall a. a -> Elem a
Elem forall a b. (a -> b) -> a -> b
$ a -> b -> c
f a
lastx b
y1) (forall a. a -> Elem a
Elem forall a b. (a -> b) -> a -> b
$ a -> b -> c
f a
lastx b
y2) (forall a. a -> Elem a
Elem 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 :: forall a b c. (a -> b -> c) -> Seq a -> Seq b -> Seq c
liftA2Seq a -> b -> c
f Seq a
xs ys :: Seq b
ys@(Seq FingerTree (Elem b)
ysFT) = case forall a. Seq a -> ViewL a
viewl Seq a
xs of
ViewL a
EmptyL -> forall a. Seq a
empty
a
firstx :< Seq a
xs' -> case forall a. Seq a -> ViewR a
viewr Seq a
xs' of
ViewR a
EmptyR -> a -> b -> c
f a
firstx forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Seq b
ys
Seq FingerTree (Elem a)
xs''FT :> a
lastx -> case forall a. FingerTree (Elem a) -> Rigidified (Elem a)
rigidify FingerTree (Elem b)
ysFT of
Rigidified (Elem b)
RigidEmpty -> forall a. Seq a
empty
RigidOne (Elem b
y) -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\a
x -> a -> b -> c
f a
x b
y) Seq a
xs
RigidTwo (Elem b
y1) (Elem b
y2) ->
forall a. FingerTree (Elem a) -> Seq a
Seq forall a b. (a -> b) -> a -> b
$ 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 b
y1) (Elem b
y2) (Elem b
y3) ->
forall a. FingerTree (Elem a) -> Seq a
Seq forall a b. (a -> b) -> a -> b
$ 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 Int
s Digit23 (Elem b)
pr Thin (Digit23 (Elem b))
_m Digit23 (Elem b)
sf) -> forall a. FingerTree (Elem a) -> Seq a
Seq forall a b. (a -> b) -> a -> b
$
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s forall a. Num a => a -> a -> a
* forall a. Seq a -> Int
length Seq a
xs)
(forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> b -> c
f a
firstx)) (forall a. Node a -> Digit a
nodeToDigit Digit23 (Elem b)
pr))
(forall b c a.
(b -> c)
-> (b -> c)
-> (a -> b -> c)
-> FingerTree (Elem a)
-> Rigid b
-> FingerTree (Node c)
liftA2Middle (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> b -> c
f a
firstx)) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> b -> c
f a
lastx)) (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)
(forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> b -> c
f a
lastx)) (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 :: forall a b c. (a -> b -> c) -> a -> Elem b -> Elem c
lift_elem = coerce :: 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
liftA2Middle
:: (b -> c)
-> (b -> c)
-> (a -> b -> c)
-> FingerTree (Elem a)
-> Rigid b
-> FingerTree (Node c)
liftA2Middle :: forall b c a.
(b -> c)
-> (b -> c)
-> (a -> b -> c)
-> FingerTree (Elem a)
-> Rigid b
-> FingerTree (Node c)
liftA2Middle
b -> c
ffirstx
b -> c
flastx
a -> b -> c
f
FingerTree (Elem a)
midxs
(Rigid Int
s Digit23 b
pr (DeepTh Int
sm Digit12 (Digit23 b)
prm Thin (Node (Digit23 b))
mm Digit12 (Digit23 b)
sfm) Digit23 b
sf)
= forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
sm forall a. Num a => a -> a -> a
+ Int
s forall a. Num a => a -> a -> a
* (forall a. Sized a => a -> Int
size FingerTree (Elem a)
midxs forall a. Num a => a -> a -> a
+ Int
1))
(forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> c
ffirstx) (forall a. Digit12 a -> Digit a
digit12ToDigit Digit12 (Digit23 b)
prm))
(forall b c a.
(b -> c)
-> (b -> c)
-> (a -> b -> c)
-> FingerTree (Elem a)
-> Rigid b
-> FingerTree (Node c)
liftA2Middle
(forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> c
ffirstx)
(forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> c
flastx)
(forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b -> c
f)
FingerTree (Elem a)
midxs
(forall a.
Int -> Digit23 a -> Thin (Digit23 a) -> Digit23 a -> Rigid a
Rigid Int
s (forall a. Digit23 a -> Digit12 (Digit23 a) -> Digit23 (Digit23 a)
squashL Digit23 b
pr Digit12 (Digit23 b)
prm) Thin (Node (Digit23 b))
mm (forall a. Digit12 (Node a) -> Node a -> Digit23 (Node a)
squashR Digit12 (Digit23 b)
sfm Digit23 b
sf)))
(forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> c
flastx) (forall a. Digit12 a -> Digit a
digit12ToDigit Digit12 (Digit23 b)
sfm))
liftA2Middle
b -> c
ffirstx
b -> c
flastx
a -> b -> c
f
FingerTree (Elem a)
midxs
(Rigid Int
s Digit23 b
pr Thin (Digit23 b)
EmptyTh Digit23 b
sf)
= forall a.
Sized a =>
Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
deep
(forall a. a -> Digit a
One (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> c
ffirstx Digit23 b
sf))
(forall a b. Int -> (a -> b) -> FingerTree a -> FingerTree b
mapMulFT Int
s (\(Elem a
x) -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> b -> c
f a
x)) Node (Digit23 b)
converted) FingerTree (Elem a)
midxs)
(forall a. a -> Digit a
One (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> c
flastx Digit23 b
pr))
where converted :: Node (Digit23 b)
converted = forall a. Sized a => a -> a -> Node a
node2 Digit23 b
pr Digit23 b
sf
liftA2Middle
b -> c
ffirstx
b -> c
flastx
a -> b -> c
f
FingerTree (Elem a)
midxs
(Rigid Int
s Digit23 b
pr (SingleTh Digit23 b
q) Digit23 b
sf)
= forall a.
Sized a =>
Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
deep
(forall a. a -> a -> Digit a
Two (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> c
ffirstx Digit23 b
q) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> c
ffirstx Digit23 b
sf))
(forall a b. Int -> (a -> b) -> FingerTree a -> FingerTree b
mapMulFT Int
s (\(Elem a
x) -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> b -> c
f a
x)) Node (Digit23 b)
converted) FingerTree (Elem a)
midxs)
(forall a. a -> a -> Digit a
Two (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> c
flastx Digit23 b
pr) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> c
flastx Digit23 b
q))
where converted :: Node (Digit23 b)
converted = 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 :: forall a. Digit12 a -> Digit a
digit12ToDigit (One12 a
a) = forall a. a -> Digit a
One a
a
digit12ToDigit (Two12 a
a a
b) = forall a. a -> a -> Digit a
Two a
a a
b
squashL :: Digit23 a -> Digit12 (Node a) -> Digit23 (Node a)
squashL :: forall a. Digit23 a -> Digit12 (Digit23 a) -> Digit23 (Digit23 a)
squashL Node a
m (One12 Node a
n) = forall a. Sized a => a -> a -> Node a
node2 Node a
m Node a
n
squashL Node a
m (Two12 Node a
n1 Node a
n2) = forall a. Sized a => a -> a -> a -> Node a
node3 Node a
m Node a
n1 Node a
n2
squashR :: Digit12 (Node a) -> Digit23 a -> Digit23 (Node a)
squashR :: forall a. Digit12 (Node a) -> Node a -> Digit23 (Node a)
squashR (One12 Node a
n) Node a
m = forall a. Sized a => a -> a -> Node a
node2 Node a
n Node a
m
squashR (Two12 Node a
n1 Node a
n2) Node a
m = 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 :: forall a b. Int -> (a -> b) -> FingerTree a -> FingerTree b
mapMulFT !Int
_ a -> b
_ FingerTree a
EmptyT = forall a. FingerTree a
EmptyT
mapMulFT Int
_mul a -> b
f (Single a
a) = forall a. a -> FingerTree a
Single (a -> b
f a
a)
mapMulFT Int
mul a -> b
f (Deep Int
s Digit a
pr FingerTree (Node a)
m Digit a
sf) = forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
mul forall a. Num a => a -> a -> a
* Int
s) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Digit a
pr) (forall a b. Int -> (a -> b) -> FingerTree a -> FingerTree b
mapMulFT Int
mul (forall a b. Int -> (a -> b) -> Node a -> Node b
mapMulNode Int
mul a -> b
f) FingerTree (Node a)
m) (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 :: forall a b. Int -> (a -> b) -> Node a -> Node b
mapMulNode Int
mul a -> b
f (Node2 Int
s a
a a
b) = forall a. Int -> a -> a -> Node a
Node2 (Int
mul forall a. Num a => a -> a -> a
* Int
s) (a -> b
f a
a) (a -> b
f a
b)
mapMulNode Int
mul a -> b
f (Node3 Int
s a
a a
b a
c) = forall a. Int -> a -> a -> a -> Node a
Node3 (Int
mul 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 :: forall a. FingerTree (Elem a) -> Rigidified (Elem a)
rigidify FingerTree (Elem a)
EmptyT = forall a. Rigidified a
RigidEmpty
rigidify (Single Elem a
q) = forall a. a -> Rigidified a
RigidOne Elem a
q
rigidify (Deep Int
s (Two Elem a
a Elem a
b) FingerTree (Node (Elem a))
m Digit (Elem a)
sf) = forall a.
Int
-> Digit23 (Elem a)
-> FingerTree (Digit23 (Elem a))
-> Digit (Elem a)
-> Rigidified (Elem a)
rigidifyRight Int
s (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 Int
s (Three Elem a
a Elem a
b Elem a
c) FingerTree (Node (Elem a))
m Digit (Elem a)
sf) = forall a.
Int
-> Digit23 (Elem a)
-> FingerTree (Digit23 (Elem a))
-> Digit (Elem a)
-> Rigidified (Elem a)
rigidifyRight Int
s (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 Int
s (Four Elem a
a Elem a
b Elem a
c Elem a
d) FingerTree (Node (Elem a))
m Digit (Elem a)
sf) = forall a.
Int
-> Digit23 (Elem a)
-> FingerTree (Digit23 (Elem a))
-> Digit (Elem a)
-> Rigidified (Elem a)
rigidifyRight Int
s (forall a. Sized a => a -> a -> Node a
node2 Elem a
a Elem a
b) (forall a. Sized a => a -> a -> Node a
node2 Elem a
c Elem a
d forall a. Sized a => a -> FingerTree a -> FingerTree a
`consTree` FingerTree (Node (Elem a))
m) Digit (Elem a)
sf
rigidify (Deep Int
s (One Elem a
a) FingerTree (Node (Elem a))
m Digit (Elem a)
sf) = case forall a. Sized a => FingerTree a -> ViewLTree a
viewLTree FingerTree (Node (Elem a))
m of
ConsLTree (Node2 Int
_ Elem a
b Elem a
c) FingerTree (Node (Elem a))
m' -> forall a.
Int
-> Digit23 (Elem a)
-> FingerTree (Digit23 (Elem a))
-> Digit (Elem a)
-> Rigidified (Elem a)
rigidifyRight Int
s (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 Int
_ Elem a
b Elem a
c Elem a
d) FingerTree (Node (Elem a))
m' -> forall a.
Int
-> Digit23 (Elem a)
-> FingerTree (Digit23 (Elem a))
-> Digit (Elem a)
-> Rigidified (Elem a)
rigidifyRight Int
s (forall a. Sized a => a -> a -> Node a
node2 Elem a
a Elem a
b) (forall a. Sized a => a -> a -> Node a
node2 Elem a
c Elem a
d forall a. Sized a => a -> FingerTree a -> FingerTree a
`consTree` FingerTree (Node (Elem a))
m') Digit (Elem a)
sf
ViewLTree (Node (Elem a))
EmptyLTree -> case Digit (Elem a)
sf of
One Elem a
b -> forall a. a -> a -> Rigidified a
RigidTwo Elem a
a Elem a
b
Two Elem a
b Elem a
c -> forall a. a -> a -> a -> Rigidified a
RigidThree Elem a
a Elem a
b Elem a
c
Three Elem a
b Elem a
c Elem a
d -> forall a. Rigid a -> Rigidified a
RigidFull forall a b. (a -> b) -> a -> b
$ forall a.
Int -> Digit23 a -> Thin (Digit23 a) -> Digit23 a -> Rigid a
Rigid Int
s (forall a. Sized a => a -> a -> Node a
node2 Elem a
a Elem a
b) forall a. Thin a
EmptyTh (forall a. Sized a => a -> a -> Node a
node2 Elem a
c Elem a
d)
Four Elem a
b Elem a
c Elem a
d Elem a
e -> forall a. Rigid a -> Rigidified a
RigidFull forall a b. (a -> b) -> a -> b
$ forall a.
Int -> Digit23 a -> Thin (Digit23 a) -> Digit23 a -> Rigid a
Rigid Int
s (forall a. Sized a => a -> a -> a -> Node a
node3 Elem a
a Elem a
b Elem a
c) forall a. Thin a
EmptyTh (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 :: forall a.
Int
-> Digit23 (Elem a)
-> FingerTree (Digit23 (Elem a))
-> Digit (Elem a)
-> Rigidified (Elem a)
rigidifyRight Int
s Node (Elem a)
pr FingerTree (Node (Elem a))
m (Two Elem a
a Elem a
b) = forall a. Rigid a -> Rigidified a
RigidFull forall a b. (a -> b) -> a -> b
$ forall a.
Int -> Digit23 a -> Thin (Digit23 a) -> Digit23 a -> Rigid a
Rigid Int
s Node (Elem a)
pr (forall a. Sized a => FingerTree a -> Thin a
thin FingerTree (Node (Elem a))
m) (forall a. Sized a => a -> a -> Node a
node2 Elem a
a Elem a
b)
rigidifyRight Int
s Node (Elem a)
pr FingerTree (Node (Elem a))
m (Three Elem a
a Elem a
b Elem a
c) = forall a. Rigid a -> Rigidified a
RigidFull forall a b. (a -> b) -> a -> b
$ forall a.
Int -> Digit23 a -> Thin (Digit23 a) -> Digit23 a -> Rigid a
Rigid Int
s Node (Elem a)
pr (forall a. Sized a => FingerTree a -> Thin a
thin FingerTree (Node (Elem a))
m) (forall a. Sized a => a -> a -> a -> Node a
node3 Elem a
a Elem a
b Elem a
c)
rigidifyRight Int
s Node (Elem a)
pr FingerTree (Node (Elem a))
m (Four Elem a
a Elem a
b Elem a
c Elem a
d) = forall a. Rigid a -> Rigidified a
RigidFull forall a b. (a -> b) -> a -> b
$ forall a.
Int -> Digit23 a -> Thin (Digit23 a) -> Digit23 a -> Rigid a
Rigid Int
s Node (Elem a)
pr (forall a. Sized a => FingerTree a -> Thin a
thin forall a b. (a -> b) -> a -> b
$ FingerTree (Node (Elem a))
m forall a. Sized a => FingerTree a -> a -> FingerTree a
`snocTree` forall a. Sized a => a -> a -> Node a
node2 Elem a
a Elem a
b) (forall a. Sized a => a -> a -> Node a
node2 Elem a
c Elem a
d)
rigidifyRight Int
s Node (Elem a)
pr FingerTree (Node (Elem a))
m (One Elem a
e) = case forall a. Sized a => FingerTree a -> ViewRTree a
viewRTree FingerTree (Node (Elem a))
m of
SnocRTree FingerTree (Node (Elem a))
m' (Node2 Int
_ Elem a
a Elem a
b) -> forall a. Rigid a -> Rigidified a
RigidFull forall a b. (a -> b) -> a -> b
$ forall a.
Int -> Digit23 a -> Thin (Digit23 a) -> Digit23 a -> Rigid a
Rigid Int
s Node (Elem a)
pr (forall a. Sized a => FingerTree a -> Thin a
thin FingerTree (Node (Elem a))
m') (forall a. Sized a => a -> a -> a -> Node a
node3 Elem a
a Elem a
b Elem a
e)
SnocRTree FingerTree (Node (Elem a))
m' (Node3 Int
_ Elem a
a Elem a
b Elem a
c) -> forall a. Rigid a -> Rigidified a
RigidFull forall a b. (a -> b) -> a -> b
$ forall a.
Int -> Digit23 a -> Thin (Digit23 a) -> Digit23 a -> Rigid a
Rigid Int
s Node (Elem a)
pr (forall a. Sized a => FingerTree a -> Thin a
thin forall a b. (a -> b) -> a -> b
$ FingerTree (Node (Elem a))
m' forall a. Sized a => FingerTree a -> a -> FingerTree a
`snocTree` forall a. Sized a => a -> a -> Node a
node2 Elem a
a Elem a
b) (forall a. Sized a => a -> a -> Node a
node2 Elem a
c Elem a
e)
ViewRTree (Node (Elem a))
EmptyRTree -> case Node (Elem a)
pr of
Node2 Int
_ Elem a
a Elem a
b -> forall a. a -> a -> a -> Rigidified a
RigidThree Elem a
a Elem a
b Elem a
e
Node3 Int
_ Elem a
a Elem a
b Elem a
c -> forall a. Rigid a -> Rigidified a
RigidFull forall a b. (a -> b) -> a -> b
$ forall a.
Int -> Digit23 a -> Thin (Digit23 a) -> Digit23 a -> Rigid a
Rigid Int
s (forall a. Sized a => a -> a -> Node a
node2 Elem a
a Elem a
b) forall a. Thin a
EmptyTh (forall a. Sized a => a -> a -> Node a
node2 Elem a
c Elem a
e)
thin :: Sized a => FingerTree a -> Thin a
thin :: forall a. Sized a => FingerTree a -> Thin a
thin FingerTree a
EmptyT = forall a. Thin a
EmptyTh
thin (Single a
a) = forall a. a -> Thin a
SingleTh a
a
thin (Deep Int
s Digit a
pr FingerTree (Node a)
m Digit a
sf) =
case Digit a
pr of
One a
a -> forall a.
Sized a =>
Int -> Digit12 a -> FingerTree (Node a) -> Digit a -> Thin a
thin12 Int
s (forall a. a -> Digit12 a
One12 a
a) FingerTree (Node a)
m Digit a
sf
Two a
a a
b -> forall a.
Sized a =>
Int -> Digit12 a -> FingerTree (Node a) -> Digit a -> Thin a
thin12 Int
s (forall a. a -> a -> Digit12 a
Two12 a
a a
b) FingerTree (Node a)
m Digit a
sf
Three a
a a
b a
c -> forall a.
Sized a =>
Int -> Digit12 a -> FingerTree (Node a) -> Digit a -> Thin a
thin12 Int
s (forall a. a -> Digit12 a
One12 a
a) (forall a. Sized a => a -> a -> Node a
node2 a
b a
c forall a. Sized a => a -> FingerTree a -> FingerTree a
`consTree` FingerTree (Node a)
m) Digit a
sf
Four a
a a
b a
c a
d -> forall a.
Sized a =>
Int -> Digit12 a -> FingerTree (Node a) -> Digit a -> Thin a
thin12 Int
s (forall a. a -> a -> Digit12 a
Two12 a
a a
b) (forall a. Sized a => a -> a -> Node a
node2 a
c a
d 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 :: forall a.
Sized a =>
Int -> Digit12 a -> FingerTree (Node a) -> Digit a -> Thin a
thin12 Int
s Digit12 a
pr FingerTree (Node a)
m (One a
a) = forall a. Int -> Digit12 a -> Thin (Node a) -> Digit12 a -> Thin a
DeepTh Int
s Digit12 a
pr (forall a. Sized a => FingerTree a -> Thin a
thin FingerTree (Node a)
m) (forall a. a -> Digit12 a
One12 a
a)
thin12 Int
s Digit12 a
pr FingerTree (Node a)
m (Two a
a a
b) = forall a. Int -> Digit12 a -> Thin (Node a) -> Digit12 a -> Thin a
DeepTh Int
s Digit12 a
pr (forall a. Sized a => FingerTree a -> Thin a
thin FingerTree (Node a)
m) (forall a. a -> a -> Digit12 a
Two12 a
a a
b)
thin12 Int
s Digit12 a
pr FingerTree (Node a)
m (Three a
a a
b a
c) = forall a. Int -> Digit12 a -> Thin (Node a) -> Digit12 a -> Thin a
DeepTh Int
s Digit12 a
pr (forall a. Sized a => FingerTree a -> Thin a
thin forall a b. (a -> b) -> a -> b
$ FingerTree (Node a)
m forall a. Sized a => FingerTree a -> a -> FingerTree a
`snocTree` forall a. Sized a => a -> a -> Node a
node2 a
a a
b) (forall a. a -> Digit12 a
One12 a
c)
thin12 Int
s Digit12 a
pr FingerTree (Node a)
m (Four a
a a
b a
c a
d) = forall a. Int -> Digit12 a -> Thin (Node a) -> Digit12 a -> Thin a
DeepTh Int
s Digit12 a
pr (forall a. Sized a => FingerTree a -> Thin a
thin forall a b. (a -> b) -> a -> b
$ FingerTree (Node a)
m forall a. Sized a => FingerTree a -> a -> FingerTree a
`snocTree` forall a. Sized a => a -> a -> Node a
node2 a
a a
b) (forall a. a -> a -> Digit12 a
Two12 a
c a
d)
intersperse :: a -> Seq a -> Seq a
intersperse :: forall a. a -> Seq a -> Seq a
intersperse a
y Seq a
xs = case forall a. Seq a -> ViewL a
viewl Seq a
xs of
ViewL a
EmptyL -> forall a. Seq a
empty
a
p :< Seq a
ps -> a
p forall a. a -> Seq a -> Seq a
<| (Seq a
ps forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**> (forall a b. a -> b -> a
const a
y forall a. a -> Seq a -> Seq a
<| forall a. a -> Seq a
singleton forall a. a -> a
id))
instance MonadPlus Seq where
mzero :: forall a. Seq a
mzero = forall a. Seq a
empty
mplus :: forall a. Seq a -> Seq a -> Seq a
mplus = forall a. Seq a -> Seq a -> Seq a
(><)
instance Alternative Seq where
empty :: forall a. Seq a
empty = forall a. Seq a
empty
<|> :: forall a. Seq a -> Seq a -> Seq a
(<|>) = forall a. Seq a -> Seq a -> Seq a
(><)
instance Eq a => Eq (Seq a) where
Seq a
xs == :: Seq a -> Seq a -> Bool
== Seq a
ys = forall a. Seq a -> Int
length Seq a
xs forall a. Eq a => a -> a -> Bool
== forall a. Seq a -> Int
length Seq a
ys Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq a
xs forall a. Eq a => a -> a -> Bool
== 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 Seq a
xs Seq a
ys = forall a. Ord a => a -> a -> Ordering
compare (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq a
xs) (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 Int
p Seq a
xs = Bool -> ShowS -> ShowS
showParen (Int
p forall a. Ord a => a -> a -> Bool
> Int
10) forall a b. (a -> b) -> a -> b
$
[Char] -> ShowS
showString [Char]
"fromList " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> ShowS
shows (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 :: forall a.
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> Seq a -> ShowS
liftShowsPrec Int -> a -> ShowS
_shwsPrc [a] -> ShowS
shwList Int
p Seq a
xs = Bool -> ShowS -> ShowS
showParen (Int
p forall a. Ord a => a -> a -> Bool
> Int
10) forall a b. (a -> b) -> a -> b
$
[Char] -> ShowS
showString [Char]
"fromList " forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> ShowS
shwList (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq a
xs)
instance Eq1 Seq where
liftEq :: forall a b. (a -> b -> Bool) -> Seq a -> Seq b -> Bool
liftEq a -> b -> Bool
eq Seq a
xs Seq b
ys = forall a. Seq a -> Int
length Seq a
xs forall a. Eq a => a -> a -> Bool
== forall a. Seq a -> Int
length Seq b
ys Bool -> Bool -> Bool
&& forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq a -> b -> Bool
eq (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq a
xs) (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq b
ys)
instance Ord1 Seq where
liftCompare :: forall a b. (a -> b -> Ordering) -> Seq a -> Seq b -> Ordering
liftCompare a -> b -> Ordering
cmp Seq a
xs Seq b
ys = forall (f :: * -> *) a b.
Ord1 f =>
(a -> b -> Ordering) -> f a -> f b -> Ordering
liftCompare a -> b -> Ordering
cmp (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq a
xs) (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 = forall a. ReadPrec a -> ReadPrec a
parens forall a b. (a -> b) -> a -> b
$ forall a. Int -> ReadPrec a -> ReadPrec a
prec Int
10 forall a b. (a -> b) -> a -> b
$ do
Ident [Char]
"fromList" <- ReadPrec Lexeme
lexP
[a]
xs <- forall a. Read a => ReadPrec a
readPrec
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. [a] -> Seq a
fromList [a]
xs)
readListPrec :: ReadPrec [Seq a]
readListPrec = 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 :: forall a. (Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (Seq a)
liftReadsPrec Int -> ReadS a
_rp ReadS [a]
readLst Int
p = forall a. Bool -> ReadS a -> ReadS a
readParen (Int
p forall a. Ord a => a -> a -> Bool
> Int
10) forall a b. (a -> b) -> a -> b
$ \[Char]
r -> do
([Char]
"fromList",[Char]
s) <- ReadS [Char]
lex [Char]
r
([a]
xs,[Char]
t) <- ReadS [a]
readLst [Char]
s
forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. [a] -> Seq a
fromList [a]
xs, [Char]
t)
#endif
instance Monoid (Seq a) where
mempty :: Seq a
mempty = forall a. Seq a
empty
#if MIN_VERSION_base(4,9,0)
mappend :: Seq a -> Seq a -> Seq a
mappend = forall a. Semigroup a => a -> a -> a
(Semigroup.<>)
#else
mappend = (><)
#endif
#if MIN_VERSION_base(4,9,0)
instance Semigroup.Semigroup (Seq a) where
<> :: Seq a -> Seq a -> Seq a
(<>) = forall a. Seq a -> Seq a -> Seq a
(><)
stimes :: forall b. Integral b => b -> Seq a -> Seq a
stimes = forall a. Int -> Seq a -> Seq a
cycleNTimes forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Seq a -> c (Seq a)
gfoldl forall d b. Data d => c (d -> b) -> d -> c b
f forall g. g -> c g
z Seq a
s = case forall a. Seq a -> ViewL a
viewl Seq a
s of
ViewL a
EmptyL -> forall g. g -> c g
z forall a. Seq a
empty
a
x :< Seq a
xs -> forall g. g -> c g
z forall a. a -> Seq a -> Seq a
(<|) forall d b. Data d => c (d -> b) -> d -> c b
`f` a
x forall d b. Data d => c (d -> b) -> d -> c b
`f` Seq a
xs
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Seq a)
gunfold forall b r. Data b => c (b -> r) -> c r
k forall r. r -> c r
z Constr
c = case Constr -> Int
constrIndex Constr
c of
Int
1 -> forall r. r -> c r
z forall a. Seq a
empty
Int
2 -> forall b r. Data b => c (b -> r) -> c r
k (forall b r. Data b => c (b -> r) -> c r
k (forall r. r -> c r
z forall a. a -> Seq a -> Seq a
(<|)))
Int
_ -> forall a. HasCallStack => [Char] -> a
error [Char]
"gunfold"
toConstr :: Seq a -> Constr
toConstr Seq a
xs
| forall a. Seq a -> Bool
null Seq a
xs = Constr
emptyConstr
| Bool
otherwise = Constr
consConstr
dataTypeOf :: Seq a -> DataType
dataTypeOf Seq a
_ = DataType
seqDataType
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Seq a))
dataCast1 forall d. Data d => c (t d)
f = 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 forall d. Data d => c (t d)
f
emptyConstr, consConstr :: Constr
emptyConstr :: Constr
emptyConstr = DataType -> [Char] -> [[Char]] -> Fixity -> Constr
mkConstr DataType
seqDataType [Char]
"empty" [] Fixity
Prefix
consConstr :: Constr
consConstr = DataType -> [Char] -> [[Char]] -> Fixity -> Constr
mkConstr DataType
seqDataType [Char]
"<|" [] Fixity
Infix
seqDataType :: DataType
seqDataType :: DataType
seqDataType = [Char] -> [Constr] -> DataType
mkDataType [Char]
"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 FingerTree a
EmptyT = Int
0
size (Single a
x) = forall a. Sized a => a -> Int
size a
x
size (Deep Int
v Digit a
_ FingerTree (Node a)
_ Digit a
_) = Int
v
instance Foldable FingerTree where
foldMap :: forall m a. Monoid m => (a -> m) -> FingerTree a -> m
foldMap a -> m
_ FingerTree a
EmptyT = forall a. Monoid a => a
mempty
foldMap a -> m
f' (Single a
x') = a -> m
f' a
x'
foldMap a -> m
f' (Deep Int
_ Digit a
pr' FingerTree (Node a)
m' Digit a
sf') =
forall m a. Monoid m => (a -> m) -> Digit a -> m
foldMapDigit a -> m
f' Digit a
pr' forall m. Monoid m => m -> m -> m
<>
forall m a. Monoid m => (Node a -> m) -> FingerTree (Node a) -> m
foldMapTree (forall m a. Monoid m => (a -> m) -> Node a -> m
foldMapNode a -> m
f') FingerTree (Node a)
m' forall m. Monoid m => m -> m -> 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 :: forall m a. Monoid m => (Node a -> m) -> FingerTree (Node a) -> m
foldMapTree Node a -> m
_ FingerTree (Node a)
EmptyT = forall a. Monoid a => a
mempty
foldMapTree Node a -> m
f (Single Node a
x) = Node a -> m
f Node a
x
foldMapTree Node a -> m
f (Deep Int
_ Digit (Node a)
pr FingerTree (Node (Node a))
m Digit (Node a)
sf) =
forall m a. Monoid m => (Node a -> m) -> Digit (Node a) -> m
foldMapDigitN Node a -> m
f Digit (Node a)
pr forall m. Monoid m => m -> m -> m
<>
forall m a. Monoid m => (Node a -> m) -> FingerTree (Node a) -> m
foldMapTree (forall m a. Monoid m => (Node a -> m) -> Node (Node a) -> m
foldMapNodeN Node a -> m
f) FingerTree (Node (Node a))
m forall m. Monoid m => m -> m -> 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 :: forall m a. Monoid m => (a -> m) -> Digit a -> m
foldMapDigit a -> m
f Digit a
t = forall b a. (b -> b -> b) -> (a -> b) -> Digit a -> b
foldDigit forall m. Monoid m => m -> m -> m
(<>) a -> m
f Digit a
t
foldMapDigitN :: Monoid m => (Node a -> m) -> Digit (Node a) -> m
foldMapDigitN :: forall m a. Monoid m => (Node a -> m) -> Digit (Node a) -> m
foldMapDigitN Node a -> m
f Digit (Node a)
t = forall b a. (b -> b -> b) -> (a -> b) -> Digit a -> b
foldDigit forall m. Monoid m => m -> m -> m
(<>) Node a -> m
f Digit (Node a)
t
foldMapNode :: Monoid m => (a -> m) -> Node a -> m
foldMapNode :: forall m a. Monoid m => (a -> m) -> Node a -> m
foldMapNode a -> m
f Node a
t = forall b a. (b -> b -> b) -> (a -> b) -> Node a -> b
foldNode forall m. Monoid m => m -> m -> m
(<>) a -> m
f Node a
t
foldMapNodeN :: Monoid m => (Node a -> m) -> Node (Node a) -> m
foldMapNodeN :: forall m a. Monoid m => (Node a -> m) -> Node (Node a) -> m
foldMapNodeN Node a -> m
f Node (Node a)
t = forall b a. (b -> b -> b) -> (a -> b) -> Node a -> b
foldNode forall m. Monoid m => m -> m -> m
(<>) Node a -> m
f Node (Node a)
t
#if __GLASGOW_HASKELL__
{-# INLINABLE foldMap #-}
#endif
foldr :: forall a b. (a -> b -> b) -> b -> FingerTree a -> b
foldr a -> b -> b
_ b
z' FingerTree a
EmptyT = b
z'
foldr a -> b -> b
f' b
z' (Single a
x') = a
x' a -> b -> b
`f'` b
z'
foldr a -> b -> b
f' b
z' (Deep Int
_ Digit a
pr' FingerTree (Node a)
m' Digit a
sf') =
forall a b. (a -> b -> b) -> b -> Digit a -> b
foldrDigit a -> b -> b
f' (forall a b. (Node a -> b -> b) -> b -> FingerTree (Node a) -> b
foldrTree (forall a b. (a -> b -> b) -> Node a -> b -> b
foldrNode a -> b -> b
f') (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 :: forall a b. (Node a -> b -> b) -> b -> FingerTree (Node a) -> b
foldrTree Node a -> b -> b
_ b
z FingerTree (Node a)
EmptyT = b
z
foldrTree Node a -> b -> b
f b
z (Single Node a
x) = Node a
x Node a -> b -> b
`f` b
z
foldrTree Node a -> b -> b
f b
z (Deep Int
_ Digit (Node a)
pr FingerTree (Node (Node a))
m Digit (Node a)
sf) =
forall a b. (Node a -> b -> b) -> b -> Digit (Node a) -> b
foldrDigitN Node a -> b -> b
f (forall a b. (Node a -> b -> b) -> b -> FingerTree (Node a) -> b
foldrTree (forall a b. (Node a -> b -> b) -> Node (Node a) -> b -> b
foldrNodeN Node a -> b -> b
f) (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 :: forall a b. (a -> b -> b) -> b -> Digit a -> b
foldrDigit a -> b -> b
f b
z Digit a
t = 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 :: forall a b. (Node a -> b -> b) -> b -> Digit (Node a) -> b
foldrDigitN Node a -> b -> b
f b
z Digit (Node a)
t = 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 :: forall a b. (a -> b -> b) -> Node a -> b -> b
foldrNode a -> b -> b
f Node a
t b
z = 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 :: forall a b. (Node a -> b -> b) -> Node (Node a) -> b -> b
foldrNodeN Node a -> b -> b
f Node (Node a)
t b
z = 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 :: forall b a. (b -> a -> b) -> b -> FingerTree a -> b
foldl b -> a -> b
_ b
z' FingerTree a
EmptyT = b
z'
foldl b -> a -> b
f' b
z' (Single a
x') = b
z' b -> a -> b
`f'` a
x'
foldl b -> a -> b
f' b
z' (Deep Int
_ Digit a
pr' FingerTree (Node a)
m' Digit a
sf') =
forall b a. (b -> a -> b) -> b -> Digit a -> b
foldlDigit b -> a -> b
f' (forall b a. (b -> Node a -> b) -> b -> FingerTree (Node a) -> b
foldlTree (forall b a. (b -> a -> b) -> b -> Node a -> b
foldlNode b -> a -> b
f') (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 :: forall b a. (b -> Node a -> b) -> b -> FingerTree (Node a) -> b
foldlTree b -> Node a -> b
_ b
z FingerTree (Node a)
EmptyT = b
z
foldlTree b -> Node a -> b
f b
z (Single Node a
x) = b
z b -> Node a -> b
`f` Node a
x
foldlTree b -> Node a -> b
f b
z (Deep Int
_ Digit (Node a)
pr FingerTree (Node (Node a))
m Digit (Node a)
sf) =
forall b a. (b -> Node a -> b) -> b -> Digit (Node a) -> b
foldlDigitN b -> Node a -> b
f (forall b a. (b -> Node a -> b) -> b -> FingerTree (Node a) -> b
foldlTree (forall b a. (b -> Node a -> b) -> b -> Node (Node a) -> b
foldlNodeN b -> Node a -> b
f) (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 :: forall b a. (b -> a -> b) -> b -> Digit a -> b
foldlDigit b -> a -> b
f b
z Digit a
t = 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 :: forall b a. (b -> Node a -> b) -> b -> Digit (Node a) -> b
foldlDigitN b -> Node a -> b
f b
z Digit (Node a)
t = 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 :: forall b a. (b -> a -> b) -> b -> Node a -> b
foldlNode b -> a -> b
f b
z Node a
t = 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 :: forall b a. (b -> Node a -> b) -> b -> Node (Node a) -> b
foldlNodeN b -> Node a -> b
f b
z Node (Node a)
t = 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' :: forall a b. (a -> b -> b) -> b -> FingerTree a -> b
foldr' a -> b -> b
_ b
z' FingerTree a
EmptyT = b
z'
foldr' a -> b -> b
f' b
z' (Single a
x') = a -> b -> b
f' a
x' b
z'
foldr' a -> b -> b
f' b
z' (Deep Int
_ Digit a
pr' FingerTree (Node a)
m' Digit a
sf') =
(forall a b. (a -> b -> b) -> b -> Digit a -> b
foldrDigit' a -> b -> b
f' forall a b. (a -> b) -> a -> b
$! (forall a b. (Node a -> b -> b) -> b -> FingerTree (Node a) -> b
foldrTree' (forall a b. (a -> b -> b) -> Node a -> b -> b
foldrNode' a -> b -> b
f') forall a b. (a -> b) -> 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' :: forall a b. (Node a -> b -> b) -> b -> FingerTree (Node a) -> b
foldrTree' Node a -> b -> b
_ b
z FingerTree (Node a)
EmptyT = b
z
foldrTree' Node a -> b -> b
f b
z (Single Node a
x) = Node a -> b -> b
f Node a
x forall a b. (a -> b) -> a -> b
$! b
z
foldrTree' Node a -> b -> b
f b
z (Deep Int
_ Digit (Node a)
pr FingerTree (Node (Node a))
m Digit (Node a)
sf) =
(forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr' Node a -> b -> b
f forall a b. (a -> b) -> a -> b
$! (forall a b. (Node a -> b -> b) -> b -> FingerTree (Node a) -> b
foldrTree' (forall a b. (Node a -> b -> b) -> Node (Node a) -> b -> b
foldrNodeN' Node a -> b -> b
f) forall a b. (a -> b) -> a -> b
$! (forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr' Node a -> b -> b
f 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' :: forall a b. (a -> b -> b) -> b -> Digit a -> b
foldrDigit' a -> b -> b
f b
z Digit a
t = 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' :: forall a b. (a -> b -> b) -> Node a -> b -> b
foldrNode' a -> b -> b
f Node a
t b
z = 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' :: forall a b. (Node a -> b -> b) -> Node (Node a) -> b -> b
foldrNodeN' Node a -> b -> b
f Node (Node a)
t b
z = 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' :: forall b a. (b -> a -> b) -> b -> FingerTree a -> b
foldl' b -> a -> b
_ b
z' FingerTree a
EmptyT = b
z'
foldl' b -> a -> b
f' b
z' (Single a
x') = b -> a -> b
f' b
z' a
x'
foldl' b -> a -> b
f' b
z' (Deep Int
_ Digit a
pr' FingerTree (Node a)
m' Digit a
sf') =
(forall b a. (b -> a -> b) -> b -> Digit a -> b
foldlDigit' b -> a -> b
f' forall a b. (a -> b) -> a -> b
$!
(forall b a. (b -> Node a -> b) -> b -> FingerTree (Node a) -> b
foldlTree' (forall b a. (b -> a -> b) -> b -> Node a -> b
foldlNode' b -> a -> b
f') forall a b. (a -> b) -> 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' :: forall b a. (b -> Node a -> b) -> b -> FingerTree (Node a) -> b
foldlTree' b -> Node a -> b
_ b
z FingerTree (Node a)
EmptyT = b
z
foldlTree' b -> Node a -> b
f b
z (Single Node a
xs) = b -> Node a -> b
f b
z Node a
xs
foldlTree' b -> Node a -> b
f b
z (Deep Int
_ Digit (Node a)
pr FingerTree (Node (Node a))
m Digit (Node a)
sf) =
(forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' b -> Node a -> b
f forall a b. (a -> b) -> a -> b
$! (forall b a. (b -> Node a -> b) -> b -> FingerTree (Node a) -> b
foldlTree' (forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' b -> Node a -> b
f) forall a b. (a -> b) -> 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' :: forall b a. (b -> a -> b) -> b -> Digit a -> b
foldlDigit' b -> a -> b
f b
z Digit a
t = 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' :: forall b a. (b -> a -> b) -> b -> Node a -> b
foldlNode' b -> a -> b
f b
z Node a
t = 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 :: forall a. (a -> a -> a) -> FingerTree a -> a
foldr1 a -> a -> a
_ FingerTree a
EmptyT = forall a. HasCallStack => [Char] -> a
error [Char]
"foldr1: empty sequence"
foldr1 a -> a -> a
_ (Single a
x) = a
x
foldr1 a -> a -> a
f (Deep Int
_ Digit a
pr FingerTree (Node a)
m Digit a
sf) =
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> a -> a
f (forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> a -> a
f)) (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 :: forall a. (a -> a -> a) -> FingerTree a -> a
foldl1 a -> a -> a
_ FingerTree a
EmptyT = forall a. HasCallStack => [Char] -> a
error [Char]
"foldl1: empty sequence"
foldl1 a -> a -> a
_ (Single a
x) = a
x
foldl1 a -> a -> a
f (Deep Int
_ Digit a
pr FingerTree (Node a)
m Digit a
sf) =
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl a -> a -> a
f (forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl a -> a -> a
f) (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 :: forall a b. (a -> b) -> FingerTree a -> FingerTree b
fmap a -> b
_ FingerTree a
EmptyT = forall a. FingerTree a
EmptyT
fmap a -> b
f (Single a
x) = forall a. a -> FingerTree a
Single (a -> b
f a
x)
fmap a -> b
f (Deep Int
v Digit a
pr FingerTree (Node a)
m Digit a
sf) =
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
v (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Digit a
pr) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) FingerTree (Node a)
m) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Digit a
sf)
instance Traversable FingerTree where
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> FingerTree a -> f (FingerTree b)
traverse a -> f b
_ FingerTree a
EmptyT = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. FingerTree a
EmptyT
traverse a -> f b
f (Single a
x) = forall a. a -> FingerTree a
Single forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
x
traverse a -> f b
f (Deep Int
v Digit a
pr FingerTree (Node a)
m Digit a
sf) =
forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3 (forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
v) (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) (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (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)
(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 FingerTree a
EmptyT = ()
rnf (Single a
x) = forall a. NFData a => a -> ()
rnf a
x
rnf (Deep Int
_ Digit a
pr FingerTree (Node a)
m Digit a
sf) = forall a. NFData a => a -> ()
rnf Digit a
pr seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf Digit a
sf seq :: forall a b. a -> b -> b
`seq` 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 :: forall a.
Sized a =>
Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
deep Digit a
pr FingerTree (Node a)
m Digit a
sf = forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (forall a. Sized a => a -> Int
size Digit a
pr forall a. Num a => a -> a -> a
+ forall a. Sized a => a -> Int
size FingerTree (Node a)
m forall a. Num a => a -> a -> a
+ 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 :: forall a. Int -> FingerTree (Node a) -> Digit a -> FingerTree a
pullL Int
s FingerTree (Node a)
m Digit a
sf = case forall a. Sized a => FingerTree a -> ViewLTree a
viewLTree FingerTree (Node a)
m of
ViewLTree (Node a)
EmptyLTree -> forall a. Int -> Digit a -> FingerTree a
digitToTree' Int
s Digit a
sf
ConsLTree Node a
pr FingerTree (Node a)
m' -> forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
s (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 :: forall a. Int -> Digit a -> FingerTree (Node a) -> FingerTree a
pullR Int
s Digit a
pr FingerTree (Node a)
m = case forall a. Sized a => FingerTree a -> ViewRTree a
viewRTree FingerTree (Node a)
m of
ViewRTree (Node a)
EmptyRTree -> forall a. Int -> Digit a -> FingerTree a
digitToTree' Int
s Digit a
pr
SnocRTree FingerTree (Node a)
m' Node a
sf -> forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
s Digit a
pr FingerTree (Node a)
m' (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 :: forall b a. (b -> b -> b) -> (a -> b) -> Digit a -> b
foldDigit b -> b -> b
_ a -> b
f (One a
a) = a -> b
f a
a
foldDigit b -> b -> b
(<+>) a -> b
f (Two a
a a
b) = a -> b
f a
a b -> b -> b
<+> a -> b
f a
b
foldDigit b -> b -> b
(<+>) a -> b
f (Three a
a a
b 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
(<+>) a -> b
f (Four a
a a
b a
c 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 :: forall m a. Monoid m => (a -> m) -> Digit a -> m
foldMap = forall b a. (b -> b -> b) -> (a -> b) -> Digit a -> b
foldDigit forall m. Monoid m => m -> m -> m
mappend
foldr :: forall a b. (a -> b -> b) -> b -> Digit a -> b
foldr a -> b -> b
f b
z (One a
a) = a
a a -> b -> b
`f` b
z
foldr a -> b -> b
f b
z (Two a
a a
b) = a
a a -> b -> b
`f` (a
b a -> b -> b
`f` b
z)
foldr a -> b -> b
f b
z (Three a
a a
b a
c) = a
a a -> b -> b
`f` (a
b a -> b -> b
`f` (a
c a -> b -> b
`f` b
z))
foldr a -> b -> b
f b
z (Four a
a a
b a
c 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 :: forall b a. (b -> a -> b) -> b -> Digit a -> b
foldl b -> a -> b
f b
z (One a
a) = b
z b -> a -> b
`f` a
a
foldl b -> a -> b
f b
z (Two a
a a
b) = (b
z b -> a -> b
`f` a
a) b -> a -> b
`f` a
b
foldl b -> a -> b
f b
z (Three a
a a
b a
c) = ((b
z b -> a -> b
`f` a
a) b -> a -> b
`f` a
b) b -> a -> b
`f` a
c
foldl b -> a -> b
f b
z (Four a
a a
b a
c 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' :: forall a b. (a -> b -> b) -> b -> Digit a -> b
foldr' a -> b -> b
f b
z (One a
a) = a -> b -> b
f a
a b
z
foldr' a -> b -> b
f b
z (Two a
a a
b) = a -> b -> b
f a
a forall a b. (a -> b) -> a -> b
$! a -> b -> b
f a
b b
z
foldr' a -> b -> b
f b
z (Three a
a a
b a
c) = a -> b -> b
f a
a forall a b. (a -> b) -> a -> b
$! a -> b -> b
f a
b forall a b. (a -> b) -> a -> b
$! a -> b -> b
f a
c b
z
foldr' a -> b -> b
f b
z (Four a
a a
b a
c a
d) = a -> b -> b
f a
a forall a b. (a -> b) -> a -> b
$! a -> b -> b
f a
b forall a b. (a -> b) -> a -> b
$! a -> b -> b
f a
c forall a b. (a -> b) -> a -> b
$! a -> b -> b
f a
d b
z
{-# INLINE foldr' #-}
foldl' :: forall b a. (b -> a -> b) -> b -> Digit a -> b
foldl' b -> a -> b
f b
z (One a
a) = b -> a -> b
f b
z a
a
foldl' b -> a -> b
f b
z (Two a
a a
b) = (b -> a -> b
f forall a b. (a -> b) -> a -> b
$! b -> a -> b
f b
z a
a) a
b
foldl' b -> a -> b
f b
z (Three a
a a
b a
c) = (b -> a -> b
f forall a b. (a -> b) -> a -> b
$! (b -> a -> b
f forall a b. (a -> b) -> a -> b
$! b -> a -> b
f b
z a
a) a
b) a
c
foldl' b -> a -> b
f b
z (Four a
a a
b a
c a
d) = (b -> a -> b
f forall a b. (a -> b) -> a -> b
$! (b -> a -> b
f forall a b. (a -> b) -> a -> b
$! (b -> a -> b
f forall a b. (a -> b) -> a -> b
$! b -> a -> b
f b
z a
a) a
b) a
c) a
d
{-# INLINE foldl' #-}
foldr1 :: forall a. (a -> a -> a) -> Digit a -> a
foldr1 a -> a -> a
_ (One a
a) = a
a
foldr1 a -> a -> a
f (Two a
a a
b) = a
a a -> a -> a
`f` a
b
foldr1 a -> a -> a
f (Three a
a a
b a
c) = a
a a -> a -> a
`f` (a
b a -> a -> a
`f` a
c)
foldr1 a -> a -> a
f (Four a
a a
b a
c a
d) = a
a a -> a -> a
`f` (a
b a -> a -> a
`f` (a
c a -> a -> a
`f` a
d))
foldl1 :: forall a. (a -> a -> a) -> Digit a -> a
foldl1 a -> a -> a
_ (One a
a) = a
a
foldl1 a -> a -> a
f (Two a
a a
b) = a
a a -> a -> a
`f` a
b
foldl1 a -> a -> a
f (Three a
a a
b a
c) = (a
a a -> a -> a
`f` a
b) a -> a -> a
`f` a
c
foldl1 a -> a -> a
f (Four a
a a
b a
c 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 :: forall a b. (a -> b) -> Digit a -> Digit b
fmap a -> b
f (One a
a) = forall a. a -> Digit a
One (a -> b
f a
a)
fmap a -> b
f (Two a
a a
b) = forall a. a -> a -> Digit a
Two (a -> b
f a
a) (a -> b
f a
b)
fmap a -> b
f (Three a
a a
b a
c) = forall a. a -> a -> a -> Digit a
Three (a -> b
f a
a) (a -> b
f a
b) (a -> b
f a
c)
fmap a -> b
f (Four a
a a
b a
c a
d) = 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 :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Digit a -> f (Digit b)
traverse a -> f b
f (One a
a) = forall a. a -> Digit a
One forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
a
traverse a -> f b
f (Two a
a a
b) = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a. a -> a -> Digit a
Two (a -> f b
f a
a) (a -> f b
f a
b)
traverse a -> f b
f (Three a
a a
b a
c) = forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3 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 a -> f b
f (Four a
a a
b a
c a
d) = forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3 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) 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) = forall a. NFData a => a -> ()
rnf a
a
rnf (Two a
a a
b) = forall a. NFData a => a -> ()
rnf a
a seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf a
b
rnf (Three a
a a
b a
c) = forall a. NFData a => a -> ()
rnf a
a seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf a
b seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf a
c
rnf (Four a
a a
b a
c a
d) = forall a. NFData a => a -> ()
rnf a
a seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf a
b seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf a
c seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf a
d
instance Sized a => Sized (Digit a) where
{-# INLINE size #-}
size :: Digit a -> Int
size = forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 forall a. Num a => a -> a -> a
(+) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap 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 :: forall a. Sized a => Digit a -> FingerTree a
digitToTree (One a
a) = forall a. a -> FingerTree a
Single a
a
digitToTree (Two a
a a
b) = forall a.
Sized a =>
Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
deep (forall a. a -> Digit a
One a
a) forall a. FingerTree a
EmptyT (forall a. a -> Digit a
One a
b)
digitToTree (Three a
a a
b a
c) = forall a.
Sized a =>
Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
deep (forall a. a -> a -> Digit a
Two a
a a
b) forall a. FingerTree a
EmptyT (forall a. a -> Digit a
One a
c)
digitToTree (Four a
a a
b a
c a
d) = forall a.
Sized a =>
Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
deep (forall a. a -> a -> Digit a
Two a
a a
b) forall a. FingerTree a
EmptyT (forall a. a -> a -> Digit a
Two a
c a
d)
digitToTree' :: Int -> Digit a -> FingerTree a
digitToTree' :: forall a. Int -> Digit a -> FingerTree a
digitToTree' Int
n (Four a
a a
b a
c a
d) = forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
n (forall a. a -> a -> Digit a
Two a
a a
b) forall a. FingerTree a
EmptyT (forall a. a -> a -> Digit a
Two a
c a
d)
digitToTree' Int
n (Three a
a a
b a
c) = forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
n (forall a. a -> a -> Digit a
Two a
a a
b) forall a. FingerTree a
EmptyT (forall a. a -> Digit a
One a
c)
digitToTree' Int
n (Two a
a a
b) = forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
n (forall a. a -> Digit a
One a
a) forall a. FingerTree a
EmptyT (forall a. a -> Digit a
One a
b)
digitToTree' !Int
_n (One a
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 :: forall b a. (b -> b -> b) -> (a -> b) -> Node a -> b
foldNode b -> b -> b
(<+>) a -> b
f (Node2 Int
_ a
a a
b) = a -> b
f a
a b -> b -> b
<+> a -> b
f a
b
foldNode b -> b -> b
(<+>) a -> b
f (Node3 Int
_ a
a a
b 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 :: forall m a. Monoid m => (a -> m) -> Node a -> m
foldMap = forall b a. (b -> b -> b) -> (a -> b) -> Node a -> b
foldNode forall m. Monoid m => m -> m -> m
mappend
foldr :: forall a b. (a -> b -> b) -> b -> Node a -> b
foldr a -> b -> b
f b
z (Node2 Int
_ a
a a
b) = a
a a -> b -> b
`f` (a
b a -> b -> b
`f` b
z)
foldr a -> b -> b
f b
z (Node3 Int
_ a
a a
b 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 :: forall b a. (b -> a -> b) -> b -> Node a -> b
foldl b -> a -> b
f b
z (Node2 Int
_ a
a a
b) = (b
z b -> a -> b
`f` a
a) b -> a -> b
`f` a
b
foldl b -> a -> b
f b
z (Node3 Int
_ a
a a
b 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' :: forall a b. (a -> b -> b) -> b -> Node a -> b
foldr' a -> b -> b
f b
z (Node2 Int
_ a
a a
b) = a -> b -> b
f a
a forall a b. (a -> b) -> a -> b
$! a -> b -> b
f a
b b
z
foldr' a -> b -> b
f b
z (Node3 Int
_ a
a a
b a
c) = a -> b -> b
f a
a forall a b. (a -> b) -> a -> b
$! a -> b -> b
f a
b forall a b. (a -> b) -> a -> b
$! a -> b -> b
f a
c b
z
{-# INLINE foldr' #-}
foldl' :: forall b a. (b -> a -> b) -> b -> Node a -> b
foldl' b -> a -> b
f b
z (Node2 Int
_ a
a a
b) = (b -> a -> b
f forall a b. (a -> b) -> a -> b
$! b -> a -> b
f b
z a
a) a
b
foldl' b -> a -> b
f b
z (Node3 Int
_ a
a a
b a
c) = (b -> a -> b
f forall a b. (a -> b) -> a -> b
$! (b -> a -> b
f 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 :: forall a b. (a -> b) -> Node a -> Node b
fmap a -> b
f (Node2 Int
v a
a a
b) = forall a. Int -> a -> a -> Node a
Node2 Int
v (a -> b
f a
a) (a -> b
f a
b)
fmap a -> b
f (Node3 Int
v a
a a
b a
c) = 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 :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Node a -> f (Node b)
traverse a -> f b
f (Node2 Int
v a
a a
b) = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (forall a. Int -> a -> a -> Node a
Node2 Int
v) (a -> f b
f a
a) (a -> f b
f a
b)
traverse a -> f b
f (Node3 Int
v a
a a
b a
c) = forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3 (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 Int
_ a
a a
b) = forall a. NFData a => a -> ()
rnf a
a seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf a
b
rnf (Node3 Int
_ a
a a
b a
c) = forall a. NFData a => a -> ()
rnf a
a seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf a
b seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf a
c
instance Sized (Node a) where
size :: Node a -> Int
size (Node2 Int
v a
_ a
_) = Int
v
size (Node3 Int
v a
_ a
_ a
_) = Int
v
{-# INLINE node2 #-}
node2 :: Sized a => a -> a -> Node a
node2 :: forall a. Sized a => a -> a -> Node a
node2 a
a a
b = forall a. Int -> a -> a -> Node a
Node2 (forall a. Sized a => a -> Int
size a
a forall a. Num a => a -> a -> a
+ forall a. Sized a => a -> Int
size a
b) a
a a
b
{-# INLINE node3 #-}
node3 :: Sized a => a -> a -> a -> Node a
node3 :: forall a. Sized a => a -> a -> a -> Node a
node3 a
a a
b a
c = forall a. Int -> a -> a -> a -> Node a
Node3 (forall a. Sized a => a -> Int
size a
a forall a. Num a => a -> a -> a
+ forall a. Sized a => a -> Int
size a
b forall a. Num a => a -> a -> a
+ forall a. Sized a => a -> Int
size a
c) a
a a
b a
c
nodeToDigit :: Node a -> Digit a
nodeToDigit :: forall a. Node a -> Digit a
nodeToDigit (Node2 Int
_ a
a a
b) = forall a. a -> a -> Digit a
Two a
a a
b
nodeToDigit (Node3 Int
_ a
a a
b a
c) = forall a. a -> a -> a -> Digit a
Three a
a a
b a
c
newtype Elem a = Elem { forall a. 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 Elem a
_ = Int
1
instance Functor Elem where
#if __GLASGOW_HASKELL__ >= 708
fmap :: forall a b. (a -> b) -> Elem a -> Elem b
fmap = coerce :: forall a b. Coercible a b => a -> b
coerce
#else
fmap f (Elem x) = Elem (f x)
#endif
instance Foldable Elem where
foldr :: forall a b. (a -> b -> b) -> b -> Elem a -> b
foldr a -> b -> b
f b
z (Elem a
x) = a -> b -> b
f a
x b
z
#if __GLASGOW_HASKELL__ >= 708
foldMap :: forall m a. Monoid m => (a -> m) -> Elem a -> m
foldMap = coerce :: forall a b. Coercible a b => a -> b
coerce
foldl :: forall b a. (b -> a -> b) -> b -> Elem a -> b
foldl = coerce :: forall a b. Coercible a b => a -> b
coerce
foldl' :: forall b a. (b -> a -> b) -> b -> Elem a -> b
foldl' = coerce :: 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 :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Elem a -> f (Elem b)
traverse a -> f b
f (Elem a
x) = forall a. a -> Elem a
Elem 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 a
x) = 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 :: forall (f :: * -> *) a.
Applicative f =>
Int -> Int -> f a -> f (FingerTree a)
applicativeTree Int
n !Int
mSize f a
m = case Int
n of
Int
0 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. FingerTree a
EmptyT
Int
1 -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> FingerTree a
Single f a
m
Int
2 -> f (Digit a)
-> f (FingerTree (Node a)) -> f (Digit a) -> f (FingerTree a)
deepA f (Digit a)
one forall {a}. f (FingerTree a)
emptyTree f (Digit a)
one
Int
3 -> f (Digit a)
-> f (FingerTree (Node a)) -> f (Digit a) -> f (FingerTree a)
deepA f (Digit a)
two forall {a}. f (FingerTree a)
emptyTree f (Digit a)
one
Int
4 -> f (Digit a)
-> f (FingerTree (Node a)) -> f (Digit a) -> f (FingerTree a)
deepA f (Digit a)
two forall {a}. f (FingerTree a)
emptyTree f (Digit a)
two
Int
5 -> f (Digit a)
-> f (FingerTree (Node a)) -> f (Digit a) -> f (FingerTree a)
deepA f (Digit a)
three forall {a}. f (FingerTree a)
emptyTree f (Digit a)
two
Int
6 -> f (Digit a)
-> f (FingerTree (Node a)) -> f (Digit a) -> f (FingerTree a)
deepA f (Digit a)
three forall {a}. f (FingerTree a)
emptyTree f (Digit a)
three
Int
_ -> case Int
n forall a. Integral a => a -> a -> (a, a)
`quotRem` Int
3 of
(Int
q,Int
0) -> f (Digit a)
-> f (FingerTree (Node a)) -> f (Digit a) -> f (FingerTree a)
deepA f (Digit a)
three (forall (f :: * -> *) a.
Applicative f =>
Int -> Int -> f a -> f (FingerTree a)
applicativeTree (Int
q forall a. Num a => a -> a -> a
- Int
2) Int
mSize' f (Node a)
n3) f (Digit a)
three
(Int
q,Int
1) -> f (Digit a)
-> f (FingerTree (Node a)) -> f (Digit a) -> f (FingerTree a)
deepA f (Digit a)
two (forall (f :: * -> *) a.
Applicative f =>
Int -> Int -> f a -> f (FingerTree a)
applicativeTree (Int
q forall a. Num a => a -> a -> a
- Int
1) Int
mSize' f (Node a)
n3) f (Digit a)
two
(Int
q,Int
_) -> f (Digit a)
-> f (FingerTree (Node a)) -> f (Digit a) -> f (FingerTree a)
deepA f (Digit a)
three (forall (f :: * -> *) a.
Applicative f =>
Int -> Int -> f a -> f (FingerTree a)
applicativeTree (Int
q forall a. Num a => a -> a -> a
- Int
1) Int
mSize' f (Node a)
n3) f (Digit a)
two
where !mSize' :: Int
mSize' = Int
3 forall a. Num a => a -> a -> a
* Int
mSize
n3 :: f (Node a)
n3 = forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3 (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 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Digit a
One f a
m
two :: f (Digit a)
two = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a. a -> a -> Digit a
Two f a
m f a
m
three :: f (Digit a)
three = forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3 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 = forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3 (forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
n forall a. Num a => a -> a -> a
* Int
mSize))
emptyTree :: f (FingerTree a)
emptyTree = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. FingerTree a
EmptyT
data RCountMid a = RCountMid
!(Node a)
!Int
!(Node a)
beforeSeq :: Seq a -> Seq b -> Seq a
beforeSeq :: forall a b. Seq a -> Seq b -> Seq a
beforeSeq Seq a
xs Seq b
ys = forall a. Int -> Seq a -> Seq a
replicateEach (forall a. Seq a -> Int
length Seq b
ys) Seq a
xs
replicateEach :: Int -> Seq a -> Seq a
replicateEach :: forall a. Int -> Seq a -> Seq a
replicateEach Int
lenys Seq a
xs = case forall a. Seq a -> ViewL a
viewl Seq a
xs of
ViewL a
EmptyL -> forall a. Seq a
empty
a
firstx :< Seq a
xs' -> case forall a. Seq a -> ViewR a
viewr Seq a
xs' of
ViewR a
EmptyR -> forall a. Int -> a -> Seq a
replicate Int
lenys a
firstx
Seq FingerTree (Elem a)
midxs :> a
lastx -> case Int
lenys of
Int
0 -> forall a. Seq a
empty
Int
1 -> Seq a
xs
Int
2 ->
forall a. FingerTree (Elem a) -> Seq a
Seq forall a b. (a -> b) -> a -> b
$ forall a.
Elem a -> FingerTree (Elem a) -> Elem a -> FingerTree (Elem a)
rep2EachFT Elem a
fxE FingerTree (Elem a)
midxs Elem a
lxE
Int
3 ->
forall a. FingerTree (Elem a) -> Seq a
Seq forall a b. (a -> b) -> a -> b
$ forall a.
Elem a -> FingerTree (Elem a) -> Elem a -> FingerTree (Elem a)
rep3EachFT Elem a
fxE FingerTree (Elem a)
midxs Elem a
lxE
Int
_ -> forall a. FingerTree (Elem a) -> Seq a
Seq forall a b. (a -> b) -> a -> b
$ case Int
lenys forall a. Integral a => a -> a -> (a, a)
`quotRem` Int
3 of
(Int
q,Int
0) -> forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
lenys forall a. Num a => a -> a -> a
* forall a. Seq a -> Int
length Seq a
xs) Digit (Elem a)
fd3
((a -> (Node (Elem a), Node (Elem a), Node (Elem a)))
-> RCountMid (Elem a) -> FingerTree (Node (Elem a))
repEachMiddle_ forall {a}. a -> (Node (Elem a), Node (Elem a), Node (Elem a))
lift_elem (forall a. Node a -> Int -> Node a -> RCountMid a
RCountMid Node (Elem a)
fn3 (Int
q forall a. Num a => a -> a -> a
- Int
2) Node (Elem a)
ln3))
Digit (Elem a)
ld3
where
lift_elem :: a -> (Node (Elem a), Node (Elem a), Node (Elem a))
lift_elem a
a = let n3a :: Node (Elem a)
n3a = forall {a}. a -> Node (Elem a)
n3 a
a in (Node (Elem a)
n3a, Node (Elem a)
n3a, Node (Elem a)
n3a)
(Int
q,Int
1) -> forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
lenys forall a. Num a => a -> a -> a
* forall a. Seq a -> Int
length Seq a
xs) Digit (Elem a)
fd2
((a -> (Node (Elem a), Node (Elem a), Node (Elem a)))
-> RCountMid (Elem a) -> FingerTree (Node (Elem a))
repEachMiddle_ forall {a}. a -> (Node (Elem a), Node (Elem a), Node (Elem a))
lift_elem (forall a. Node a -> Int -> Node a -> RCountMid a
RCountMid Node (Elem a)
fn2 (Int
q forall a. Num a => a -> a -> a
- Int
1) Node (Elem a)
ln2))
Digit (Elem a)
ld2
where
lift_elem :: a -> (Node (Elem a), Node (Elem a), Node (Elem a))
lift_elem a
a = let n2a :: Node (Elem a)
n2a = forall {a}. a -> Node (Elem a)
n2 a
a in (Node (Elem a)
n2a, forall {a}. a -> Node (Elem a)
n3 a
a, Node (Elem a)
n2a)
(Int
q,Int
_) -> forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
lenys forall a. Num a => a -> a -> a
* forall a. Seq a -> Int
length Seq a
xs) Digit (Elem a)
fd3
((a -> (Node (Elem a), Node (Elem a), Node (Elem a)))
-> RCountMid (Elem a) -> FingerTree (Node (Elem a))
repEachMiddle_ forall {a}. a -> (Node (Elem a), Node (Elem a), Node (Elem a))
lift_elem (forall a. Node a -> Int -> Node a -> RCountMid a
RCountMid Node (Elem a)
fn2 (Int
q forall a. Num a => a -> a -> a
- Int
1) Node (Elem a)
ln3))
Digit (Elem a)
ld2
where
lift_elem :: a -> (Node (Elem a), Node (Elem a), Node (Elem a))
lift_elem a
a = let n3a :: Node (Elem a)
n3a = forall {a}. a -> Node (Elem a)
n3 a
a in (Node (Elem a)
n3a, Node (Elem a)
n3a, forall {a}. a -> Node (Elem a)
n2 a
a)
where
repEachMiddle_ :: (a -> (Node (Elem a), Node (Elem a), Node (Elem a)))
-> RCountMid (Elem a) -> FingerTree (Node (Elem a))
repEachMiddle_ = forall a c.
FingerTree (Elem a)
-> Int
-> Int
-> Node c
-> Node c
-> (a -> (Node c, Node c, Node c))
-> RCountMid c
-> FingerTree (Node c)
repEachMiddle FingerTree (Elem a)
midxs Int
lenys Int
3 Node (Elem a)
fn3 Node (Elem a)
ln3
fd2 :: Digit (Elem a)
fd2 = forall a. a -> a -> Digit a
Two Elem a
fxE Elem a
fxE
fd3 :: Digit (Elem a)
fd3 = forall a. a -> a -> a -> Digit a
Three Elem a
fxE Elem a
fxE Elem a
fxE
ld2 :: Digit (Elem a)
ld2 = forall a. a -> a -> Digit a
Two Elem a
lxE Elem a
lxE
ld3 :: Digit (Elem a)
ld3 = forall a. a -> a -> a -> Digit a
Three Elem a
lxE Elem a
lxE Elem a
lxE
fn2 :: Node (Elem a)
fn2 = forall a. Int -> a -> a -> Node a
Node2 Int
2 Elem a
fxE Elem a
fxE
fn3 :: Node (Elem a)
fn3 = forall a. Int -> a -> a -> a -> Node a
Node3 Int
3 Elem a
fxE Elem a
fxE Elem a
fxE
ln2 :: Node (Elem a)
ln2 = forall a. Int -> a -> a -> Node a
Node2 Int
2 Elem a
lxE Elem a
lxE
ln3 :: Node (Elem a)
ln3 = forall a. Int -> a -> a -> a -> Node a
Node3 Int
3 Elem a
lxE Elem a
lxE Elem a
lxE
n3 :: a -> Node (Elem a)
n3 a
a = forall a. Int -> a -> a -> a -> Node a
Node3 Int
3 (forall a. a -> Elem a
Elem a
a) (forall a. a -> Elem a
Elem a
a) (forall a. a -> Elem a
Elem a
a)
n2 :: a -> Node (Elem a)
n2 a
a = forall a. Int -> a -> a -> Node a
Node2 Int
2 (forall a. a -> Elem a
Elem a
a) (forall a. a -> Elem a
Elem a
a)
where
fxE :: Elem a
fxE = forall a. a -> Elem a
Elem a
firstx
lxE :: Elem a
lxE = forall a. a -> Elem a
Elem a
lastx
rep2EachFT :: Elem a -> FingerTree (Elem a) -> Elem a -> FingerTree (Elem a)
rep2EachFT :: forall a.
Elem a -> FingerTree (Elem a) -> Elem a -> FingerTree (Elem a)
rep2EachFT Elem a
firstx FingerTree (Elem a)
xs Elem a
lastx =
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (forall a. Sized a => a -> Int
size FingerTree (Elem a)
xs forall a. Num a => a -> a -> a
* Int
2 forall a. Num a => a -> a -> a
+ Int
4)
(forall a. a -> a -> Digit a
Two Elem a
firstx Elem a
firstx)
(forall a b. Int -> (a -> b) -> FingerTree a -> FingerTree b
mapMulFT Int
2 (\Elem a
ex -> forall a. Int -> a -> a -> Node a
Node2 Int
2 Elem a
ex Elem a
ex) FingerTree (Elem a)
xs)
(forall a. a -> a -> Digit a
Two Elem a
lastx Elem a
lastx)
rep3EachFT :: Elem a -> FingerTree (Elem a) -> Elem a -> FingerTree (Elem a)
rep3EachFT :: forall a.
Elem a -> FingerTree (Elem a) -> Elem a -> FingerTree (Elem a)
rep3EachFT Elem a
firstx FingerTree (Elem a)
xs Elem a
lastx =
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (forall a. Sized a => a -> Int
size FingerTree (Elem a)
xs forall a. Num a => a -> a -> a
* Int
3 forall a. Num a => a -> a -> a
+ Int
6)
(forall a. a -> a -> a -> Digit a
Three Elem a
firstx Elem a
firstx Elem a
firstx)
(forall a b. Int -> (a -> b) -> FingerTree a -> FingerTree b
mapMulFT Int
3 (\Elem a
ex -> forall a. Int -> a -> a -> a -> Node a
Node3 Int
3 Elem a
ex Elem a
ex Elem a
ex) FingerTree (Elem a)
xs)
(forall a. a -> a -> a -> Digit a
Three Elem a
lastx Elem a
lastx Elem a
lastx)
repEachMiddle
:: FingerTree (Elem a)
-> Int
-> Int
-> Node c
-> Node c
-> (a -> (Node c, Node c, Node c))
-> RCountMid c
-> FingerTree (Node c)
repEachMiddle :: forall a c.
FingerTree (Elem a)
-> Int
-> Int
-> Node c
-> Node c
-> (a -> (Node c, Node c, Node c))
-> RCountMid c
-> FingerTree (Node c)
repEachMiddle FingerTree (Elem a)
midxs Int
lenys
!Int
_sizec
Node c
_firstx
Node c
_lastx
a -> (Node c, Node c, Node c)
fill23
(RCountMid Node c
pr Int
0 Node c
sf)
= forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
lenys forall a. Num a => a -> a -> a
* (forall a. Sized a => a -> Int
size FingerTree (Elem a)
midxs forall a. Num a => a -> a -> a
+ Int
1))
(forall a. a -> Digit a
One Node c
pr)
(forall a b. Int -> (a -> b) -> FingerTree a -> FingerTree b
mapMulFT Int
lenys Elem a -> Node (Node c)
fill23_final FingerTree (Elem a)
midxs)
(forall a. a -> Digit a
One Node c
sf)
where
fill23_final :: Elem a -> Node (Node c)
fill23_final (Elem a
a) = case a -> (Node c, Node c, Node c)
fill23 a
a of
~(Node c
lft, Node c
_fill, Node c
rght) -> forall a. Int -> a -> a -> Node a
Node2 (forall a. Sized a => a -> Int
size Node c
pr forall a. Num a => a -> a -> a
+ forall a. Sized a => a -> Int
size Node c
sf) Node c
lft Node c
rght
repEachMiddle FingerTree (Elem a)
midxs Int
lenys
!Int
sizec
Node c
firstx
Node c
lastx
a -> (Node c, Node c, Node c)
fill23
(RCountMid Node c
pr Int
1 Node c
sf)
= forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
sizec forall a. Num a => a -> a -> a
+ Int
lenys forall a. Num a => a -> a -> a
* (forall a. Sized a => a -> Int
size FingerTree (Elem a)
midxs forall a. Num a => a -> a -> a
+ Int
1))
(forall a. a -> a -> Digit a
Two Node c
pr Node c
firstx)
(forall a b. Int -> (a -> b) -> FingerTree a -> FingerTree b
mapMulFT Int
lenys Elem a -> Node (Node c)
fill23_final FingerTree (Elem a)
midxs)
(forall a. a -> a -> Digit a
Two Node c
lastx Node c
sf)
where
fill23_final :: Elem a -> Node (Node c)
fill23_final (Elem a
a) = case a -> (Node c, Node c, Node c)
fill23 a
a of
~(Node c
lft, Node c
fill, Node c
rght) -> forall a. Int -> a -> a -> a -> Node a
Node3 (forall a. Sized a => a -> Int
size Node c
pr forall a. Num a => a -> a -> a
+ forall a. Sized a => a -> Int
size Node c
sf forall a. Num a => a -> a -> a
+ Int
sizec) Node c
lft Node c
fill Node c
rght
repEachMiddle FingerTree (Elem a)
midxs Int
lenys
!Int
sizec
Node c
firstx
Node c
lastx
a -> (Node c, Node c, Node c)
fill23
(RCountMid Node c
pr Int
deep_count Node c
sf)
= case Int
deep_count forall a. Integral a => a -> a -> (a, a)
`quotRem` Int
3 of
(Int
q,Int
0)
-> Digit (Node c)
-> FingerTree (Node (Node c))
-> Digit (Node c)
-> FingerTree (Node c)
deep'
(forall a. a -> a -> Digit a
Two Node c
firstx Node c
firstx)
((a -> (Node (Node c), Node (Node c), Node (Node c)))
-> RCountMid (Node c) -> FingerTree (Node (Node c))
repEachMiddle_
(forall a b.
TwoOrThree
-> TwoOrThree -> (a -> (b, b, b)) -> a -> (Node b, Node b, Node b)
lift_fill23 TwoOrThree
TOT3 TwoOrThree
TOT2 a -> (Node c, Node c, Node c)
fill23)
(forall a. Node a -> Int -> Node a -> RCountMid a
RCountMid Node (Node c)
pr' (Int
q forall a. Num a => a -> a -> a
- Int
1) Node (Node c)
sf'))
(forall a. a -> Digit a
One Node c
lastx)
where
pr' :: Node (Node c)
pr' = forall a. Sized a => a -> a -> Node a
node2 Node c
firstx Node c
pr
sf' :: Node (Node c)
sf' = forall a. Sized a => a -> a -> a -> Node a
node3 Node c
lastx Node c
lastx Node c
sf
(Int
q,Int
1)
-> Digit (Node c)
-> FingerTree (Node (Node c))
-> Digit (Node c)
-> FingerTree (Node c)
deep'
(forall a. a -> a -> Digit a
Two Node c
firstx Node c
firstx)
((a -> (Node (Node c), Node (Node c), Node (Node c)))
-> RCountMid (Node c) -> FingerTree (Node (Node c))
repEachMiddle_
(forall a b.
TwoOrThree
-> TwoOrThree -> (a -> (b, b, b)) -> a -> (Node b, Node b, Node b)
lift_fill23 TwoOrThree
TOT3 TwoOrThree
TOT3 a -> (Node c, Node c, Node c)
fill23)
(forall a. Node a -> Int -> Node a -> RCountMid a
RCountMid Node (Node c)
pr' (Int
q forall a. Num a => a -> a -> a
- Int
1) Node (Node c)
sf'))
(forall a. a -> a -> Digit a
Two Node c
lastx Node c
lastx)
where
pr' :: Node (Node c)
pr' = forall a. Sized a => a -> a -> a -> Node a
node3 Node c
firstx Node c
firstx Node c
pr
sf' :: Node (Node c)
sf' = forall a. Sized a => a -> a -> a -> Node a
node3 Node c
lastx Node c
lastx Node c
sf
(Int
q,Int
_)
-> Digit (Node c)
-> FingerTree (Node (Node c))
-> Digit (Node c)
-> FingerTree (Node c)
deep'
(forall a. a -> Digit a
One Node c
firstx)
((a -> (Node (Node c), Node (Node c), Node (Node c)))
-> RCountMid (Node c) -> FingerTree (Node (Node c))
repEachMiddle_
(forall a b.
TwoOrThree
-> TwoOrThree -> (a -> (b, b, b)) -> a -> (Node b, Node b, Node b)
lift_fill23 TwoOrThree
TOT2 TwoOrThree
TOT2 a -> (Node c, Node c, Node c)
fill23)
(forall a. Node a -> Int -> Node a -> RCountMid a
RCountMid Node (Node c)
pr' Int
q Node (Node c)
sf'))
(forall a. a -> Digit a
One Node c
lastx)
where
pr' :: Node (Node c)
pr' = forall a. Sized a => a -> a -> Node a
node2 Node c
firstx Node c
pr
sf' :: Node (Node c)
sf' = forall a. Sized a => a -> a -> Node a
node2 Node c
lastx Node c
sf
where
deep' :: Digit (Node c)
-> FingerTree (Node (Node c))
-> Digit (Node c)
-> FingerTree (Node c)
deep' = forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
deep_count forall a. Num a => a -> a -> a
* Int
sizec forall a. Num a => a -> a -> a
+ Int
lenys forall a. Num a => a -> a -> a
* (forall a. Sized a => a -> Int
size FingerTree (Elem a)
midxs forall a. Num a => a -> a -> a
+ Int
1))
repEachMiddle_ :: (a -> (Node (Node c), Node (Node c), Node (Node c)))
-> RCountMid (Node c) -> FingerTree (Node (Node c))
repEachMiddle_ = forall a c.
FingerTree (Elem a)
-> Int
-> Int
-> Node c
-> Node c
-> (a -> (Node c, Node c, Node c))
-> RCountMid c
-> FingerTree (Node c)
repEachMiddle FingerTree (Elem a)
midxs Int
lenys Int
sizec' Node (Node c)
fn3 Node (Node c)
ln3
sizec' :: Int
sizec' = Int
3 forall a. Num a => a -> a -> a
* Int
sizec
fn3 :: Node (Node c)
fn3 = forall a. Int -> a -> a -> a -> Node a
Node3 Int
sizec' Node c
firstx Node c
firstx Node c
firstx
ln3 :: Node (Node c)
ln3 = forall a. Int -> a -> a -> a -> Node a
Node3 Int
sizec' Node c
lastx Node c
lastx Node c
lastx
spr :: Int
spr = forall a. Sized a => a -> Int
size Node c
pr
ssf :: Int
ssf = forall a. Sized a => a -> Int
size Node c
sf
lift_fill23
:: TwoOrThree
-> TwoOrThree
-> (a -> (b, b, b))
-> a -> (Node b, Node b, Node b)
lift_fill23 :: forall a b.
TwoOrThree
-> TwoOrThree -> (a -> (b, b, b)) -> a -> (Node b, Node b, Node b)
lift_fill23 !TwoOrThree
tl !TwoOrThree
tr a -> (b, b, b)
f a
a = (Node b
lft', Node b
fill', Node b
rght')
where
!(b
lft, b
fill, b
rght) = a -> (b, b, b)
f a
a
!fill' :: Node b
fill' = forall a. Int -> a -> a -> a -> Node a
Node3 (Int
3 forall a. Num a => a -> a -> a
* Int
sizec) b
fill b
fill b
fill
!lft' :: Node b
lft' = case TwoOrThree
tl of
TwoOrThree
TOT2 -> forall a. Int -> a -> a -> Node a
Node2 (Int
ssf forall a. Num a => a -> a -> a
+ Int
sizec) b
lft b
fill
TwoOrThree
TOT3 -> forall a. Int -> a -> a -> a -> Node a
Node3 (Int
ssf forall a. Num a => a -> a -> a
+ Int
2 forall a. Num a => a -> a -> a
* Int
sizec) b
lft b
fill b
fill
!rght' :: Node b
rght' = case TwoOrThree
tr of
TwoOrThree
TOT2 -> forall a. Int -> a -> a -> Node a
Node2 (Int
spr forall a. Num a => a -> a -> a
+ Int
sizec) b
rght b
fill
TwoOrThree
TOT3 -> forall a. Int -> a -> a -> a -> Node a
Node3 (Int
spr forall a. Num a => a -> a -> a
+ Int
2 forall a. Num a => a -> a -> a
* Int
sizec) b
rght b
fill b
fill
data TwoOrThree = TOT2 | TOT3
empty :: Seq a
empty :: forall a. Seq a
empty = forall a. FingerTree (Elem a) -> Seq a
Seq forall a. FingerTree a
EmptyT
singleton :: a -> Seq a
singleton :: forall a. a -> Seq a
singleton a
x = forall a. FingerTree (Elem a) -> Seq a
Seq (forall a. a -> FingerTree a
Single (forall a. a -> Elem a
Elem a
x))
replicate :: Int -> a -> Seq a
replicate :: forall a. Int -> a -> Seq a
replicate Int
n a
x
| Int
n forall a. Ord a => a -> a -> Bool
>= Int
0 = forall a. Identity a -> a
runIdentity (forall (f :: * -> *) a. Applicative f => Int -> f a -> f (Seq a)
replicateA Int
n (forall a. a -> Identity a
Identity a
x))
| Bool
otherwise = forall a. HasCallStack => [Char] -> a
error [Char]
"replicate takes a nonnegative integer argument"
replicateA :: Applicative f => Int -> f a -> f (Seq a)
replicateA :: forall (f :: * -> *) a. Applicative f => Int -> f a -> f (Seq a)
replicateA Int
n f a
x
| Int
n forall a. Ord a => a -> a -> Bool
>= Int
0 = forall a. FingerTree (Elem a) -> Seq a
Seq forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a.
Applicative f =>
Int -> Int -> f a -> f (FingerTree a)
applicativeTree Int
n Int
1 (forall a. a -> Elem a
Elem forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f a
x)
| Bool
otherwise = forall a. HasCallStack => [Char] -> a
error [Char]
"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 :: forall (f :: * -> *) a. Applicative f => Int -> f a -> f (Seq a)
replicateM = 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 :: forall a. Int -> Seq a -> Seq a
cycleTaking Int
n !Seq a
_xs | Int
n forall a. Ord a => a -> a -> Bool
<= Int
0 = forall a. Seq a
empty
cycleTaking Int
_n Seq a
xs | forall a. Seq a -> Bool
null Seq a
xs = forall a. HasCallStack => [Char] -> a
error [Char]
"cycleTaking cannot take a positive number of elements from an empty cycle."
cycleTaking Int
n Seq a
xs = forall a. Int -> Seq a -> Seq a
cycleNTimes Int
reps Seq a
xs forall a. Seq a -> Seq a -> Seq a
>< forall a. Int -> Seq a -> Seq a
take Int
final Seq a
xs
where
(Int
reps, Int
final) = Int
n forall a. Integral a => a -> a -> (a, a)
`quotRem` forall a. Seq a -> Int
length Seq a
xs
cycleNTimes :: Int -> Seq a -> Seq a
cycleNTimes :: forall a. Int -> Seq a -> Seq a
cycleNTimes Int
n !Seq a
xs
| Int
n forall a. Ord a => a -> a -> Bool
<= Int
0 = forall a. Seq a
empty
| Int
n forall a. Eq a => a -> a -> Bool
== Int
1 = Seq a
xs
cycleNTimes Int
n (Seq FingerTree (Elem a)
xsFT) = case forall a. FingerTree (Elem a) -> Rigidified (Elem a)
rigidify FingerTree (Elem a)
xsFT of
Rigidified (Elem a)
RigidEmpty -> forall a. Seq a
empty
RigidOne (Elem a
x) -> forall a. Int -> a -> Seq a
replicate Int
n a
x
RigidTwo Elem a
x1 Elem a
x2 -> forall a. FingerTree (Elem a) -> Seq a
Seq forall a b. (a -> b) -> a -> b
$
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
nforall a. Num a => a -> a -> a
*Int
2) Digit (Elem a)
pair
(forall a. Identity a -> a
runIdentity forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a.
Applicative f =>
Int -> Int -> f a -> f (FingerTree a)
applicativeTree (Int
nforall a. Num a => a -> a -> a
-Int
2) Int
2 (forall a. a -> Identity a
Identity (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 = forall a. a -> a -> Digit a
Two Elem a
x1 Elem a
x2
RigidThree Elem a
x1 Elem a
x2 Elem a
x3 -> forall a. FingerTree (Elem a) -> Seq a
Seq forall a b. (a -> b) -> a -> b
$
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
nforall a. Num a => a -> a -> a
*Int
3) Digit (Elem a)
triple
(forall a. Identity a -> a
runIdentity forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a.
Applicative f =>
Int -> Int -> f a -> f (FingerTree a)
applicativeTree (Int
nforall a. Num a => a -> a -> a
-Int
2) Int
3 (forall a. a -> Identity a
Identity (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 = forall a. a -> a -> a -> Digit a
Three Elem a
x1 Elem a
x2 Elem a
x3
RigidFull r :: Rigid (Elem a)
r@(Rigid Int
s Node (Elem a)
pr Thin (Node (Elem a))
_m Node (Elem a)
sf) -> forall a. FingerTree (Elem a) -> Seq a
Seq forall a b. (a -> b) -> a -> b
$
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
nforall a. Num a => a -> a -> a
*Int
s)
(forall a. Node a -> Digit a
nodeToDigit Node (Elem a)
pr)
(forall c. Int -> Rigid c -> FingerTree (Node c)
cycleNMiddle (Int
nforall a. Num a => a -> a -> a
-Int
2) Rigid (Elem a)
r)
(forall a. Node a -> Digit a
nodeToDigit Node (Elem a)
sf)
cycleNMiddle
:: Int
-> Rigid c
-> FingerTree (Node c)
cycleNMiddle :: forall c. Int -> Rigid c -> FingerTree (Node c)
cycleNMiddle !Int
n
(Rigid Int
s Digit23 c
pr (DeepTh Int
sm Digit12 (Digit23 c)
prm Thin (Node (Digit23 c))
mm Digit12 (Digit23 c)
sfm) Digit23 c
sf)
= forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
sm forall a. Num a => a -> a -> a
+ Int
s forall a. Num a => a -> a -> a
* (Int
n forall a. Num a => a -> a -> a
+ Int
1))
(forall a. Digit12 a -> Digit a
digit12ToDigit Digit12 (Digit23 c)
prm)
(forall c. Int -> Rigid c -> FingerTree (Node c)
cycleNMiddle Int
n
(forall a.
Int -> Digit23 a -> Thin (Digit23 a) -> Digit23 a -> Rigid a
Rigid Int
s (forall a. Digit23 a -> Digit12 (Digit23 a) -> Digit23 (Digit23 a)
squashL Digit23 c
pr Digit12 (Digit23 c)
prm) Thin (Node (Digit23 c))
mm (forall a. Digit12 (Node a) -> Node a -> Digit23 (Node a)
squashR Digit12 (Digit23 c)
sfm Digit23 c
sf)))
(forall a. Digit12 a -> Digit a
digit12ToDigit Digit12 (Digit23 c)
sfm)
cycleNMiddle Int
n
(Rigid Int
s Digit23 c
pr Thin (Digit23 c)
EmptyTh Digit23 c
sf)
= forall a.
Sized a =>
Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
deep
(forall a. a -> Digit a
One Digit23 c
sf)
(forall a. Identity a -> a
runIdentity forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a.
Applicative f =>
Int -> Int -> f a -> f (FingerTree a)
applicativeTree Int
n Int
s (forall a. a -> Identity a
Identity Node (Digit23 c)
converted))
(forall a. a -> Digit a
One Digit23 c
pr)
where converted :: Node (Digit23 c)
converted = forall a. Sized a => a -> a -> Node a
node2 Digit23 c
pr Digit23 c
sf
cycleNMiddle Int
n
(Rigid Int
s Digit23 c
pr (SingleTh Digit23 c
q) Digit23 c
sf)
= forall a.
Sized a =>
Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
deep
(forall a. a -> a -> Digit a
Two Digit23 c
q Digit23 c
sf)
(forall a. Identity a -> a
runIdentity forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a.
Applicative f =>
Int -> Int -> f a -> f (FingerTree a)
applicativeTree Int
n Int
s (forall a. a -> Identity a
Identity Node (Digit23 c)
converted))
(forall a. a -> a -> Digit a
Two Digit23 c
pr Digit23 c
q)
where converted :: Node (Digit23 c)
converted = forall a. Sized a => a -> a -> a -> Node a
node3 Digit23 c
pr Digit23 c
q Digit23 c
sf
(<|) :: a -> Seq a -> Seq a
a
x <| :: forall a. a -> Seq a -> Seq a
<| Seq FingerTree (Elem a)
xs = forall a. FingerTree (Elem a) -> Seq a
Seq (forall a. a -> Elem a
Elem a
x 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 :: forall a. Sized a => a -> FingerTree a -> FingerTree a
consTree a
a FingerTree a
EmptyT = forall a. a -> FingerTree a
Single a
a
consTree a
a (Single a
b) = forall a.
Sized a =>
Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
deep (forall a. a -> Digit a
One a
a) forall a. FingerTree a
EmptyT (forall a. a -> Digit a
One a
b)
consTree a
a (Deep Int
s (Four a
b a
c a
d a
e) FingerTree (Node a)
m Digit a
sf) = FingerTree (Node a)
m seq :: forall a b. a -> b -> b
`seq`
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (forall a. Sized a => a -> Int
size a
a forall a. Num a => a -> a -> a
+ Int
s) (forall a. a -> a -> Digit a
Two a
a a
b) (forall a. Sized a => a -> a -> a -> Node a
node3 a
c a
d a
e forall a. Sized a => a -> FingerTree a -> FingerTree a
`consTree` FingerTree (Node a)
m) Digit a
sf
consTree a
a (Deep Int
s (Three a
b a
c a
d) FingerTree (Node a)
m Digit a
sf) =
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (forall a. Sized a => a -> Int
size a
a forall a. Num a => a -> a -> a
+ Int
s) (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 (Deep Int
s (Two a
b a
c) FingerTree (Node a)
m Digit a
sf) =
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (forall a. Sized a => a -> Int
size a
a forall a. Num a => a -> a -> a
+ Int
s) (forall a. a -> a -> a -> Digit a
Three a
a a
b a
c) FingerTree (Node a)
m Digit a
sf
consTree a
a (Deep Int
s (One a
b) FingerTree (Node a)
m Digit a
sf) =
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (forall a. Sized a => a -> Int
size a
a forall a. Num a => a -> a -> a
+ Int
s) (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' :: forall a. a -> Seq a -> Seq a
cons' a
x (Seq FingerTree (Elem a)
xs) = forall a. FingerTree (Elem a) -> Seq a
Seq (forall a. a -> Elem a
Elem a
x forall a. Sized a => a -> FingerTree a -> FingerTree a
`consTree'` FingerTree (Elem a)
xs)
snoc' :: Seq a -> a -> Seq a
snoc' :: forall a. Seq a -> a -> Seq a
snoc' (Seq FingerTree (Elem a)
xs) a
x = forall a. FingerTree (Elem a) -> Seq a
Seq (FingerTree (Elem a)
xs forall a. Sized a => FingerTree a -> a -> FingerTree a
`snocTree'` 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' :: forall a. Sized a => a -> FingerTree a -> FingerTree a
consTree' a
a FingerTree a
EmptyT = forall a. a -> FingerTree a
Single a
a
consTree' a
a (Single a
b) = forall a.
Sized a =>
Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
deep (forall a. a -> Digit a
One a
a) forall a. FingerTree a
EmptyT (forall a. a -> Digit a
One a
b)
consTree' a
a (Deep Int
s (Four a
b a
c a
d a
e) FingerTree (Node a)
m Digit a
sf) =
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (forall a. Sized a => a -> Int
size a
a forall a. Num a => a -> a -> a
+ Int
s) (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 forall a. Sized a => a -> FingerTree a -> FingerTree a
`consTree'` FingerTree (Node a)
m
!abc :: Node a
abc = forall a. Sized a => a -> a -> a -> Node a
node3 a
c a
d a
e
consTree' a
a (Deep Int
s (Three a
b a
c a
d) FingerTree (Node a)
m Digit a
sf) =
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (forall a. Sized a => a -> Int
size a
a forall a. Num a => a -> a -> a
+ Int
s) (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 (Deep Int
s (Two a
b a
c) FingerTree (Node a)
m Digit a
sf) =
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (forall a. Sized a => a -> Int
size a
a forall a. Num a => a -> a -> a
+ Int
s) (forall a. a -> a -> a -> Digit a
Three a
a a
b a
c) FingerTree (Node a)
m Digit a
sf
consTree' a
a (Deep Int
s (One a
b) FingerTree (Node a)
m Digit a
sf) =
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (forall a. Sized a => a -> Int
size a
a forall a. Num a => a -> a -> a
+ Int
s) (forall a. a -> a -> Digit a
Two a
a a
b) FingerTree (Node a)
m Digit a
sf
(|>) :: Seq a -> a -> Seq a
Seq FingerTree (Elem a)
xs |> :: forall a. Seq a -> a -> Seq a
|> a
x = forall a. FingerTree (Elem a) -> Seq a
Seq (FingerTree (Elem a)
xs forall a. Sized a => FingerTree a -> a -> FingerTree a
`snocTree` 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 :: forall a. Sized a => FingerTree a -> a -> FingerTree a
snocTree FingerTree a
EmptyT a
a = forall a. a -> FingerTree a
Single a
a
snocTree (Single a
a) a
b = forall a.
Sized a =>
Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
deep (forall a. a -> Digit a
One a
a) forall a. FingerTree a
EmptyT (forall a. a -> Digit a
One a
b)
snocTree (Deep Int
s Digit a
pr FingerTree (Node a)
m (Four a
a a
b a
c a
d)) a
e = FingerTree (Node a)
m seq :: forall a b. a -> b -> b
`seq`
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s forall a. Num a => a -> a -> a
+ forall a. Sized a => a -> Int
size a
e) Digit a
pr (FingerTree (Node a)
m forall a. Sized a => FingerTree a -> a -> FingerTree a
`snocTree` forall a. Sized a => a -> a -> a -> Node a
node3 a
a a
b a
c) (forall a. a -> a -> Digit a
Two a
d a
e)
snocTree (Deep Int
s Digit a
pr FingerTree (Node a)
m (Three a
a a
b a
c)) a
d =
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s forall a. Num a => a -> a -> a
+ forall a. Sized a => a -> Int
size a
d) Digit a
pr FingerTree (Node a)
m (forall a. a -> a -> a -> a -> Digit a
Four a
a a
b a
c a
d)
snocTree (Deep Int
s Digit a
pr FingerTree (Node a)
m (Two a
a a
b)) a
c =
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s forall a. Num a => a -> a -> a
+ forall a. Sized a => a -> Int
size a
c) Digit a
pr FingerTree (Node a)
m (forall a. a -> a -> a -> Digit a
Three a
a a
b a
c)
snocTree (Deep Int
s Digit a
pr FingerTree (Node a)
m (One a
a)) a
b =
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s forall a. Num a => a -> a -> a
+ forall a. Sized a => a -> Int
size a
b) Digit a
pr FingerTree (Node a)
m (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' :: forall a. Sized a => FingerTree a -> a -> FingerTree a
snocTree' FingerTree a
EmptyT a
a = forall a. a -> FingerTree a
Single a
a
snocTree' (Single a
a) a
b = forall a.
Sized a =>
Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
deep (forall a. a -> Digit a
One a
a) forall a. FingerTree a
EmptyT (forall a. a -> Digit a
One a
b)
snocTree' (Deep Int
s Digit a
pr FingerTree (Node a)
m (Four a
a a
b a
c a
d)) a
e =
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s forall a. Num a => a -> a -> a
+ forall a. Sized a => a -> Int
size a
e) Digit a
pr FingerTree (Node a)
m' (forall a. a -> a -> Digit a
Two a
d a
e)
where !m' :: FingerTree (Node a)
m' = FingerTree (Node a)
m forall a. Sized a => FingerTree a -> a -> FingerTree a
`snocTree'` Node a
abc
!abc :: Node a
abc = forall a. Sized a => a -> a -> a -> Node a
node3 a
a a
b a
c
snocTree' (Deep Int
s Digit a
pr FingerTree (Node a)
m (Three a
a a
b a
c)) a
d =
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s forall a. Num a => a -> a -> a
+ forall a. Sized a => a -> Int
size a
d) Digit a
pr FingerTree (Node a)
m (forall a. a -> a -> a -> a -> Digit a
Four a
a a
b a
c a
d)
snocTree' (Deep Int
s Digit a
pr FingerTree (Node a)
m (Two a
a a
b)) a
c =
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s forall a. Num a => a -> a -> a
+ forall a. Sized a => a -> Int
size a
c) Digit a
pr FingerTree (Node a)
m (forall a. a -> a -> a -> Digit a
Three a
a a
b a
c)
snocTree' (Deep Int
s Digit a
pr FingerTree (Node a)
m (One a
a)) a
b =
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s forall a. Num a => a -> a -> a
+ forall a. Sized a => a -> Int
size a
b) Digit a
pr FingerTree (Node a)
m (forall a. a -> a -> Digit a
Two a
a a
b)
(><) :: Seq a -> Seq a -> Seq a
Seq FingerTree (Elem a)
xs >< :: forall a. Seq a -> Seq a -> Seq a
>< Seq FingerTree (Elem a)
ys = forall a. FingerTree (Elem a) -> Seq a
Seq (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 :: forall a.
FingerTree (Elem a) -> FingerTree (Elem a) -> FingerTree (Elem a)
appendTree0 FingerTree (Elem a)
EmptyT FingerTree (Elem a)
xs =
FingerTree (Elem a)
xs
appendTree0 FingerTree (Elem a)
xs FingerTree (Elem a)
EmptyT =
FingerTree (Elem a)
xs
appendTree0 (Single Elem a
x) FingerTree (Elem a)
xs =
Elem a
x forall a. Sized a => a -> FingerTree a -> FingerTree a
`consTree` FingerTree (Elem a)
xs
appendTree0 FingerTree (Elem a)
xs (Single Elem a
x) =
FingerTree (Elem a)
xs forall a. Sized a => FingerTree a -> a -> FingerTree a
`snocTree` Elem a
x
appendTree0 (Deep Int
s1 Digit (Elem a)
pr1 FingerTree (Node (Elem a))
m1 Digit (Elem a)
sf1) (Deep Int
s2 Digit (Elem a)
pr2 FingerTree (Node (Elem a))
m2 Digit (Elem a)
sf2) =
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s1 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 = 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 :: 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 (One Elem a
a) (One Elem a
b) FingerTree (Node (Elem a))
m2 =
forall a.
FingerTree (Node a)
-> Node a -> FingerTree (Node a) -> FingerTree (Node a)
appendTree1 FingerTree (Node (Elem a))
m1 (forall a. Sized a => a -> a -> Node a
node2 Elem a
a Elem a
b) FingerTree (Node (Elem a))
m2
addDigits0 FingerTree (Node (Elem a))
m1 (One Elem a
a) (Two Elem a
b Elem a
c) FingerTree (Node (Elem a))
m2 =
forall a.
FingerTree (Node a)
-> Node a -> FingerTree (Node a) -> FingerTree (Node a)
appendTree1 FingerTree (Node (Elem a))
m1 (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 FingerTree (Node (Elem a))
m1 (One Elem a
a) (Three Elem a
b Elem a
c Elem a
d) FingerTree (Node (Elem a))
m2 =
forall a.
FingerTree (Node a)
-> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
appendTree2 FingerTree (Node (Elem a))
m1 (forall a. Sized a => a -> a -> Node a
node2 Elem a
a Elem a
b) (forall a. Sized a => a -> a -> Node a
node2 Elem a
c Elem a
d) FingerTree (Node (Elem a))
m2
addDigits0 FingerTree (Node (Elem a))
m1 (One Elem a
a) (Four Elem a
b Elem a
c Elem a
d Elem a
e) FingerTree (Node (Elem a))
m2 =
forall a.
FingerTree (Node a)
-> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
appendTree2 FingerTree (Node (Elem a))
m1 (forall a. Sized a => a -> a -> a -> Node a
node3 Elem a
a Elem a
b Elem a
c) (forall a. Sized a => a -> a -> Node a
node2 Elem a
d Elem a
e) FingerTree (Node (Elem a))
m2
addDigits0 FingerTree (Node (Elem a))
m1 (Two Elem a
a Elem a
b) (One Elem a
c) FingerTree (Node (Elem a))
m2 =
forall a.
FingerTree (Node a)
-> Node a -> FingerTree (Node a) -> FingerTree (Node a)
appendTree1 FingerTree (Node (Elem a))
m1 (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 FingerTree (Node (Elem a))
m1 (Two Elem a
a Elem a
b) (Two Elem a
c Elem a
d) FingerTree (Node (Elem a))
m2 =
forall a.
FingerTree (Node a)
-> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
appendTree2 FingerTree (Node (Elem a))
m1 (forall a. Sized a => a -> a -> Node a
node2 Elem a
a Elem a
b) (forall a. Sized a => a -> a -> Node a
node2 Elem a
c Elem a
d) FingerTree (Node (Elem a))
m2
addDigits0 FingerTree (Node (Elem a))
m1 (Two Elem a
a Elem a
b) (Three Elem a
c Elem a
d Elem a
e) FingerTree (Node (Elem a))
m2 =
forall a.
FingerTree (Node a)
-> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
appendTree2 FingerTree (Node (Elem a))
m1 (forall a. Sized a => a -> a -> a -> Node a
node3 Elem a
a Elem a
b Elem a
c) (forall a. Sized a => a -> a -> Node a
node2 Elem a
d Elem a
e) FingerTree (Node (Elem a))
m2
addDigits0 FingerTree (Node (Elem a))
m1 (Two Elem a
a Elem a
b) (Four Elem a
c Elem a
d Elem a
e Elem a
f) FingerTree (Node (Elem a))
m2 =
forall a.
FingerTree (Node a)
-> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
appendTree2 FingerTree (Node (Elem a))
m1 (forall a. Sized a => a -> a -> a -> Node a
node3 Elem a
a Elem a
b Elem a
c) (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 FingerTree (Node (Elem a))
m1 (Three Elem a
a Elem a
b Elem a
c) (One Elem a
d) FingerTree (Node (Elem a))
m2 =
forall a.
FingerTree (Node a)
-> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
appendTree2 FingerTree (Node (Elem a))
m1 (forall a. Sized a => a -> a -> Node a
node2 Elem a
a Elem a
b) (forall a. Sized a => a -> a -> Node a
node2 Elem a
c Elem a
d) FingerTree (Node (Elem a))
m2
addDigits0 FingerTree (Node (Elem a))
m1 (Three Elem a
a Elem a
b Elem a
c) (Two Elem a
d Elem a
e) FingerTree (Node (Elem a))
m2 =
forall a.
FingerTree (Node a)
-> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
appendTree2 FingerTree (Node (Elem a))
m1 (forall a. Sized a => a -> a -> a -> Node a
node3 Elem a
a Elem a
b Elem a
c) (forall a. Sized a => a -> a -> Node a
node2 Elem a
d Elem a
e) FingerTree (Node (Elem a))
m2
addDigits0 FingerTree (Node (Elem a))
m1 (Three Elem a
a Elem a
b Elem a
c) (Three Elem a
d Elem a
e Elem a
f) FingerTree (Node (Elem a))
m2 =
forall a.
FingerTree (Node a)
-> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
appendTree2 FingerTree (Node (Elem a))
m1 (forall a. Sized a => a -> a -> a -> Node a
node3 Elem a
a Elem a
b Elem a
c) (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 FingerTree (Node (Elem a))
m1 (Three Elem a
a Elem a
b Elem a
c) (Four Elem a
d Elem a
e Elem a
f Elem a
g) FingerTree (Node (Elem a))
m2 =
forall a.
FingerTree (Node a)
-> Node a
-> Node a
-> Node a
-> FingerTree (Node a)
-> FingerTree (Node a)
appendTree3 FingerTree (Node (Elem a))
m1 (forall a. Sized a => a -> a -> a -> Node a
node3 Elem a
a Elem a
b Elem a
c) (forall a. Sized a => a -> a -> Node a
node2 Elem a
d Elem a
e) (forall a. Sized a => a -> a -> Node a
node2 Elem a
f Elem a
g) FingerTree (Node (Elem a))
m2
addDigits0 FingerTree (Node (Elem a))
m1 (Four Elem a
a Elem a
b Elem a
c Elem a
d) (One Elem a
e) FingerTree (Node (Elem a))
m2 =
forall a.
FingerTree (Node a)
-> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
appendTree2 FingerTree (Node (Elem a))
m1 (forall a. Sized a => a -> a -> a -> Node a
node3 Elem a
a Elem a
b Elem a
c) (forall a. Sized a => a -> a -> Node a
node2 Elem a
d Elem a
e) FingerTree (Node (Elem a))
m2
addDigits0 FingerTree (Node (Elem a))
m1 (Four Elem a
a Elem a
b Elem a
c Elem a
d) (Two Elem a
e Elem a
f) FingerTree (Node (Elem a))
m2 =
forall a.
FingerTree (Node a)
-> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
appendTree2 FingerTree (Node (Elem a))
m1 (forall a. Sized a => a -> a -> a -> Node a
node3 Elem a
a Elem a
b Elem a
c) (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 FingerTree (Node (Elem a))
m1 (Four Elem a
a Elem a
b Elem a
c Elem a
d) (Three Elem a
e Elem a
f Elem a
g) FingerTree (Node (Elem a))
m2 =
forall a.
FingerTree (Node a)
-> Node a
-> Node a
-> Node a
-> FingerTree (Node a)
-> FingerTree (Node a)
appendTree3 FingerTree (Node (Elem a))
m1 (forall a. Sized a => a -> a -> a -> Node a
node3 Elem a
a Elem a
b Elem a
c) (forall a. Sized a => a -> a -> Node a
node2 Elem a
d Elem a
e) (forall a. Sized a => a -> a -> Node a
node2 Elem a
f Elem a
g) FingerTree (Node (Elem a))
m2
addDigits0 FingerTree (Node (Elem a))
m1 (Four Elem a
a Elem a
b Elem a
c Elem a
d) (Four Elem a
e Elem a
f Elem a
g Elem a
h) FingerTree (Node (Elem a))
m2 =
forall a.
FingerTree (Node a)
-> Node a
-> Node a
-> Node a
-> FingerTree (Node a)
-> FingerTree (Node a)
appendTree3 FingerTree (Node (Elem a))
m1 (forall a. Sized a => a -> a -> a -> Node a
node3 Elem a
a Elem a
b Elem a
c) (forall a. Sized a => a -> a -> a -> Node a
node3 Elem a
d Elem a
e Elem a
f) (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 :: forall a.
FingerTree (Node a)
-> Node a -> FingerTree (Node a) -> FingerTree (Node a)
appendTree1 FingerTree (Node a)
EmptyT !Node a
a FingerTree (Node a)
xs =
Node a
a forall a. Sized a => a -> FingerTree a -> FingerTree a
`consTree` FingerTree (Node a)
xs
appendTree1 FingerTree (Node a)
xs !Node a
a FingerTree (Node a)
EmptyT =
FingerTree (Node a)
xs forall a. Sized a => FingerTree a -> a -> FingerTree a
`snocTree` Node a
a
appendTree1 (Single Node a
x) !Node a
a FingerTree (Node a)
xs =
Node a
x forall a. Sized a => a -> FingerTree a -> FingerTree a
`consTree` Node a
a forall a. Sized a => a -> FingerTree a -> FingerTree a
`consTree` FingerTree (Node a)
xs
appendTree1 FingerTree (Node a)
xs !Node a
a (Single Node a
x) =
FingerTree (Node a)
xs forall a. Sized a => FingerTree a -> a -> FingerTree a
`snocTree` Node a
a forall a. Sized a => FingerTree a -> a -> FingerTree a
`snocTree` Node a
x
appendTree1 (Deep Int
s1 Digit (Node a)
pr1 FingerTree (Node (Node a))
m1 Digit (Node a)
sf1) Node a
a (Deep Int
s2 Digit (Node a)
pr2 FingerTree (Node (Node a))
m2 Digit (Node a)
sf2) =
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s1 forall a. Num a => a -> a -> a
+ forall a. Sized a => a -> Int
size Node a
a 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 = 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 :: 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 (One Node a
a) Node a
b (One Node a
c) FingerTree (Node (Node a))
m2 =
forall a.
FingerTree (Node a)
-> Node a -> FingerTree (Node a) -> FingerTree (Node a)
appendTree1 FingerTree (Node (Node a))
m1 (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 FingerTree (Node (Node a))
m1 (One Node a
a) Node a
b (Two Node a
c Node a
d) FingerTree (Node (Node a))
m2 =
forall a.
FingerTree (Node a)
-> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
appendTree2 FingerTree (Node (Node a))
m1 (forall a. Sized a => a -> a -> Node a
node2 Node a
a Node a
b) (forall a. Sized a => a -> a -> Node a
node2 Node a
c Node a
d) FingerTree (Node (Node a))
m2
addDigits1 FingerTree (Node (Node a))
m1 (One Node a
a) Node a
b (Three Node a
c Node a
d Node a
e) FingerTree (Node (Node a))
m2 =
forall a.
FingerTree (Node a)
-> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
appendTree2 FingerTree (Node (Node a))
m1 (forall a. Sized a => a -> a -> a -> Node a
node3 Node a
a Node a
b Node a
c) (forall a. Sized a => a -> a -> Node a
node2 Node a
d Node a
e) FingerTree (Node (Node a))
m2
addDigits1 FingerTree (Node (Node a))
m1 (One Node a
a) Node a
b (Four Node a
c Node a
d Node a
e Node a
f) FingerTree (Node (Node a))
m2 =
forall a.
FingerTree (Node a)
-> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
appendTree2 FingerTree (Node (Node a))
m1 (forall a. Sized a => a -> a -> a -> Node a
node3 Node a
a Node a
b Node a
c) (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 FingerTree (Node (Node a))
m1 (Two Node a
a Node a
b) Node a
c (One Node a
d) FingerTree (Node (Node a))
m2 =
forall a.
FingerTree (Node a)
-> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
appendTree2 FingerTree (Node (Node a))
m1 (forall a. Sized a => a -> a -> Node a
node2 Node a
a Node a
b) (forall a. Sized a => a -> a -> Node a
node2 Node a
c Node a
d) FingerTree (Node (Node a))
m2
addDigits1 FingerTree (Node (Node a))
m1 (Two Node a
a Node a
b) Node a
c (Two Node a
d Node a
e) FingerTree (Node (Node a))
m2 =
forall a.
FingerTree (Node a)
-> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
appendTree2 FingerTree (Node (Node a))
m1 (forall a. Sized a => a -> a -> a -> Node a
node3 Node a
a Node a
b Node a
c) (forall a. Sized a => a -> a -> Node a
node2 Node a
d Node a
e) FingerTree (Node (Node a))
m2
addDigits1 FingerTree (Node (Node a))
m1 (Two Node a
a Node a
b) Node a
c (Three Node a
d Node a
e Node a
f) FingerTree (Node (Node a))
m2 =
forall a.
FingerTree (Node a)
-> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
appendTree2 FingerTree (Node (Node a))
m1 (forall a. Sized a => a -> a -> a -> Node a
node3 Node a
a Node a
b Node a
c) (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 FingerTree (Node (Node a))
m1 (Two Node a
a Node a
b) Node a
c (Four Node a
d Node a
e Node a
f Node a
g) FingerTree (Node (Node a))
m2 =
forall a.
FingerTree (Node a)
-> Node a
-> Node a
-> Node a
-> FingerTree (Node a)
-> FingerTree (Node a)
appendTree3 FingerTree (Node (Node a))
m1 (forall a. Sized a => a -> a -> a -> Node a
node3 Node a
a Node a
b Node a
c) (forall a. Sized a => a -> a -> Node a
node2 Node a
d Node a
e) (forall a. Sized a => a -> a -> Node a
node2 Node a
f Node a
g) FingerTree (Node (Node a))
m2
addDigits1 FingerTree (Node (Node a))
m1 (Three Node a
a Node a
b Node a
c) Node a
d (One Node a
e) FingerTree (Node (Node a))
m2 =
forall a.
FingerTree (Node a)
-> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
appendTree2 FingerTree (Node (Node a))
m1 (forall a. Sized a => a -> a -> a -> Node a
node3 Node a
a Node a
b Node a
c) (forall a. Sized a => a -> a -> Node a
node2 Node a
d Node a
e) FingerTree (Node (Node a))
m2
addDigits1 FingerTree (Node (Node a))
m1 (Three Node a
a Node a
b Node a
c) Node a
d (Two Node a
e Node a
f) FingerTree (Node (Node a))
m2 =
forall a.
FingerTree (Node a)
-> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
appendTree2 FingerTree (Node (Node a))
m1 (forall a. Sized a => a -> a -> a -> Node a
node3 Node a
a Node a
b Node a
c) (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 FingerTree (Node (Node a))
m1 (Three Node a
a Node a
b Node a
c) Node a
d (Three Node a
e Node a
f Node a
g) FingerTree (Node (Node a))
m2 =
forall a.
FingerTree (Node a)
-> Node a
-> Node a
-> Node a
-> FingerTree (Node a)
-> FingerTree (Node a)
appendTree3 FingerTree (Node (Node a))
m1 (forall a. Sized a => a -> a -> a -> Node a
node3 Node a
a Node a
b Node a
c) (forall a. Sized a => a -> a -> Node a
node2 Node a
d Node a
e) (forall a. Sized a => a -> a -> Node a
node2 Node a
f Node a
g) FingerTree (Node (Node a))
m2
addDigits1 FingerTree (Node (Node a))
m1 (Three Node a
a Node a
b Node a
c) Node a
d (Four Node a
e Node a
f Node a
g Node a
h) FingerTree (Node (Node a))
m2 =
forall a.
FingerTree (Node a)
-> Node a
-> Node a
-> Node a
-> FingerTree (Node a)
-> FingerTree (Node a)
appendTree3 FingerTree (Node (Node a))
m1 (forall a. Sized a => a -> a -> a -> Node a
node3 Node a
a Node a
b Node a
c) (forall a. Sized a => a -> a -> a -> Node a
node3 Node a
d Node a
e Node a
f) (forall a. Sized a => a -> a -> Node a
node2 Node a
g Node a
h) FingerTree (Node (Node a))
m2
addDigits1 FingerTree (Node (Node a))
m1 (Four Node a
a Node a
b Node a
c Node a
d) Node a
e (One Node a
f) FingerTree (Node (Node a))
m2 =
forall a.
FingerTree (Node a)
-> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
appendTree2 FingerTree (Node (Node a))
m1 (forall a. Sized a => a -> a -> a -> Node a
node3 Node a
a Node a
b Node a
c) (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 FingerTree (Node (Node a))
m1 (Four Node a
a Node a
b Node a
c Node a
d) Node a
e (Two Node a
f Node a
g) FingerTree (Node (Node a))
m2 =
forall a.
FingerTree (Node a)
-> Node a
-> Node a
-> Node a
-> FingerTree (Node a)
-> FingerTree (Node a)
appendTree3 FingerTree (Node (Node a))
m1 (forall a. Sized a => a -> a -> a -> Node a
node3 Node a
a Node a
b Node a
c) (forall a. Sized a => a -> a -> Node a
node2 Node a
d Node a
e) (forall a. Sized a => a -> a -> Node a
node2 Node a
f Node a
g) FingerTree (Node (Node a))
m2
addDigits1 FingerTree (Node (Node a))
m1 (Four Node a
a Node a
b Node a
c Node a
d) Node a
e (Three Node a
f Node a
g Node a
h) FingerTree (Node (Node a))
m2 =
forall a.
FingerTree (Node a)
-> Node a
-> Node a
-> Node a
-> FingerTree (Node a)
-> FingerTree (Node a)
appendTree3 FingerTree (Node (Node a))
m1 (forall a. Sized a => a -> a -> a -> Node a
node3 Node a
a Node a
b Node a
c) (forall a. Sized a => a -> a -> a -> Node a
node3 Node a
d Node a
e Node a
f) (forall a. Sized a => a -> a -> Node a
node2 Node a
g Node a
h) FingerTree (Node (Node a))
m2
addDigits1 FingerTree (Node (Node a))
m1 (Four Node a
a Node a
b Node a
c Node a
d) Node a
e (Four Node a
f Node a
g Node a
h Node a
i) FingerTree (Node (Node a))
m2 =
forall a.
FingerTree (Node a)
-> Node a
-> Node a
-> Node a
-> FingerTree (Node a)
-> FingerTree (Node a)
appendTree3 FingerTree (Node (Node a))
m1 (forall a. Sized a => a -> a -> a -> Node a
node3 Node a
a Node a
b Node a
c) (forall a. Sized a => a -> a -> a -> Node a
node3 Node a
d Node a
e Node a
f) (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 :: forall a.
FingerTree (Node a)
-> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
appendTree2 FingerTree (Node a)
EmptyT !Node a
a !Node a
b FingerTree (Node a)
xs =
Node a
a forall a. Sized a => a -> FingerTree a -> FingerTree a
`consTree` Node a
b forall a. Sized a => a -> FingerTree a -> FingerTree a
`consTree` FingerTree (Node a)
xs
appendTree2 FingerTree (Node a)
xs !Node a
a !Node a
b FingerTree (Node a)
EmptyT =
FingerTree (Node a)
xs forall a. Sized a => FingerTree a -> a -> FingerTree a
`snocTree` Node a
a forall a. Sized a => FingerTree a -> a -> FingerTree a
`snocTree` Node a
b
appendTree2 (Single Node a
x) Node a
a Node a
b FingerTree (Node a)
xs =
Node a
x forall a. Sized a => a -> FingerTree a -> FingerTree a
`consTree` Node a
a forall a. Sized a => a -> FingerTree a -> FingerTree a
`consTree` Node a
b forall a. Sized a => a -> FingerTree a -> FingerTree a
`consTree` FingerTree (Node a)
xs
appendTree2 FingerTree (Node a)
xs Node a
a Node a
b (Single Node a
x) =
FingerTree (Node a)
xs forall a. Sized a => FingerTree a -> a -> FingerTree a
`snocTree` Node a
a forall a. Sized a => FingerTree a -> a -> FingerTree a
`snocTree` Node a
b forall a. Sized a => FingerTree a -> a -> FingerTree a
`snocTree` Node a
x
appendTree2 (Deep Int
s1 Digit (Node a)
pr1 FingerTree (Node (Node a))
m1 Digit (Node a)
sf1) Node a
a Node a
b (Deep Int
s2 Digit (Node a)
pr2 FingerTree (Node (Node a))
m2 Digit (Node a)
sf2) =
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s1 forall a. Num a => a -> a -> a
+ forall a. Sized a => a -> Int
size Node a
a forall a. Num a => a -> a -> a
+ forall a. Sized a => a -> Int
size Node a
b 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 = 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 :: 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 (One Node a
a) Node a
b Node a
c (One Node a
d) FingerTree (Node (Node a))
m2 =
forall a.
FingerTree (Node a)
-> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
appendTree2 FingerTree (Node (Node a))
m1 (forall a. Sized a => a -> a -> Node a
node2 Node a
a Node a
b) (forall a. Sized a => a -> a -> Node a
node2 Node a
c Node a
d) FingerTree (Node (Node a))
m2
addDigits2 FingerTree (Node (Node a))
m1 (One Node a
a) Node a
b Node a
c (Two Node a
d Node a
e) FingerTree (Node (Node a))
m2 =
forall a.
FingerTree (Node a)
-> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
appendTree2 FingerTree (Node (Node a))
m1 (forall a. Sized a => a -> a -> a -> Node a
node3 Node a
a Node a
b Node a
c) (forall a. Sized a => a -> a -> Node a
node2 Node a
d Node a
e) FingerTree (Node (Node a))
m2
addDigits2 FingerTree (Node (Node a))
m1 (One Node a
a) Node a
b Node a
c (Three Node a
d Node a
e Node a
f) FingerTree (Node (Node a))
m2 =
forall a.
FingerTree (Node a)
-> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
appendTree2 FingerTree (Node (Node a))
m1 (forall a. Sized a => a -> a -> a -> Node a
node3 Node a
a Node a
b Node a
c) (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 FingerTree (Node (Node a))
m1 (One Node a
a) Node a
b Node a
c (Four Node a
d Node a
e Node a
f Node a
g) FingerTree (Node (Node a))
m2 =
forall a.
FingerTree (Node a)
-> Node a
-> Node a
-> Node a
-> FingerTree (Node a)
-> FingerTree (Node a)
appendTree3 FingerTree (Node (Node a))
m1 (forall a. Sized a => a -> a -> a -> Node a
node3 Node a
a Node a
b Node a
c) (forall a. Sized a => a -> a -> Node a
node2 Node a
d Node a
e) (forall a. Sized a => a -> a -> Node a
node2 Node a
f Node a
g) FingerTree (Node (Node a))
m2
addDigits2 FingerTree (Node (Node a))
m1 (Two Node a
a Node a
b) Node a
c Node a
d (One Node a
e) FingerTree (Node (Node a))
m2 =
forall a.
FingerTree (Node a)
-> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
appendTree2 FingerTree (Node (Node a))
m1 (forall a. Sized a => a -> a -> a -> Node a
node3 Node a
a Node a
b Node a
c) (forall a. Sized a => a -> a -> Node a
node2 Node a
d Node a
e) FingerTree (Node (Node a))
m2
addDigits2 FingerTree (Node (Node a))
m1 (Two Node a
a Node a
b) Node a
c Node a
d (Two Node a
e Node a
f) FingerTree (Node (Node a))
m2 =
forall a.
FingerTree (Node a)
-> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
appendTree2 FingerTree (Node (Node a))
m1 (forall a. Sized a => a -> a -> a -> Node a
node3 Node a
a Node a
b Node a
c) (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 FingerTree (Node (Node a))
m1 (Two Node a
a Node a
b) Node a
c Node a
d (Three Node a
e Node a
f Node a
g) FingerTree (Node (Node a))
m2 =
forall a.
FingerTree (Node a)
-> Node a
-> Node a
-> Node a
-> FingerTree (Node a)
-> FingerTree (Node a)
appendTree3 FingerTree (Node (Node a))
m1 (forall a. Sized a => a -> a -> a -> Node a
node3 Node a
a Node a
b Node a
c) (forall a. Sized a => a -> a -> Node a
node2 Node a
d Node a
e) (forall a. Sized a => a -> a -> Node a
node2 Node a
f Node a
g) FingerTree (Node (Node a))
m2
addDigits2 FingerTree (Node (Node a))
m1 (Two Node a
a Node a
b) Node a
c Node a
d (Four Node a
e Node a
f Node a
g Node a
h) FingerTree (Node (Node a))
m2 =
forall a.
FingerTree (Node a)
-> Node a
-> Node a
-> Node a
-> FingerTree (Node a)
-> FingerTree (Node a)
appendTree3 FingerTree (Node (Node a))
m1 (forall a. Sized a => a -> a -> a -> Node a
node3 Node a
a Node a
b Node a
c) (forall a. Sized a => a -> a -> a -> Node a
node3 Node a
d Node a
e Node a
f) (forall a. Sized a => a -> a -> Node a
node2 Node a
g Node a
h) FingerTree (Node (Node a))
m2
addDigits2 FingerTree (Node (Node a))
m1 (Three Node a
a Node a
b Node a
c) Node a
d Node a
e (One Node a
f) FingerTree (Node (Node a))
m2 =
forall a.
FingerTree (Node a)
-> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
appendTree2 FingerTree (Node (Node a))
m1 (forall a. Sized a => a -> a -> a -> Node a
node3 Node a
a Node a
b Node a
c) (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 FingerTree (Node (Node a))
m1 (Three Node a
a Node a
b Node a
c) Node a
d Node a
e (Two Node a
f Node a
g) FingerTree (Node (Node a))
m2 =
forall a.
FingerTree (Node a)
-> Node a
-> Node a
-> Node a
-> FingerTree (Node a)
-> FingerTree (Node a)
appendTree3 FingerTree (Node (Node a))
m1 (forall a. Sized a => a -> a -> a -> Node a
node3 Node a
a Node a
b Node a
c) (forall a. Sized a => a -> a -> Node a
node2 Node a
d Node a
e) (forall a. Sized a => a -> a -> Node a
node2 Node a
f Node a
g) FingerTree (Node (Node a))
m2
addDigits2 FingerTree (Node (Node a))
m1 (Three Node a
a Node a
b Node a
c) Node a
d Node a
e (Three Node a
f Node a
g Node a
h) FingerTree (Node (Node a))
m2 =
forall a.
FingerTree (Node a)
-> Node a
-> Node a
-> Node a
-> FingerTree (Node a)
-> FingerTree (Node a)
appendTree3 FingerTree (Node (Node a))
m1 (forall a. Sized a => a -> a -> a -> Node a
node3 Node a
a Node a
b Node a
c) (forall a. Sized a => a -> a -> a -> Node a
node3 Node a
d Node a
e Node a
f) (forall a. Sized a => a -> a -> Node a
node2 Node a
g Node a
h) FingerTree (Node (Node a))
m2
addDigits2 FingerTree (Node (Node a))
m1 (Three Node a
a Node a
b Node a
c) Node a
d Node a
e (Four Node a
f Node a
g Node a
h Node a
i) FingerTree (Node (Node a))
m2 =
forall a.
FingerTree (Node a)
-> Node a
-> Node a
-> Node a
-> FingerTree (Node a)
-> FingerTree (Node a)
appendTree3 FingerTree (Node (Node a))
m1 (forall a. Sized a => a -> a -> a -> Node a
node3 Node a
a Node a
b Node a
c) (forall a. Sized a => a -> a -> a -> Node a
node3 Node a
d Node a
e Node a
f) (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 FingerTree (Node (Node a))
m1 (Four Node a
a Node a
b Node a
c Node a
d) Node a
e Node a
f (One Node a
g) FingerTree (Node (Node a))
m2 =
forall a.
FingerTree (Node a)
-> Node a
-> Node a
-> Node a
-> FingerTree (Node a)
-> FingerTree (Node a)
appendTree3 FingerTree (Node (Node a))
m1 (forall a. Sized a => a -> a -> a -> Node a
node3 Node a
a Node a
b Node a
c) (forall a. Sized a => a -> a -> Node a
node2 Node a
d Node a
e) (forall a. Sized a => a -> a -> Node a
node2 Node a
f Node a
g) FingerTree (Node (Node a))
m2
addDigits2 FingerTree (Node (Node a))
m1 (Four Node a
a Node a
b Node a
c Node a
d) Node a
e Node a
f (Two Node a
g Node a
h) FingerTree (Node (Node a))
m2 =
forall a.
FingerTree (Node a)
-> Node a
-> Node a
-> Node a
-> FingerTree (Node a)
-> FingerTree (Node a)
appendTree3 FingerTree (Node (Node a))
m1 (forall a. Sized a => a -> a -> a -> Node a
node3 Node a
a Node a
b Node a
c) (forall a. Sized a => a -> a -> a -> Node a
node3 Node a
d Node a
e Node a
f) (forall a. Sized a => a -> a -> Node a
node2 Node a
g Node a
h) FingerTree (Node (Node a))
m2
addDigits2 FingerTree (Node (Node a))
m1 (Four Node a
a Node a
b Node a
c Node a
d) Node a
e Node a
f (Three Node a
g Node a
h Node a
i) FingerTree (Node (Node a))
m2 =
forall a.
FingerTree (Node a)
-> Node a
-> Node a
-> Node a
-> FingerTree (Node a)
-> FingerTree (Node a)
appendTree3 FingerTree (Node (Node a))
m1 (forall a. Sized a => a -> a -> a -> Node a
node3 Node a
a Node a
b Node a
c) (forall a. Sized a => a -> a -> a -> Node a
node3 Node a
d Node a
e Node a
f) (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 FingerTree (Node (Node a))
m1 (Four Node a
a Node a
b Node a
c Node a
d) Node a
e Node a
f (Four Node a
g Node a
h Node a
i Node a
j) FingerTree (Node (Node a))
m2 =
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 (forall a. Sized a => a -> a -> a -> Node a
node3 Node a
a Node a
b Node a
c) (forall a. Sized a => a -> a -> a -> Node a
node3 Node a
d Node a
e Node a
f) (forall a. Sized a => a -> a -> Node a
node2 Node a
g Node a
h) (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 :: forall a.
FingerTree (Node a)
-> Node a
-> Node a
-> Node a
-> FingerTree (Node a)
-> FingerTree (Node a)
appendTree3 FingerTree (Node a)
EmptyT !Node a
a !Node a
b !Node a
c FingerTree (Node a)
xs =
Node a
a forall a. Sized a => a -> FingerTree a -> FingerTree a
`consTree` Node a
b forall a. Sized a => a -> FingerTree a -> FingerTree a
`consTree` Node a
c forall a. Sized a => a -> FingerTree a -> FingerTree a
`consTree` FingerTree (Node a)
xs
appendTree3 FingerTree (Node a)
xs !Node a
a !Node a
b !Node a
c FingerTree (Node a)
EmptyT =
FingerTree (Node a)
xs forall a. Sized a => FingerTree a -> a -> FingerTree a
`snocTree` Node a
a forall a. Sized a => FingerTree a -> a -> FingerTree a
`snocTree` Node a
b forall a. Sized a => FingerTree a -> a -> FingerTree a
`snocTree` Node a
c
appendTree3 (Single Node a
x) Node a
a Node a
b Node a
c FingerTree (Node a)
xs =
Node a
x forall a. Sized a => a -> FingerTree a -> FingerTree a
`consTree` Node a
a forall a. Sized a => a -> FingerTree a -> FingerTree a
`consTree` Node a
b forall a. Sized a => a -> FingerTree a -> FingerTree a
`consTree` Node a
c forall a. Sized a => a -> FingerTree a -> FingerTree a
`consTree` FingerTree (Node a)
xs
appendTree3 FingerTree (Node a)
xs Node a
a Node a
b Node a
c (Single Node a
x) =
FingerTree (Node a)
xs forall a. Sized a => FingerTree a -> a -> FingerTree a
`snocTree` Node a
a forall a. Sized a => FingerTree a -> a -> FingerTree a
`snocTree` Node a
b forall a. Sized a => FingerTree a -> a -> FingerTree a
`snocTree` Node a
c forall a. Sized a => FingerTree a -> a -> FingerTree a
`snocTree` Node a
x
appendTree3 (Deep Int
s1 Digit (Node a)
pr1 FingerTree (Node (Node a))
m1 Digit (Node a)
sf1) Node a
a Node a
b Node a
c (Deep Int
s2 Digit (Node a)
pr2 FingerTree (Node (Node a))
m2 Digit (Node a)
sf2) =
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s1 forall a. Num a => a -> a -> a
+ forall a. Sized a => a -> Int
size Node a
a forall a. Num a => a -> a -> a
+ forall a. Sized a => a -> Int
size Node a
b forall a. Num a => a -> a -> a
+ forall a. Sized a => a -> Int
size Node a
c 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 = 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 :: 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 (One Node a
a) !Node a
b !Node a
c !Node a
d (One Node a
e) FingerTree (Node (Node a))
m2 =
forall a.
FingerTree (Node a)
-> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
appendTree2 FingerTree (Node (Node a))
m1 (forall a. Sized a => a -> a -> a -> Node a
node3 Node a
a Node a
b Node a
c) (forall a. Sized a => a -> a -> Node a
node2 Node a
d Node a
e) FingerTree (Node (Node a))
m2
addDigits3 FingerTree (Node (Node a))
m1 (One Node a
a) Node a
b Node a
c Node a
d (Two Node a
e Node a
f) FingerTree (Node (Node a))
m2 =
forall a.
FingerTree (Node a)
-> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
appendTree2 FingerTree (Node (Node a))
m1 (forall a. Sized a => a -> a -> a -> Node a
node3 Node a
a Node a
b Node a
c) (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 FingerTree (Node (Node a))
m1 (One Node a
a) Node a
b Node a
c Node a
d (Three Node a
e Node a
f Node a
g) FingerTree (Node (Node a))
m2 =
forall a.
FingerTree (Node a)
-> Node a
-> Node a
-> Node a
-> FingerTree (Node a)
-> FingerTree (Node a)
appendTree3 FingerTree (Node (Node a))
m1 (forall a. Sized a => a -> a -> a -> Node a
node3 Node a
a Node a
b Node a
c) (forall a. Sized a => a -> a -> Node a
node2 Node a
d Node a
e) (forall a. Sized a => a -> a -> Node a
node2 Node a
f Node a
g) FingerTree (Node (Node a))
m2
addDigits3 FingerTree (Node (Node a))
m1 (One Node a
a) Node a
b Node a
c Node a
d (Four Node a
e Node a
f Node a
g Node a
h) FingerTree (Node (Node a))
m2 =
forall a.
FingerTree (Node a)
-> Node a
-> Node a
-> Node a
-> FingerTree (Node a)
-> FingerTree (Node a)
appendTree3 FingerTree (Node (Node a))
m1 (forall a. Sized a => a -> a -> a -> Node a
node3 Node a
a Node a
b Node a
c) (forall a. Sized a => a -> a -> a -> Node a
node3 Node a
d Node a
e Node a
f) (forall a. Sized a => a -> a -> Node a
node2 Node a
g Node a
h) FingerTree (Node (Node a))
m2
addDigits3 FingerTree (Node (Node a))
m1 (Two Node a
a Node a
b) !Node a
c !Node a
d !Node a
e (One Node a
f) FingerTree (Node (Node a))
m2 =
forall a.
FingerTree (Node a)
-> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
appendTree2 FingerTree (Node (Node a))
m1 (forall a. Sized a => a -> a -> a -> Node a
node3 Node a
a Node a
b Node a
c) (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 FingerTree (Node (Node a))
m1 (Two Node a
a Node a
b) Node a
c Node a
d Node a
e (Two Node a
f Node a
g) FingerTree (Node (Node a))
m2 =
forall a.
FingerTree (Node a)
-> Node a
-> Node a
-> Node a
-> FingerTree (Node a)
-> FingerTree (Node a)
appendTree3 FingerTree (Node (Node a))
m1 (forall a. Sized a => a -> a -> a -> Node a
node3 Node a
a Node a
b Node a
c) (forall a. Sized a => a -> a -> Node a
node2 Node a
d Node a
e) (forall a. Sized a => a -> a -> Node a
node2 Node a
f Node a
g) FingerTree (Node (Node a))
m2
addDigits3 FingerTree (Node (Node a))
m1 (Two Node a
a Node a
b) Node a
c Node a
d Node a
e (Three Node a
f Node a
g Node a
h) FingerTree (Node (Node a))
m2 =
forall a.
FingerTree (Node a)
-> Node a
-> Node a
-> Node a
-> FingerTree (Node a)
-> FingerTree (Node a)
appendTree3 FingerTree (Node (Node a))
m1 (forall a. Sized a => a -> a -> a -> Node a
node3 Node a
a Node a
b Node a
c) (forall a. Sized a => a -> a -> a -> Node a
node3 Node a
d Node a
e Node a
f) (forall a. Sized a => a -> a -> Node a
node2 Node a
g Node a
h) FingerTree (Node (Node a))
m2
addDigits3 FingerTree (Node (Node a))
m1 (Two Node a
a Node a
b) Node a
c Node a
d Node a
e (Four Node a
f Node a
g Node a
h Node a
i) FingerTree (Node (Node a))
m2 =
forall a.
FingerTree (Node a)
-> Node a
-> Node a
-> Node a
-> FingerTree (Node a)
-> FingerTree (Node a)
appendTree3 FingerTree (Node (Node a))
m1 (forall a. Sized a => a -> a -> a -> Node a
node3 Node a
a Node a
b Node a
c) (forall a. Sized a => a -> a -> a -> Node a
node3 Node a
d Node a
e Node a
f) (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 FingerTree (Node (Node a))
m1 (Three Node a
a Node a
b Node a
c) !Node a
d !Node a
e !Node a
f (One Node a
g) FingerTree (Node (Node a))
m2 =
forall a.
FingerTree (Node a)
-> Node a
-> Node a
-> Node a
-> FingerTree (Node a)
-> FingerTree (Node a)
appendTree3 FingerTree (Node (Node a))
m1 (forall a. Sized a => a -> a -> a -> Node a
node3 Node a
a Node a
b Node a
c) (forall a. Sized a => a -> a -> Node a
node2 Node a
d Node a
e) (forall a. Sized a => a -> a -> Node a
node2 Node a
f Node a
g) FingerTree (Node (Node a))
m2
addDigits3 FingerTree (Node (Node a))
m1 (Three Node a
a Node a
b Node a
c) Node a
d Node a
e Node a
f (Two Node a
g Node a
h) FingerTree (Node (Node a))
m2 =
forall a.
FingerTree (Node a)
-> Node a
-> Node a
-> Node a
-> FingerTree (Node a)
-> FingerTree (Node a)
appendTree3 FingerTree (Node (Node a))
m1 (forall a. Sized a => a -> a -> a -> Node a
node3 Node a
a Node a
b Node a
c) (forall a. Sized a => a -> a -> a -> Node a
node3 Node a
d Node a
e Node a
f) (forall a. Sized a => a -> a -> Node a
node2 Node a
g Node a
h) FingerTree (Node (Node a))
m2
addDigits3 FingerTree (Node (Node a))
m1 (Three Node a
a Node a
b Node a
c) Node a
d Node a
e Node a
f (Three Node a
g Node a
h Node a
i) FingerTree (Node (Node a))
m2 =
forall a.
FingerTree (Node a)
-> Node a
-> Node a
-> Node a
-> FingerTree (Node a)
-> FingerTree (Node a)
appendTree3 FingerTree (Node (Node a))
m1 (forall a. Sized a => a -> a -> a -> Node a
node3 Node a
a Node a
b Node a
c) (forall a. Sized a => a -> a -> a -> Node a
node3 Node a
d Node a
e Node a
f) (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 FingerTree (Node (Node a))
m1 (Three Node a
a Node a
b Node a
c) Node a
d Node a
e Node a
f (Four Node a
g Node a
h Node a
i Node a
j) FingerTree (Node (Node a))
m2 =
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 (forall a. Sized a => a -> a -> a -> Node a
node3 Node a
a Node a
b Node a
c) (forall a. Sized a => a -> a -> a -> Node a
node3 Node a
d Node a
e Node a
f) (forall a. Sized a => a -> a -> Node a
node2 Node a
g Node a
h) (forall a. Sized a => a -> a -> Node a
node2 Node a
i Node a
j) FingerTree (Node (Node a))
m2
addDigits3 FingerTree (Node (Node a))
m1 (Four Node a
a Node a
b Node a
c Node a
d) !Node a
e !Node a
f !Node a
g (One Node a
h) FingerTree (Node (Node a))
m2 =
forall a.
FingerTree (Node a)
-> Node a
-> Node a
-> Node a
-> FingerTree (Node a)
-> FingerTree (Node a)
appendTree3 FingerTree (Node (Node a))
m1 (forall a. Sized a => a -> a -> a -> Node a
node3 Node a
a Node a
b Node a
c) (forall a. Sized a => a -> a -> a -> Node a
node3 Node a
d Node a
e Node a
f) (forall a. Sized a => a -> a -> Node a
node2 Node a
g Node a
h) FingerTree (Node (Node a))
m2
addDigits3 FingerTree (Node (Node a))
m1 (Four Node a
a Node a
b Node a
c Node a
d) Node a
e Node a
f Node a
g (Two Node a
h Node a
i) FingerTree (Node (Node a))
m2 =
forall a.
FingerTree (Node a)
-> Node a
-> Node a
-> Node a
-> FingerTree (Node a)
-> FingerTree (Node a)
appendTree3 FingerTree (Node (Node a))
m1 (forall a. Sized a => a -> a -> a -> Node a
node3 Node a
a Node a
b Node a
c) (forall a. Sized a => a -> a -> a -> Node a
node3 Node a
d Node a
e Node a
f) (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 FingerTree (Node (Node a))
m1 (Four Node a
a Node a
b Node a
c Node a
d) Node a
e Node a
f Node a
g (Three Node a
h Node a
i Node a
j) FingerTree (Node (Node a))
m2 =
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 (forall a. Sized a => a -> a -> a -> Node a
node3 Node a
a Node a
b Node a
c) (forall a. Sized a => a -> a -> a -> Node a
node3 Node a
d Node a
e Node a
f) (forall a. Sized a => a -> a -> Node a
node2 Node a
g Node a
h) (forall a. Sized a => a -> a -> Node a
node2 Node a
i Node a
j) FingerTree (Node (Node a))
m2
addDigits3 FingerTree (Node (Node a))
m1 (Four Node a
a Node a
b Node a
c Node a
d) Node a
e Node a
f Node a
g (Four Node a
h Node a
i Node a
j Node a
k) FingerTree (Node (Node a))
m2 =
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 (forall a. Sized a => a -> a -> a -> Node a
node3 Node a
a Node a
b Node a
c) (forall a. Sized a => a -> a -> a -> Node a
node3 Node a
d Node a
e Node a
f) (forall a. Sized a => a -> a -> a -> Node a
node3 Node a
g Node a
h Node a
i) (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 :: forall a.
FingerTree (Node a)
-> Node a
-> Node a
-> Node a
-> Node a
-> FingerTree (Node a)
-> FingerTree (Node a)
appendTree4 FingerTree (Node a)
EmptyT !Node a
a !Node a
b !Node a
c !Node a
d FingerTree (Node a)
xs =
Node a
a forall a. Sized a => a -> FingerTree a -> FingerTree a
`consTree` Node a
b forall a. Sized a => a -> FingerTree a -> FingerTree a
`consTree` Node a
c forall a. Sized a => a -> FingerTree a -> FingerTree a
`consTree` Node a
d forall a. Sized a => a -> FingerTree a -> FingerTree a
`consTree` FingerTree (Node a)
xs
appendTree4 FingerTree (Node a)
xs !Node a
a !Node a
b !Node a
c !Node a
d FingerTree (Node a)
EmptyT =
FingerTree (Node a)
xs forall a. Sized a => FingerTree a -> a -> FingerTree a
`snocTree` Node a
a forall a. Sized a => FingerTree a -> a -> FingerTree a
`snocTree` Node a
b forall a. Sized a => FingerTree a -> a -> FingerTree a
`snocTree` Node a
c forall a. Sized a => FingerTree a -> a -> FingerTree a
`snocTree` Node a
d
appendTree4 (Single Node a
x) Node a
a Node a
b Node a
c Node a
d FingerTree (Node a)
xs =
Node a
x forall a. Sized a => a -> FingerTree a -> FingerTree a
`consTree` Node a
a forall a. Sized a => a -> FingerTree a -> FingerTree a
`consTree` Node a
b forall a. Sized a => a -> FingerTree a -> FingerTree a
`consTree` Node a
c forall a. Sized a => a -> FingerTree a -> FingerTree a
`consTree` Node a
d forall a. Sized a => a -> FingerTree a -> FingerTree a
`consTree` FingerTree (Node a)
xs
appendTree4 FingerTree (Node a)
xs Node a
a Node a
b Node a
c Node a
d (Single Node a
x) =
FingerTree (Node a)
xs forall a. Sized a => FingerTree a -> a -> FingerTree a
`snocTree` Node a
a forall a. Sized a => FingerTree a -> a -> FingerTree a
`snocTree` Node a
b forall a. Sized a => FingerTree a -> a -> FingerTree a
`snocTree` Node a
c forall a. Sized a => FingerTree a -> a -> FingerTree a
`snocTree` Node a
d forall a. Sized a => FingerTree a -> a -> FingerTree a
`snocTree` Node a
x
appendTree4 (Deep Int
s1 Digit (Node a)
pr1 FingerTree (Node (Node a))
m1 Digit (Node a)
sf1) Node a
a Node a
b Node a
c Node a
d (Deep Int
s2 Digit (Node a)
pr2 FingerTree (Node (Node a))
m2 Digit (Node a)
sf2) =
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s1 forall a. Num a => a -> a -> a
+ forall a. Sized a => a -> Int
size Node a
a forall a. Num a => a -> a -> a
+ forall a. Sized a => a -> Int
size Node a
b forall a. Num a => a -> a -> a
+ forall a. Sized a => a -> Int
size Node a
c forall a. Num a => a -> a -> a
+ forall a. Sized a => a -> Int
size Node a
d 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 = 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 :: 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 (One Node a
a) !Node a
b !Node a
c !Node a
d !Node a
e (One Node a
f) FingerTree (Node (Node a))
m2 =
forall a.
FingerTree (Node a)
-> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
appendTree2 FingerTree (Node (Node a))
m1 (forall a. Sized a => a -> a -> a -> Node a
node3 Node a
a Node a
b Node a
c) (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 FingerTree (Node (Node a))
m1 (One Node a
a) Node a
b Node a
c Node a
d Node a
e (Two Node a
f Node a
g) FingerTree (Node (Node a))
m2 =
forall a.
FingerTree (Node a)
-> Node a
-> Node a
-> Node a
-> FingerTree (Node a)
-> FingerTree (Node a)
appendTree3 FingerTree (Node (Node a))
m1 (forall a. Sized a => a -> a -> a -> Node a
node3 Node a
a Node a
b Node a
c) (forall a. Sized a => a -> a -> Node a
node2 Node a
d Node a
e) (forall a. Sized a => a -> a -> Node a
node2 Node a
f Node a
g) FingerTree (Node (Node a))
m2
addDigits4 FingerTree (Node (Node a))
m1 (One Node a
a) Node a
b Node a
c Node a
d Node a
e (Three Node a
f Node a
g Node a
h) FingerTree (Node (Node a))
m2 =
forall a.
FingerTree (Node a)
-> Node a
-> Node a
-> Node a
-> FingerTree (Node a)
-> FingerTree (Node a)
appendTree3 FingerTree (Node (Node a))
m1 (forall a. Sized a => a -> a -> a -> Node a
node3 Node a
a Node a
b Node a
c) (forall a. Sized a => a -> a -> a -> Node a
node3 Node a
d Node a
e Node a
f) (forall a. Sized a => a -> a -> Node a
node2 Node a
g Node a
h) FingerTree (Node (Node a))
m2
addDigits4 FingerTree (Node (Node a))
m1 (One Node a
a) Node a
b Node a
c Node a
d Node a
e (Four Node a
f Node a
g Node a
h Node a
i) FingerTree (Node (Node a))
m2 =
forall a.
FingerTree (Node a)
-> Node a
-> Node a
-> Node a
-> FingerTree (Node a)
-> FingerTree (Node a)
appendTree3 FingerTree (Node (Node a))
m1 (forall a. Sized a => a -> a -> a -> Node a
node3 Node a
a Node a
b Node a
c) (forall a. Sized a => a -> a -> a -> Node a
node3 Node a
d Node a
e Node a
f) (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 FingerTree (Node (Node a))
m1 (Two Node a
a Node a
b) !Node a
c !Node a
d !Node a
e !Node a
f (One Node a
g) FingerTree (Node (Node a))
m2 =
forall a.
FingerTree (Node a)
-> Node a
-> Node a
-> Node a
-> FingerTree (Node a)
-> FingerTree (Node a)
appendTree3 FingerTree (Node (Node a))
m1 (forall a. Sized a => a -> a -> a -> Node a
node3 Node a
a Node a
b Node a
c) (forall a. Sized a => a -> a -> Node a
node2 Node a
d Node a
e) (forall a. Sized a => a -> a -> Node a
node2 Node a
f Node a
g) FingerTree (Node (Node a))
m2
addDigits4 FingerTree (Node (Node a))
m1 (Two Node a
a Node a
b) Node a
c Node a
d Node a
e Node a
f (Two Node a
g Node a
h) FingerTree (Node (Node a))
m2 =
forall a.
FingerTree (Node a)
-> Node a
-> Node a
-> Node a
-> FingerTree (Node a)
-> FingerTree (Node a)
appendTree3 FingerTree (Node (Node a))
m1 (forall a. Sized a => a -> a -> a -> Node a
node3 Node a
a Node a
b Node a
c) (forall a. Sized a => a -> a -> a -> Node a
node3 Node a
d Node a
e Node a
f) (forall a. Sized a => a -> a -> Node a
node2 Node a
g Node a
h) FingerTree (Node (Node a))
m2
addDigits4 FingerTree (Node (Node a))
m1 (Two Node a
a Node a
b) Node a
c Node a
d Node a
e Node a
f (Three Node a
g Node a
h Node a
i) FingerTree (Node (Node a))
m2 =
forall a.
FingerTree (Node a)
-> Node a
-> Node a
-> Node a
-> FingerTree (Node a)
-> FingerTree (Node a)
appendTree3 FingerTree (Node (Node a))
m1 (forall a. Sized a => a -> a -> a -> Node a
node3 Node a
a Node a
b Node a
c) (forall a. Sized a => a -> a -> a -> Node a
node3 Node a
d Node a
e Node a
f) (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 FingerTree (Node (Node a))
m1 (Two Node a
a Node a
b) Node a
c Node a
d Node a
e Node a
f (Four Node a
g Node a
h Node a
i Node a
j) FingerTree (Node (Node a))
m2 =
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 (forall a. Sized a => a -> a -> a -> Node a
node3 Node a
a Node a
b Node a
c) (forall a. Sized a => a -> a -> a -> Node a
node3 Node a
d Node a
e Node a
f) (forall a. Sized a => a -> a -> Node a
node2 Node a
g Node a
h) (forall a. Sized a => a -> a -> Node a
node2 Node a
i Node a
j) FingerTree (Node (Node a))
m2
addDigits4 FingerTree (Node (Node a))
m1 (Three Node a
a Node a
b Node a
c) !Node a
d !Node a
e !Node a
f !Node a
g (One Node a
h) FingerTree (Node (Node a))
m2 =
forall a.
FingerTree (Node a)
-> Node a
-> Node a
-> Node a
-> FingerTree (Node a)
-> FingerTree (Node a)
appendTree3 FingerTree (Node (Node a))
m1 (forall a. Sized a => a -> a -> a -> Node a
node3 Node a
a Node a
b Node a
c) (forall a. Sized a => a -> a -> a -> Node a
node3 Node a
d Node a
e Node a
f) (forall a. Sized a => a -> a -> Node a
node2 Node a
g Node a
h) FingerTree (Node (Node a))
m2
addDigits4 FingerTree (Node (Node a))
m1 (Three Node a
a Node a
b Node a
c) Node a
d Node a
e Node a
f Node a
g (Two Node a
h Node a
i) FingerTree (Node (Node a))
m2 =
forall a.
FingerTree (Node a)
-> Node a
-> Node a
-> Node a
-> FingerTree (Node a)
-> FingerTree (Node a)
appendTree3 FingerTree (Node (Node a))
m1 (forall a. Sized a => a -> a -> a -> Node a
node3 Node a
a Node a
b Node a
c) (forall a. Sized a => a -> a -> a -> Node a
node3 Node a
d Node a
e Node a
f) (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 FingerTree (Node (Node a))
m1 (Three Node a
a Node a
b Node a
c) Node a
d Node a
e Node a
f Node a
g (Three Node a
h Node a
i Node a
j) FingerTree (Node (Node a))
m2 =
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 (forall a. Sized a => a -> a -> a -> Node a
node3 Node a
a Node a
b Node a
c) (forall a. Sized a => a -> a -> a -> Node a
node3 Node a
d Node a
e Node a
f) (forall a. Sized a => a -> a -> Node a
node2 Node a
g Node a
h) (forall a. Sized a => a -> a -> Node a
node2 Node a
i Node a
j) FingerTree (Node (Node a))
m2
addDigits4 FingerTree (Node (Node a))
m1 (Three Node a
a Node a
b Node a
c) Node a
d Node a
e Node a
f Node a
g (Four Node a
h Node a
i Node a
j Node a
k) FingerTree (Node (Node a))
m2 =
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 (forall a. Sized a => a -> a -> a -> Node a
node3 Node a
a Node a
b Node a
c) (forall a. Sized a => a -> a -> a -> Node a
node3 Node a
d Node a
e Node a
f) (forall a. Sized a => a -> a -> a -> Node a
node3 Node a
g Node a
h Node a
i) (forall a. Sized a => a -> a -> Node a
node2 Node a
j Node a
k) FingerTree (Node (Node a))
m2
addDigits4 FingerTree (Node (Node a))
m1 (Four Node a
a Node a
b Node a
c Node a
d) !Node a
e !Node a
f !Node a
g !Node a
h (One Node a
i) FingerTree (Node (Node a))
m2 =
forall a.
FingerTree (Node a)
-> Node a
-> Node a
-> Node a
-> FingerTree (Node a)
-> FingerTree (Node a)
appendTree3 FingerTree (Node (Node a))
m1 (forall a. Sized a => a -> a -> a -> Node a
node3 Node a
a Node a
b Node a
c) (forall a. Sized a => a -> a -> a -> Node a
node3 Node a
d Node a
e Node a
f) (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 FingerTree (Node (Node a))
m1 (Four Node a
a Node a
b Node a
c Node a
d) !Node a
e !Node a
f !Node a
g !Node a
h (Two Node a
i Node a
j) FingerTree (Node (Node a))
m2 =
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 (forall a. Sized a => a -> a -> a -> Node a
node3 Node a
a Node a
b Node a
c) (forall a. Sized a => a -> a -> a -> Node a
node3 Node a
d Node a
e Node a
f) (forall a. Sized a => a -> a -> Node a
node2 Node a
g Node a
h) (forall a. Sized a => a -> a -> Node a
node2 Node a
i Node a
j) FingerTree (Node (Node a))
m2
addDigits4 FingerTree (Node (Node a))
m1 (Four Node a
a Node a
b Node a
c Node a
d) !Node a
e !Node a
f !Node a
g !Node a
h (Three Node a
i Node a
j Node a
k) FingerTree (Node (Node a))
m2 =
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 (forall a. Sized a => a -> a -> a -> Node a
node3 Node a
a Node a
b Node a
c) (forall a. Sized a => a -> a -> a -> Node a
node3 Node a
d Node a
e Node a
f) (forall a. Sized a => a -> a -> a -> Node a
node3 Node a
g Node a
h Node a
i) (forall a. Sized a => a -> a -> Node a
node2 Node a
j Node a
k) FingerTree (Node (Node a))
m2
addDigits4 FingerTree (Node (Node a))
m1 (Four Node a
a Node a
b Node a
c Node a
d) !Node a
e !Node a
f !Node a
g !Node a
h (Four Node a
i Node a
j Node a
k Node a
l) FingerTree (Node (Node a))
m2 =
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 (forall a. Sized a => a -> a -> a -> Node a
node3 Node a
a Node a
b Node a
c) (forall a. Sized a => a -> a -> a -> Node a
node3 Node a
d Node a
e Node a
f) (forall a. Sized a => a -> a -> a -> Node a
node3 Node a
g Node a
h Node a
i) (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 :: forall b a. (b -> Maybe (a, b)) -> b -> Seq a
unfoldr b -> Maybe (a, b)
f = Seq a -> b -> Seq a
unfoldr' forall a. Seq a
empty
where unfoldr' :: Seq a -> b -> Seq a
unfoldr' !Seq a
as b
b = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Seq a
as (\ (a
a, b
b') -> Seq a -> b -> Seq a
unfoldr' (Seq a
as 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 :: forall b a. (b -> Maybe (b, a)) -> b -> Seq a
unfoldl b -> Maybe (b, a)
f = Seq a -> b -> Seq a
unfoldl' forall a. Seq a
empty
where unfoldl' :: Seq a -> b -> Seq a
unfoldl' !Seq a
as b
b = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Seq a
as (\ (b
b', a
a) -> Seq a -> b -> Seq a
unfoldl' (a
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 :: forall a. Int -> (a -> a) -> a -> Seq a
iterateN Int
n a -> a
f a
x
| Int
n forall a. Ord a => a -> a -> Bool
>= Int
0 = forall (f :: * -> *) a. Applicative f => Int -> f a -> f (Seq a)
replicateA Int
n (forall s a. (s -> (s, a)) -> State s a
State (\ a
y -> (a -> a
f a
y, a
y))) forall s a. State s a -> s -> a
`execState` a
x
| Bool
otherwise = forall a. HasCallStack => [Char] -> a
error [Char]
"iterateN takes a nonnegative integer argument"
null :: Seq a -> Bool
null :: forall a. Seq a -> Bool
null (Seq FingerTree (Elem a)
EmptyT) = Bool
True
null Seq a
_ = Bool
False
length :: Seq a -> Int
length :: forall a. Seq a -> Int
length (Seq FingerTree (Elem a)
xs) = 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
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, ViewL a -> ViewL a -> Bool
ViewL a -> ViewL a -> Ordering
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
Ord, Int -> ViewL a -> ShowS
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)
ReadS [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 :: forall a b. (a -> b) -> ViewL a -> ViewL b
fmap a -> b
_ ViewL a
EmptyL = forall a. ViewL a
EmptyL
fmap a -> b
f (a
x :< Seq a
xs) = a -> b
f a
x forall a. a -> Seq a -> ViewL a
:< forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Seq a
xs
instance Foldable ViewL where
foldMap :: forall m a. Monoid m => (a -> m) -> ViewL a -> m
foldMap a -> m
_ ViewL a
EmptyL = forall a. Monoid a => a
mempty
foldMap a -> m
f (a
x :< Seq a
xs) = a -> m
f a
x forall m. Monoid m => m -> m -> m
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f Seq a
xs
foldr :: forall a b. (a -> b -> b) -> b -> ViewL a -> b
foldr a -> b -> b
_ b
z ViewL a
EmptyL = b
z
foldr a -> b -> b
f b
z (a
x :< Seq a
xs) = a -> b -> b
f a
x (forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> b -> b
f b
z Seq a
xs)
foldl :: forall b a. (b -> a -> b) -> b -> ViewL a -> b
foldl b -> a -> b
_ b
z ViewL a
EmptyL = b
z
foldl b -> a -> b
f b
z (a
x :< Seq a
xs) = 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 :: forall a. (a -> a -> a) -> ViewL a -> a
foldl1 a -> a -> a
_ ViewL a
EmptyL = forall a. HasCallStack => [Char] -> a
error [Char]
"foldl1: empty view"
foldl1 a -> a -> a
f (a
x :< Seq a
xs) = 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 :: forall a. ViewL a -> Bool
null ViewL a
EmptyL = Bool
True
null (a
_ :< Seq a
_) = Bool
False
length :: forall a. ViewL a -> Int
length ViewL a
EmptyL = Int
0
length (a
_ :< Seq a
xs) = Int
1 forall a. Num a => a -> a -> a
+ forall a. Seq a -> Int
length Seq a
xs
#endif
instance Traversable ViewL where
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ViewL a -> f (ViewL b)
traverse a -> f b
_ ViewL a
EmptyL = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. ViewL a
EmptyL
traverse a -> f b
f (a
x :< Seq a
xs) = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a. a -> Seq a -> ViewL a
(:<) (a -> f b
f a
x) (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 :: forall a. Seq a -> ViewL a
viewl (Seq FingerTree (Elem a)
xs) = case forall a. Sized a => FingerTree a -> ViewLTree a
viewLTree FingerTree (Elem a)
xs of
ViewLTree (Elem a)
EmptyLTree -> forall a. ViewL a
EmptyL
ConsLTree (Elem a
x) FingerTree (Elem a)
xs' -> a
x forall a. a -> Seq a -> ViewL 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 :: forall a. Sized a => FingerTree a -> ViewLTree a
viewLTree FingerTree a
EmptyT = forall a. ViewLTree a
EmptyLTree
viewLTree (Single a
a) = forall a. a -> FingerTree a -> ViewLTree a
ConsLTree a
a forall a. FingerTree a
EmptyT
viewLTree (Deep Int
s (One a
a) FingerTree (Node a)
m Digit a
sf) = forall a. a -> FingerTree a -> ViewLTree a
ConsLTree a
a (forall a. Int -> FingerTree (Node a) -> Digit a -> FingerTree a
pullL (Int
s forall a. Num a => a -> a -> a
- forall a. Sized a => a -> Int
size a
a) FingerTree (Node a)
m Digit a
sf)
viewLTree (Deep Int
s (Two a
a a
b) FingerTree (Node a)
m Digit a
sf) =
forall a. a -> FingerTree a -> ViewLTree a
ConsLTree a
a (forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s forall a. Num a => a -> a -> a
- forall a. Sized a => a -> Int
size a
a) (forall a. a -> Digit a
One a
b) FingerTree (Node a)
m Digit a
sf)
viewLTree (Deep Int
s (Three a
a a
b a
c) FingerTree (Node a)
m Digit a
sf) =
forall a. a -> FingerTree a -> ViewLTree a
ConsLTree a
a (forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s forall a. Num a => a -> a -> a
- forall a. Sized a => a -> Int
size a
a) (forall a. a -> a -> Digit a
Two a
b a
c) FingerTree (Node a)
m Digit a
sf)
viewLTree (Deep Int
s (Four a
a a
b a
c a
d) FingerTree (Node a)
m Digit a
sf) =
forall a. a -> FingerTree a -> ViewLTree a
ConsLTree a
a (forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s forall a. Num a => a -> a -> a
- forall a. Sized a => a -> Int
size a
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
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, ViewR a -> ViewR a -> Bool
ViewR a -> ViewR a -> Ordering
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
Ord, Int -> ViewR a -> ShowS
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)
ReadS [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 :: forall a b. (a -> b) -> ViewR a -> ViewR b
fmap a -> b
_ ViewR a
EmptyR = forall a. ViewR a
EmptyR
fmap a -> b
f (Seq a
xs :> a
x) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Seq a
xs forall a. Seq a -> a -> ViewR a
:> a -> b
f a
x
instance Foldable ViewR where
foldMap :: forall m a. Monoid m => (a -> m) -> ViewR a -> m
foldMap a -> m
_ ViewR a
EmptyR = forall a. Monoid a => a
mempty
foldMap a -> m
f (Seq a
xs :> a
x) = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f Seq a
xs forall m. Monoid m => m -> m -> m
<> a -> m
f a
x
foldr :: forall a b. (a -> b -> b) -> b -> ViewR a -> b
foldr a -> b -> b
_ b
z ViewR a
EmptyR = b
z
foldr a -> b -> b
f b
z (Seq a
xs :> a
x) = 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 :: forall b a. (b -> a -> b) -> b -> ViewR a -> b
foldl b -> a -> b
_ b
z ViewR a
EmptyR = b
z
foldl b -> a -> b
f b
z (Seq a
xs :> a
x) = 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 :: forall a. (a -> a -> a) -> ViewR a -> a
foldr1 a -> a -> a
_ ViewR a
EmptyR = forall a. HasCallStack => [Char] -> a
error [Char]
"foldr1: empty view"
foldr1 a -> a -> a
f (Seq a
xs :> a
x) = 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 :: forall a. ViewR a -> Bool
null ViewR a
EmptyR = Bool
True
null (Seq a
_ :> a
_) = Bool
False
length :: forall a. ViewR a -> Int
length ViewR a
EmptyR = Int
0
length (Seq a
xs :> a
_) = forall a. Seq a -> Int
length Seq a
xs forall a. Num a => a -> a -> a
+ Int
1
#endif
instance Traversable ViewR where
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ViewR a -> f (ViewR b)
traverse a -> f b
_ ViewR a
EmptyR = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. ViewR a
EmptyR
traverse a -> f b
f (Seq a
xs :> a
x) = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a. Seq a -> a -> ViewR a
(:>) (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 :: forall a. Seq a -> ViewR a
viewr (Seq FingerTree (Elem a)
xs) = case forall a. Sized a => FingerTree a -> ViewRTree a
viewRTree FingerTree (Elem a)
xs of
ViewRTree (Elem a)
EmptyRTree -> forall a. ViewR a
EmptyR
SnocRTree FingerTree (Elem a)
xs' (Elem a
x) -> forall a. FingerTree (Elem a) -> Seq a
Seq FingerTree (Elem a)
xs' 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 :: forall a. Sized a => FingerTree a -> ViewRTree a
viewRTree FingerTree a
EmptyT = forall a. ViewRTree a
EmptyRTree
viewRTree (Single a
z) = forall a. FingerTree a -> a -> ViewRTree a
SnocRTree forall a. FingerTree a
EmptyT a
z
viewRTree (Deep Int
s Digit a
pr FingerTree (Node a)
m (One a
z)) = forall a. FingerTree a -> a -> ViewRTree a
SnocRTree (forall a. Int -> Digit a -> FingerTree (Node a) -> FingerTree a
pullR (Int
s forall a. Num a => a -> a -> a
- forall a. Sized a => a -> Int
size a
z) Digit a
pr FingerTree (Node a)
m) a
z
viewRTree (Deep Int
s Digit a
pr FingerTree (Node a)
m (Two a
y a
z)) =
forall a. FingerTree a -> a -> ViewRTree a
SnocRTree (forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s forall a. Num a => a -> a -> a
- forall a. Sized a => a -> Int
size a
z) Digit a
pr FingerTree (Node a)
m (forall a. a -> Digit a
One a
y)) a
z
viewRTree (Deep Int
s Digit a
pr FingerTree (Node a)
m (Three a
x a
y a
z)) =
forall a. FingerTree a -> a -> ViewRTree a
SnocRTree (forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s forall a. Num a => a -> a -> a
- forall a. Sized a => a -> Int
size a
z) Digit a
pr FingerTree (Node a)
m (forall a. a -> a -> Digit a
Two a
x a
y)) a
z
viewRTree (Deep Int
s Digit a
pr FingerTree (Node a)
m (Four a
w a
x a
y a
z)) =
forall a. FingerTree a -> a -> ViewRTree a
SnocRTree (forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s forall a. Num a => a -> a -> a
- forall a. Sized a => a -> Int
size a
z) Digit a
pr FingerTree (Node a)
m (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 :: forall a b. (a -> b -> a) -> a -> Seq b -> Seq a
scanl a -> b -> a
f a
z0 Seq b
xs = a
z0 forall a. a -> Seq a -> Seq a
<| forall a b. (a, b) -> b
snd (forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
mapAccumL (\ a
x 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 :: forall a. (a -> a -> a) -> Seq a -> Seq a
scanl1 a -> a -> a
f Seq a
xs = case forall a. Seq a -> ViewL a
viewl Seq a
xs of
ViewL a
EmptyL -> forall a. HasCallStack => [Char] -> a
error [Char]
"scanl1 takes a nonempty sequence as an argument"
a
x :< Seq a
xs' -> 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 :: forall a b. (a -> b -> b) -> b -> Seq a -> Seq b
scanr a -> b -> b
f b
z0 Seq a
xs = forall a b. (a, b) -> b
snd (forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
mapAccumR (\ b
z a
x -> let z' :: b
z' = a -> b -> b
f a
x b
z in (b
z', b
z')) b
z0 Seq a
xs) forall a. Seq a -> a -> Seq a
|> b
z0
scanr1 :: (a -> a -> a) -> Seq a -> Seq a
scanr1 :: forall a. (a -> a -> a) -> Seq a -> Seq a
scanr1 a -> a -> a
f Seq a
xs = case forall a. Seq a -> ViewR a
viewr Seq a
xs of
ViewR a
EmptyR -> forall a. HasCallStack => [Char] -> a
error [Char]
"scanr1 takes a nonempty sequence as an argument"
Seq a
xs' :> a
x -> 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 :: forall a. Seq a -> Int -> a
index (Seq FingerTree (Elem a)
xs) Int
i
| forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i forall a. Ord a => a -> a -> Bool
< (forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Sized a => a -> Int
size FingerTree (Elem a)
xs) :: Word) = case forall a. Sized a => Int -> FingerTree a -> Place a
lookupTree Int
i FingerTree (Elem a)
xs of
Place Int
_ (Elem a
x) -> a
x
| Bool
otherwise =
forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"index out of bounds in call to: Data.Sequence.index " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
i
lookup :: Int -> Seq a -> Maybe a
lookup :: forall a. Int -> Seq a -> Maybe a
lookup Int
i (Seq FingerTree (Elem a)
xs)
| forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i forall a. Ord a => a -> a -> Bool
< (forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Sized a => a -> Int
size FingerTree (Elem a)
xs) :: Word) = case forall a. Sized a => Int -> FingerTree a -> Place a
lookupTree Int
i FingerTree (Elem a)
xs of
Place Int
_ (Elem a
x) -> forall a. a -> Maybe a
Just a
x
| Bool
otherwise = forall a. Maybe a
Nothing
(!?) :: Seq a -> Int -> Maybe a
!? :: forall a. Seq a -> Int -> Maybe a
(!?) = forall a b c. (a -> b -> c) -> b -> a -> c
flip 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 :: forall a. Sized a => Int -> FingerTree a -> Place a
lookupTree !Int
_ FingerTree a
EmptyT = forall a. HasCallStack => [Char] -> a
error [Char]
"lookupTree of empty tree"
lookupTree Int
i (Single a
x) = forall a. Int -> a -> Place a
Place Int
i a
x
lookupTree Int
i (Deep Int
_ Digit a
pr FingerTree (Node a)
m Digit a
sf)
| Int
i forall a. Ord a => a -> a -> Bool
< Int
spr = forall a. Sized a => Int -> Digit a -> Place a
lookupDigit Int
i Digit a
pr
| Int
i forall a. Ord a => a -> a -> Bool
< Int
spm = case forall a. Sized a => Int -> FingerTree a -> Place a
lookupTree (Int
i forall a. Num a => a -> a -> a
- Int
spr) FingerTree (Node a)
m of
Place Int
i' Node a
xs -> forall a. Sized a => Int -> Node a -> Place a
lookupNode Int
i' Node a
xs
| Bool
otherwise = forall a. Sized a => Int -> Digit a -> Place a
lookupDigit (Int
i forall a. Num a => a -> a -> a
- Int
spm) Digit a
sf
where
spr :: Int
spr = forall a. Sized a => a -> Int
size Digit a
pr
spm :: Int
spm = Int
spr forall a. Num a => a -> a -> a
+ 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 :: forall a. Sized a => Int -> Node a -> Place a
lookupNode Int
i (Node2 Int
_ a
a a
b)
| Int
i forall a. Ord a => a -> a -> Bool
< Int
sa = forall a. Int -> a -> Place a
Place Int
i a
a
| Bool
otherwise = forall a. Int -> a -> Place a
Place (Int
i forall a. Num a => a -> a -> a
- Int
sa) a
b
where
sa :: Int
sa = forall a. Sized a => a -> Int
size a
a
lookupNode Int
i (Node3 Int
_ a
a a
b a
c)
| Int
i forall a. Ord a => a -> a -> Bool
< Int
sa = forall a. Int -> a -> Place a
Place Int
i a
a
| Int
i forall a. Ord a => a -> a -> Bool
< Int
sab = forall a. Int -> a -> Place a
Place (Int
i forall a. Num a => a -> a -> a
- Int
sa) a
b
| Bool
otherwise = forall a. Int -> a -> Place a
Place (Int
i forall a. Num a => a -> a -> a
- Int
sab) a
c
where
sa :: Int
sa = forall a. Sized a => a -> Int
size a
a
sab :: Int
sab = Int
sa forall a. Num a => a -> a -> a
+ 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 :: forall a. Sized a => Int -> Digit a -> Place a
lookupDigit Int
i (One a
a) = forall a. Int -> a -> Place a
Place Int
i a
a
lookupDigit Int
i (Two a
a a
b)
| Int
i forall a. Ord a => a -> a -> Bool
< Int
sa = forall a. Int -> a -> Place a
Place Int
i a
a
| Bool
otherwise = forall a. Int -> a -> Place a
Place (Int
i forall a. Num a => a -> a -> a
- Int
sa) a
b
where
sa :: Int
sa = forall a. Sized a => a -> Int
size a
a
lookupDigit Int
i (Three a
a a
b a
c)
| Int
i forall a. Ord a => a -> a -> Bool
< Int
sa = forall a. Int -> a -> Place a
Place Int
i a
a
| Int
i forall a. Ord a => a -> a -> Bool
< Int
sab = forall a. Int -> a -> Place a
Place (Int
i forall a. Num a => a -> a -> a
- Int
sa) a
b
| Bool
otherwise = forall a. Int -> a -> Place a
Place (Int
i forall a. Num a => a -> a -> a
- Int
sab) a
c
where
sa :: Int
sa = forall a. Sized a => a -> Int
size a
a
sab :: Int
sab = Int
sa forall a. Num a => a -> a -> a
+ forall a. Sized a => a -> Int
size a
b
lookupDigit Int
i (Four a
a a
b a
c a
d)
| Int
i forall a. Ord a => a -> a -> Bool
< Int
sa = forall a. Int -> a -> Place a
Place Int
i a
a
| Int
i forall a. Ord a => a -> a -> Bool
< Int
sab = forall a. Int -> a -> Place a
Place (Int
i forall a. Num a => a -> a -> a
- Int
sa) a
b
| Int
i forall a. Ord a => a -> a -> Bool
< Int
sabc = forall a. Int -> a -> Place a
Place (Int
i forall a. Num a => a -> a -> a
- Int
sab) a
c
| Bool
otherwise = forall a. Int -> a -> Place a
Place (Int
i forall a. Num a => a -> a -> a
- Int
sabc) a
d
where
sa :: Int
sa = forall a. Sized a => a -> Int
size a
a
sab :: Int
sab = Int
sa forall a. Num a => a -> a -> a
+ forall a. Sized a => a -> Int
size a
b
sabc :: Int
sabc = Int
sab forall a. Num a => a -> a -> a
+ forall a. Sized a => a -> Int
size a
c
update :: Int -> a -> Seq a -> Seq a
update :: forall a. Int -> a -> Seq a -> Seq a
update Int
i a
x (Seq FingerTree (Elem a)
xs)
| forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i forall a. Ord a => a -> a -> Bool
< (forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Sized a => a -> Int
size FingerTree (Elem a)
xs) :: Word) = forall a. FingerTree (Elem a) -> Seq a
Seq (forall a.
Elem a -> Int -> FingerTree (Elem a) -> FingerTree (Elem a)
updateTree (forall a. a -> Elem a
Elem a
x) Int
i FingerTree (Elem a)
xs)
| Bool
otherwise = forall a. FingerTree (Elem a) -> Seq a
Seq FingerTree (Elem a)
xs
updateTree :: Elem a -> Int -> FingerTree (Elem a) -> FingerTree (Elem a)
updateTree :: forall a.
Elem a -> Int -> FingerTree (Elem a) -> FingerTree (Elem a)
updateTree Elem a
_ !Int
_ FingerTree (Elem a)
EmptyT = forall a. FingerTree a
EmptyT
updateTree Elem a
v Int
_i (Single Elem a
_) = forall a. a -> FingerTree a
Single Elem a
v
updateTree Elem a
v Int
i (Deep Int
s Digit (Elem a)
pr FingerTree (Node (Elem a))
m Digit (Elem a)
sf)
| Int
i forall a. Ord a => a -> a -> Bool
< Int
spr = forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
s (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 forall a. Ord a => a -> a -> Bool
< Int
spm = let !m' :: FingerTree (Node (Elem a))
m' = forall a.
(Sized a, MaybeForce a) =>
(Int -> a -> a) -> Int -> FingerTree a -> FingerTree a
adjustTree (forall a. Elem a -> Int -> Node (Elem a) -> Node (Elem a)
updateNode Elem a
v) (Int
i forall a. Num a => a -> a -> a
- Int
spr) FingerTree (Node (Elem a))
m
in 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 = forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
s Digit (Elem a)
pr FingerTree (Node (Elem a))
m (forall a. Elem a -> Int -> Digit (Elem a) -> Digit (Elem a)
updateDigit Elem a
v (Int
i forall a. Num a => a -> a -> a
- Int
spm) Digit (Elem a)
sf)
where
spr :: Int
spr = forall a. Sized a => a -> Int
size Digit (Elem a)
pr
spm :: Int
spm = Int
spr forall a. Num a => a -> a -> a
+ forall a. Sized a => a -> Int
size FingerTree (Node (Elem a))
m
updateNode :: Elem a -> Int -> Node (Elem a) -> Node (Elem a)
updateNode :: forall a. Elem a -> Int -> Node (Elem a) -> Node (Elem a)
updateNode Elem a
v Int
i (Node2 Int
s Elem a
a Elem a
b)
| Int
i forall a. Ord a => a -> a -> Bool
< Int
sa = forall a. Int -> a -> a -> Node a
Node2 Int
s Elem a
v Elem a
b
| Bool
otherwise = forall a. Int -> a -> a -> Node a
Node2 Int
s Elem a
a Elem a
v
where
sa :: Int
sa = forall a. Sized a => a -> Int
size Elem a
a
updateNode Elem a
v Int
i (Node3 Int
s Elem a
a Elem a
b Elem a
c)
| Int
i forall a. Ord a => a -> a -> Bool
< Int
sa = forall a. Int -> a -> a -> a -> Node a
Node3 Int
s Elem a
v Elem a
b Elem a
c
| Int
i forall a. Ord a => a -> a -> Bool
< Int
sab = forall a. Int -> a -> a -> a -> Node a
Node3 Int
s Elem a
a Elem a
v Elem a
c
| Bool
otherwise = forall a. Int -> a -> a -> a -> Node a
Node3 Int
s Elem a
a Elem a
b Elem a
v
where
sa :: Int
sa = forall a. Sized a => a -> Int
size Elem a
a
sab :: Int
sab = Int
sa forall a. Num a => a -> a -> a
+ forall a. Sized a => a -> Int
size Elem a
b
updateDigit :: Elem a -> Int -> Digit (Elem a) -> Digit (Elem a)
updateDigit :: forall a. Elem a -> Int -> Digit (Elem a) -> Digit (Elem a)
updateDigit Elem a
v !Int
_i (One Elem a
_) = forall a. a -> Digit a
One Elem a
v
updateDigit Elem a
v Int
i (Two Elem a
a Elem a
b)
| Int
i forall a. Ord a => a -> a -> Bool
< Int
sa = forall a. a -> a -> Digit a
Two Elem a
v Elem a
b
| Bool
otherwise = forall a. a -> a -> Digit a
Two Elem a
a Elem a
v
where
sa :: Int
sa = forall a. Sized a => a -> Int
size Elem a
a
updateDigit Elem a
v Int
i (Three Elem a
a Elem a
b Elem a
c)
| Int
i forall a. Ord a => a -> a -> Bool
< Int
sa = forall a. a -> a -> a -> Digit a
Three Elem a
v Elem a
b Elem a
c
| Int
i forall a. Ord a => a -> a -> Bool
< Int
sab = forall a. a -> a -> a -> Digit a
Three Elem a
a Elem a
v Elem a
c
| Bool
otherwise = forall a. a -> a -> a -> Digit a
Three Elem a
a Elem a
b Elem a
v
where
sa :: Int
sa = forall a. Sized a => a -> Int
size Elem a
a
sab :: Int
sab = Int
sa forall a. Num a => a -> a -> a
+ forall a. Sized a => a -> Int
size Elem a
b
updateDigit Elem a
v Int
i (Four Elem a
a Elem a
b Elem a
c Elem a
d)
| Int
i forall a. Ord a => a -> a -> Bool
< Int
sa = forall a. a -> a -> a -> a -> Digit a
Four Elem a
v Elem a
b Elem a
c Elem a
d
| Int
i forall a. Ord a => a -> a -> Bool
< Int
sab = forall a. a -> a -> a -> a -> Digit a
Four Elem a
a Elem a
v Elem a
c Elem a
d
| Int
i forall a. Ord a => a -> a -> Bool
< Int
sabc = forall a. a -> a -> a -> a -> Digit a
Four Elem a
a Elem a
b Elem a
v Elem a
d
| Bool
otherwise = 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 = forall a. Sized a => a -> Int
size Elem a
a
sab :: Int
sab = Int
sa forall a. Num a => a -> a -> a
+ forall a. Sized a => a -> Int
size Elem a
b
sabc :: Int
sabc = Int
sab forall a. Num a => a -> a -> a
+ forall a. Sized a => a -> Int
size Elem a
c
adjust :: (a -> a) -> Int -> Seq a -> Seq a
adjust :: forall a. (a -> a) -> Int -> Seq a -> Seq a
adjust a -> a
f Int
i (Seq FingerTree (Elem a)
xs)
| forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i forall a. Ord a => a -> a -> Bool
< (forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Sized a => a -> Int
size FingerTree (Elem a)
xs) :: Word) = forall a. FingerTree (Elem a) -> Seq a
Seq (forall a.
(Sized a, MaybeForce a) =>
(Int -> a -> a) -> Int -> FingerTree a -> FingerTree a
adjustTree (seq :: forall a b. a -> b -> b
`seq` forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
f) Int
i FingerTree (Elem a)
xs)
| Bool
otherwise = 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' :: forall a. (a -> a) -> Int -> Seq a -> Seq a
adjust' a -> a
f Int
i Seq a
xs
| forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i forall a. Ord a => a -> a -> Bool
< (forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Seq a -> Int
length Seq a
xs) :: Word) =
coerce :: forall a b. Coercible a b => a -> b
coerce forall a b. (a -> b) -> a -> b
$ forall a.
(Sized a, MaybeForce a) =>
(Int -> a -> a) -> Int -> FingerTree a -> FingerTree a
adjustTree (\ !Int
_k (ForceBox a
a) -> forall a. a -> ForceBox a
ForceBox (a -> a
f a
a)) Int
i (coerce :: 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 :: forall a.
(Sized a, MaybeForce a) =>
(Int -> a -> a) -> Int -> FingerTree a -> FingerTree a
adjustTree Int -> a -> a
_ !Int
_ FingerTree a
EmptyT = forall a. FingerTree a
EmptyT
adjustTree Int -> a -> a
f Int
i (Single a
x) = forall a. a -> FingerTree a
Single forall a b. MaybeForce a => (a -> b) -> a -> b
$!? Int -> a -> a
f Int
i a
x
adjustTree Int -> a -> a
f Int
i (Deep Int
s Digit a
pr FingerTree (Node a)
m Digit a
sf)
| Int
i forall a. Ord a => a -> a -> Bool
< Int
spr = forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
s (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 forall a. Ord a => a -> a -> Bool
< Int
spm = let !m' :: FingerTree (Node a)
m' = forall a.
(Sized a, MaybeForce a) =>
(Int -> a -> a) -> Int -> FingerTree a -> FingerTree a
adjustTree (forall a.
(Sized a, MaybeForce a) =>
(Int -> a -> a) -> Int -> Node a -> Node a
adjustNode Int -> a -> a
f) (Int
i forall a. Num a => a -> a -> a
- Int
spr) FingerTree (Node a)
m
in 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 = forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
s Digit a
pr FingerTree (Node a)
m (forall a.
(Sized a, MaybeForce a) =>
(Int -> a -> a) -> Int -> Digit a -> Digit a
adjustDigit Int -> a -> a
f (Int
i forall a. Num a => a -> a -> a
- Int
spm) Digit a
sf)
where
spr :: Int
spr = forall a. Sized a => a -> Int
size Digit a
pr
spm :: Int
spm = Int
spr forall a. Num a => a -> a -> a
+ 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 :: forall a.
(Sized a, MaybeForce a) =>
(Int -> a -> a) -> Int -> Node a -> Node a
adjustNode Int -> a -> a
f Int
i (Node2 Int
s a
a a
b)
| Int
i forall a. Ord a => a -> a -> Bool
< Int
sa = let fia :: a
fia = Int -> a -> a
f Int
i a
a in a
fia forall a b. MaybeForce a => a -> b -> b
`mseq` 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 forall a. Num a => a -> a -> a
- Int
sa) a
b in a
fisab forall a b. MaybeForce a => a -> b -> b
`mseq` forall a. Int -> a -> a -> Node a
Node2 Int
s a
a a
fisab
where
sa :: Int
sa = forall a. Sized a => a -> Int
size a
a
adjustNode Int -> a -> a
f Int
i (Node3 Int
s a
a a
b a
c)
| Int
i forall a. Ord a => a -> a -> Bool
< Int
sa = let fia :: a
fia = Int -> a -> a
f Int
i a
a in a
fia forall a b. MaybeForce a => a -> b -> b
`mseq` forall a. Int -> a -> a -> a -> Node a
Node3 Int
s a
fia a
b a
c
| Int
i forall a. Ord a => a -> a -> Bool
< Int
sab = let fisab :: a
fisab = Int -> a -> a
f (Int
i forall a. Num a => a -> a -> a
- Int
sa) a
b in a
fisab forall a b. MaybeForce a => a -> b -> b
`mseq` 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 forall a. Num a => a -> a -> a
- Int
sab) a
c in a
fisabc forall a b. MaybeForce a => a -> b -> b
`mseq` forall a. Int -> a -> a -> a -> Node a
Node3 Int
s a
a a
b a
fisabc
where
sa :: Int
sa = forall a. Sized a => a -> Int
size a
a
sab :: Int
sab = Int
sa forall a. Num a => a -> a -> a
+ 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 :: forall a.
(Sized a, MaybeForce a) =>
(Int -> a -> a) -> Int -> Digit a -> Digit a
adjustDigit Int -> a -> a
f !Int
i (One a
a) = forall a. a -> Digit a
One forall a b. MaybeForce a => (a -> b) -> a -> b
$!? Int -> a -> a
f Int
i a
a
adjustDigit Int -> a -> a
f Int
i (Two a
a a
b)
| Int
i forall a. Ord a => a -> a -> Bool
< Int
sa = let fia :: a
fia = Int -> a -> a
f Int
i a
a in a
fia forall a b. MaybeForce a => a -> b -> b
`mseq` forall a. a -> a -> Digit a
Two a
fia a
b
| Bool
otherwise = let fisab :: a
fisab = Int -> a -> a
f (Int
i forall a. Num a => a -> a -> a
- Int
sa) a
b in a
fisab forall a b. MaybeForce a => a -> b -> b
`mseq` forall a. a -> a -> Digit a
Two a
a a
fisab
where
sa :: Int
sa = forall a. Sized a => a -> Int
size a
a
adjustDigit Int -> a -> a
f Int
i (Three a
a a
b a
c)
| Int
i forall a. Ord a => a -> a -> Bool
< Int
sa = let fia :: a
fia = Int -> a -> a
f Int
i a
a in a
fia forall a b. MaybeForce a => a -> b -> b
`mseq` forall a. a -> a -> a -> Digit a
Three a
fia a
b a
c
| Int
i forall a. Ord a => a -> a -> Bool
< Int
sab = let fisab :: a
fisab = Int -> a -> a
f (Int
i forall a. Num a => a -> a -> a
- Int
sa) a
b in a
fisab forall a b. MaybeForce a => a -> b -> b
`mseq` 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 forall a. Num a => a -> a -> a
- Int
sab) a
c in a
fisabc forall a b. MaybeForce a => a -> b -> b
`mseq` forall a. a -> a -> a -> Digit a
Three a
a a
b a
fisabc
where
sa :: Int
sa = forall a. Sized a => a -> Int
size a
a
sab :: Int
sab = Int
sa forall a. Num a => a -> a -> a
+ forall a. Sized a => a -> Int
size a
b
adjustDigit Int -> a -> a
f Int
i (Four a
a a
b a
c a
d)
| Int
i forall a. Ord a => a -> a -> Bool
< Int
sa = let fia :: a
fia = Int -> a -> a
f Int
i a
a in a
fia forall a b. MaybeForce a => a -> b -> b
`mseq` forall a. a -> a -> a -> a -> Digit a
Four a
fia a
b a
c a
d
| Int
i forall a. Ord a => a -> a -> Bool
< Int
sab = let fisab :: a
fisab = Int -> a -> a
f (Int
i forall a. Num a => a -> a -> a
- Int
sa) a
b in a
fisab forall a b. MaybeForce a => a -> b -> b
`mseq` forall a. a -> a -> a -> a -> Digit a
Four a
a a
fisab a
c a
d
| Int
i forall a. Ord a => a -> a -> Bool
< Int
sabc = let fisabc :: a
fisabc = Int -> a -> a
f (Int
i forall a. Num a => a -> a -> a
- Int
sab) a
c in a
fisabc forall a b. MaybeForce a => a -> b -> b
`mseq` 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 forall a. Num a => a -> a -> a
- Int
sabc) a
d in a
fisabcd forall a b. MaybeForce a => a -> b -> b
`mseq` forall a. a -> a -> a -> a -> Digit a
Four a
a a
b a
c a
fisabcd
where
sa :: Int
sa = forall a. Sized a => a -> Int
size a
a
sab :: Int
sab = Int
sa forall a. Num a => a -> a -> a
+ forall a. Sized a => a -> Int
size a
b
sabc :: Int
sabc = Int
sab forall a. Num a => a -> a -> a
+ forall a. Sized a => a -> Int
size a
c
insertAt :: Int -> a -> Seq a -> Seq a
insertAt :: forall a. Int -> a -> Seq a -> Seq a
insertAt Int
i a
a s :: Seq a
s@(Seq FingerTree (Elem a)
xs)
| forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i forall a. Ord a => a -> a -> Bool
< (forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Sized a => a -> Int
size FingerTree (Elem a)
xs) :: Word)
= forall a. FingerTree (Elem a) -> Seq a
Seq (forall a.
Sized a =>
(Int -> a -> Ins a) -> Int -> FingerTree a -> FingerTree a
insTree (seq :: forall a b. a -> b -> b
`seq` forall a. a -> a -> Ins a
InsTwo (forall a. a -> Elem a
Elem a
a)) Int
i FingerTree (Elem a)
xs)
| Int
i forall a. Ord a => a -> a -> Bool
<= Int
0 = a
a forall a. a -> Seq a -> Seq a
<| Seq a
s
| Bool
otherwise = Seq a
s 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 :: forall a.
Sized a =>
(Int -> a -> Ins a) -> Int -> FingerTree a -> FingerTree a
insTree Int -> a -> Ins a
_ !Int
_ FingerTree a
EmptyT = forall a. FingerTree a
EmptyT
insTree Int -> a -> Ins a
f Int
i (Single a
x) = case Int -> a -> Ins a
f Int
i a
x of
InsOne a
x' -> forall a. a -> FingerTree a
Single a
x'
InsTwo a
m a
n -> forall a.
Sized a =>
Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
deep (forall a. a -> Digit a
One a
m) forall a. FingerTree a
EmptyT (forall a. a -> Digit a
One a
n)
insTree Int -> a -> Ins a
f Int
i (Deep Int
s Digit a
pr FingerTree (Node a)
m Digit a
sf)
| Int
i forall a. Ord a => a -> a -> Bool
< Int
spr = case 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 Digit a
pr' -> forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s forall a. Num a => a -> a -> a
+ Int
1) Digit a
pr' FingerTree (Node a)
m Digit a
sf
InsDigNode Digit a
pr' Node a
n -> FingerTree (Node a)
m seq :: forall a b. a -> b -> b
`seq` forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s forall a. Num a => a -> a -> a
+ Int
1) Digit a
pr' (Node a
n forall a. Sized a => a -> FingerTree a -> FingerTree a
`consTree` FingerTree (Node a)
m) Digit a
sf
| Int
i forall a. Ord a => a -> a -> Bool
< Int
spm = let !m' :: FingerTree (Node a)
m' = forall a.
Sized a =>
(Int -> a -> Ins a) -> Int -> FingerTree a -> FingerTree a
insTree (forall a.
Sized a =>
(Int -> a -> Ins a) -> Int -> Node a -> Ins (Node a)
insNode Int -> a -> Ins a
f) (Int
i forall a. Num a => a -> a -> a
- Int
spr) FingerTree (Node a)
m
in forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s forall a. Num a => a -> a -> a
+ Int
1) Digit a
pr FingerTree (Node a)
m' Digit a
sf
| Bool
otherwise = case forall a.
Sized a =>
(Int -> a -> Ins a) -> Int -> Digit a -> InsNodeDig a
insRightDigit Int -> a -> Ins a
f (Int
i forall a. Num a => a -> a -> a
- Int
spm) Digit a
sf of
InsRightDig Digit a
sf' -> forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s forall a. Num a => a -> a -> a
+ Int
1) Digit a
pr FingerTree (Node a)
m Digit a
sf'
InsNodeDig Node a
n Digit a
sf' -> FingerTree (Node a)
m seq :: forall a b. a -> b -> b
`seq` forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s forall a. Num a => a -> a -> a
+ Int
1) Digit a
pr (FingerTree (Node a)
m forall a. Sized a => FingerTree a -> a -> FingerTree a
`snocTree` Node a
n) Digit a
sf'
where
spr :: Int
spr = forall a. Sized a => a -> Int
size Digit a
pr
spm :: Int
spm = Int
spr forall a. Num a => a -> a -> a
+ 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 :: forall a.
Sized a =>
(Int -> a -> Ins a) -> Int -> Node a -> Ins (Node a)
insNode Int -> a -> Ins a
f Int
i (Node2 Int
s a
a a
b)
| Int
i forall a. Ord a => a -> a -> Bool
< Int
sa = case Int -> a -> Ins a
f Int
i a
a of
InsOne a
n -> forall a. a -> Ins a
InsOne forall a b. (a -> b) -> a -> b
$ forall a. Int -> a -> a -> Node a
Node2 (Int
s forall a. Num a => a -> a -> a
+ Int
1) a
n a
b
InsTwo a
m a
n -> forall a. a -> Ins a
InsOne forall a b. (a -> b) -> a -> b
$ forall a. Int -> a -> a -> a -> Node a
Node3 (Int
s forall a. Num a => a -> a -> a
+ Int
1) a
m a
n a
b
| Bool
otherwise = case Int -> a -> Ins a
f (Int
i forall a. Num a => a -> a -> a
- Int
sa) a
b of
InsOne a
n -> forall a. a -> Ins a
InsOne forall a b. (a -> b) -> a -> b
$ forall a. Int -> a -> a -> Node a
Node2 (Int
s forall a. Num a => a -> a -> a
+ Int
1) a
a a
n
InsTwo a
m a
n -> forall a. a -> Ins a
InsOne forall a b. (a -> b) -> a -> b
$ forall a. Int -> a -> a -> a -> Node a
Node3 (Int
s forall a. Num a => a -> a -> a
+ Int
1) a
a a
m a
n
where sa :: Int
sa = forall a. Sized a => a -> Int
size a
a
insNode Int -> a -> Ins a
f Int
i (Node3 Int
s a
a a
b a
c)
| Int
i forall a. Ord a => a -> a -> Bool
< Int
sa = case Int -> a -> Ins a
f Int
i a
a of
InsOne a
n -> forall a. a -> Ins a
InsOne forall a b. (a -> b) -> a -> b
$ forall a. Int -> a -> a -> a -> Node a
Node3 (Int
s forall a. Num a => a -> a -> a
+ Int
1) a
n a
b a
c
InsTwo a
m a
n -> forall a. a -> a -> Ins a
InsTwo (forall a. Int -> a -> a -> Node a
Node2 (Int
sa forall a. Num a => a -> a -> a
+ Int
1) a
m a
n) (forall a. Int -> a -> a -> Node a
Node2 (Int
s forall a. Num a => a -> a -> a
- Int
sa) a
b a
c)
| Int
i forall a. Ord a => a -> a -> Bool
< Int
sab = case Int -> a -> Ins a
f (Int
i forall a. Num a => a -> a -> a
- Int
sa) a
b of
InsOne a
n -> forall a. a -> Ins a
InsOne forall a b. (a -> b) -> a -> b
$ forall a. Int -> a -> a -> a -> Node a
Node3 (Int
s forall a. Num a => a -> a -> a
+ Int
1) a
a a
n a
c
InsTwo a
m a
n -> forall a. a -> a -> Ins a
InsTwo Node a
am Node a
nc
where !am :: Node a
am = forall a. Sized a => a -> a -> Node a
node2 a
a a
m
!nc :: Node a
nc = forall a. Sized a => a -> a -> Node a
node2 a
n a
c
| Bool
otherwise = case Int -> a -> Ins a
f (Int
i forall a. Num a => a -> a -> a
- Int
sab) a
c of
InsOne a
n -> forall a. a -> Ins a
InsOne forall a b. (a -> b) -> a -> b
$ forall a. Int -> a -> a -> a -> Node a
Node3 (Int
s forall a. Num a => a -> a -> a
+ Int
1) a
a a
b a
n
InsTwo a
m a
n -> forall a. a -> a -> Ins a
InsTwo (forall a. Int -> a -> a -> Node a
Node2 Int
sab a
a a
b) (forall a. Int -> a -> a -> Node a
Node2 (Int
s forall a. Num a => a -> a -> a
- Int
sab forall a. Num a => a -> a -> a
+ Int
1) a
m a
n)
where sa :: Int
sa = forall a. Sized a => a -> Int
size a
a
sab :: Int
sab = Int
sa forall a. Num a => a -> a -> a
+ 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 :: forall a.
Sized a =>
(Int -> a -> Ins a) -> Int -> Digit a -> InsDigNode a
insLeftDigit Int -> a -> Ins a
f !Int
i (One a
a) = case Int -> a -> Ins a
f Int
i a
a of
InsOne a
a' -> forall a. Digit a -> InsDigNode a
InsLeftDig forall a b. (a -> b) -> a -> b
$ forall a. a -> Digit a
One a
a'
InsTwo a
a1 a
a2 -> forall a. Digit a -> InsDigNode a
InsLeftDig forall a b. (a -> b) -> a -> b
$ forall a. a -> a -> Digit a
Two a
a1 a
a2
insLeftDigit Int -> a -> Ins a
f Int
i (Two a
a a
b)
| Int
i forall a. Ord a => a -> a -> Bool
< Int
sa = case Int -> a -> Ins a
f Int
i a
a of
InsOne a
a' -> forall a. Digit a -> InsDigNode a
InsLeftDig forall a b. (a -> b) -> a -> b
$ forall a. a -> a -> Digit a
Two a
a' a
b
InsTwo a
a1 a
a2 -> forall a. Digit a -> InsDigNode a
InsLeftDig forall a b. (a -> b) -> a -> b
$ forall a. a -> a -> a -> Digit a
Three a
a1 a
a2 a
b
| Bool
otherwise = case Int -> a -> Ins a
f (Int
i forall a. Num a => a -> a -> a
- Int
sa) a
b of
InsOne a
b' -> forall a. Digit a -> InsDigNode a
InsLeftDig forall a b. (a -> b) -> a -> b
$ forall a. a -> a -> Digit a
Two a
a a
b'
InsTwo a
b1 a
b2 -> forall a. Digit a -> InsDigNode a
InsLeftDig forall a b. (a -> b) -> a -> b
$ forall a. a -> a -> a -> Digit a
Three a
a a
b1 a
b2
where sa :: Int
sa = forall a. Sized a => a -> Int
size a
a
insLeftDigit Int -> a -> Ins a
f Int
i (Three a
a a
b a
c)
| Int
i forall a. Ord a => a -> a -> Bool
< Int
sa = case Int -> a -> Ins a
f Int
i a
a of
InsOne a
a' -> forall a. Digit a -> InsDigNode a
InsLeftDig forall a b. (a -> b) -> a -> b
$ forall a. a -> a -> a -> Digit a
Three a
a' a
b a
c
InsTwo a
a1 a
a2 -> forall a. Digit a -> InsDigNode a
InsLeftDig forall a b. (a -> b) -> a -> b
$ forall a. a -> a -> a -> a -> Digit a
Four a
a1 a
a2 a
b a
c
| Int
i forall a. Ord a => a -> a -> Bool
< Int
sab = case Int -> a -> Ins a
f (Int
i forall a. Num a => a -> a -> a
- Int
sa) a
b of
InsOne a
b' -> forall a. Digit a -> InsDigNode a
InsLeftDig forall a b. (a -> b) -> a -> b
$ forall a. a -> a -> a -> Digit a
Three a
a a
b' a
c
InsTwo a
b1 a
b2 -> forall a. Digit a -> InsDigNode a
InsLeftDig forall a b. (a -> b) -> a -> b
$ 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 forall a. Num a => a -> a -> a
- Int
sab) a
c of
InsOne a
c' -> forall a. Digit a -> InsDigNode a
InsLeftDig forall a b. (a -> b) -> a -> b
$ forall a. a -> a -> a -> Digit a
Three a
a a
b a
c'
InsTwo a
c1 a
c2 -> forall a. Digit a -> InsDigNode a
InsLeftDig forall a b. (a -> b) -> a -> b
$ forall a. a -> a -> a -> a -> Digit a
Four a
a a
b a
c1 a
c2
where sa :: Int
sa = forall a. Sized a => a -> Int
size a
a
sab :: Int
sab = Int
sa forall a. Num a => a -> a -> a
+ forall a. Sized a => a -> Int
size a
b
insLeftDigit Int -> a -> Ins a
f Int
i (Four a
a a
b a
c a
d)
| Int
i forall a. Ord a => a -> a -> Bool
< Int
sa = case Int -> a -> Ins a
f Int
i a
a of
InsOne a
a' -> forall a. Digit a -> InsDigNode a
InsLeftDig forall a b. (a -> b) -> a -> b
$ forall a. a -> a -> a -> a -> Digit a
Four a
a' a
b a
c a
d
InsTwo a
a1 a
a2 -> forall a. Digit a -> Node a -> InsDigNode a
InsDigNode (forall a. a -> a -> Digit a
Two a
a1 a
a2) (forall a. Sized a => a -> a -> a -> Node a
node3 a
b a
c a
d)
| Int
i forall a. Ord a => a -> a -> Bool
< Int
sab = case Int -> a -> Ins a
f (Int
i forall a. Num a => a -> a -> a
- Int
sa) a
b of
InsOne a
b' -> forall a. Digit a -> InsDigNode a
InsLeftDig forall a b. (a -> b) -> a -> b
$ forall a. a -> a -> a -> a -> Digit a
Four a
a a
b' a
c a
d
InsTwo a
b1 a
b2 -> forall a. Digit a -> Node a -> InsDigNode a
InsDigNode (forall a. a -> a -> Digit a
Two a
a a
b1) (forall a. Sized a => a -> a -> a -> Node a
node3 a
b2 a
c a
d)
| Int
i forall a. Ord a => a -> a -> Bool
< Int
sabc = case Int -> a -> Ins a
f (Int
i forall a. Num a => a -> a -> a
- Int
sab) a
c of
InsOne a
c' -> forall a. Digit a -> InsDigNode a
InsLeftDig forall a b. (a -> b) -> a -> b
$ forall a. a -> a -> a -> a -> Digit a
Four a
a a
b a
c' a
d
InsTwo a
c1 a
c2 -> forall a. Digit a -> Node a -> InsDigNode a
InsDigNode (forall a. a -> a -> Digit a
Two a
a a
b) (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 forall a. Num a => a -> a -> a
- Int
sabc) a
d of
InsOne a
d' -> forall a. Digit a -> InsDigNode a
InsLeftDig forall a b. (a -> b) -> a -> b
$ forall a. a -> a -> a -> a -> Digit a
Four a
a a
b a
c a
d'
InsTwo a
d1 a
d2 -> forall a. Digit a -> Node a -> InsDigNode a
InsDigNode (forall a. a -> a -> Digit a
Two a
a a
b) (forall a. Sized a => a -> a -> a -> Node a
node3 a
c a
d1 a
d2)
where sa :: Int
sa = forall a. Sized a => a -> Int
size a
a
sab :: Int
sab = Int
sa forall a. Num a => a -> a -> a
+ forall a. Sized a => a -> Int
size a
b
sabc :: Int
sabc = Int
sab forall a. Num a => a -> a -> a
+ 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 :: forall a.
Sized a =>
(Int -> a -> Ins a) -> Int -> Digit a -> InsNodeDig a
insRightDigit Int -> a -> Ins a
f !Int
i (One a
a) = case Int -> a -> Ins a
f Int
i a
a of
InsOne a
a' -> forall a. Digit a -> InsNodeDig a
InsRightDig forall a b. (a -> b) -> a -> b
$ forall a. a -> Digit a
One a
a'
InsTwo a
a1 a
a2 -> forall a. Digit a -> InsNodeDig a
InsRightDig forall a b. (a -> b) -> a -> b
$ forall a. a -> a -> Digit a
Two a
a1 a
a2
insRightDigit Int -> a -> Ins a
f Int
i (Two a
a a
b)
| Int
i forall a. Ord a => a -> a -> Bool
< Int
sa = case Int -> a -> Ins a
f Int
i a
a of
InsOne a
a' -> forall a. Digit a -> InsNodeDig a
InsRightDig forall a b. (a -> b) -> a -> b
$ forall a. a -> a -> Digit a
Two a
a' a
b
InsTwo a
a1 a
a2 -> forall a. Digit a -> InsNodeDig a
InsRightDig forall a b. (a -> b) -> a -> b
$ forall a. a -> a -> a -> Digit a
Three a
a1 a
a2 a
b
| Bool
otherwise = case Int -> a -> Ins a
f (Int
i forall a. Num a => a -> a -> a
- Int
sa) a
b of
InsOne a
b' -> forall a. Digit a -> InsNodeDig a
InsRightDig forall a b. (a -> b) -> a -> b
$ forall a. a -> a -> Digit a
Two a
a a
b'
InsTwo a
b1 a
b2 -> forall a. Digit a -> InsNodeDig a
InsRightDig forall a b. (a -> b) -> a -> b
$ forall a. a -> a -> a -> Digit a
Three a
a a
b1 a
b2
where sa :: Int
sa = forall a. Sized a => a -> Int
size a
a
insRightDigit Int -> a -> Ins a
f Int
i (Three a
a a
b a
c)
| Int
i forall a. Ord a => a -> a -> Bool
< Int
sa = case Int -> a -> Ins a
f Int
i a
a of
InsOne a
a' -> forall a. Digit a -> InsNodeDig a
InsRightDig forall a b. (a -> b) -> a -> b
$ forall a. a -> a -> a -> Digit a
Three a
a' a
b a
c
InsTwo a
a1 a
a2 -> forall a. Digit a -> InsNodeDig a
InsRightDig forall a b. (a -> b) -> a -> b
$ forall a. a -> a -> a -> a -> Digit a
Four a
a1 a
a2 a
b a
c
| Int
i forall a. Ord a => a -> a -> Bool
< Int
sab = case Int -> a -> Ins a
f (Int
i forall a. Num a => a -> a -> a
- Int
sa) a
b of
InsOne a
b' -> forall a. Digit a -> InsNodeDig a
InsRightDig forall a b. (a -> b) -> a -> b
$ forall a. a -> a -> a -> Digit a
Three a
a a
b' a
c
InsTwo a
b1 a
b2 -> forall a. Digit a -> InsNodeDig a
InsRightDig forall a b. (a -> b) -> a -> b
$ 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 forall a. Num a => a -> a -> a
- Int
sab) a
c of
InsOne a
c' -> forall a. Digit a -> InsNodeDig a
InsRightDig forall a b. (a -> b) -> a -> b
$ forall a. a -> a -> a -> Digit a
Three a
a a
b a
c'
InsTwo a
c1 a
c2 -> forall a. Digit a -> InsNodeDig a
InsRightDig forall a b. (a -> b) -> a -> b
$ forall a. a -> a -> a -> a -> Digit a
Four a
a a
b a
c1 a
c2
where sa :: Int
sa = forall a. Sized a => a -> Int
size a
a
sab :: Int
sab = Int
sa forall a. Num a => a -> a -> a
+ forall a. Sized a => a -> Int
size a
b
insRightDigit Int -> a -> Ins a
f Int
i (Four a
a a
b a
c a
d)
| Int
i forall a. Ord a => a -> a -> Bool
< Int
sa = case Int -> a -> Ins a
f Int
i a
a of
InsOne a
a' -> forall a. Digit a -> InsNodeDig a
InsRightDig forall a b. (a -> b) -> a -> b
$ forall a. a -> a -> a -> a -> Digit a
Four a
a' a
b a
c a
d
InsTwo a
a1 a
a2 -> forall a. Node a -> Digit a -> InsNodeDig a
InsNodeDig (forall a. Sized a => a -> a -> a -> Node a
node3 a
a1 a
a2 a
b) (forall a. a -> a -> Digit a
Two a
c a
d)
| Int
i forall a. Ord a => a -> a -> Bool
< Int
sab = case Int -> a -> Ins a
f (Int
i forall a. Num a => a -> a -> a
- Int
sa) a
b of
InsOne a
b' -> forall a. Digit a -> InsNodeDig a
InsRightDig forall a b. (a -> b) -> a -> b
$ forall a. a -> a -> a -> a -> Digit a
Four a
a a
b' a
c a
d
InsTwo a
b1 a
b2 -> forall a. Node a -> Digit a -> InsNodeDig a
InsNodeDig (forall a. Sized a => a -> a -> a -> Node a
node3 a
a a
b1 a
b2) (forall a. a -> a -> Digit a
Two a
c a
d)
| Int
i forall a. Ord a => a -> a -> Bool
< Int
sabc = case Int -> a -> Ins a
f (Int
i forall a. Num a => a -> a -> a
- Int
sab) a
c of
InsOne a
c' -> forall a. Digit a -> InsNodeDig a
InsRightDig forall a b. (a -> b) -> a -> b
$ forall a. a -> a -> a -> a -> Digit a
Four a
a a
b a
c' a
d
InsTwo a
c1 a
c2 -> forall a. Node a -> Digit a -> InsNodeDig a
InsNodeDig (forall a. Sized a => a -> a -> a -> Node a
node3 a
a a
b a
c1) (forall a. a -> a -> Digit a
Two a
c2 a
d)
| Bool
otherwise = case Int -> a -> Ins a
f (Int
i forall a. Num a => a -> a -> a
- Int
sabc) a
d of
InsOne a
d' -> forall a. Digit a -> InsNodeDig a
InsRightDig forall a b. (a -> b) -> a -> b
$ forall a. a -> a -> a -> a -> Digit a
Four a
a a
b a
c a
d'
InsTwo a
d1 a
d2 -> forall a. Node a -> Digit a -> InsNodeDig a
InsNodeDig (forall a. Sized a => a -> a -> a -> Node a
node3 a
a a
b a
c) (forall a. a -> a -> Digit a
Two a
d1 a
d2)
where sa :: Int
sa = forall a. Sized a => a -> Int
size a
a
sab :: Int
sab = Int
sa forall a. Num a => a -> a -> a
+ forall a. Sized a => a -> Int
size a
b
sabc :: Int
sabc = Int
sab forall a. Num a => a -> a -> a
+ forall a. Sized a => a -> Int
size a
c
deleteAt :: Int -> Seq a -> Seq a
deleteAt :: forall a. Int -> Seq a -> Seq a
deleteAt Int
i (Seq FingerTree (Elem a)
xs)
| forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i forall a. Ord a => a -> a -> Bool
< (forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Sized a => a -> Int
size FingerTree (Elem a)
xs) :: Word) = forall a. FingerTree (Elem a) -> Seq a
Seq forall a b. (a -> b) -> a -> b
$ forall a. Int -> FingerTree (Elem a) -> FingerTree (Elem a)
delTreeE Int
i FingerTree (Elem a)
xs
| Bool
otherwise = forall a. FingerTree (Elem a) -> Seq a
Seq FingerTree (Elem a)
xs
delTreeE :: Int -> FingerTree (Elem a) -> FingerTree (Elem a)
delTreeE :: forall a. Int -> FingerTree (Elem a) -> FingerTree (Elem a)
delTreeE !Int
_i FingerTree (Elem a)
EmptyT = forall a. FingerTree a
EmptyT
delTreeE Int
_i Single{} = forall a. FingerTree a
EmptyT
delTreeE Int
i (Deep Int
s Digit (Elem a)
pr FingerTree (Node (Elem a))
m Digit (Elem a)
sf)
| Int
i forall a. Ord a => a -> a -> Bool
< Int
spr = 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 forall a. Ord a => a -> a -> Bool
< Int
spm = case forall a.
Sized a =>
(Int -> Node a -> Del a) -> Int -> FingerTree (Node a) -> DelTree a
delTree forall a. Int -> Node (Elem a) -> Del (Elem a)
delNodeE (Int
i forall a. Num a => a -> a -> a
- Int
spr) FingerTree (Node (Elem a))
m of
FullTree FingerTree (Node (Elem a))
m' -> forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s forall a. Num a => a -> a -> a
- Int
1) Digit (Elem a)
pr FingerTree (Node (Elem a))
m' Digit (Elem a)
sf
DefectTree Elem a
e -> forall a. Sized a => Int -> Digit a -> a -> Digit a -> FingerTree a
delRebuildMiddle (Int
s forall a. Num a => a -> a -> a
- Int
1) Digit (Elem a)
pr Elem a
e Digit (Elem a)
sf
| Bool
otherwise = forall a.
Int
-> Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> FingerTree (Elem a)
delRightDigitE (Int
i 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 = forall a. Sized a => a -> Int
size Digit (Elem a)
pr
spm :: Int
spm = Int
spr forall a. Num a => a -> a -> a
+ forall a. Sized a => a -> Int
size FingerTree (Node (Elem a))
m
delNodeE :: Int -> Node (Elem a) -> Del (Elem a)
delNodeE :: forall a. Int -> Node (Elem a) -> Del (Elem a)
delNodeE Int
i (Node3 Int
_ Elem a
a Elem a
b Elem a
c) = case Int
i of
Int
0 -> forall a. Node a -> Del a
Full forall a b. (a -> b) -> a -> b
$ forall a. Int -> a -> a -> Node a
Node2 Int
2 Elem a
b Elem a
c
Int
1 -> forall a. Node a -> Del a
Full forall a b. (a -> b) -> a -> b
$ forall a. Int -> a -> a -> Node a
Node2 Int
2 Elem a
a Elem a
c
Int
_ -> forall a. Node a -> Del a
Full forall a b. (a -> b) -> a -> b
$ forall a. Int -> a -> a -> Node a
Node2 Int
2 Elem a
a Elem a
b
delNodeE Int
i (Node2 Int
_ Elem a
a Elem a
b) = case Int
i of
Int
0 -> forall a. a -> Del a
Defect Elem a
b
Int
_ -> 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 :: forall a.
Int
-> Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> FingerTree (Elem a)
delLeftDigitE !Int
_i Int
s One{} FingerTree (Node (Elem a))
m Digit (Elem a)
sf = forall a. Int -> FingerTree (Node a) -> Digit a -> FingerTree a
pullL (Int
s forall a. Num a => a -> a -> a
- Int
1) FingerTree (Node (Elem a))
m Digit (Elem a)
sf
delLeftDigitE Int
i Int
s (Two Elem a
a Elem a
b) FingerTree (Node (Elem a))
m Digit (Elem a)
sf
| Int
i forall a. Eq a => a -> a -> Bool
== Int
0 = forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s forall a. Num a => a -> a -> a
- Int
1) (forall a. a -> Digit a
One Elem a
b) FingerTree (Node (Elem a))
m Digit (Elem a)
sf
| Bool
otherwise = forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s forall a. Num a => a -> a -> a
- Int
1) (forall a. a -> Digit a
One Elem a
a) FingerTree (Node (Elem a))
m Digit (Elem a)
sf
delLeftDigitE Int
i Int
s (Three Elem a
a Elem a
b Elem a
c) FingerTree (Node (Elem a))
m Digit (Elem a)
sf
| Int
i forall a. Eq a => a -> a -> Bool
== Int
0 = forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s forall a. Num a => a -> a -> a
- Int
1) (forall a. a -> a -> Digit a
Two Elem a
b Elem a
c) FingerTree (Node (Elem a))
m Digit (Elem a)
sf
| Int
i forall a. Eq a => a -> a -> Bool
== Int
1 = forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s forall a. Num a => a -> a -> a
- Int
1) (forall a. a -> a -> Digit a
Two Elem a
a Elem a
c) FingerTree (Node (Elem a))
m Digit (Elem a)
sf
| Bool
otherwise = forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s forall a. Num a => a -> a -> a
- Int
1) (forall a. a -> a -> Digit a
Two Elem a
a Elem a
b) FingerTree (Node (Elem a))
m Digit (Elem a)
sf
delLeftDigitE Int
i Int
s (Four Elem a
a Elem a
b Elem a
c Elem a
d) FingerTree (Node (Elem a))
m Digit (Elem a)
sf
| Int
i forall a. Eq a => a -> a -> Bool
== Int
0 = forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s forall a. Num a => a -> a -> a
- Int
1) (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 forall a. Eq a => a -> a -> Bool
== Int
1 = forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s forall a. Num a => a -> a -> a
- Int
1) (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 forall a. Eq a => a -> a -> Bool
== Int
2 = forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s forall a. Num a => a -> a -> a
- Int
1) (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 = forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s forall a. Num a => a -> a -> a
- Int
1) (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 :: forall a.
Int
-> Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> FingerTree (Elem a)
delRightDigitE !Int
_i Int
s Digit (Elem a)
pr FingerTree (Node (Elem a))
m One{} = forall a. Int -> Digit a -> FingerTree (Node a) -> FingerTree a
pullR (Int
s forall a. Num a => a -> a -> a
- Int
1) Digit (Elem a)
pr FingerTree (Node (Elem a))
m
delRightDigitE Int
i Int
s Digit (Elem a)
pr FingerTree (Node (Elem a))
m (Two Elem a
a Elem a
b)
| Int
i forall a. Eq a => a -> a -> Bool
== Int
0 = forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s forall a. Num a => a -> a -> a
- Int
1) Digit (Elem a)
pr FingerTree (Node (Elem a))
m (forall a. a -> Digit a
One Elem a
b)
| Bool
otherwise = forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s forall a. Num a => a -> a -> a
- Int
1) Digit (Elem a)
pr FingerTree (Node (Elem a))
m (forall a. a -> Digit a
One Elem a
a)
delRightDigitE Int
i Int
s Digit (Elem a)
pr FingerTree (Node (Elem a))
m (Three Elem a
a Elem a
b Elem a
c)
| Int
i forall a. Eq a => a -> a -> Bool
== Int
0 = forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s forall a. Num a => a -> a -> a
- Int
1) Digit (Elem a)
pr FingerTree (Node (Elem a))
m (forall a. a -> a -> Digit a
Two Elem a
b Elem a
c)
| Int
i forall a. Eq a => a -> a -> Bool
== Int
1 = forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s forall a. Num a => a -> a -> a
- Int
1) Digit (Elem a)
pr FingerTree (Node (Elem a))
m (forall a. a -> a -> Digit a
Two Elem a
a Elem a
c)
| Bool
otherwise = forall a.
Sized a =>
Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
deep Digit (Elem a)
pr FingerTree (Node (Elem a))
m (forall a. a -> a -> Digit a
Two Elem a
a Elem a
b)
delRightDigitE Int
i Int
s Digit (Elem a)
pr FingerTree (Node (Elem a))
m (Four Elem a
a Elem a
b Elem a
c Elem a
d)
| Int
i forall a. Eq a => a -> a -> Bool
== Int
0 = forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s forall a. Num a => a -> a -> a
- Int
1) Digit (Elem a)
pr FingerTree (Node (Elem a))
m (forall a. a -> a -> a -> Digit a
Three Elem a
b Elem a
c Elem a
d)
| Int
i forall a. Eq a => a -> a -> Bool
== Int
1 = forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s forall a. Num a => a -> a -> a
- Int
1) Digit (Elem a)
pr FingerTree (Node (Elem a))
m (forall a. a -> a -> a -> Digit a
Three Elem a
a Elem a
c Elem a
d)
| Int
i forall a. Eq a => a -> a -> Bool
== Int
2 = forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s forall a. Num a => a -> a -> a
- Int
1) Digit (Elem a)
pr FingerTree (Node (Elem a))
m (forall a. a -> a -> a -> Digit a
Three Elem a
a Elem a
b Elem a
d)
| Bool
otherwise = forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s forall a. Num a => a -> a -> a
- Int
1) Digit (Elem a)
pr FingerTree (Node (Elem a))
m (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 :: forall a.
Sized a =>
(Int -> Node a -> Del a) -> Int -> FingerTree (Node a) -> DelTree a
delTree Int -> Node a -> Del a
_f !Int
_i FingerTree (Node a)
EmptyT = forall a. FingerTree (Node a) -> DelTree a
FullTree forall a. FingerTree a
EmptyT
delTree Int -> Node a -> Del a
f Int
i (Single Node a
a) = case Int -> Node a -> Del a
f Int
i Node a
a of
Full Node a
a' -> forall a. FingerTree (Node a) -> DelTree a
FullTree (forall a. a -> FingerTree a
Single Node a
a')
Defect a
e -> forall a. a -> DelTree a
DefectTree a
e
delTree Int -> Node a -> Del a
f Int
i (Deep Int
s Digit (Node a)
pr FingerTree (Node (Node a))
m Digit (Node a)
sf)
| Int
i forall a. Ord a => a -> a -> Bool
< Int
spr = case 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 Digit (Node a)
pr' -> forall a. FingerTree (Node a) -> DelTree a
FullTree forall a b. (a -> b) -> a -> b
$ forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s forall a. Num a => a -> a -> a
- Int
1) Digit (Node a)
pr' FingerTree (Node (Node a))
m Digit (Node a)
sf
DefectDig a
e -> case forall a. Sized a => FingerTree a -> ViewLTree a
viewLTree FingerTree (Node (Node a))
m of
ViewLTree (Node (Node a))
EmptyLTree -> forall a. FingerTree (Node a) -> DelTree a
FullTree forall a b. (a -> b) -> a -> b
$ forall a.
Sized a =>
Int -> a -> Digit (Node a) -> FingerTree (Node a)
delRebuildRightDigit (Int
s forall a. Num a => a -> a -> a
- Int
1) a
e Digit (Node a)
sf
ConsLTree Node (Node a)
n FingerTree (Node (Node a))
m' -> forall a. FingerTree (Node a) -> DelTree a
FullTree forall a b. (a -> b) -> a -> b
$ forall a.
Sized a =>
Int
-> a
-> Node (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> FingerTree (Node a)
delRebuildLeftSide (Int
s forall a. Num a => a -> a -> a
- Int
1) a
e Node (Node a)
n FingerTree (Node (Node a))
m' Digit (Node a)
sf
| Int
i forall a. Ord a => a -> a -> Bool
< Int
spm = case forall a.
Sized a =>
(Int -> Node a -> Del a) -> Int -> FingerTree (Node a) -> DelTree a
delTree (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 forall a. Num a => a -> a -> a
- Int
spr) FingerTree (Node (Node a))
m of
FullTree FingerTree (Node (Node a))
m' -> forall a. FingerTree (Node a) -> DelTree a
FullTree (forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s forall a. Num a => a -> a -> a
- Int
1) Digit (Node a)
pr FingerTree (Node (Node a))
m' Digit (Node a)
sf)
DefectTree Node a
e -> forall a. FingerTree (Node a) -> DelTree a
FullTree forall a b. (a -> b) -> a -> b
$ forall a. Sized a => Int -> Digit a -> a -> Digit a -> FingerTree a
delRebuildMiddle (Int
s forall a. Num a => a -> a -> a
- Int
1) Digit (Node a)
pr Node a
e Digit (Node a)
sf
| Bool
otherwise = case forall a.
Sized a =>
(Int -> Node a -> Del a) -> Int -> Digit (Node a) -> DelDig a
delDigit Int -> Node a -> Del a
f (Int
i forall a. Num a => a -> a -> a
- Int
spm) Digit (Node a)
sf of
FullDig Digit (Node a)
sf' -> forall a. FingerTree (Node a) -> DelTree a
FullTree forall a b. (a -> b) -> a -> b
$ forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s forall a. Num a => a -> a -> a
- Int
1) Digit (Node a)
pr FingerTree (Node (Node a))
m Digit (Node a)
sf'
DefectDig a
e -> case forall a. Sized a => FingerTree a -> ViewRTree a
viewRTree FingerTree (Node (Node a))
m of
ViewRTree (Node (Node a))
EmptyRTree -> forall a. FingerTree (Node a) -> DelTree a
FullTree forall a b. (a -> b) -> a -> b
$ forall a.
Sized a =>
Int -> Digit (Node a) -> a -> FingerTree (Node a)
delRebuildLeftDigit (Int
s forall a. Num a => a -> a -> a
- Int
1) Digit (Node a)
pr a
e
SnocRTree FingerTree (Node (Node a))
m' Node (Node a)
n -> forall a. FingerTree (Node a) -> DelTree a
FullTree forall a b. (a -> b) -> a -> b
$ forall a.
Sized a =>
Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> Node (Node a)
-> a
-> FingerTree (Node a)
delRebuildRightSide (Int
s forall a. Num a => a -> a -> a
- Int
1) Digit (Node a)
pr FingerTree (Node (Node a))
m' Node (Node a)
n a
e
where spr :: Int
spr = forall a. Sized a => a -> Int
size Digit (Node a)
pr
spm :: Int
spm = Int
spr forall a. Num a => a -> a -> a
+ 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 :: 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 (Node3 Int
s Node a
a Node a
b Node a
c)
| Int
i forall a. Ord a => a -> a -> Bool
< Int
sa = case Int -> Node a -> Del a
f Int
i Node a
a of
Full Node a
a' -> forall a. Node a -> Del a
Full forall a b. (a -> b) -> a -> b
$ forall a. Int -> a -> a -> a -> Node a
Node3 (Int
s forall a. Num a => a -> a -> a
- Int
1) Node a
a' Node a
b Node a
c
Defect a
e -> let !se :: Int
se = forall a. Sized a => a -> Int
size a
e in case Node a
b of
Node3 Int
sxyz a
x a
y a
z -> forall a. Node a -> Del a
Full forall a b. (a -> b) -> a -> b
$ forall a. Int -> a -> a -> a -> Node a
Node3 (Int
s forall a. Num a => a -> a -> a
- Int
1) (forall a. Int -> a -> a -> Node a
Node2 (Int
se forall a. Num a => a -> a -> a
+ Int
sx) a
e a
x) (forall a. Int -> a -> a -> Node a
Node2 (Int
sxyz forall a. Num a => a -> a -> a
- Int
sx) a
y a
z) Node a
c
where !sx :: Int
sx = forall a. Sized a => a -> Int
size a
x
Node2 Int
sxy a
x a
y -> forall a. Node a -> Del a
Full forall a b. (a -> b) -> a -> b
$ forall a. Int -> a -> a -> Node a
Node2 (Int
s forall a. Num a => a -> a -> a
- Int
1) (forall a. Int -> a -> a -> a -> Node a
Node3 (Int
sxy forall a. Num a => a -> a -> a
+ Int
se) a
e a
x a
y) Node a
c
| Int
i forall a. Ord a => a -> a -> Bool
< Int
sab = case Int -> Node a -> Del a
f (Int
i forall a. Num a => a -> a -> a
- Int
sa) Node a
b of
Full Node a
b' -> forall a. Node a -> Del a
Full forall a b. (a -> b) -> a -> b
$ forall a. Int -> a -> a -> a -> Node a
Node3 (Int
s forall a. Num a => a -> a -> a
- Int
1) Node a
a Node a
b' Node a
c
Defect a
e -> let !se :: Int
se = forall a. Sized a => a -> Int
size a
e in case Node a
a of
Node3 Int
sxyz a
x a
y a
z -> forall a. Node a -> Del a
Full forall a b. (a -> b) -> a -> b
$ forall a. Int -> a -> a -> a -> Node a
Node3 (Int
s forall a. Num a => a -> a -> a
- Int
1) (forall a. Int -> a -> a -> Node a
Node2 (Int
sxyz forall a. Num a => a -> a -> a
- Int
sz) a
x a
y) (forall a. Int -> a -> a -> Node a
Node2 (Int
sz forall a. Num a => a -> a -> a
+ Int
se) a
z a
e) Node a
c
where !sz :: Int
sz = forall a. Sized a => a -> Int
size a
z
Node2 Int
sxy a
x a
y -> forall a. Node a -> Del a
Full forall a b. (a -> b) -> a -> b
$ forall a. Int -> a -> a -> Node a
Node2 (Int
s forall a. Num a => a -> a -> a
- Int
1) (forall a. Int -> a -> a -> a -> Node a
Node3 (Int
sxy 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 forall a. Num a => a -> a -> a
- Int
sab) Node a
c of
Full Node a
c' -> forall a. Node a -> Del a
Full forall a b. (a -> b) -> a -> b
$ forall a. Int -> a -> a -> a -> Node a
Node3 (Int
s forall a. Num a => a -> a -> a
- Int
1) Node a
a Node a
b Node a
c'
Defect a
e -> let !se :: Int
se = forall a. Sized a => a -> Int
size a
e in case Node a
b of
Node3 Int
sxyz a
x a
y a
z -> forall a. Node a -> Del a
Full forall a b. (a -> b) -> a -> b
$ forall a. Int -> a -> a -> a -> Node a
Node3 (Int
s forall a. Num a => a -> a -> a
- Int
1) Node a
a (forall a. Int -> a -> a -> Node a
Node2 (Int
sxyz forall a. Num a => a -> a -> a
- Int
sz) a
x a
y) (forall a. Int -> a -> a -> Node a
Node2 (Int
sz forall a. Num a => a -> a -> a
+ Int
se) a
z a
e)
where !sz :: Int
sz = forall a. Sized a => a -> Int
size a
z
Node2 Int
sxy a
x a
y -> forall a. Node a -> Del a
Full forall a b. (a -> b) -> a -> b
$ forall a. Int -> a -> a -> Node a
Node2 (Int
s forall a. Num a => a -> a -> a
- Int
1) Node a
a (forall a. Int -> a -> a -> a -> Node a
Node3 (Int
sxy forall a. Num a => a -> a -> a
+ Int
se) a
x a
y a
e)
where sa :: Int
sa = forall a. Sized a => a -> Int
size Node a
a
sab :: Int
sab = Int
sa forall a. Num a => a -> a -> a
+ forall a. Sized a => a -> Int
size Node a
b
delNode Int -> Node a -> Del a
f Int
i (Node2 Int
s Node a
a Node a
b)
| Int
i forall a. Ord a => a -> a -> Bool
< Int
sa = case Int -> Node a -> Del a
f Int
i Node a
a of
Full Node a
a' -> forall a. Node a -> Del a
Full forall a b. (a -> b) -> a -> b
$ forall a. Int -> a -> a -> Node a
Node2 (Int
s forall a. Num a => a -> a -> a
- Int
1) Node a
a' Node a
b
Defect a
e -> let !se :: Int
se = forall a. Sized a => a -> Int
size a
e in case Node a
b of
Node3 Int
sxyz a
x a
y a
z -> forall a. Node a -> Del a
Full forall a b. (a -> b) -> a -> b
$ forall a. Int -> a -> a -> Node a
Node2 (Int
s forall a. Num a => a -> a -> a
- Int
1) (forall a. Int -> a -> a -> Node a
Node2 (Int
se forall a. Num a => a -> a -> a
+ Int
sx) a
e a
x) (forall a. Int -> a -> a -> Node a
Node2 (Int
sxyz forall a. Num a => a -> a -> a
- Int
sx) a
y a
z)
where !sx :: Int
sx = forall a. Sized a => a -> Int
size a
x
Node2 Int
_ a
x a
y -> forall a. a -> Del a
Defect forall a b. (a -> b) -> a -> b
$ forall a. Int -> a -> a -> a -> Node a
Node3 (Int
s forall a. Num a => a -> a -> a
- Int
1) a
e a
x a
y
| Bool
otherwise = case Int -> Node a -> Del a
f (Int
i forall a. Num a => a -> a -> a
- Int
sa) Node a
b of
Full Node a
b' -> forall a. Node a -> Del a
Full forall a b. (a -> b) -> a -> b
$ forall a. Int -> a -> a -> Node a
Node2 (Int
s forall a. Num a => a -> a -> a
- Int
1) Node a
a Node a
b'
Defect a
e -> let !se :: Int
se = forall a. Sized a => a -> Int
size a
e in case Node a
a of
Node3 Int
sxyz a
x a
y a
z -> forall a. Node a -> Del a
Full forall a b. (a -> b) -> a -> b
$ forall a. Int -> a -> a -> Node a
Node2 (Int
s forall a. Num a => a -> a -> a
- Int
1) (forall a. Int -> a -> a -> Node a
Node2 (Int
sxyz forall a. Num a => a -> a -> a
- Int
sz) a
x a
y) (forall a. Int -> a -> a -> Node a
Node2 (Int
sz forall a. Num a => a -> a -> a
+ Int
se) a
z a
e)
where !sz :: Int
sz = forall a. Sized a => a -> Int
size a
z
Node2 Int
_ a
x a
y -> forall a. a -> Del a
Defect forall a b. (a -> b) -> a -> b
$ forall a. Int -> a -> a -> a -> Node a
Node3 (Int
s forall a. Num a => a -> a -> a
- Int
1) a
x a
y a
e
where sa :: Int
sa = 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 :: forall a.
Sized a =>
Int -> a -> Digit (Node a) -> FingerTree (Node a)
delRebuildRightDigit Int
s a
p (One Node a
a) = let !sp :: Int
sp = forall a. Sized a => a -> Int
size a
p in case Node a
a of
Node3 Int
sxyz a
x a
y a
z -> forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
s (forall a. a -> Digit a
One (forall a. Int -> a -> a -> Node a
Node2 (Int
sp forall a. Num a => a -> a -> a
+ Int
sx) a
p a
x)) forall a. FingerTree a
EmptyT (forall a. a -> Digit a
One (forall a. Int -> a -> a -> Node a
Node2 (Int
sxyz forall a. Num a => a -> a -> a
- Int
sx) a
y a
z))
where !sx :: Int
sx = forall a. Sized a => a -> Int
size a
x
Node2 Int
sxy a
x a
y -> forall a. a -> FingerTree a
Single (forall a. Int -> a -> a -> a -> Node a
Node3 (Int
sp forall a. Num a => a -> a -> a
+ Int
sxy) a
p a
x a
y)
delRebuildRightDigit Int
s a
p (Two Node a
a Node a
b) = let !sp :: Int
sp = forall a. Sized a => a -> Int
size a
p in case Node a
a of
Node3 Int
sxyz a
x a
y a
z -> forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
s (forall a. a -> a -> Digit a
Two (forall a. Int -> a -> a -> Node a
Node2 (Int
sp forall a. Num a => a -> a -> a
+ Int
sx) a
p a
x) (forall a. Int -> a -> a -> Node a
Node2 (Int
sxyz forall a. Num a => a -> a -> a
- Int
sx) a
y a
z)) forall a. FingerTree a
EmptyT (forall a. a -> Digit a
One Node a
b)
where !sx :: Int
sx = forall a. Sized a => a -> Int
size a
x
Node2 Int
sxy a
x a
y -> forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
s (forall a. a -> Digit a
One (forall a. Int -> a -> a -> a -> Node a
Node3 (Int
sp forall a. Num a => a -> a -> a
+ Int
sxy) a
p a
x a
y)) forall a. FingerTree a
EmptyT (forall a. a -> Digit a
One Node a
b)
delRebuildRightDigit Int
s a
p (Three Node a
a Node a
b Node a
c) = let !sp :: Int
sp = forall a. Sized a => a -> Int
size a
p in case Node a
a of
Node3 Int
sxyz a
x a
y a
z -> forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
s (forall a. a -> a -> Digit a
Two (forall a. Int -> a -> a -> Node a
Node2 (Int
sp forall a. Num a => a -> a -> a
+ Int
sx) a
p a
x) (forall a. Int -> a -> a -> Node a
Node2 (Int
sxyz forall a. Num a => a -> a -> a
- Int
sx) a
y a
z)) forall a. FingerTree a
EmptyT (forall a. a -> a -> Digit a
Two Node a
b Node a
c)
where !sx :: Int
sx = forall a. Sized a => a -> Int
size a
x
Node2 Int
sxy a
x a
y -> forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
s (forall a. a -> a -> Digit a
Two (forall a. Int -> a -> a -> a -> Node a
Node3 (Int
sp forall a. Num a => a -> a -> a
+ Int
sxy) a
p a
x a
y) Node a
b) forall a. FingerTree a
EmptyT (forall a. a -> Digit a
One Node a
c)
delRebuildRightDigit Int
s a
p (Four Node a
a Node a
b Node a
c Node a
d) = let !sp :: Int
sp = forall a. Sized a => a -> Int
size a
p in case Node a
a of
Node3 Int
sxyz a
x a
y a
z -> forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
s (forall a. a -> a -> a -> Digit a
Three (forall a. Int -> a -> a -> Node a
Node2 (Int
sp forall a. Num a => a -> a -> a
+ Int
sx) a
p a
x) (forall a. Int -> a -> a -> Node a
Node2 (Int
sxyz forall a. Num a => a -> a -> a
- Int
sx) a
y a
z) Node a
b) forall a. FingerTree a
EmptyT (forall a. a -> a -> Digit a
Two Node a
c Node a
d)
where !sx :: Int
sx = forall a. Sized a => a -> Int
size a
x
Node2 Int
sxy a
x a
y -> forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
s (forall a. a -> a -> Digit a
Two (forall a. Int -> a -> a -> a -> Node a
Node3 (Int
sp forall a. Num a => a -> a -> a
+ Int
sxy) a
p a
x a
y) Node a
b) forall a. FingerTree a
EmptyT (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 :: forall a.
Sized a =>
Int -> Digit (Node a) -> a -> FingerTree (Node a)
delRebuildLeftDigit Int
s (One Node a
a) a
p = let !sp :: Int
sp = forall a. Sized a => a -> Int
size a
p in case Node a
a of
Node3 Int
sxyz a
x a
y a
z -> forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
s (forall a. a -> Digit a
One (forall a. Int -> a -> a -> Node a
Node2 (Int
sxyz forall a. Num a => a -> a -> a
- Int
sz) a
x a
y)) forall a. FingerTree a
EmptyT (forall a. a -> Digit a
One (forall a. Int -> a -> a -> Node a
Node2 (Int
sz forall a. Num a => a -> a -> a
+ Int
sp) a
z a
p))
where !sz :: Int
sz = forall a. Sized a => a -> Int
size a
z
Node2 Int
sxy a
x a
y -> forall a. a -> FingerTree a
Single (forall a. Int -> a -> a -> a -> Node a
Node3 (Int
sxy forall a. Num a => a -> a -> a
+ Int
sp) a
x a
y a
p)
delRebuildLeftDigit Int
s (Two Node a
a Node a
b) a
p = let !sp :: Int
sp = forall a. Sized a => a -> Int
size a
p in case Node a
b of
Node3 Int
sxyz a
x a
y a
z -> forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
s (forall a. a -> a -> Digit a
Two Node a
a (forall a. Int -> a -> a -> Node a
Node2 (Int
sxyz forall a. Num a => a -> a -> a
- Int
sz) a
x a
y)) forall a. FingerTree a
EmptyT (forall a. a -> Digit a
One (forall a. Int -> a -> a -> Node a
Node2 (Int
sz forall a. Num a => a -> a -> a
+ Int
sp) a
z a
p))
where !sz :: Int
sz = forall a. Sized a => a -> Int
size a
z
Node2 Int
sxy a
x a
y -> forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
s (forall a. a -> Digit a
One Node a
a) forall a. FingerTree a
EmptyT (forall a. a -> Digit a
One (forall a. Int -> a -> a -> a -> Node a
Node3 (Int
sxy forall a. Num a => a -> a -> a
+ Int
sp) a
x a
y a
p))
delRebuildLeftDigit Int
s (Three Node a
a Node a
b Node a
c) a
p = let !sp :: Int
sp = forall a. Sized a => a -> Int
size a
p in case Node a
c of
Node3 Int
sxyz a
x a
y a
z -> forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
s (forall a. a -> a -> Digit a
Two Node a
a Node a
b) forall a. FingerTree a
EmptyT (forall a. a -> a -> Digit a
Two (forall a. Int -> a -> a -> Node a
Node2 (Int
sxyz forall a. Num a => a -> a -> a
- Int
sz) a
x a
y) (forall a. Int -> a -> a -> Node a
Node2 (Int
sz forall a. Num a => a -> a -> a
+ Int
sp) a
z a
p))
where !sz :: Int
sz = forall a. Sized a => a -> Int
size a
z
Node2 Int
sxy a
x a
y -> forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
s (forall a. a -> a -> Digit a
Two Node a
a Node a
b) forall a. FingerTree a
EmptyT (forall a. a -> Digit a
One (forall a. Int -> a -> a -> a -> Node a
Node3 (Int
sxy forall a. Num a => a -> a -> a
+ Int
sp) a
x a
y a
p))
delRebuildLeftDigit Int
s (Four Node a
a Node a
b Node a
c Node a
d) a
p = let !sp :: Int
sp = forall a. Sized a => a -> Int
size a
p in case Node a
d of
Node3 Int
sxyz a
x a
y a
z -> forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
s (forall a. a -> a -> a -> Digit a
Three Node a
a Node a
b Node a
c) forall a. FingerTree a
EmptyT (forall a. a -> a -> Digit a
Two (forall a. Int -> a -> a -> Node a
Node2 (Int
sxyz forall a. Num a => a -> a -> a
- Int
sz) a
x a
y) (forall a. Int -> a -> a -> Node a
Node2 (Int
sz forall a. Num a => a -> a -> a
+ Int
sp) a
z a
p))
where !sz :: Int
sz = forall a. Sized a => a -> Int
size a
z
Node2 Int
sxy a
x a
y -> forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
s (forall a. a -> a -> Digit a
Two Node a
a Node a
b) forall a. FingerTree a
EmptyT (forall a. a -> a -> Digit a
Two Node a
c (forall a. Int -> a -> a -> a -> Node a
Node3 (Int
sxy 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 :: forall a.
Sized a =>
Int
-> a
-> Node (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> FingerTree (Node a)
delRebuildLeftSide Int
s a
p (Node2 Int
_ Node a
a Node a
b) FingerTree (Node (Node a))
m Digit (Node a)
sf = let !sp :: Int
sp = forall a. Sized a => a -> Int
size a
p in case Node a
a of
Node2 Int
sxy a
x a
y -> forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
s (forall a. a -> a -> Digit a
Two (forall a. Int -> a -> a -> a -> Node a
Node3 (Int
sp 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 Int
sxyz a
x a
y a
z -> forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
s (forall a. a -> a -> a -> Digit a
Three (forall a. Int -> a -> a -> Node a
Node2 (Int
sp forall a. Num a => a -> a -> a
+ Int
sx) a
p a
x) (forall a. Int -> a -> a -> Node a
Node2 (Int
sxyz 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 = forall a. Sized a => a -> Int
size a
x
delRebuildLeftSide Int
s a
p (Node3 Int
_ Node a
a Node a
b Node a
c) FingerTree (Node (Node a))
m Digit (Node a)
sf = let !sp :: Int
sp = forall a. Sized a => a -> Int
size a
p in case Node a
a of
Node2 Int
sxy a
x a
y -> forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
s (forall a. a -> a -> a -> Digit a
Three (forall a. Int -> a -> a -> a -> Node a
Node3 (Int
sp 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 Int
sxyz a
x a
y a
z -> forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
s (forall a. a -> a -> a -> a -> Digit a
Four (forall a. Int -> a -> a -> Node a
Node2 (Int
sp forall a. Num a => a -> a -> a
+ Int
sx) a
p a
x) (forall a. Int -> a -> a -> Node a
Node2 (Int
sxyz 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 = 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 :: forall a.
Sized a =>
Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> Node (Node a)
-> a
-> FingerTree (Node a)
delRebuildRightSide Int
s Digit (Node a)
pr FingerTree (Node (Node a))
m (Node2 Int
_ Node a
a Node a
b) a
p = let !sp :: Int
sp = forall a. Sized a => a -> Int
size a
p in case Node a
b of
Node2 Int
sxy a
x a
y -> forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
s Digit (Node a)
pr FingerTree (Node (Node a))
m (forall a. a -> a -> Digit a
Two Node a
a (forall a. Int -> a -> a -> a -> Node a
Node3 (Int
sxy forall a. Num a => a -> a -> a
+ Int
sp) a
x a
y a
p))
Node3 Int
sxyz a
x a
y a
z -> forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
s Digit (Node a)
pr FingerTree (Node (Node a))
m (forall a. a -> a -> a -> Digit a
Three Node a
a (forall a. Int -> a -> a -> Node a
Node2 (Int
sxyz forall a. Num a => a -> a -> a
- Int
sz) a
x a
y) (forall a. Int -> a -> a -> Node a
Node2 (Int
sz forall a. Num a => a -> a -> a
+ Int
sp) a
z a
p))
where !sz :: Int
sz = forall a. Sized a => a -> Int
size a
z
delRebuildRightSide Int
s Digit (Node a)
pr FingerTree (Node (Node a))
m (Node3 Int
_ Node a
a Node a
b Node a
c) a
p = let !sp :: Int
sp = forall a. Sized a => a -> Int
size a
p in case Node a
c of
Node2 Int
sxy a
x a
y -> forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
s Digit (Node a)
pr FingerTree (Node (Node a))
m (forall a. a -> a -> a -> Digit a
Three Node a
a Node a
b (forall a. Int -> a -> a -> a -> Node a
Node3 (Int
sxy forall a. Num a => a -> a -> a
+ Int
sp) a
x a
y a
p))
Node3 Int
sxyz a
x a
y a
z -> forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
s Digit (Node a)
pr FingerTree (Node (Node a))
m (forall a. a -> a -> a -> a -> Digit a
Four Node a
a Node a
b (forall a. Int -> a -> a -> Node a
Node2 (Int
sxyz forall a. Num a => a -> a -> a
- Int
sz) a
x a
y) (forall a. Int -> a -> a -> Node a
Node2 (Int
sz forall a. Num a => a -> a -> a
+ Int
sp) a
z a
p))
where !sz :: Int
sz = forall a. Sized a => a -> Int
size a
z
delRebuildMiddle :: Sized a
=> Int -> Digit a -> a -> Digit a
-> FingerTree a
delRebuildMiddle :: forall a. Sized a => Int -> Digit a -> a -> Digit a -> FingerTree a
delRebuildMiddle Int
s (One a
a) a
e Digit a
sf = forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
s (forall a. a -> a -> Digit a
Two a
a a
e) forall a. FingerTree a
EmptyT Digit a
sf
delRebuildMiddle Int
s (Two a
a a
b) a
e Digit a
sf = forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
s (forall a. a -> a -> a -> Digit a
Three a
a a
b a
e) forall a. FingerTree a
EmptyT Digit a
sf
delRebuildMiddle Int
s (Three a
a a
b a
c) a
e Digit a
sf = forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
s (forall a. a -> a -> a -> a -> Digit a
Four a
a a
b a
c a
e) forall a. FingerTree a
EmptyT Digit a
sf
delRebuildMiddle Int
s (Four a
a a
b a
c a
d) a
e Digit a
sf = forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
s (forall a. a -> a -> Digit a
Two a
a a
b) (forall a. a -> FingerTree a
Single (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 :: forall a.
Sized a =>
(Int -> Node a -> Del a) -> Int -> Digit (Node a) -> DelDig a
delDigit Int -> Node a -> Del a
f !Int
i (One Node a
a) = case Int -> Node a -> Del a
f Int
i Node a
a of
Full Node a
a' -> forall a. Digit (Node a) -> DelDig a
FullDig forall a b. (a -> b) -> a -> b
$ forall a. a -> Digit a
One Node a
a'
Defect a
e -> forall a. a -> DelDig a
DefectDig a
e
delDigit Int -> Node a -> Del a
f Int
i (Two Node a
a Node a
b)
| Int
i forall a. Ord a => a -> a -> Bool
< Int
sa = case Int -> Node a -> Del a
f Int
i Node a
a of
Full Node a
a' -> forall a. Digit (Node a) -> DelDig a
FullDig forall a b. (a -> b) -> a -> b
$ forall a. a -> a -> Digit a
Two Node a
a' Node a
b
Defect a
e -> let !se :: Int
se = forall a. Sized a => a -> Int
size a
e in case Node a
b of
Node3 Int
sxyz a
x a
y a
z -> forall a. Digit (Node a) -> DelDig a
FullDig forall a b. (a -> b) -> a -> b
$ forall a. a -> a -> Digit a
Two (forall a. Int -> a -> a -> Node a
Node2 (Int
se forall a. Num a => a -> a -> a
+ Int
sx) a
e a
x) (forall a. Int -> a -> a -> Node a
Node2 (Int
sxyz forall a. Num a => a -> a -> a
- Int
sx) a
y a
z)
where !sx :: Int
sx = forall a. Sized a => a -> Int
size a
x
Node2 Int
sxy a
x a
y -> forall a. Digit (Node a) -> DelDig a
FullDig forall a b. (a -> b) -> a -> b
$ forall a. a -> Digit a
One (forall a. Int -> a -> a -> a -> Node a
Node3 (Int
se 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 forall a. Num a => a -> a -> a
- Int
sa) Node a
b of
Full Node a
b' -> forall a. Digit (Node a) -> DelDig a
FullDig forall a b. (a -> b) -> a -> b
$ forall a. a -> a -> Digit a
Two Node a
a Node a
b'
Defect a
e -> let !se :: Int
se = forall a. Sized a => a -> Int
size a
e in case Node a
a of
Node3 Int
sxyz a
x a
y a
z -> forall a. Digit (Node a) -> DelDig a
FullDig forall a b. (a -> b) -> a -> b
$ forall a. a -> a -> Digit a
Two (forall a. Int -> a -> a -> Node a
Node2 (Int
sxyz forall a. Num a => a -> a -> a
- Int
sz) a
x a
y) (forall a. Int -> a -> a -> Node a
Node2 (Int
sz forall a. Num a => a -> a -> a
+ Int
se) a
z a
e)
where !sz :: Int
sz = forall a. Sized a => a -> Int
size a
z
Node2 Int
sxy a
x a
y -> forall a. Digit (Node a) -> DelDig a
FullDig forall a b. (a -> b) -> a -> b
$ forall a. a -> Digit a
One (forall a. Int -> a -> a -> a -> Node a
Node3 (Int
sxy forall a. Num a => a -> a -> a
+ Int
se) a
x a
y a
e)
where sa :: Int
sa = forall a. Sized a => a -> Int
size Node a
a
delDigit Int -> Node a -> Del a
f Int
i (Three Node a
a Node a
b Node a
c)
| Int
i forall a. Ord a => a -> a -> Bool
< Int
sa = case Int -> Node a -> Del a
f Int
i Node a
a of
Full Node a
a' -> forall a. Digit (Node a) -> DelDig a
FullDig forall a b. (a -> b) -> a -> b
$ forall a. a -> a -> a -> Digit a
Three Node a
a' Node a
b Node a
c
Defect a
e -> let !se :: Int
se = forall a. Sized a => a -> Int
size a
e in case Node a
b of
Node3 Int
sxyz a
x a
y a
z -> forall a. Digit (Node a) -> DelDig a
FullDig forall a b. (a -> b) -> a -> b
$ forall a. a -> a -> a -> Digit a
Three (forall a. Int -> a -> a -> Node a
Node2 (Int
se forall a. Num a => a -> a -> a
+ Int
sx) a
e a
x) (forall a. Int -> a -> a -> Node a
Node2 (Int
sxyz forall a. Num a => a -> a -> a
- Int
sx) a
y a
z) Node a
c
where !sx :: Int
sx = forall a. Sized a => a -> Int
size a
x
Node2 Int
sxy a
x a
y -> forall a. Digit (Node a) -> DelDig a
FullDig forall a b. (a -> b) -> a -> b
$ forall a. a -> a -> Digit a
Two (forall a. Int -> a -> a -> a -> Node a
Node3 (Int
se forall a. Num a => a -> a -> a
+ Int
sxy) a
e a
x a
y) Node a
c
| Int
i forall a. Ord a => a -> a -> Bool
< Int
sab = case Int -> Node a -> Del a
f (Int
i forall a. Num a => a -> a -> a
- Int
sa) Node a
b of
Full Node a
b' -> forall a. Digit (Node a) -> DelDig a
FullDig forall a b. (a -> b) -> a -> b
$ forall a. a -> a -> a -> Digit a
Three Node a
a Node a
b' Node a
c
Defect a
e -> let !se :: Int
se = forall a. Sized a => a -> Int
size a
e in case Node a
a of
Node3 Int
sxyz a
x a
y a
z -> forall a. Digit (Node a) -> DelDig a
FullDig forall a b. (a -> b) -> a -> b
$ forall a. a -> a -> a -> Digit a
Three (forall a. Int -> a -> a -> Node a
Node2 (Int
sxyz forall a. Num a => a -> a -> a
- Int
sz) a
x a
y) (forall a. Int -> a -> a -> Node a
Node2 (Int
sz forall a. Num a => a -> a -> a
+ Int
se) a
z a
e) Node a
c
where !sz :: Int
sz = forall a. Sized a => a -> Int
size a
z
Node2 Int
sxy a
x a
y -> forall a. Digit (Node a) -> DelDig a
FullDig forall a b. (a -> b) -> a -> b
$ forall a. a -> a -> Digit a
Two (forall a. Int -> a -> a -> a -> Node a
Node3 (Int
sxy 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 forall a. Num a => a -> a -> a
- Int
sab) Node a
c of
Full Node a
c' -> forall a. Digit (Node a) -> DelDig a
FullDig forall a b. (a -> b) -> a -> b
$ forall a. a -> a -> a -> Digit a
Three Node a
a Node a
b Node a
c'
Defect a
e -> let !se :: Int
se = forall a. Sized a => a -> Int
size a
e in case Node a
b of
Node3 Int
sxyz a
x a
y a
z -> forall a. Digit (Node a) -> DelDig a
FullDig forall a b. (a -> b) -> a -> b
$ forall a. a -> a -> a -> Digit a
Three Node a
a (forall a. Int -> a -> a -> Node a
Node2 (Int
sxyz forall a. Num a => a -> a -> a
- Int
sz) a
x a
y) (forall a. Int -> a -> a -> Node a
Node2 (Int
sz forall a. Num a => a -> a -> a
+ Int
se) a
z a
e)
where !sz :: Int
sz = forall a. Sized a => a -> Int
size a
z
Node2 Int
sxy a
x a
y -> forall a. Digit (Node a) -> DelDig a
FullDig forall a b. (a -> b) -> a -> b
$ forall a. a -> a -> Digit a
Two Node a
a (forall a. Int -> a -> a -> a -> Node a
Node3 (Int
sxy forall a. Num a => a -> a -> a
+ Int
se) a
x a
y a
e)
where sa :: Int
sa = forall a. Sized a => a -> Int
size Node a
a
sab :: Int
sab = Int
sa forall a. Num a => a -> a -> a
+ forall a. Sized a => a -> Int
size Node a
b
delDigit Int -> Node a -> Del a
f Int
i (Four Node a
a Node a
b Node a
c Node a
d)
| Int
i forall a. Ord a => a -> a -> Bool
< Int
sa = case Int -> Node a -> Del a
f Int
i Node a
a of
Full Node a
a' -> forall a. Digit (Node a) -> DelDig a
FullDig forall a b. (a -> b) -> a -> b
$ forall a. a -> a -> a -> a -> Digit a
Four Node a
a' Node a
b Node a
c Node a
d
Defect a
e -> let !se :: Int
se = forall a. Sized a => a -> Int
size a
e in case Node a
b of
Node3 Int
sxyz a
x a
y a
z -> forall a. Digit (Node a) -> DelDig a
FullDig forall a b. (a -> b) -> a -> b
$ forall a. a -> a -> a -> a -> Digit a
Four (forall a. Int -> a -> a -> Node a
Node2 (Int
se forall a. Num a => a -> a -> a
+ Int
sx) a
e a
x) (forall a. Int -> a -> a -> Node a
Node2 (Int
sxyz forall a. Num a => a -> a -> a
- Int
sx) a
y a
z) Node a
c Node a
d
where !sx :: Int
sx = forall a. Sized a => a -> Int
size a
x
Node2 Int
sxy a
x a
y -> forall a. Digit (Node a) -> DelDig a
FullDig forall a b. (a -> b) -> a -> b
$ forall a. a -> a -> a -> Digit a
Three (forall a. Int -> a -> a -> a -> Node a
Node3 (Int
se forall a. Num a => a -> a -> a
+ Int
sxy) a
e a
x a
y) Node a
c Node a
d
| Int
i forall a. Ord a => a -> a -> Bool
< Int
sab = case Int -> Node a -> Del a
f (Int
i forall a. Num a => a -> a -> a
- Int
sa) Node a
b of
Full Node a
b' -> forall a. Digit (Node a) -> DelDig a
FullDig forall a b. (a -> b) -> a -> b
$ forall a. a -> a -> a -> a -> Digit a
Four Node a
a Node a
b' Node a
c Node a
d
Defect a
e -> let !se :: Int
se = forall a. Sized a => a -> Int
size a
e in case Node a
a of
Node3 Int
sxyz a
x a
y a
z -> forall a. Digit (Node a) -> DelDig a
FullDig forall a b. (a -> b) -> a -> b
$ forall a. a -> a -> a -> a -> Digit a
Four (forall a. Int -> a -> a -> Node a
Node2 (Int
sxyz forall a. Num a => a -> a -> a
- Int
sz) a
x a
y) (forall a. Int -> a -> a -> Node a
Node2 (Int
sz forall a. Num a => a -> a -> a
+ Int
se) a
z a
e) Node a
c Node a
d
where !sz :: Int
sz = forall a. Sized a => a -> Int
size a
z
Node2 Int
sxy a
x a
y -> forall a. Digit (Node a) -> DelDig a
FullDig forall a b. (a -> b) -> a -> b
$ forall a. a -> a -> a -> Digit a
Three (forall a. Int -> a -> a -> a -> Node a
Node3 (Int
sxy forall a. Num a => a -> a -> a
+ Int
se) a
x a
y a
e) Node a
c Node a
d
| Int
i forall a. Ord a => a -> a -> Bool
< Int
sabc = case Int -> Node a -> Del a
f (Int
i forall a. Num a => a -> a -> a
- Int
sab) Node a
c of
Full Node a
c' -> forall a. Digit (Node a) -> DelDig a
FullDig forall a b. (a -> b) -> a -> b
$ forall a. a -> a -> a -> a -> Digit a
Four Node a
a Node a
b Node a
c' Node a
d
Defect a
e -> let !se :: Int
se = forall a. Sized a => a -> Int
size a
e in case Node a
b of
Node3 Int
sxyz a
x a
y a
z -> forall a. Digit (Node a) -> DelDig a
FullDig forall a b. (a -> b) -> a -> b
$ forall a. a -> a -> a -> a -> Digit a
Four Node a
a (forall a. Int -> a -> a -> Node a
Node2 (Int
sxyz forall a. Num a => a -> a -> a
- Int
sz) a
x a
y) (forall a. Int -> a -> a -> Node a
Node2 (Int
sz forall a. Num a => a -> a -> a
+ Int
se) a
z a
e) Node a
d
where !sz :: Int
sz = forall a. Sized a => a -> Int
size a
z
Node2 Int
sxy a
x a
y -> forall a. Digit (Node a) -> DelDig a
FullDig forall a b. (a -> b) -> a -> b
$ forall a. a -> a -> a -> Digit a
Three Node a
a (forall a. Int -> a -> a -> a -> Node a
Node3 (Int
sxy 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 forall a. Num a => a -> a -> a
- Int
sabc) Node a
d of
Full Node a
d' -> forall a. Digit (Node a) -> DelDig a
FullDig forall a b. (a -> b) -> a -> b
$ forall a. a -> a -> a -> a -> Digit a
Four Node a
a Node a
b Node a
c Node a
d'
Defect a
e -> let !se :: Int
se = forall a. Sized a => a -> Int
size a
e in case Node a
c of
Node3 Int
sxyz a
x a
y a
z -> forall a. Digit (Node a) -> DelDig a
FullDig forall a b. (a -> b) -> a -> b
$ forall a. a -> a -> a -> a -> Digit a
Four Node a
a Node a
b (forall a. Int -> a -> a -> Node a
Node2 (Int
sxyz forall a. Num a => a -> a -> a
- Int
sz) a
x a
y) (forall a. Int -> a -> a -> Node a
Node2 (Int
sz forall a. Num a => a -> a -> a
+ Int
se) a
z a
e)
where !sz :: Int
sz = forall a. Sized a => a -> Int
size a
z
Node2 Int
sxy a
x a
y -> forall a. Digit (Node a) -> DelDig a
FullDig forall a b. (a -> b) -> a -> b
$ forall a. a -> a -> a -> Digit a
Three Node a
a Node a
b (forall a. Int -> a -> a -> a -> Node a
Node3 (Int
sxy forall a. Num a => a -> a -> a
+ Int
se) a
x a
y a
e)
where sa :: Int
sa = forall a. Sized a => a -> Int
size Node a
a
sab :: Int
sab = Int
sa forall a. Num a => a -> a -> a
+ forall a. Sized a => a -> Int
size Node a
b
sabc :: Int
sabc = Int
sab forall a. Num a => a -> a -> a
+ forall a. Sized a => a -> Int
size Node a
c
mapWithIndex :: (Int -> a -> b) -> Seq a -> Seq b
mapWithIndex :: forall a b. (Int -> a -> b) -> Seq a -> Seq b
mapWithIndex Int -> a -> b
f' (Seq FingerTree (Elem a)
xs') = forall a. FingerTree (Elem a) -> Seq a
Seq forall a b. (a -> b) -> a -> b
$ forall a b.
Sized a =>
(Int -> a -> b) -> Int -> FingerTree a -> FingerTree b
mapWithIndexTree (\Int
s (Elem a
a) -> forall a. a -> Elem a
Elem (Int -> a -> b
f' Int
s a
a)) Int
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 :: forall a b.
Sized a =>
(Int -> a -> b) -> Int -> FingerTree a -> FingerTree b
mapWithIndexTree Int -> a -> b
_ !Int
_s FingerTree a
EmptyT = forall a. FingerTree a
EmptyT
mapWithIndexTree Int -> a -> b
f Int
s (Single a
xs) = forall a. a -> FingerTree a
Single forall a b. (a -> b) -> a -> b
$ Int -> a -> b
f Int
s a
xs
mapWithIndexTree Int -> a -> b
f Int
s (Deep Int
n Digit a
pr FingerTree (Node a)
m Digit a
sf) =
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
n
(forall a b. Sized a => (Int -> a -> b) -> Int -> Digit a -> Digit b
mapWithIndexDigit Int -> a -> b
f Int
s Digit a
pr)
(forall a b.
Sized a =>
(Int -> a -> b) -> Int -> FingerTree a -> FingerTree b
mapWithIndexTree (forall a b. Sized a => (Int -> a -> b) -> Int -> Node a -> Node b
mapWithIndexNode Int -> a -> b
f) Int
sPspr FingerTree (Node a)
m)
(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 forall a. Num a => a -> a -> a
+ forall a. Sized a => a -> Int
size Digit a
pr
!sPsprm :: Int
sPsprm = Int
sPspr forall a. Num a => a -> a -> a
+ 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 :: forall a b. Sized a => (Int -> a -> b) -> Int -> Digit a -> Digit b
mapWithIndexDigit Int -> a -> b
f !Int
s (One a
a) = forall a. a -> Digit a
One (Int -> a -> b
f Int
s a
a)
mapWithIndexDigit Int -> a -> b
f Int
s (Two a
a a
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 forall a. Num a => a -> a -> a
+ forall a. Sized a => a -> Int
size a
a
mapWithIndexDigit Int -> a -> b
f Int
s (Three a
a a
b a
c) =
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 forall a. Num a => a -> a -> a
+ forall a. Sized a => a -> Int
size a
a
!sPsab :: Int
sPsab = Int
sPsa forall a. Num a => a -> a -> a
+ forall a. Sized a => a -> Int
size a
b
mapWithIndexDigit Int -> a -> b
f Int
s (Four a
a a
b a
c a
d) =
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 forall a. Num a => a -> a -> a
+ forall a. Sized a => a -> Int
size a
a
!sPsab :: Int
sPsab = Int
sPsa forall a. Num a => a -> a -> a
+ forall a. Sized a => a -> Int
size a
b
!sPsabc :: Int
sPsabc = Int
sPsab forall a. Num a => a -> a -> a
+ 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 :: forall a b. Sized a => (Int -> a -> b) -> Int -> Node a -> Node b
mapWithIndexNode Int -> a -> b
f Int
s (Node2 Int
ns a
a a
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 forall a. Num a => a -> a -> a
+ forall a. Sized a => a -> Int
size a
a
mapWithIndexNode Int -> a -> b
f Int
s (Node3 Int
ns a
a a
b a
c) =
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 forall a. Num a => a -> a -> a
+ forall a. Sized a => a -> Int
size a
a
!sPsab :: Int
sPsab = Int
sPsa forall a. Num a => a -> a -> a
+ 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 :: forall a b.
Sized a =>
(b -> b -> b) -> (Int -> a -> b) -> Int -> Digit a -> b
foldWithIndexDigit b -> b -> b
_ Int -> a -> b
f !Int
s (One a
a) = Int -> a -> b
f Int
s a
a
foldWithIndexDigit b -> b -> b
(<+>) Int -> a -> b
f Int
s (Two a
a 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 forall a. Num a => a -> a -> a
+ forall a. Sized a => a -> Int
size a
a
foldWithIndexDigit b -> b -> b
(<+>) Int -> a -> b
f Int
s (Three a
a a
b 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 forall a. Num a => a -> a -> a
+ forall a. Sized a => a -> Int
size a
a
!sPsab :: Int
sPsab = Int
sPsa forall a. Num a => a -> a -> a
+ forall a. Sized a => a -> Int
size a
b
foldWithIndexDigit b -> b -> b
(<+>) Int -> a -> b
f Int
s (Four a
a a
b a
c 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 forall a. Num a => a -> a -> a
+ forall a. Sized a => a -> Int
size a
a
!sPsab :: Int
sPsab = Int
sPsa forall a. Num a => a -> a -> a
+ forall a. Sized a => a -> Int
size a
b
!sPsabc :: Int
sPsabc = Int
sPsab forall a. Num a => a -> a -> a
+ 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 :: forall a m.
Sized a =>
(m -> m -> m) -> (Int -> a -> m) -> Int -> Node a -> m
foldWithIndexNode m -> m -> m
(<+>) Int -> a -> m
f !Int
s (Node2 Int
_ a
a 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 forall a. Num a => a -> a -> a
+ forall a. Sized a => a -> Int
size a
a
foldWithIndexNode m -> m -> m
(<+>) Int -> a -> m
f Int
s (Node3 Int
_ a
a a
b 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 forall a. Num a => a -> a -> a
+ forall a. Sized a => a -> Int
size a
a
!sPsab :: Int
sPsab = Int
sPsa forall a. Num a => a -> a -> a
+ forall a. Sized a => a -> Int
size a
b
foldMapWithIndex :: Monoid m => (Int -> a -> m) -> Seq a -> m
foldMapWithIndex :: forall m a. Monoid m => (Int -> a -> m) -> Seq a -> m
foldMapWithIndex Int -> a -> m
f' (Seq FingerTree (Elem a)
xs') = forall m a.
Monoid m =>
(Int -> Elem a -> m) -> Int -> FingerTree (Elem a) -> m
foldMapWithIndexTreeE (forall a m. (Int -> a -> m) -> Int -> Elem a -> m
lift_elem Int -> a -> m
f') Int
0 FingerTree (Elem a)
xs'
where
lift_elem :: (Int -> a -> m) -> (Int -> Elem a -> m)
#if __GLASGOW_HASKELL__ >= 708
lift_elem :: forall a m. (Int -> a -> m) -> Int -> Elem a -> m
lift_elem Int -> a -> m
g = coerce :: 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 :: forall m a.
Monoid m =>
(Int -> Elem a -> m) -> Int -> FingerTree (Elem a) -> m
foldMapWithIndexTreeE Int -> Elem a -> m
_ !Int
_s FingerTree (Elem a)
EmptyT = forall a. Monoid a => a
mempty
foldMapWithIndexTreeE Int -> Elem a -> m
f Int
s (Single Elem a
xs) = Int -> Elem a -> m
f Int
s Elem a
xs
foldMapWithIndexTreeE Int -> Elem a -> m
f Int
s (Deep Int
_ Digit (Elem a)
pr FingerTree (Node (Elem a))
m Digit (Elem a)
sf) =
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 forall m. Monoid m => m -> m -> m
<>
forall m a.
Monoid m =>
(Int -> Node a -> m) -> Int -> FingerTree (Node a) -> m
foldMapWithIndexTreeN (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 forall m. Monoid m => m -> m -> 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 forall a. Num a => a -> a -> a
+ forall a. Sized a => a -> Int
size Digit (Elem a)
pr
!sPsprm :: Int
sPsprm = Int
sPspr forall a. Num a => a -> a -> a
+ 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 :: forall m a.
Monoid m =>
(Int -> Node a -> m) -> Int -> FingerTree (Node a) -> m
foldMapWithIndexTreeN Int -> Node a -> m
_ !Int
_s FingerTree (Node a)
EmptyT = forall a. Monoid a => a
mempty
foldMapWithIndexTreeN Int -> Node a -> m
f Int
s (Single Node a
xs) = Int -> Node a -> m
f Int
s Node a
xs
foldMapWithIndexTreeN Int -> Node a -> m
f Int
s (Deep Int
_ Digit (Node a)
pr FingerTree (Node (Node a))
m Digit (Node a)
sf) =
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 forall m. Monoid m => m -> m -> m
<>
forall m a.
Monoid m =>
(Int -> Node a -> m) -> Int -> FingerTree (Node a) -> m
foldMapWithIndexTreeN (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 forall m. Monoid m => m -> m -> 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 forall a. Num a => a -> a -> a
+ forall a. Sized a => a -> Int
size Digit (Node a)
pr
!sPsprm :: Int
sPsprm = Int
sPspr forall a. Num a => a -> a -> a
+ 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 :: forall m a.
Monoid m =>
(Int -> Elem a -> m) -> Int -> Digit (Elem a) -> m
foldMapWithIndexDigitE Int -> Elem a -> m
f Int
i Digit (Elem a)
t = forall a b.
Sized a =>
(b -> b -> b) -> (Int -> a -> b) -> Int -> Digit a -> b
foldWithIndexDigit forall m. Monoid m => m -> m -> m
(<>) Int -> Elem a -> m
f Int
i Digit (Elem a)
t
foldMapWithIndexDigitN :: Monoid m => (Int -> Node a -> m) -> Int -> Digit (Node a) -> m
foldMapWithIndexDigitN :: forall m a.
Monoid m =>
(Int -> Node a -> m) -> Int -> Digit (Node a) -> m
foldMapWithIndexDigitN Int -> Node a -> m
f Int
i Digit (Node a)
t = forall a b.
Sized a =>
(b -> b -> b) -> (Int -> a -> b) -> Int -> Digit a -> b
foldWithIndexDigit forall m. Monoid m => m -> m -> m
(<>) Int -> Node a -> m
f Int
i Digit (Node a)
t
foldMapWithIndexNodeE :: Monoid m => (Int -> Elem a -> m) -> Int -> Node (Elem a) -> m
foldMapWithIndexNodeE :: forall m a.
Monoid m =>
(Int -> Elem a -> m) -> Int -> Node (Elem a) -> m
foldMapWithIndexNodeE Int -> Elem a -> m
f Int
i Node (Elem a)
t = forall a m.
Sized a =>
(m -> m -> m) -> (Int -> a -> m) -> Int -> Node a -> m
foldWithIndexNode forall m. Monoid m => m -> m -> m
(<>) Int -> Elem a -> m
f Int
i Node (Elem a)
t
foldMapWithIndexNodeN :: Monoid m => (Int -> Node a -> m) -> Int -> Node (Node a) -> m
foldMapWithIndexNodeN :: forall m a.
Monoid m =>
(Int -> Node a -> m) -> Int -> Node (Node a) -> m
foldMapWithIndexNodeN Int -> Node a -> m
f Int
i Node (Node a)
t = forall a m.
Sized a =>
(m -> m -> m) -> (Int -> a -> m) -> Int -> Node a -> m
foldWithIndexNode forall m. Monoid m => m -> m -> m
(<>) 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 :: forall (f :: * -> *) a b.
Applicative f =>
(Int -> a -> f b) -> Seq a -> f (Seq b)
traverseWithIndex Int -> a -> f b
f' (Seq FingerTree (Elem a)
xs') = forall a. FingerTree (Elem a) -> Seq a
Seq forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a b.
Applicative f =>
(Int -> Elem a -> f b)
-> Int -> FingerTree (Elem a) -> f (FingerTree b)
traverseWithIndexTreeE (\Int
s (Elem a
a) -> forall a. a -> Elem a
Elem forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> a -> f b
f' Int
s a
a) Int
0 FingerTree (Elem a)
xs'
where
traverseWithIndexTreeE :: Applicative f => (Int -> Elem a -> f b) -> Int -> FingerTree (Elem a) -> f (FingerTree b)
traverseWithIndexTreeE :: forall (f :: * -> *) a b.
Applicative f =>
(Int -> Elem a -> f b)
-> Int -> FingerTree (Elem a) -> f (FingerTree b)
traverseWithIndexTreeE Int -> Elem a -> f b
_ !Int
_s FingerTree (Elem a)
EmptyT = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. FingerTree a
EmptyT
traverseWithIndexTreeE Int -> Elem a -> f b
f Int
s (Single Elem a
xs) = forall a. a -> FingerTree a
Single forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Elem a -> f b
f Int
s Elem a
xs
traverseWithIndexTreeE Int -> Elem a -> f b
f Int
s (Deep Int
n Digit (Elem a)
pr FingerTree (Node (Elem a))
m Digit (Elem a)
sf) =
forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3 (forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
n)
(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)
(forall (f :: * -> *) a b.
Applicative f =>
(Int -> Node a -> f b)
-> Int -> FingerTree (Node a) -> f (FingerTree b)
traverseWithIndexTreeN (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)
(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 forall a. Num a => a -> a -> a
+ forall a. Sized a => a -> Int
size Digit (Elem a)
pr
!sPsprm :: Int
sPsprm = Int
sPspr forall a. Num a => a -> a -> a
+ 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 :: 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
_s FingerTree (Node a)
EmptyT = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. FingerTree a
EmptyT
traverseWithIndexTreeN Int -> Node a -> f b
f Int
s (Single Node a
xs) = forall a. a -> FingerTree a
Single forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Node a -> f b
f Int
s Node a
xs
traverseWithIndexTreeN Int -> Node a -> f b
f Int
s (Deep Int
n Digit (Node a)
pr FingerTree (Node (Node a))
m Digit (Node a)
sf) =
forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3 (forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
n)
(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)
(forall (f :: * -> *) a b.
Applicative f =>
(Int -> Node a -> f b)
-> Int -> FingerTree (Node a) -> f (FingerTree b)
traverseWithIndexTreeN (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)
(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 forall a. Num a => a -> a -> a
+ forall a. Sized a => a -> Int
size Digit (Node a)
pr
!sPsprm :: Int
sPsprm = Int
sPspr forall a. Num a => a -> a -> a
+ 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 :: 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
i Digit (Elem a)
t = 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 :: 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
i Digit (Node a)
t = 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 :: forall (f :: * -> *) a b.
(Applicative f, Sized a) =>
(Int -> a -> f b) -> Int -> Digit a -> f (Digit b)
traverseWithIndexDigit Int -> a -> f b
f !Int
s (One a
a) = forall a. a -> Digit a
One forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> a -> f b
f Int
s a
a
traverseWithIndexDigit Int -> a -> f b
f Int
s (Two a
a a
b) = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 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 forall a. Num a => a -> a -> a
+ forall a. Sized a => a -> Int
size a
a
traverseWithIndexDigit Int -> a -> f b
f Int
s (Three a
a a
b a
c) =
forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3 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 forall a. Num a => a -> a -> a
+ forall a. Sized a => a -> Int
size a
a
!sPsab :: Int
sPsab = Int
sPsa forall a. Num a => a -> a -> a
+ forall a. Sized a => a -> Int
size a
b
traverseWithIndexDigit Int -> a -> f b
f Int
s (Four a
a a
b a
c a
d) =
forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3 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) 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 forall a. Num a => a -> a -> a
+ forall a. Sized a => a -> Int
size a
a
!sPsab :: Int
sPsab = Int
sPsa forall a. Num a => a -> a -> a
+ forall a. Sized a => a -> Int
size a
b
!sPsabc :: Int
sPsabc = Int
sPsab forall a. Num a => a -> a -> a
+ 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 :: 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
i Node (Elem a)
t = 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 :: 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
i Node (Node a)
t = 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 :: forall (f :: * -> *) a b.
(Applicative f, Sized a) =>
(Int -> a -> f b) -> Int -> Node a -> f (Node b)
traverseWithIndexNode Int -> a -> f b
f !Int
s (Node2 Int
ns a
a a
b) = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (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 forall a. Num a => a -> a -> a
+ forall a. Sized a => a -> Int
size a
a
traverseWithIndexNode Int -> a -> f b
f Int
s (Node3 Int
ns a
a a
b a
c) =
forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3 (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 forall a. Num a => a -> a -> a
+ forall a. Sized a => a -> Int
size a
a
!sPsab :: Int
sPsab = Int
sPsa forall a. Num a => a -> a -> a
+ 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 :: forall a. Int -> (Int -> a) -> Seq a
fromFunction Int
len Int -> a
f | Int
len forall a. Ord a => a -> a -> Bool
< Int
0 = forall a. HasCallStack => [Char] -> a
error [Char]
"Data.Sequence.fromFunction called with negative len"
| Int
len forall a. Eq a => a -> a -> Bool
== Int
0 = forall a. Seq a
empty
| Bool
otherwise = forall a. FingerTree (Elem a) -> Seq a
Seq forall a b. (a -> b) -> a -> b
$ forall a. (Int -> a) -> Int -> Int -> Int -> FingerTree a
create (forall a. (Int -> a) -> Int -> Elem a
lift_elem Int -> a
f) Int
1 Int
0 Int
len
where
create :: (Int -> a) -> Int -> Int -> Int -> FingerTree a
create :: forall a. (Int -> a) -> Int -> Int -> Int -> FingerTree a
create Int -> a
b !Int
s !Int
i Int
trees = case Int
trees of
Int
1 -> forall a. a -> FingerTree a
Single forall a b. (a -> b) -> a -> b
$ Int -> a
b Int
i
Int
2 -> forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
2forall a. Num a => a -> a -> a
*Int
s) (forall a. a -> Digit a
One (Int -> a
b Int
i)) forall a. FingerTree a
EmptyT (forall a. a -> Digit a
One (Int -> a
b (Int
iforall a. Num a => a -> a -> a
+Int
s)))
Int
3 -> forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
3forall a. Num a => a -> a -> a
*Int
s) (Int -> Digit a
createTwo Int
i) forall a. FingerTree a
EmptyT (forall a. a -> Digit a
One (Int -> a
b (Int
iforall a. Num a => a -> a -> a
+Int
2forall a. Num a => a -> a -> a
*Int
s)))
Int
4 -> forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
4forall a. Num a => a -> a -> a
*Int
s) (Int -> Digit a
createTwo Int
i) forall a. FingerTree a
EmptyT (Int -> Digit a
createTwo (Int
iforall a. Num a => a -> a -> a
+Int
2forall a. Num a => a -> a -> a
*Int
s))
Int
5 -> forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
5forall a. Num a => a -> a -> a
*Int
s) (Int -> Digit a
createThree Int
i) forall a. FingerTree a
EmptyT (Int -> Digit a
createTwo (Int
iforall a. Num a => a -> a -> a
+Int
3forall a. Num a => a -> a -> a
*Int
s))
Int
6 -> forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
6forall a. Num a => a -> a -> a
*Int
s) (Int -> Digit a
createThree Int
i) forall a. FingerTree a
EmptyT (Int -> Digit a
createThree (Int
iforall a. Num a => a -> a -> a
+Int
3forall a. Num a => a -> a -> a
*Int
s))
Int
_ -> case Int
trees forall a. Integral a => a -> a -> (a, a)
`quotRem` Int
3 of
(Int
trees', Int
1) -> forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
treesforall a. Num a => a -> a -> a
*Int
s) (Int -> Digit a
createTwo Int
i)
(forall a. (Int -> a) -> Int -> Int -> Int -> FingerTree a
create Int -> Node a
mb (Int
3forall a. Num a => a -> a -> a
*Int
s) (Int
iforall a. Num a => a -> a -> a
+Int
2forall a. Num a => a -> a -> a
*Int
s) (Int
trees'forall a. Num a => a -> a -> a
-Int
1))
(Int -> Digit a
createTwo (Int
iforall a. Num a => a -> a -> a
+(Int
2forall a. Num a => a -> a -> a
+Int
3forall a. Num a => a -> a -> a
*(Int
trees'forall a. Num a => a -> a -> a
-Int
1))forall a. Num a => a -> a -> a
*Int
s))
(Int
trees', Int
2) -> forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
treesforall a. Num a => a -> a -> a
*Int
s) (Int -> Digit a
createThree Int
i)
(forall a. (Int -> a) -> Int -> Int -> Int -> FingerTree a
create Int -> Node a
mb (Int
3forall a. Num a => a -> a -> a
*Int
s) (Int
iforall a. Num a => a -> a -> a
+Int
3forall a. Num a => a -> a -> a
*Int
s) (Int
trees'forall a. Num a => a -> a -> a
-Int
1))
(Int -> Digit a
createTwo (Int
iforall a. Num a => a -> a -> a
+(Int
3forall a. Num a => a -> a -> a
+Int
3forall a. Num a => a -> a -> a
*(Int
trees'forall a. Num a => a -> a -> a
-Int
1))forall a. Num a => a -> a -> a
*Int
s))
(Int
trees', Int
_) -> forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
treesforall a. Num a => a -> a -> a
*Int
s) (Int -> Digit a
createThree Int
i)
(forall a. (Int -> a) -> Int -> Int -> Int -> FingerTree a
create Int -> Node a
mb (Int
3forall a. Num a => a -> a -> a
*Int
s) (Int
iforall a. Num a => a -> a -> a
+Int
3forall a. Num a => a -> a -> a
*Int
s) (Int
trees'forall a. Num a => a -> a -> a
-Int
2))
(Int -> Digit a
createThree (Int
iforall a. Num a => a -> a -> a
+(Int
3forall a. Num a => a -> a -> a
+Int
3forall a. Num a => a -> a -> a
*(Int
trees'forall a. Num a => a -> a -> a
-Int
2))forall a. Num a => a -> a -> a
*Int
s))
where
createTwo :: Int -> Digit a
createTwo Int
j = forall a. a -> a -> Digit a
Two (Int -> a
b Int
j) (Int -> a
b (Int
j forall a. Num a => a -> a -> a
+ Int
s))
{-# INLINE createTwo #-}
createThree :: Int -> Digit a
createThree Int
j = forall a. a -> a -> a -> Digit a
Three (Int -> a
b Int
j) (Int -> a
b (Int
j forall a. Num a => a -> a -> a
+ Int
s)) (Int -> a
b (Int
j forall a. Num a => a -> a -> a
+ Int
2forall a. Num a => a -> a -> a
*Int
s))
{-# INLINE createThree #-}
mb :: Int -> Node a
mb Int
j = forall a. Int -> a -> a -> a -> Node a
Node3 (Int
3forall a. Num a => a -> a -> a
*Int
s) (Int -> a
b Int
j) (Int -> a
b (Int
j forall a. Num a => a -> a -> a
+ Int
s)) (Int -> a
b (Int
j forall a. Num a => a -> a -> a
+ Int
2forall a. Num a => a -> a -> a
*Int
s))
{-# INLINE mb #-}
lift_elem :: (Int -> a) -> (Int -> Elem a)
#if __GLASGOW_HASKELL__ >= 708
lift_elem :: forall a. (Int -> a) -> Int -> Elem a
lift_elem Int -> a
g = coerce :: 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 :: forall i a. Ix i => Array i a -> Seq a
fromArray Array i a
a = forall a. Int -> (Int -> a) -> Seq a
fromFunction (forall i e. Array i e -> Int
GHC.Arr.numElements Array i a
a) (forall i e. Array i e -> Int -> e
GHC.Arr.unsafeAt Array i a
a)
where
Int
_ = forall a. Ix a => (a, a) -> Int
Data.Array.rangeSize (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 :: forall a. Int -> Seq a -> Seq a
take Int
i xs :: Seq a
xs@(Seq FingerTree (Elem a)
t)
| forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i forall a. Num a => a -> a -> a
- Word
1 forall a. Ord a => a -> a -> Bool
< (forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Seq a -> Int
length Seq a
xs) forall a. Num a => a -> a -> a
- Word
1 :: Word) =
forall a. FingerTree (Elem a) -> Seq a
Seq (forall a. Int -> FingerTree (Elem a) -> FingerTree (Elem a)
takeTreeE Int
i FingerTree (Elem a)
t)
| Int
i forall a. Ord a => a -> a -> Bool
<= Int
0 = forall a. Seq a
empty
| Bool
otherwise = Seq a
xs
takeTreeE :: Int -> FingerTree (Elem a) -> FingerTree (Elem a)
takeTreeE :: forall a. Int -> FingerTree (Elem a) -> FingerTree (Elem a)
takeTreeE !Int
_i FingerTree (Elem a)
EmptyT = forall a. FingerTree a
EmptyT
takeTreeE Int
i t :: FingerTree (Elem a)
t@(Single Elem a
_)
| Int
i forall a. Ord a => a -> a -> Bool
<= Int
0 = forall a. FingerTree a
EmptyT
| Bool
otherwise = FingerTree (Elem a)
t
takeTreeE Int
i (Deep Int
s Digit (Elem a)
pr FingerTree (Node (Elem a))
m Digit (Elem a)
sf)
| Int
i forall a. Ord a => a -> a -> Bool
< Int
spr = forall a. Int -> Digit (Elem a) -> FingerTree (Elem a)
takePrefixE Int
i Digit (Elem a)
pr
| Int
i forall a. Ord a => a -> a -> Bool
< Int
spm = case forall a.
Int
-> FingerTree (Node a) -> StrictPair (FingerTree (Node a)) (Node a)
takeTreeN Int
im FingerTree (Node (Elem a))
m of
FingerTree (Node (Elem a))
ml :*: Node (Elem a)
xs -> forall a.
Int
-> Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> Node (Elem a)
-> FingerTree (Elem a)
takeMiddleE (Int
im forall a. Num a => a -> a -> a
- 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 = forall a.
Int
-> Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> FingerTree (Elem a)
takeSuffixE (Int
i 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 = forall a. Sized a => a -> Int
size Digit (Elem a)
pr
spm :: Int
spm = Int
spr forall a. Num a => a -> a -> a
+ forall a. Sized a => a -> Int
size FingerTree (Node (Elem a))
m
im :: Int
im = Int
i forall a. Num a => a -> a -> a
- Int
spr
takeTreeN :: Int -> FingerTree (Node a) -> StrictPair (FingerTree (Node a)) (Node a)
takeTreeN :: forall a.
Int
-> FingerTree (Node a) -> StrictPair (FingerTree (Node a)) (Node a)
takeTreeN !Int
_i FingerTree (Node a)
EmptyT = forall a. HasCallStack => [Char] -> a
error [Char]
"takeTreeN of empty tree"
takeTreeN Int
_i (Single Node a
x) = forall a. FingerTree a
EmptyT forall a b. a -> b -> StrictPair a b
:*: Node a
x
takeTreeN Int
i (Deep Int
s Digit (Node a)
pr FingerTree (Node (Node a))
m Digit (Node a)
sf)
| Int
i forall a. Ord a => a -> a -> Bool
< Int
spr = forall a.
Int -> Digit (Node a) -> StrictPair (FingerTree (Node a)) (Node a)
takePrefixN Int
i Digit (Node a)
pr
| Int
i forall a. Ord a => a -> a -> Bool
< Int
spm = case forall a.
Int
-> FingerTree (Node a) -> StrictPair (FingerTree (Node a)) (Node a)
takeTreeN Int
im FingerTree (Node (Node a))
m of
FingerTree (Node (Node a))
ml :*: Node (Node a)
xs -> forall a.
Int
-> Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> Node (Node a)
-> StrictPair (FingerTree (Node a)) (Node a)
takeMiddleN (Int
im forall a. Num a => a -> a -> a
- 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 = forall a.
Int
-> Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> StrictPair (FingerTree (Node a)) (Node a)
takeSuffixN (Int
i 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 = forall a. Sized a => a -> Int
size Digit (Node a)
pr
spm :: Int
spm = Int
spr forall a. Num a => a -> a -> a
+ forall a. Sized a => a -> Int
size FingerTree (Node (Node a))
m
im :: Int
im = Int
i 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 :: forall a.
Int
-> Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> Node (Node a)
-> StrictPair (FingerTree (Node a)) (Node a)
takeMiddleN Int
i Int
spr Digit (Node a)
pr FingerTree (Node (Node a))
ml (Node2 Int
_ Node a
a Node a
b)
| Int
i forall a. Ord a => a -> a -> Bool
< Int
sa = forall a. Int -> Digit a -> FingerTree (Node a) -> FingerTree a
pullR Int
sprml Digit (Node a)
pr FingerTree (Node (Node a))
ml forall a b. a -> b -> StrictPair a b
:*: Node a
a
| Bool
otherwise = forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
sprmla Digit (Node a)
pr FingerTree (Node (Node a))
ml (forall a. a -> Digit a
One Node a
a) forall a b. a -> b -> StrictPair a b
:*: Node a
b
where
sa :: Int
sa = forall a. Sized a => a -> Int
size Node a
a
sprml :: Int
sprml = Int
spr forall a. Num a => a -> a -> a
+ forall a. Sized a => a -> Int
size FingerTree (Node (Node a))
ml
sprmla :: Int
sprmla = Int
sa forall a. Num a => a -> a -> a
+ Int
sprml
takeMiddleN Int
i Int
spr Digit (Node a)
pr FingerTree (Node (Node a))
ml (Node3 Int
_ Node a
a Node a
b Node a
c)
| Int
i forall a. Ord a => a -> a -> Bool
< Int
sa = forall a. Int -> Digit a -> FingerTree (Node a) -> FingerTree a
pullR Int
sprml Digit (Node a)
pr FingerTree (Node (Node a))
ml forall a b. a -> b -> StrictPair a b
:*: Node a
a
| Int
i forall a. Ord a => a -> a -> Bool
< Int
sab = forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
sprmla Digit (Node a)
pr FingerTree (Node (Node a))
ml (forall a. a -> Digit a
One Node a
a) forall a b. a -> b -> StrictPair a b
:*: Node a
b
| Bool
otherwise = forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
sprmlab Digit (Node a)
pr FingerTree (Node (Node a))
ml (forall a. a -> a -> Digit a
Two Node a
a Node a
b) forall a b. a -> b -> StrictPair a b
:*: Node a
c
where
sa :: Int
sa = forall a. Sized a => a -> Int
size Node a
a
sab :: Int
sab = Int
sa forall a. Num a => a -> a -> a
+ forall a. Sized a => a -> Int
size Node a
b
sprml :: Int
sprml = Int
spr forall a. Num a => a -> a -> a
+ forall a. Sized a => a -> Int
size FingerTree (Node (Node a))
ml
sprmla :: Int
sprmla = Int
sa forall a. Num a => a -> a -> a
+ Int
sprml
sprmlab :: Int
sprmlab = Int
sprmla forall a. Num a => a -> a -> a
+ 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 :: forall a.
Int
-> Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> Node (Elem a)
-> FingerTree (Elem a)
takeMiddleE Int
i Int
spr Digit (Elem a)
pr FingerTree (Node (Elem a))
ml (Node2 Int
_ Elem a
a Elem a
_)
| Int
i forall a. Ord a => a -> a -> Bool
< Int
1 = forall a. Int -> Digit a -> FingerTree (Node a) -> FingerTree a
pullR Int
sprml Digit (Elem a)
pr FingerTree (Node (Elem a))
ml
| Bool
otherwise = forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
sprmla Digit (Elem a)
pr FingerTree (Node (Elem a))
ml (forall a. a -> Digit a
One Elem a
a)
where
sprml :: Int
sprml = Int
spr forall a. Num a => a -> a -> a
+ forall a. Sized a => a -> Int
size FingerTree (Node (Elem a))
ml
sprmla :: Int
sprmla = Int
1 forall a. Num a => a -> a -> a
+ Int
sprml
takeMiddleE Int
i Int
spr Digit (Elem a)
pr FingerTree (Node (Elem a))
ml (Node3 Int
_ Elem a
a Elem a
b Elem a
_)
| Int
i forall a. Ord a => a -> a -> Bool
< Int
1 = forall a. Int -> Digit a -> FingerTree (Node a) -> FingerTree a
pullR Int
sprml Digit (Elem a)
pr FingerTree (Node (Elem a))
ml
| Int
i forall a. Ord a => a -> a -> Bool
< Int
2 = forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
sprmla Digit (Elem a)
pr FingerTree (Node (Elem a))
ml (forall a. a -> Digit a
One Elem a
a)
| Bool
otherwise = forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
sprmlab Digit (Elem a)
pr FingerTree (Node (Elem a))
ml (forall a. a -> a -> Digit a
Two Elem a
a Elem a
b)
where
sprml :: Int
sprml = Int
spr forall a. Num a => a -> a -> a
+ forall a. Sized a => a -> Int
size FingerTree (Node (Elem a))
ml
sprmla :: Int
sprmla = Int
1 forall a. Num a => a -> a -> a
+ Int
sprml
sprmlab :: Int
sprmlab = Int
sprmla forall a. Num a => a -> a -> a
+ Int
1
takePrefixE :: Int -> Digit (Elem a) -> FingerTree (Elem a)
takePrefixE :: forall a. Int -> Digit (Elem a) -> FingerTree (Elem a)
takePrefixE !Int
_i (One Elem a
_) = forall a. FingerTree a
EmptyT
takePrefixE Int
i (Two Elem a
a Elem a
_)
| Int
i forall a. Ord a => a -> a -> Bool
< Int
1 = forall a. FingerTree a
EmptyT
| Bool
otherwise = forall a. a -> FingerTree a
Single Elem a
a
takePrefixE Int
i (Three Elem a
a Elem a
b Elem a
_)
| Int
i forall a. Ord a => a -> a -> Bool
< Int
1 = forall a. FingerTree a
EmptyT
| Int
i forall a. Ord a => a -> a -> Bool
< Int
2 = forall a. a -> FingerTree a
Single Elem a
a
| Bool
otherwise = forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
2 (forall a. a -> Digit a
One Elem a
a) forall a. FingerTree a
EmptyT (forall a. a -> Digit a
One Elem a
b)
takePrefixE Int
i (Four Elem a
a Elem a
b Elem a
c Elem a
_)
| Int
i forall a. Ord a => a -> a -> Bool
< Int
1 = forall a. FingerTree a
EmptyT
| Int
i forall a. Ord a => a -> a -> Bool
< Int
2 = forall a. a -> FingerTree a
Single Elem a
a
| Int
i forall a. Ord a => a -> a -> Bool
< Int
3 = forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
2 (forall a. a -> Digit a
One Elem a
a) forall a. FingerTree a
EmptyT (forall a. a -> Digit a
One Elem a
b)
| Bool
otherwise = forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
3 (forall a. a -> a -> Digit a
Two Elem a
a Elem a
b) forall a. FingerTree a
EmptyT (forall a. a -> Digit a
One Elem a
c)
takePrefixN :: Int -> Digit (Node a)
-> StrictPair (FingerTree (Node a)) (Node a)
takePrefixN :: forall a.
Int -> Digit (Node a) -> StrictPair (FingerTree (Node a)) (Node a)
takePrefixN !Int
_i (One Node a
a) = forall a. FingerTree a
EmptyT forall a b. a -> b -> StrictPair a b
:*: Node a
a
takePrefixN Int
i (Two Node a
a Node a
b)
| Int
i forall a. Ord a => a -> a -> Bool
< Int
sa = forall a. FingerTree a
EmptyT forall a b. a -> b -> StrictPair a b
:*: Node a
a
| Bool
otherwise = forall a. a -> FingerTree a
Single Node a
a forall a b. a -> b -> StrictPair a b
:*: Node a
b
where
sa :: Int
sa = forall a. Sized a => a -> Int
size Node a
a
takePrefixN Int
i (Three Node a
a Node a
b Node a
c)
| Int
i forall a. Ord a => a -> a -> Bool
< Int
sa = forall a. FingerTree a
EmptyT forall a b. a -> b -> StrictPair a b
:*: Node a
a
| Int
i forall a. Ord a => a -> a -> Bool
< Int
sab = forall a. a -> FingerTree a
Single Node a
a forall a b. a -> b -> StrictPair a b
:*: Node a
b
| Bool
otherwise = forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
sab (forall a. a -> Digit a
One Node a
a) forall a. FingerTree a
EmptyT (forall a. a -> Digit a
One Node a
b) forall a b. a -> b -> StrictPair a b
:*: Node a
c
where
sa :: Int
sa = forall a. Sized a => a -> Int
size Node a
a
sab :: Int
sab = Int
sa forall a. Num a => a -> a -> a
+ forall a. Sized a => a -> Int
size Node a
b
takePrefixN Int
i (Four Node a
a Node a
b Node a
c Node a
d)
| Int
i forall a. Ord a => a -> a -> Bool
< Int
sa = forall a. FingerTree a
EmptyT forall a b. a -> b -> StrictPair a b
:*: Node a
a
| Int
i forall a. Ord a => a -> a -> Bool
< Int
sab = forall a. a -> FingerTree a
Single Node a
a forall a b. a -> b -> StrictPair a b
:*: Node a
b
| Int
i forall a. Ord a => a -> a -> Bool
< Int
sabc = forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
sab (forall a. a -> Digit a
One Node a
a) forall a. FingerTree a
EmptyT (forall a. a -> Digit a
One Node a
b) forall a b. a -> b -> StrictPair a b
:*: Node a
c
| Bool
otherwise = forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
sabc (forall a. a -> a -> Digit a
Two Node a
a Node a
b) forall a. FingerTree a
EmptyT (forall a. a -> Digit a
One Node a
c) forall a b. a -> b -> StrictPair a b
:*: Node a
d
where
sa :: Int
sa = forall a. Sized a => a -> Int
size Node a
a
sab :: Int
sab = Int
sa forall a. Num a => a -> a -> a
+ forall a. Sized a => a -> Int
size Node a
b
sabc :: Int
sabc = Int
sab forall a. Num a => a -> a -> a
+ 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 :: forall a.
Int
-> Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> FingerTree (Elem a)
takeSuffixE !Int
_i !Int
s Digit (Elem a)
pr FingerTree (Node (Elem a))
m (One Elem a
_) = forall a. Int -> Digit a -> FingerTree (Node a) -> FingerTree a
pullR (Int
s forall a. Num a => a -> a -> a
- Int
1) Digit (Elem a)
pr FingerTree (Node (Elem a))
m
takeSuffixE Int
i Int
s Digit (Elem a)
pr FingerTree (Node (Elem a))
m (Two Elem a
a Elem a
_)
| Int
i forall a. Ord a => a -> a -> Bool
< Int
1 = forall a. Int -> Digit a -> FingerTree (Node a) -> FingerTree a
pullR (Int
s forall a. Num a => a -> a -> a
- Int
2) Digit (Elem a)
pr FingerTree (Node (Elem a))
m
| Bool
otherwise = forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s forall a. Num a => a -> a -> a
- Int
1) Digit (Elem a)
pr FingerTree (Node (Elem a))
m (forall a. a -> Digit a
One Elem a
a)
takeSuffixE Int
i Int
s Digit (Elem a)
pr FingerTree (Node (Elem a))
m (Three Elem a
a Elem a
b Elem a
_)
| Int
i forall a. Ord a => a -> a -> Bool
< Int
1 = forall a. Int -> Digit a -> FingerTree (Node a) -> FingerTree a
pullR (Int
s forall a. Num a => a -> a -> a
- Int
3) Digit (Elem a)
pr FingerTree (Node (Elem a))
m
| Int
i forall a. Ord a => a -> a -> Bool
< Int
2 = forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s forall a. Num a => a -> a -> a
- Int
2) Digit (Elem a)
pr FingerTree (Node (Elem a))
m (forall a. a -> Digit a
One Elem a
a)
| Bool
otherwise = forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s forall a. Num a => a -> a -> a
- Int
1) Digit (Elem a)
pr FingerTree (Node (Elem a))
m (forall a. a -> a -> Digit a
Two Elem a
a Elem a
b)
takeSuffixE Int
i Int
s Digit (Elem a)
pr FingerTree (Node (Elem a))
m (Four Elem a
a Elem a
b Elem a
c Elem a
_)
| Int
i forall a. Ord a => a -> a -> Bool
< Int
1 = forall a. Int -> Digit a -> FingerTree (Node a) -> FingerTree a
pullR (Int
s forall a. Num a => a -> a -> a
- Int
4) Digit (Elem a)
pr FingerTree (Node (Elem a))
m
| Int
i forall a. Ord a => a -> a -> Bool
< Int
2 = forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s forall a. Num a => a -> a -> a
- Int
3) Digit (Elem a)
pr FingerTree (Node (Elem a))
m (forall a. a -> Digit a
One Elem a
a)
| Int
i forall a. Ord a => a -> a -> Bool
< Int
3 = forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s forall a. Num a => a -> a -> a
- Int
2) Digit (Elem a)
pr FingerTree (Node (Elem a))
m (forall a. a -> a -> Digit a
Two Elem a
a Elem a
b)
| Bool
otherwise = forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s forall a. Num a => a -> a -> a
- Int
1) Digit (Elem a)
pr FingerTree (Node (Elem a))
m (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 :: forall a.
Int
-> Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> StrictPair (FingerTree (Node a)) (Node a)
takeSuffixN !Int
_i !Int
s Digit (Node a)
pr FingerTree (Node (Node a))
m (One Node a
a) = forall a. Int -> Digit a -> FingerTree (Node a) -> FingerTree a
pullR (Int
s forall a. Num a => a -> a -> a
- forall a. Sized a => a -> Int
size Node a
a) Digit (Node a)
pr FingerTree (Node (Node a))
m forall a b. a -> b -> StrictPair a b
:*: Node a
a
takeSuffixN Int
i Int
s Digit (Node a)
pr FingerTree (Node (Node a))
m (Two Node a
a Node a
b)
| Int
i forall a. Ord a => a -> a -> Bool
< Int
sa = forall a. Int -> Digit a -> FingerTree (Node a) -> FingerTree a
pullR (Int
s forall a. Num a => a -> a -> a
- Int
sa forall a. Num a => a -> a -> a
- forall a. Sized a => a -> Int
size Node a
b) Digit (Node a)
pr FingerTree (Node (Node a))
m forall a b. a -> b -> StrictPair a b
:*: Node a
a
| Bool
otherwise = forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s forall a. Num a => a -> a -> a
- forall a. Sized a => a -> Int
size Node a
b) Digit (Node a)
pr FingerTree (Node (Node a))
m (forall a. a -> Digit a
One Node a
a) forall a b. a -> b -> StrictPair a b
:*: Node a
b
where
sa :: Int
sa = forall a. Sized a => a -> Int
size Node a
a
takeSuffixN Int
i Int
s Digit (Node a)
pr FingerTree (Node (Node a))
m (Three Node a
a Node a
b Node a
c)
| Int
i forall a. Ord a => a -> a -> Bool
< Int
sa = forall a. Int -> Digit a -> FingerTree (Node a) -> FingerTree a
pullR (Int
s forall a. Num a => a -> a -> a
- Int
sab forall a. Num a => a -> a -> a
- forall a. Sized a => a -> Int
size Node a
c) Digit (Node a)
pr FingerTree (Node (Node a))
m forall a b. a -> b -> StrictPair a b
:*: Node a
a
| Int
i forall a. Ord a => a -> a -> Bool
< Int
sab = forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s forall a. Num a => a -> a -> a
- forall a. Sized a => a -> Int
size Node a
b forall a. Num a => a -> a -> a
- forall a. Sized a => a -> Int
size Node a
c) Digit (Node a)
pr FingerTree (Node (Node a))
m (forall a. a -> Digit a
One Node a
a) forall a b. a -> b -> StrictPair a b
:*: Node a
b
| Bool
otherwise = forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s forall a. Num a => a -> a -> a
- forall a. Sized a => a -> Int
size Node a
c) Digit (Node a)
pr FingerTree (Node (Node a))
m (forall a. a -> a -> Digit a
Two Node a
a Node a
b) forall a b. a -> b -> StrictPair a b
:*: Node a
c
where
sa :: Int
sa = forall a. Sized a => a -> Int
size Node a
a
sab :: Int
sab = Int
sa forall a. Num a => a -> a -> a
+ forall a. Sized a => a -> Int
size Node a
b
takeSuffixN Int
i Int
s Digit (Node a)
pr FingerTree (Node (Node a))
m (Four Node a
a Node a
b Node a
c Node a
d)
| Int
i forall a. Ord a => a -> a -> Bool
< Int
sa = forall a. Int -> Digit a -> FingerTree (Node a) -> FingerTree a
pullR (Int
s forall a. Num a => a -> a -> a
- Int
sa forall a. Num a => a -> a -> a
- Int
sbcd) Digit (Node a)
pr FingerTree (Node (Node a))
m forall a b. a -> b -> StrictPair a b
:*: Node a
a
| Int
i forall a. Ord a => a -> a -> Bool
< Int
sab = forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s forall a. Num a => a -> a -> a
- Int
sbcd) Digit (Node a)
pr FingerTree (Node (Node a))
m (forall a. a -> Digit a
One Node a
a) forall a b. a -> b -> StrictPair a b
:*: Node a
b
| Int
i forall a. Ord a => a -> a -> Bool
< Int
sabc = forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s forall a. Num a => a -> a -> a
- Int
scd) Digit (Node a)
pr FingerTree (Node (Node a))
m (forall a. a -> a -> Digit a
Two Node a
a Node a
b) forall a b. a -> b -> StrictPair a b
:*: Node a
c
| Bool
otherwise = forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s forall a. Num a => a -> a -> a
- Int
sd) Digit (Node a)
pr FingerTree (Node (Node a))
m (forall a. a -> a -> a -> Digit a
Three Node a
a Node a
b Node a
c) forall a b. a -> b -> StrictPair a b
:*: Node a
d
where
sa :: Int
sa = forall a. Sized a => a -> Int
size Node a
a
sab :: Int
sab = Int
sa forall a. Num a => a -> a -> a
+ forall a. Sized a => a -> Int
size Node a
b
sabc :: Int
sabc = Int
sab forall a. Num a => a -> a -> a
+ forall a. Sized a => a -> Int
size Node a
c
sd :: Int
sd = forall a. Sized a => a -> Int
size Node a
d
scd :: Int
scd = forall a. Sized a => a -> Int
size Node a
c forall a. Num a => a -> a -> a
+ Int
sd
sbcd :: Int
sbcd = forall a. Sized a => a -> Int
size Node a
b forall a. Num a => a -> a -> a
+ Int
scd
drop :: Int -> Seq a -> Seq a
drop :: forall a. Int -> Seq a -> Seq a
drop Int
i xs :: Seq a
xs@(Seq FingerTree (Elem a)
t)
| forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i forall a. Num a => a -> a -> a
- Word
1 forall a. Ord a => a -> a -> Bool
< (forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Seq a -> Int
length Seq a
xs) forall a. Num a => a -> a -> a
- Word
1 :: Word) =
forall a. FingerTree (Elem a) -> Seq a
Seq (forall a. Int -> FingerTree (Elem a) -> FingerTree (Elem a)
takeTreeER (forall a. Seq a -> Int
length Seq a
xs forall a. Num a => a -> a -> a
- Int
i) FingerTree (Elem a)
t)
| Int
i forall a. Ord a => a -> a -> Bool
<= Int
0 = Seq a
xs
| Bool
otherwise = forall a. Seq a
empty
takeTreeER :: Int -> FingerTree (Elem a) -> FingerTree (Elem a)
takeTreeER :: forall a. Int -> FingerTree (Elem a) -> FingerTree (Elem a)
takeTreeER !Int
_i FingerTree (Elem a)
EmptyT = forall a. FingerTree a
EmptyT
takeTreeER Int
i t :: FingerTree (Elem a)
t@(Single Elem a
_)
| Int
i forall a. Ord a => a -> a -> Bool
<= Int
0 = forall a. FingerTree a
EmptyT
| Bool
otherwise = FingerTree (Elem a)
t
takeTreeER Int
i (Deep Int
s Digit (Elem a)
pr FingerTree (Node (Elem a))
m Digit (Elem a)
sf)
| Int
i forall a. Ord a => a -> a -> Bool
< Int
ssf = forall a. Int -> Digit (Elem a) -> FingerTree (Elem a)
takeSuffixER Int
i Digit (Elem a)
sf
| Int
i forall a. Ord a => a -> a -> Bool
< Int
ssm = case forall a.
Int
-> FingerTree (Node a) -> StrictPair (Node a) (FingerTree (Node a))
takeTreeNR Int
im FingerTree (Node (Elem a))
m of
Node (Elem a)
xs :*: FingerTree (Node (Elem a))
mr -> forall a.
Int
-> Int
-> Node (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> FingerTree (Elem a)
takeMiddleER (Int
im forall a. Num a => a -> a -> a
- 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 = forall a.
Int
-> Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> FingerTree (Elem a)
takePrefixER (Int
i 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 = forall a. Sized a => a -> Int
size Digit (Elem a)
sf
ssm :: Int
ssm = Int
ssf forall a. Num a => a -> a -> a
+ forall a. Sized a => a -> Int
size FingerTree (Node (Elem a))
m
im :: Int
im = Int
i forall a. Num a => a -> a -> a
- Int
ssf
takeTreeNR :: Int -> FingerTree (Node a) -> StrictPair (Node a) (FingerTree (Node a))
takeTreeNR :: forall a.
Int
-> FingerTree (Node a) -> StrictPair (Node a) (FingerTree (Node a))
takeTreeNR !Int
_i FingerTree (Node a)
EmptyT = forall a. HasCallStack => [Char] -> a
error [Char]
"takeTreeNR of empty tree"
takeTreeNR Int
_i (Single Node a
x) = Node a
x forall a b. a -> b -> StrictPair a b
:*: forall a. FingerTree a
EmptyT
takeTreeNR Int
i (Deep Int
s Digit (Node a)
pr FingerTree (Node (Node a))
m Digit (Node a)
sf)
| Int
i forall a. Ord a => a -> a -> Bool
< Int
ssf = forall a.
Int -> Digit (Node a) -> StrictPair (Node a) (FingerTree (Node a))
takeSuffixNR Int
i Digit (Node a)
sf
| Int
i forall a. Ord a => a -> a -> Bool
< Int
ssm = case forall a.
Int
-> FingerTree (Node a) -> StrictPair (Node a) (FingerTree (Node a))
takeTreeNR Int
im FingerTree (Node (Node a))
m of
Node (Node a)
xs :*: FingerTree (Node (Node a))
mr -> forall a.
Int
-> Int
-> Node (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> StrictPair (Node a) (FingerTree (Node a))
takeMiddleNR (Int
im forall a. Num a => a -> a -> a
- 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 = forall a.
Int
-> Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> StrictPair (Node a) (FingerTree (Node a))
takePrefixNR (Int
i 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 = forall a. Sized a => a -> Int
size Digit (Node a)
sf
ssm :: Int
ssm = Int
ssf forall a. Num a => a -> a -> a
+ forall a. Sized a => a -> Int
size FingerTree (Node (Node a))
m
im :: Int
im = Int
i 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 :: forall a.
Int
-> Int
-> Node (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> StrictPair (Node a) (FingerTree (Node a))
takeMiddleNR Int
i Int
ssf (Node2 Int
_ Node a
a Node a
b) FingerTree (Node (Node a))
mr Digit (Node a)
sf
| Int
i forall a. Ord a => a -> a -> Bool
< Int
sb = Node a
b forall a b. a -> b -> StrictPair a b
:*: 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 forall a b. a -> b -> StrictPair a b
:*: forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
ssfmrb (forall a. a -> Digit a
One Node a
b) FingerTree (Node (Node a))
mr Digit (Node a)
sf
where
sb :: Int
sb = forall a. Sized a => a -> Int
size Node a
b
ssfmr :: Int
ssfmr = Int
ssf forall a. Num a => a -> a -> a
+ forall a. Sized a => a -> Int
size FingerTree (Node (Node a))
mr
ssfmrb :: Int
ssfmrb = Int
sb forall a. Num a => a -> a -> a
+ Int
ssfmr
takeMiddleNR Int
i Int
ssf (Node3 Int
_ Node a
a Node a
b Node a
c) FingerTree (Node (Node a))
mr Digit (Node a)
sf
| Int
i forall a. Ord a => a -> a -> Bool
< Int
sc = Node a
c forall a b. a -> b -> StrictPair a b
:*: forall a. Int -> FingerTree (Node a) -> Digit a -> FingerTree a
pullL Int
ssfmr FingerTree (Node (Node a))
mr Digit (Node a)
sf
| Int
i forall a. Ord a => a -> a -> Bool
< Int
sbc = Node a
b forall a b. a -> b -> StrictPair a b
:*: forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
ssfmrc (forall a. a -> Digit a
One Node a
c) FingerTree (Node (Node a))
mr Digit (Node a)
sf
| Bool
otherwise = Node a
a forall a b. a -> b -> StrictPair a b
:*: forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
ssfmrbc (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 = forall a. Sized a => a -> Int
size Node a
c
sbc :: Int
sbc = Int
sc forall a. Num a => a -> a -> a
+ forall a. Sized a => a -> Int
size Node a
b
ssfmr :: Int
ssfmr = Int
ssf forall a. Num a => a -> a -> a
+ forall a. Sized a => a -> Int
size FingerTree (Node (Node a))
mr
ssfmrc :: Int
ssfmrc = Int
sc forall a. Num a => a -> a -> a
+ Int
ssfmr
ssfmrbc :: Int
ssfmrbc = Int
ssfmrc forall a. Num a => a -> a -> a
+ 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 :: forall a.
Int
-> Int
-> Node (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> FingerTree (Elem a)
takeMiddleER Int
i Int
ssf (Node2 Int
_ Elem a
_ Elem a
b) FingerTree (Node (Elem a))
mr Digit (Elem a)
sf
| Int
i forall a. Ord a => a -> a -> Bool
< Int
1 = forall a. Int -> FingerTree (Node a) -> Digit a -> FingerTree a
pullL Int
ssfmr FingerTree (Node (Elem a))
mr Digit (Elem a)
sf
| Bool
otherwise = forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
ssfmrb (forall a. a -> Digit a
One Elem a
b) FingerTree (Node (Elem a))
mr Digit (Elem a)
sf
where
ssfmr :: Int
ssfmr = Int
ssf forall a. Num a => a -> a -> a
+ forall a. Sized a => a -> Int
size FingerTree (Node (Elem a))
mr
ssfmrb :: Int
ssfmrb = Int
1 forall a. Num a => a -> a -> a
+ Int
ssfmr
takeMiddleER Int
i Int
ssf (Node3 Int
_ Elem a
_ Elem a
b Elem a
c) FingerTree (Node (Elem a))
mr Digit (Elem a)
sf
| Int
i forall a. Ord a => a -> a -> Bool
< Int
1 = forall a. Int -> FingerTree (Node a) -> Digit a -> FingerTree a
pullL Int
ssfmr FingerTree (Node (Elem a))
mr Digit (Elem a)
sf
| Int
i forall a. Ord a => a -> a -> Bool
< Int
2 = forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
ssfmrc (forall a. a -> Digit a
One Elem a
c) FingerTree (Node (Elem a))
mr Digit (Elem a)
sf
| Bool
otherwise = forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
ssfmrbc (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 forall a. Num a => a -> a -> a
+ forall a. Sized a => a -> Int
size FingerTree (Node (Elem a))
mr
ssfmrc :: Int
ssfmrc = Int
1 forall a. Num a => a -> a -> a
+ Int
ssfmr
ssfmrbc :: Int
ssfmrbc = Int
ssfmr forall a. Num a => a -> a -> a
+ Int
2
takeSuffixER :: Int -> Digit (Elem a) -> FingerTree (Elem a)
takeSuffixER :: forall a. Int -> Digit (Elem a) -> FingerTree (Elem a)
takeSuffixER !Int
_i (One Elem a
_) = forall a. FingerTree a
EmptyT
takeSuffixER Int
i (Two Elem a
_ Elem a
b)
| Int
i forall a. Ord a => a -> a -> Bool
< Int
1 = forall a. FingerTree a
EmptyT
| Bool
otherwise = forall a. a -> FingerTree a
Single Elem a
b
takeSuffixER Int
i (Three Elem a
_ Elem a
b Elem a
c)
| Int
i forall a. Ord a => a -> a -> Bool
< Int
1 = forall a. FingerTree a
EmptyT
| Int
i forall a. Ord a => a -> a -> Bool
< Int
2 = forall a. a -> FingerTree a
Single Elem a
c
| Bool
otherwise = forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
2 (forall a. a -> Digit a
One Elem a
b) forall a. FingerTree a
EmptyT (forall a. a -> Digit a
One Elem a
c)
takeSuffixER Int
i (Four Elem a
_ Elem a
b Elem a
c Elem a
d)
| Int
i forall a. Ord a => a -> a -> Bool
< Int
1 = forall a. FingerTree a
EmptyT
| Int
i forall a. Ord a => a -> a -> Bool
< Int
2 = forall a. a -> FingerTree a
Single Elem a
d
| Int
i forall a. Ord a => a -> a -> Bool
< Int
3 = forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
2 (forall a. a -> Digit a
One Elem a
c) forall a. FingerTree a
EmptyT (forall a. a -> Digit a
One Elem a
d)
| Bool
otherwise = forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
3 (forall a. a -> a -> Digit a
Two Elem a
b Elem a
c) forall a. FingerTree a
EmptyT (forall a. a -> Digit a
One Elem a
d)
takeSuffixNR :: Int -> Digit (Node a)
-> StrictPair (Node a) (FingerTree (Node a))
takeSuffixNR :: forall a.
Int -> Digit (Node a) -> StrictPair (Node a) (FingerTree (Node a))
takeSuffixNR !Int
_i (One Node a
a) = Node a
a forall a b. a -> b -> StrictPair a b
:*: forall a. FingerTree a
EmptyT
takeSuffixNR Int
i (Two Node a
a Node a
b)
| Int
i forall a. Ord a => a -> a -> Bool
< Int
sb = Node a
b forall a b. a -> b -> StrictPair a b
:*: forall a. FingerTree a
EmptyT
| Bool
otherwise = Node a
a forall a b. a -> b -> StrictPair a b
:*: forall a. a -> FingerTree a
Single Node a
b
where
sb :: Int
sb = forall a. Sized a => a -> Int
size Node a
b
takeSuffixNR Int
i (Three Node a
a Node a
b Node a
c)
| Int
i forall a. Ord a => a -> a -> Bool
< Int
sc = Node a
c forall a b. a -> b -> StrictPair a b
:*: forall a. FingerTree a
EmptyT
| Int
i forall a. Ord a => a -> a -> Bool
< Int
sbc = Node a
b forall a b. a -> b -> StrictPair a b
:*: forall a. a -> FingerTree a
Single Node a
c
| Bool
otherwise = Node a
a forall a b. a -> b -> StrictPair a b
:*: forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
sbc (forall a. a -> Digit a
One Node a
b) forall a. FingerTree a
EmptyT (forall a. a -> Digit a
One Node a
c)
where
sc :: Int
sc = forall a. Sized a => a -> Int
size Node a
c
sbc :: Int
sbc = Int
sc forall a. Num a => a -> a -> a
+ forall a. Sized a => a -> Int
size Node a
b
takeSuffixNR Int
i (Four Node a
a Node a
b Node a
c Node a
d)
| Int
i forall a. Ord a => a -> a -> Bool
< Int
sd = Node a
d forall a b. a -> b -> StrictPair a b
:*: forall a. FingerTree a
EmptyT
| Int
i forall a. Ord a => a -> a -> Bool
< Int
scd = Node a
c forall a b. a -> b -> StrictPair a b
:*: forall a. a -> FingerTree a
Single Node a
d
| Int
i forall a. Ord a => a -> a -> Bool
< Int
sbcd = Node a
b forall a b. a -> b -> StrictPair a b
:*: forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
scd (forall a. a -> Digit a
One Node a
c) forall a. FingerTree a
EmptyT (forall a. a -> Digit a
One Node a
d)
| Bool
otherwise = Node a
a forall a b. a -> b -> StrictPair a b
:*: forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
sbcd (forall a. a -> a -> Digit a
Two Node a
b Node a
c) forall a. FingerTree a
EmptyT (forall a. a -> Digit a
One Node a
d)
where
sd :: Int
sd = forall a. Sized a => a -> Int
size Node a
d
scd :: Int
scd = Int
sd forall a. Num a => a -> a -> a
+ forall a. Sized a => a -> Int
size Node a
c
sbcd :: Int
sbcd = Int
scd forall a. Num a => a -> a -> a
+ 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 :: forall a.
Int
-> Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> FingerTree (Elem a)
takePrefixER !Int
_i !Int
s (One Elem a
_) FingerTree (Node (Elem a))
m Digit (Elem a)
sf = forall a. Int -> FingerTree (Node a) -> Digit a -> FingerTree a
pullL (Int
s forall a. Num a => a -> a -> a
- Int
1) FingerTree (Node (Elem a))
m Digit (Elem a)
sf
takePrefixER Int
i Int
s (Two Elem a
_ Elem a
b) FingerTree (Node (Elem a))
m Digit (Elem a)
sf
| Int
i forall a. Ord a => a -> a -> Bool
< Int
1 = forall a. Int -> FingerTree (Node a) -> Digit a -> FingerTree a
pullL (Int
s forall a. Num a => a -> a -> a
- Int
2) FingerTree (Node (Elem a))
m Digit (Elem a)
sf
| Bool
otherwise = forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s forall a. Num a => a -> a -> a
- Int
1) (forall a. a -> Digit a
One Elem a
b) FingerTree (Node (Elem a))
m Digit (Elem a)
sf
takePrefixER Int
i Int
s (Three Elem a
_ Elem a
b Elem a
c) FingerTree (Node (Elem a))
m Digit (Elem a)
sf
| Int
i forall a. Ord a => a -> a -> Bool
< Int
1 = forall a. Int -> FingerTree (Node a) -> Digit a -> FingerTree a
pullL (Int
s forall a. Num a => a -> a -> a
- Int
3) FingerTree (Node (Elem a))
m Digit (Elem a)
sf
| Int
i forall a. Ord a => a -> a -> Bool
< Int
2 = forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s forall a. Num a => a -> a -> a
- Int
2) (forall a. a -> Digit a
One Elem a
c) FingerTree (Node (Elem a))
m Digit (Elem a)
sf
| Bool
otherwise = forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s forall a. Num a => a -> a -> a
- Int
1) (forall a. a -> a -> Digit a
Two Elem a
b Elem a
c) FingerTree (Node (Elem a))
m Digit (Elem a)
sf
takePrefixER Int
i Int
s (Four Elem a
_ Elem a
b Elem a
c Elem a
d) FingerTree (Node (Elem a))
m Digit (Elem a)
sf
| Int
i forall a. Ord a => a -> a -> Bool
< Int
1 = forall a. Int -> FingerTree (Node a) -> Digit a -> FingerTree a
pullL (Int
s forall a. Num a => a -> a -> a
- Int
4) FingerTree (Node (Elem a))
m Digit (Elem a)
sf
| Int
i forall a. Ord a => a -> a -> Bool
< Int
2 = forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s forall a. Num a => a -> a -> a
- Int
3) (forall a. a -> Digit a
One Elem a
d) FingerTree (Node (Elem a))
m Digit (Elem a)
sf
| Int
i forall a. Ord a => a -> a -> Bool
< Int
3 = forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s forall a. Num a => a -> a -> a
- Int
2) (forall a. a -> a -> Digit a
Two Elem a
c Elem a
d) FingerTree (Node (Elem a))
m Digit (Elem a)
sf
| Bool
otherwise = forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s forall a. Num a => a -> a -> a
- Int
1) (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 :: forall a.
Int
-> Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> StrictPair (Node a) (FingerTree (Node a))
takePrefixNR !Int
_i !Int
s (One Node a
a) FingerTree (Node (Node a))
m Digit (Node a)
sf = Node a
a forall a b. a -> b -> StrictPair a b
:*: forall a. Int -> FingerTree (Node a) -> Digit a -> FingerTree a
pullL (Int
s forall a. Num a => a -> a -> a
- forall a. Sized a => a -> Int
size Node a
a) FingerTree (Node (Node a))
m Digit (Node a)
sf
takePrefixNR Int
i Int
s (Two Node a
a Node a
b) FingerTree (Node (Node a))
m Digit (Node a)
sf
| Int
i forall a. Ord a => a -> a -> Bool
< Int
sb = Node a
b forall a b. a -> b -> StrictPair a b
:*: forall a. Int -> FingerTree (Node a) -> Digit a -> FingerTree a
pullL (Int
s forall a. Num a => a -> a -> a
- Int
sb forall a. Num a => a -> a -> a
- forall a. Sized a => a -> Int
size Node a
a) FingerTree (Node (Node a))
m Digit (Node a)
sf
| Bool
otherwise = Node a
a forall a b. a -> b -> StrictPair a b
:*: forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s forall a. Num a => a -> a -> a
- forall a. Sized a => a -> Int
size Node a
a) (forall a. a -> Digit a
One Node a
b) FingerTree (Node (Node a))
m Digit (Node a)
sf
where
sb :: Int
sb = forall a. Sized a => a -> Int
size Node a
b
takePrefixNR Int
i Int
s (Three Node a
a Node a
b Node a
c) FingerTree (Node (Node a))
m Digit (Node a)
sf
| Int
i forall a. Ord a => a -> a -> Bool
< Int
sc = Node a
c forall a b. a -> b -> StrictPair a b
:*: forall a. Int -> FingerTree (Node a) -> Digit a -> FingerTree a
pullL (Int
s forall a. Num a => a -> a -> a
- Int
sbc forall a. Num a => a -> a -> a
- forall a. Sized a => a -> Int
size Node a
a) FingerTree (Node (Node a))
m Digit (Node a)
sf
| Int
i forall a. Ord a => a -> a -> Bool
< Int
sbc = Node a
b forall a b. a -> b -> StrictPair a b
:*: forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s forall a. Num a => a -> a -> a
- forall a. Sized a => a -> Int
size Node a
b forall a. Num a => a -> a -> a
- forall a. Sized a => a -> Int
size Node a
a) (forall a. a -> Digit a
One Node a
c) FingerTree (Node (Node a))
m Digit (Node a)
sf
| Bool
otherwise = Node a
a forall a b. a -> b -> StrictPair a b
:*: forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s forall a. Num a => a -> a -> a
- forall a. Sized a => a -> Int
size Node a
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 = forall a. Sized a => a -> Int
size Node a
c
sbc :: Int
sbc = Int
sc forall a. Num a => a -> a -> a
+ forall a. Sized a => a -> Int
size Node a
b
takePrefixNR Int
i Int
s (Four Node a
a Node a
b Node a
c Node a
d) FingerTree (Node (Node a))
m Digit (Node a)
sf
| Int
i forall a. Ord a => a -> a -> Bool
< Int
sd = Node a
d forall a b. a -> b -> StrictPair a b
:*: forall a. Int -> FingerTree (Node a) -> Digit a -> FingerTree a
pullL (Int
s forall a. Num a => a -> a -> a
- Int
sd forall a. Num a => a -> a -> a
- Int
sabc) FingerTree (Node (Node a))
m Digit (Node a)
sf
| Int
i forall a. Ord a => a -> a -> Bool
< Int
scd = Node a
c forall a b. a -> b -> StrictPair a b
:*: forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s forall a. Num a => a -> a -> a
- Int
sabc) (forall a. a -> Digit a
One Node a
d) FingerTree (Node (Node a))
m Digit (Node a)
sf
| Int
i forall a. Ord a => a -> a -> Bool
< Int
sbcd = Node a
b forall a b. a -> b -> StrictPair a b
:*: forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s forall a. Num a => a -> a -> a
- Int
sab) (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 forall a b. a -> b -> StrictPair a b
:*: forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s forall a. Num a => a -> a -> a
- Int
sa) (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 = forall a. Sized a => a -> Int
size Node a
a
sab :: Int
sab = Int
sa forall a. Num a => a -> a -> a
+ forall a. Sized a => a -> Int
size Node a
b
sabc :: Int
sabc = Int
sab forall a. Num a => a -> a -> a
+ forall a. Sized a => a -> Int
size Node a
c
sd :: Int
sd = forall a. Sized a => a -> Int
size Node a
d
scd :: Int
scd = forall a. Sized a => a -> Int
size Node a
c forall a. Num a => a -> a -> a
+ Int
sd
sbcd :: Int
sbcd = forall a. Sized a => a -> Int
size Node a
b forall a. Num a => a -> a -> a
+ Int
scd
splitAt :: Int -> Seq a -> (Seq a, Seq a)
splitAt :: forall a. Int -> Seq a -> (Seq a, Seq a)
splitAt Int
i xs :: Seq a
xs@(Seq FingerTree (Elem a)
t)
| forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i forall a. Num a => a -> a -> a
- Word
1 forall a. Ord a => a -> a -> Bool
< (forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Seq a -> Int
length Seq a
xs) forall a. Num a => a -> a -> a
- Word
1 :: Word) =
case forall a.
Int
-> FingerTree (Elem a)
-> StrictPair (FingerTree (Elem a)) (FingerTree (Elem a))
splitTreeE Int
i FingerTree (Elem a)
t of
FingerTree (Elem a)
l :*: FingerTree (Elem a)
r -> (forall a. FingerTree (Elem a) -> Seq a
Seq FingerTree (Elem a)
l, forall a. FingerTree (Elem a) -> Seq a
Seq FingerTree (Elem a)
r)
| Int
i forall a. Ord a => a -> a -> Bool
<= Int
0 = (forall a. Seq a
empty, Seq a
xs)
| Bool
otherwise = (Seq a
xs, forall a. Seq a
empty)
uncheckedSplitAt :: Int -> Seq a -> (Seq a, Seq a)
uncheckedSplitAt :: forall a. Int -> Seq a -> (Seq a, Seq a)
uncheckedSplitAt Int
i (Seq FingerTree (Elem a)
xs) = case forall a.
Int
-> FingerTree (Elem a)
-> StrictPair (FingerTree (Elem a)) (FingerTree (Elem a))
splitTreeE Int
i FingerTree (Elem a)
xs of
FingerTree (Elem a)
l :*: FingerTree (Elem a)
r -> (forall a. FingerTree (Elem a) -> Seq a
Seq FingerTree (Elem a)
l, 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 :: forall a.
Int
-> FingerTree (Elem a)
-> StrictPair (FingerTree (Elem a)) (FingerTree (Elem a))
splitTreeE !Int
_i FingerTree (Elem a)
EmptyT = forall a. FingerTree a
EmptyT forall a b. a -> b -> StrictPair a b
:*: forall a. FingerTree a
EmptyT
splitTreeE Int
i t :: FingerTree (Elem a)
t@(Single Elem a
_)
| Int
i forall a. Ord a => a -> a -> Bool
<= Int
0 = forall a. FingerTree a
EmptyT forall a b. a -> b -> StrictPair a b
:*: FingerTree (Elem a)
t
| Bool
otherwise = FingerTree (Elem a)
t forall a b. a -> b -> StrictPair a b
:*: forall a. FingerTree a
EmptyT
splitTreeE Int
i (Deep Int
s Digit (Elem a)
pr FingerTree (Node (Elem a))
m Digit (Elem a)
sf)
| Int
i forall a. Ord a => a -> a -> Bool
< Int
spr = 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 forall a. Ord a => a -> a -> Bool
< Int
spm = case forall a. Int -> FingerTree (Node a) -> Split a
splitTreeN Int
im FingerTree (Node (Elem a))
m of
Split FingerTree (Node (Elem a))
ml Node (Elem a)
xs FingerTree (Node (Elem a))
mr -> 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 forall a. Num a => a -> a -> a
- 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 = forall a.
Int
-> Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> StrictPair (FingerTree (Elem a)) (FingerTree (Elem a))
splitSuffixE (Int
i 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 = forall a. Sized a => a -> Int
size Digit (Elem a)
pr
spm :: Int
spm = Int
spr forall a. Num a => a -> a -> a
+ forall a. Sized a => a -> Int
size FingerTree (Node (Elem a))
m
im :: Int
im = Int
i forall a. Num a => a -> a -> a
- Int
spr
splitTreeN :: Int -> FingerTree (Node a) -> Split a
splitTreeN :: forall a. Int -> FingerTree (Node a) -> Split a
splitTreeN !Int
_i FingerTree (Node a)
EmptyT = forall a. HasCallStack => [Char] -> a
error [Char]
"splitTreeN of empty tree"
splitTreeN Int
_i (Single Node a
x) = forall a.
FingerTree (Node a) -> Node a -> FingerTree (Node a) -> Split a
Split forall a. FingerTree a
EmptyT Node a
x forall a. FingerTree a
EmptyT
splitTreeN Int
i (Deep Int
s Digit (Node a)
pr FingerTree (Node (Node a))
m Digit (Node a)
sf)
| Int
i forall a. Ord a => a -> a -> Bool
< Int
spr = 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 forall a. Ord a => a -> a -> Bool
< Int
spm = case forall a. Int -> FingerTree (Node a) -> Split a
splitTreeN Int
im FingerTree (Node (Node a))
m of
Split FingerTree (Node (Node a))
ml Node (Node a)
xs FingerTree (Node (Node a))
mr -> 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 forall a. Num a => a -> a -> a
- 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 = forall a.
Int
-> Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> Split a
splitSuffixN (Int
i 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 = forall a. Sized a => a -> Int
size Digit (Node a)
pr
spm :: Int
spm = Int
spr forall a. Num a => a -> a -> a
+ forall a. Sized a => a -> Int
size FingerTree (Node (Node a))
m
im :: Int
im = Int
i 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 :: 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
i Int
s Int
spr Digit (Node a)
pr FingerTree (Node (Node a))
ml (Node2 Int
_ Node a
a Node a
b) FingerTree (Node (Node a))
mr Digit (Node a)
sf
| Int
i forall a. Ord a => a -> a -> Bool
< Int
sa = forall a.
FingerTree (Node a) -> Node a -> FingerTree (Node a) -> Split a
Split (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 (forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s forall a. Num a => a -> a -> a
- Int
sprmla) (forall a. a -> Digit a
One Node a
b) FingerTree (Node (Node a))
mr Digit (Node a)
sf)
| Bool
otherwise = forall a.
FingerTree (Node a) -> Node a -> FingerTree (Node a) -> Split a
Split (forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
sprmla Digit (Node a)
pr FingerTree (Node (Node a))
ml (forall a. a -> Digit a
One Node a
a)) Node a
b (forall a. Int -> FingerTree (Node a) -> Digit a -> FingerTree a
pullL (Int
s forall a. Num a => a -> a -> a
- Int
sprmla forall a. Num a => a -> a -> a
- forall a. Sized a => a -> Int
size Node a
b) FingerTree (Node (Node a))
mr Digit (Node a)
sf)
where
sa :: Int
sa = forall a. Sized a => a -> Int
size Node a
a
sprml :: Int
sprml = Int
spr forall a. Num a => a -> a -> a
+ forall a. Sized a => a -> Int
size FingerTree (Node (Node a))
ml
sprmla :: Int
sprmla = Int
sa forall a. Num a => a -> a -> a
+ Int
sprml
splitMiddleN Int
i Int
s Int
spr Digit (Node a)
pr FingerTree (Node (Node a))
ml (Node3 Int
_ Node a
a Node a
b Node a
c) FingerTree (Node (Node a))
mr Digit (Node a)
sf
| Int
i forall a. Ord a => a -> a -> Bool
< Int
sa = forall a.
FingerTree (Node a) -> Node a -> FingerTree (Node a) -> Split a
Split (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 (forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s forall a. Num a => a -> a -> a
- Int
sprmla) (forall a. a -> a -> Digit a
Two Node a
b Node a
c) FingerTree (Node (Node a))
mr Digit (Node a)
sf)
| Int
i forall a. Ord a => a -> a -> Bool
< Int
sab = forall a.
FingerTree (Node a) -> Node a -> FingerTree (Node a) -> Split a
Split (forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
sprmla Digit (Node a)
pr FingerTree (Node (Node a))
ml (forall a. a -> Digit a
One Node a
a)) Node a
b (forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s forall a. Num a => a -> a -> a
- Int
sprmlab) (forall a. a -> Digit a
One Node a
c) FingerTree (Node (Node a))
mr Digit (Node a)
sf)
| Bool
otherwise = forall a.
FingerTree (Node a) -> Node a -> FingerTree (Node a) -> Split a
Split (forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
sprmlab Digit (Node a)
pr FingerTree (Node (Node a))
ml (forall a. a -> a -> Digit a
Two Node a
a Node a
b)) Node a
c (forall a. Int -> FingerTree (Node a) -> Digit a -> FingerTree a
pullL (Int
s forall a. Num a => a -> a -> a
- Int
sprmlab forall a. Num a => a -> a -> a
- forall a. Sized a => a -> Int
size Node a
c) FingerTree (Node (Node a))
mr Digit (Node a)
sf)
where
sa :: Int
sa = forall a. Sized a => a -> Int
size Node a
a
sab :: Int
sab = Int
sa forall a. Num a => a -> a -> a
+ forall a. Sized a => a -> Int
size Node a
b
sprml :: Int
sprml = Int
spr forall a. Num a => a -> a -> a
+ forall a. Sized a => a -> Int
size FingerTree (Node (Node a))
ml
sprmla :: Int
sprmla = Int
sa forall a. Num a => a -> a -> a
+ Int
sprml
sprmlab :: Int
sprmlab = Int
sprmla forall a. Num a => a -> a -> a
+ 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 :: 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
i Int
s Int
spr Digit (Elem a)
pr FingerTree (Node (Elem a))
ml (Node2 Int
_ Elem a
a Elem a
b) FingerTree (Node (Elem a))
mr Digit (Elem a)
sf
| Int
i forall a. Ord a => a -> a -> Bool
< Int
1 = forall a. Int -> Digit a -> FingerTree (Node a) -> FingerTree a
pullR Int
sprml Digit (Elem a)
pr FingerTree (Node (Elem a))
ml forall a b. a -> b -> StrictPair a b
:*: forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s forall a. Num a => a -> a -> a
- Int
sprml) (forall a. a -> a -> Digit a
Two Elem a
a Elem a
b) FingerTree (Node (Elem a))
mr Digit (Elem a)
sf
| Bool
otherwise = forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
sprmla Digit (Elem a)
pr FingerTree (Node (Elem a))
ml (forall a. a -> Digit a
One Elem a
a) forall a b. a -> b -> StrictPair a b
:*: forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s forall a. Num a => a -> a -> a
- Int
sprmla) (forall a. a -> Digit a
One Elem a
b) FingerTree (Node (Elem a))
mr Digit (Elem a)
sf
where
sprml :: Int
sprml = Int
spr forall a. Num a => a -> a -> a
+ forall a. Sized a => a -> Int
size FingerTree (Node (Elem a))
ml
sprmla :: Int
sprmla = Int
1 forall a. Num a => a -> a -> a
+ Int
sprml
splitMiddleE Int
i Int
s Int
spr Digit (Elem a)
pr FingerTree (Node (Elem a))
ml (Node3 Int
_ Elem a
a Elem a
b Elem a
c) FingerTree (Node (Elem a))
mr Digit (Elem a)
sf = case Int
i of
Int
0 -> forall a. Int -> Digit a -> FingerTree (Node a) -> FingerTree a
pullR Int
sprml Digit (Elem a)
pr FingerTree (Node (Elem a))
ml forall a b. a -> b -> StrictPair a b
:*: forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s forall a. Num a => a -> a -> a
- Int
sprml) (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
Int
1 -> forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
sprmla Digit (Elem a)
pr FingerTree (Node (Elem a))
ml (forall a. a -> Digit a
One Elem a
a) forall a b. a -> b -> StrictPair a b
:*: forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s forall a. Num a => a -> a -> a
- Int
sprmla) (forall a. a -> a -> Digit a
Two Elem a
b Elem a
c) FingerTree (Node (Elem a))
mr Digit (Elem a)
sf
Int
_ -> forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
sprmlab Digit (Elem a)
pr FingerTree (Node (Elem a))
ml (forall a. a -> a -> Digit a
Two Elem a
a Elem a
b) forall a b. a -> b -> StrictPair a b
:*: forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s forall a. Num a => a -> a -> a
- Int
sprmlab) (forall a. a -> Digit a
One Elem a
c) FingerTree (Node (Elem a))
mr Digit (Elem a)
sf
where
sprml :: Int
sprml = Int
spr forall a. Num a => a -> a -> a
+ forall a. Sized a => a -> Int
size FingerTree (Node (Elem a))
ml
sprmla :: Int
sprmla = Int
1 forall a. Num a => a -> a -> a
+ Int
sprml
sprmlab :: Int
sprmlab = Int
sprmla forall a. Num a => a -> a -> a
+ Int
1
splitPrefixE :: Int -> Int -> Digit (Elem a) -> FingerTree (Node (Elem a)) -> Digit (Elem a) ->
StrictPair (FingerTree (Elem a)) (FingerTree (Elem a))
splitPrefixE :: 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 (One Elem a
a) FingerTree (Node (Elem a))
m Digit (Elem a)
sf = forall a. FingerTree a
EmptyT forall a b. a -> b -> StrictPair a b
:*: forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
s (forall a. a -> Digit a
One Elem a
a) FingerTree (Node (Elem a))
m Digit (Elem a)
sf
splitPrefixE Int
i Int
s (Two Elem a
a Elem a
b) FingerTree (Node (Elem a))
m Digit (Elem a)
sf = case Int
i of
Int
0 -> forall a. FingerTree a
EmptyT forall a b. a -> b -> StrictPair a b
:*: forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
s (forall a. a -> a -> Digit a
Two Elem a
a Elem a
b) FingerTree (Node (Elem a))
m Digit (Elem a)
sf
Int
_ -> forall a. a -> FingerTree a
Single Elem a
a forall a b. a -> b -> StrictPair a b
:*: forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s forall a. Num a => a -> a -> a
- Int
1) (forall a. a -> Digit a
One Elem a
b) FingerTree (Node (Elem a))
m Digit (Elem a)
sf
splitPrefixE Int
i Int
s (Three Elem a
a Elem a
b Elem a
c) FingerTree (Node (Elem a))
m Digit (Elem a)
sf = case Int
i of
Int
0 -> forall a. FingerTree a
EmptyT forall a b. a -> b -> StrictPair a b
:*: forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
s (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
Int
1 -> forall a. a -> FingerTree a
Single Elem a
a forall a b. a -> b -> StrictPair a b
:*: forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s forall a. Num a => a -> a -> a
- Int
1) (forall a. a -> a -> Digit a
Two Elem a
b Elem a
c) FingerTree (Node (Elem a))
m Digit (Elem a)
sf
Int
_ -> forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
2 (forall a. a -> Digit a
One Elem a
a) forall a. FingerTree a
EmptyT (forall a. a -> Digit a
One Elem a
b) forall a b. a -> b -> StrictPair a b
:*: forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s forall a. Num a => a -> a -> a
- Int
2) (forall a. a -> Digit a
One Elem a
c) FingerTree (Node (Elem a))
m Digit (Elem a)
sf
splitPrefixE Int
i Int
s (Four Elem a
a Elem a
b Elem a
c Elem a
d) FingerTree (Node (Elem a))
m Digit (Elem a)
sf = case Int
i of
Int
0 -> forall a. FingerTree a
EmptyT forall a b. a -> b -> StrictPair a b
:*: forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
s (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
Int
1 -> forall a. a -> FingerTree a
Single Elem a
a forall a b. a -> b -> StrictPair a b
:*: forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s forall a. Num a => a -> a -> a
- Int
1) (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
2 -> forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
2 (forall a. a -> Digit a
One Elem a
a) forall a. FingerTree a
EmptyT (forall a. a -> Digit a
One Elem a
b) forall a b. a -> b -> StrictPair a b
:*: forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s forall a. Num a => a -> a -> a
- Int
2) (forall a. a -> a -> Digit a
Two Elem a
c Elem a
d) FingerTree (Node (Elem a))
m Digit (Elem a)
sf
Int
_ -> forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
3 (forall a. a -> a -> Digit a
Two Elem a
a Elem a
b) forall a. FingerTree a
EmptyT (forall a. a -> Digit a
One Elem a
c) forall a b. a -> b -> StrictPair a b
:*: forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s forall a. Num a => a -> a -> a
- Int
3) (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 :: forall a.
Int
-> Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> Split a
splitPrefixN !Int
_i !Int
s (One Node a
a) FingerTree (Node (Node a))
m Digit (Node a)
sf = forall a.
FingerTree (Node a) -> Node a -> FingerTree (Node a) -> Split a
Split forall a. FingerTree a
EmptyT Node a
a (forall a. Int -> FingerTree (Node a) -> Digit a -> FingerTree a
pullL (Int
s forall a. Num a => a -> a -> a
- forall a. Sized a => a -> Int
size Node a
a) FingerTree (Node (Node a))
m Digit (Node a)
sf)
splitPrefixN Int
i Int
s (Two Node a
a Node a
b) FingerTree (Node (Node a))
m Digit (Node a)
sf
| Int
i forall a. Ord a => a -> a -> Bool
< Int
sa = forall a.
FingerTree (Node a) -> Node a -> FingerTree (Node a) -> Split a
Split forall a. FingerTree a
EmptyT Node a
a (forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s forall a. Num a => a -> a -> a
- Int
sa) (forall a. a -> Digit a
One Node a
b) FingerTree (Node (Node a))
m Digit (Node a)
sf)
| Bool
otherwise = forall a.
FingerTree (Node a) -> Node a -> FingerTree (Node a) -> Split a
Split (forall a. a -> FingerTree a
Single Node a
a) Node a
b (forall a. Int -> FingerTree (Node a) -> Digit a -> FingerTree a
pullL (Int
s forall a. Num a => a -> a -> a
- Int
sa forall a. Num a => a -> a -> a
- forall a. Sized a => a -> Int
size Node a
b) FingerTree (Node (Node a))
m Digit (Node a)
sf)
where
sa :: Int
sa = forall a. Sized a => a -> Int
size Node a
a
splitPrefixN Int
i Int
s (Three Node a
a Node a
b Node a
c) FingerTree (Node (Node a))
m Digit (Node a)
sf
| Int
i forall a. Ord a => a -> a -> Bool
< Int
sa = forall a.
FingerTree (Node a) -> Node a -> FingerTree (Node a) -> Split a
Split forall a. FingerTree a
EmptyT Node a
a (forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s forall a. Num a => a -> a -> a
- Int
sa) (forall a. a -> a -> Digit a
Two Node a
b Node a
c) FingerTree (Node (Node a))
m Digit (Node a)
sf)
| Int
i forall a. Ord a => a -> a -> Bool
< Int
sab = forall a.
FingerTree (Node a) -> Node a -> FingerTree (Node a) -> Split a
Split (forall a. a -> FingerTree a
Single Node a
a) Node a
b (forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s forall a. Num a => a -> a -> a
- Int
sab) (forall a. a -> Digit a
One Node a
c) FingerTree (Node (Node a))
m Digit (Node a)
sf)
| Bool
otherwise = forall a.
FingerTree (Node a) -> Node a -> FingerTree (Node a) -> Split a
Split (forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
sab (forall a. a -> Digit a
One Node a
a) forall a. FingerTree a
EmptyT (forall a. a -> Digit a
One Node a
b)) Node a
c (forall a. Int -> FingerTree (Node a) -> Digit a -> FingerTree a
pullL (Int
s forall a. Num a => a -> a -> a
- Int
sab forall a. Num a => a -> a -> a
- forall a. Sized a => a -> Int
size Node a
c) FingerTree (Node (Node a))
m Digit (Node a)
sf)
where
sa :: Int
sa = forall a. Sized a => a -> Int
size Node a
a
sab :: Int
sab = Int
sa forall a. Num a => a -> a -> a
+ forall a. Sized a => a -> Int
size Node a
b
splitPrefixN Int
i Int
s (Four Node a
a Node a
b Node a
c Node a
d) FingerTree (Node (Node a))
m Digit (Node a)
sf
| Int
i forall a. Ord a => a -> a -> Bool
< Int
sa = forall a.
FingerTree (Node a) -> Node a -> FingerTree (Node a) -> Split a
Split forall a. FingerTree a
EmptyT Node a
a forall a b. (a -> b) -> a -> b
$ forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s forall a. Num a => a -> a -> a
- Int
sa) (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 forall a. Ord a => a -> a -> Bool
< Int
sab = forall a.
FingerTree (Node a) -> Node a -> FingerTree (Node a) -> Split a
Split (forall a. a -> FingerTree a
Single Node a
a) Node a
b forall a b. (a -> b) -> a -> b
$ forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s forall a. Num a => a -> a -> a
- Int
sab) (forall a. a -> a -> Digit a
Two Node a
c Node a
d) FingerTree (Node (Node a))
m Digit (Node a)
sf
| Int
i forall a. Ord a => a -> a -> Bool
< Int
sabc = forall a.
FingerTree (Node a) -> Node a -> FingerTree (Node a) -> Split a
Split (forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
sab (forall a. a -> Digit a
One Node a
a) forall a. FingerTree a
EmptyT (forall a. a -> Digit a
One Node a
b)) Node a
c forall a b. (a -> b) -> a -> b
$ forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s forall a. Num a => a -> a -> a
- Int
sabc) (forall a. a -> Digit a
One Node a
d) FingerTree (Node (Node a))
m Digit (Node a)
sf
| Bool
otherwise = forall a.
FingerTree (Node a) -> Node a -> FingerTree (Node a) -> Split a
Split (forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
sabc (forall a. a -> a -> Digit a
Two Node a
a Node a
b) forall a. FingerTree a
EmptyT (forall a. a -> Digit a
One Node a
c)) Node a
d forall a b. (a -> b) -> a -> b
$ forall a. Int -> FingerTree (Node a) -> Digit a -> FingerTree a
pullL (Int
s forall a. Num a => a -> a -> a
- Int
sabc forall a. Num a => a -> a -> a
- forall a. Sized a => a -> Int
size Node a
d) FingerTree (Node (Node a))
m Digit (Node a)
sf
where
sa :: Int
sa = forall a. Sized a => a -> Int
size Node a
a
sab :: Int
sab = Int
sa forall a. Num a => a -> a -> a
+ forall a. Sized a => a -> Int
size Node a
b
sabc :: Int
sabc = Int
sab forall a. Num a => a -> a -> a
+ 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 :: 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
s Digit (Elem a)
pr FingerTree (Node (Elem a))
m (One Elem a
a) = forall a. Int -> Digit a -> FingerTree (Node a) -> FingerTree a
pullR (Int
s forall a. Num a => a -> a -> a
- Int
1) Digit (Elem a)
pr FingerTree (Node (Elem a))
m forall a b. a -> b -> StrictPair a b
:*: forall a. a -> FingerTree a
Single Elem a
a
splitSuffixE Int
i Int
s Digit (Elem a)
pr FingerTree (Node (Elem a))
m (Two Elem a
a Elem a
b) = case Int
i of
Int
0 -> forall a. Int -> Digit a -> FingerTree (Node a) -> FingerTree a
pullR (Int
s forall a. Num a => a -> a -> a
- Int
2) Digit (Elem a)
pr FingerTree (Node (Elem a))
m forall a b. a -> b -> StrictPair a b
:*: forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
2 (forall a. a -> Digit a
One Elem a
a) forall a. FingerTree a
EmptyT (forall a. a -> Digit a
One Elem a
b)
Int
_ -> forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s forall a. Num a => a -> a -> a
- Int
1) Digit (Elem a)
pr FingerTree (Node (Elem a))
m (forall a. a -> Digit a
One Elem a
a) forall a b. a -> b -> StrictPair a b
:*: forall a. a -> FingerTree a
Single Elem a
b
splitSuffixE Int
i Int
s Digit (Elem a)
pr FingerTree (Node (Elem a))
m (Three Elem a
a Elem a
b Elem a
c) = case Int
i of
Int
0 -> forall a. Int -> Digit a -> FingerTree (Node a) -> FingerTree a
pullR (Int
s forall a. Num a => a -> a -> a
- Int
3) Digit (Elem a)
pr FingerTree (Node (Elem a))
m forall a b. a -> b -> StrictPair a b
:*: forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
3 (forall a. a -> a -> Digit a
Two Elem a
a Elem a
b) forall a. FingerTree a
EmptyT (forall a. a -> Digit a
One Elem a
c)
Int
1 -> forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s forall a. Num a => a -> a -> a
- Int
2) Digit (Elem a)
pr FingerTree (Node (Elem a))
m (forall a. a -> Digit a
One Elem a
a) forall a b. a -> b -> StrictPair a b
:*: forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
2 (forall a. a -> Digit a
One Elem a
b) forall a. FingerTree a
EmptyT (forall a. a -> Digit a
One Elem a
c)
Int
_ -> forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s forall a. Num a => a -> a -> a
- Int
1) Digit (Elem a)
pr FingerTree (Node (Elem a))
m (forall a. a -> a -> Digit a
Two Elem a
a Elem a
b) forall a b. a -> b -> StrictPair a b
:*: forall a. a -> FingerTree a
Single Elem a
c
splitSuffixE Int
i Int
s Digit (Elem a)
pr FingerTree (Node (Elem a))
m (Four Elem a
a Elem a
b Elem a
c Elem a
d) = case Int
i of
Int
0 -> forall a. Int -> Digit a -> FingerTree (Node a) -> FingerTree a
pullR (Int
s forall a. Num a => a -> a -> a
- Int
4) Digit (Elem a)
pr FingerTree (Node (Elem a))
m forall a b. a -> b -> StrictPair a b
:*: forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
4 (forall a. a -> a -> Digit a
Two Elem a
a Elem a
b) forall a. FingerTree a
EmptyT (forall a. a -> a -> Digit a
Two Elem a
c Elem a
d)
Int
1 -> forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s forall a. Num a => a -> a -> a
- Int
3) Digit (Elem a)
pr FingerTree (Node (Elem a))
m (forall a. a -> Digit a
One Elem a
a) forall a b. a -> b -> StrictPair a b
:*: forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
3 (forall a. a -> a -> Digit a
Two Elem a
b Elem a
c) forall a. FingerTree a
EmptyT (forall a. a -> Digit a
One Elem a
d)
Int
2 -> forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s forall a. Num a => a -> a -> a
- Int
2) Digit (Elem a)
pr FingerTree (Node (Elem a))
m (forall a. a -> a -> Digit a
Two Elem a
a Elem a
b) forall a b. a -> b -> StrictPair a b
:*: forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
2 (forall a. a -> Digit a
One Elem a
c) forall a. FingerTree a
EmptyT (forall a. a -> Digit a
One Elem a
d)
Int
_ -> forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s forall a. Num a => a -> a -> a
- Int
1) Digit (Elem a)
pr FingerTree (Node (Elem a))
m (forall a. a -> a -> a -> Digit a
Three Elem a
a Elem a
b Elem a
c) forall a b. a -> b -> StrictPair a b
:*: 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 :: forall a.
Int
-> Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> Split a
splitSuffixN !Int
_i !Int
s Digit (Node a)
pr FingerTree (Node (Node a))
m (One Node a
a) = forall a.
FingerTree (Node a) -> Node a -> FingerTree (Node a) -> Split a
Split (forall a. Int -> Digit a -> FingerTree (Node a) -> FingerTree a
pullR (Int
s forall a. Num a => a -> a -> a
- forall a. Sized a => a -> Int
size Node a
a) Digit (Node a)
pr FingerTree (Node (Node a))
m) Node a
a forall a. FingerTree a
EmptyT
splitSuffixN Int
i Int
s Digit (Node a)
pr FingerTree (Node (Node a))
m (Two Node a
a Node a
b)
| Int
i forall a. Ord a => a -> a -> Bool
< Int
sa = forall a.
FingerTree (Node a) -> Node a -> FingerTree (Node a) -> Split a
Split (forall a. Int -> Digit a -> FingerTree (Node a) -> FingerTree a
pullR (Int
s forall a. Num a => a -> a -> a
- Int
sa forall a. Num a => a -> a -> a
- forall a. Sized a => a -> Int
size Node a
b) Digit (Node a)
pr FingerTree (Node (Node a))
m) Node a
a (forall a. a -> FingerTree a
Single Node a
b)
| Bool
otherwise = forall a.
FingerTree (Node a) -> Node a -> FingerTree (Node a) -> Split a
Split (forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s forall a. Num a => a -> a -> a
- forall a. Sized a => a -> Int
size Node a
b) Digit (Node a)
pr FingerTree (Node (Node a))
m (forall a. a -> Digit a
One Node a
a)) Node a
b forall a. FingerTree a
EmptyT
where
sa :: Int
sa = forall a. Sized a => a -> Int
size Node a
a
splitSuffixN Int
i Int
s Digit (Node a)
pr FingerTree (Node (Node a))
m (Three Node a
a Node a
b Node a
c)
| Int
i forall a. Ord a => a -> a -> Bool
< Int
sa = forall a.
FingerTree (Node a) -> Node a -> FingerTree (Node a) -> Split a
Split (forall a. Int -> Digit a -> FingerTree (Node a) -> FingerTree a
pullR (Int
s forall a. Num a => a -> a -> a
- Int
sab forall a. Num a => a -> a -> a
- forall a. Sized a => a -> Int
size Node a
c) Digit (Node a)
pr FingerTree (Node (Node a))
m) Node a
a (forall a.
Sized a =>
Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
deep (forall a. a -> Digit a
One Node a
b) forall a. FingerTree a
EmptyT (forall a. a -> Digit a
One Node a
c))
| Int
i forall a. Ord a => a -> a -> Bool
< Int
sab = forall a.
FingerTree (Node a) -> Node a -> FingerTree (Node a) -> Split a
Split (forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s forall a. Num a => a -> a -> a
- forall a. Sized a => a -> Int
size Node a
b forall a. Num a => a -> a -> a
- forall a. Sized a => a -> Int
size Node a
c) Digit (Node a)
pr FingerTree (Node (Node a))
m (forall a. a -> Digit a
One Node a
a)) Node a
b (forall a. a -> FingerTree a
Single Node a
c)
| Bool
otherwise = forall a.
FingerTree (Node a) -> Node a -> FingerTree (Node a) -> Split a
Split (forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s forall a. Num a => a -> a -> a
- forall a. Sized a => a -> Int
size Node a
c) Digit (Node a)
pr FingerTree (Node (Node a))
m (forall a. a -> a -> Digit a
Two Node a
a Node a
b)) Node a
c forall a. FingerTree a
EmptyT
where
sa :: Int
sa = forall a. Sized a => a -> Int
size Node a
a
sab :: Int
sab = Int
sa forall a. Num a => a -> a -> a
+ forall a. Sized a => a -> Int
size Node a
b
splitSuffixN Int
i Int
s Digit (Node a)
pr FingerTree (Node (Node a))
m (Four Node a
a Node a
b Node a
c Node a
d)
| Int
i forall a. Ord a => a -> a -> Bool
< Int
sa = forall a.
FingerTree (Node a) -> Node a -> FingerTree (Node a) -> Split a
Split (forall a. Int -> Digit a -> FingerTree (Node a) -> FingerTree a
pullR (Int
s forall a. Num a => a -> a -> a
- Int
sa forall a. Num a => a -> a -> a
- Int
sbcd) Digit (Node a)
pr FingerTree (Node (Node a))
m) Node a
a (forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
sbcd (forall a. a -> a -> Digit a
Two Node a
b Node a
c) forall a. FingerTree a
EmptyT (forall a. a -> Digit a
One Node a
d))
| Int
i forall a. Ord a => a -> a -> Bool
< Int
sab = forall a.
FingerTree (Node a) -> Node a -> FingerTree (Node a) -> Split a
Split (forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s forall a. Num a => a -> a -> a
- Int
sbcd) Digit (Node a)
pr FingerTree (Node (Node a))
m (forall a. a -> Digit a
One Node a
a)) Node a
b (forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
scd (forall a. a -> Digit a
One Node a
c) forall a. FingerTree a
EmptyT (forall a. a -> Digit a
One Node a
d))
| Int
i forall a. Ord a => a -> a -> Bool
< Int
sabc = forall a.
FingerTree (Node a) -> Node a -> FingerTree (Node a) -> Split a
Split (forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s forall a. Num a => a -> a -> a
- Int
scd) Digit (Node a)
pr FingerTree (Node (Node a))
m (forall a. a -> a -> Digit a
Two Node a
a Node a
b)) Node a
c (forall a. a -> FingerTree a
Single Node a
d)
| Bool
otherwise = forall a.
FingerTree (Node a) -> Node a -> FingerTree (Node a) -> Split a
Split (forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s forall a. Num a => a -> a -> a
- Int
sd) Digit (Node a)
pr FingerTree (Node (Node a))
m (forall a. a -> a -> a -> Digit a
Three Node a
a Node a
b Node a
c)) Node a
d forall a. FingerTree a
EmptyT
where
sa :: Int
sa = forall a. Sized a => a -> Int
size Node a
a
sab :: Int
sab = Int
sa forall a. Num a => a -> a -> a
+ forall a. Sized a => a -> Int
size Node a
b
sabc :: Int
sabc = Int
sab forall a. Num a => a -> a -> a
+ forall a. Sized a => a -> Int
size Node a
c
sd :: Int
sd = forall a. Sized a => a -> Int
size Node a
d
scd :: Int
scd = forall a. Sized a => a -> Int
size Node a
c forall a. Num a => a -> a -> a
+ Int
sd
sbcd :: Int
sbcd = forall a. Sized a => a -> Int
size Node a
b forall a. Num a => a -> a -> a
+ Int
scd
chunksOf :: Int -> Seq a -> Seq (Seq a)
chunksOf :: forall a. Int -> Seq a -> Seq (Seq a)
chunksOf Int
n Seq a
xs | Int
n forall a. Ord a => a -> a -> Bool
<= Int
0 =
if forall a. Seq a -> Bool
null Seq a
xs
then forall a. Seq a
empty
else forall a. HasCallStack => [Char] -> a
error [Char]
"chunksOf: A non-empty sequence can only be broken up into positively-sized chunks."
chunksOf Int
1 Seq a
s = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Seq a
singleton Seq a
s
chunksOf Int
n Seq a
s = forall s a' b'.
(Int -> s -> (s, s)) -> (s -> a' -> b') -> s -> Seq a' -> Seq b'
splitMap (forall a. Int -> Seq a -> (Seq a, Seq a)
uncheckedSplitAt forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Num a => a -> a -> a
*Int
n)) forall a b. a -> b -> a
const Seq a
most (forall a. Int -> a -> Seq a
replicate Int
numReps ())
forall a. Seq a -> Seq a -> Seq a
>< if forall a. Seq a -> Bool
null Seq a
end then forall a. Seq a
empty else forall a. a -> Seq a
singleton Seq a
end
where
(Int
numReps, Int
endLength) = forall a. Seq a -> Int
length Seq a
s forall a. Integral a => a -> a -> (a, a)
`quotRem` Int
n
(Seq a
most, Seq a
end) = forall a. Int -> Seq a -> (Seq a, Seq a)
splitAt (forall a. Seq a -> Int
length Seq a
s forall a. Num a => a -> a -> a
- Int
endLength) Seq a
s
tails :: Seq a -> Seq (Seq a)
tails :: forall a. Seq a -> Seq (Seq a)
tails (Seq FingerTree (Elem a)
xs) = forall a. FingerTree (Elem a) -> Seq a
Seq (forall a b.
Sized a =>
(FingerTree a -> b) -> FingerTree a -> FingerTree b
tailsTree (forall a. a -> Elem a
Elem forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. FingerTree (Elem a) -> Seq a
Seq) FingerTree (Elem a)
xs) forall a. Seq a -> a -> Seq a
|> forall a. Seq a
empty
inits :: Seq a -> Seq (Seq a)
inits :: forall a. Seq a -> Seq (Seq a)
inits (Seq FingerTree (Elem a)
xs) = forall a. Seq a
empty forall a. a -> Seq a -> Seq a
<| forall a. FingerTree (Elem a) -> Seq a
Seq (forall a b.
Sized a =>
(FingerTree a -> b) -> FingerTree a -> FingerTree b
initsTree (forall a. a -> Elem a
Elem forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. FingerTree (Elem a) -> Seq a
Seq) FingerTree (Elem a)
xs)
tailsDigit :: Digit a -> Digit (Digit a)
tailsDigit :: forall a. Digit a -> Digit (Digit a)
tailsDigit (One a
a) = forall a. a -> Digit a
One (forall a. a -> Digit a
One a
a)
tailsDigit (Two a
a a
b) = forall a. a -> a -> Digit a
Two (forall a. a -> a -> Digit a
Two a
a a
b) (forall a. a -> Digit a
One a
b)
tailsDigit (Three a
a a
b a
c) = forall a. a -> a -> a -> Digit a
Three (forall a. a -> a -> a -> Digit a
Three a
a a
b a
c) (forall a. a -> a -> Digit a
Two a
b a
c) (forall a. a -> Digit a
One a
c)
tailsDigit (Four a
a a
b a
c a
d) = forall a. a -> a -> a -> a -> Digit a
Four (forall a. a -> a -> a -> a -> Digit a
Four a
a a
b a
c a
d) (forall a. a -> a -> a -> Digit a
Three a
b a
c a
d) (forall a. a -> a -> Digit a
Two a
c a
d) (forall a. a -> Digit a
One a
d)
initsDigit :: Digit a -> Digit (Digit a)
initsDigit :: forall a. Digit a -> Digit (Digit a)
initsDigit (One a
a) = forall a. a -> Digit a
One (forall a. a -> Digit a
One a
a)
initsDigit (Two a
a a
b) = forall a. a -> a -> Digit a
Two (forall a. a -> Digit a
One a
a) (forall a. a -> a -> Digit a
Two a
a a
b)
initsDigit (Three a
a a
b a
c) = forall a. a -> a -> a -> Digit a
Three (forall a. a -> Digit a
One a
a) (forall a. a -> a -> Digit a
Two a
a a
b) (forall a. a -> a -> a -> Digit a
Three a
a a
b a
c)
initsDigit (Four a
a a
b a
c a
d) = forall a. a -> a -> a -> a -> Digit a
Four (forall a. a -> Digit a
One a
a) (forall a. a -> a -> Digit a
Two a
a a
b) (forall a. a -> a -> a -> Digit a
Three a
a a
b a
c) (forall a. a -> a -> a -> a -> Digit a
Four a
a a
b a
c a
d)
tailsNode :: Node a -> Node (Digit a)
tailsNode :: forall a. Node a -> Node (Digit a)
tailsNode (Node2 Int
s a
a a
b) = forall a. Int -> a -> a -> Node a
Node2 Int
s (forall a. a -> a -> Digit a
Two a
a a
b) (forall a. a -> Digit a
One a
b)
tailsNode (Node3 Int
s a
a a
b a
c) = forall a. Int -> a -> a -> a -> Node a
Node3 Int
s (forall a. a -> a -> a -> Digit a
Three a
a a
b a
c) (forall a. a -> a -> Digit a
Two a
b a
c) (forall a. a -> Digit a
One a
c)
initsNode :: Node a -> Node (Digit a)
initsNode :: forall a. Node a -> Node (Digit a)
initsNode (Node2 Int
s a
a a
b) = forall a. Int -> a -> a -> Node a
Node2 Int
s (forall a. a -> Digit a
One a
a) (forall a. a -> a -> Digit a
Two a
a a
b)
initsNode (Node3 Int
s a
a a
b a
c) = forall a. Int -> a -> a -> a -> Node a
Node3 Int
s (forall a. a -> Digit a
One a
a) (forall a. a -> a -> Digit a
Two a
a a
b) (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 :: forall a b.
Sized a =>
(FingerTree a -> b) -> FingerTree a -> FingerTree b
tailsTree FingerTree a -> b
_ FingerTree a
EmptyT = forall a. FingerTree a
EmptyT
tailsTree FingerTree a -> b
f (Single a
x) = forall a. a -> FingerTree a
Single (FingerTree a -> b
f (forall a. a -> FingerTree a
Single a
x))
tailsTree FingerTree a -> b
f (Deep Int
n Digit a
pr FingerTree (Node a)
m Digit a
sf) =
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
n (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\ Digit a
pr' -> FingerTree a -> b
f (forall a.
Sized a =>
Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
deep Digit a
pr' FingerTree (Node a)
m Digit a
sf)) (forall a. Digit a -> Digit (Digit a)
tailsDigit Digit a
pr))
(forall a b.
Sized a =>
(FingerTree a -> b) -> FingerTree a -> FingerTree b
tailsTree FingerTree (Node a) -> Node b
f' FingerTree (Node a)
m)
(forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FingerTree a -> b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Sized a => Digit a -> FingerTree a
digitToTree) (forall a. Digit a -> Digit (Digit a)
tailsDigit Digit a
sf))
where
f' :: FingerTree (Node a) -> Node b
f' FingerTree (Node a)
ms = let ConsLTree Node a
node FingerTree (Node a)
m' = forall a. Sized a => FingerTree a -> ViewLTree a
viewLTree FingerTree (Node a)
ms in
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\ Digit a
pr' -> FingerTree a -> b
f (forall a.
Sized a =>
Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
deep Digit a
pr' FingerTree (Node a)
m' Digit a
sf)) (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 :: forall a b.
Sized a =>
(FingerTree a -> b) -> FingerTree a -> FingerTree b
initsTree FingerTree a -> b
_ FingerTree a
EmptyT = forall a. FingerTree a
EmptyT
initsTree FingerTree a -> b
f (Single a
x) = forall a. a -> FingerTree a
Single (FingerTree a -> b
f (forall a. a -> FingerTree a
Single a
x))
initsTree FingerTree a -> b
f (Deep Int
n Digit a
pr FingerTree (Node a)
m Digit a
sf) =
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
n (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FingerTree a -> b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Sized a => Digit a -> FingerTree a
digitToTree) (forall a. Digit a -> Digit (Digit a)
initsDigit Digit a
pr))
(forall a b.
Sized a =>
(FingerTree a -> b) -> FingerTree a -> FingerTree b
initsTree FingerTree (Node a) -> Node b
f' FingerTree (Node a)
m)
(forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FingerTree a -> b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
Sized a =>
Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
deep Digit a
pr FingerTree (Node a)
m) (forall a. Digit a -> Digit (Digit a)
initsDigit Digit a
sf))
where
f' :: FingerTree (Node a) -> Node b
f' FingerTree (Node a)
ms = let SnocRTree FingerTree (Node a)
m' Node a
node = forall a. Sized a => FingerTree a -> ViewRTree a
viewRTree FingerTree (Node a)
ms in
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\ Digit a
sf' -> FingerTree a -> b
f (forall a.
Sized a =>
Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
deep Digit a
pr FingerTree (Node a)
m' Digit a
sf')) (forall a. Node a -> Node (Digit a)
initsNode Node a
node)
{-# INLINE foldlWithIndex #-}
foldlWithIndex :: (b -> Int -> a -> b) -> b -> Seq a -> b
foldlWithIndex :: forall b a. (b -> Int -> a -> b) -> b -> Seq a -> b
foldlWithIndex b -> Int -> a -> b
f b
z Seq a
xs = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\ Int -> b
g a
x !Int
i -> b -> Int -> a -> b
f (Int -> b
g (Int
i forall a. Num a => a -> a -> a
- Int
1)) Int
i a
x) (forall a b. a -> b -> a
const b
z) Seq a
xs (forall a. Seq a -> Int
length Seq a
xs forall a. Num a => a -> a -> a
- Int
1)
{-# INLINE foldrWithIndex #-}
foldrWithIndex :: (Int -> a -> b -> b) -> b -> Seq a -> b
foldrWithIndex :: forall a b. (Int -> a -> b -> b) -> b -> Seq a -> b
foldrWithIndex Int -> a -> b -> b
f b
z Seq a
xs = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\ a
x Int -> b
g !Int
i -> Int -> a -> b -> b
f Int
i a
x (Int -> b
g (Int
iforall a. Num a => a -> a -> a
+Int
1))) (forall a b. a -> b -> a
const b
z) Seq a
xs Int
0
{-# INLINE listToMaybe' #-}
listToMaybe' :: [a] -> Maybe a
listToMaybe' :: forall a. [a] -> Maybe a
listToMaybe' = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\ a
x Maybe a
_ -> forall a. a -> Maybe a
Just a
x) forall a. Maybe a
Nothing
takeWhileL :: (a -> Bool) -> Seq a -> Seq a
takeWhileL :: forall a. (a -> Bool) -> Seq a -> Seq a
takeWhileL a -> Bool
p = forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> Seq a -> (Seq a, Seq a)
spanl a -> Bool
p
takeWhileR :: (a -> Bool) -> Seq a -> Seq a
takeWhileR :: forall a. (a -> Bool) -> Seq a -> Seq a
takeWhileR a -> Bool
p = forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> Seq a -> (Seq a, Seq a)
spanr a -> Bool
p
dropWhileL :: (a -> Bool) -> Seq a -> Seq a
dropWhileL :: forall a. (a -> Bool) -> Seq a -> Seq a
dropWhileL a -> Bool
p = forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> Seq a -> (Seq a, Seq a)
spanl a -> Bool
p
dropWhileR :: (a -> Bool) -> Seq a -> Seq a
dropWhileR :: forall a. (a -> Bool) -> Seq a -> Seq a
dropWhileR a -> Bool
p = forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> Seq a -> (Seq a, Seq a)
spanr a -> Bool
p
spanl :: (a -> Bool) -> Seq a -> (Seq a, Seq a)
spanl :: forall a. (a -> Bool) -> Seq a -> (Seq a, Seq a)
spanl a -> Bool
p = forall a. (a -> Bool) -> Seq a -> (Seq a, Seq a)
breakl (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Bool
p)
spanr :: (a -> Bool) -> Seq a -> (Seq a, Seq a)
spanr :: forall a. (a -> Bool) -> Seq a -> (Seq a, Seq a)
spanr a -> Bool
p = forall a. (a -> Bool) -> Seq a -> (Seq a, Seq a)
breakr (Bool -> Bool
not 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 :: forall a. (a -> Bool) -> Seq a -> (Seq a, Seq a)
breakl a -> Bool
p Seq a
xs = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\ Int
i (Seq a, Seq a)
_ -> forall a. Int -> Seq a -> (Seq a, Seq a)
splitAt Int
i Seq a
xs) (Seq a
xs, forall a. Seq a
empty) (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 :: forall a. (a -> Bool) -> Seq a -> (Seq a, Seq a)
breakr a -> Bool
p Seq a
xs = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\ Int
i (Seq a, Seq a)
_ -> forall {b} {a}. (b, a) -> (a, b)
flipPair (forall a. Int -> Seq a -> (Seq a, Seq a)
splitAt (Int
i forall a. Num a => a -> a -> a
+ Int
1) Seq a
xs)) (Seq a
xs, forall a. Seq a
empty) (forall a. (a -> Bool) -> Seq a -> [Int]
findIndicesR a -> Bool
p Seq a
xs)
where flipPair :: (b, a) -> (a, b)
flipPair (b
x, a
y) = (a
y, b
x)
partition :: (a -> Bool) -> Seq a -> (Seq a, Seq a)
partition :: forall a. (a -> Bool) -> Seq a -> (Seq a, Seq a)
partition a -> Bool
p = forall a b. StrictPair a b -> (a, b)
toPair forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 (forall a. Seq a
empty forall a b. a -> b -> StrictPair a b
:*: forall a. Seq a
empty)
where
part :: StrictPair (Seq a) (Seq a) -> a -> StrictPair (Seq a) (Seq a)
part (Seq a
xs :*: Seq a
ys) a
x
| a -> Bool
p a
x = (Seq a
xs forall a. Seq a -> a -> Seq a
`snoc'` a
x) forall a b. a -> b -> StrictPair a b
:*: Seq a
ys
| Bool
otherwise = Seq a
xs forall a b. a -> b -> StrictPair a b
:*: (Seq a
ys forall a. Seq a -> a -> Seq a
`snoc'` a
x)
filter :: (a -> Bool) -> Seq a -> Seq a
filter :: forall a. (a -> Bool) -> Seq a -> Seq a
filter a -> Bool
p = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\ Seq a
xs a
x -> if a -> Bool
p a
x then Seq a
xs forall a. Seq a -> a -> Seq a
`snoc'` a
x else Seq a
xs) forall a. Seq a
empty
elemIndexL :: Eq a => a -> Seq a -> Maybe Int
elemIndexL :: forall a. Eq a => a -> Seq a -> Maybe Int
elemIndexL a
x = forall a. (a -> Bool) -> Seq a -> Maybe Int
findIndexL (a
x forall a. Eq a => a -> a -> Bool
==)
elemIndexR :: Eq a => a -> Seq a -> Maybe Int
elemIndexR :: forall a. Eq a => a -> Seq a -> Maybe Int
elemIndexR a
x = forall a. (a -> Bool) -> Seq a -> Maybe Int
findIndexR (a
x forall a. Eq a => a -> a -> Bool
==)
elemIndicesL :: Eq a => a -> Seq a -> [Int]
elemIndicesL :: forall a. Eq a => a -> Seq a -> [Int]
elemIndicesL a
x = forall a. (a -> Bool) -> Seq a -> [Int]
findIndicesL (a
x forall a. Eq a => a -> a -> Bool
==)
elemIndicesR :: Eq a => a -> Seq a -> [Int]
elemIndicesR :: forall a. Eq a => a -> Seq a -> [Int]
elemIndicesR a
x = forall a. (a -> Bool) -> Seq a -> [Int]
findIndicesR (a
x forall a. Eq a => a -> a -> Bool
==)
findIndexL :: (a -> Bool) -> Seq a -> Maybe Int
findIndexL :: forall a. (a -> Bool) -> Seq a -> Maybe Int
findIndexL a -> Bool
p = forall a. [a] -> Maybe a
listToMaybe' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> Seq a -> [Int]
findIndicesL a -> Bool
p
findIndexR :: (a -> Bool) -> Seq a -> Maybe Int
findIndexR :: forall a. (a -> Bool) -> Seq a -> Maybe Int
findIndexR a -> Bool
p = forall a. [a] -> Maybe a
listToMaybe' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> Seq a -> [Int]
findIndicesR a -> Bool
p
{-# INLINE findIndicesL #-}
findIndicesL :: (a -> Bool) -> Seq a -> [Int]
#if __GLASGOW_HASKELL__
findIndicesL :: forall a. (a -> Bool) -> Seq a -> [Int]
findIndicesL a -> Bool
p Seq a
xs = forall a. (forall b. (a -> b -> b) -> b -> b) -> [a]
build (\ Int -> b -> b
c b
n -> let g :: Int -> a -> b -> b
g Int
i a
x b
z = if a -> Bool
p a
x then Int -> b -> b
c Int
i b
z else b
z in
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 :: forall a. (a -> Bool) -> Seq a -> [Int]
findIndicesR a -> Bool
p Seq a
xs = forall a. (forall b. (a -> b -> b) -> b -> b) -> [a]
build (\ Int -> b -> b
c b
n ->
let g :: b -> Int -> a -> b
g b
z Int
i a
x = if a -> Bool
p a
x then Int -> b -> b
c Int
i b
z else b
z in 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 :: forall a. [a] -> Seq a
fromList = forall a. FingerTree (Elem a) -> Seq a
Seq forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a'. [Elem a'] -> FingerTree (Elem a')
mkTree forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall a'. [Elem a'] -> FingerTree (Elem a')
mkTree [] = forall a. FingerTree a
EmptyT
mkTree [Elem a'
x1] = forall a. a -> FingerTree a
Single Elem a'
x1
mkTree [Elem a'
x1, Elem a'
x2] = forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
2 (forall a. a -> Digit a
One Elem a'
x1) forall a. FingerTree a
EmptyT (forall a. a -> Digit a
One Elem a'
x2)
mkTree [Elem a'
x1, Elem a'
x2, Elem a'
x3] = forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
3 (forall a. a -> a -> Digit a
Two Elem a'
x1 Elem a'
x2) forall a. FingerTree a
EmptyT (forall a. a -> Digit a
One Elem a'
x3)
mkTree [Elem a'
x1, Elem a'
x2, Elem a'
x3, Elem a'
x4] = forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
4 (forall a. a -> a -> Digit a
Two Elem a'
x1 Elem a'
x2) forall a. FingerTree a
EmptyT (forall a. a -> a -> Digit a
Two Elem a'
x3 Elem a'
x4)
mkTree [Elem a'
x1, Elem a'
x2, Elem a'
x3, Elem a'
x4, Elem a'
x5] = forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
5 (forall a. a -> a -> a -> Digit a
Three Elem a'
x1 Elem a'
x2 Elem a'
x3) forall a. FingerTree a
EmptyT (forall a. a -> a -> Digit a
Two Elem a'
x4 Elem a'
x5)
mkTree [Elem a'
x1, Elem a'
x2, Elem a'
x3, Elem a'
x4, Elem a'
x5, Elem a'
x6] =
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
6 (forall a. a -> a -> a -> Digit a
Three Elem a'
x1 Elem a'
x2 Elem a'
x3) forall a. FingerTree a
EmptyT (forall a. a -> a -> a -> Digit a
Three Elem a'
x4 Elem a'
x5 Elem a'
x6)
mkTree [Elem a'
x1, Elem a'
x2, Elem a'
x3, Elem a'
x4, Elem a'
x5, Elem a'
x6, Elem a'
x7] =
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
7 (forall a. a -> a -> Digit a
Two Elem a'
x1 Elem a'
x2) (forall a. a -> FingerTree a
Single (forall a. Int -> a -> a -> a -> Node a
Node3 Int
3 Elem a'
x3 Elem a'
x4 Elem a'
x5)) (forall a. a -> a -> Digit a
Two Elem a'
x6 Elem a'
x7)
mkTree [Elem a'
x1, Elem a'
x2, Elem a'
x3, Elem a'
x4, Elem a'
x5, Elem a'
x6, Elem a'
x7, Elem a'
x8] =
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
8 (forall a. a -> a -> a -> Digit a
Three Elem a'
x1 Elem a'
x2 Elem a'
x3) (forall a. a -> FingerTree a
Single (forall a. Int -> a -> a -> a -> Node a
Node3 Int
3 Elem a'
x4 Elem a'
x5 Elem a'
x6)) (forall a. a -> a -> Digit a
Two Elem a'
x7 Elem a'
x8)
mkTree [Elem a'
x1, Elem a'
x2, Elem a'
x3, Elem a'
x4, Elem a'
x5, Elem a'
x6, Elem a'
x7, Elem a'
x8, Elem a'
x9] =
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
9 (forall a. a -> a -> a -> Digit a
Three Elem a'
x1 Elem a'
x2 Elem a'
x3) (forall a. a -> FingerTree a
Single (forall a. Int -> a -> a -> a -> Node a
Node3 Int
3 Elem a'
x4 Elem a'
x5 Elem a'
x6)) (forall a. a -> a -> a -> Digit a
Three Elem a'
x7 Elem a'
x8 Elem a'
x9)
mkTree [Elem a'
x1, Elem a'
x2, Elem a'
x3, Elem a'
x4, Elem a'
x5, Elem a'
x6, Elem a'
x7, Elem a'
x8, Elem a'
y0, Elem a'
y1] =
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
10 (forall a. a -> a -> Digit a
Two Elem a'
x1 Elem a'
x2)
(forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
6 (forall a. a -> Digit a
One (forall a. Int -> a -> a -> a -> Node a
Node3 Int
3 Elem a'
x3 Elem a'
x4 Elem a'
x5)) forall a. FingerTree a
EmptyT (forall a. a -> Digit a
One (forall a. Int -> a -> a -> a -> Node a
Node3 Int
3 Elem a'
x6 Elem a'
x7 Elem a'
x8)))
(forall a. a -> a -> Digit a
Two Elem a'
y0 Elem a'
y1)
mkTree [Elem a'
x1, Elem a'
x2, Elem a'
x3, Elem a'
x4, Elem a'
x5, Elem a'
x6, Elem a'
x7, Elem a'
x8, Elem a'
x9, Elem a'
y0, Elem a'
y1] =
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
11 (forall a. a -> a -> a -> Digit a
Three Elem a'
x1 Elem a'
x2 Elem a'
x3)
(forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
6 (forall a. a -> Digit a
One (forall a. Int -> a -> a -> a -> Node a
Node3 Int
3 Elem a'
x4 Elem a'
x5 Elem a'
x6)) forall a. FingerTree a
EmptyT (forall a. a -> Digit a
One (forall a. Int -> a -> a -> a -> Node a
Node3 Int
3 Elem a'
x7 Elem a'
x8 Elem a'
x9)))
(forall a. a -> a -> Digit a
Two Elem a'
y0 Elem a'
y1)
mkTree [Elem a'
x1, Elem a'
x2, Elem a'
x3, Elem a'
x4, Elem a'
x5, Elem a'
x6, Elem a'
x7, Elem a'
x8, Elem a'
x9, Elem a'
y0, Elem a'
y1, Elem a'
y2] =
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
12 (forall a. a -> a -> a -> Digit a
Three Elem a'
x1 Elem a'
x2 Elem a'
x3)
(forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
6 (forall a. a -> Digit a
One (forall a. Int -> a -> a -> a -> Node a
Node3 Int
3 Elem a'
x4 Elem a'
x5 Elem a'
x6)) forall a. FingerTree a
EmptyT (forall a. a -> Digit a
One (forall a. Int -> a -> a -> a -> Node a
Node3 Int
3 Elem a'
x7 Elem a'
x8 Elem a'
x9)))
(forall a. a -> a -> a -> Digit a
Three Elem a'
y0 Elem a'
y1 Elem a'
y2)
mkTree [Elem a'
x1, Elem a'
x2, Elem a'
x3, Elem a'
x4, Elem a'
x5, Elem a'
x6, Elem a'
x7, Elem a'
x8, Elem a'
y0, Elem a'
y1, Elem a'
y2, Elem a'
y3, Elem a'
y4] =
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
13 (forall a. a -> a -> Digit a
Two Elem a'
x1 Elem a'
x2)
(forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
9 (forall a. a -> a -> Digit a
Two (forall a. Int -> a -> a -> a -> Node a
Node3 Int
3 Elem a'
x3 Elem a'
x4 Elem a'
x5) (forall a. Int -> a -> a -> a -> Node a
Node3 Int
3 Elem a'
x6 Elem a'
x7 Elem a'
x8)) forall a. FingerTree a
EmptyT (forall a. a -> Digit a
One (forall a. Int -> a -> a -> a -> Node a
Node3 Int
3 Elem a'
y0 Elem a'
y1 Elem a'
y2)))
(forall a. a -> a -> Digit a
Two Elem a'
y3 Elem a'
y4)
mkTree [Elem a'
x1, Elem a'
x2, Elem a'
x3, Elem a'
x4, Elem a'
x5, Elem a'
x6, Elem a'
x7, Elem a'
x8, Elem a'
x9, Elem a'
y0, Elem a'
y1, Elem a'
y2, Elem a'
y3, Elem a'
y4] =
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
14 (forall a. a -> a -> a -> Digit a
Three Elem a'
x1 Elem a'
x2 Elem a'
x3)
(forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
9 (forall a. a -> a -> Digit a
Two (forall a. Int -> a -> a -> a -> Node a
Node3 Int
3 Elem a'
x4 Elem a'
x5 Elem a'
x6) (forall a. Int -> a -> a -> a -> Node a
Node3 Int
3 Elem a'
x7 Elem a'
x8 Elem a'
x9)) forall a. FingerTree a
EmptyT (forall a. a -> Digit a
One (forall a. Int -> a -> a -> a -> Node a
Node3 Int
3 Elem a'
y0 Elem a'
y1 Elem a'
y2)))
(forall a. a -> a -> Digit a
Two Elem a'
y3 Elem a'
y4)
mkTree [Elem a'
x1, Elem a'
x2, Elem a'
x3, Elem a'
x4, Elem a'
x5, Elem a'
x6, Elem a'
x7, Elem a'
x8, Elem a'
x9, Elem a'
y0, Elem a'
y1, Elem a'
y2, Elem a'
y3, Elem a'
y4, Elem a'
y5] =
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
15 (forall a. a -> a -> a -> Digit a
Three Elem a'
x1 Elem a'
x2 Elem a'
x3)
(forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
9 (forall a. a -> a -> Digit a
Two (forall a. Int -> a -> a -> a -> Node a
Node3 Int
3 Elem a'
x4 Elem a'
x5 Elem a'
x6) (forall a. Int -> a -> a -> a -> Node a
Node3 Int
3 Elem a'
x7 Elem a'
x8 Elem a'
x9)) forall a. FingerTree a
EmptyT (forall a. a -> Digit a
One (forall a. Int -> a -> a -> a -> Node a
Node3 Int
3 Elem a'
y0 Elem a'
y1 Elem a'
y2)))
(forall a. a -> a -> a -> Digit a
Three Elem a'
y3 Elem a'
y4 Elem a'
y5)
mkTree (Elem a'
x1:Elem a'
x2:Elem a'
x3:Elem a'
x4:Elem a'
x5:Elem a'
x6:Elem a'
x7:Elem a'
x8:Elem a'
x9:Elem a'
y0:Elem a'
y1:Elem a'
y2:Elem a'
y3:Elem a'
y4:Elem a'
y5:Elem a'
y6:[Elem a']
xs) =
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 Int
9 (forall a.
Int
-> Node a
-> a
-> [a]
-> ListFinal (Node (Node a)) (Digit (Node a), Digit a)
getNodes Int
3 (forall a. Int -> a -> a -> a -> Node a
Node3 Int
3 Elem a'
y3 Elem a'
y4 Elem a'
y5) Elem a'
y6 [Elem a']
xs)
where
d2 :: Digit (Elem a')
d2 = forall a. a -> a -> a -> Digit a
Three Elem a'
x1 Elem a'
x2 Elem a'
x3
d1 :: Digit (Node (Elem a'))
d1 = forall a. a -> a -> a -> Digit a
Three (forall a. Int -> a -> a -> a -> Node a
Node3 Int
3 Elem a'
x4 Elem a'
x5 Elem a'
x6) (forall a. Int -> a -> a -> a -> Node a
Node3 Int
3 Elem a'
x7 Elem a'
x8 Elem a'
x9) (forall a. Int -> a -> a -> a -> Node a
Node3 Int
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 = forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
9 forall a. Num a => a -> a -> a
+ forall a. Sized a => a -> Int
size Digit (Node (Elem a'))
r1 forall a. Num a => a -> a -> a
+ 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 forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
3 forall a. Num a => a -> a -> a
+ forall a. Sized a => a -> Int
size Digit (Elem a')
r2 forall a. Num a => a -> a -> a
+ 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 :: forall a.
Int
-> Node a
-> a
-> [a]
-> ListFinal (Node (Node a)) (Digit (Node a), Digit a)
getNodes !Int
_ Node a
n1 a
x1 [] = forall a cont. cont -> ListFinal a cont
LFinal (forall a. a -> Digit a
One Node a
n1, forall a. a -> Digit a
One a
x1)
getNodes Int
_ Node a
n1 a
x1 [a
x2] = forall a cont. cont -> ListFinal a cont
LFinal (forall a. a -> Digit a
One Node a
n1, forall a. a -> a -> Digit a
Two a
x1 a
x2)
getNodes Int
_ Node a
n1 a
x1 [a
x2, a
x3] = forall a cont. cont -> ListFinal a cont
LFinal (forall a. a -> Digit a
One Node a
n1, forall a. a -> a -> a -> Digit a
Three a
x1 a
x2 a
x3)
getNodes Int
s Node a
n1 a
x1 [a
x2, a
x3, a
x4] = forall a cont. cont -> ListFinal a cont
LFinal (forall a. a -> a -> Digit a
Two Node a
n1 (forall a. Int -> a -> a -> a -> Node a
Node3 Int
s a
x1 a
x2 a
x3), forall a. a -> Digit a
One a
x4)
getNodes Int
s Node a
n1 a
x1 [a
x2, a
x3, a
x4, a
x5] = forall a cont. cont -> ListFinal a cont
LFinal (forall a. a -> a -> Digit a
Two Node a
n1 (forall a. Int -> a -> a -> a -> Node a
Node3 Int
s a
x1 a
x2 a
x3), forall a. a -> a -> Digit a
Two a
x4 a
x5)
getNodes Int
s Node a
n1 a
x1 [a
x2, a
x3, a
x4, a
x5, a
x6] = forall a cont. cont -> ListFinal a cont
LFinal (forall a. a -> a -> Digit a
Two Node a
n1 (forall a. Int -> a -> a -> a -> Node a
Node3 Int
s a
x1 a
x2 a
x3), forall a. a -> a -> a -> Digit a
Three a
x4 a
x5 a
x6)
getNodes Int
s Node a
n1 a
x1 [a
x2, a
x3, a
x4, a
x5, a
x6, a
x7] = forall a cont. cont -> ListFinal a cont
LFinal (forall a. a -> a -> a -> Digit a
Three Node a
n1 (forall a. Int -> a -> a -> a -> Node a
Node3 Int
s a
x1 a
x2 a
x3) (forall a. Int -> a -> a -> a -> Node a
Node3 Int
s a
x4 a
x5 a
x6), forall a. a -> Digit a
One a
x7)
getNodes Int
s Node a
n1 a
x1 [a
x2, a
x3, a
x4, a
x5, a
x6, a
x7, a
x8] = forall a cont. cont -> ListFinal a cont
LFinal (forall a. a -> a -> a -> Digit a
Three Node a
n1 (forall a. Int -> a -> a -> a -> Node a
Node3 Int
s a
x1 a
x2 a
x3) (forall a. Int -> a -> a -> a -> Node a
Node3 Int
s a
x4 a
x5 a
x6), forall a. a -> a -> Digit a
Two a
x7 a
x8)
getNodes Int
s Node a
n1 a
x1 [a
x2, a
x3, a
x4, a
x5, a
x6, a
x7, a
x8, a
x9] = forall a cont. cont -> ListFinal a cont
LFinal (forall a. a -> a -> a -> Digit a
Three Node a
n1 (forall a. Int -> a -> a -> a -> Node a
Node3 Int
s a
x1 a
x2 a
x3) (forall a. Int -> a -> a -> a -> Node a
Node3 Int
s a
x4 a
x5 a
x6), forall a. a -> a -> a -> Digit a
Three a
x7 a
x8 a
x9)
getNodes Int
s Node a
n1 a
x1 (a
x2:a
x3:a
x4:a
x5:a
x6:a
x7:a
x8:a
x9:a
x10:[a]
xs) = forall a cont. a -> ListFinal a cont -> ListFinal a cont
LCons Node (Node a)
n10 (forall a.
Int
-> Node a
-> a
-> [a]
-> ListFinal (Node (Node a)) (Digit (Node a), Digit a)
getNodes Int
s (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 = forall a. Int -> a -> a -> a -> Node a
Node3 Int
s a
x1 a
x2 a
x3
!n3 :: Node a
n3 = forall a. Int -> a -> a -> a -> Node a
Node3 Int
s a
x4 a
x5 a
x6
!n10 :: Node (Node a)
n10 = forall a. Int -> a -> a -> a -> Node a
Node3 (Int
3forall 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 :: forall a b c.
(b -> FingerTree (Node a) -> c) -> Int -> ListFinal (Node a) b -> c
mkTreeC b -> FingerTree (Node a) -> c
cont !Int
_ (LFinal b
b) =
b -> FingerTree (Node a) -> c
cont b
b forall a. FingerTree a
EmptyT
mkTreeC b -> FingerTree (Node a) -> c
cont Int
_ (LCons Node a
x1 (LFinal b
b)) =
b -> FingerTree (Node a) -> c
cont b
b (forall a. a -> FingerTree a
Single Node a
x1)
mkTreeC b -> FingerTree (Node a) -> c
cont Int
s (LCons Node a
x1 (LCons Node a
x2 (LFinal b
b))) =
b -> FingerTree (Node a) -> c
cont b
b (forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
2forall a. Num a => a -> a -> a
*Int
s) (forall a. a -> Digit a
One Node a
x1) forall a. FingerTree a
EmptyT (forall a. a -> Digit a
One Node a
x2))
mkTreeC b -> FingerTree (Node a) -> c
cont Int
s (LCons Node a
x1 (LCons Node a
x2 (LCons Node a
x3 (LFinal b
b)))) =
b -> FingerTree (Node a) -> c
cont b
b (forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
3forall a. Num a => a -> a -> a
*Int
s) (forall a. a -> a -> Digit a
Two Node a
x1 Node a
x2) forall a. FingerTree a
EmptyT (forall a. a -> Digit a
One Node a
x3))
mkTreeC b -> FingerTree (Node a) -> c
cont Int
s (LCons Node a
x1 (LCons Node a
x2 (LCons Node a
x3 (LCons Node a
x4 (LFinal b
b))))) =
b -> FingerTree (Node a) -> c
cont b
b (forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
4forall a. Num a => a -> a -> a
*Int
s) (forall a. a -> a -> Digit a
Two Node a
x1 Node a
x2) forall a. FingerTree a
EmptyT (forall a. a -> a -> Digit a
Two Node a
x3 Node a
x4))
mkTreeC b -> FingerTree (Node a) -> c
cont Int
s (LCons Node a
x1 (LCons Node a
x2 (LCons Node a
x3 (LCons Node a
x4 (LCons Node a
x5 (LFinal b
b)))))) =
b -> FingerTree (Node a) -> c
cont b
b (forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
5forall a. Num a => a -> a -> a
*Int
s) (forall a. a -> a -> a -> Digit a
Three Node a
x1 Node a
x2 Node a
x3) forall a. FingerTree a
EmptyT (forall a. a -> a -> Digit a
Two Node a
x4 Node a
x5))
mkTreeC b -> FingerTree (Node a) -> c
cont Int
s (LCons Node a
x1 (LCons Node a
x2 (LCons Node a
x3 (LCons Node a
x4 (LCons Node a
x5 (LCons Node a
x6 (LFinal b
b))))))) =
b -> FingerTree (Node a) -> c
cont b
b (forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
6forall a. Num a => a -> a -> a
*Int
s) (forall a. a -> a -> a -> Digit a
Three Node a
x1 Node a
x2 Node a
x3) forall a. FingerTree a
EmptyT (forall a. a -> a -> a -> Digit a
Three Node a
x4 Node a
x5 Node a
x6))
mkTreeC b -> FingerTree (Node a) -> c
cont Int
s (LCons Node a
x1 (LCons Node a
x2 (LCons Node a
x3 (LCons Node a
x4 (LCons Node a
x5 (LCons Node a
x6 (LCons Node a
x7 (LFinal b
b)))))))) =
b -> FingerTree (Node a) -> c
cont b
b (forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
7forall a. Num a => a -> a -> a
*Int
s) (forall a. a -> a -> Digit a
Two Node a
x1 Node a
x2) (forall a. a -> FingerTree a
Single (forall a. Int -> a -> a -> a -> Node a
Node3 (Int
3forall a. Num a => a -> a -> a
*Int
s) Node a
x3 Node a
x4 Node a
x5)) (forall a. a -> a -> Digit a
Two Node a
x6 Node a
x7))
mkTreeC b -> FingerTree (Node a) -> c
cont Int
s (LCons Node a
x1 (LCons Node a
x2 (LCons Node a
x3 (LCons Node a
x4 (LCons Node a
x5 (LCons Node a
x6 (LCons Node a
x7 (LCons Node a
x8 (LFinal b
b))))))))) =
b -> FingerTree (Node a) -> c
cont b
b (forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
8forall a. Num a => a -> a -> a
*Int
s) (forall a. a -> a -> a -> Digit a
Three Node a
x1 Node a
x2 Node a
x3) (forall a. a -> FingerTree a
Single (forall a. Int -> a -> a -> a -> Node a
Node3 (Int
3forall a. Num a => a -> a -> a
*Int
s) Node a
x4 Node a
x5 Node a
x6)) (forall a. a -> a -> Digit a
Two Node a
x7 Node a
x8))
mkTreeC b -> FingerTree (Node a) -> c
cont Int
s (LCons Node a
x1 (LCons Node a
x2 (LCons Node a
x3 (LCons Node a
x4 (LCons Node a
x5 (LCons Node a
x6 (LCons Node a
x7 (LCons Node a
x8 (LCons Node a
x9 (LFinal b
b)))))))))) =
b -> FingerTree (Node a) -> c
cont b
b (forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
9forall a. Num a => a -> a -> a
*Int
s) (forall a. a -> a -> a -> Digit a
Three Node a
x1 Node a
x2 Node a
x3) (forall a. a -> FingerTree a
Single (forall a. Int -> a -> a -> a -> Node a
Node3 (Int
3forall a. Num a => a -> a -> a
*Int
s) Node a
x4 Node a
x5 Node a
x6)) (forall a. a -> a -> a -> Digit a
Three Node a
x7 Node a
x8 Node a
x9))
mkTreeC b -> FingerTree (Node a) -> c
cont Int
s (LCons Node a
x1 (LCons Node a
x2 (LCons Node a
x3 (LCons Node a
x4 (LCons Node a
x5 (LCons Node a
x6 (LCons Node a
x7 (LCons Node a
x8 (LCons Node a
y0 (LCons Node a
y1 (LFinal b
b))))))))))) =
b -> FingerTree (Node a) -> c
cont b
b (forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
10forall a. Num a => a -> a -> a
*Int
s) (forall a. a -> a -> Digit a
Two Node a
x1 Node a
x2) (forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
6forall a. Num a => a -> a -> a
*Int
s) (forall a. a -> Digit a
One (forall a. Int -> a -> a -> a -> Node a
Node3 (Int
3forall a. Num a => a -> a -> a
*Int
s) Node a
x3 Node a
x4 Node a
x5)) forall a. FingerTree a
EmptyT (forall a. a -> Digit a
One (forall a. Int -> a -> a -> a -> Node a
Node3 (Int
3forall a. Num a => a -> a -> a
*Int
s) Node a
x6 Node a
x7 Node a
x8))) (forall a. a -> a -> Digit a
Two Node a
y0 Node a
y1))
mkTreeC b -> FingerTree (Node a) -> c
cont Int
s (LCons Node a
x1 (LCons Node a
x2 (LCons Node a
x3 (LCons Node a
x4 (LCons Node a
x5 (LCons Node a
x6 (LCons Node a
x7 (LCons Node a
x8 (LCons Node a
x9 (LCons Node a
y0 (LCons Node a
y1 (LFinal b
b)))))))))))) =
b -> FingerTree (Node a) -> c
cont b
b (forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
11forall a. Num a => a -> a -> a
*Int
s) (forall a. a -> a -> a -> Digit a
Three Node a
x1 Node a
x2 Node a
x3) (forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
6forall a. Num a => a -> a -> a
*Int
s) (forall a. a -> Digit a
One (forall a. Int -> a -> a -> a -> Node a
Node3 (Int
3forall a. Num a => a -> a -> a
*Int
s) Node a
x4 Node a
x5 Node a
x6)) forall a. FingerTree a
EmptyT (forall a. a -> Digit a
One (forall a. Int -> a -> a -> a -> Node a
Node3 (Int
3forall a. Num a => a -> a -> a
*Int
s) Node a
x7 Node a
x8 Node a
x9))) (forall a. a -> a -> Digit a
Two Node a
y0 Node a
y1))
mkTreeC b -> FingerTree (Node a) -> c
cont Int
s (LCons Node a
x1 (LCons Node a
x2 (LCons Node a
x3 (LCons Node a
x4 (LCons Node a
x5 (LCons Node a
x6 (LCons Node a
x7 (LCons Node a
x8 (LCons Node a
x9 (LCons Node a
y0 (LCons Node a
y1 (LCons Node a
y2 (LFinal b
b))))))))))))) =
b -> FingerTree (Node a) -> c
cont b
b (forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
12forall a. Num a => a -> a -> a
*Int
s) (forall a. a -> a -> a -> Digit a
Three Node a
x1 Node a
x2 Node a
x3) (forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
6forall a. Num a => a -> a -> a
*Int
s) (forall a. a -> Digit a
One (forall a. Int -> a -> a -> a -> Node a
Node3 (Int
3forall a. Num a => a -> a -> a
*Int
s) Node a
x4 Node a
x5 Node a
x6)) forall a. FingerTree a
EmptyT (forall a. a -> Digit a
One (forall a. Int -> a -> a -> a -> Node a
Node3 (Int
3forall a. Num a => a -> a -> a
*Int
s) Node a
x7 Node a
x8 Node a
x9))) (forall a. a -> a -> a -> Digit a
Three Node a
y0 Node a
y1 Node a
y2))
mkTreeC b -> FingerTree (Node a) -> c
cont Int
s (LCons Node a
x1 (LCons Node a
x2 (LCons Node a
x3 (LCons Node a
x4 (LCons Node a
x5 (LCons Node a
x6 (LCons Node a
x7 (LCons Node a
x8 (LCons Node a
y0 (LCons Node a
y1 (LCons Node a
y2 (LCons Node a
y3 (LCons Node a
y4 (LFinal b
b)))))))))))))) =
b -> FingerTree (Node a) -> c
cont b
b (forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
13forall a. Num a => a -> a -> a
*Int
s) (forall a. a -> a -> Digit a
Two Node a
x1 Node a
x2) (forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
9forall a. Num a => a -> a -> a
*Int
s) (forall a. a -> a -> Digit a
Two (forall a. Int -> a -> a -> a -> Node a
Node3 (Int
3forall a. Num a => a -> a -> a
*Int
s) Node a
x3 Node a
x4 Node a
x5) (forall a. Int -> a -> a -> a -> Node a
Node3 (Int
3forall a. Num a => a -> a -> a
*Int
s) Node a
x6 Node a
x7 Node a
x8)) forall a. FingerTree a
EmptyT (forall a. a -> Digit a
One (forall a. Int -> a -> a -> a -> Node a
Node3 (Int
3forall a. Num a => a -> a -> a
*Int
s) Node a
y0 Node a
y1 Node a
y2))) (forall a. a -> a -> Digit a
Two Node a
y3 Node a
y4))
mkTreeC b -> FingerTree (Node a) -> c
cont Int
s (LCons Node a
x1 (LCons Node a
x2 (LCons Node a
x3 (LCons Node a
x4 (LCons Node a
x5 (LCons Node a
x6 (LCons Node a
x7 (LCons Node a
x8 (LCons Node a
x9 (LCons Node a
y0 (LCons Node a
y1 (LCons Node a
y2 (LCons Node a
y3 (LCons Node a
y4 (LFinal b
b))))))))))))))) =
b -> FingerTree (Node a) -> c
cont b
b (forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
14forall a. Num a => a -> a -> a
*Int
s) (forall a. a -> a -> a -> Digit a
Three Node a
x1 Node a
x2 Node a
x3) (forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
9forall a. Num a => a -> a -> a
*Int
s) (forall a. a -> a -> Digit a
Two (forall a. Int -> a -> a -> a -> Node a
Node3 (Int
3forall a. Num a => a -> a -> a
*Int
s) Node a
x4 Node a
x5 Node a
x6) (forall a. Int -> a -> a -> a -> Node a
Node3 (Int
3forall a. Num a => a -> a -> a
*Int
s) Node a
x7 Node a
x8 Node a
x9)) forall a. FingerTree a
EmptyT (forall a. a -> Digit a
One (forall a. Int -> a -> a -> a -> Node a
Node3 (Int
3forall a. Num a => a -> a -> a
*Int
s) Node a
y0 Node a
y1 Node a
y2))) (forall a. a -> a -> Digit a
Two Node a
y3 Node a
y4))
mkTreeC b -> FingerTree (Node a) -> c
cont Int
s (LCons Node a
x1 (LCons Node a
x2 (LCons Node a
x3 (LCons Node a
x4 (LCons Node a
x5 (LCons Node a
x6 (LCons Node a
x7 (LCons Node a
x8 (LCons Node a
x9 (LCons Node a
y0 (LCons Node a
y1 (LCons Node a
y2 (LCons Node a
y3 (LCons Node a
y4 (LCons Node a
y5 (LFinal b
b)))))))))))))))) =
b -> FingerTree (Node a) -> c
cont b
b (forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
15forall a. Num a => a -> a -> a
*Int
s) (forall a. a -> a -> a -> Digit a
Three Node a
x1 Node a
x2 Node a
x3) (forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
9forall a. Num a => a -> a -> a
*Int
s) (forall a. a -> a -> Digit a
Two (forall a. Int -> a -> a -> a -> Node a
Node3 (Int
3forall a. Num a => a -> a -> a
*Int
s) Node a
x4 Node a
x5 Node a
x6) (forall a. Int -> a -> a -> a -> Node a
Node3 (Int
3forall a. Num a => a -> a -> a
*Int
s) Node a
x7 Node a
x8 Node a
x9)) forall a. FingerTree a
EmptyT (forall a. a -> Digit a
One (forall a. Int -> a -> a -> a -> Node a
Node3 (Int
3forall a. Num a => a -> a -> a
*Int
s) Node a
y0 Node a
y1 Node a
y2))) (forall a. a -> a -> a -> Digit a
Three Node a
y3 Node a
y4 Node a
y5))
mkTreeC b -> FingerTree (Node a) -> c
cont Int
s (LCons Node a
x1 (LCons Node a
x2 (LCons Node a
x3 (LCons Node a
x4 (LCons Node a
x5 (LCons Node a
x6 (LCons Node a
x7 (LCons Node a
x8 (LCons Node a
x9 (LCons Node a
y0 (LCons Node a
y1 (LCons Node a
y2 (LCons Node a
y3 (LCons Node a
y4 (LCons Node a
y5 (LCons Node a
y6 ListFinal (Node a) b
xs)))))))))))))))) =
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 (Int
9forall a. Num a => a -> a -> a
*Int
s) (forall a b.
Int
-> Node a
-> a
-> ListFinal a b
-> ListFinal (Node (Node a)) (b, Digit (Node a), Digit a)
getNodesC (Int
3forall a. Num a => a -> a -> a
*Int
s) (forall a. Int -> a -> a -> a -> Node a
Node3 (Int
3forall 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, Digit (Node (Node a))
r1, Digit (Node a)
r2) !FingerTree (Node (Node (Node a)))
sub =
let d2 :: Digit (Node a)
d2 = forall a. a -> a -> a -> Digit a
Three Node a
x1 Node a
x2 Node a
x3
d1 :: Digit (Node (Node a))
d1 = forall a. a -> a -> a -> Digit a
Three (forall a. Int -> a -> a -> a -> Node a
Node3 (Int
3forall a. Num a => a -> a -> a
*Int
s) Node a
x4 Node a
x5 Node a
x6) (forall a. Int -> a -> a -> a -> Node a
Node3 (Int
3forall a. Num a => a -> a -> a
*Int
s) Node a
x7 Node a
x8 Node a
x9) (forall a. Int -> a -> a -> a -> Node a
Node3 (Int
3forall a. Num a => a -> a -> a
*Int
s) Node a
y0 Node a
y1 Node a
y2)
!sub1 :: FingerTree (Node (Node a))
sub1 = forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
9forall a. Num a => a -> a -> a
*Int
s forall a. Num a => a -> a -> a
+ forall a. Sized a => a -> Int
size Digit (Node (Node a))
r1 forall a. Num a => a -> a -> a
+ 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 forall a b. (a -> b) -> a -> b
$! forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
3forall a. Num a => a -> a -> a
*Int
s forall a. Num a => a -> a -> a
+ forall a. Sized a => a -> Int
size Digit (Node a)
r2 forall a. Num a => a -> a -> a
+ 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 :: forall a b.
Int
-> Node a
-> a
-> ListFinal a b
-> ListFinal (Node (Node a)) (b, Digit (Node a), Digit a)
getNodesC !Int
_ Node a
n1 a
x1 (LFinal b
b) = forall a cont. cont -> ListFinal a cont
LFinal forall a b. (a -> b) -> a -> b
$ (b
b, forall a. a -> Digit a
One Node a
n1, forall a. a -> Digit a
One a
x1)
getNodesC Int
_ Node a
n1 a
x1 (LCons a
x2 (LFinal b
b)) = forall a cont. cont -> ListFinal a cont
LFinal forall a b. (a -> b) -> a -> b
$ (b
b, forall a. a -> Digit a
One Node a
n1, forall a. a -> a -> Digit a
Two a
x1 a
x2)
getNodesC Int
_ Node a
n1 a
x1 (LCons a
x2 (LCons a
x3 (LFinal b
b))) = forall a cont. cont -> ListFinal a cont
LFinal forall a b. (a -> b) -> a -> b
$ (b
b, forall a. a -> Digit a
One Node a
n1, forall a. a -> a -> a -> Digit a
Three a
x1 a
x2 a
x3)
getNodesC Int
s Node a
n1 a
x1 (LCons a
x2 (LCons a
x3 (LCons a
x4 (LFinal b
b)))) =
let !n2 :: Node a
n2 = forall a. Int -> a -> a -> a -> Node a
Node3 Int
s a
x1 a
x2 a
x3
in forall a cont. cont -> ListFinal a cont
LFinal forall a b. (a -> b) -> a -> b
$ (b
b, forall a. a -> a -> Digit a
Two Node a
n1 Node a
n2, forall a. a -> Digit a
One a
x4)
getNodesC Int
s Node a
n1 a
x1 (LCons a
x2 (LCons a
x3 (LCons a
x4 (LCons a
x5 (LFinal b
b))))) =
let !n2 :: Node a
n2 = forall a. Int -> a -> a -> a -> Node a
Node3 Int
s a
x1 a
x2 a
x3
in forall a cont. cont -> ListFinal a cont
LFinal forall a b. (a -> b) -> a -> b
$ (b
b, forall a. a -> a -> Digit a
Two Node a
n1 Node a
n2, forall a. a -> a -> Digit a
Two a
x4 a
x5)
getNodesC Int
s Node a
n1 a
x1 (LCons a
x2 (LCons a
x3 (LCons a
x4 (LCons a
x5 (LCons a
x6 (LFinal b
b)))))) =
let !n2 :: Node a
n2 = forall a. Int -> a -> a -> a -> Node a
Node3 Int
s a
x1 a
x2 a
x3
in forall a cont. cont -> ListFinal a cont
LFinal forall a b. (a -> b) -> a -> b
$ (b
b, forall a. a -> a -> Digit a
Two Node a
n1 Node a
n2, forall a. a -> a -> a -> Digit a
Three a
x4 a
x5 a
x6)
getNodesC Int
s Node a
n1 a
x1 (LCons a
x2 (LCons a
x3 (LCons a
x4 (LCons a
x5 (LCons a
x6 (LCons a
x7 (LFinal b
b))))))) =
let !n2 :: Node a
n2 = forall a. Int -> a -> a -> a -> Node a
Node3 Int
s a
x1 a
x2 a
x3
!n3 :: Node a
n3 = forall a. Int -> a -> a -> a -> Node a
Node3 Int
s a
x4 a
x5 a
x6
in forall a cont. cont -> ListFinal a cont
LFinal forall a b. (a -> b) -> a -> b
$ (b
b, forall a. a -> a -> a -> Digit a
Three Node a
n1 Node a
n2 Node a
n3, forall a. a -> Digit a
One a
x7)
getNodesC Int
s Node a
n1 a
x1 (LCons a
x2 (LCons a
x3 (LCons a
x4 (LCons a
x5 (LCons a
x6 (LCons a
x7 (LCons a
x8 (LFinal b
b)))))))) =
let !n2 :: Node a
n2 = forall a. Int -> a -> a -> a -> Node a
Node3 Int
s a
x1 a
x2 a
x3
!n3 :: Node a
n3 = forall a. Int -> a -> a -> a -> Node a
Node3 Int
s a
x4 a
x5 a
x6
in forall a cont. cont -> ListFinal a cont
LFinal forall a b. (a -> b) -> a -> b
$ (b
b, forall a. a -> a -> a -> Digit a
Three Node a
n1 Node a
n2 Node a
n3, forall a. a -> a -> Digit a
Two a
x7 a
x8)
getNodesC Int
s Node a
n1 a
x1 (LCons a
x2 (LCons a
x3 (LCons a
x4 (LCons a
x5 (LCons a
x6 (LCons a
x7 (LCons a
x8 (LCons a
x9 (LFinal b
b))))))))) =
let !n2 :: Node a
n2 = forall a. Int -> a -> a -> a -> Node a
Node3 Int
s a
x1 a
x2 a
x3
!n3 :: Node a
n3 = forall a. Int -> a -> a -> a -> Node a
Node3 Int
s a
x4 a
x5 a
x6
in forall a cont. cont -> ListFinal a cont
LFinal forall a b. (a -> b) -> a -> b
$ (b
b, forall a. a -> a -> a -> Digit a
Three Node a
n1 Node a
n2 Node a
n3, forall a. a -> a -> a -> Digit a
Three a
x7 a
x8 a
x9)
getNodesC Int
s Node a
n1 a
x1 (LCons a
x2 (LCons a
x3 (LCons a
x4 (LCons a
x5 (LCons a
x6 (LCons a
x7 (LCons a
x8 (LCons a
x9 (LCons a
x10 ListFinal a b
xs))))))))) =
forall a cont. a -> ListFinal a cont -> ListFinal a cont
LCons Node (Node a)
n10 forall a b. (a -> b) -> a -> b
$ forall a b.
Int
-> Node a
-> a
-> ListFinal a b
-> ListFinal (Node (Node a)) (b, Digit (Node a), Digit a)
getNodesC Int
s (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 = forall a. Int -> a -> a -> a -> Node a
Node3 Int
s a
x1 a
x2 a
x3
!n3 :: Node a
n3 = forall a. Int -> a -> a -> a -> Node a
Node3 Int
s a
x4 a
x5 a
x6
!n10 :: Node (Node a)
n10 = forall a. Int -> a -> a -> a -> Node a
Node3 (Int
3forall 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 :: forall a. [a] -> [Elem a]
map_elem [a]
xs = coerce :: 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 = forall a. [a] -> Seq a
fromList
fromListN :: Int -> [Item (Seq a)] -> Seq a
fromListN = forall a. Int -> [a] -> Seq a
fromList2
toList :: Seq a -> [Item (Seq a)]
toList = 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 = forall a. [a] -> Seq a
fromList
#endif
reverse :: Seq a -> Seq a
reverse :: forall a. Seq a -> Seq a
reverse (Seq FingerTree (Elem a)
xs) = forall a. FingerTree (Elem a) -> Seq a
Seq (forall a b. (a -> b) -> FingerTree a -> FingerTree b
fmapReverseTree forall a. a -> a
id FingerTree (Elem a)
xs)
#ifdef __GLASGOW_HASKELL__
{-# NOINLINE [1] reverse #-}
fmapReverse :: (a -> b) -> Seq a -> Seq b
fmapReverse :: forall a b. (a -> b) -> Seq a -> Seq b
fmapReverse a -> b
f (Seq FingerTree (Elem a)
xs) = forall a. FingerTree (Elem a) -> Seq a
Seq (forall a b. (a -> b) -> FingerTree a -> FingerTree b
fmapReverseTree (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 :: forall a b. (a -> b) -> Elem a -> Elem b
lift_elem = coerce :: 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 :: forall a b. (a -> b) -> FingerTree a -> FingerTree b
fmapReverseTree a -> b
_ FingerTree a
EmptyT = forall a. FingerTree a
EmptyT
fmapReverseTree a -> b
f (Single a
x) = forall a. a -> FingerTree a
Single (a -> b
f a
x)
fmapReverseTree a -> b
f (Deep Int
s Digit a
pr FingerTree (Node a)
m Digit a
sf) =
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
s (forall a b. (a -> b) -> Digit a -> Digit b
reverseDigit a -> b
f Digit a
sf)
(forall a b. (a -> b) -> FingerTree a -> FingerTree b
fmapReverseTree (forall a b. (a -> b) -> Node a -> Node b
reverseNode a -> b
f) FingerTree (Node a)
m)
(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 :: forall a b. (a -> b) -> Digit a -> Digit b
reverseDigit a -> b
f (One a
a) = forall a. a -> Digit a
One (a -> b
f a
a)
reverseDigit a -> b
f (Two a
a a
b) = forall a. a -> a -> Digit a
Two (a -> b
f a
b) (a -> b
f a
a)
reverseDigit a -> b
f (Three a
a a
b a
c) = forall a. a -> a -> a -> Digit a
Three (a -> b
f a
c) (a -> b
f a
b) (a -> b
f a
a)
reverseDigit a -> b
f (Four a
a a
b a
c a
d) = 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 :: forall a b. (a -> b) -> Node a -> Node b
reverseNode a -> b
f (Node2 Int
s a
a a
b) = forall a. Int -> a -> a -> Node a
Node2 Int
s (a -> b
f a
b) (a -> b
f a
a)
reverseNode a -> b
f (Node3 Int
s a
a a
b a
c) = 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 :: forall s a' b'.
(Int -> s -> (s, s)) -> (s -> a' -> b') -> s -> Seq a' -> Seq b'
splitMap Int -> s -> (s, s)
splt s -> a' -> b'
f0 s
s0 (Seq FingerTree (Elem a')
xs0) = forall a. FingerTree (Elem a) -> Seq a
Seq forall a b. (a -> b) -> a -> b
$ forall y b.
(s -> Elem y -> b) -> s -> FingerTree (Elem y) -> FingerTree b
splitMapTreeE (\s
s' (Elem a'
a) -> 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 :: forall y b.
(s -> Elem y -> b) -> s -> FingerTree (Elem y) -> FingerTree b
splitMapTreeE s -> Elem y -> b
_ s
_ FingerTree (Elem y)
EmptyT = forall a. FingerTree a
EmptyT
splitMapTreeE s -> Elem y -> b
f s
s (Single Elem y
xs) = forall a. a -> FingerTree a
Single forall a b. (a -> b) -> a -> b
$ s -> Elem y -> b
f s
s Elem y
xs
splitMapTreeE s -> Elem y -> b
f s
s (Deep Int
n Digit (Elem y)
pr FingerTree (Node (Elem y))
m Digit (Elem y)
sf) = forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
n (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) (forall a b.
(s -> Node a -> b) -> s -> FingerTree (Node a) -> FingerTree b
splitMapTreeN (\s
eta1 Node (Elem y)
eta2 -> 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) (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 = forall a. Sized a => a -> Int
size Digit (Elem y)
pr
!sm :: Int
sm = Int
n forall a. Num a => a -> a -> a
- Int
spr forall a. Num a => a -> a -> a
- forall a. Sized a => a -> Int
size Digit (Elem y)
sf
(s
prs, s
r) = Int -> s -> (s, s)
splt Int
spr s
s
(s
ms, s
sfs) = Int -> s -> (s, s)
splt Int
sm s
r
splitMapTreeN :: (s -> Node a -> b) -> s -> FingerTree (Node a) -> FingerTree b
splitMapTreeN :: forall a b.
(s -> Node a -> b) -> s -> FingerTree (Node a) -> FingerTree b
splitMapTreeN s -> Node a -> b
_ s
_ FingerTree (Node a)
EmptyT = forall a. FingerTree a
EmptyT
splitMapTreeN s -> Node a -> b
f s
s (Single Node a
xs) = forall a. a -> FingerTree a
Single forall a b. (a -> b) -> a -> b
$ s -> Node a -> b
f s
s Node a
xs
splitMapTreeN s -> Node a -> b
f s
s (Deep Int
n Digit (Node a)
pr FingerTree (Node (Node a))
m Digit (Node a)
sf) = forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
n (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) (forall a b.
(s -> Node a -> b) -> s -> FingerTree (Node a) -> FingerTree b
splitMapTreeN (\s
eta1 Node (Node a)
eta2 -> 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) (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
(s
prs, s
r) = Int -> s -> (s, s)
splt (forall a. Sized a => a -> Int
size Digit (Node a)
pr) s
s
(s
ms, s
sfs) = Int -> s -> (s, s)
splt (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 :: forall a b. Sized a => (s -> a -> b) -> s -> Digit a -> Digit b
splitMapDigit s -> a -> b
f s
s (One a
a) = forall a. a -> Digit a
One (s -> a -> b
f s
s a
a)
splitMapDigit s -> a -> b
f s
s (Two a
a a
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
(s
first, s
second) = Int -> s -> (s, s)
splt (forall a. Sized a => a -> Int
size a
a) s
s
splitMapDigit s -> a -> b
f s
s (Three a
a a
b a
c) = 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
(s
first, s
r) = Int -> s -> (s, s)
splt (forall a. Sized a => a -> Int
size a
a) s
s
(s
second, s
third) = Int -> s -> (s, s)
splt (forall a. Sized a => a -> Int
size a
b) s
r
splitMapDigit s -> a -> b
f s
s (Four a
a a
b a
c a
d) = 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
(s
first, s
s') = Int -> s -> (s, s)
splt (forall a. Sized a => a -> Int
size a
a) s
s
(s
middle, s
fourth) = Int -> s -> (s, s)
splt (forall a. Sized a => a -> Int
size a
b forall a. Num a => a -> a -> a
+ forall a. Sized a => a -> Int
size a
c) s
s'
(s
second, s
third) = Int -> s -> (s, s)
splt (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 :: forall a b. Sized a => (s -> a -> b) -> s -> Node a -> Node b
splitMapNode s -> a -> b
f s
s (Node2 Int
ns a
a a
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
(s
first, s
second) = Int -> s -> (s, s)
splt (forall a. Sized a => a -> Int
size a
a) s
s
splitMapNode s -> a -> b
f s
s (Node3 Int
ns a
a a
b a
c) = 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
(s
first, s
r) = Int -> s -> (s, s)
splt (forall a. Sized a => a -> Int
size a
a) s
s
(s
second, s
third) = Int -> s -> (s, s)
splt (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 :: forall a b c. (a -> b -> c) -> Seq a -> Seq b -> Seq c
mzipWith = forall a b c. (a -> b -> c) -> Seq a -> Seq b -> Seq c
zipWith
munzip :: forall a b. Seq (a, b) -> (Seq a, Seq b)
munzip = forall a b. Seq (a, b) -> (Seq a, Seq b)
unzip
unzip :: Seq (a, b) -> (Seq a, Seq b)
unzip :: forall a b. Seq (a, b) -> (Seq a, Seq b)
unzip Seq (a, b)
xs = forall a b c. (a -> (b, c)) -> Seq a -> (Seq b, Seq c)
unzipWith forall a. a -> a
id Seq (a, b)
xs
unzipWith :: (a -> (b, c)) -> Seq a -> (Seq b, Seq c)
unzipWith :: forall a b c. (a -> (b, c)) -> Seq a -> (Seq b, Seq c)
unzipWith a -> (b, c)
f = forall (f :: * -> *) x a b.
UnzipWith f =>
(x -> (a, b)) -> f x -> (f a, f b)
unzipWith' (\a
x ->
let
{-# NOINLINE fx #-}
fx :: (b, c)
fx = a -> (b, c)
f a
x
(b
y,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' :: forall x a b. (x -> (a, b)) -> Elem x -> (Elem a, Elem b)
unzipWith' = coerce :: 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' :: forall x a b. (x -> (a, b)) -> Node x -> (Node a, Node b)
unzipWith' x -> (a, b)
f (Node2 Int
s x
x x
y) =
( forall a. Int -> a -> a -> Node a
Node2 Int
s a
x1 a
y1
, forall a. Int -> a -> a -> Node a
Node2 Int
s b
x2 b
y2)
where
{-# NOINLINE fx #-}
{-# NOINLINE fy #-}
fx :: (a, b)
fx = forall a b. (a, b) -> (a, b)
strictifyPair (x -> (a, b)
f x
x)
fy :: (a, b)
fy = forall a b. (a, b) -> (a, b)
strictifyPair (x -> (a, b)
f x
y)
(a
x1, b
x2) = (a, b)
fx
(a
y1, b
y2) = (a, b)
fy
unzipWith' x -> (a, b)
f (Node3 Int
s x
x x
y x
z) =
( forall a. Int -> a -> a -> a -> Node a
Node3 Int
s a
x1 a
y1 a
z1
, 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 = forall a b. (a, b) -> (a, b)
strictifyPair (x -> (a, b)
f x
x)
fy :: (a, b)
fy = forall a b. (a, b) -> (a, b)
strictifyPair (x -> (a, b)
f x
y)
fz :: (a, b)
fz = forall a b. (a, b) -> (a, b)
strictifyPair (x -> (a, b)
f x
z)
(a
x1, b
x2) = (a, b)
fx
(a
y1, b
y2) = (a, b)
fy
(a
z1, b
z2) = (a, b)
fz
strictifyPair :: (a, b) -> (a, b)
strictifyPair :: forall a b. (a, b) -> (a, b)
strictifyPair (!a
x, !b
y) = (a
x, b
y)
instance UnzipWith Digit where
unzipWith' :: forall x a b. (x -> (a, b)) -> Digit x -> (Digit a, Digit b)
unzipWith' x -> (a, b)
f (One x
x)
| (a
x1, b
x2) <- x -> (a, b)
f x
x
= (forall a. a -> Digit a
One a
x1, forall a. a -> Digit a
One b
x2)
unzipWith' x -> (a, b)
f (Two x
x x
y)
| (a
x1, b
x2) <- x -> (a, b)
f x
x
, (a
y1, b
y2) <- x -> (a, b)
f x
y
= ( forall a. a -> a -> Digit a
Two a
x1 a
y1
, forall a. a -> a -> Digit a
Two b
x2 b
y2)
unzipWith' x -> (a, b)
f (Three x
x x
y x
z)
| (a
x1, b
x2) <- x -> (a, b)
f x
x
, (a
y1, b
y2) <- x -> (a, b)
f x
y
, (a
z1, b
z2) <- x -> (a, b)
f x
z
= ( forall a. a -> a -> a -> Digit a
Three a
x1 a
y1 a
z1
, forall a. a -> a -> a -> Digit a
Three b
x2 b
y2 b
z2)
unzipWith' x -> (a, b)
f (Four x
x x
y x
z x
w)
| (a
x1, b
x2) <- x -> (a, b)
f x
x
, (a
y1, b
y2) <- x -> (a, b)
f x
y
, (a
z1, b
z2) <- x -> (a, b)
f x
z
, (a
w1, b
w2) <- x -> (a, b)
f x
w
= ( forall a. a -> a -> a -> a -> Digit a
Four a
x1 a
y1 a
z1 a
w1
, forall a. a -> a -> a -> a -> Digit a
Four b
x2 b
y2 b
z2 b
w2)
instance UnzipWith FingerTree where
unzipWith' :: forall x a b.
(x -> (a, b)) -> FingerTree x -> (FingerTree a, FingerTree b)
unzipWith' x -> (a, b)
_ FingerTree x
EmptyT = (forall a. FingerTree a
EmptyT, forall a. FingerTree a
EmptyT)
unzipWith' x -> (a, b)
f (Single x
x)
| (a
x1, b
x2) <- x -> (a, b)
f x
x
= (forall a. a -> FingerTree a
Single a
x1, forall a. a -> FingerTree a
Single b
x2)
unzipWith' x -> (a, b)
f (Deep Int
s Digit x
pr FingerTree (Node x)
m Digit x
sf)
| (!Digit a
pr1, !Digit b
pr2) <- 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) <- forall (f :: * -> *) x a b.
UnzipWith f =>
(x -> (a, b)) -> f x -> (f a, f b)
unzipWith' x -> (a, b)
f Digit x
sf
= (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, 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 = forall a b. (a, b) -> (a, b)
strictifyPair forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) x a b.
UnzipWith f =>
(x -> (a, b)) -> f x -> (f a, f b)
unzipWith' (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
(FingerTree (Node a)
m1, FingerTree (Node b)
m2) = (FingerTree (Node a), FingerTree (Node b))
m1m2
instance UnzipWith Seq where
unzipWith' :: forall a b c. (a -> (b, c)) -> Seq a -> (Seq b, Seq c)
unzipWith' x -> (a, b)
_ (Seq FingerTree (Elem x)
EmptyT) = (forall a. Seq a
empty, forall a. Seq a
empty)
unzipWith' x -> (a, b)
f (Seq (Single (Elem x
x)))
| (a
x1, b
x2) <- x -> (a, b)
f x
x
= (forall a. a -> Seq a
singleton a
x1, forall a. a -> Seq a
singleton b
x2)
unzipWith' x -> (a, b)
f (Seq (Deep Int
s Digit (Elem x)
pr FingerTree (Node (Elem x))
m Digit (Elem x)
sf))
| (!Digit (Elem a)
pr1, !Digit (Elem b)
pr2) <- forall (f :: * -> *) x a b.
UnzipWith f =>
(x -> (a, b)) -> f x -> (f a, f b)
unzipWith' (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) <- forall (f :: * -> *) x a b.
UnzipWith f =>
(x -> (a, b)) -> f x -> (f a, f b)
unzipWith' (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
= (forall a. FingerTree (Elem a) -> Seq a
Seq (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), forall a. FingerTree (Elem a) -> Seq a
Seq (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 = forall a b. (a, b) -> (a, b)
strictifyPair forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) x a b.
UnzipWith f =>
(x -> (a, b)) -> f x -> (f a, f b)
unzipWith' (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
(FingerTree (Node (Elem a))
m1, 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 :: forall x a b.
(x -> (a, b)) -> Node (Elem x) -> (Node (Elem a), Node (Elem b))
unzipWithNodeElem x -> (a, b)
f (Node2 Int
s (Elem x
x) (Elem x
y))
| (a
x1, b
x2) <- x -> (a, b)
f x
x
, (a
y1, b
y2) <- x -> (a, b)
f x
y
= ( forall a. Int -> a -> a -> Node a
Node2 Int
s (forall a. a -> Elem a
Elem a
x1) (forall a. a -> Elem a
Elem a
y1)
, forall a. Int -> a -> a -> Node a
Node2 Int
s (forall a. a -> Elem a
Elem b
x2) (forall a. a -> Elem a
Elem b
y2))
unzipWithNodeElem x -> (a, b)
f (Node3 Int
s (Elem x
x) (Elem x
y) (Elem x
z))
| (a
x1, b
x2) <- x -> (a, b)
f x
x
, (a
y1, b
y2) <- x -> (a, b)
f x
y
, (a
z1, b
z2) <- x -> (a, b)
f x
z
= ( forall a. Int -> a -> a -> a -> Node a
Node3 Int
s (forall a. a -> Elem a
Elem a
x1) (forall a. a -> Elem a
Elem a
y1) (forall a. a -> Elem a
Elem a
z1)
, forall a. Int -> a -> a -> a -> Node a
Node3 Int
s (forall a. a -> Elem a
Elem b
x2) (forall a. a -> Elem a
Elem b
y2) (forall a. a -> Elem a
Elem b
z2))
zip :: Seq a -> Seq b -> Seq (a, b)
zip :: forall a b. Seq a -> Seq b -> Seq (a, b)
zip = 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 :: forall a b c. (a -> b -> c) -> Seq a -> Seq b -> Seq c
zipWith a -> b -> c
f Seq a
s1 Seq b
s2 = 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 = forall a. Ord a => a -> a -> a
min (forall a. Seq a -> Int
length Seq a
s1) (forall a. Seq a -> Int
length Seq b
s2)
s1' :: Seq a
s1' = forall a. Int -> Seq a -> Seq a
take Int
minLen Seq a
s1
s2' :: Seq b
s2' = forall a. Int -> Seq a -> Seq a
take Int
minLen Seq b
s2
zipWith' :: (a -> b -> c) -> Seq a -> Seq b -> Seq c
zipWith' :: forall a b c. (a -> b -> c) -> Seq a -> Seq b -> Seq c
zipWith' a -> b -> c
f Seq a
s1 Seq b
s2 = forall s a' b'.
(Int -> s -> (s, s)) -> (s -> a' -> b') -> s -> Seq a' -> Seq b'
splitMap 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))) a
a = a -> b -> c
f a
a b
b
goLeaf Seq b
_ a
_ = forall a. HasCallStack => [Char] -> a
error [Char]
"Data.Sequence.zipWith'.goLeaf internal error: not a singleton"
zip3 :: Seq a -> Seq b -> Seq c -> Seq (a,b,c)
zip3 :: forall a b c. Seq a -> Seq b -> Seq c -> Seq (a, b, c)
zip3 = 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 :: forall a b c d.
(a -> b -> c -> d) -> Seq a -> Seq b -> Seq c -> Seq d
zipWith3 a -> b -> c -> d
f Seq a
s1 Seq b
s2 Seq c
s3 = forall a b c. (a -> b -> c) -> Seq a -> Seq b -> Seq c
zipWith' forall a b. (a -> b) -> a -> b
($) (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 = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [forall a. Seq a -> Int
length Seq a
s1, forall a. Seq a -> Int
length Seq b
s2, forall a. Seq a -> Int
length Seq c
s3]
s1' :: Seq a
s1' = forall a. Int -> Seq a -> Seq a
take Int
minLen Seq a
s1
s2' :: Seq b
s2' = forall a. Int -> Seq a -> Seq a
take Int
minLen Seq b
s2
s3' :: Seq c
s3' = 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' :: forall a b c d.
(a -> b -> c -> d) -> Seq a -> Seq b -> Seq c -> Seq d
zipWith3' a -> b -> c -> d
f Seq a
s1 Seq b
s2 Seq c
s3 = forall a b c. (a -> b -> c) -> Seq a -> Seq b -> Seq c
zipWith' forall a b. (a -> b) -> a -> b
($) (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 :: forall a b c d.
Seq a -> Seq b -> Seq c -> Seq d -> Seq (a, b, c, d)
zip4 = 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 :: forall a b c d e.
(a -> b -> c -> d -> e)
-> Seq a -> Seq b -> Seq c -> Seq d -> Seq e
zipWith4 a -> b -> c -> d -> e
f Seq a
s1 Seq b
s2 Seq c
s3 Seq d
s4 = forall a b c. (a -> b -> c) -> Seq a -> Seq b -> Seq c
zipWith' forall a b. (a -> b) -> a -> b
($) (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 = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [forall a. Seq a -> Int
length Seq a
s1, forall a. Seq a -> Int
length Seq b
s2, forall a. Seq a -> Int
length Seq c
s3, forall a. Seq a -> Int
length Seq d
s4]
s1' :: Seq a
s1' = forall a. Int -> Seq a -> Seq a
take Int
minLen Seq a
s1
s2' :: Seq b
s2' = forall a. Int -> Seq a -> Seq a
take Int
minLen Seq b
s2
s3' :: Seq c
s3' = forall a. Int -> Seq a -> Seq a
take Int
minLen Seq c
s3
s4' :: Seq d
s4' = forall a. Int -> Seq a -> Seq a
take Int
minLen Seq d
s4
fromList2 :: Int -> [a] -> Seq a
fromList2 :: forall a. Int -> [a] -> Seq a
fromList2 Int
n = forall s a. State s a -> s -> a
execState (forall (f :: * -> *) a. Applicative f => Int -> f a -> f (Seq a)
replicateA Int
n (forall s a. (s -> (s, a)) -> State s a
State forall {b}. [b] -> ([b], b)
ht))
where
ht :: [b] -> ([b], b)
ht (b
x:[b]
xs) = ([b]
xs, b
x)
ht [] = forall a. HasCallStack => [Char] -> a
error [Char]
"fromList2: short list"