{-# LANGUAGE CPP #-}
#include "containers.h"
{-# LANGUAGE BangPatterns #-}
#if __GLASGOW_HASKELL__
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE Trustworthy #-}
#endif
#ifdef DEFINE_PATTERN_SYNONYMS
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ViewPatterns #-}
#endif
{-# LANGUAGE PatternGuards #-}

{-# OPTIONS_HADDOCK not-home #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  Data.Sequence.Internal
-- Copyright   :  (c) Ross Paterson 2005
--                (c) Louis Wasserman 2009
--                (c) Bertram Felgenhauer, David Feuer, Ross Paterson, and
--                    Milan Straka 2014
-- License     :  BSD-style
-- Maintainer  :  libraries@haskell.org
-- Portability :  portable
--
--
-- = WARNING
--
-- This module is considered __internal__.
--
-- The Package Versioning Policy __does not apply__.
--
-- The contents of this module may change __in any way whatsoever__
-- and __without any warning__ between minor versions of this package.
--
-- Authors importing this module are expected to track development
-- closely.
--
-- = Description
--
-- General purpose finite sequences.
-- Apart from being finite and having strict operations, sequences
-- also differ from lists in supporting a wider variety of operations
-- efficiently.
--
-- An amortized running time is given for each operation, with \( n \) referring
-- to the length of the sequence and \( i \) being the integral index used by
-- some operations. These bounds hold even in a persistent (shared) setting.
--
-- The implementation uses 2-3 finger trees annotated with sizes,
-- as described in section 4.2 of
--
--    * Ralf Hinze and Ross Paterson,
--      \"Finger trees: a simple general-purpose data structure\",
--      /Journal of Functional Programming/ 16:2 (2006) pp 197-217.
--      <http://staff.city.ac.uk/~ross/papers/FingerTree.html>
--
-- /Note/: Many of these operations have the same names as similar
-- operations on lists in the "Prelude". The ambiguity may be resolved
-- using either qualification or the @hiding@ clause.
--
-- /Warning/: The size of a 'Seq' must not exceed @maxBound::Int@.  Violation
-- of this condition is not detected and if the size limit is exceeded, the
-- behaviour of the sequence is undefined.  This is unlikely to occur in most
-- applications, but some care may be required when using '><', '<*>', '*>', or
-- '>>', particularly repeatedly and particularly in combination with
-- 'replicate' or 'fromFunction'.
--
-- @since 0.5.9
-----------------------------------------------------------------------------

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,

    -- * Construction
    empty,          -- :: Seq a
    singleton,      -- :: a -> Seq a
    (<|),           -- :: a -> Seq a -> Seq a
    (|>),           -- :: Seq a -> a -> Seq a
    (><),           -- :: Seq a -> Seq a -> Seq a
    fromList,       -- :: [a] -> Seq a
    fromFunction,   -- :: Int -> (Int -> a) -> Seq a
    fromArray,      -- :: Ix i => Array i a -> Seq a
    -- ** Repetition
    replicate,      -- :: Int -> a -> Seq a
    replicateA,     -- :: Applicative f => Int -> f a -> f (Seq a)
    replicateM,     -- :: Applicative m => Int -> m a -> m (Seq a)
    cycleTaking,    -- :: Int -> Seq a -> Seq a
    -- ** Iterative construction
    iterateN,       -- :: Int -> (a -> a) -> a -> Seq a
    unfoldr,        -- :: (b -> Maybe (a, b)) -> b -> Seq a
    unfoldl,        -- :: (b -> Maybe (b, a)) -> b -> Seq a
    -- * Deconstruction
    -- | Additional functions for deconstructing sequences are available
    -- via the 'Foldable' instance of 'Seq'.

    -- ** Queries
    null,           -- :: Seq a -> Bool
    length,         -- :: Seq a -> Int
    -- ** Views
    ViewL(..),
    viewl,          -- :: Seq a -> ViewL a
    ViewR(..),
    viewr,          -- :: Seq a -> ViewR a
    -- * Scans
    scanl,          -- :: (a -> b -> a) -> a -> Seq b -> Seq a
    scanl1,         -- :: (a -> a -> a) -> Seq a -> Seq a
    scanr,          -- :: (a -> b -> b) -> b -> Seq a -> Seq b
    scanr1,         -- :: (a -> a -> a) -> Seq a -> Seq a
    -- * Sublists
    tails,          -- :: Seq a -> Seq (Seq a)
    inits,          -- :: Seq a -> Seq (Seq a)
    chunksOf,       -- :: Int -> Seq a -> Seq (Seq a)
    -- ** Sequential searches
    takeWhileL,     -- :: (a -> Bool) -> Seq a -> Seq a
    takeWhileR,     -- :: (a -> Bool) -> Seq a -> Seq a
    dropWhileL,     -- :: (a -> Bool) -> Seq a -> Seq a
    dropWhileR,     -- :: (a -> Bool) -> Seq a -> Seq a
    spanl,          -- :: (a -> Bool) -> Seq a -> (Seq a, Seq a)
    spanr,          -- :: (a -> Bool) -> Seq a -> (Seq a, Seq a)
    breakl,         -- :: (a -> Bool) -> Seq a -> (Seq a, Seq a)
    breakr,         -- :: (a -> Bool) -> Seq a -> (Seq a, Seq a)
    partition,      -- :: (a -> Bool) -> Seq a -> (Seq a, Seq a)
    filter,         -- :: (a -> Bool) -> Seq a -> Seq a
    -- * Indexing
    lookup,         -- :: Int -> Seq a -> Maybe a
    (!?),           -- :: Seq a -> Int -> Maybe a
    index,          -- :: Seq a -> Int -> a
    adjust,         -- :: (a -> a) -> Int -> Seq a -> Seq a
    adjust',        -- :: (a -> a) -> Int -> Seq a -> Seq a
    update,         -- :: Int -> a -> Seq a -> Seq a
    take,           -- :: Int -> Seq a -> Seq a
    drop,           -- :: Int -> Seq a -> Seq a
    insertAt,       -- :: Int -> a -> Seq a -> Seq a
    deleteAt,       -- :: Int -> Seq a -> Seq a
    splitAt,        -- :: Int -> Seq a -> (Seq a, Seq a)
    -- ** Indexing with predicates
    -- | These functions perform sequential searches from the left
    -- or right ends of the sequence, returning indices of matching
    -- elements.
    elemIndexL,     -- :: Eq a => a -> Seq a -> Maybe Int
    elemIndicesL,   -- :: Eq a => a -> Seq a -> [Int]
    elemIndexR,     -- :: Eq a => a -> Seq a -> Maybe Int
    elemIndicesR,   -- :: Eq a => a -> Seq a -> [Int]
    findIndexL,     -- :: (a -> Bool) -> Seq a -> Maybe Int
    findIndicesL,   -- :: (a -> Bool) -> Seq a -> [Int]
    findIndexR,     -- :: (a -> Bool) -> Seq a -> Maybe Int
    findIndicesR,   -- :: (a -> Bool) -> Seq a -> [Int]
    -- * Folds
    -- | General folds are available via the 'Foldable' instance of 'Seq'.
    foldMapWithIndex, -- :: Monoid m => (Int -> a -> m) -> Seq a -> m
    foldlWithIndex, -- :: (b -> Int -> a -> b) -> b -> Seq a -> b
    foldrWithIndex, -- :: (Int -> a -> b -> b) -> b -> Seq a -> b
    -- * Transformations
    mapWithIndex,   -- :: (Int -> a -> b) -> Seq a -> Seq b
    traverseWithIndex, -- :: Applicative f => (Int -> a -> f b) -> Seq a -> f (Seq b)
    reverse,        -- :: Seq a -> Seq a
    intersperse,    -- :: a -> Seq a -> Seq a
    liftA2Seq,      -- :: (a -> b -> c) -> Seq a -> Seq b -> Seq c
    -- ** Zips and unzips
    zip,            -- :: Seq a -> Seq b -> Seq (a, b)
    zipWith,        -- :: (a -> b -> c) -> Seq a -> Seq b -> Seq c
    zip3,           -- :: Seq a -> Seq b -> Seq c -> Seq (a, b, c)
    zipWith3,       -- :: (a -> b -> c -> d) -> Seq a -> Seq b -> Seq c -> Seq d
    zip4,           -- :: Seq a -> Seq b -> Seq c -> Seq d -> Seq (a, b, c, d)
    zipWith4,       -- :: (a -> b -> c -> d -> e) -> Seq a -> Seq b -> Seq c -> Seq d -> Seq e
    unzip,          -- :: Seq (a, b) -> (Seq a, Seq b)
    unzipWith,      -- :: (a -> (b, c)) -> Seq a -> (Seq b, Seq c)
#ifdef TESTING
    deep,
    node2,
    node3,
#endif
    ) where

import Prelude hiding (
    Functor(..),
#if MIN_VERSION_base(4,11,0)
    (<>),
#endif
#if MIN_VERSION_base(4,8,0)
    Applicative, (<$>), foldMap, Monoid,
#endif
    null, length, lookup, take, drop, splitAt, foldl, foldl1, foldr, foldr1,
    scanl, scanl1, scanr, scanr1, replicate, zip, zipWith, zip3, zipWith3,
    unzip, takeWhile, dropWhile, iterate, reverse, filter, mapM, sum, all)
import qualified Data.List
import Control.Applicative (Applicative(..), (<$>), (<**>),  Alternative,
                            liftA2, liftA3)
import qualified Control.Applicative as Applicative
import Control.DeepSeq (NFData(rnf))
import Control.Monad (MonadPlus(..))
import Data.Monoid (Monoid(..))
import Data.Functor (Functor(..))
import Utils.Containers.Internal.State (State(..), execState)
import Data.Foldable (Foldable(foldl, foldl1, foldr, foldr1, foldMap, foldl', foldr'), toList)

#if MIN_VERSION_base(4,9,0)
import qualified Data.Semigroup as Semigroup
import Data.Functor.Classes
#endif
import Data.Traversable
import Data.Typeable

-- GHC specific stuff
#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

-- Array stuff, with GHC.Arr on GHC
import Data.Array (Ix, Array)
import qualified Data.Array
#ifdef __GLASGOW_HASKELL__
import qualified GHC.Arr
#endif

import Utils.Containers.Internal.Coercions ((.#), (.^#))
-- Coercion on GHC 7.8+
#if __GLASGOW_HASKELL__ >= 708
import Data.Coerce
import qualified GHC.Exts
#else
#endif

-- Identity functor on base 4.8 (GHC 7.10+)
#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 ()

-- We define our own copy here, for Monoid only, even though this
-- is now a Semigroup operator in base. The essential reason is that
-- we have absolutely no use for semigroups in this module. Everything
-- that needs to sum things up requires a Monoid constraint to deal
-- with empty sequences. I'm not sure if there's a risk of walking
-- through dictionaries to reach <> from Monoid, but I see no reason
-- to risk it.
infixr 6 <>
(<>) :: Monoid m => m -> m -> m
<> :: m -> m -> m
(<>) = m -> m -> m
forall a. Monoid a => a -> a -> a
Evidence bound by a type signature of the constraint type Monoid 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

-- | A bidirectional pattern synonym matching an empty sequence.
--
-- @since 0.5.8
pattern Empty :: Seq a
pattern $bEmpty :: Seq a
$mEmpty :: forall {r} {a}. Seq a -> (Void# -> r) -> (Void# -> r) -> r
Empty = Seq EmptyT

-- | A bidirectional pattern synonym viewing the front of a non-empty
-- sequence.
--
-- @since 0.5.8
pattern (:<|) :: a -> Seq a -> Seq a
pattern x $b:<| :: a -> Seq a -> Seq a
$m:<| :: forall {r} {a}. Seq a -> (a -> Seq a -> r) -> (Void# -> r) -> r
:<| xs <- (viewl -> x :< xs)
  where
    a
x :<| Seq a
xs = a
x a -> Seq a -> Seq a
forall a. a -> Seq a -> Seq a
<| Seq a
xs

-- | A bidirectional pattern synonym viewing the rear of a non-empty
-- sequence.
--
-- @since 0.5.8
pattern (:|>) :: Seq a -> a -> Seq a
pattern xs $b:|> :: Seq a -> a -> Seq a
$m:|> :: forall {r} {a}. Seq a -> (Seq a -> a -> r) -> (Void# -> r) -> r
:|> x <- (viewr -> xs :> x)
  where
    Seq a
xs :|> a
x = Seq a
xs Seq a -> a -> Seq a
forall a. Seq a -> a -> Seq a
|> a
x
#endif

class Sized a where
    size :: a -> Int

-- In much the same way that Sized lets us handle the
-- sizes of elements and nodes uniformly, MaybeForce lets
-- us handle their strictness (or lack thereof) uniformly.
-- We can `mseq` something and not have to worry about
-- whether it's an element or a node.
class MaybeForce a where
  maybeRwhnf :: a -> ()

mseq :: MaybeForce a => a -> b -> b
mseq :: a -> b -> b
mseq a
a b
b = case a -> ()
forall a. MaybeForce a => a -> ()
Evidence bound by a type signature of the constraint type MaybeForce a
maybeRwhnf a
a of () -> b
b
{-# INLINE mseq #-}

infixr 0 $!?
($!?) :: MaybeForce a => (a -> b) -> a -> b
a -> b
f $!? :: (a -> b) -> a -> b
$!? a
a = case a -> ()
forall a. MaybeForce a => a -> ()
Evidence bound by a type signature of the constraint type MaybeForce 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 #-}

-- A wrapper making mseq = seq
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

-- | General-purpose finite sequences.
newtype Seq a = Seq (FingerTree (Elem a))

instance Functor Seq where
    fmap :: (a -> b) -> Seq a -> Seq b
fmap = (a -> b) -> Seq a -> Seq b
forall a b. (a -> b) -> Seq a -> Seq b
fmapSeq
#ifdef __GLASGOW_HASKELL__
    a
x <$ :: a -> Seq b -> Seq a
<$ Seq b
s = Int -> a -> Seq a
forall a. Int -> a -> Seq a
replicate (Seq b -> Int
forall a. Seq a -> Int
length Seq b
s) a
x
#endif

fmapSeq :: (a -> b) -> Seq a -> Seq b
fmapSeq :: (a -> b) -> Seq a -> Seq b
fmapSeq a -> b
f (Seq FingerTree (Elem a)
xs) = FingerTree (Elem b) -> Seq b
forall a. FingerTree (Elem a) -> Seq a
Seq ((Elem a -> Elem b) -> FingerTree (Elem a) -> FingerTree (Elem b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Instance of class: Functor of the constraint type Functor FingerTree
fmap ((a -> b) -> Elem a -> Elem b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Instance of class: Functor of the constraint type Functor Elem
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
-- Safe coercions were introduced in 7.8, but did not work well with RULES yet.
{-# RULES
"fmapSeq/coerce" fmapSeq coerce = coerce
 #-}
#endif

getSeq :: Seq a -> FingerTree (Elem a)
getSeq :: Seq a -> FingerTree (Elem a)
getSeq (Seq FingerTree (Elem a)
xs) = FingerTree (Elem a)
xs

instance Foldable Seq where
    foldMap :: (a -> m) -> Seq a -> m
foldMap a -> m
f = (Elem a -> m) -> FingerTree (Elem a) -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
Evidence bound by a type signature of the constraint type Monoid m
Instance of class: Foldable of the constraint type Foldable FingerTree
foldMap (a -> m
f (a -> m) -> (Elem a -> a) -> Elem a -> m
forall b a c. Coercible b a => (b -> c) -> (a -> b) -> a -> c
.# Elem a -> a
forall a. Elem a -> a
getElem) (FingerTree (Elem a) -> m)
-> (Seq a -> FingerTree (Elem a)) -> Seq a -> m
forall b a c. Coercible b a => (b -> c) -> (a -> b) -> a -> c
.# Seq a -> FingerTree (Elem a)
forall a. Seq a -> FingerTree (Elem a)
getSeq
    foldr :: (a -> b -> b) -> b -> Seq a -> b
foldr a -> b -> b
f b
z = (Elem a -> b -> b) -> b -> FingerTree (Elem a) -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
Instance of class: Foldable of the constraint type Foldable FingerTree
foldr (a -> b -> b
f (a -> b -> b) -> (Elem a -> a) -> Elem a -> b -> b
forall b a c. Coercible b a => (b -> c) -> (a -> b) -> a -> c
.# Elem a -> a
forall a. Elem a -> a
getElem) b
z (FingerTree (Elem a) -> b)
-> (Seq a -> FingerTree (Elem a)) -> Seq a -> b
forall b a c. Coercible b a => (b -> c) -> (a -> b) -> a -> c
.# Seq a -> FingerTree (Elem a)
forall a. Seq a -> FingerTree (Elem a)
getSeq
    foldl :: (b -> a -> b) -> b -> Seq a -> b
foldl b -> a -> b
f b
z = (b -> Elem a -> b) -> b -> FingerTree (Elem a) -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Instance of class: Foldable of the constraint type Foldable FingerTree
foldl (b -> a -> b
f (b -> a -> b) -> (Elem a -> a) -> b -> Elem a -> b
forall c b a d.
Coercible c b =>
(a -> c -> d) -> (b -> c) -> a -> b -> d
.^# Elem a -> a
forall a. Elem a -> a
getElem) b
z (FingerTree (Elem a) -> b)
-> (Seq a -> FingerTree (Elem a)) -> Seq a -> b
forall b a c. Coercible b a => (b -> c) -> (a -> b) -> a -> c
.# Seq a -> FingerTree (Elem a)
forall a. Seq a -> FingerTree (Elem a)
getSeq

#if __GLASGOW_HASKELL__
    {-# INLINABLE foldMap #-}
    {-# INLINABLE foldr #-}
    {-# INLINABLE foldl #-}
#endif

    foldr' :: (a -> b -> b) -> b -> Seq a -> b
foldr' a -> b -> b
f b
z = (Elem a -> b -> b) -> b -> FingerTree (Elem a) -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
Instance of class: Foldable of the constraint type Foldable FingerTree
foldr' (a -> b -> b
f (a -> b -> b) -> (Elem a -> a) -> Elem a -> b -> b
forall b a c. Coercible b a => (b -> c) -> (a -> b) -> a -> c
.# Elem a -> a
forall a. Elem a -> a
getElem) b
z (FingerTree (Elem a) -> b)
-> (Seq a -> FingerTree (Elem a)) -> Seq a -> b
forall b a c. Coercible b a => (b -> c) -> (a -> b) -> a -> c
.# Seq a -> FingerTree (Elem a)
forall a. Seq a -> FingerTree (Elem a)
getSeq
    foldl' :: (b -> a -> b) -> b -> Seq a -> b
foldl' b -> a -> b
f b
z = (b -> Elem a -> b) -> b -> FingerTree (Elem a) -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Instance of class: Foldable of the constraint type Foldable FingerTree
foldl' (b -> a -> b
f (b -> a -> b) -> (Elem a -> a) -> b -> Elem a -> b
forall c b a d.
Coercible c b =>
(a -> c -> d) -> (b -> c) -> a -> b -> d
.^# Elem a -> a
forall a. Elem a -> a
getElem) b
z (FingerTree (Elem a) -> b)
-> (Seq a -> FingerTree (Elem a)) -> Seq a -> b
forall b a c. Coercible b a => (b -> c) -> (a -> b) -> a -> c
.# Seq a -> FingerTree (Elem a)
forall a. Seq a -> FingerTree (Elem a)
getSeq

#if __GLASGOW_HASKELL__
    {-# INLINABLE foldr' #-}
    {-# INLINABLE foldl' #-}
#endif

    foldr1 :: (a -> a -> a) -> Seq a -> a
foldr1 a -> a -> a
f (Seq FingerTree (Elem a)
xs) = Elem a -> a
forall a. Elem a -> a
getElem ((Elem a -> Elem a -> Elem a) -> FingerTree (Elem a) -> Elem a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
Instance of class: Foldable of the constraint type Foldable FingerTree
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) = a -> Elem a
forall a. a -> Elem a
Elem (a -> a -> a
f a
x a
y)

    foldl1 :: (a -> a -> a) -> Seq a -> a
foldl1 a -> a -> a
f (Seq FingerTree (Elem a)
xs) = Elem a -> a
forall a. Elem a -> a
getElem ((Elem a -> Elem a -> Elem a) -> FingerTree (Elem a) -> Elem a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
Instance of class: Foldable of the constraint type Foldable FingerTree
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) = a -> Elem a
forall a. a -> Elem a
Elem (a -> a -> a
f a
x a
y)

#if MIN_VERSION_base(4,8,0)
    length :: Seq a -> Int
length = Seq a -> Int
forall a. Seq a -> Int
length
    {-# INLINE length #-}
    null :: Seq a -> Bool
null   = Seq a -> Bool
forall a. Seq a -> Bool
null
    {-# INLINE null #-}
#endif

instance Traversable Seq where
#if __GLASGOW_HASKELL__
    {-# INLINABLE traverse #-}
#endif
    traverse :: (a -> f b) -> Seq a -> f (Seq b)
traverse a -> f b
_ (Seq FingerTree (Elem a)
EmptyT) = Seq b -> f (Seq b)
forall (f :: * -> *) a. Applicative f => a -> f a
Evidence bound by a type signature of the constraint type Applicative f
pure (FingerTree (Elem b) -> Seq b
forall a. FingerTree (Elem a) -> Seq a
Seq FingerTree (Elem b)
forall a. FingerTree a
EmptyT)
    traverse a -> f b
f' (Seq (Single (Elem a
x'))) =
        (\b
x'' -> FingerTree (Elem b) -> Seq b
forall a. FingerTree (Elem a) -> Seq a
Seq (Elem b -> FingerTree (Elem b)
forall a. a -> FingerTree a
Single (b -> Elem b
forall a. a -> Elem a
Elem b
x''))) (b -> Seq b) -> f b -> f (Seq b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
External instance of the constraint type forall (f :: * -> *). Applicative f => Functor f
Evidence bound by a type signature of the constraint type Applicative f
<$> 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')) =
        (Digit (Elem b)
 -> FingerTree (Node (Elem b)) -> Digit (Elem b) -> Seq b)
-> f (Digit (Elem b))
-> f (FingerTree (Node (Elem b)))
-> f (Digit (Elem b))
-> f (Seq b)
forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
Evidence bound by a type signature of the constraint type Applicative f
liftA3
            (\Digit (Elem b)
pr'' FingerTree (Node (Elem b))
m'' Digit (Elem b)
sf'' -> FingerTree (Elem b) -> Seq b
forall a. FingerTree (Elem a) -> Seq a
Seq (Int
-> Digit (Elem b)
-> FingerTree (Node (Elem b))
-> Digit (Elem b)
-> FingerTree (Elem b)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
s' Digit (Elem b)
pr'' FingerTree (Node (Elem b))
m'' Digit (Elem b)
sf''))
            ((a -> f b) -> Digit (Elem a) -> f (Digit (Elem b))
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Digit (Elem a) -> f (Digit (Elem b))
Evidence bound by a type signature of the constraint type Applicative f
traverseDigitE a -> f b
f' Digit (Elem a)
pr')
            ((Node (Elem a) -> f (Node (Elem b)))
-> FingerTree (Node (Elem a)) -> f (FingerTree (Node (Elem b)))
forall (f :: * -> *) a b.
Applicative f =>
(Node a -> f (Node b))
-> FingerTree (Node a) -> f (FingerTree (Node b))
Evidence bound by a type signature of the constraint type Applicative f
traverseTree ((a -> f b) -> Node (Elem a) -> f (Node (Elem b))
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Node (Elem a) -> f (Node (Elem b))
Evidence bound by a type signature of the constraint type Applicative f
traverseNodeE a -> f b
f') FingerTree (Node (Elem a))
m')
            ((a -> f b) -> Digit (Elem a) -> f (Digit (Elem b))
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Digit (Elem a) -> f (Digit (Elem b))
Evidence bound by a type signature of the constraint type Applicative f
traverseDigitE a -> f b
f' Digit (Elem a)
sf')
      where
        traverseTree
            :: Applicative f
            => (Node a -> f (Node b))
            -> FingerTree (Node a)
            -> f (FingerTree (Node b))
        traverseTree :: (Node a -> f (Node b))
-> FingerTree (Node a) -> f (FingerTree (Node b))
traverseTree Node a -> f (Node b)
_ FingerTree (Node a)
EmptyT = FingerTree (Node b) -> f (FingerTree (Node b))
forall (f :: * -> *) a. Applicative f => a -> f a
Evidence bound by a type signature of the constraint type Applicative f
pure FingerTree (Node b)
forall a. FingerTree a
EmptyT
        traverseTree Node a -> f (Node b)
f (Single Node a
x) = Node b -> FingerTree (Node b)
forall a. a -> FingerTree a
Single (Node b -> FingerTree (Node b))
-> f (Node b) -> f (FingerTree (Node b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
External instance of the constraint type forall (f :: * -> *). Applicative f => Functor f
Evidence bound by a type signature of the constraint type Applicative f
<$> 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) =
            (Digit (Node b)
 -> FingerTree (Node (Node b))
 -> Digit (Node b)
 -> FingerTree (Node b))
-> f (Digit (Node b))
-> f (FingerTree (Node (Node b)))
-> f (Digit (Node b))
-> f (FingerTree (Node b))
forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
Evidence bound by a type signature of the constraint type Applicative f
liftA3
                (Int
-> Digit (Node b)
-> FingerTree (Node (Node b))
-> Digit (Node b)
-> FingerTree (Node b)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
s)
                ((Node a -> f (Node b)) -> Digit (Node a) -> f (Digit (Node b))
forall (f :: * -> *) a b.
Applicative f =>
(Node a -> f (Node b)) -> Digit (Node a) -> f (Digit (Node b))
Evidence bound by a type signature of the constraint type Applicative f
traverseDigitN Node a -> f (Node b)
f Digit (Node a)
pr)
                ((Node (Node a) -> f (Node (Node b)))
-> FingerTree (Node (Node a)) -> f (FingerTree (Node (Node b)))
forall (f :: * -> *) a b.
Applicative f =>
(Node a -> f (Node b))
-> FingerTree (Node a) -> f (FingerTree (Node b))
Evidence bound by a type signature of the constraint type Applicative f
traverseTree ((Node a -> f (Node b)) -> Node (Node a) -> f (Node (Node b))
forall (f :: * -> *) a b.
Applicative f =>
(Node a -> f (Node b)) -> Node (Node a) -> f (Node (Node b))
Evidence bound by a type signature of the constraint type Applicative f
traverseNodeN Node a -> f (Node b)
f) FingerTree (Node (Node a))
m)
                ((Node a -> f (Node b)) -> Digit (Node a) -> f (Digit (Node b))
forall (f :: * -> *) a b.
Applicative f =>
(Node a -> f (Node b)) -> Digit (Node a) -> f (Digit (Node b))
Evidence bound by a type signature of the constraint type Applicative f
traverseDigitN Node a -> f (Node b)
f Digit (Node a)
sf)
        traverseDigitE
            :: Applicative f
            => (a -> f b) -> Digit (Elem a) -> f (Digit (Elem b))
        traverseDigitE :: (a -> f b) -> Digit (Elem a) -> f (Digit (Elem b))
traverseDigitE a -> f b
f (One (Elem a
a)) =
            (\b
a' -> Elem b -> Digit (Elem b)
forall a. a -> Digit a
One (b -> Elem b
forall a. a -> Elem a
Elem b
a')) (b -> Digit (Elem b)) -> f b -> f (Digit (Elem b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
External instance of the constraint type forall (f :: * -> *). Applicative f => Functor f
Evidence bound by a type signature of the constraint type Applicative f
<$>
            a -> f b
f a
a
        traverseDigitE a -> f b
f (Two (Elem a
a) (Elem a
b)) =
            (b -> b -> Digit (Elem b)) -> f b -> f b -> f (Digit (Elem b))
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
Evidence bound by a type signature of the constraint type Applicative f
liftA2
                (\b
a' b
b' -> Elem b -> Elem b -> Digit (Elem b)
forall a. a -> a -> Digit a
Two (b -> Elem b
forall a. a -> Elem a
Elem b
a') (b -> Elem b
forall a. a -> Elem a
Elem b
b'))
                (a -> f b
f a
a)
                (a -> f b
f a
b)
        traverseDigitE a -> f b
f (Three (Elem a
a) (Elem a
b) (Elem a
c)) =
            (b -> b -> b -> Digit (Elem b))
-> f b -> f b -> f b -> f (Digit (Elem b))
forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
Evidence bound by a type signature of the constraint type Applicative f
liftA3
                (\b
a' b
b' b
c' ->
                      Elem b -> Elem b -> Elem b -> Digit (Elem b)
forall a. a -> a -> a -> Digit a
Three (b -> Elem b
forall a. a -> Elem a
Elem b
a') (b -> Elem b
forall a. a -> Elem a
Elem b
b') (b -> Elem b
forall a. a -> Elem a
Elem b
c'))
                (a -> f b
f a
a)
                (a -> f b
f a
b)
                (a -> f b
f a
c)
        traverseDigitE a -> f b
f (Four (Elem a
a) (Elem a
b) (Elem a
c) (Elem a
d)) =
            (b -> b -> b -> b -> Digit (Elem b))
-> f b -> f b -> f b -> f (b -> Digit (Elem b))
forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
Evidence bound by a type signature of the constraint type Applicative f
liftA3
                (\b
a' b
b' b
c' b
d' -> Elem b -> Elem b -> Elem b -> Elem b -> Digit (Elem b)
forall a. a -> a -> a -> a -> Digit a
Four (b -> Elem b
forall a. a -> Elem a
Elem b
a') (b -> Elem b
forall a. a -> Elem a
Elem b
b') (b -> Elem b
forall a. a -> Elem a
Elem b
c') (b -> Elem b
forall a. a -> Elem a
Elem b
d'))
                (a -> f b
f a
a)
                (a -> f b
f a
b)
                (a -> f b
f a
c) f (b -> Digit (Elem b)) -> f b -> f (Digit (Elem b))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Evidence bound by a type signature of the constraint type Applicative f
<*> 
                (a -> f b
f a
d)
        traverseDigitN
            :: Applicative f
            => (Node a -> f (Node b)) -> Digit (Node a) -> f (Digit (Node b))
        traverseDigitN :: (Node a -> f (Node b)) -> Digit (Node a) -> f (Digit (Node b))
traverseDigitN Node a -> f (Node b)
f Digit (Node a)
t = (Node a -> f (Node b)) -> Digit (Node a) -> f (Digit (Node b))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
Evidence bound by a type signature of the constraint type Applicative f
Instance of class: Traversable of the constraint type Traversable Digit
traverse Node a -> f (Node b)
f Digit (Node a)
t
        traverseNodeE
            :: Applicative f
            => (a -> f b) -> Node (Elem a) -> f (Node (Elem b))
        traverseNodeE :: (a -> f b) -> Node (Elem a) -> f (Node (Elem b))
traverseNodeE a -> f b
f (Node2 Int
s (Elem a
a) (Elem a
b)) =
            (b -> b -> Node (Elem b)) -> f b -> f b -> f (Node (Elem b))
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
Evidence bound by a type signature of the constraint type Applicative f
liftA2
                (\b
a' b
b' -> Int -> Elem b -> Elem b -> Node (Elem b)
forall a. Int -> a -> a -> Node a
Node2 Int
s (b -> Elem b
forall a. a -> Elem a
Elem b
a') (b -> Elem b
forall a. a -> Elem a
Elem b
b'))
                (a -> f b
f a
a)
                (a -> f b
f a
b)
        traverseNodeE a -> f b
f (Node3 Int
s (Elem a
a) (Elem a
b) (Elem a
c)) =
            (b -> b -> b -> Node (Elem b))
-> f b -> f b -> f b -> f (Node (Elem b))
forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
Evidence bound by a type signature of the constraint type Applicative f
liftA3
                (\b
a' b
b' b
c' ->
                      Int -> Elem b -> Elem b -> Elem b -> Node (Elem b)
forall a. Int -> a -> a -> a -> Node a
Node3 Int
s (b -> Elem b
forall a. a -> Elem a
Elem b
a') (b -> Elem b
forall a. a -> Elem a
Elem b
b') (b -> Elem b
forall a. a -> Elem a
Elem b
c'))
                (a -> f b
f a
a)
                (a -> f b
f a
b)
                (a -> f b
f a
c)
        traverseNodeN
            :: Applicative f
            => (Node a -> f (Node b)) -> Node (Node a) -> f (Node (Node b))
        traverseNodeN :: (Node a -> f (Node b)) -> Node (Node a) -> f (Node (Node b))
traverseNodeN Node a -> f (Node b)
f Node (Node a)
t = (Node a -> f (Node b)) -> Node (Node a) -> f (Node (Node b))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
Evidence bound by a type signature of the constraint type Applicative f
Instance of class: Traversable of the constraint type Traversable Node
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) = FingerTree (Elem a) -> ()
forall a. NFData a => a -> ()
Instance of class: NFData of the constraint type forall a. NFData a => NFData (FingerTree a)
Instance of class: NFData of the constraint type forall a. NFData a => NFData (Elem a)
Evidence bound by a type signature of the constraint type NFData a
rnf FingerTree (Elem a)
xs

instance Monad Seq where
    return :: a -> Seq a
return = a -> Seq a
forall (f :: * -> *) a. Applicative f => a -> f a
Instance of class: Applicative of the constraint type Applicative Seq
pure
    Seq a
xs >>= :: Seq a -> (a -> Seq b) -> Seq b
>>= a -> Seq b
f = (Seq b -> a -> Seq b) -> Seq b -> Seq a -> Seq b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Instance of class: Foldable of the constraint type Foldable Seq
foldl' Seq b -> a -> Seq b
add Seq b
forall a. Seq a
empty Seq a
xs
      where add :: Seq b -> a -> Seq b
add Seq b
ys a
x = Seq b
ys Seq b -> Seq b -> Seq b
forall a. Seq a -> Seq a -> Seq a
>< a -> Seq b
f a
x
    >> :: Seq a -> Seq b -> Seq b
(>>) = Seq a -> Seq b -> Seq b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
Instance of class: Applicative of the constraint type Applicative Seq
(*>)

-- | @since 0.5.11
instance MonadFix Seq where
    mfix :: (a -> Seq a) -> Seq a
mfix = (a -> Seq a) -> Seq a
forall a. (a -> Seq a) -> Seq a
mfixSeq

-- This is just like the instance for lists, but we can take advantage of
-- constant-time length and logarithmic-time indexing to speed things up.
-- Using fromFunction, we make this about as lazy as we can.
mfixSeq :: (a -> Seq a) -> Seq a
mfixSeq :: (a -> Seq a) -> Seq a
mfixSeq a -> Seq a
f = Int -> (Int -> a) -> Seq a
forall a. Int -> (Int -> a) -> Seq a
fromFunction (Seq a -> Int
forall a. Seq a -> Int
length (a -> Seq a
f a
forall {a}. a
err)) (\Int
k -> (a -> a) -> a
forall a. (a -> a) -> a
fix (\a
xk -> a -> Seq a
f a
xk Seq a -> Int -> a
forall a. Seq a -> Int -> a
`index` Int
k))
  where
    err :: a
err = [Char] -> a
forall a. HasCallStack => [Char] -> a
error [Char]
"mfix for Data.Sequence.Seq applied to strict function"

-- | @since 0.5.4
instance Applicative Seq where
    pure :: a -> Seq a
pure = a -> Seq a
forall a. a -> Seq a
singleton
    Seq a
xs *> :: Seq a -> Seq b -> Seq b
*> Seq b
ys = Int -> Seq b -> Seq b
forall a. Int -> Seq a -> Seq a
cycleNTimes (Seq a -> Int
forall a. Seq a -> Int
length Seq a
xs) Seq b
ys
    <*> :: Seq (a -> b) -> Seq a -> Seq b
(<*>) = Seq (a -> b) -> Seq a -> Seq b
forall a b. Seq (a -> b) -> Seq a -> Seq b
apSeq
#if MIN_VERSION_base(4,10,0)
    liftA2 :: (a -> b -> c) -> Seq a -> Seq b -> Seq c
liftA2 = (a -> b -> c) -> Seq a -> Seq b -> Seq c
forall a b c. (a -> b -> c) -> Seq a -> Seq b -> Seq c
liftA2Seq
#endif

apSeq :: Seq (a -> b) -> Seq a -> Seq b
apSeq :: Seq (a -> b) -> Seq a -> Seq b
apSeq Seq (a -> b)
fs xs :: Seq a
xs@(Seq FingerTree (Elem a)
xsFT) = case Seq (a -> b) -> ViewL (a -> b)
forall a. Seq a -> ViewL a
viewl Seq (a -> b)
fs of
  ViewL (a -> b)
EmptyL -> Seq b
forall a. Seq a
empty
  a -> b
firstf :< Seq (a -> b)
fs' -> case Seq (a -> b) -> ViewR (a -> b)
forall a. Seq a -> ViewR a
viewr Seq (a -> b)
fs' of
    ViewR (a -> b)
EmptyR -> (a -> b) -> Seq a -> Seq b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Instance of class: Functor of the constraint type Functor Seq
fmap a -> b
firstf Seq a
xs
    Seq FingerTree (Elem (a -> b))
fs''FT :> a -> b
lastf -> case FingerTree (Elem a) -> Rigidified (Elem a)
forall a. FingerTree (Elem a) -> Rigidified (Elem a)
rigidify FingerTree (Elem a)
xsFT of
         Rigidified (Elem a)
RigidEmpty -> Seq b
forall a. Seq a
empty
         RigidOne (Elem a
x) -> ((a -> b) -> b) -> Seq (a -> b) -> Seq b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Instance of class: Functor of the constraint type Functor Seq
fmap ((a -> b) -> a -> b
forall a b. (a -> b) -> a -> b
$a
x) Seq (a -> b)
fs
         RigidTwo (Elem a
x1) (Elem a
x2) ->
            FingerTree (Elem b) -> Seq b
forall a. FingerTree (Elem a) -> Seq a
Seq (FingerTree (Elem b) -> Seq b) -> FingerTree (Elem b) -> Seq b
forall a b. (a -> b) -> a -> b
$ (a -> b)
-> FingerTree (Elem (a -> b))
-> (a -> b)
-> (a, a)
-> FingerTree (Elem b)
forall a b.
(a -> b)
-> FingerTree (Elem (a -> b))
-> (a -> b)
-> (a, a)
-> FingerTree (Elem b)
ap2FT a -> b
firstf FingerTree (Elem (a -> b))
fs''FT a -> b
lastf (a
x1, a
x2)
         RigidThree (Elem a
x1) (Elem a
x2) (Elem a
x3) ->
            FingerTree (Elem b) -> Seq b
forall a. FingerTree (Elem a) -> Seq a
Seq (FingerTree (Elem b) -> Seq b) -> FingerTree (Elem b) -> Seq b
forall a b. (a -> b) -> a -> b
$ (a -> b)
-> FingerTree (Elem (a -> b))
-> (a -> b)
-> (a, a, a)
-> FingerTree (Elem b)
forall a b.
(a -> b)
-> FingerTree (Elem (a -> b))
-> (a -> b)
-> (a, a, a)
-> FingerTree (Elem b)
ap3FT a -> b
firstf FingerTree (Elem (a -> b))
fs''FT a -> b
lastf (a
x1, a
x2, a
x3)
         RigidFull r :: Rigid (Elem a)
r@(Rigid Int
s Digit23 (Elem a)
pr Thin (Digit23 (Elem a))
_m Digit23 (Elem a)
sf) -> FingerTree (Elem b) -> Seq b
forall a. FingerTree (Elem a) -> Seq a
Seq (FingerTree (Elem b) -> Seq b) -> FingerTree (Elem b) -> Seq b
forall a b. (a -> b) -> a -> b
$
               Int
-> Digit (Elem b)
-> FingerTree (Node (Elem b))
-> Digit (Elem b)
-> FingerTree (Elem b)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
* Seq (a -> b) -> Int
forall a. Seq a -> Int
length Seq (a -> b)
fs)
                    ((Elem a -> Elem b) -> Digit (Elem a) -> Digit (Elem b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Instance of class: Functor of the constraint type Functor Digit
fmap ((a -> b) -> Elem a -> Elem b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Instance of class: Functor of the constraint type Functor Elem
fmap a -> b
firstf) (Digit23 (Elem a) -> Digit (Elem a)
forall a. Node a -> Digit a
nodeToDigit Digit23 (Elem a)
pr))
                    ((Elem a -> Elem b)
-> (Elem a -> Elem b)
-> ((a -> b) -> Elem a -> Elem b)
-> FingerTree (Elem (a -> b))
-> Rigid (Elem a)
-> FingerTree (Node (Elem b))
forall b c a.
(b -> c)
-> (b -> c)
-> (a -> b -> c)
-> FingerTree (Elem a)
-> Rigid b
-> FingerTree (Node c)
aptyMiddle ((a -> b) -> Elem a -> Elem b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Instance of class: Functor of the constraint type Functor Elem
fmap a -> b
firstf) ((a -> b) -> Elem a -> Elem b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Instance of class: Functor of the constraint type Functor Elem
fmap a -> b
lastf) (a -> b) -> Elem a -> Elem b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Instance of class: Functor of the constraint type Functor Elem
fmap FingerTree (Elem (a -> b))
fs''FT Rigid (Elem a)
r)
                    ((Elem a -> Elem b) -> Digit (Elem a) -> Digit (Elem b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Instance of class: Functor of the constraint type Functor Digit
fmap ((a -> b) -> Elem a -> Elem b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Instance of class: Functor of the constraint type Functor Elem
fmap a -> b
lastf) (Digit23 (Elem a) -> Digit (Elem a)
forall a. Node a -> Digit a
nodeToDigit Digit23 (Elem a)
sf))
{-# NOINLINE [1] apSeq #-}

{-# RULES
"ap/fmap1" forall f xs ys . apSeq (fmapSeq f xs) ys = liftA2Seq f xs ys
"ap/fmap2" forall f gs xs . apSeq gs (fmapSeq f xs) =
                              liftA2Seq (\g x -> g (f x)) gs xs
"fmap/ap" forall f gs xs . fmapSeq f (gs `apSeq` xs) =
                             liftA2Seq (\g x -> f (g x)) gs xs
"fmap/liftA2" forall f g m n . fmapSeq f (liftA2Seq g m n) =
                       liftA2Seq (\x y -> f (g x y)) m n
"liftA2/fmap1" forall f g m n . liftA2Seq f (fmapSeq g m) n =
                       liftA2Seq (\x y -> f (g x) y) m n
"liftA2/fmap2" forall f g m n . liftA2Seq f m (fmapSeq g n) =
                       liftA2Seq (\x y -> f x (g y)) m n
 #-}

ap2FT :: (a -> b) -> FingerTree (Elem (a->b)) -> (a -> b) -> (a,a) -> FingerTree (Elem b)
ap2FT :: (a -> b)
-> FingerTree (Elem (a -> b))
-> (a -> b)
-> (a, a)
-> FingerTree (Elem b)
ap2FT a -> b
firstf FingerTree (Elem (a -> b))
fs a -> b
lastf (a
x,a
y) =
                 Int
-> Digit (Elem b)
-> FingerTree (Node (Elem b))
-> Digit (Elem b)
-> FingerTree (Elem b)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (FingerTree (Elem (a -> b)) -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized a => Sized (FingerTree a)
Instance of class: Sized of the constraint type forall a. Sized (Elem a)
size FingerTree (Elem (a -> b))
fs Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
* Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Int
4)
                      (Elem b -> Elem b -> Digit (Elem b)
forall a. a -> a -> Digit a
Two (b -> Elem b
forall a. a -> Elem a
Elem (b -> Elem b) -> b -> Elem b
forall a b. (a -> b) -> a -> b
$ a -> b
firstf a
x) (b -> Elem b
forall a. a -> Elem a
Elem (b -> Elem b) -> b -> Elem b
forall a b. (a -> b) -> a -> b
$ a -> b
firstf a
y))
                      (Int
-> (Elem (a -> b) -> Node (Elem b))
-> FingerTree (Elem (a -> b))
-> FingerTree (Node (Elem b))
forall a b. Int -> (a -> b) -> FingerTree a -> FingerTree b
mapMulFT Int
2 (\(Elem a -> b
f) -> Int -> Elem b -> Elem b -> Node (Elem b)
forall a. Int -> a -> a -> Node a
Node2 Int
2 (b -> Elem b
forall a. a -> Elem a
Elem (a -> b
f a
x)) (b -> Elem b
forall a. a -> Elem a
Elem (a -> b
f a
y))) FingerTree (Elem (a -> b))
fs)
                      (Elem b -> Elem b -> Digit (Elem b)
forall a. a -> a -> Digit a
Two (b -> Elem b
forall a. a -> Elem a
Elem (b -> Elem b) -> b -> Elem b
forall a b. (a -> b) -> a -> b
$ a -> b
lastf a
x) (b -> Elem b
forall a. a -> Elem a
Elem (b -> Elem b) -> b -> Elem b
forall a b. (a -> b) -> a -> b
$ a -> b
lastf a
y))

ap3FT :: (a -> b) -> FingerTree (Elem (a->b)) -> (a -> b) -> (a,a,a) -> FingerTree (Elem b)
ap3FT :: (a -> b)
-> FingerTree (Elem (a -> b))
-> (a -> b)
-> (a, a, a)
-> FingerTree (Elem b)
ap3FT a -> b
firstf FingerTree (Elem (a -> b))
fs a -> b
lastf (a
x,a
y,a
z) = Int
-> Digit (Elem b)
-> FingerTree (Node (Elem b))
-> Digit (Elem b)
-> FingerTree (Elem b)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (FingerTree (Elem (a -> b)) -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized a => Sized (FingerTree a)
Instance of class: Sized of the constraint type forall a. Sized (Elem a)
size FingerTree (Elem (a -> b))
fs Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
* Int
3 Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Int
6)
                        (Elem b -> Elem b -> Elem b -> Digit (Elem b)
forall a. a -> a -> a -> Digit a
Three (b -> Elem b
forall a. a -> Elem a
Elem (b -> Elem b) -> b -> Elem b
forall a b. (a -> b) -> a -> b
$ a -> b
firstf a
x) (b -> Elem b
forall a. a -> Elem a
Elem (b -> Elem b) -> b -> Elem b
forall a b. (a -> b) -> a -> b
$ a -> b
firstf a
y) (b -> Elem b
forall a. a -> Elem a
Elem (b -> Elem b) -> b -> Elem b
forall a b. (a -> b) -> a -> b
$ a -> b
firstf a
z))
                        (Int
-> (Elem (a -> b) -> Node (Elem b))
-> FingerTree (Elem (a -> b))
-> FingerTree (Node (Elem b))
forall a b. Int -> (a -> b) -> FingerTree a -> FingerTree b
mapMulFT Int
3 (\(Elem a -> b
f) -> Int -> Elem b -> Elem b -> Elem b -> Node (Elem b)
forall a. Int -> a -> a -> a -> Node a
Node3 Int
3 (b -> Elem b
forall a. a -> Elem a
Elem (a -> b
f a
x)) (b -> Elem b
forall a. a -> Elem a
Elem (a -> b
f a
y)) (b -> Elem b
forall a. a -> Elem a
Elem (a -> b
f a
z))) FingerTree (Elem (a -> b))
fs)
                        (Elem b -> Elem b -> Elem b -> Digit (Elem b)
forall a. a -> a -> a -> Digit a
Three (b -> Elem b
forall a. a -> Elem a
Elem (b -> Elem b) -> b -> Elem b
forall a b. (a -> b) -> a -> b
$ a -> b
lastf a
x) (b -> Elem b
forall a. a -> Elem a
Elem (b -> Elem b) -> b -> Elem b
forall a b. (a -> b) -> a -> b
$ a -> b
lastf a
y) (b -> Elem b
forall a. a -> Elem a
Elem (b -> Elem b) -> b -> Elem b
forall a b. (a -> b) -> a -> b
$ a -> b
lastf a
z))

lift2FT :: (a -> b -> c) -> a -> FingerTree (Elem a) -> a -> (b,b) -> FingerTree (Elem c)
lift2FT :: (a -> b -> c)
-> a -> FingerTree (Elem a) -> a -> (b, b) -> FingerTree (Elem c)
lift2FT a -> b -> c
f a
firstx FingerTree (Elem a)
xs a
lastx (b
y1,b
y2) =
                 Int
-> Digit (Elem c)
-> FingerTree (Node (Elem c))
-> Digit (Elem c)
-> FingerTree (Elem c)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (FingerTree (Elem a) -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized a => Sized (FingerTree a)
Instance of class: Sized of the constraint type forall a. Sized (Elem a)
size FingerTree (Elem a)
xs Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
* Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Int
4)
                      (Elem c -> Elem c -> Digit (Elem c)
forall a. a -> a -> Digit a
Two (c -> Elem c
forall a. a -> Elem a
Elem (c -> Elem c) -> c -> Elem c
forall a b. (a -> b) -> a -> b
$ a -> b -> c
f a
firstx b
y1) (c -> Elem c
forall a. a -> Elem a
Elem (c -> Elem c) -> c -> Elem c
forall a b. (a -> b) -> a -> b
$ a -> b -> c
f a
firstx b
y2))
                      (Int
-> (Elem a -> Node (Elem c))
-> FingerTree (Elem a)
-> FingerTree (Node (Elem c))
forall a b. Int -> (a -> b) -> FingerTree a -> FingerTree b
mapMulFT Int
2 (\(Elem a
x) -> Int -> Elem c -> Elem c -> Node (Elem c)
forall a. Int -> a -> a -> Node a
Node2 Int
2 (c -> Elem c
forall a. a -> Elem a
Elem (a -> b -> c
f a
x b
y1)) (c -> Elem c
forall a. a -> Elem a
Elem (a -> b -> c
f a
x b
y2))) FingerTree (Elem a)
xs)
                      (Elem c -> Elem c -> Digit (Elem c)
forall a. a -> a -> Digit a
Two (c -> Elem c
forall a. a -> Elem a
Elem (c -> Elem c) -> c -> Elem c
forall a b. (a -> b) -> a -> b
$ a -> b -> c
f a
lastx b
y1) (c -> Elem c
forall a. a -> Elem a
Elem (c -> Elem c) -> c -> Elem c
forall a b. (a -> b) -> a -> b
$ a -> b -> c
f a
lastx b
y2))

lift3FT :: (a -> b -> c) -> a -> FingerTree (Elem a) -> a -> (b,b,b) -> FingerTree (Elem c)
lift3FT :: (a -> b -> c)
-> a
-> FingerTree (Elem a)
-> a
-> (b, b, b)
-> FingerTree (Elem c)
lift3FT a -> b -> c
f a
firstx FingerTree (Elem a)
xs a
lastx (b
y1,b
y2,b
y3) =
                 Int
-> Digit (Elem c)
-> FingerTree (Node (Elem c))
-> Digit (Elem c)
-> FingerTree (Elem c)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (FingerTree (Elem a) -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized a => Sized (FingerTree a)
Instance of class: Sized of the constraint type forall a. Sized (Elem a)
size FingerTree (Elem a)
xs Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
* Int
3 Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Int
6)
                      (Elem c -> Elem c -> Elem c -> Digit (Elem c)
forall a. a -> a -> a -> Digit a
Three (c -> Elem c
forall a. a -> Elem a
Elem (c -> Elem c) -> c -> Elem c
forall a b. (a -> b) -> a -> b
$ a -> b -> c
f a
firstx b
y1) (c -> Elem c
forall a. a -> Elem a
Elem (c -> Elem c) -> c -> Elem c
forall a b. (a -> b) -> a -> b
$ a -> b -> c
f a
firstx b
y2) (c -> Elem c
forall a. a -> Elem a
Elem (c -> Elem c) -> c -> Elem c
forall a b. (a -> b) -> a -> b
$ a -> b -> c
f a
firstx b
y3))
                      (Int
-> (Elem a -> Node (Elem c))
-> FingerTree (Elem a)
-> FingerTree (Node (Elem c))
forall a b. Int -> (a -> b) -> FingerTree a -> FingerTree b
mapMulFT Int
3 (\(Elem a
x) -> Int -> Elem c -> Elem c -> Elem c -> Node (Elem c)
forall a. Int -> a -> a -> a -> Node a
Node3 Int
3 (c -> Elem c
forall a. a -> Elem a
Elem (a -> b -> c
f a
x b
y1)) (c -> Elem c
forall a. a -> Elem a
Elem (a -> b -> c
f a
x b
y2)) (c -> Elem c
forall a. a -> Elem a
Elem (a -> b -> c
f a
x b
y3))) FingerTree (Elem a)
xs)
                      (Elem c -> Elem c -> Elem c -> Digit (Elem c)
forall a. a -> a -> a -> Digit a
Three (c -> Elem c
forall a. a -> Elem a
Elem (c -> Elem c) -> c -> Elem c
forall a b. (a -> b) -> a -> b
$ a -> b -> c
f a
lastx b
y1) (c -> Elem c
forall a. a -> Elem a
Elem (c -> Elem c) -> c -> Elem c
forall a b. (a -> b) -> a -> b
$ a -> b -> c
f a
lastx b
y2) (c -> Elem c
forall a. a -> Elem a
Elem (c -> Elem c) -> c -> Elem c
forall a b. (a -> b) -> a -> b
$ a -> b -> c
f a
lastx b
y3))

liftA2Seq :: (a -> b -> c) -> Seq a -> Seq b -> Seq c
liftA2Seq :: (a -> b -> c) -> Seq a -> Seq b -> Seq c
liftA2Seq a -> b -> c
f Seq a
xs ys :: Seq b
ys@(Seq FingerTree (Elem b)
ysFT) = case Seq a -> ViewL a
forall a. Seq a -> ViewL a
viewl Seq a
xs of
  ViewL a
EmptyL -> Seq c
forall a. Seq a
empty
  a
firstx :< Seq a
xs' -> case Seq a -> ViewR a
forall a. Seq a -> ViewR a
viewr Seq a
xs' of
    ViewR a
EmptyR -> a -> b -> c
f a
firstx (b -> c) -> Seq b -> Seq c
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Instance of class: Functor of the constraint type Functor Seq
<$> Seq b
ys
    Seq FingerTree (Elem a)
xs''FT :> a
lastx -> case FingerTree (Elem b) -> Rigidified (Elem b)
forall a. FingerTree (Elem a) -> Rigidified (Elem a)
rigidify FingerTree (Elem b)
ysFT of
      Rigidified (Elem b)
RigidEmpty -> Seq c
forall a. Seq a
empty
      RigidOne (Elem b
y) -> (a -> c) -> Seq a -> Seq c
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Instance of class: Functor of the constraint type Functor Seq
fmap (\a
x -> a -> b -> c
f a
x b
y) Seq a
xs
      RigidTwo (Elem b
y1) (Elem b
y2) ->
        FingerTree (Elem c) -> Seq c
forall a. FingerTree (Elem a) -> Seq a
Seq (FingerTree (Elem c) -> Seq c) -> FingerTree (Elem c) -> Seq c
forall a b. (a -> b) -> a -> b
$ (a -> b -> c)
-> a -> FingerTree (Elem a) -> a -> (b, b) -> FingerTree (Elem c)
forall a b c.
(a -> b -> c)
-> a -> FingerTree (Elem a) -> a -> (b, b) -> FingerTree (Elem c)
lift2FT a -> b -> c
f a
firstx FingerTree (Elem a)
xs''FT a
lastx (b
y1, b
y2)
      RigidThree (Elem b
y1) (Elem b
y2) (Elem b
y3) ->
        FingerTree (Elem c) -> Seq c
forall a. FingerTree (Elem a) -> Seq a
Seq (FingerTree (Elem c) -> Seq c) -> FingerTree (Elem c) -> Seq c
forall a b. (a -> b) -> a -> b
$ (a -> b -> c)
-> a
-> FingerTree (Elem a)
-> a
-> (b, b, b)
-> FingerTree (Elem c)
forall a b c.
(a -> b -> c)
-> a
-> FingerTree (Elem a)
-> a
-> (b, b, b)
-> FingerTree (Elem c)
lift3FT a -> b -> c
f a
firstx FingerTree (Elem a)
xs''FT a
lastx (b
y1, b
y2, b
y3)
      RigidFull r :: Rigid (Elem b)
r@(Rigid Int
s Digit23 (Elem b)
pr Thin (Digit23 (Elem b))
_m Digit23 (Elem b)
sf) -> FingerTree (Elem c) -> Seq c
forall a. FingerTree (Elem a) -> Seq a
Seq (FingerTree (Elem c) -> Seq c) -> FingerTree (Elem c) -> Seq c
forall a b. (a -> b) -> a -> b
$
        Int
-> Digit (Elem c)
-> FingerTree (Node (Elem c))
-> Digit (Elem c)
-> FingerTree (Elem c)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
* Seq a -> Int
forall a. Seq a -> Int
length Seq a
xs)
             ((Elem b -> Elem c) -> Digit (Elem b) -> Digit (Elem c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Instance of class: Functor of the constraint type Functor Digit
fmap ((b -> c) -> Elem b -> Elem c
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Instance of class: Functor of the constraint type Functor Elem
fmap (a -> b -> c
f a
firstx)) (Digit23 (Elem b) -> Digit (Elem b)
forall a. Node a -> Digit a
nodeToDigit Digit23 (Elem b)
pr))
             ((Elem b -> Elem c)
-> (Elem b -> Elem c)
-> (a -> Elem b -> Elem c)
-> FingerTree (Elem a)
-> Rigid (Elem b)
-> FingerTree (Node (Elem c))
forall b c a.
(b -> c)
-> (b -> c)
-> (a -> b -> c)
-> FingerTree (Elem a)
-> Rigid b
-> FingerTree (Node c)
aptyMiddle ((b -> c) -> Elem b -> Elem c
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Instance of class: Functor of the constraint type Functor Elem
fmap (a -> b -> c
f a
firstx)) ((b -> c) -> Elem b -> Elem c
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Instance of class: Functor of the constraint type Functor Elem
fmap (a -> b -> c
f a
lastx)) ((a -> b -> c) -> a -> Elem b -> Elem c
forall a b c. (a -> b -> c) -> a -> Elem b -> Elem c
lift_elem a -> b -> c
f) FingerTree (Elem a)
xs''FT Rigid (Elem b)
r)
             ((Elem b -> Elem c) -> Digit (Elem b) -> Digit (Elem c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Instance of class: Functor of the constraint type Functor Digit
fmap ((b -> c) -> Elem b -> Elem c
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Instance of class: Functor of the constraint type Functor Elem
fmap (a -> b -> c
f a
lastx)) (Digit23 (Elem b) -> Digit (Elem b)
forall a. Node a -> Digit a
nodeToDigit Digit23 (Elem b)
sf))
  where
    lift_elem :: (a -> b -> c) -> a -> Elem b -> Elem c
#if __GLASGOW_HASKELL__ >= 708
    lift_elem :: (a -> b -> c) -> a -> Elem b -> Elem c
lift_elem = (a -> b -> c) -> a -> Elem b -> Elem c
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

-- | A finger tree whose top level has only Two and/or Three digits, and whose
-- other levels have only One and Two digits. A Rigid tree is precisely what one
-- gets by unzipping/inverting a 2-3 tree, so it is precisely what we need to
-- turn a finger tree into in order to transform it into a 2-3 tree.
data Rigid a = Rigid {-# UNPACK #-} !Int !(Digit23 a) (Thin (Node a)) !(Digit23 a)
#ifdef TESTING
             deriving Show
#endif

-- | A finger tree whose digits are all ones and twos
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

-- | Sometimes, we want to emphasize that we are viewing a node as a top-level
-- digit of a 'Rigid' tree.
type Digit23 a = Node a

-- | 'aptyMiddle' does most of the hard work of computing @fs<*>xs@.  It
-- produces the center part of a finger tree, with a prefix corresponding to
-- the prefix of @xs@ and a suffix corresponding to the suffix of @xs@ omitted;
-- the missing suffix and prefix are added by the caller.  For the recursive
-- call, it squashes the prefix and the suffix into the center tree. Once it
-- gets to the bottom, it turns the tree into a 2-3 tree, applies 'mapMulFT' to
-- produce the main body, and glues all the pieces together.
--
-- @map23@ itself is a bit horrifying because of the nested types involved. Its
-- job is to map over the *elements* of a 2-3 tree, rather than the subtrees.
-- If we used a higher-order nested type with MPTC, we could probably use a
-- class, but as it is we have to build up @map23@ explicitly through the
-- recursion.
aptyMiddle
  :: (b -> c)
     -> (b -> c)
     -> (a -> b -> c)
     -> FingerTree (Elem a)
     -> Rigid b
     -> FingerTree (Node c)

-- Not at the bottom yet

aptyMiddle :: (b -> c)
-> (b -> c)
-> (a -> b -> c)
-> FingerTree (Elem a)
-> Rigid b
-> FingerTree (Node c)
aptyMiddle b -> c
firstf
           b -> c
lastf
           a -> b -> c
map23
           FingerTree (Elem a)
fs
           (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)
    = Int
-> Digit (Node c)
-> FingerTree (Node (Node c))
-> Digit (Node c)
-> FingerTree (Node c)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
sm Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
* (FingerTree (Elem a) -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized a => Sized (FingerTree a)
Instance of class: Sized of the constraint type forall a. Sized (Elem a)
size FingerTree (Elem a)
fs Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Int
1)) -- note: sm = s - size pr - size sf
           ((Digit23 b -> Node c) -> Digit (Digit23 b) -> Digit (Node c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Instance of class: Functor of the constraint type Functor Digit
fmap ((b -> c) -> Digit23 b -> Node c
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Instance of class: Functor of the constraint type Functor Node
fmap b -> c
firstf) (Digit12 (Digit23 b) -> Digit (Digit23 b)
forall a. Digit12 a -> Digit a
digit12ToDigit Digit12 (Digit23 b)
prm))
           ((Digit23 b -> Node c)
-> (Digit23 b -> Node c)
-> (a -> Digit23 b -> Node c)
-> FingerTree (Elem a)
-> Rigid (Digit23 b)
-> FingerTree (Node (Node c))
forall b c a.
(b -> c)
-> (b -> c)
-> (a -> b -> c)
-> FingerTree (Elem a)
-> Rigid b
-> FingerTree (Node c)
aptyMiddle ((b -> c) -> Digit23 b -> Node c
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Instance of class: Functor of the constraint type Functor Node
fmap b -> c
firstf)
                       ((b -> c) -> Digit23 b -> Node c
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Instance of class: Functor of the constraint type Functor Node
fmap b -> c
lastf)
                       ((b -> c) -> Digit23 b -> Node c
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Instance of class: Functor of the constraint type Functor Node
fmap ((b -> c) -> Digit23 b -> Node c)
-> (a -> b -> c) -> a -> Digit23 b -> Node c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b -> c
map23)
                       FingerTree (Elem a)
fs
                       (Int
-> Node (Digit23 b)
-> Thin (Node (Digit23 b))
-> Node (Digit23 b)
-> Rigid (Digit23 b)
forall a.
Int -> Digit23 a -> Thin (Digit23 a) -> Digit23 a -> Rigid a
Rigid Int
s (Digit23 b -> Digit12 (Digit23 b) -> Node (Digit23 b)
forall a. Digit23 a -> Digit12 (Digit23 a) -> Digit23 (Digit23 a)
squashL Digit23 b
pr Digit12 (Digit23 b)
prm) Thin (Node (Digit23 b))
mm (Digit12 (Digit23 b) -> Digit23 b -> Node (Digit23 b)
forall a. Digit12 (Node a) -> Node a -> Digit23 (Node a)
squashR Digit12 (Digit23 b)
sfm Digit23 b
sf)))
           ((Digit23 b -> Node c) -> Digit (Digit23 b) -> Digit (Node c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Instance of class: Functor of the constraint type Functor Digit
fmap ((b -> c) -> Digit23 b -> Node c
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Instance of class: Functor of the constraint type Functor Node
fmap b -> c
lastf) (Digit12 (Digit23 b) -> Digit (Digit23 b)
forall a. Digit12 a -> Digit a
digit12ToDigit Digit12 (Digit23 b)
sfm))

-- At the bottom

aptyMiddle b -> c
firstf
           b -> c
lastf
           a -> b -> c
map23
           FingerTree (Elem a)
fs
           (Rigid Int
s Digit23 b
pr Thin (Digit23 b)
EmptyTh Digit23 b
sf)
     = Digit (Node c)
-> FingerTree (Node (Node c))
-> Digit (Node c)
-> FingerTree (Node c)
forall a.
Sized a =>
Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
deep
            (Node c -> Digit (Node c)
forall a. a -> Digit a
One ((b -> c) -> Digit23 b -> Node c
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Instance of class: Functor of the constraint type Functor Node
fmap b -> c
firstf Digit23 b
sf))
            (Int
-> (Elem a -> Node (Node c))
-> FingerTree (Elem a)
-> FingerTree (Node (Node c))
forall a b. Int -> (a -> b) -> FingerTree a -> FingerTree b
mapMulFT Int
s (\(Elem a
f) -> (Digit23 b -> Node c) -> Node (Digit23 b) -> Node (Node c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Instance of class: Functor of the constraint type Functor Node
fmap ((b -> c) -> Digit23 b -> Node c
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Instance of class: Functor of the constraint type Functor Node
fmap (a -> b -> c
map23 a
f)) Node (Digit23 b)
converted) FingerTree (Elem a)
fs)
            (Node c -> Digit (Node c)
forall a. a -> Digit a
One ((b -> c) -> Digit23 b -> Node c
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Instance of class: Functor of the constraint type Functor Node
fmap b -> c
lastf Digit23 b
pr))
   where converted :: Node (Digit23 b)
converted = Digit23 b -> Digit23 b -> Node (Digit23 b)
forall a. Sized a => a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
node2 Digit23 b
pr Digit23 b
sf

aptyMiddle b -> c
firstf
           b -> c
lastf
           a -> b -> c
map23
           FingerTree (Elem a)
fs
           (Rigid Int
s Digit23 b
pr (SingleTh Digit23 b
q) Digit23 b
sf)
     = Digit (Node c)
-> FingerTree (Node (Node c))
-> Digit (Node c)
-> FingerTree (Node c)
forall a.
Sized a =>
Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
deep
            (Node c -> Node c -> Digit (Node c)
forall a. a -> a -> Digit a
Two ((b -> c) -> Digit23 b -> Node c
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Instance of class: Functor of the constraint type Functor Node
fmap b -> c
firstf Digit23 b
q) ((b -> c) -> Digit23 b -> Node c
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Instance of class: Functor of the constraint type Functor Node
fmap b -> c
firstf Digit23 b
sf))
            (Int
-> (Elem a -> Node (Node c))
-> FingerTree (Elem a)
-> FingerTree (Node (Node c))
forall a b. Int -> (a -> b) -> FingerTree a -> FingerTree b
mapMulFT Int
s (\(Elem a
f) -> (Digit23 b -> Node c) -> Node (Digit23 b) -> Node (Node c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Instance of class: Functor of the constraint type Functor Node
fmap ((b -> c) -> Digit23 b -> Node c
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Instance of class: Functor of the constraint type Functor Node
fmap (a -> b -> c
map23 a
f)) Node (Digit23 b)
converted) FingerTree (Elem a)
fs)
            (Node c -> Node c -> Digit (Node c)
forall a. a -> a -> Digit a
Two ((b -> c) -> Digit23 b -> Node c
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Instance of class: Functor of the constraint type Functor Node
fmap b -> c
lastf Digit23 b
pr) ((b -> c) -> Digit23 b -> Node c
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Instance of class: Functor of the constraint type Functor Node
fmap b -> c
lastf Digit23 b
q))
   where converted :: Node (Digit23 b)
converted = Digit23 b -> Digit23 b -> Digit23 b -> Node (Digit23 b)
forall a. Sized a => a -> a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
node3 Digit23 b
pr Digit23 b
q Digit23 b
sf

digit12ToDigit :: Digit12 a -> Digit a
digit12ToDigit :: Digit12 a -> Digit a
digit12ToDigit (One12 a
a) = a -> Digit a
forall a. a -> Digit a
One a
a
digit12ToDigit (Two12 a
a a
b) = a -> a -> Digit a
forall a. a -> a -> Digit a
Two a
a a
b

-- Squash the first argument down onto the left side of the second.
squashL :: Digit23 a -> Digit12 (Node a) -> Digit23 (Node a)
squashL :: Digit23 a -> Digit12 (Digit23 a) -> Digit23 (Digit23 a)
squashL Digit23 a
m (One12 Digit23 a
n) = Digit23 a -> Digit23 a -> Digit23 (Digit23 a)
forall a. Sized a => a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
node2 Digit23 a
m Digit23 a
n
squashL Digit23 a
m (Two12 Digit23 a
n1 Digit23 a
n2) = Digit23 a -> Digit23 a -> Digit23 a -> Digit23 (Digit23 a)
forall a. Sized a => a -> a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
node3 Digit23 a
m Digit23 a
n1 Digit23 a
n2

-- Squash the second argument down onto the right side of the first
squashR :: Digit12 (Node a) -> Digit23 a -> Digit23 (Node a)
squashR :: Digit12 (Node a) -> Node a -> Digit23 (Node a)
squashR (One12 Node a
n) Node a
m = Node a -> Node a -> Digit23 (Node a)
forall a. Sized a => a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
node2 Node a
n Node a
m
squashR (Two12 Node a
n1 Node a
n2) Node a
m = Node a -> Node a -> Node a -> Digit23 (Node a)
forall a. Sized a => a -> a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
node3 Node a
n1 Node a
n2 Node a
m


-- | /O(m*n)/ (incremental) Takes an /O(m)/ function and a finger tree of size
-- /n/ and maps the function over the tree leaves. Unlike the usual 'fmap', the
-- function is applied to the "leaves" of the 'FingerTree' (i.e., given a
-- @FingerTree (Elem a)@, it applies the function to elements of type @Elem
-- a@), replacing the leaves with subtrees of at least the same height, e.g.,
-- @Node(Node(Elem y))@. The multiplier argument serves to make the annotations
-- match up properly.
mapMulFT :: Int -> (a -> b) -> FingerTree a -> FingerTree b
mapMulFT :: Int -> (a -> b) -> FingerTree a -> FingerTree b
mapMulFT Int
_ a -> b
_ FingerTree a
EmptyT = FingerTree b
forall a. FingerTree a
EmptyT
mapMulFT Int
_mul a -> b
f (Single a
a) = b -> FingerTree b
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) = Int -> Digit b -> FingerTree (Node b) -> Digit b -> FingerTree b
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
mul Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
* Int
s) ((a -> b) -> Digit a -> Digit b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Instance of class: Functor of the constraint type Functor Digit
fmap a -> b
f Digit a
pr) (Int
-> (Node a -> Node b) -> FingerTree (Node a) -> FingerTree (Node b)
forall a b. Int -> (a -> b) -> FingerTree a -> FingerTree b
mapMulFT Int
mul (Int -> (a -> b) -> Node a -> Node b
forall a b. Int -> (a -> b) -> Node a -> Node b
mapMulNode Int
mul a -> b
f) FingerTree (Node a)
m) ((a -> b) -> Digit a -> Digit b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Instance of class: Functor of the constraint type Functor Digit
fmap a -> b
f Digit a
sf)

mapMulNode :: Int -> (a -> b) -> Node a -> Node b
mapMulNode :: Int -> (a -> b) -> Node a -> Node b
mapMulNode Int
mul a -> b
f (Node2 Int
s a
a a
b)   = Int -> b -> b -> Node b
forall a. Int -> a -> a -> Node a
Node2 (Int
mul Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
* 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) = Int -> b -> b -> b -> Node b
forall a. Int -> a -> a -> a -> Node a
Node3 (Int
mul Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
* Int
s) (a -> b
f a
a) (a -> b
f a
b) (a -> b
f a
c)

-- | /O(log n)/ (incremental) Takes the extra flexibility out of a 'FingerTree'
-- to make it a genuine 2-3 finger tree. The result of 'rigidify' will have
-- only two and three digits at the top level and only one and two
-- digits elsewhere. If the tree has fewer than four elements, 'rigidify'
-- will simply extract them, and will not build a tree.
rigidify :: FingerTree (Elem a) -> Rigidified (Elem a)
-- The patterns below just fix up the top level of the tree; 'rigidify'
-- delegates the hard work to 'thin'.

rigidify :: FingerTree (Elem a) -> Rigidified (Elem a)
rigidify FingerTree (Elem a)
EmptyT = Rigidified (Elem a)
forall a. Rigidified a
RigidEmpty

rigidify (Single Elem a
q) = Elem a -> Rigidified (Elem a)
forall a. a -> Rigidified a
RigidOne Elem a
q

-- The left digit is Two or Three
rigidify (Deep Int
s (Two Elem a
a Elem a
b) FingerTree (Node (Elem a))
m Digit (Elem a)
sf) = Int
-> Node (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> Rigidified (Elem a)
forall a.
Int
-> Digit23 (Elem a)
-> FingerTree (Digit23 (Elem a))
-> Digit (Elem a)
-> Rigidified (Elem a)
rigidifyRight Int
s (Elem a -> Elem a -> Node (Elem a)
forall a. Sized a => a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Elem 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) = Int
-> Node (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> Rigidified (Elem a)
forall a.
Int
-> Digit23 (Elem a)
-> FingerTree (Digit23 (Elem a))
-> Digit (Elem a)
-> Rigidified (Elem a)
rigidifyRight Int
s (Elem a -> Elem a -> Elem a -> Node (Elem a)
forall a. Sized a => a -> a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Elem a)
node3 Elem a
a Elem a
b Elem a
c) FingerTree (Node (Elem a))
m Digit (Elem a)
sf

-- The left digit is Four
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) = Int
-> Node (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> Rigidified (Elem a)
forall a.
Int
-> Digit23 (Elem a)
-> FingerTree (Digit23 (Elem a))
-> Digit (Elem a)
-> Rigidified (Elem a)
rigidifyRight Int
s (Elem a -> Elem a -> Node (Elem a)
forall a. Sized a => a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Elem a)
node2 Elem a
a Elem a
b) (Elem a -> Elem a -> Node (Elem a)
forall a. Sized a => a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Elem a)
node2 Elem a
c Elem a
d Node (Elem a)
-> FingerTree (Node (Elem a)) -> FingerTree (Node (Elem a))
forall a. Sized a => a -> FingerTree a -> FingerTree a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
`consTree` FingerTree (Node (Elem a))
m) Digit (Elem a)
sf

-- The left digit is One
rigidify (Deep Int
s (One Elem a
a) FingerTree (Node (Elem a))
m Digit (Elem a)
sf) = case FingerTree (Node (Elem a)) -> ViewLTree (Node (Elem a))
forall a. Sized a => FingerTree a -> ViewLTree a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
viewLTree FingerTree (Node (Elem a))
m of
   ConsLTree (Node2 Int
_ Elem a
b Elem a
c) FingerTree (Node (Elem a))
m' -> Int
-> Node (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> Rigidified (Elem a)
forall a.
Int
-> Digit23 (Elem a)
-> FingerTree (Digit23 (Elem a))
-> Digit (Elem a)
-> Rigidified (Elem a)
rigidifyRight Int
s (Elem a -> Elem a -> Elem a -> Node (Elem a)
forall a. Sized a => a -> a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Elem 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' -> Int
-> Node (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> Rigidified (Elem a)
forall a.
Int
-> Digit23 (Elem a)
-> FingerTree (Digit23 (Elem a))
-> Digit (Elem a)
-> Rigidified (Elem a)
rigidifyRight Int
s (Elem a -> Elem a -> Node (Elem a)
forall a. Sized a => a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Elem a)
node2 Elem a
a Elem a
b) (Elem a -> Elem a -> Node (Elem a)
forall a. Sized a => a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Elem a)
node2 Elem a
c Elem a
d Node (Elem a)
-> FingerTree (Node (Elem a)) -> FingerTree (Node (Elem a))
forall a. Sized a => a -> FingerTree a -> FingerTree a
Instance of class: Sized of the constraint type forall a. Sized (Node 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 -> Elem a -> Elem a -> Rigidified (Elem a)
forall a. a -> a -> Rigidified a
RigidTwo Elem a
a Elem a
b
     Two Elem a
b Elem a
c -> Elem a -> Elem a -> Elem a -> Rigidified (Elem a)
forall a. a -> a -> a -> Rigidified a
RigidThree Elem a
a Elem a
b Elem a
c
     Three Elem a
b Elem a
c Elem a
d -> Rigid (Elem a) -> Rigidified (Elem a)
forall a. Rigid a -> Rigidified a
RigidFull (Rigid (Elem a) -> Rigidified (Elem a))
-> Rigid (Elem a) -> Rigidified (Elem a)
forall a b. (a -> b) -> a -> b
$ Int
-> Node (Elem a)
-> Thin (Node (Elem a))
-> Node (Elem a)
-> Rigid (Elem a)
forall a.
Int -> Digit23 a -> Thin (Digit23 a) -> Digit23 a -> Rigid a
Rigid Int
s (Elem a -> Elem a -> Node (Elem a)
forall a. Sized a => a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Elem a)
node2 Elem a
a Elem a
b) Thin (Node (Elem a))
forall a. Thin a
EmptyTh (Elem a -> Elem a -> Node (Elem a)
forall a. Sized a => a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Elem a)
node2 Elem a
c Elem a
d)
     Four Elem a
b Elem a
c Elem a
d Elem a
e -> Rigid (Elem a) -> Rigidified (Elem a)
forall a. Rigid a -> Rigidified a
RigidFull (Rigid (Elem a) -> Rigidified (Elem a))
-> Rigid (Elem a) -> Rigidified (Elem a)
forall a b. (a -> b) -> a -> b
$ Int
-> Node (Elem a)
-> Thin (Node (Elem a))
-> Node (Elem a)
-> Rigid (Elem a)
forall a.
Int -> Digit23 a -> Thin (Digit23 a) -> Digit23 a -> Rigid a
Rigid Int
s (Elem a -> Elem a -> Elem a -> Node (Elem a)
forall a. Sized a => a -> a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Elem a)
node3 Elem a
a Elem a
b Elem a
c) Thin (Node (Elem a))
forall a. Thin a
EmptyTh (Elem a -> Elem a -> Node (Elem a)
forall a. Sized a => a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Elem a)
node2 Elem a
d Elem a
e)

-- | /O(log n)/ (incremental) Takes a tree whose left side has been rigidified
-- and finishes the job.
rigidifyRight :: Int -> Digit23 (Elem a) -> FingerTree (Node (Elem a)) -> Digit (Elem a) -> Rigidified (Elem a)

-- The right digit is Two, Three, or Four
rigidifyRight :: Int
-> Digit23 (Elem a)
-> FingerTree (Digit23 (Elem a))
-> Digit (Elem a)
-> Rigidified (Elem a)
rigidifyRight Int
s Digit23 (Elem a)
pr FingerTree (Digit23 (Elem a))
m (Two Elem a
a Elem a
b) = Rigid (Elem a) -> Rigidified (Elem a)
forall a. Rigid a -> Rigidified a
RigidFull (Rigid (Elem a) -> Rigidified (Elem a))
-> Rigid (Elem a) -> Rigidified (Elem a)
forall a b. (a -> b) -> a -> b
$ Int
-> Digit23 (Elem a)
-> Thin (Digit23 (Elem a))
-> Digit23 (Elem a)
-> Rigid (Elem a)
forall a.
Int -> Digit23 a -> Thin (Digit23 a) -> Digit23 a -> Rigid a
Rigid Int
s Digit23 (Elem a)
pr (FingerTree (Digit23 (Elem a)) -> Thin (Digit23 (Elem a))
forall a. Sized a => FingerTree a -> Thin a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
thin FingerTree (Digit23 (Elem a))
m) (Elem a -> Elem a -> Digit23 (Elem a)
forall a. Sized a => a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Elem a)
node2 Elem a
a Elem a
b)
rigidifyRight Int
s Digit23 (Elem a)
pr FingerTree (Digit23 (Elem a))
m (Three Elem a
a Elem a
b Elem a
c) = Rigid (Elem a) -> Rigidified (Elem a)
forall a. Rigid a -> Rigidified a
RigidFull (Rigid (Elem a) -> Rigidified (Elem a))
-> Rigid (Elem a) -> Rigidified (Elem a)
forall a b. (a -> b) -> a -> b
$ Int
-> Digit23 (Elem a)
-> Thin (Digit23 (Elem a))
-> Digit23 (Elem a)
-> Rigid (Elem a)
forall a.
Int -> Digit23 a -> Thin (Digit23 a) -> Digit23 a -> Rigid a
Rigid Int
s Digit23 (Elem a)
pr (FingerTree (Digit23 (Elem a)) -> Thin (Digit23 (Elem a))
forall a. Sized a => FingerTree a -> Thin a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
thin FingerTree (Digit23 (Elem a))
m) (Elem a -> Elem a -> Elem a -> Digit23 (Elem a)
forall a. Sized a => a -> a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Elem a)
node3 Elem a
a Elem a
b Elem a
c)
rigidifyRight Int
s Digit23 (Elem a)
pr FingerTree (Digit23 (Elem a))
m (Four Elem a
a Elem a
b Elem a
c Elem a
d) = Rigid (Elem a) -> Rigidified (Elem a)
forall a. Rigid a -> Rigidified a
RigidFull (Rigid (Elem a) -> Rigidified (Elem a))
-> Rigid (Elem a) -> Rigidified (Elem a)
forall a b. (a -> b) -> a -> b
$ Int
-> Digit23 (Elem a)
-> Thin (Digit23 (Elem a))
-> Digit23 (Elem a)
-> Rigid (Elem a)
forall a.
Int -> Digit23 a -> Thin (Digit23 a) -> Digit23 a -> Rigid a
Rigid Int
s Digit23 (Elem a)
pr (FingerTree (Digit23 (Elem a)) -> Thin (Digit23 (Elem a))
forall a. Sized a => FingerTree a -> Thin a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
thin (FingerTree (Digit23 (Elem a)) -> Thin (Digit23 (Elem a)))
-> FingerTree (Digit23 (Elem a)) -> Thin (Digit23 (Elem a))
forall a b. (a -> b) -> a -> b
$ FingerTree (Digit23 (Elem a))
m FingerTree (Digit23 (Elem a))
-> Digit23 (Elem a) -> FingerTree (Digit23 (Elem a))
forall a. Sized a => FingerTree a -> a -> FingerTree a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
`snocTree` Elem a -> Elem a -> Digit23 (Elem a)
forall a. Sized a => a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Elem a)
node2 Elem a
a Elem a
b) (Elem a -> Elem a -> Digit23 (Elem a)
forall a. Sized a => a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Elem a)
node2 Elem a
c Elem a
d)

-- The right digit is One
rigidifyRight Int
s Digit23 (Elem a)
pr FingerTree (Digit23 (Elem a))
m (One Elem a
e) = case FingerTree (Digit23 (Elem a)) -> ViewRTree (Digit23 (Elem a))
forall a. Sized a => FingerTree a -> ViewRTree a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
viewRTree FingerTree (Digit23 (Elem a))
m of
    SnocRTree FingerTree (Digit23 (Elem a))
m' (Node2 Int
_ Elem a
a Elem a
b) -> Rigid (Elem a) -> Rigidified (Elem a)
forall a. Rigid a -> Rigidified a
RigidFull (Rigid (Elem a) -> Rigidified (Elem a))
-> Rigid (Elem a) -> Rigidified (Elem a)
forall a b. (a -> b) -> a -> b
$ Int
-> Digit23 (Elem a)
-> Thin (Digit23 (Elem a))
-> Digit23 (Elem a)
-> Rigid (Elem a)
forall a.
Int -> Digit23 a -> Thin (Digit23 a) -> Digit23 a -> Rigid a
Rigid Int
s Digit23 (Elem a)
pr (FingerTree (Digit23 (Elem a)) -> Thin (Digit23 (Elem a))
forall a. Sized a => FingerTree a -> Thin a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
thin FingerTree (Digit23 (Elem a))
m') (Elem a -> Elem a -> Elem a -> Digit23 (Elem a)
forall a. Sized a => a -> a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Elem a)
node3 Elem a
a Elem a
b Elem a
e)
    SnocRTree FingerTree (Digit23 (Elem a))
m' (Node3 Int
_ Elem a
a Elem a
b Elem a
c) -> Rigid (Elem a) -> Rigidified (Elem a)
forall a. Rigid a -> Rigidified a
RigidFull (Rigid (Elem a) -> Rigidified (Elem a))
-> Rigid (Elem a) -> Rigidified (Elem a)
forall a b. (a -> b) -> a -> b
$ Int
-> Digit23 (Elem a)
-> Thin (Digit23 (Elem a))
-> Digit23 (Elem a)
-> Rigid (Elem a)
forall a.
Int -> Digit23 a -> Thin (Digit23 a) -> Digit23 a -> Rigid a
Rigid Int
s Digit23 (Elem a)
pr (FingerTree (Digit23 (Elem a)) -> Thin (Digit23 (Elem a))
forall a. Sized a => FingerTree a -> Thin a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
thin (FingerTree (Digit23 (Elem a)) -> Thin (Digit23 (Elem a)))
-> FingerTree (Digit23 (Elem a)) -> Thin (Digit23 (Elem a))
forall a b. (a -> b) -> a -> b
$ FingerTree (Digit23 (Elem a))
m' FingerTree (Digit23 (Elem a))
-> Digit23 (Elem a) -> FingerTree (Digit23 (Elem a))
forall a. Sized a => FingerTree a -> a -> FingerTree a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
`snocTree` Elem a -> Elem a -> Digit23 (Elem a)
forall a. Sized a => a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Elem a)
node2 Elem a
a Elem a
b) (Elem a -> Elem a -> Digit23 (Elem a)
forall a. Sized a => a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Elem a)
node2 Elem a
c Elem a
e)
    ViewRTree (Digit23 (Elem a))
EmptyRTree -> case Digit23 (Elem a)
pr of
      Node2 Int
_ Elem a
a Elem a
b -> Elem a -> Elem a -> Elem a -> Rigidified (Elem a)
forall a. a -> a -> a -> Rigidified a
RigidThree Elem a
a Elem a
b Elem a
e
      Node3 Int
_ Elem a
a Elem a
b Elem a
c -> Rigid (Elem a) -> Rigidified (Elem a)
forall a. Rigid a -> Rigidified a
RigidFull (Rigid (Elem a) -> Rigidified (Elem a))
-> Rigid (Elem a) -> Rigidified (Elem a)
forall a b. (a -> b) -> a -> b
$ Int
-> Digit23 (Elem a)
-> Thin (Digit23 (Elem a))
-> Digit23 (Elem a)
-> Rigid (Elem a)
forall a.
Int -> Digit23 a -> Thin (Digit23 a) -> Digit23 a -> Rigid a
Rigid Int
s (Elem a -> Elem a -> Digit23 (Elem a)
forall a. Sized a => a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Elem a)
node2 Elem a
a Elem a
b) Thin (Digit23 (Elem a))
forall a. Thin a
EmptyTh (Elem a -> Elem a -> Digit23 (Elem a)
forall a. Sized a => a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Elem a)
node2 Elem a
c Elem a
e)

-- | /O(log n)/ (incremental) Rejigger a finger tree so the digits are all ones
-- and twos.
thin :: Sized a => FingerTree a -> Thin a
-- Note that 'thin12' will produce a 'DeepTh' constructor immediately before
-- recursively calling 'thin'.
thin :: FingerTree a -> Thin a
thin FingerTree a
EmptyT = Thin a
forall a. Thin a
EmptyTh
thin (Single a
a) = a -> Thin 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 -> Int -> Digit12 a -> FingerTree (Node a) -> Digit a -> Thin a
forall a.
Sized a =>
Int -> Digit12 a -> FingerTree (Node a) -> Digit a -> Thin a
Evidence bound by a type signature of the constraint type Sized a
thin12 Int
s (a -> Digit12 a
forall a. a -> Digit12 a
One12 a
a) FingerTree (Node a)
m Digit a
sf
    Two a
a a
b -> Int -> Digit12 a -> FingerTree (Node a) -> Digit a -> Thin a
forall a.
Sized a =>
Int -> Digit12 a -> FingerTree (Node a) -> Digit a -> Thin a
Evidence bound by a type signature of the constraint type Sized a
thin12 Int
s (a -> a -> Digit12 a
forall a. a -> a -> Digit12 a
Two12 a
a a
b) FingerTree (Node a)
m Digit a
sf
    Three a
a a
b a
c  -> Int -> Digit12 a -> FingerTree (Node a) -> Digit a -> Thin a
forall a.
Sized a =>
Int -> Digit12 a -> FingerTree (Node a) -> Digit a -> Thin a
Evidence bound by a type signature of the constraint type Sized a
thin12 Int
s (a -> Digit12 a
forall a. a -> Digit12 a
One12 a
a) (a -> a -> Node a
forall a. Sized a => a -> a -> Node a
Evidence bound by a type signature of the constraint type Sized a
node2 a
b a
c Node a -> FingerTree (Node a) -> FingerTree (Node a)
forall a. Sized a => a -> FingerTree a -> FingerTree a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
`consTree` FingerTree (Node a)
m) Digit a
sf
    Four a
a a
b a
c a
d -> Int -> Digit12 a -> FingerTree (Node a) -> Digit a -> Thin a
forall a.
Sized a =>
Int -> Digit12 a -> FingerTree (Node a) -> Digit a -> Thin a
Evidence bound by a type signature of the constraint type Sized a
thin12 Int
s (a -> a -> Digit12 a
forall a. a -> a -> Digit12 a
Two12 a
a a
b) (a -> a -> Node a
forall a. Sized a => a -> a -> Node a
Evidence bound by a type signature of the constraint type Sized a
node2 a
c a
d Node a -> FingerTree (Node a) -> FingerTree (Node a)
forall a. Sized a => a -> FingerTree a -> FingerTree a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
`consTree` FingerTree (Node a)
m) Digit a
sf

thin12 :: Sized a => Int -> Digit12 a -> FingerTree (Node a) -> Digit a -> Thin a
thin12 :: Int -> Digit12 a -> FingerTree (Node a) -> Digit a -> Thin a
thin12 Int
s Digit12 a
pr FingerTree (Node a)
m (One a
a) = Int -> Digit12 a -> Thin (Node a) -> Digit12 a -> Thin a
forall a. Int -> Digit12 a -> Thin (Node a) -> Digit12 a -> Thin a
DeepTh Int
s Digit12 a
pr (FingerTree (Node a) -> Thin (Node a)
forall a. Sized a => FingerTree a -> Thin a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
thin FingerTree (Node a)
m) (a -> Digit12 a
forall a. a -> Digit12 a
One12 a
a)
thin12 Int
s Digit12 a
pr FingerTree (Node a)
m (Two a
a a
b) = Int -> Digit12 a -> Thin (Node a) -> Digit12 a -> Thin a
forall a. Int -> Digit12 a -> Thin (Node a) -> Digit12 a -> Thin a
DeepTh Int
s Digit12 a
pr (FingerTree (Node a) -> Thin (Node a)
forall a. Sized a => FingerTree a -> Thin a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
thin FingerTree (Node a)
m) (a -> a -> Digit12 a
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) = Int -> Digit12 a -> Thin (Node a) -> Digit12 a -> Thin a
forall a. Int -> Digit12 a -> Thin (Node a) -> Digit12 a -> Thin a
DeepTh Int
s Digit12 a
pr (FingerTree (Node a) -> Thin (Node a)
forall a. Sized a => FingerTree a -> Thin a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
thin (FingerTree (Node a) -> Thin (Node a))
-> FingerTree (Node a) -> Thin (Node a)
forall a b. (a -> b) -> a -> b
$ FingerTree (Node a)
m FingerTree (Node a) -> Node a -> FingerTree (Node a)
forall a. Sized a => FingerTree a -> a -> FingerTree a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
`snocTree` a -> a -> Node a
forall a. Sized a => a -> a -> Node a
Evidence bound by a type signature of the constraint type Sized a
node2 a
a a
b) (a -> Digit12 a
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) = Int -> Digit12 a -> Thin (Node a) -> Digit12 a -> Thin a
forall a. Int -> Digit12 a -> Thin (Node a) -> Digit12 a -> Thin a
DeepTh Int
s Digit12 a
pr (FingerTree (Node a) -> Thin (Node a)
forall a. Sized a => FingerTree a -> Thin a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
thin (FingerTree (Node a) -> Thin (Node a))
-> FingerTree (Node a) -> Thin (Node a)
forall a b. (a -> b) -> a -> b
$ FingerTree (Node a)
m FingerTree (Node a) -> Node a -> FingerTree (Node a)
forall a. Sized a => FingerTree a -> a -> FingerTree a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
`snocTree` a -> a -> Node a
forall a. Sized a => a -> a -> Node a
Evidence bound by a type signature of the constraint type Sized a
node2 a
a a
b) (a -> a -> Digit12 a
forall a. a -> a -> Digit12 a
Two12 a
c a
d)

-- | \( O(n) \). Intersperse an element between the elements of a sequence.
--
-- @
-- intersperse a empty = empty
-- intersperse a (singleton x) = singleton x
-- intersperse a (fromList [x,y]) = fromList [x,a,y]
-- intersperse a (fromList [x,y,z]) = fromList [x,a,y,a,z]
-- @
--
-- @since 0.5.8
intersperse :: a -> Seq a -> Seq a
intersperse :: a -> Seq a -> Seq a
intersperse a
y Seq a
xs = case Seq a -> ViewL a
forall a. Seq a -> ViewL a
viewl Seq a
xs of
  ViewL a
EmptyL -> Seq a
forall a. Seq a
empty
  a
p :< Seq a
ps -> a
p a -> Seq a -> Seq a
forall a. a -> Seq a -> Seq a
<| (Seq a
ps Seq a -> Seq (a -> a) -> Seq a
forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
Instance of class: Applicative of the constraint type Applicative Seq
<**> (a -> a -> a
forall a b. a -> b -> a
const a
y (a -> a) -> Seq (a -> a) -> Seq (a -> a)
forall a. a -> Seq a -> Seq a
<| (a -> a) -> Seq (a -> a)
forall a. a -> Seq a
singleton a -> a
forall a. a -> a
id))
-- We used to use
--
-- intersperse y xs = drop 1 $ xs <**> (const y <| singleton id)
--
-- but if length xs = ((maxBound :: Int) `quot` 2) + 1 then
--
-- length (xs <**> (const y <| singleton id)) will wrap around to negative
-- and the drop won't work. The new implementation can produce a result
-- right up to maxBound :: Int

instance MonadPlus Seq where
    mzero :: Seq a
mzero = Seq a
forall a. Seq a
empty
    mplus :: Seq a -> Seq a -> Seq a
mplus = Seq a -> Seq a -> Seq a
forall a. Seq a -> Seq a -> Seq a
(><)

-- | @since 0.5.4
instance Alternative Seq where
    empty :: Seq a
empty = Seq a
forall a. Seq a
empty
    <|> :: Seq a -> Seq a -> Seq a
(<|>) = Seq a -> Seq a -> Seq a
forall a. Seq a -> Seq a -> Seq a
(><)

instance Eq a => Eq (Seq a) where
    Seq a
xs == :: Seq a -> Seq a -> Bool
== Seq a
ys = Seq a -> Int
forall a. Seq a -> Int
length Seq a
xs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq Int
== Seq a -> Int
forall a. Seq a -> Int
length Seq a
ys Bool -> Bool -> Bool
&& Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Instance of class: Foldable of the constraint type Foldable Seq
toList Seq a
xs [a] -> [a] -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type forall a. Eq a => Eq [a]
Evidence bound by a type signature of the constraint type Eq a
== Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Instance of class: Foldable of the constraint type Foldable Seq
toList Seq a
ys

instance Ord a => Ord (Seq a) where
    compare :: Seq a -> Seq a -> Ordering
compare Seq a
xs Seq a
ys = [a] -> [a] -> Ordering
forall a. Ord a => a -> a -> Ordering
External instance of the constraint type forall a. Ord a => Ord [a]
Evidence bound by a type signature of the constraint type Ord a
compare (Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Instance of class: Foldable of the constraint type Foldable Seq
toList Seq a
xs) (Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Instance of class: Foldable of the constraint type Foldable Seq
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
        [Char] -> ShowS
showString [Char]
"fromList " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> ShowS
forall a. Show a => a -> ShowS
External instance of the constraint type forall a. Show a => Show [a]
Evidence bound by a type signature of the constraint type Show a
shows (Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Instance of class: Foldable of the constraint type Foldable Seq
toList Seq a
xs)
#endif

#if MIN_VERSION_base(4,9,0)
-- | @since 0.5.9
instance Show1 Seq where
  liftShowsPrec :: (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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
        [Char] -> ShowS
showString [Char]
"fromList " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> ShowS
shwList (Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Instance of class: Foldable of the constraint type Foldable Seq
toList Seq a
xs)

-- | @since 0.5.9
instance Eq1 Seq where
    liftEq :: (a -> b -> Bool) -> Seq a -> Seq b -> Bool
liftEq a -> b -> Bool
eq Seq a
xs Seq b
ys = Seq a -> Int
forall a. Seq a -> Int
length Seq a
xs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq Int
== Seq b -> Int
forall a. Seq a -> Int
length Seq b
ys Bool -> Bool -> Bool
&& (a -> b -> Bool) -> [a] -> [b] -> Bool
forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
External instance of the constraint type Eq1 []
liftEq a -> b -> Bool
eq (Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Instance of class: Foldable of the constraint type Foldable Seq
toList Seq a
xs) (Seq b -> [b]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Instance of class: Foldable of the constraint type Foldable Seq
toList Seq b
ys)

-- | @since 0.5.9
instance Ord1 Seq where
    liftCompare :: (a -> b -> Ordering) -> Seq a -> Seq b -> Ordering
liftCompare a -> b -> Ordering
cmp Seq a
xs Seq b
ys = (a -> b -> Ordering) -> [a] -> [b] -> Ordering
forall (f :: * -> *) a b.
Ord1 f =>
(a -> b -> Ordering) -> f a -> f b -> Ordering
External instance of the constraint type Ord1 []
liftCompare a -> b -> Ordering
cmp (Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Instance of class: Foldable of the constraint type Foldable Seq
toList Seq a
xs) (Seq b -> [b]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Instance of class: Foldable of the constraint type Foldable Seq
toList Seq b
ys)
#endif

instance Read a => Read (Seq a) where
#ifdef __GLASGOW_HASKELL__
    readPrec :: ReadPrec (Seq a)
readPrec = ReadPrec (Seq a) -> ReadPrec (Seq a)
forall a. ReadPrec a -> ReadPrec a
parens (ReadPrec (Seq a) -> ReadPrec (Seq a))
-> ReadPrec (Seq a) -> ReadPrec (Seq a)
forall a b. (a -> b) -> a -> b
$ Int -> ReadPrec (Seq a) -> ReadPrec (Seq a)
forall a. Int -> ReadPrec a -> ReadPrec a
prec Int
10 (ReadPrec (Seq a) -> ReadPrec (Seq a))
-> ReadPrec (Seq a) -> ReadPrec (Seq a)
forall a b. (a -> b) -> a -> b
$ do
        Ident [Char]
"fromList" <- ReadPrec Lexeme
lexP
        [a]
xs <- ReadPrec [a]
forall a. Read a => ReadPrec a
External instance of the constraint type forall a. Read a => Read [a]
Evidence bound by a type signature of the constraint type Read a
readPrec
        Seq a -> ReadPrec (Seq a)
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad ReadPrec
return ([a] -> Seq a
forall a. [a] -> Seq a
fromList [a]
xs)

    readListPrec :: ReadPrec [Seq a]
readListPrec = ReadPrec [Seq a]
forall a. Read a => ReadPrec [a]
Instance of class: Read of the constraint type forall a. Read a => Read (Seq a)
Evidence bound by a type signature of the constraint type Read 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)
-- | @since 0.5.9
instance Read1 Seq where
  liftReadsPrec :: (Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (Seq a)
liftReadsPrec Int -> ReadS a
_rp ReadS [a]
readLst Int
p = Bool -> ReadS (Seq a) -> ReadS (Seq a)
forall a. Bool -> ReadS a -> ReadS a
readParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
> Int
10) (ReadS (Seq a) -> ReadS (Seq a)) -> ReadS (Seq a) -> ReadS (Seq a)
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
    (Seq a, [Char]) -> [(Seq a, [Char])]
forall (f :: * -> *) a. Applicative f => a -> f a
External instance of the constraint type Applicative []
pure ([a] -> Seq a
forall a. [a] -> Seq a
fromList [a]
xs, [Char]
t)
#endif

instance Monoid (Seq a) where
    mempty :: Seq a
mempty = Seq a
forall a. Seq a
empty
    mappend :: Seq a -> Seq a -> Seq a
mappend = Seq a -> Seq a -> Seq a
forall a. Seq a -> Seq a -> Seq a
(><)

#if MIN_VERSION_base(4,9,0)
-- | @since 0.5.7
instance Semigroup.Semigroup (Seq a) where
    <> :: Seq a -> Seq a -> Seq a
(<>)    = Seq a -> Seq a -> Seq a
forall a. Seq a -> Seq a -> Seq a
(><)
    stimes :: b -> Seq a -> Seq a
stimes = Int -> Seq a -> Seq a
forall a. Int -> Seq a -> Seq a
cycleNTimes (Int -> Seq a -> Seq a) -> (b -> Int) -> b -> Seq a -> Seq a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Int
forall a b. (Integral a, Num b) => a -> b
External instance of the constraint type Num Int
Evidence bound by a type signature of the constraint type Integral b
fromIntegral
#endif

INSTANCE_TYPEABLE1(Seq)

#if __GLASGOW_HASKELL__
instance Data a => Data (Seq a) where
    gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Seq a -> c (Seq a)
gfoldl forall d b. Data d => c (d -> b) -> d -> c b
f forall g. g -> c g
z Seq a
s    = case Seq a -> ViewL a
forall a. Seq a -> ViewL a
viewl Seq a
s of
        ViewL a
EmptyL  -> Seq a -> c (Seq a)
forall g. g -> c g
z Seq a
forall a. Seq a
empty
        a
x :< Seq a
xs -> (a -> Seq a -> Seq a) -> c (a -> Seq a -> Seq a)
forall g. g -> c g
z a -> Seq a -> Seq a
forall a. a -> Seq a -> Seq a
(<|) c (a -> Seq a -> Seq a) -> a -> c (Seq a -> Seq a)
forall d b. Data d => c (d -> b) -> d -> c b
Evidence bound by a type signature of the constraint type Data a
`f` a
x c (Seq a -> Seq a) -> Seq a -> c (Seq a)
forall d b. Data d => c (d -> b) -> d -> c b
Instance of class: Data of the constraint type forall a. Data a => Data (Seq a)
Evidence bound by a type signature of the constraint type Data a
`f` Seq a
xs

    gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Seq a)
gunfold 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 -> Seq a -> c (Seq a)
forall r. r -> c r
z Seq a
forall a. Seq a
empty
        Int
2 -> c (Seq a -> Seq a) -> c (Seq a)
forall b r. Data b => c (b -> r) -> c r
Instance of class: Data of the constraint type forall a. Data a => Data (Seq a)
Evidence bound by a type signature of the constraint type Data a
k (c (a -> Seq a -> Seq a) -> c (Seq a -> Seq a)
forall b r. Data b => c (b -> r) -> c r
Evidence bound by a type signature of the constraint type Data a
k ((a -> Seq a -> Seq a) -> c (a -> Seq a -> Seq a)
forall r. r -> c r
z a -> Seq a -> Seq a
forall a. a -> Seq a -> Seq a
(<|)))
        Int
_ -> [Char] -> c (Seq a)
forall a. HasCallStack => [Char] -> a
error [Char]
"gunfold"

    toConstr :: Seq a -> Constr
toConstr Seq a
xs
      | Seq a -> Bool
forall a. Seq a -> Bool
null Seq a
xs     = Constr
emptyConstr
      | Bool
otherwise   = Constr
consConstr

    dataTypeOf :: Seq a -> DataType
dataTypeOf Seq a
_    = DataType
seqDataType

    dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c (Seq a))
dataCast1 forall d. Data d => c (t d)
f     = c (t a) -> Maybe (c (Seq a))
forall {k1} {k2} (c :: k1 -> *) (t :: k2 -> k1) (t' :: k2 -> k1)
       (a :: k2).
(Typeable t, Typeable t') =>
c (t a) -> Maybe (c (t' a))
Evidence bound by a type signature of the constraint type Typeable t
gcast1 c (t a)
forall d. Data d => c (t d)
Evidence bound by a type signature of the constraint type Data a
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

-- Finger trees

data FingerTree a
    = EmptyT
    | Single a
    | Deep {-# UNPACK #-} !Int !(Digit a) (FingerTree (Node a)) !(Digit a)
#ifdef TESTING
    deriving Show
#endif

#ifdef __GLASGOW_HASKELL__
-- | @since 0.6.1
deriving instance Generic1 FingerTree

-- | @since 0.6.1
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)         = a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
size a
x
    size (Deep Int
v Digit a
_ FingerTree (Node a)
_ Digit a
_)     = Int
v

instance Foldable FingerTree where
    foldMap :: (a -> m) -> FingerTree a -> m
foldMap a -> m
_ FingerTree a
EmptyT = m
forall a. Monoid a => a
Evidence bound by a type signature of the constraint type Monoid m
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') = 
        (a -> m) -> Digit a -> m
forall m a. Monoid m => (a -> m) -> Digit a -> m
Evidence bound by a type signature of the constraint type Monoid m
foldMapDigit a -> m
f' Digit a
pr' m -> m -> m
forall a. Monoid a => a -> a -> a
Evidence bound by a type signature of the constraint type Monoid m
<>
        (Node a -> m) -> FingerTree (Node a) -> m
forall m a. Monoid m => (Node a -> m) -> FingerTree (Node a) -> m
Evidence bound by a type signature of the constraint type Monoid m
foldMapTree ((a -> m) -> Node a -> m
forall m a. Monoid m => (a -> m) -> Node a -> m
Evidence bound by a type signature of the constraint type Monoid m
foldMapNode a -> m
f') FingerTree (Node a)
m' m -> m -> m
forall a. Monoid a => a -> a -> a
Evidence bound by a type signature of the constraint type Monoid m
<>
        (a -> m) -> Digit a -> m
forall m a. Monoid m => (a -> m) -> Digit a -> m
Evidence bound by a type signature of the constraint type Monoid m
foldMapDigit a -> m
f' Digit a
sf'
      where
        foldMapTree :: Monoid m => (Node a -> m) -> FingerTree (Node a) -> m
        foldMapTree :: (Node a -> m) -> FingerTree (Node a) -> m
foldMapTree Node a -> m
_ FingerTree (Node a)
EmptyT = m
forall a. Monoid a => a
Evidence bound by a type signature of the constraint type Monoid m
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) = 
            (Node a -> m) -> Digit (Node a) -> m
forall m a. Monoid m => (Node a -> m) -> Digit (Node a) -> m
Evidence bound by a type signature of the constraint type Monoid m
foldMapDigitN Node a -> m
f Digit (Node a)
pr m -> m -> m
forall a. Monoid a => a -> a -> a
Evidence bound by a type signature of the constraint type Monoid m
<>
            (Node (Node a) -> m) -> FingerTree (Node (Node a)) -> m
forall m a. Monoid m => (Node a -> m) -> FingerTree (Node a) -> m
Evidence bound by a type signature of the constraint type Monoid m
foldMapTree ((Node a -> m) -> Node (Node a) -> m
forall m a. Monoid m => (Node a -> m) -> Node (Node a) -> m
Evidence bound by a type signature of the constraint type Monoid m
foldMapNodeN Node a -> m
f) FingerTree (Node (Node a))
m m -> m -> m
forall a. Monoid a => a -> a -> a
Evidence bound by a type signature of the constraint type Monoid m
<>
            (Node a -> m) -> Digit (Node a) -> m
forall m a. Monoid m => (Node a -> m) -> Digit (Node a) -> m
Evidence bound by a type signature of the constraint type Monoid m
foldMapDigitN Node a -> m
f Digit (Node a)
sf

        foldMapDigit :: Monoid m => (a -> m) -> Digit a -> m
        foldMapDigit :: (a -> m) -> Digit a -> m
foldMapDigit a -> m
f Digit a
t = (m -> m -> m) -> (a -> m) -> Digit a -> m
forall b a. (b -> b -> b) -> (a -> b) -> Digit a -> b
foldDigit m -> m -> m
forall a. Monoid a => a -> a -> a
Evidence bound by a type signature of the constraint type Monoid m
(<>) a -> m
f Digit a
t

        foldMapDigitN :: Monoid m => (Node a -> m) -> Digit (Node a) -> m
        foldMapDigitN :: (Node a -> m) -> Digit (Node a) -> m
foldMapDigitN Node a -> m
f Digit (Node a)
t = (m -> m -> m) -> (Node a -> m) -> Digit (Node a) -> m
forall b a. (b -> b -> b) -> (a -> b) -> Digit a -> b
foldDigit m -> m -> m
forall a. Monoid a => a -> a -> a
Evidence bound by a type signature of the constraint type Monoid m
(<>) Node a -> m
f Digit (Node a)
t

        foldMapNode :: Monoid m => (a -> m) -> Node a -> m
        foldMapNode :: (a -> m) -> Node a -> m
foldMapNode a -> m
f Node a
t = (m -> m -> m) -> (a -> m) -> Node a -> m
forall b a. (b -> b -> b) -> (a -> b) -> Node a -> b
foldNode m -> m -> m
forall a. Monoid a => a -> a -> a
Evidence bound by a type signature of the constraint type Monoid m
(<>) a -> m
f Node a
t

        foldMapNodeN :: Monoid m => (Node a -> m) -> Node (Node a) -> m
        foldMapNodeN :: (Node a -> m) -> Node (Node a) -> m
foldMapNodeN Node a -> m
f Node (Node a)
t = (m -> m -> m) -> (Node a -> m) -> Node (Node a) -> m
forall b a. (b -> b -> b) -> (a -> b) -> Node a -> b
foldNode m -> m -> m
forall a. Monoid a => a -> a -> a
Evidence bound by a type signature of the constraint type Monoid m
(<>) Node a -> m
f Node (Node a)
t
#if __GLASGOW_HASKELL__
    {-# INLINABLE foldMap #-}
#endif

    foldr :: (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') =
        (a -> b -> b) -> b -> Digit a -> b
forall a b. (a -> b -> b) -> b -> Digit a -> b
foldrDigit a -> b -> b
f' ((Node a -> b -> b) -> b -> FingerTree (Node a) -> b
forall a b. (Node a -> b -> b) -> b -> FingerTree (Node a) -> b
foldrTree ((a -> b -> b) -> Node a -> b -> b
forall a b. (a -> b -> b) -> Node a -> b -> b
foldrNode a -> b -> b
f') ((a -> b -> b) -> b -> Digit a -> b
forall a b. (a -> b -> b) -> b -> Digit a -> b
foldrDigit a -> b -> b
f' b
z' Digit a
sf') FingerTree (Node a)
m') Digit a
pr'
      where
        foldrTree :: (Node a -> b -> b) -> b -> FingerTree (Node a) -> b
        foldrTree :: (Node a -> b -> b) -> b -> FingerTree (Node a) -> b
foldrTree 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) =
            (Node a -> b -> b) -> b -> Digit (Node a) -> b
forall a b. (Node a -> b -> b) -> b -> Digit (Node a) -> b
foldrDigitN Node a -> b -> b
f ((Node (Node a) -> b -> b) -> b -> FingerTree (Node (Node a)) -> b
forall a b. (Node a -> b -> b) -> b -> FingerTree (Node a) -> b
foldrTree ((Node a -> b -> b) -> Node (Node a) -> b -> b
forall a b. (Node a -> b -> b) -> Node (Node a) -> b -> b
foldrNodeN Node a -> b -> b
f) ((Node a -> b -> b) -> b -> Digit (Node a) -> b
forall a b. (Node a -> b -> b) -> b -> Digit (Node a) -> b
foldrDigitN Node a -> b -> b
f b
z Digit (Node a)
sf) FingerTree (Node (Node a))
m) Digit (Node a)
pr

        foldrDigit :: (a -> b -> b) -> b -> Digit a -> b
        foldrDigit :: (a -> b -> b) -> b -> Digit a -> b
foldrDigit a -> b -> b
f b
z Digit a
t = (a -> b -> b) -> b -> Digit a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
Instance of class: Foldable of the constraint type Foldable Digit
foldr a -> b -> b
f b
z Digit a
t

        foldrDigitN :: (Node a -> b -> b) -> b -> Digit (Node a) -> b
        foldrDigitN :: (Node a -> b -> b) -> b -> Digit (Node a) -> b
foldrDigitN Node a -> b -> b
f b
z Digit (Node a)
t = (Node a -> b -> b) -> b -> Digit (Node a) -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
Instance of class: Foldable of the constraint type Foldable Digit
foldr Node a -> b -> b
f b
z Digit (Node a)
t

        foldrNode :: (a -> b -> b) -> Node a -> b -> b
        foldrNode :: (a -> b -> b) -> Node a -> b -> b
foldrNode a -> b -> b
f Node a
t b
z = (a -> b -> b) -> b -> Node a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
Instance of class: Foldable of the constraint type Foldable Node
foldr a -> b -> b
f b
z Node a
t

        foldrNodeN :: (Node a -> b -> b) -> Node (Node a) -> b -> b
        foldrNodeN :: (Node a -> b -> b) -> Node (Node a) -> b -> b
foldrNodeN Node a -> b -> b
f Node (Node a)
t b
z = (Node a -> b -> b) -> b -> Node (Node a) -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
Instance of class: Foldable of the constraint type Foldable Node
foldr Node a -> b -> b
f b
z Node (Node a)
t
    {-# INLINE foldr #-}


    foldl :: (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') =
        (b -> a -> b) -> b -> Digit a -> b
forall b a. (b -> a -> b) -> b -> Digit a -> b
foldlDigit b -> a -> b
f' ((b -> Node a -> b) -> b -> FingerTree (Node a) -> b
forall b a. (b -> Node a -> b) -> b -> FingerTree (Node a) -> b
foldlTree ((b -> a -> b) -> b -> Node a -> b
forall b a. (b -> a -> b) -> b -> Node a -> b
foldlNode b -> a -> b
f') ((b -> a -> b) -> b -> Digit a -> b
forall b a. (b -> a -> b) -> b -> Digit a -> b
foldlDigit b -> a -> b
f' b
z' Digit a
pr') FingerTree (Node a)
m') Digit a
sf'
      where
        foldlTree :: (b -> Node a -> b) -> b -> FingerTree (Node a) -> b
        foldlTree :: (b -> Node a -> b) -> b -> FingerTree (Node a) -> b
foldlTree 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) =
            (b -> Node a -> b) -> b -> Digit (Node a) -> b
forall b a. (b -> Node a -> b) -> b -> Digit (Node a) -> b
foldlDigitN b -> Node a -> b
f ((b -> Node (Node a) -> b) -> b -> FingerTree (Node (Node a)) -> b
forall b a. (b -> Node a -> b) -> b -> FingerTree (Node a) -> b
foldlTree ((b -> Node a -> b) -> b -> Node (Node a) -> b
forall b a. (b -> Node a -> b) -> b -> Node (Node a) -> b
foldlNodeN b -> Node a -> b
f) ((b -> Node a -> b) -> b -> Digit (Node a) -> b
forall b a. (b -> Node a -> b) -> b -> Digit (Node a) -> b
foldlDigitN b -> Node a -> b
f b
z Digit (Node a)
pr) FingerTree (Node (Node a))
m) Digit (Node a)
sf

        foldlDigit :: (b -> a -> b) -> b -> Digit a -> b
        foldlDigit :: (b -> a -> b) -> b -> Digit a -> b
foldlDigit b -> a -> b
f b
z Digit a
t = (b -> a -> b) -> b -> Digit a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Instance of class: Foldable of the constraint type Foldable Digit
foldl b -> a -> b
f b
z Digit a
t

        foldlDigitN :: (b -> Node a -> b) -> b -> Digit (Node a) -> b
        foldlDigitN :: (b -> Node a -> b) -> b -> Digit (Node a) -> b
foldlDigitN b -> Node a -> b
f b
z Digit (Node a)
t = (b -> Node a -> b) -> b -> Digit (Node a) -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Instance of class: Foldable of the constraint type Foldable Digit
foldl b -> Node a -> b
f b
z Digit (Node a)
t

        foldlNode :: (b -> a -> b) -> b -> Node a -> b
        foldlNode :: (b -> a -> b) -> b -> Node a -> b
foldlNode b -> a -> b
f b
z Node a
t = (b -> a -> b) -> b -> Node a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Instance of class: Foldable of the constraint type Foldable Node
foldl b -> a -> b
f b
z Node a
t

        foldlNodeN :: (b -> Node a -> b) -> b -> Node (Node a) -> b
        foldlNodeN :: (b -> Node a -> b) -> b -> Node (Node a) -> b
foldlNodeN b -> Node a -> b
f b
z Node (Node a)
t = (b -> Node a -> b) -> b -> Node (Node a) -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Instance of class: Foldable of the constraint type Foldable Node
foldl b -> Node a -> b
f b
z Node (Node a)
t
    {-# INLINE foldl #-}

    foldr' :: (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') =
        ((a -> b -> b) -> b -> Digit a -> b
forall a b. (a -> b -> b) -> b -> Digit a -> b
foldrDigit' a -> b -> b
f' (b -> Digit a -> b) -> b -> Digit a -> b
forall a b. (a -> b) -> a -> b
$! ((Node a -> b -> b) -> b -> FingerTree (Node a) -> b
forall a b. (Node a -> b -> b) -> b -> FingerTree (Node a) -> b
foldrTree' ((a -> b -> b) -> Node a -> b -> b
forall a b. (a -> b -> b) -> Node a -> b -> b
foldrNode' a -> b -> b
f') (b -> FingerTree (Node a) -> b) -> b -> FingerTree (Node a) -> b
forall a b. (a -> b) -> a -> b
$! ((a -> b -> b) -> b -> Digit a -> b
forall a b. (a -> b -> b) -> b -> Digit a -> b
foldrDigit' a -> b -> b
f' b
z') Digit a
sf') FingerTree (Node a)
m') Digit a
pr'
      where
        foldrTree' :: (Node a -> b -> b) -> b -> FingerTree (Node a) -> b
        foldrTree' :: (Node a -> b -> b) -> b -> FingerTree (Node a) -> b
foldrTree' 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 (b -> b) -> b -> b
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) =
            ((Node a -> b -> b) -> b -> Digit (Node a) -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
Instance of class: Foldable of the constraint type Foldable Digit
foldr' Node a -> b -> b
f (b -> Digit (Node a) -> b) -> b -> Digit (Node a) -> b
forall a b. (a -> b) -> a -> b
$! ((Node (Node a) -> b -> b) -> b -> FingerTree (Node (Node a)) -> b
forall a b. (Node a -> b -> b) -> b -> FingerTree (Node a) -> b
foldrTree' ((Node a -> b -> b) -> Node (Node a) -> b -> b
forall a b. (Node a -> b -> b) -> Node (Node a) -> b -> b
foldrNodeN' Node a -> b -> b
f) (b -> FingerTree (Node (Node a)) -> b)
-> b -> FingerTree (Node (Node a)) -> b
forall a b. (a -> b) -> a -> b
$! ((Node a -> b -> b) -> b -> Digit (Node a) -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
Instance of class: Foldable of the constraint type Foldable Digit
foldr' Node a -> b -> b
f (b -> Digit (Node a) -> b) -> b -> Digit (Node a) -> b
forall a b. (a -> b) -> a -> b
$! b
z) Digit (Node a)
sf) FingerTree (Node (Node a))
m) Digit (Node a)
pr

        foldrDigit' :: (a -> b -> b) -> b -> Digit a -> b
        foldrDigit' :: (a -> b -> b) -> b -> Digit a -> b
foldrDigit' a -> b -> b
f b
z Digit a
t = (a -> b -> b) -> b -> Digit a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
Instance of class: Foldable of the constraint type Foldable Digit
foldr' a -> b -> b
f b
z Digit a
t

        foldrNode' :: (a -> b -> b) -> Node a -> b -> b
        foldrNode' :: (a -> b -> b) -> Node a -> b -> b
foldrNode' a -> b -> b
f Node a
t b
z = (a -> b -> b) -> b -> Node a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
Instance of class: Foldable of the constraint type Foldable Node
foldr' a -> b -> b
f b
z Node a
t

        foldrNodeN' :: (Node a -> b -> b) -> Node (Node a) -> b -> b
        foldrNodeN' :: (Node a -> b -> b) -> Node (Node a) -> b -> b
foldrNodeN' Node a -> b -> b
f Node (Node a)
t b
z = (Node a -> b -> b) -> b -> Node (Node a) -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
Instance of class: Foldable of the constraint type Foldable Node
foldr' Node a -> b -> b
f b
z Node (Node a)
t
    {-# INLINE foldr' #-}

    foldl' :: (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') =
        ((b -> a -> b) -> b -> Digit a -> b
forall b a. (b -> a -> b) -> b -> Digit a -> b
foldlDigit' b -> a -> b
f' (b -> Digit a -> b) -> b -> Digit a -> b
forall a b. (a -> b) -> a -> b
$!
         ((b -> Node a -> b) -> b -> FingerTree (Node a) -> b
forall b a. (b -> Node a -> b) -> b -> FingerTree (Node a) -> b
foldlTree' ((b -> a -> b) -> b -> Node a -> b
forall b a. (b -> a -> b) -> b -> Node a -> b
foldlNode' b -> a -> b
f') (b -> FingerTree (Node a) -> b) -> b -> FingerTree (Node a) -> b
forall a b. (a -> b) -> a -> b
$! ((b -> a -> b) -> b -> Digit a -> b
forall b a. (b -> a -> b) -> b -> Digit a -> b
foldlDigit' b -> a -> b
f' b
z') Digit a
pr') FingerTree (Node a)
m')
            Digit a
sf'
      where
        foldlTree' :: (b -> Node a -> b) -> b -> FingerTree (Node a) -> b
        foldlTree' :: (b -> Node a -> b) -> b -> FingerTree (Node a) -> b
foldlTree' 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) =
            ((b -> Node a -> b) -> b -> Digit (Node a) -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Instance of class: Foldable of the constraint type Foldable Digit
foldl' b -> Node a -> b
f (b -> Digit (Node a) -> b) -> b -> Digit (Node a) -> b
forall a b. (a -> b) -> a -> b
$! ((b -> Node (Node a) -> b) -> b -> FingerTree (Node (Node a)) -> b
forall b a. (b -> Node a -> b) -> b -> FingerTree (Node a) -> b
foldlTree' ((b -> Node a -> b) -> b -> Node (Node a) -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Instance of class: Foldable of the constraint type Foldable Node
foldl' b -> Node a -> b
f) (b -> FingerTree (Node (Node a)) -> b)
-> b -> FingerTree (Node (Node a)) -> b
forall a b. (a -> b) -> a -> b
$! (b -> Node a -> b) -> b -> Digit (Node a) -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Instance of class: Foldable of the constraint type Foldable Digit
foldl' b -> Node a -> b
f b
z Digit (Node a)
pr) FingerTree (Node (Node a))
m) Digit (Node a)
sf

        foldlDigit' :: (b -> a -> b) -> b -> Digit a -> b
        foldlDigit' :: (b -> a -> b) -> b -> Digit a -> b
foldlDigit' b -> a -> b
f b
z Digit a
t = (b -> a -> b) -> b -> Digit a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Instance of class: Foldable of the constraint type Foldable Digit
foldl' b -> a -> b
f b
z Digit a
t

        foldlNode' :: (b -> a -> b) -> b -> Node a -> b
        foldlNode' :: (b -> a -> b) -> b -> Node a -> b
foldlNode' b -> a -> b
f b
z Node a
t = (b -> a -> b) -> b -> Node a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Instance of class: Foldable of the constraint type Foldable Node
foldl' b -> a -> b
f b
z Node a
t
    {-# INLINE foldl' #-}

    foldr1 :: (a -> a -> a) -> FingerTree a -> a
foldr1 a -> a -> a
_ FingerTree a
EmptyT = [Char] -> a
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) =
        (a -> a -> a) -> a -> Digit a -> a
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
Instance of class: Foldable of the constraint type Foldable Digit
foldr a -> a -> a
f ((Node a -> a -> a) -> a -> FingerTree (Node a) -> a
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
Instance of class: Foldable of the constraint type Foldable FingerTree
foldr ((a -> Node a -> a) -> Node a -> a -> a
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((a -> a -> a) -> a -> Node a -> a
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
Instance of class: Foldable of the constraint type Foldable Node
foldr a -> a -> a
f)) ((a -> a -> a) -> Digit a -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
Instance of class: Foldable of the constraint type Foldable Digit
foldr1 a -> a -> a
f Digit a
sf) FingerTree (Node a)
m) Digit a
pr

    foldl1 :: (a -> a -> a) -> FingerTree a -> a
foldl1 a -> a -> a
_ FingerTree a
EmptyT = [Char] -> a
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) =
        (a -> a -> a) -> a -> Digit a -> a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Instance of class: Foldable of the constraint type Foldable Digit
foldl a -> a -> a
f ((a -> Node a -> a) -> a -> FingerTree (Node a) -> a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Instance of class: Foldable of the constraint type Foldable FingerTree
foldl ((a -> a -> a) -> a -> Node a -> a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Instance of class: Foldable of the constraint type Foldable Node
foldl a -> a -> a
f) ((a -> a -> a) -> Digit a -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
Instance of class: Foldable of the constraint type Foldable Digit
foldl1 a -> a -> a
f Digit a
pr) FingerTree (Node a)
m) Digit a
sf

instance Functor FingerTree where
    fmap :: (a -> b) -> FingerTree a -> FingerTree b
fmap a -> b
_ FingerTree a
EmptyT = FingerTree b
forall a. FingerTree a
EmptyT
    fmap a -> b
f (Single a
x) = b -> FingerTree b
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) =
        Int -> Digit b -> FingerTree (Node b) -> Digit b -> FingerTree b
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
v ((a -> b) -> Digit a -> Digit b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Instance of class: Functor of the constraint type Functor Digit
fmap a -> b
f Digit a
pr) ((Node a -> Node b) -> FingerTree (Node a) -> FingerTree (Node b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Instance of class: Functor of the constraint type Functor FingerTree
fmap ((a -> b) -> Node a -> Node b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Instance of class: Functor of the constraint type Functor Node
fmap a -> b
f) FingerTree (Node a)
m) ((a -> b) -> Digit a -> Digit b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Instance of class: Functor of the constraint type Functor Digit
fmap a -> b
f Digit a
sf)

instance Traversable FingerTree where
    traverse :: (a -> f b) -> FingerTree a -> f (FingerTree b)
traverse a -> f b
_ FingerTree a
EmptyT = FingerTree b -> f (FingerTree b)
forall (f :: * -> *) a. Applicative f => a -> f a
Evidence bound by a type signature of the constraint type Applicative f
pure FingerTree b
forall a. FingerTree a
EmptyT
    traverse a -> f b
f (Single a
x) = b -> FingerTree b
forall a. a -> FingerTree a
Single (b -> FingerTree b) -> f b -> f (FingerTree b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
External instance of the constraint type forall (f :: * -> *). Applicative f => Functor f
Evidence bound by a type signature of the constraint type Applicative f
<$> a -> f b
f a
x
    traverse a -> f b
f (Deep Int
v Digit a
pr FingerTree (Node a)
m Digit a
sf) =
        (Digit b -> FingerTree (Node b) -> Digit b -> FingerTree b)
-> f (Digit b)
-> f (FingerTree (Node b))
-> f (Digit b)
-> f (FingerTree b)
forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
Evidence bound by a type signature of the constraint type Applicative f
liftA3 (Int -> Digit b -> FingerTree (Node b) -> Digit b -> FingerTree b
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
v) ((a -> f b) -> Digit a -> f (Digit b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
Evidence bound by a type signature of the constraint type Applicative f
Instance of class: Traversable of the constraint type Traversable Digit
traverse a -> f b
f Digit a
pr) ((Node a -> f (Node b))
-> FingerTree (Node a) -> f (FingerTree (Node b))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
Evidence bound by a type signature of the constraint type Applicative f
Instance of class: Traversable of the constraint type Traversable FingerTree
traverse ((a -> f b) -> Node a -> f (Node b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
Evidence bound by a type signature of the constraint type Applicative f
Instance of class: Traversable of the constraint type Traversable Node
traverse a -> f b
f) FingerTree (Node a)
m)
            ((a -> f b) -> Digit a -> f (Digit b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
Evidence bound by a type signature of the constraint type Applicative f
Instance of class: Traversable of the constraint type Traversable Digit
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) = a -> ()
forall a. NFData a => a -> ()
Evidence bound by a type signature of the constraint type NFData a
rnf a
x
    rnf (Deep Int
_ Digit a
pr FingerTree (Node a)
m Digit a
sf) = Digit a -> ()
forall a. NFData a => a -> ()
Instance of class: NFData of the constraint type forall a. NFData a => NFData (Digit a)
Evidence bound by a type signature of the constraint type NFData a
rnf Digit a
pr () -> () -> ()
`seq` Digit a -> ()
forall a. NFData a => a -> ()
Instance of class: NFData of the constraint type forall a. NFData a => NFData (Digit a)
Evidence bound by a type signature of the constraint type NFData a
rnf Digit a
sf () -> () -> ()
`seq` FingerTree (Node a) -> ()
forall a. NFData a => a -> ()
Instance of class: NFData of the constraint type forall a. NFData a => NFData (FingerTree a)
Instance of class: NFData of the constraint type forall a. NFData a => NFData (Node a)
Evidence bound by a type signature of the constraint type NFData a
rnf FingerTree (Node a)
m

{-# INLINE deep #-}
deep            :: Sized a => Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
deep :: Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
deep Digit a
pr FingerTree (Node a)
m Digit a
sf    =  Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Digit a -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized a => Sized (Digit a)
Evidence bound by a type signature of the constraint type Sized a
size Digit a
pr Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ FingerTree (Node a) -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized a => Sized (FingerTree a)
Instance of class: Sized of the constraint type forall a. Sized (Node a)
size FingerTree (Node a)
m Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Digit a -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized a => Sized (Digit a)
Evidence bound by a type signature of the constraint type Sized a
size Digit a
sf) Digit a
pr FingerTree (Node a)
m Digit a
sf

{-# INLINE pullL #-}
pullL :: Int -> FingerTree (Node a) -> Digit a -> FingerTree a
pullL :: Int -> FingerTree (Node a) -> Digit a -> FingerTree a
pullL Int
s FingerTree (Node a)
m Digit a
sf = case FingerTree (Node a) -> ViewLTree (Node a)
forall a. Sized a => FingerTree a -> ViewLTree a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
viewLTree FingerTree (Node a)
m of
    ViewLTree (Node a)
EmptyLTree          -> Int -> Digit a -> FingerTree a
forall a. Int -> Digit a -> FingerTree a
digitToTree' Int
s Digit a
sf
    ConsLTree Node a
pr FingerTree (Node a)
m'     -> Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
s (Node a -> Digit a
forall a. Node a -> Digit a
nodeToDigit Node a
pr) FingerTree (Node a)
m' Digit a
sf

{-# INLINE pullR #-}
pullR :: Int -> Digit a -> FingerTree (Node a) -> FingerTree a
pullR :: Int -> Digit a -> FingerTree (Node a) -> FingerTree a
pullR Int
s Digit a
pr FingerTree (Node a)
m = case FingerTree (Node a) -> ViewRTree (Node a)
forall a. Sized a => FingerTree a -> ViewRTree a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
viewRTree FingerTree (Node a)
m of
    ViewRTree (Node a)
EmptyRTree          -> Int -> Digit a -> FingerTree a
forall a. Int -> Digit a -> FingerTree a
digitToTree' Int
s Digit a
pr
    SnocRTree FingerTree (Node a)
m' Node a
sf     -> Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
s Digit a
pr FingerTree (Node a)
m' (Node a -> Digit a
forall a. Node a -> Digit a
nodeToDigit Node a
sf)

-- Digits

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__
-- | @since 0.6.1
deriving instance Generic1 Digit

-- | @since 0.6.1
deriving instance Generic (Digit a)
#endif

foldDigit :: (b -> b -> b) -> (a -> b) -> Digit a -> b
foldDigit :: (b -> b -> b) -> (a -> b) -> Digit a -> b
foldDigit 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 :: (a -> m) -> Digit a -> m
foldMap = (m -> m -> m) -> (a -> m) -> Digit a -> m
forall b a. (b -> b -> b) -> (a -> b) -> Digit a -> b
foldDigit m -> m -> m
forall a. Monoid a => a -> a -> a
Evidence bound by a type signature of the constraint type Monoid m
mappend

    foldr :: (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 :: (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' :: (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 (b -> b) -> b -> b
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 (b -> b) -> b -> b
forall a b. (a -> b) -> a -> b
$! a -> b -> b
f a
b (b -> b) -> b -> b
forall a b. (a -> b) -> a -> b
$! a -> b -> b
f a
c b
z
    foldr' a -> b -> b
f b
z (Four a
a a
b a
c a
d) = a -> b -> b
f a
a (b -> b) -> b -> b
forall a b. (a -> b) -> a -> b
$! a -> b -> b
f a
b (b -> b) -> b -> b
forall a b. (a -> b) -> a -> b
$! a -> b -> b
f a
c (b -> b) -> b -> b
forall a b. (a -> b) -> a -> b
$! a -> b -> b
f a
d b
z
    {-# INLINE foldr' #-}

    foldl' :: (b -> a -> b) -> b -> Digit a -> b
foldl' 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 (b -> a -> b) -> b -> a -> b
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 (b -> a -> b) -> b -> a -> b
forall a b. (a -> b) -> a -> b
$! (b -> a -> b
f (b -> a -> b) -> b -> a -> b
forall a b. (a -> b) -> a -> b
$! b -> a -> b
f b
z a
a) a
b) a
c
    foldl' b -> a -> b
f b
z (Four a
a a
b a
c a
d) = (b -> a -> b
f (b -> a -> b) -> b -> a -> b
forall a b. (a -> b) -> a -> b
$! (b -> a -> b
f (b -> a -> b) -> b -> a -> b
forall a b. (a -> b) -> a -> b
$! (b -> a -> b
f (b -> a -> b) -> b -> a -> b
forall a b. (a -> b) -> a -> b
$! b -> a -> b
f b
z a
a) a
b) a
c) a
d
    {-# INLINE foldl' #-}

    foldr1 :: (a -> a -> a) -> Digit a -> a
foldr1 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 :: (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 :: (a -> b) -> Digit a -> Digit b
fmap a -> b
f (One a
a) = b -> Digit b
forall a. a -> Digit a
One (a -> b
f a
a)
    fmap a -> b
f (Two a
a a
b) = b -> b -> Digit 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) = b -> b -> b -> Digit b
forall a. a -> a -> a -> Digit a
Three (a -> b
f a
a) (a -> b
f a
b) (a -> b
f a
c)
    fmap a -> b
f (Four a
a a
b a
c a
d) = b -> b -> b -> b -> Digit b
forall a. a -> a -> a -> a -> Digit a
Four (a -> b
f a
a) (a -> b
f a
b) (a -> b
f a
c) (a -> b
f a
d)

instance Traversable Digit where
    {-# INLINE traverse #-}
    traverse :: (a -> f b) -> Digit a -> f (Digit b)
traverse a -> f b
f (One a
a) = b -> Digit b
forall a. a -> Digit a
One (b -> Digit b) -> f b -> f (Digit b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
External instance of the constraint type forall (f :: * -> *). Applicative f => Functor f
Evidence bound by a type signature of the constraint type Applicative f
<$> a -> f b
f a
a
    traverse a -> f b
f (Two a
a a
b) = (b -> b -> Digit b) -> f b -> f b -> f (Digit b)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
Evidence bound by a type signature of the constraint type Applicative f
liftA2 b -> b -> Digit b
forall a. a -> a -> Digit a
Two (a -> f b
f a
a) (a -> f b
f a
b)
    traverse a -> f b
f (Three a
a a
b a
c) = (b -> b -> b -> Digit b) -> f b -> f b -> f b -> f (Digit b)
forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
Evidence bound by a type signature of the constraint type Applicative f
liftA3 b -> b -> b -> Digit b
forall a. a -> a -> a -> Digit a
Three (a -> f b
f a
a) (a -> f b
f a
b) (a -> f b
f a
c)
    traverse a -> f b
f (Four a
a a
b a
c a
d) = (b -> b -> b -> b -> Digit b)
-> f b -> f b -> f b -> f (b -> Digit b)
forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
Evidence bound by a type signature of the constraint type Applicative f
liftA3 b -> b -> b -> b -> Digit b
forall a. a -> a -> a -> a -> Digit a
Four (a -> f b
f a
a) (a -> f b
f a
b) (a -> f b
f a
c) f (b -> Digit b) -> f b -> f (Digit b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Evidence bound by a type signature of the constraint type Applicative f
<*> a -> f b
f a
d

instance NFData a => NFData (Digit a) where
    rnf :: Digit a -> ()
rnf (One a
a) = a -> ()
forall a. NFData a => a -> ()
Evidence bound by a type signature of the constraint type NFData a
rnf a
a
    rnf (Two a
a a
b) = a -> ()
forall a. NFData a => a -> ()
Evidence bound by a type signature of the constraint type NFData a
rnf a
a () -> () -> ()
`seq` a -> ()
forall a. NFData a => a -> ()
Evidence bound by a type signature of the constraint type NFData a
rnf a
b
    rnf (Three a
a a
b a
c) = a -> ()
forall a. NFData a => a -> ()
Evidence bound by a type signature of the constraint type NFData a
rnf a
a () -> () -> ()
`seq` a -> ()
forall a. NFData a => a -> ()
Evidence bound by a type signature of the constraint type NFData a
rnf a
b () -> () -> ()
`seq` a -> ()
forall a. NFData a => a -> ()
Evidence bound by a type signature of the constraint type NFData a
rnf a
c
    rnf (Four a
a a
b a
c a
d) = a -> ()
forall a. NFData a => a -> ()
Evidence bound by a type signature of the constraint type NFData a
rnf a
a () -> () -> ()
`seq` a -> ()
forall a. NFData a => a -> ()
Evidence bound by a type signature of the constraint type NFData a
rnf a
b () -> () -> ()
`seq` a -> ()
forall a. NFData a => a -> ()
Evidence bound by a type signature of the constraint type NFData a
rnf a
c () -> () -> ()
`seq` a -> ()
forall a. NFData a => a -> ()
Evidence bound by a type signature of the constraint type NFData a
rnf a
d

instance Sized a => Sized (Digit a) where
    {-# INLINE size #-}
    size :: Digit a -> Int
size = (Int -> Int -> Int) -> Digit Int -> Int
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
Instance of class: Foldable of the constraint type Foldable Digit
foldl1 Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
(+) (Digit Int -> Int) -> (Digit a -> Digit Int) -> Digit a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Int) -> Digit a -> Digit Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Instance of class: Functor of the constraint type Functor Digit
fmap a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
size

{-# SPECIALIZE digitToTree :: Digit (Elem a) -> FingerTree (Elem a) #-}
{-# SPECIALIZE digitToTree :: Digit (Node a) -> FingerTree (Node a) #-}
digitToTree     :: Sized a => Digit a -> FingerTree a
digitToTree :: Digit a -> FingerTree a
digitToTree (One a
a) = a -> FingerTree a
forall a. a -> FingerTree a
Single a
a
digitToTree (Two a
a a
b) = Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
forall a.
Sized a =>
Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Evidence bound by a type signature of the constraint type Sized a
deep (a -> Digit a
forall a. a -> Digit a
One a
a) FingerTree (Node a)
forall a. FingerTree a
EmptyT (a -> Digit a
forall a. a -> Digit a
One a
b)
digitToTree (Three a
a a
b a
c) = Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
forall a.
Sized a =>
Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Evidence bound by a type signature of the constraint type Sized a
deep (a -> a -> Digit a
forall a. a -> a -> Digit a
Two a
a a
b) FingerTree (Node a)
forall a. FingerTree a
EmptyT (a -> Digit a
forall a. a -> Digit a
One a
c)
digitToTree (Four a
a a
b a
c a
d) = Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
forall a.
Sized a =>
Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Evidence bound by a type signature of the constraint type Sized a
deep (a -> a -> Digit a
forall a. a -> a -> Digit a
Two a
a a
b) FingerTree (Node a)
forall a. FingerTree a
EmptyT (a -> a -> Digit a
forall a. a -> a -> Digit a
Two a
c a
d)

-- | Given the size of a digit and the digit itself, efficiently converts
-- it to a FingerTree.
digitToTree' :: Int -> Digit a -> FingerTree a
digitToTree' :: Int -> Digit a -> FingerTree a
digitToTree' Int
n (Four a
a a
b a
c a
d) = Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
n (a -> a -> Digit a
forall a. a -> a -> Digit a
Two a
a a
b) FingerTree (Node a)
forall a. FingerTree a
EmptyT (a -> a -> Digit a
forall a. a -> a -> Digit a
Two a
c a
d)
digitToTree' Int
n (Three a
a a
b a
c) = Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
n (a -> a -> Digit a
forall a. a -> a -> Digit a
Two a
a a
b) FingerTree (Node a)
forall a. FingerTree a
EmptyT (a -> Digit a
forall a. a -> Digit a
One a
c)
digitToTree' Int
n (Two a
a a
b) = Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
n (a -> Digit a
forall a. a -> Digit a
One a
a) FingerTree (Node a)
forall a. FingerTree a
EmptyT (a -> Digit a
forall a. a -> Digit a
One a
b)
digitToTree' !Int
_n (One a
a) = a -> FingerTree a
forall a. a -> FingerTree a
Single a
a

-- Nodes

data Node a
    = Node2 {-# UNPACK #-} !Int a a
    | Node3 {-# UNPACK #-} !Int a a a
#ifdef TESTING
    deriving Show
#endif

#ifdef __GLASGOW_HASKELL__
-- | @since 0.6.1
deriving instance Generic1 Node

-- | @since 0.6.1
deriving instance Generic (Node a)
#endif

foldNode :: (b -> b -> b) -> (a -> b) -> Node a -> b
foldNode :: (b -> b -> b) -> (a -> b) -> Node a -> b
foldNode b -> b -> b
(<+>) 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 :: (a -> m) -> Node a -> m
foldMap = (m -> m -> m) -> (a -> m) -> Node a -> m
forall b a. (b -> b -> b) -> (a -> b) -> Node a -> b
foldNode m -> m -> m
forall a. Monoid a => a -> a -> a
Evidence bound by a type signature of the constraint type Monoid m
mappend

    foldr :: (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 :: (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' :: (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 (b -> b) -> b -> b
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 (b -> b) -> b -> b
forall a b. (a -> b) -> a -> b
$! a -> b -> b
f a
b (b -> b) -> b -> b
forall a b. (a -> b) -> a -> b
$! a -> b -> b
f a
c b
z
    {-# INLINE foldr' #-}

    foldl' :: (b -> a -> b) -> b -> Node a -> b
foldl' b -> a -> b
f b
z (Node2 Int
_ a
a a
b) = (b -> a -> b
f (b -> a -> b) -> b -> a -> b
forall a b. (a -> b) -> a -> b
$! b -> a -> b
f b
z a
a) a
b
    foldl' b -> a -> b
f b
z (Node3 Int
_ a
a a
b a
c) = (b -> a -> b
f (b -> a -> b) -> b -> a -> b
forall a b. (a -> b) -> a -> b
$! (b -> a -> b
f (b -> a -> b) -> b -> a -> b
forall a b. (a -> b) -> a -> b
$! b -> a -> b
f b
z a
a) a
b) a
c
    {-# INLINE foldl' #-}

instance Functor Node where
    {-# INLINE fmap #-}
    fmap :: (a -> b) -> Node a -> Node b
fmap a -> b
f (Node2 Int
v a
a a
b) = Int -> b -> b -> Node b
forall a. Int -> a -> a -> Node a
Node2 Int
v (a -> b
f a
a) (a -> b
f a
b)
    fmap a -> b
f (Node3 Int
v a
a a
b a
c) = Int -> b -> b -> b -> Node b
forall a. Int -> a -> a -> a -> Node a
Node3 Int
v (a -> b
f a
a) (a -> b
f a
b) (a -> b
f a
c)

instance Traversable Node where
    {-# INLINE traverse #-}
    traverse :: (a -> f b) -> Node a -> f (Node b)
traverse a -> f b
f (Node2 Int
v a
a a
b) = (b -> b -> Node b) -> f b -> f b -> f (Node b)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
Evidence bound by a type signature of the constraint type Applicative f
liftA2 (Int -> b -> b -> Node b
forall a. Int -> a -> a -> Node a
Node2 Int
v) (a -> f b
f a
a) (a -> f b
f a
b)
    traverse a -> f b
f (Node3 Int
v a
a a
b a
c) = (b -> b -> b -> Node b) -> f b -> f b -> f b -> f (Node b)
forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
Evidence bound by a type signature of the constraint type Applicative f
liftA3 (Int -> b -> b -> b -> Node b
forall a. Int -> a -> a -> a -> Node a
Node3 Int
v) (a -> f b
f a
a) (a -> f b
f a
b) (a -> f b
f a
c)

instance NFData a => NFData (Node a) where
    rnf :: Node a -> ()
rnf (Node2 Int
_ a
a a
b) = a -> ()
forall a. NFData a => a -> ()
Evidence bound by a type signature of the constraint type NFData a
rnf a
a () -> () -> ()
`seq` a -> ()
forall a. NFData a => a -> ()
Evidence bound by a type signature of the constraint type NFData a
rnf a
b
    rnf (Node3 Int
_ a
a a
b a
c) = a -> ()
forall a. NFData a => a -> ()
Evidence bound by a type signature of the constraint type NFData a
rnf a
a () -> () -> ()
`seq` a -> ()
forall a. NFData a => a -> ()
Evidence bound by a type signature of the constraint type NFData a
rnf a
b () -> () -> ()
`seq` a -> ()
forall a. NFData a => a -> ()
Evidence bound by a type signature of the constraint type NFData 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 :: a -> a -> Node a
node2 a
a a
b       =  Int -> a -> a -> Node a
forall a. Int -> a -> a -> Node a
Node2 (a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
size a
a Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
size a
b) a
a a
b

{-# INLINE node3 #-}
node3           :: Sized a => a -> a -> a -> Node a
node3 :: a -> a -> a -> Node a
node3 a
a a
b a
c     =  Int -> a -> a -> a -> Node a
forall a. Int -> a -> a -> a -> Node a
Node3 (a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
size a
a Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
size a
b Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
size a
c) a
a a
b a
c

nodeToDigit :: Node a -> Digit a
nodeToDigit :: Node a -> Digit a
nodeToDigit (Node2 Int
_ a
a a
b) = a -> a -> Digit a
forall a. a -> a -> Digit a
Two a
a a
b
nodeToDigit (Node3 Int
_ a
a a
b a
c) = a -> a -> a -> Digit a
forall a. a -> a -> a -> Digit a
Three a
a a
b a
c

-- Elements

newtype Elem a  =  Elem { Elem a -> a
getElem :: a }
#ifdef TESTING
    deriving Show
#endif

#ifdef __GLASGOW_HASKELL__
-- | @since 0.6.1
deriving instance Generic1 Elem

-- | @since 0.6.1
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
-- This cuts the time for <*> by around a fifth.
    fmap :: (a -> b) -> Elem a -> Elem b
fmap = (a -> b) -> Elem a -> Elem b
coerce
#else
    fmap f (Elem x) = Elem (f x)
#endif

instance Foldable Elem where
    foldr :: (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 :: (a -> m) -> Elem a -> m
foldMap = (a -> m) -> Elem a -> m
coerce
    foldl :: (b -> a -> b) -> b -> Elem a -> b
foldl = (b -> a -> b) -> b -> Elem a -> b
coerce
    foldl' :: (b -> a -> b) -> b -> Elem a -> b
foldl' = (b -> a -> b) -> b -> Elem a -> b
coerce
#else
    foldMap f (Elem x) = f x
    foldl f z (Elem x) = f z x
    foldl' f z (Elem x) = f z x
#endif

instance Traversable Elem where
    traverse :: (a -> f b) -> Elem a -> f (Elem b)
traverse a -> f b
f (Elem a
x) = b -> Elem b
forall a. a -> Elem a
Elem (b -> Elem b) -> f b -> f (Elem b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
External instance of the constraint type forall (f :: * -> *). Applicative f => Functor f
Evidence bound by a type signature of the constraint type Applicative f
<$> a -> f b
f a
x

instance NFData a => NFData (Elem a) where
    rnf :: Elem a -> ()
rnf (Elem a
x) = a -> ()
forall a. NFData a => a -> ()
Evidence bound by a type signature of the constraint type NFData a
rnf a
x

-------------------------------------------------------
-- Applicative construction
-------------------------------------------------------
#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

-- | 'applicativeTree' takes an Applicative-wrapped construction of a
-- piece of a FingerTree, assumed to always have the same size (which
-- is put in the second argument), and replicates it as many times as
-- specified.  This is a generalization of 'replicateA', which itself
-- is a generalization of many Data.Sequence methods.
{-# SPECIALIZE applicativeTree :: Int -> Int -> State s a -> State s (FingerTree a) #-}
{-# SPECIALIZE applicativeTree :: Int -> Int -> Identity a -> Identity (FingerTree a) #-}
-- Special note: the Identity specialization automatically does node sharing,
-- reducing memory usage of the resulting tree to /O(log n)/.
applicativeTree :: Applicative f => Int -> Int -> f a -> f (FingerTree a)
applicativeTree :: Int -> Int -> f a -> f (FingerTree a)
applicativeTree Int
n !Int
mSize f a
m = case Int
n of
    Int
0 -> FingerTree a -> f (FingerTree a)
forall (f :: * -> *) a. Applicative f => a -> f a
Evidence bound by a type signature of the constraint type Applicative f
pure FingerTree a
forall a. FingerTree a
EmptyT
    Int
1 -> (a -> FingerTree a) -> f a -> f (FingerTree a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
External instance of the constraint type forall (f :: * -> *). Applicative f => Functor f
Evidence bound by a type signature of the constraint type Applicative f
fmap a -> FingerTree a
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 f (FingerTree (Node a))
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 f (FingerTree (Node a))
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 f (FingerTree (Node a))
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 f (FingerTree (Node a))
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 f (FingerTree (Node a))
forall {a}. f (FingerTree a)
emptyTree f (Digit a)
three
    Int
_ -> case Int
n Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
External instance of the constraint type Integral Int
`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 (Int -> Int -> f (Node a) -> f (FingerTree (Node a))
forall (f :: * -> *) a.
Applicative f =>
Int -> Int -> f a -> f (FingerTree a)
Evidence bound by a type signature of the constraint type Applicative f
applicativeTree (Int
q Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- 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 (Int -> Int -> f (Node a) -> f (FingerTree (Node a))
forall (f :: * -> *) a.
Applicative f =>
Int -> Int -> f a -> f (FingerTree a)
Evidence bound by a type signature of the constraint type Applicative f
applicativeTree (Int
q Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- 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 (Int -> Int -> f (Node a) -> f (FingerTree (Node a))
forall (f :: * -> *) a.
Applicative f =>
Int -> Int -> f a -> f (FingerTree a)
Evidence bound by a type signature of the constraint type Applicative f
applicativeTree (Int
q Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
1) Int
mSize' f (Node a)
n3) f (Digit a)
two
      where !mSize' :: Int
mSize' = Int
3 Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
* Int
mSize
            n3 :: f (Node a)
n3 = (a -> a -> a -> Node a) -> f a -> f a -> f a -> f (Node a)
forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
Evidence bound by a type signature of the constraint type Applicative f
liftA3 (Int -> a -> a -> a -> Node a
forall a. Int -> a -> a -> a -> Node a
Node3 Int
mSize') f a
m f a
m f a
m
  where
    one :: f (Digit a)
one = (a -> Digit a) -> f a -> f (Digit a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
External instance of the constraint type forall (f :: * -> *). Applicative f => Functor f
Evidence bound by a type signature of the constraint type Applicative f
fmap a -> Digit a
forall a. a -> Digit a
One f a
m
    two :: f (Digit a)
two = (a -> a -> Digit a) -> f a -> f a -> f (Digit a)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
Evidence bound by a type signature of the constraint type Applicative f
liftA2 a -> a -> Digit a
forall a. a -> a -> Digit a
Two f a
m f a
m
    three :: f (Digit a)
three = (a -> a -> a -> Digit a) -> f a -> f a -> f a -> f (Digit a)
forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
Evidence bound by a type signature of the constraint type Applicative f
liftA3 a -> a -> a -> Digit a
forall a. a -> a -> a -> Digit a
Three f a
m f a
m f a
m
    deepA :: f (Digit a)
-> f (FingerTree (Node a)) -> f (Digit a) -> f (FingerTree a)
deepA = (Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a)
-> f (Digit a)
-> f (FingerTree (Node a))
-> f (Digit a)
-> f (FingerTree a)
forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
Evidence bound by a type signature of the constraint type Applicative f
liftA3 (Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
* Int
mSize))
    emptyTree :: f (FingerTree a)
emptyTree = FingerTree a -> f (FingerTree a)
forall (f :: * -> *) a. Applicative f => a -> f a
Evidence bound by a type signature of the constraint type Applicative f
pure FingerTree a
forall a. FingerTree a
EmptyT

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

-- | \( O(1) \). The empty sequence.
empty           :: Seq a
empty :: Seq a
empty           =  FingerTree (Elem a) -> Seq a
forall a. FingerTree (Elem a) -> Seq a
Seq FingerTree (Elem a)
forall a. FingerTree a
EmptyT

-- | \( O(1) \). A singleton sequence.
singleton       :: a -> Seq a
singleton :: a -> Seq a
singleton a
x     =  FingerTree (Elem a) -> Seq a
forall a. FingerTree (Elem a) -> Seq a
Seq (Elem a -> FingerTree (Elem a)
forall a. a -> FingerTree a
Single (a -> Elem a
forall a. a -> Elem a
Elem a
x))

-- | \( O(\log n) \). @replicate n x@ is a sequence consisting of @n@ copies of @x@.
replicate       :: Int -> a -> Seq a
replicate :: Int -> a -> Seq a
replicate Int
n a
x
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
>= Int
0      = Identity (Seq a) -> Seq a
forall a. Identity a -> a
runIdentity (Int -> Identity a -> Identity (Seq a)
forall (f :: * -> *) a. Applicative f => Int -> f a -> f (Seq a)
External instance of the constraint type Applicative Identity
replicateA Int
n (a -> Identity a
forall a. a -> Identity a
Identity a
x))
  | Bool
otherwise   = [Char] -> Seq a
forall a. HasCallStack => [Char] -> a
error [Char]
"replicate takes a nonnegative integer argument"

-- | 'replicateA' is an 'Applicative' version of 'replicate', and makes
-- \( O(\log n) \) calls to 'liftA2' and 'pure'.
--
-- > replicateA n x = sequenceA (replicate n x)
replicateA :: Applicative f => Int -> f a -> f (Seq a)
replicateA :: Int -> f a -> f (Seq a)
replicateA Int
n f a
x
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
>= Int
0      = FingerTree (Elem a) -> Seq a
forall a. FingerTree (Elem a) -> Seq a
Seq (FingerTree (Elem a) -> Seq a)
-> f (FingerTree (Elem a)) -> f (Seq a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
External instance of the constraint type forall (f :: * -> *). Applicative f => Functor f
Evidence bound by a type signature of the constraint type Applicative f
<$> Int -> Int -> f (Elem a) -> f (FingerTree (Elem a))
forall (f :: * -> *) a.
Applicative f =>
Int -> Int -> f a -> f (FingerTree a)
Evidence bound by a type signature of the constraint type Applicative f
applicativeTree Int
n Int
1 (a -> Elem a
forall a. a -> Elem a
Elem (a -> Elem a) -> f a -> f (Elem a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
External instance of the constraint type forall (f :: * -> *). Applicative f => Functor f
Evidence bound by a type signature of the constraint type Applicative f
<$> f a
x)
  | Bool
otherwise   = [Char] -> f (Seq a)
forall a. HasCallStack => [Char] -> a
error [Char]
"replicateA takes a nonnegative integer argument"
{-# SPECIALIZE replicateA :: Int -> State a b -> State a (Seq b) #-}

-- | 'replicateM' is a sequence counterpart of 'Control.Monad.replicateM'.
--
-- > replicateM n x = sequence (replicate n x)
--
-- For @base >= 4.8.0@ and @containers >= 0.5.11@, 'replicateM'
-- is a synonym for 'replicateA'.
#if MIN_VERSION_base(4,8,0)
replicateM :: Applicative m => Int -> m a -> m (Seq a)
replicateM :: Int -> m a -> m (Seq a)
replicateM = Int -> m a -> m (Seq a)
forall (f :: * -> *) a. Applicative f => Int -> f a -> f (Seq a)
Evidence bound by a type signature of the constraint type Applicative m
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

-- | /O(/log/ k)/. @'cycleTaking' k xs@ forms a sequence of length @k@ by
-- repeatedly concatenating @xs@ with itself. @xs@ may only be empty if
-- @k@ is 0.
--
-- prop> cycleTaking k = fromList . take k . cycle . toList

-- If you wish to concatenate a possibly empty sequence @xs@ with
-- itself precisely @k@ times, use @'stimes' k xs@ instead of this
-- function.
--
-- @since 0.5.8
cycleTaking :: Int -> Seq a -> Seq a
cycleTaking :: Int -> Seq a -> Seq a
cycleTaking Int
n !Seq a
_xs | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
<= Int
0 = Seq a
forall a. Seq a
empty
cycleTaking Int
_n Seq a
xs  | Seq a -> Bool
forall a. Seq a -> Bool
null Seq a
xs = [Char] -> Seq a
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 = Int -> Seq a -> Seq a
forall a. Int -> Seq a -> Seq a
cycleNTimes Int
reps Seq a
xs Seq a -> Seq a -> Seq a
forall a. Seq a -> Seq a -> Seq a
>< Int -> Seq a -> Seq a
forall a. Int -> Seq a -> Seq a
take Int
final Seq a
xs
  where
    (Int
reps, Int
final) = Int
n Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
External instance of the constraint type Integral Int
`quotRem` Seq a -> Int
forall a. Seq a -> Int
length Seq a
xs

-- \( O(\log(kn)) \). @'cycleNTimes' k xs@ concatenates @k@ copies of @xs@. This
-- operation uses time and additional space logarithmic in the size of its
-- result.
cycleNTimes :: Int -> Seq a -> Seq a
cycleNTimes :: Int -> Seq a -> Seq a
cycleNTimes Int
n !Seq a
xs
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
<= Int
0    = Seq a
forall a. Seq a
empty
  | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq Int
== Int
1    = Seq a
xs
cycleNTimes Int
n (Seq FingerTree (Elem a)
xsFT) = case FingerTree (Elem a) -> Rigidified (Elem a)
forall a. FingerTree (Elem a) -> Rigidified (Elem a)
rigidify FingerTree (Elem a)
xsFT of
             Rigidified (Elem a)
RigidEmpty -> Seq a
forall a. Seq a
empty
             RigidOne (Elem a
x) -> Int -> a -> Seq a
forall a. Int -> a -> Seq a
replicate Int
n a
x
             RigidTwo Elem a
x1 Elem a
x2 -> FingerTree (Elem a) -> Seq a
forall a. FingerTree (Elem a) -> Seq a
Seq (FingerTree (Elem a) -> Seq a) -> FingerTree (Elem a) -> Seq a
forall a b. (a -> b) -> a -> b
$
               Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> FingerTree (Elem a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
*Int
2) Digit (Elem a)
pair
                    (Identity (FingerTree (Node (Elem a))) -> FingerTree (Node (Elem a))
forall a. Identity a -> a
runIdentity (Identity (FingerTree (Node (Elem a)))
 -> FingerTree (Node (Elem a)))
-> Identity (FingerTree (Node (Elem a)))
-> FingerTree (Node (Elem a))
forall a b. (a -> b) -> a -> b
$ Int
-> Int
-> Identity (Node (Elem a))
-> Identity (FingerTree (Node (Elem a)))
forall (f :: * -> *) a.
Applicative f =>
Int -> Int -> f a -> f (FingerTree a)
External instance of the constraint type Applicative Identity
applicativeTree (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
-Int
2) Int
2 (Node (Elem a) -> Identity (Node (Elem a))
forall a. a -> Identity a
Identity (Elem a -> Elem a -> Node (Elem a)
forall a. Sized a => a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Elem a)
node2 Elem a
x1 Elem a
x2)))
                    Digit (Elem a)
pair
               where pair :: Digit (Elem a)
pair = Elem a -> Elem a -> Digit (Elem a)
forall a. a -> a -> Digit a
Two Elem a
x1 Elem a
x2
             RigidThree Elem a
x1 Elem a
x2 Elem a
x3 -> FingerTree (Elem a) -> Seq a
forall a. FingerTree (Elem a) -> Seq a
Seq (FingerTree (Elem a) -> Seq a) -> FingerTree (Elem a) -> Seq a
forall a b. (a -> b) -> a -> b
$
               Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> FingerTree (Elem a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
*Int
3) Digit (Elem a)
triple
                    (Identity (FingerTree (Node (Elem a))) -> FingerTree (Node (Elem a))
forall a. Identity a -> a
runIdentity (Identity (FingerTree (Node (Elem a)))
 -> FingerTree (Node (Elem a)))
-> Identity (FingerTree (Node (Elem a)))
-> FingerTree (Node (Elem a))
forall a b. (a -> b) -> a -> b
$ Int
-> Int
-> Identity (Node (Elem a))
-> Identity (FingerTree (Node (Elem a)))
forall (f :: * -> *) a.
Applicative f =>
Int -> Int -> f a -> f (FingerTree a)
External instance of the constraint type Applicative Identity
applicativeTree (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
-Int
2) Int
3 (Node (Elem a) -> Identity (Node (Elem a))
forall a. a -> Identity a
Identity (Elem a -> Elem a -> Elem a -> Node (Elem a)
forall a. Sized a => a -> a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Elem a)
node3 Elem a
x1 Elem a
x2 Elem a
x3)))
                    Digit (Elem a)
triple
               where triple :: Digit (Elem a)
triple = Elem a -> Elem a -> Elem a -> Digit (Elem a)
forall a. a -> a -> a -> Digit a
Three Elem a
x1 Elem a
x2 Elem a
x3
             RigidFull r :: Rigid (Elem a)
r@(Rigid Int
s Node (Elem a)
pr Thin (Node (Elem a))
_m Node (Elem a)
sf) -> FingerTree (Elem a) -> Seq a
forall a. FingerTree (Elem a) -> Seq a
Seq (FingerTree (Elem a) -> Seq a) -> FingerTree (Elem a) -> Seq a
forall a b. (a -> b) -> a -> b
$
                   Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> FingerTree (Elem a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
*Int
s)
                        (Node (Elem a) -> Digit (Elem a)
forall a. Node a -> Digit a
nodeToDigit Node (Elem a)
pr)
                        (Int -> Rigid (Elem a) -> FingerTree (Node (Elem a))
forall c. Int -> Rigid c -> FingerTree (Node c)
cycleNMiddle (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
-Int
2) Rigid (Elem a)
r)
                        (Node (Elem a) -> Digit (Elem a)
forall a. Node a -> Digit a
nodeToDigit Node (Elem a)
sf)

cycleNMiddle
  :: Int
     -> Rigid c
     -> FingerTree (Node c)

-- Not at the bottom yet

cycleNMiddle :: Int -> Rigid c -> FingerTree (Node c)
cycleNMiddle !Int
n
           (Rigid Int
s Node c
pr (DeepTh Int
sm Digit12 (Node c)
prm Thin (Node (Node c))
mm Digit12 (Node c)
sfm) Node c
sf)
    = Int
-> Digit (Node c)
-> FingerTree (Node (Node c))
-> Digit (Node c)
-> FingerTree (Node c)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
sm Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
* (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Int
1)) -- note: sm = s - size pr - size sf
           (Digit12 (Node c) -> Digit (Node c)
forall a. Digit12 a -> Digit a
digit12ToDigit Digit12 (Node c)
prm)
           (Int -> Rigid (Node c) -> FingerTree (Node (Node c))
forall c. Int -> Rigid c -> FingerTree (Node c)
cycleNMiddle Int
n
                       (Int
-> Node (Node c)
-> Thin (Node (Node c))
-> Node (Node c)
-> Rigid (Node c)
forall a.
Int -> Digit23 a -> Thin (Digit23 a) -> Digit23 a -> Rigid a
Rigid Int
s (Node c -> Digit12 (Node c) -> Node (Node c)
forall a. Digit23 a -> Digit12 (Digit23 a) -> Digit23 (Digit23 a)
squashL Node c
pr Digit12 (Node c)
prm) Thin (Node (Node c))
mm (Digit12 (Node c) -> Node c -> Node (Node c)
forall a. Digit12 (Node a) -> Node a -> Digit23 (Node a)
squashR Digit12 (Node c)
sfm Node c
sf)))
           (Digit12 (Node c) -> Digit (Node c)
forall a. Digit12 a -> Digit a
digit12ToDigit Digit12 (Node c)
sfm)

-- At the bottom

cycleNMiddle Int
n
           (Rigid Int
s Node c
pr Thin (Node c)
EmptyTh Node c
sf)
     = Digit (Node c)
-> FingerTree (Node (Node c))
-> Digit (Node c)
-> FingerTree (Node c)
forall a.
Sized a =>
Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
deep
            (Node c -> Digit (Node c)
forall a. a -> Digit a
One Node c
sf)
            (Identity (FingerTree (Node (Node c))) -> FingerTree (Node (Node c))
forall a. Identity a -> a
runIdentity (Identity (FingerTree (Node (Node c)))
 -> FingerTree (Node (Node c)))
-> Identity (FingerTree (Node (Node c)))
-> FingerTree (Node (Node c))
forall a b. (a -> b) -> a -> b
$ Int
-> Int
-> Identity (Node (Node c))
-> Identity (FingerTree (Node (Node c)))
forall (f :: * -> *) a.
Applicative f =>
Int -> Int -> f a -> f (FingerTree a)
External instance of the constraint type Applicative Identity
applicativeTree Int
n Int
s (Node (Node c) -> Identity (Node (Node c))
forall a. a -> Identity a
Identity Node (Node c)
converted))
            (Node c -> Digit (Node c)
forall a. a -> Digit a
One Node c
pr)
   where converted :: Node (Node c)
converted = Node c -> Node c -> Node (Node c)
forall a. Sized a => a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
node2 Node c
pr Node c
sf

cycleNMiddle Int
n
           (Rigid Int
s Node c
pr (SingleTh Node c
q) Node c
sf)
     = Digit (Node c)
-> FingerTree (Node (Node c))
-> Digit (Node c)
-> FingerTree (Node c)
forall a.
Sized a =>
Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
deep
            (Node c -> Node c -> Digit (Node c)
forall a. a -> a -> Digit a
Two Node c
q Node c
sf)
            (Identity (FingerTree (Node (Node c))) -> FingerTree (Node (Node c))
forall a. Identity a -> a
runIdentity (Identity (FingerTree (Node (Node c)))
 -> FingerTree (Node (Node c)))
-> Identity (FingerTree (Node (Node c)))
-> FingerTree (Node (Node c))
forall a b. (a -> b) -> a -> b
$ Int
-> Int
-> Identity (Node (Node c))
-> Identity (FingerTree (Node (Node c)))
forall (f :: * -> *) a.
Applicative f =>
Int -> Int -> f a -> f (FingerTree a)
External instance of the constraint type Applicative Identity
applicativeTree Int
n Int
s (Node (Node c) -> Identity (Node (Node c))
forall a. a -> Identity a
Identity Node (Node c)
converted))
            (Node c -> Node c -> Digit (Node c)
forall a. a -> a -> Digit a
Two Node c
pr Node c
q)
   where converted :: Node (Node c)
converted = Node c -> Node c -> Node c -> Node (Node c)
forall a. Sized a => a -> a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
node3 Node c
pr Node c
q Node c
sf


-- | \( O(1) \). Add an element to the left end of a sequence.
-- Mnemonic: a triangle with the single element at the pointy end.
(<|)            :: a -> Seq a -> Seq a
a
x <| :: a -> Seq a -> Seq a
<| Seq FingerTree (Elem a)
xs     =  FingerTree (Elem a) -> Seq a
forall a. FingerTree (Elem a) -> Seq a
Seq (a -> Elem a
forall a. a -> Elem a
Elem a
x Elem a -> FingerTree (Elem a) -> FingerTree (Elem a)
forall a. Sized a => a -> FingerTree a -> FingerTree a
Instance of class: Sized of the constraint type forall a. Sized (Elem a)
`consTree` FingerTree (Elem a)
xs)

{-# SPECIALIZE consTree :: Elem a -> FingerTree (Elem a) -> FingerTree (Elem a) #-}
{-# SPECIALIZE consTree :: Node a -> FingerTree (Node a) -> FingerTree (Node a) #-}
consTree        :: Sized a => a -> FingerTree a -> FingerTree a
consTree :: a -> FingerTree a -> FingerTree a
consTree a
a FingerTree a
EmptyT       = a -> FingerTree a
forall a. a -> FingerTree a
Single a
a
consTree a
a (Single a
b)   = Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
forall a.
Sized a =>
Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Evidence bound by a type signature of the constraint type Sized a
deep (a -> Digit a
forall a. a -> Digit a
One a
a) FingerTree (Node a)
forall a. FingerTree a
EmptyT (a -> Digit a
forall a. a -> Digit a
One a
b)
-- As described in the paper, we force the middle of a tree
-- *before* consing onto it; this preserves the amortized
-- bounds but prevents repeated consing from building up
-- gigantic suspensions.
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 FingerTree (Node a) -> FingerTree a -> FingerTree a
`seq`
    Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
size a
a Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Int
s) (a -> a -> Digit a
forall a. a -> a -> Digit a
Two a
a a
b) (a -> a -> a -> Node a
forall a. Sized a => a -> a -> a -> Node a
Evidence bound by a type signature of the constraint type Sized a
node3 a
c a
d a
e Node a -> FingerTree (Node a) -> FingerTree (Node a)
forall a. Sized a => a -> FingerTree a -> FingerTree a
Instance of class: Sized of the constraint type forall a. Sized (Node 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) =
    Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
size a
a Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Int
s) (a -> a -> a -> a -> Digit a
forall a. a -> a -> a -> a -> Digit a
Four a
a a
b a
c a
d) FingerTree (Node a)
m Digit a
sf
consTree a
a (Deep Int
s (Two a
b a
c) FingerTree (Node a)
m Digit a
sf) =
    Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
size a
a Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Int
s) (a -> a -> a -> Digit a
forall a. a -> a -> a -> Digit a
Three a
a a
b a
c) FingerTree (Node a)
m Digit a
sf
consTree a
a (Deep Int
s (One a
b) FingerTree (Node a)
m Digit a
sf) =
    Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
size a
a Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Int
s) (a -> a -> Digit a
forall a. a -> a -> Digit a
Two a
a a
b) FingerTree (Node a)
m Digit a
sf

cons' :: a -> Seq a -> Seq a
cons' :: a -> Seq a -> Seq a
cons' a
x (Seq FingerTree (Elem a)
xs) = FingerTree (Elem a) -> Seq a
forall a. FingerTree (Elem a) -> Seq a
Seq (a -> Elem a
forall a. a -> Elem a
Elem a
x Elem a -> FingerTree (Elem a) -> FingerTree (Elem a)
forall a. Sized a => a -> FingerTree a -> FingerTree a
Instance of class: Sized of the constraint type forall a. Sized (Elem a)
`consTree'` FingerTree (Elem a)
xs)

snoc' :: Seq a -> a -> Seq a
snoc' :: Seq a -> a -> Seq a
snoc' (Seq FingerTree (Elem a)
xs) a
x = FingerTree (Elem a) -> Seq a
forall a. FingerTree (Elem a) -> Seq a
Seq (FingerTree (Elem a)
xs FingerTree (Elem a) -> Elem a -> FingerTree (Elem a)
forall a. Sized a => FingerTree a -> a -> FingerTree a
Instance of class: Sized of the constraint type forall a. Sized (Elem a)
`snocTree'` a -> Elem a
forall a. a -> Elem a
Elem a
x)

{-# SPECIALIZE consTree' :: Elem a -> FingerTree (Elem a) -> FingerTree (Elem a) #-}
{-# SPECIALIZE consTree' :: Node a -> FingerTree (Node a) -> FingerTree (Node a) #-}
consTree'        :: Sized a => a -> FingerTree a -> FingerTree a
consTree' :: a -> FingerTree a -> FingerTree a
consTree' a
a FingerTree a
EmptyT       = a -> FingerTree a
forall a. a -> FingerTree a
Single a
a
consTree' a
a (Single a
b)   = Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
forall a.
Sized a =>
Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Evidence bound by a type signature of the constraint type Sized a
deep (a -> Digit a
forall a. a -> Digit a
One a
a) FingerTree (Node a)
forall a. FingerTree a
EmptyT (a -> Digit a
forall a. a -> Digit a
One a
b)
-- As described in the paper, we force the middle of a tree
-- *before* consing onto it; this preserves the amortized
-- bounds but prevents repeated consing from building up
-- gigantic suspensions.
consTree' a
a (Deep Int
s (Four a
b a
c a
d a
e) FingerTree (Node a)
m Digit a
sf) =
    Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
size a
a Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Int
s) (a -> a -> Digit a
forall a. a -> a -> Digit a
Two a
a a
b) FingerTree (Node a)
m' Digit a
sf
  where !m' :: FingerTree (Node a)
m' = Node a
abc Node a -> FingerTree (Node a) -> FingerTree (Node a)
forall a. Sized a => a -> FingerTree a -> FingerTree a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
`consTree'` FingerTree (Node a)
m
        !abc :: Node a
abc = a -> a -> a -> Node a
forall a. Sized a => a -> a -> a -> Node a
Evidence bound by a type signature of the constraint type Sized 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) =
    Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
size a
a Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Int
s) (a -> a -> a -> a -> Digit a
forall a. a -> a -> a -> a -> Digit a
Four a
a a
b a
c a
d) FingerTree (Node a)
m Digit a
sf
consTree' a
a (Deep Int
s (Two a
b a
c) FingerTree (Node a)
m Digit a
sf) =
    Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
size a
a Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Int
s) (a -> a -> a -> Digit a
forall a. a -> a -> a -> Digit a
Three a
a a
b a
c) FingerTree (Node a)
m Digit a
sf
consTree' a
a (Deep Int
s (One a
b) FingerTree (Node a)
m Digit a
sf) =
    Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
size a
a Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Int
s) (a -> a -> Digit a
forall a. a -> a -> Digit a
Two a
a a
b) FingerTree (Node a)
m Digit a
sf

-- | \( O(1) \). Add an element to the right end of a sequence.
-- Mnemonic: a triangle with the single element at the pointy end.
(|>)            :: Seq a -> a -> Seq a
Seq FingerTree (Elem a)
xs |> :: Seq a -> a -> Seq a
|> a
x     =  FingerTree (Elem a) -> Seq a
forall a. FingerTree (Elem a) -> Seq a
Seq (FingerTree (Elem a)
xs FingerTree (Elem a) -> Elem a -> FingerTree (Elem a)
forall a. Sized a => FingerTree a -> a -> FingerTree a
Instance of class: Sized of the constraint type forall a. Sized (Elem a)
`snocTree` a -> Elem a
forall a. a -> Elem a
Elem a
x)

{-# SPECIALIZE snocTree :: FingerTree (Elem a) -> Elem a -> FingerTree (Elem a) #-}
{-# SPECIALIZE snocTree :: FingerTree (Node a) -> Node a -> FingerTree (Node a) #-}
snocTree        :: Sized a => FingerTree a -> a -> FingerTree a
snocTree :: FingerTree a -> a -> FingerTree a
snocTree FingerTree a
EmptyT a
a       =  a -> FingerTree a
forall a. a -> FingerTree a
Single a
a
snocTree (Single a
a) a
b   =  Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
forall a.
Sized a =>
Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Evidence bound by a type signature of the constraint type Sized a
deep (a -> Digit a
forall a. a -> Digit a
One a
a) FingerTree (Node a)
forall a. FingerTree a
EmptyT (a -> Digit a
forall a. a -> Digit a
One a
b)
-- See note on `seq` in `consTree`.
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 FingerTree (Node a) -> FingerTree a -> FingerTree a
`seq`
    Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
size a
e) Digit a
pr (FingerTree (Node a)
m FingerTree (Node a) -> Node a -> FingerTree (Node a)
forall a. Sized a => FingerTree a -> a -> FingerTree a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
`snocTree` a -> a -> a -> Node a
forall a. Sized a => a -> a -> a -> Node a
Evidence bound by a type signature of the constraint type Sized a
node3 a
a a
b a
c) (a -> a -> Digit a
forall a. a -> a -> Digit a
Two a
d a
e)
snocTree (Deep Int
s Digit a
pr FingerTree (Node a)
m (Three a
a a
b a
c)) a
d =
    Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
size a
d) Digit a
pr FingerTree (Node a)
m (a -> a -> a -> a -> Digit a
forall a. a -> a -> a -> a -> Digit a
Four a
a a
b a
c a
d)
snocTree (Deep Int
s Digit a
pr FingerTree (Node a)
m (Two a
a a
b)) a
c =
    Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
size a
c) Digit a
pr FingerTree (Node a)
m (a -> a -> a -> Digit a
forall a. a -> a -> a -> Digit a
Three a
a a
b a
c)
snocTree (Deep Int
s Digit a
pr FingerTree (Node a)
m (One a
a)) a
b =
    Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
size a
b) Digit a
pr FingerTree (Node a)
m (a -> a -> Digit a
forall a. a -> a -> Digit a
Two a
a a
b)

{-# SPECIALIZE snocTree' :: FingerTree (Elem a) -> Elem a -> FingerTree (Elem a) #-}
{-# SPECIALIZE snocTree' :: FingerTree (Node a) -> Node a -> FingerTree (Node a) #-}
snocTree'        :: Sized a => FingerTree a -> a -> FingerTree a
snocTree' :: FingerTree a -> a -> FingerTree a
snocTree' FingerTree a
EmptyT a
a       =  a -> FingerTree a
forall a. a -> FingerTree a
Single a
a
snocTree' (Single a
a) a
b   =  Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
forall a.
Sized a =>
Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Evidence bound by a type signature of the constraint type Sized a
deep (a -> Digit a
forall a. a -> Digit a
One a
a) FingerTree (Node a)
forall a. FingerTree a
EmptyT (a -> Digit a
forall a. a -> Digit a
One a
b)
-- See note on `seq` in `consTree`.
snocTree' (Deep Int
s Digit a
pr FingerTree (Node a)
m (Four a
a a
b a
c a
d)) a
e =
    Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
size a
e) Digit a
pr FingerTree (Node a)
m' (a -> a -> Digit a
forall a. a -> a -> Digit a
Two a
d a
e)
  where !m' :: FingerTree (Node a)
m' = FingerTree (Node a)
m FingerTree (Node a) -> Node a -> FingerTree (Node a)
forall a. Sized a => FingerTree a -> a -> FingerTree a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
`snocTree'` Node a
abc
        !abc :: Node a
abc = a -> a -> a -> Node a
forall a. Sized a => a -> a -> a -> Node a
Evidence bound by a type signature of the constraint type Sized 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 =
    Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
size a
d) Digit a
pr FingerTree (Node a)
m (a -> a -> a -> a -> Digit a
forall a. a -> a -> a -> a -> Digit a
Four a
a a
b a
c a
d)
snocTree' (Deep Int
s Digit a
pr FingerTree (Node a)
m (Two a
a a
b)) a
c =
    Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
size a
c) Digit a
pr FingerTree (Node a)
m (a -> a -> a -> Digit a
forall a. a -> a -> a -> Digit a
Three a
a a
b a
c)
snocTree' (Deep Int
s Digit a
pr FingerTree (Node a)
m (One a
a)) a
b =
    Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
size a
b) Digit a
pr FingerTree (Node a)
m (a -> a -> Digit a
forall a. a -> a -> Digit a
Two a
a a
b)

-- | \( O(\log(\min(n_1,n_2))) \). Concatenate two sequences.
(><)            :: Seq a -> Seq a -> Seq a
Seq FingerTree (Elem a)
xs >< :: Seq a -> Seq a -> Seq a
>< Seq FingerTree (Elem a)
ys = FingerTree (Elem a) -> Seq a
forall a. FingerTree (Elem a) -> Seq a
Seq (FingerTree (Elem a) -> FingerTree (Elem a) -> FingerTree (Elem a)
forall a.
FingerTree (Elem a) -> FingerTree (Elem a) -> FingerTree (Elem a)
appendTree0 FingerTree (Elem a)
xs FingerTree (Elem a)
ys)

-- The appendTree/addDigits gunk below is machine generated

appendTree0 :: FingerTree (Elem a) -> FingerTree (Elem a) -> FingerTree (Elem a)
appendTree0 :: FingerTree (Elem a) -> FingerTree (Elem a) -> FingerTree (Elem a)
appendTree0 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 Elem a -> FingerTree (Elem a) -> FingerTree (Elem a)
forall a. Sized a => a -> FingerTree a -> FingerTree a
Instance of class: Sized of the constraint type forall a. Sized (Elem a)
`consTree` FingerTree (Elem a)
xs
appendTree0 FingerTree (Elem a)
xs (Single Elem a
x) =
    FingerTree (Elem a)
xs FingerTree (Elem a) -> Elem a -> FingerTree (Elem a)
forall a. Sized a => FingerTree a -> a -> FingerTree a
Instance of class: Sized of the constraint type forall a. Sized (Elem 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) =
    Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> FingerTree (Elem a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s1 Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Int
s2) Digit (Elem a)
pr1 FingerTree (Node (Elem a))
m Digit (Elem a)
sf2
  where !m :: FingerTree (Node (Elem a))
m = FingerTree (Node (Elem a))
-> Digit (Elem a)
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> FingerTree (Node (Elem a))
forall a.
FingerTree (Node (Elem a))
-> Digit (Elem a)
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> FingerTree (Node (Elem a))
addDigits0 FingerTree (Node (Elem a))
m1 Digit (Elem a)
sf1 Digit (Elem a)
pr2 FingerTree (Node (Elem a))
m2

addDigits0 :: FingerTree (Node (Elem a)) -> Digit (Elem a) -> Digit (Elem a) -> FingerTree (Node (Elem a)) -> FingerTree (Node (Elem a))
addDigits0 :: FingerTree (Node (Elem a))
-> Digit (Elem a)
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> FingerTree (Node (Elem a))
addDigits0 FingerTree (Node (Elem a))
m1 (One Elem a
a) (One Elem a
b) FingerTree (Node (Elem a))
m2 =
    FingerTree (Node (Elem a))
-> Node (Elem a)
-> FingerTree (Node (Elem a))
-> FingerTree (Node (Elem a))
forall a.
FingerTree (Node a)
-> Node a -> FingerTree (Node a) -> FingerTree (Node a)
appendTree1 FingerTree (Node (Elem a))
m1 (Elem a -> Elem a -> Node (Elem a)
forall a. Sized a => a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Elem 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 =
    FingerTree (Node (Elem a))
-> Node (Elem a)
-> FingerTree (Node (Elem a))
-> FingerTree (Node (Elem a))
forall a.
FingerTree (Node a)
-> Node a -> FingerTree (Node a) -> FingerTree (Node a)
appendTree1 FingerTree (Node (Elem a))
m1 (Elem a -> Elem a -> Elem a -> Node (Elem a)
forall a. Sized a => a -> a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Elem 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 =
    FingerTree (Node (Elem a))
-> Node (Elem a)
-> Node (Elem a)
-> FingerTree (Node (Elem a))
-> FingerTree (Node (Elem a))
forall a.
FingerTree (Node a)
-> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
appendTree2 FingerTree (Node (Elem a))
m1 (Elem a -> Elem a -> Node (Elem a)
forall a. Sized a => a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Elem a)
node2 Elem a
a Elem a
b) (Elem a -> Elem a -> Node (Elem a)
forall a. Sized a => a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Elem 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 =
    FingerTree (Node (Elem a))
-> Node (Elem a)
-> Node (Elem a)
-> FingerTree (Node (Elem a))
-> FingerTree (Node (Elem a))
forall a.
FingerTree (Node a)
-> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
appendTree2 FingerTree (Node (Elem a))
m1 (Elem a -> Elem a -> Elem a -> Node (Elem a)
forall a. Sized a => a -> a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Elem a)
node3 Elem a
a Elem a
b Elem a
c) (Elem a -> Elem a -> Node (Elem a)
forall a. Sized a => a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Elem 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 =
    FingerTree (Node (Elem a))
-> Node (Elem a)
-> FingerTree (Node (Elem a))
-> FingerTree (Node (Elem a))
forall a.
FingerTree (Node a)
-> Node a -> FingerTree (Node a) -> FingerTree (Node a)
appendTree1 FingerTree (Node (Elem a))
m1 (Elem a -> Elem a -> Elem a -> Node (Elem a)
forall a. Sized a => a -> a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Elem 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 =
    FingerTree (Node (Elem a))
-> Node (Elem a)
-> Node (Elem a)
-> FingerTree (Node (Elem a))
-> FingerTree (Node (Elem a))
forall a.
FingerTree (Node a)
-> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
appendTree2 FingerTree (Node (Elem a))
m1 (Elem a -> Elem a -> Node (Elem a)
forall a. Sized a => a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Elem a)
node2 Elem a
a Elem a
b) (Elem a -> Elem a -> Node (Elem a)
forall a. Sized a => a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Elem 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 =
    FingerTree (Node (Elem a))
-> Node (Elem a)
-> Node (Elem a)
-> FingerTree (Node (Elem a))
-> FingerTree (Node (Elem a))
forall a.
FingerTree (Node a)
-> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
appendTree2 FingerTree (Node (Elem a))
m1 (Elem a -> Elem a -> Elem a -> Node (Elem a)
forall a. Sized a => a -> a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Elem a)
node3 Elem a
a Elem a
b Elem a
c) (Elem a -> Elem a -> Node (Elem a)
forall a. Sized a => a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Elem 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 =
    FingerTree (Node (Elem a))
-> Node (Elem a)
-> Node (Elem a)
-> FingerTree (Node (Elem a))
-> FingerTree (Node (Elem a))
forall a.
FingerTree (Node a)
-> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
appendTree2 FingerTree (Node (Elem a))
m1 (Elem a -> Elem a -> Elem a -> Node (Elem a)
forall a. Sized a => a -> a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Elem a)
node3 Elem a
a Elem a
b Elem a
c) (Elem a -> Elem a -> Elem a -> Node (Elem a)
forall a. Sized a => a -> a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Elem 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 =
    FingerTree (Node (Elem a))
-> Node (Elem a)
-> Node (Elem a)
-> FingerTree (Node (Elem a))
-> FingerTree (Node (Elem a))
forall a.
FingerTree (Node a)
-> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
appendTree2 FingerTree (Node (Elem a))
m1 (Elem a -> Elem a -> Node (Elem a)
forall a. Sized a => a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Elem a)
node2 Elem a
a Elem a
b) (Elem a -> Elem a -> Node (Elem a)
forall a. Sized a => a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Elem 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 =
    FingerTree (Node (Elem a))
-> Node (Elem a)
-> Node (Elem a)
-> FingerTree (Node (Elem a))
-> FingerTree (Node (Elem a))
forall a.
FingerTree (Node a)
-> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
appendTree2 FingerTree (Node (Elem a))
m1 (Elem a -> Elem a -> Elem a -> Node (Elem a)
forall a. Sized a => a -> a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Elem a)
node3 Elem a
a Elem a
b Elem a
c) (Elem a -> Elem a -> Node (Elem a)
forall a. Sized a => a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Elem 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 =
    FingerTree (Node (Elem a))
-> Node (Elem a)
-> Node (Elem a)
-> FingerTree (Node (Elem a))
-> FingerTree (Node (Elem a))
forall a.
FingerTree (Node a)
-> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
appendTree2 FingerTree (Node (Elem a))
m1 (Elem a -> Elem a -> Elem a -> Node (Elem a)
forall a. Sized a => a -> a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Elem a)
node3 Elem a
a Elem a
b Elem a
c) (Elem a -> Elem a -> Elem a -> Node (Elem a)
forall a. Sized a => a -> a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Elem 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 =
    FingerTree (Node (Elem a))
-> Node (Elem a)
-> Node (Elem a)
-> Node (Elem a)
-> FingerTree (Node (Elem a))
-> FingerTree (Node (Elem a))
forall a.
FingerTree (Node a)
-> Node a
-> Node a
-> Node a
-> FingerTree (Node a)
-> FingerTree (Node a)
appendTree3 FingerTree (Node (Elem a))
m1 (Elem a -> Elem a -> Elem a -> Node (Elem a)
forall a. Sized a => a -> a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Elem a)
node3 Elem a
a Elem a
b Elem a
c) (Elem a -> Elem a -> Node (Elem a)
forall a. Sized a => a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Elem a)
node2 Elem a
d Elem a
e) (Elem a -> Elem a -> Node (Elem a)
forall a. Sized a => a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Elem 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 =
    FingerTree (Node (Elem a))
-> Node (Elem a)
-> Node (Elem a)
-> FingerTree (Node (Elem a))
-> FingerTree (Node (Elem a))
forall a.
FingerTree (Node a)
-> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
appendTree2 FingerTree (Node (Elem a))
m1 (Elem a -> Elem a -> Elem a -> Node (Elem a)
forall a. Sized a => a -> a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Elem a)
node3 Elem a
a Elem a
b Elem a
c) (Elem a -> Elem a -> Node (Elem a)
forall a. Sized a => a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Elem 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 =
    FingerTree (Node (Elem a))
-> Node (Elem a)
-> Node (Elem a)
-> FingerTree (Node (Elem a))
-> FingerTree (Node (Elem a))
forall a.
FingerTree (Node a)
-> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
appendTree2 FingerTree (Node (Elem a))
m1 (Elem a -> Elem a -> Elem a -> Node (Elem a)
forall a. Sized a => a -> a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Elem a)
node3 Elem a
a Elem a
b Elem a
c) (Elem a -> Elem a -> Elem a -> Node (Elem a)
forall a. Sized a => a -> a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Elem 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 =
    FingerTree (Node (Elem a))
-> Node (Elem a)
-> Node (Elem a)
-> Node (Elem a)
-> FingerTree (Node (Elem a))
-> FingerTree (Node (Elem a))
forall a.
FingerTree (Node a)
-> Node a
-> Node a
-> Node a
-> FingerTree (Node a)
-> FingerTree (Node a)
appendTree3 FingerTree (Node (Elem a))
m1 (Elem a -> Elem a -> Elem a -> Node (Elem a)
forall a. Sized a => a -> a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Elem a)
node3 Elem a
a Elem a
b Elem a
c) (Elem a -> Elem a -> Node (Elem a)
forall a. Sized a => a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Elem a)
node2 Elem a
d Elem a
e) (Elem a -> Elem a -> Node (Elem a)
forall a. Sized a => a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Elem 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 =
    FingerTree (Node (Elem a))
-> Node (Elem a)
-> Node (Elem a)
-> Node (Elem a)
-> FingerTree (Node (Elem a))
-> FingerTree (Node (Elem a))
forall a.
FingerTree (Node a)
-> Node a
-> Node a
-> Node a
-> FingerTree (Node a)
-> FingerTree (Node a)
appendTree3 FingerTree (Node (Elem a))
m1 (Elem a -> Elem a -> Elem a -> Node (Elem a)
forall a. Sized a => a -> a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Elem a)
node3 Elem a
a Elem a
b Elem a
c) (Elem a -> Elem a -> Elem a -> Node (Elem a)
forall a. Sized a => a -> a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Elem a)
node3 Elem a
d Elem a
e Elem a
f) (Elem a -> Elem a -> Node (Elem a)
forall a. Sized a => a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Elem a)
node2 Elem a
g Elem a
h) FingerTree (Node (Elem a))
m2

appendTree1 :: FingerTree (Node a) -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
appendTree1 :: FingerTree (Node a)
-> Node a -> FingerTree (Node a) -> FingerTree (Node a)
appendTree1 FingerTree (Node a)
EmptyT !Node a
a FingerTree (Node a)
xs =
    Node a
a Node a -> FingerTree (Node a) -> FingerTree (Node a)
forall a. Sized a => a -> FingerTree a -> FingerTree a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
`consTree` FingerTree (Node a)
xs
appendTree1 FingerTree (Node a)
xs !Node a
a FingerTree (Node a)
EmptyT =
    FingerTree (Node a)
xs FingerTree (Node a) -> Node a -> FingerTree (Node a)
forall a. Sized a => FingerTree a -> a -> FingerTree a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
`snocTree` Node a
a
appendTree1 (Single Node a
x) !Node a
a FingerTree (Node a)
xs =
    Node a
x Node a -> FingerTree (Node a) -> FingerTree (Node a)
forall a. Sized a => a -> FingerTree a -> FingerTree a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
`consTree` Node a
a Node a -> FingerTree (Node a) -> FingerTree (Node a)
forall a. Sized a => a -> FingerTree a -> FingerTree a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
`consTree` FingerTree (Node a)
xs
appendTree1 FingerTree (Node a)
xs !Node a
a (Single Node a
x) =
    FingerTree (Node a)
xs FingerTree (Node a) -> Node a -> FingerTree (Node a)
forall a. Sized a => FingerTree a -> a -> FingerTree a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
`snocTree` Node a
a FingerTree (Node a) -> Node a -> FingerTree (Node a)
forall a. Sized a => FingerTree a -> a -> FingerTree a
Instance of class: Sized of the constraint type forall a. Sized (Node 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) =
    Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> FingerTree (Node a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s1 Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Node a -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized (Node a)
size Node a
a Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Int
s2) Digit (Node a)
pr1 FingerTree (Node (Node a))
m Digit (Node a)
sf2
  where !m :: FingerTree (Node (Node a))
m = FingerTree (Node (Node a))
-> Digit (Node a)
-> Node a
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
FingerTree (Node (Node a))
-> Digit (Node a)
-> Node a
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
addDigits1 FingerTree (Node (Node a))
m1 Digit (Node a)
sf1 Node a
a Digit (Node a)
pr2 FingerTree (Node (Node a))
m2

addDigits1 :: FingerTree (Node (Node a)) -> Digit (Node a) -> Node a -> Digit (Node a) -> FingerTree (Node (Node a)) -> FingerTree (Node (Node a))
addDigits1 :: FingerTree (Node (Node a))
-> Digit (Node a)
-> Node a
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
addDigits1 FingerTree (Node (Node a))
m1 (One Node a
a) Node a
b (One Node a
c) FingerTree (Node (Node a))
m2 =
    FingerTree (Node (Node a))
-> Node (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
FingerTree (Node a)
-> Node a -> FingerTree (Node a) -> FingerTree (Node a)
appendTree1 FingerTree (Node (Node a))
m1 (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (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 =
    FingerTree (Node (Node a))
-> Node (Node a)
-> Node (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
FingerTree (Node a)
-> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
appendTree2 FingerTree (Node (Node a))
m1 (Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
node2 Node a
a Node a
b) (Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (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 =
    FingerTree (Node (Node a))
-> Node (Node a)
-> Node (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
FingerTree (Node a)
-> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
appendTree2 FingerTree (Node (Node a))
m1 (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
node3 Node a
a Node a
b Node a
c) (Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (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 =
    FingerTree (Node (Node a))
-> Node (Node a)
-> Node (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
FingerTree (Node a)
-> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
appendTree2 FingerTree (Node (Node a))
m1 (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
node3 Node a
a Node a
b Node a
c) (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (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 =
    FingerTree (Node (Node a))
-> Node (Node a)
-> Node (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
FingerTree (Node a)
-> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
appendTree2 FingerTree (Node (Node a))
m1 (Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
node2 Node a
a Node a
b) (Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (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 =
    FingerTree (Node (Node a))
-> Node (Node a)
-> Node (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
FingerTree (Node a)
-> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
appendTree2 FingerTree (Node (Node a))
m1 (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
node3 Node a
a Node a
b Node a
c) (Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (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 =
    FingerTree (Node (Node a))
-> Node (Node a)
-> Node (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
FingerTree (Node a)
-> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
appendTree2 FingerTree (Node (Node a))
m1 (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
node3 Node a
a Node a
b Node a
c) (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (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 =
    FingerTree (Node (Node a))
-> Node (Node a)
-> Node (Node a)
-> Node (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
FingerTree (Node a)
-> Node a
-> Node a
-> Node a
-> FingerTree (Node a)
-> FingerTree (Node a)
appendTree3 FingerTree (Node (Node a))
m1 (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
node3 Node a
a Node a
b Node a
c) (Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
node2 Node a
d Node a
e) (Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (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 =
    FingerTree (Node (Node a))
-> Node (Node a)
-> Node (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
FingerTree (Node a)
-> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
appendTree2 FingerTree (Node (Node a))
m1 (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
node3 Node a
a Node a
b Node a
c) (Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (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 =
    FingerTree (Node (Node a))
-> Node (Node a)
-> Node (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
FingerTree (Node a)
-> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
appendTree2 FingerTree (Node (Node a))
m1 (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
node3 Node a
a Node a
b Node a
c) (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (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 =
    FingerTree (Node (Node a))
-> Node (Node a)
-> Node (Node a)
-> Node (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
FingerTree (Node a)
-> Node a
-> Node a
-> Node a
-> FingerTree (Node a)
-> FingerTree (Node a)
appendTree3 FingerTree (Node (Node a))
m1 (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
node3 Node a
a Node a
b Node a
c) (Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
node2 Node a
d Node a
e) (Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (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 =
    FingerTree (Node (Node a))
-> Node (Node a)
-> Node (Node a)
-> Node (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
FingerTree (Node a)
-> Node a
-> Node a
-> Node a
-> FingerTree (Node a)
-> FingerTree (Node a)
appendTree3 FingerTree (Node (Node a))
m1 (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
node3 Node a
a Node a
b Node a
c) (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
node3 Node a
d Node a
e Node a
f) (Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (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 =
    FingerTree (Node (Node a))
-> Node (Node a)
-> Node (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
FingerTree (Node a)
-> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
appendTree2 FingerTree (Node (Node a))
m1 (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
node3 Node a
a Node a
b Node a
c) (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (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 =
    FingerTree (Node (Node a))
-> Node (Node a)
-> Node (Node a)
-> Node (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
FingerTree (Node a)
-> Node a
-> Node a
-> Node a
-> FingerTree (Node a)
-> FingerTree (Node a)
appendTree3 FingerTree (Node (Node a))
m1 (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
node3 Node a
a Node a
b Node a
c) (Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
node2 Node a
d Node a
e) (Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (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 =
    FingerTree (Node (Node a))
-> Node (Node a)
-> Node (Node a)
-> Node (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
FingerTree (Node a)
-> Node a
-> Node a
-> Node a
-> FingerTree (Node a)
-> FingerTree (Node a)
appendTree3 FingerTree (Node (Node a))
m1 (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
node3 Node a
a Node a
b Node a
c) (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
node3 Node a
d Node a
e Node a
f) (Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (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 =
    FingerTree (Node (Node a))
-> Node (Node a)
-> Node (Node a)
-> Node (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
FingerTree (Node a)
-> Node a
-> Node a
-> Node a
-> FingerTree (Node a)
-> FingerTree (Node a)
appendTree3 FingerTree (Node (Node a))
m1 (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
node3 Node a
a Node a
b Node a
c) (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
node3 Node a
d Node a
e Node a
f) (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
node3 Node a
g Node a
h Node a
i) FingerTree (Node (Node a))
m2

appendTree2 :: FingerTree (Node a) -> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
appendTree2 :: FingerTree (Node a)
-> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
appendTree2 FingerTree (Node a)
EmptyT !Node a
a !Node a
b FingerTree (Node a)
xs =
    Node a
a Node a -> FingerTree (Node a) -> FingerTree (Node a)
forall a. Sized a => a -> FingerTree a -> FingerTree a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
`consTree` Node a
b Node a -> FingerTree (Node a) -> FingerTree (Node a)
forall a. Sized a => a -> FingerTree a -> FingerTree a
Instance of class: Sized of the constraint type forall a. Sized (Node 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 FingerTree (Node a) -> Node a -> FingerTree (Node a)
forall a. Sized a => FingerTree a -> a -> FingerTree a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
`snocTree` Node a
a FingerTree (Node a) -> Node a -> FingerTree (Node a)
forall a. Sized a => FingerTree a -> a -> FingerTree a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
`snocTree` Node a
b
appendTree2 (Single Node a
x) Node a
a Node a
b FingerTree (Node a)
xs =
    Node a
x Node a -> FingerTree (Node a) -> FingerTree (Node a)
forall a. Sized a => a -> FingerTree a -> FingerTree a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
`consTree` Node a
a Node a -> FingerTree (Node a) -> FingerTree (Node a)
forall a. Sized a => a -> FingerTree a -> FingerTree a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
`consTree` Node a
b Node a -> FingerTree (Node a) -> FingerTree (Node a)
forall a. Sized a => a -> FingerTree a -> FingerTree a
Instance of class: Sized of the constraint type forall a. Sized (Node 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 FingerTree (Node a) -> Node a -> FingerTree (Node a)
forall a. Sized a => FingerTree a -> a -> FingerTree a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
`snocTree` Node a
a FingerTree (Node a) -> Node a -> FingerTree (Node a)
forall a. Sized a => FingerTree a -> a -> FingerTree a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
`snocTree` Node a
b FingerTree (Node a) -> Node a -> FingerTree (Node a)
forall a. Sized a => FingerTree a -> a -> FingerTree a
Instance of class: Sized of the constraint type forall a. Sized (Node 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) =
    Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> FingerTree (Node a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s1 Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Node a -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized (Node a)
size Node a
a Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Node a -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized (Node a)
size Node a
b Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Int
s2) Digit (Node a)
pr1 FingerTree (Node (Node a))
m Digit (Node a)
sf2
  where !m :: FingerTree (Node (Node a))
m = FingerTree (Node (Node a))
-> Digit (Node a)
-> Node a
-> Node a
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
FingerTree (Node (Node a))
-> Digit (Node a)
-> Node a
-> Node a
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
addDigits2 FingerTree (Node (Node a))
m1 Digit (Node a)
sf1 Node a
a Node a
b Digit (Node a)
pr2 FingerTree (Node (Node a))
m2

addDigits2 :: FingerTree (Node (Node a)) -> Digit (Node a) -> Node a -> Node a -> Digit (Node a) -> FingerTree (Node (Node a)) -> FingerTree (Node (Node a))
addDigits2 :: FingerTree (Node (Node a))
-> Digit (Node a)
-> Node a
-> Node a
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
addDigits2 FingerTree (Node (Node a))
m1 (One Node a
a) Node a
b Node a
c (One Node a
d) FingerTree (Node (Node a))
m2 =
    FingerTree (Node (Node a))
-> Node (Node a)
-> Node (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
FingerTree (Node a)
-> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
appendTree2 FingerTree (Node (Node a))
m1 (Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
node2 Node a
a Node a
b) (Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (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 =
    FingerTree (Node (Node a))
-> Node (Node a)
-> Node (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
FingerTree (Node a)
-> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
appendTree2 FingerTree (Node (Node a))
m1 (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
node3 Node a
a Node a
b Node a
c) (Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (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 =
    FingerTree (Node (Node a))
-> Node (Node a)
-> Node (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
FingerTree (Node a)
-> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
appendTree2 FingerTree (Node (Node a))
m1 (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
node3 Node a
a Node a
b Node a
c) (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (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 =
    FingerTree (Node (Node a))
-> Node (Node a)
-> Node (Node a)
-> Node (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
FingerTree (Node a)
-> Node a
-> Node a
-> Node a
-> FingerTree (Node a)
-> FingerTree (Node a)
appendTree3 FingerTree (Node (Node a))
m1 (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
node3 Node a
a Node a
b Node a
c) (Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
node2 Node a
d Node a
e) (Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (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 =
    FingerTree (Node (Node a))
-> Node (Node a)
-> Node (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
FingerTree (Node a)
-> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
appendTree2 FingerTree (Node (Node a))
m1 (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
node3 Node a
a Node a
b Node a
c) (Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (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 =
    FingerTree (Node (Node a))
-> Node (Node a)
-> Node (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
FingerTree (Node a)
-> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
appendTree2 FingerTree (Node (Node a))
m1 (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
node3 Node a
a Node a
b Node a
c) (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (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 =
    FingerTree (Node (Node a))
-> Node (Node a)
-> Node (Node a)
-> Node (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
FingerTree (Node a)
-> Node a
-> Node a
-> Node a
-> FingerTree (Node a)
-> FingerTree (Node a)
appendTree3 FingerTree (Node (Node a))
m1 (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
node3 Node a
a Node a
b Node a
c) (Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
node2 Node a
d Node a
e) (Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (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 =
    FingerTree (Node (Node a))
-> Node (Node a)
-> Node (Node a)
-> Node (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
FingerTree (Node a)
-> Node a
-> Node a
-> Node a
-> FingerTree (Node a)
-> FingerTree (Node a)
appendTree3 FingerTree (Node (Node a))
m1 (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
node3 Node a
a Node a
b Node a
c) (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
node3 Node a
d Node a
e Node a
f) (Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (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 =
    FingerTree (Node (Node a))
-> Node (Node a)
-> Node (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
FingerTree (Node a)
-> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
appendTree2 FingerTree (Node (Node a))
m1 (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
node3 Node a
a Node a
b Node a
c) (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (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 =
    FingerTree (Node (Node a))
-> Node (Node a)
-> Node (Node a)
-> Node (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
FingerTree (Node a)
-> Node a
-> Node a
-> Node a
-> FingerTree (Node a)
-> FingerTree (Node a)
appendTree3 FingerTree (Node (Node a))
m1 (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
node3 Node a
a Node a
b Node a
c) (Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
node2 Node a
d Node a
e) (Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (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 =
    FingerTree (Node (Node a))
-> Node (Node a)
-> Node (Node a)
-> Node (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
FingerTree (Node a)
-> Node a
-> Node a
-> Node a
-> FingerTree (Node a)
-> FingerTree (Node a)
appendTree3 FingerTree (Node (Node a))
m1 (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
node3 Node a
a Node a
b Node a
c) (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
node3 Node a
d Node a
e Node a
f) (Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (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 =
    FingerTree (Node (Node a))
-> Node (Node a)
-> Node (Node a)
-> Node (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
FingerTree (Node a)
-> Node a
-> Node a
-> Node a
-> FingerTree (Node a)
-> FingerTree (Node a)
appendTree3 FingerTree (Node (Node a))
m1 (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
node3 Node a
a Node a
b Node a
c) (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
node3 Node a
d Node a
e Node a
f) (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (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 =
    FingerTree (Node (Node a))
-> Node (Node a)
-> Node (Node a)
-> Node (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
FingerTree (Node a)
-> Node a
-> Node a
-> Node a
-> FingerTree (Node a)
-> FingerTree (Node a)
appendTree3 FingerTree (Node (Node a))
m1 (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
node3 Node a
a Node a
b Node a
c) (Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
node2 Node a
d Node a
e) (Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (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 =
    FingerTree (Node (Node a))
-> Node (Node a)
-> Node (Node a)
-> Node (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
FingerTree (Node a)
-> Node a
-> Node a
-> Node a
-> FingerTree (Node a)
-> FingerTree (Node a)
appendTree3 FingerTree (Node (Node a))
m1 (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
node3 Node a
a Node a
b Node a
c) (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
node3 Node a
d Node a
e Node a
f) (Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (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 =
    FingerTree (Node (Node a))
-> Node (Node a)
-> Node (Node a)
-> Node (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
FingerTree (Node a)
-> Node a
-> Node a
-> Node a
-> FingerTree (Node a)
-> FingerTree (Node a)
appendTree3 FingerTree (Node (Node a))
m1 (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
node3 Node a
a Node a
b Node a
c) (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
node3 Node a
d Node a
e Node a
f) (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (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 =
    FingerTree (Node (Node a))
-> Node (Node a)
-> Node (Node a)
-> Node (Node a)
-> Node (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
FingerTree (Node a)
-> Node a
-> Node a
-> Node a
-> Node a
-> FingerTree (Node a)
-> FingerTree (Node a)
appendTree4 FingerTree (Node (Node a))
m1 (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
node3 Node a
a Node a
b Node a
c) (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
node3 Node a
d Node a
e Node a
f) (Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
node2 Node a
g Node a
h) (Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
node2 Node a
i Node a
j) FingerTree (Node (Node a))
m2

appendTree3 :: FingerTree (Node a) -> Node a -> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
appendTree3 :: FingerTree (Node a)
-> Node a
-> Node a
-> Node a
-> FingerTree (Node a)
-> FingerTree (Node a)
appendTree3 FingerTree (Node a)
EmptyT !Node a
a !Node a
b !Node a
c FingerTree (Node a)
xs =
    Node a
a Node a -> FingerTree (Node a) -> FingerTree (Node a)
forall a. Sized a => a -> FingerTree a -> FingerTree a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
`consTree` Node a
b Node a -> FingerTree (Node a) -> FingerTree (Node a)
forall a. Sized a => a -> FingerTree a -> FingerTree a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
`consTree` Node a
c Node a -> FingerTree (Node a) -> FingerTree (Node a)
forall a. Sized a => a -> FingerTree a -> FingerTree a
Instance of class: Sized of the constraint type forall a. Sized (Node 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 FingerTree (Node a) -> Node a -> FingerTree (Node a)
forall a. Sized a => FingerTree a -> a -> FingerTree a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
`snocTree` Node a
a FingerTree (Node a) -> Node a -> FingerTree (Node a)
forall a. Sized a => FingerTree a -> a -> FingerTree a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
`snocTree` Node a
b FingerTree (Node a) -> Node a -> FingerTree (Node a)
forall a. Sized a => FingerTree a -> a -> FingerTree a
Instance of class: Sized of the constraint type forall a. Sized (Node 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 Node a -> FingerTree (Node a) -> FingerTree (Node a)
forall a. Sized a => a -> FingerTree a -> FingerTree a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
`consTree` Node a
a Node a -> FingerTree (Node a) -> FingerTree (Node a)
forall a. Sized a => a -> FingerTree a -> FingerTree a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
`consTree` Node a
b Node a -> FingerTree (Node a) -> FingerTree (Node a)
forall a. Sized a => a -> FingerTree a -> FingerTree a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
`consTree` Node a
c Node a -> FingerTree (Node a) -> FingerTree (Node a)
forall a. Sized a => a -> FingerTree a -> FingerTree a
Instance of class: Sized of the constraint type forall a. Sized (Node 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 FingerTree (Node a) -> Node a -> FingerTree (Node a)
forall a. Sized a => FingerTree a -> a -> FingerTree a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
`snocTree` Node a
a FingerTree (Node a) -> Node a -> FingerTree (Node a)
forall a. Sized a => FingerTree a -> a -> FingerTree a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
`snocTree` Node a
b FingerTree (Node a) -> Node a -> FingerTree (Node a)
forall a. Sized a => FingerTree a -> a -> FingerTree a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
`snocTree` Node a
c FingerTree (Node a) -> Node a -> FingerTree (Node a)
forall a. Sized a => FingerTree a -> a -> FingerTree a
Instance of class: Sized of the constraint type forall a. Sized (Node 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) =
    Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> FingerTree (Node a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s1 Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Node a -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized (Node a)
size Node a
a Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Node a -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized (Node a)
size Node a
b Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Node a -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized (Node a)
size Node a
c Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Int
s2) Digit (Node a)
pr1 FingerTree (Node (Node a))
m Digit (Node a)
sf2
  where !m :: FingerTree (Node (Node a))
m = FingerTree (Node (Node a))
-> Digit (Node a)
-> Node a
-> Node a
-> Node a
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
FingerTree (Node (Node a))
-> Digit (Node a)
-> Node a
-> Node a
-> Node a
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
addDigits3 FingerTree (Node (Node a))
m1 Digit (Node a)
sf1 Node a
a Node a
b Node a
c Digit (Node a)
pr2 FingerTree (Node (Node a))
m2

addDigits3 :: FingerTree (Node (Node a)) -> Digit (Node a) -> Node a -> Node a -> Node a -> Digit (Node a) -> FingerTree (Node (Node a)) -> FingerTree (Node (Node a))
addDigits3 :: FingerTree (Node (Node a))
-> Digit (Node a)
-> Node a
-> Node a
-> Node a
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
addDigits3 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 =
    FingerTree (Node (Node a))
-> Node (Node a)
-> Node (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
FingerTree (Node a)
-> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
appendTree2 FingerTree (Node (Node a))
m1 (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
node3 Node a
a Node a
b Node a
c) (Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (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 =
    FingerTree (Node (Node a))
-> Node (Node a)
-> Node (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
FingerTree (Node a)
-> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
appendTree2 FingerTree (Node (Node a))
m1 (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
node3 Node a
a Node a
b Node a
c) (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (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 =
    FingerTree (Node (Node a))
-> Node (Node a)
-> Node (Node a)
-> Node (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
FingerTree (Node a)
-> Node a
-> Node a
-> Node a
-> FingerTree (Node a)
-> FingerTree (Node a)
appendTree3 FingerTree (Node (Node a))
m1 (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
node3 Node a
a Node a
b Node a
c) (Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
node2 Node a
d Node a
e) (Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (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 =
    FingerTree (Node (Node a))
-> Node (Node a)
-> Node (Node a)
-> Node (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
FingerTree (Node a)
-> Node a
-> Node a
-> Node a
-> FingerTree (Node a)
-> FingerTree (Node a)
appendTree3 FingerTree (Node (Node a))
m1 (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
node3 Node a
a Node a
b Node a
c) (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
node3 Node a
d Node a
e Node a
f) (Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (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 =
    FingerTree (Node (Node a))
-> Node (Node a)
-> Node (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
FingerTree (Node a)
-> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
appendTree2 FingerTree (Node (Node a))
m1 (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
node3 Node a
a Node a
b Node a
c) (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (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 =
    FingerTree (Node (Node a))
-> Node (Node a)
-> Node (Node a)
-> Node (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
FingerTree (Node a)
-> Node a
-> Node a
-> Node a
-> FingerTree (Node a)
-> FingerTree (Node a)
appendTree3 FingerTree (Node (Node a))
m1 (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
node3 Node a
a Node a
b Node a
c) (Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
node2 Node a
d Node a
e) (Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (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 =
    FingerTree (Node (Node a))
-> Node (Node a)
-> Node (Node a)
-> Node (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
FingerTree (Node a)
-> Node a
-> Node a
-> Node a
-> FingerTree (Node a)
-> FingerTree (Node a)
appendTree3 FingerTree (Node (Node a))
m1 (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
node3 Node a
a Node a
b Node a
c) (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
node3 Node a
d Node a
e Node a
f) (Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (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 =
    FingerTree (Node (Node a))
-> Node (Node a)
-> Node (Node a)
-> Node (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
FingerTree (Node a)
-> Node a
-> Node a
-> Node a
-> FingerTree (Node a)
-> FingerTree (Node a)
appendTree3 FingerTree (Node (Node a))
m1 (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
node3 Node a
a Node a
b Node a
c) (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
node3 Node a
d Node a
e Node a
f) (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (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 =
    FingerTree (Node (Node a))
-> Node (Node a)
-> Node (Node a)
-> Node (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
FingerTree (Node a)
-> Node a
-> Node a
-> Node a
-> FingerTree (Node a)
-> FingerTree (Node a)
appendTree3 FingerTree (Node (Node a))
m1 (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
node3 Node a
a Node a
b Node a
c) (Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
node2 Node a
d Node a
e) (Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (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 =
    FingerTree (Node (Node a))
-> Node (Node a)
-> Node (Node a)
-> Node (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
FingerTree (Node a)
-> Node a
-> Node a
-> Node a
-> FingerTree (Node a)
-> FingerTree (Node a)
appendTree3 FingerTree (Node (Node a))
m1 (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
node3 Node a
a Node a
b Node a
c) (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
node3 Node a
d Node a
e Node a
f) (Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (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 =
    FingerTree (Node (Node a))
-> Node (Node a)
-> Node (Node a)
-> Node (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
FingerTree (Node a)
-> Node a
-> Node a
-> Node a
-> FingerTree (Node a)
-> FingerTree (Node a)
appendTree3 FingerTree (Node (Node a))
m1 (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
node3 Node a
a Node a
b Node a
c) (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
node3 Node a
d Node a
e Node a
f) (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (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 =
    FingerTree (Node (Node a))
-> Node (Node a)
-> Node (Node a)
-> Node (Node a)
-> Node (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
FingerTree (Node a)
-> Node a
-> Node a
-> Node a
-> Node a
-> FingerTree (Node a)
-> FingerTree (Node a)
appendTree4 FingerTree (Node (Node a))
m1 (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
node3 Node a
a Node a
b Node a
c) (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
node3 Node a
d Node a
e Node a
f) (Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
node2 Node a
g Node a
h) (Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (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 =
    FingerTree (Node (Node a))
-> Node (Node a)
-> Node (Node a)
-> Node (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
FingerTree (Node a)
-> Node a
-> Node a
-> Node a
-> FingerTree (Node a)
-> FingerTree (Node a)
appendTree3 FingerTree (Node (Node a))
m1 (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
node3 Node a
a Node a
b Node a
c) (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
node3 Node a
d Node a
e Node a
f) (Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (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 =
    FingerTree (Node (Node a))
-> Node (Node a)
-> Node (Node a)
-> Node (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
FingerTree (Node a)
-> Node a
-> Node a
-> Node a
-> FingerTree (Node a)
-> FingerTree (Node a)
appendTree3 FingerTree (Node (Node a))
m1 (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
node3 Node a
a Node a
b Node a
c) (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
node3 Node a
d Node a
e Node a
f) (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (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 =
    FingerTree (Node (Node a))
-> Node (Node a)
-> Node (Node a)
-> Node (Node a)
-> Node (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
FingerTree (Node a)
-> Node a
-> Node a
-> Node a
-> Node a
-> FingerTree (Node a)
-> FingerTree (Node a)
appendTree4 FingerTree (Node (Node a))
m1 (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
node3 Node a
a Node a
b Node a
c) (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
node3 Node a
d Node a
e Node a
f) (Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
node2 Node a
g Node a
h) (Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (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 =
    FingerTree (Node (Node a))
-> Node (Node a)
-> Node (Node a)
-> Node (Node a)
-> Node (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
FingerTree (Node a)
-> Node a
-> Node a
-> Node a
-> Node a
-> FingerTree (Node a)
-> FingerTree (Node a)
appendTree4 FingerTree (Node (Node a))
m1 (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
node3 Node a
a Node a
b Node a
c) (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
node3 Node a
d Node a
e Node a
f) (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
node3 Node a
g Node a
h Node a
i) (Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
node2 Node a
j Node a
k) FingerTree (Node (Node a))
m2

appendTree4 :: FingerTree (Node a) -> Node a -> Node a -> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
appendTree4 :: FingerTree (Node a)
-> Node a
-> Node a
-> Node a
-> Node a
-> FingerTree (Node a)
-> FingerTree (Node a)
appendTree4 FingerTree (Node a)
EmptyT !Node a
a !Node a
b !Node a
c !Node a
d FingerTree (Node a)
xs =
    Node a
a Node a -> FingerTree (Node a) -> FingerTree (Node a)
forall a. Sized a => a -> FingerTree a -> FingerTree a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
`consTree` Node a
b Node a -> FingerTree (Node a) -> FingerTree (Node a)
forall a. Sized a => a -> FingerTree a -> FingerTree a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
`consTree` Node a
c Node a -> FingerTree (Node a) -> FingerTree (Node a)
forall a. Sized a => a -> FingerTree a -> FingerTree a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
`consTree` Node a
d Node a -> FingerTree (Node a) -> FingerTree (Node a)
forall a. Sized a => a -> FingerTree a -> FingerTree a
Instance of class: Sized of the constraint type forall a. Sized (Node 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 FingerTree (Node a) -> Node a -> FingerTree (Node a)
forall a. Sized a => FingerTree a -> a -> FingerTree a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
`snocTree` Node a
a FingerTree (Node a) -> Node a -> FingerTree (Node a)
forall a. Sized a => FingerTree a -> a -> FingerTree a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
`snocTree` Node a
b FingerTree (Node a) -> Node a -> FingerTree (Node a)
forall a. Sized a => FingerTree a -> a -> FingerTree a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
`snocTree` Node a
c FingerTree (Node a) -> Node a -> FingerTree (Node a)
forall a. Sized a => FingerTree a -> a -> FingerTree a
Instance of class: Sized of the constraint type forall a. Sized (Node 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 Node a -> FingerTree (Node a) -> FingerTree (Node a)
forall a. Sized a => a -> FingerTree a -> FingerTree a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
`consTree` Node a
a Node a -> FingerTree (Node a) -> FingerTree (Node a)
forall a. Sized a => a -> FingerTree a -> FingerTree a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
`consTree` Node a
b Node a -> FingerTree (Node a) -> FingerTree (Node a)
forall a. Sized a => a -> FingerTree a -> FingerTree a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
`consTree` Node a
c Node a -> FingerTree (Node a) -> FingerTree (Node a)
forall a. Sized a => a -> FingerTree a -> FingerTree a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
`consTree` Node a
d Node a -> FingerTree (Node a) -> FingerTree (Node a)
forall a. Sized a => a -> FingerTree a -> FingerTree a
Instance of class: Sized of the constraint type forall a. Sized (Node 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 FingerTree (Node a) -> Node a -> FingerTree (Node a)
forall a. Sized a => FingerTree a -> a -> FingerTree a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
`snocTree` Node a
a FingerTree (Node a) -> Node a -> FingerTree (Node a)
forall a. Sized a => FingerTree a -> a -> FingerTree a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
`snocTree` Node a
b FingerTree (Node a) -> Node a -> FingerTree (Node a)
forall a. Sized a => FingerTree a -> a -> FingerTree a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
`snocTree` Node a
c FingerTree (Node a) -> Node a -> FingerTree (Node a)
forall a. Sized a => FingerTree a -> a -> FingerTree a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
`snocTree` Node a
d FingerTree (Node a) -> Node a -> FingerTree (Node a)
forall a. Sized a => FingerTree a -> a -> FingerTree a
Instance of class: Sized of the constraint type forall a. Sized (Node 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) =
    Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> FingerTree (Node a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s1 Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Node a -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized (Node a)
size Node a
a Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Node a -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized (Node a)
size Node a
b Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Node a -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized (Node a)
size Node a
c Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Node a -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized (Node a)
size Node a
d Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Int
s2) Digit (Node a)
pr1 FingerTree (Node (Node a))
m Digit (Node a)
sf2
  where !m :: FingerTree (Node (Node a))
m = FingerTree (Node (Node a))
-> Digit (Node a)
-> Node a
-> Node a
-> Node a
-> Node a
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
FingerTree (Node (Node a))
-> Digit (Node a)
-> Node a
-> Node a
-> Node a
-> Node a
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
addDigits4 FingerTree (Node (Node a))
m1 Digit (Node a)
sf1 Node a
a Node a
b Node a
c Node a
d Digit (Node a)
pr2 FingerTree (Node (Node a))
m2

addDigits4 :: FingerTree (Node (Node a)) -> Digit (Node a) -> Node a -> Node a -> Node a -> Node a -> Digit (Node a) -> FingerTree (Node (Node a)) -> FingerTree (Node (Node a))
addDigits4 :: FingerTree (Node (Node a))
-> Digit (Node a)
-> Node a
-> Node a
-> Node a
-> Node a
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
addDigits4 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 =
    FingerTree (Node (Node a))
-> Node (Node a)
-> Node (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
FingerTree (Node a)
-> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
appendTree2 FingerTree (Node (Node a))
m1 (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
node3 Node a
a Node a
b Node a
c) (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (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 =
    FingerTree (Node (Node a))
-> Node (Node a)
-> Node (Node a)
-> Node (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
FingerTree (Node a)
-> Node a
-> Node a
-> Node a
-> FingerTree (Node a)
-> FingerTree (Node a)
appendTree3 FingerTree (Node (Node a))
m1 (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
node3 Node a
a Node a
b Node a
c) (Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
node2 Node a
d Node a
e) (Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (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 =
    FingerTree (Node (Node a))
-> Node (Node a)
-> Node (Node a)
-> Node (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
FingerTree (Node a)
-> Node a
-> Node a
-> Node a
-> FingerTree (Node a)
-> FingerTree (Node a)
appendTree3 FingerTree (Node (Node a))
m1 (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
node3 Node a
a Node a
b Node a
c) (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
node3 Node a
d Node a
e Node a
f) (Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (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 =
    FingerTree (Node (Node a))
-> Node (Node a)
-> Node (Node a)
-> Node (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
FingerTree (Node a)
-> Node a
-> Node a
-> Node a
-> FingerTree (Node a)
-> FingerTree (Node a)
appendTree3 FingerTree (Node (Node a))
m1 (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
node3 Node a
a Node a
b Node a
c) (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
node3 Node a
d Node a
e Node a
f) (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (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 =
    FingerTree (Node (Node a))
-> Node (Node a)
-> Node (Node a)
-> Node (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
FingerTree (Node a)
-> Node a
-> Node a
-> Node a
-> FingerTree (Node a)
-> FingerTree (Node a)
appendTree3 FingerTree (Node (Node a))
m1 (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
node3 Node a
a Node a
b Node a
c) (Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
node2 Node a
d Node a
e) (Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (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 =
    FingerTree (Node (Node a))
-> Node (Node a)
-> Node (Node a)
-> Node (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
FingerTree (Node a)
-> Node a
-> Node a
-> Node a
-> FingerTree (Node a)
-> FingerTree (Node a)
appendTree3 FingerTree (Node (Node a))
m1 (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
node3 Node a
a Node a
b Node a
c) (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
node3 Node a
d Node a
e Node a
f) (Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (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 =
    FingerTree (Node (Node a))
-> Node (Node a)
-> Node (Node a)
-> Node (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
FingerTree (Node a)
-> Node a
-> Node a
-> Node a
-> FingerTree (Node a)
-> FingerTree (Node a)
appendTree3 FingerTree (Node (Node a))
m1 (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
node3 Node a
a Node a
b Node a
c) (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
node3 Node a
d Node a
e Node a
f) (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (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 =
    FingerTree (Node (Node a))
-> Node (Node a)
-> Node (Node a)
-> Node (Node a)
-> Node (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
FingerTree (Node a)
-> Node a
-> Node a
-> Node a
-> Node a
-> FingerTree (Node a)
-> FingerTree (Node a)
appendTree4 FingerTree (Node (Node a))
m1 (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
node3 Node a
a Node a
b Node a
c) (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
node3 Node a
d Node a
e Node a
f) (Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
node2 Node a
g Node a
h) (Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (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 =
    FingerTree (Node (Node a))
-> Node (Node a)
-> Node (Node a)
-> Node (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
FingerTree (Node a)
-> Node a
-> Node a
-> Node a
-> FingerTree (Node a)
-> FingerTree (Node a)
appendTree3 FingerTree (Node (Node a))
m1 (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
node3 Node a
a Node a
b Node a
c) (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
node3 Node a
d Node a
e Node a
f) (Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (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 =
    FingerTree (Node (Node a))
-> Node (Node a)
-> Node (Node a)
-> Node (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
FingerTree (Node a)
-> Node a
-> Node a
-> Node a
-> FingerTree (Node a)
-> FingerTree (Node a)
appendTree3 FingerTree (Node (Node a))
m1 (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
node3 Node a
a Node a
b Node a
c) (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
node3 Node a
d Node a
e Node a
f) (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (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 =
    FingerTree (Node (Node a))
-> Node (Node a)
-> Node (Node a)
-> Node (Node a)
-> Node (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
FingerTree (Node a)
-> Node a
-> Node a
-> Node a
-> Node a
-> FingerTree (Node a)
-> FingerTree (Node a)
appendTree4 FingerTree (Node (Node a))
m1 (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
node3 Node a
a Node a
b Node a
c) (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
node3 Node a
d Node a
e Node a
f) (Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
node2 Node a
g Node a
h) (Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (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 =
    FingerTree (Node (Node a))
-> Node (Node a)
-> Node (Node a)
-> Node (Node a)
-> Node (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
FingerTree (Node a)
-> Node a
-> Node a
-> Node a
-> Node a
-> FingerTree (Node a)
-> FingerTree (Node a)
appendTree4 FingerTree (Node (Node a))
m1 (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
node3 Node a
a Node a
b Node a
c) (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
node3 Node a
d Node a
e Node a
f) (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
node3 Node a
g Node a
h Node a
i) (Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (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 =
    FingerTree (Node (Node a))
-> Node (Node a)
-> Node (Node a)
-> Node (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
FingerTree (Node a)
-> Node a
-> Node a
-> Node a
-> FingerTree (Node a)
-> FingerTree (Node a)
appendTree3 FingerTree (Node (Node a))
m1 (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
node3 Node a
a Node a
b Node a
c) (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
node3 Node a
d Node a
e Node a
f) (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (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 =
    FingerTree (Node (Node a))
-> Node (Node a)
-> Node (Node a)
-> Node (Node a)
-> Node (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
FingerTree (Node a)
-> Node a
-> Node a
-> Node a
-> Node a
-> FingerTree (Node a)
-> FingerTree (Node a)
appendTree4 FingerTree (Node (Node a))
m1 (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
node3 Node a
a Node a
b Node a
c) (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
node3 Node a
d Node a
e Node a
f) (Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
node2 Node a
g Node a
h) (Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (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 =
    FingerTree (Node (Node a))
-> Node (Node a)
-> Node (Node a)
-> Node (Node a)
-> Node (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
FingerTree (Node a)
-> Node a
-> Node a
-> Node a
-> Node a
-> FingerTree (Node a)
-> FingerTree (Node a)
appendTree4 FingerTree (Node (Node a))
m1 (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
node3 Node a
a Node a
b Node a
c) (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
node3 Node a
d Node a
e Node a
f) (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
node3 Node a
g Node a
h Node a
i) (Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (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 =
    FingerTree (Node (Node a))
-> Node (Node a)
-> Node (Node a)
-> Node (Node a)
-> Node (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
FingerTree (Node a)
-> Node a
-> Node a
-> Node a
-> Node a
-> FingerTree (Node a)
-> FingerTree (Node a)
appendTree4 FingerTree (Node (Node a))
m1 (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
node3 Node a
a Node a
b Node a
c) (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
node3 Node a
d Node a
e Node a
f) (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
node3 Node a
g Node a
h Node a
i) (Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
node3 Node a
j Node a
k Node a
l) FingerTree (Node (Node a))
m2

-- | Builds a sequence from a seed value.  Takes time linear in the
-- number of generated elements.  /WARNING:/ If the number of generated
-- elements is infinite, this method will not terminate.
unfoldr :: (b -> Maybe (a, b)) -> b -> Seq a
unfoldr :: (b -> Maybe (a, b)) -> b -> Seq a
unfoldr b -> Maybe (a, b)
f = Seq a -> b -> Seq a
unfoldr' Seq a
forall a. Seq a
empty
  -- uses tail recursion rather than, for instance, the List implementation.
  where unfoldr' :: Seq a -> b -> Seq a
unfoldr' !Seq a
as b
b = Seq a -> ((a, b) -> Seq a) -> Maybe (a, b) -> Seq a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Seq a
as (\ (a
a, b
b') -> Seq a -> b -> Seq a
unfoldr' (Seq a
as Seq a -> a -> Seq a
forall a. Seq a -> a -> Seq a
`snoc'` a
a) b
b') (b -> Maybe (a, b)
f b
b)

-- | @'unfoldl' f x@ is equivalent to @'reverse' ('unfoldr' ('fmap' swap . f) x)@.
unfoldl :: (b -> Maybe (b, a)) -> b -> Seq a
unfoldl :: (b -> Maybe (b, a)) -> b -> Seq a
unfoldl b -> Maybe (b, a)
f = Seq a -> b -> Seq a
unfoldl' Seq a
forall a. Seq a
empty
  where unfoldl' :: Seq a -> b -> Seq a
unfoldl' !Seq a
as b
b = Seq a -> ((b, a) -> Seq a) -> Maybe (b, a) -> Seq a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Seq a
as (\ (b
b', a
a) -> Seq a -> b -> Seq a
unfoldl' (a
a a -> Seq a -> Seq a
forall a. a -> Seq a -> Seq a
`cons'` Seq a
as) b
b') (b -> Maybe (b, a)
f b
b)

-- | \( O(n) \).  Constructs a sequence by repeated application of a function
-- to a seed value.
--
-- > iterateN n f x = fromList (Prelude.take n (Prelude.iterate f x))
iterateN :: Int -> (a -> a) -> a -> Seq a
iterateN :: Int -> (a -> a) -> a -> Seq a
iterateN Int
n a -> a
f a
x
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
>= Int
0      = Int -> State a a -> State a (Seq a)
forall (f :: * -> *) a. Applicative f => Int -> f a -> f (Seq a)
External instance of the constraint type forall s. Applicative (State s)
replicateA Int
n ((a -> (a, a)) -> State a a
forall s a. (s -> (s, a)) -> State s a
State (\ a
y -> (a -> a
f a
y, a
y))) State a (Seq a) -> a -> Seq a
forall s a. State s a -> s -> a
`execState` a
x
  | Bool
otherwise   = [Char] -> Seq a
forall a. HasCallStack => [Char] -> a
error [Char]
"iterateN takes a nonnegative integer argument"

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

-- | \( O(1) \). Is this the empty sequence?
null            :: Seq a -> Bool
null :: Seq a -> Bool
null (Seq FingerTree (Elem a)
EmptyT) = Bool
True
null Seq a
_            =  Bool
False

-- | \( O(1) \). The number of elements in the sequence.
length          :: Seq a -> Int
length :: Seq a -> Int
length (Seq FingerTree (Elem a)
xs) =  FingerTree (Elem a) -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized a => Sized (FingerTree a)
Instance of class: Sized of the constraint type forall a. Sized (Elem a)
size FingerTree (Elem a)
xs

-- Views

data ViewLTree a = ConsLTree a (FingerTree a) | EmptyLTree
data ViewRTree a = SnocRTree (FingerTree a) a | EmptyRTree

-- | View of the left end of a sequence.
data ViewL a
    = EmptyL        -- ^ empty sequence
    | a :< Seq a    -- ^ leftmost element and the rest of the sequence
    deriving (ViewL a -> ViewL a -> Bool
(ViewL a -> ViewL a -> Bool)
-> (ViewL a -> ViewL a -> Bool) -> Eq (ViewL a)
forall a. Eq a => ViewL a -> ViewL a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ViewL a -> ViewL a -> Bool
$c/= :: forall a. Eq a => ViewL a -> ViewL a -> Bool
== :: ViewL a -> ViewL a -> Bool
$c== :: forall a. Eq a => ViewL a -> ViewL a -> Bool
Instance of class: Eq of the constraint type forall a. Eq a => Eq (Seq a)
Evidence bound by a type signature of the constraint type Eq a
Eq, Eq (ViewL a)
Eq (ViewL a)
-> (ViewL a -> ViewL a -> Ordering)
-> (ViewL a -> ViewL a -> Bool)
-> (ViewL a -> ViewL a -> Bool)
-> (ViewL a -> ViewL a -> Bool)
-> (ViewL a -> ViewL a -> Bool)
-> (ViewL a -> ViewL a -> ViewL a)
-> (ViewL a -> ViewL a -> ViewL a)
-> Ord (ViewL a)
ViewL a -> ViewL a -> Bool
ViewL a -> ViewL a -> Ordering
ViewL a -> ViewL a -> ViewL a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {a}. Ord a => Eq (ViewL a)
forall a. Ord a => ViewL a -> ViewL a -> Bool
forall a. Ord a => ViewL a -> ViewL a -> Ordering
forall a. Ord a => ViewL a -> ViewL a -> ViewL a
min :: ViewL a -> ViewL a -> ViewL a
$cmin :: forall a. Ord a => ViewL a -> ViewL a -> ViewL a
max :: ViewL a -> ViewL a -> ViewL a
$cmax :: forall a. Ord a => ViewL a -> ViewL a -> ViewL a
>= :: ViewL a -> ViewL a -> Bool
$c>= :: forall a. Ord a => ViewL a -> ViewL a -> Bool
> :: ViewL a -> ViewL a -> Bool
$c> :: forall a. Ord a => ViewL a -> ViewL a -> Bool
<= :: ViewL a -> ViewL a -> Bool
$c<= :: forall a. Ord a => ViewL a -> ViewL a -> Bool
< :: ViewL a -> ViewL a -> Bool
$c< :: forall a. Ord a => ViewL a -> ViewL a -> Bool
compare :: ViewL a -> ViewL a -> Ordering
$ccompare :: forall a. Ord a => ViewL a -> ViewL a -> Ordering
Instance of class: Eq of the constraint type forall a. Eq a => Eq (ViewL a)
External instance of the constraint type forall a. Ord a => Eq a
Evidence bound by a type signature of the constraint type Ord a
External instance of the constraint type forall a. Ord a => Eq a
Evidence bound by a type signature of the constraint type Ord a
External instance of the constraint type forall a. Ord a => Eq a
Instance of class: Ord of the constraint type forall a. Ord a => Ord (Seq a)
Instance of class: Ord of the constraint type forall a. Ord a => Ord (ViewL a)
Evidence bound by a type signature of the constraint type Ord a
Instance of class: Eq of the constraint type forall a. Eq a => Eq (ViewL a)
Ord, Int -> ViewL a -> ShowS
[ViewL a] -> ShowS
ViewL a -> [Char]
(Int -> ViewL a -> ShowS)
-> (ViewL a -> [Char]) -> ([ViewL a] -> ShowS) -> Show (ViewL a)
forall a. Show a => Int -> ViewL a -> ShowS
forall a. Show a => [ViewL a] -> ShowS
forall a. Show a => ViewL a -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [ViewL a] -> ShowS
$cshowList :: forall a. Show a => [ViewL a] -> ShowS
show :: ViewL a -> [Char]
$cshow :: forall a. Show a => ViewL a -> [Char]
showsPrec :: Int -> ViewL a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> ViewL a -> ShowS
External instance of the constraint type Ord Int
Instance of class: Show of the constraint type forall a. Show a => Show (Seq a)
Evidence bound by a type signature of the constraint type Show a
Show, ReadPrec [ViewL a]
ReadPrec (ViewL a)
Int -> ReadS (ViewL a)
ReadS [ViewL a]
(Int -> ReadS (ViewL a))
-> ReadS [ViewL a]
-> ReadPrec (ViewL a)
-> ReadPrec [ViewL a]
-> Read (ViewL a)
forall a. Read a => ReadPrec [ViewL a]
forall a. Read a => ReadPrec (ViewL a)
forall a. Read a => Int -> ReadS (ViewL a)
forall a. Read a => ReadS [ViewL a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ViewL a]
$creadListPrec :: forall a. Read a => ReadPrec [ViewL a]
readPrec :: ReadPrec (ViewL a)
$creadPrec :: forall a. Read a => ReadPrec (ViewL a)
readList :: ReadS [ViewL a]
$creadList :: forall a. Read a => ReadS [ViewL a]
readsPrec :: Int -> ReadS (ViewL a)
$creadsPrec :: forall a. Read a => Int -> ReadS (ViewL a)
External instance of the constraint type Monad ReadPrec
External instance of the constraint type Monad ReadPrec
Instance of class: Read of the constraint type forall a. Read a => Read (Seq a)
Instance of class: Read of the constraint type forall a. Read a => Read (ViewL a)
Evidence bound by a type signature of the constraint type Read a
Read)

#ifdef __GLASGOW_HASKELL__
deriving instance Data a => Data (ViewL a)

-- | @since 0.5.8
deriving instance Generic1 ViewL

-- | @since 0.5.8
deriving instance Generic (ViewL a)
#endif

INSTANCE_TYPEABLE1(ViewL)

instance Functor ViewL where
    {-# INLINE fmap #-}
    fmap :: (a -> b) -> ViewL a -> ViewL b
fmap a -> b
_ ViewL a
EmptyL       = ViewL b
forall a. ViewL a
EmptyL
    fmap a -> b
f (a
x :< Seq a
xs)    = a -> b
f a
x b -> Seq b -> ViewL b
forall a. a -> Seq a -> ViewL a
:< (a -> b) -> Seq a -> Seq b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Instance of class: Functor of the constraint type Functor Seq
fmap a -> b
f Seq a
xs

instance Foldable ViewL where
    foldr :: (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 ((a -> b -> b) -> b -> Seq a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
Instance of class: Foldable of the constraint type Foldable Seq
foldr a -> b -> b
f b
z Seq a
xs)

    foldl :: (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) = (b -> a -> b) -> b -> Seq a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Instance of class: Foldable of the constraint type Foldable Seq
foldl b -> a -> b
f (b -> a -> b
f b
z a
x) Seq a
xs

    foldl1 :: (a -> a -> a) -> ViewL a -> a
foldl1 a -> a -> a
_ ViewL a
EmptyL = [Char] -> a
forall a. HasCallStack => [Char] -> a
error [Char]
"foldl1: empty view"
    foldl1 a -> a -> a
f (a
x :< Seq a
xs) = (a -> a -> a) -> a -> Seq a -> a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Instance of class: Foldable of the constraint type Foldable Seq
foldl a -> a -> a
f a
x Seq a
xs

#if MIN_VERSION_base(4,8,0)
    null :: ViewL a -> Bool
null ViewL a
EmptyL = Bool
True
    null (a
_ :< Seq a
_) = Bool
False

    length :: ViewL a -> Int
length ViewL a
EmptyL = Int
0
    length (a
_ :< Seq a
xs) = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Seq a -> Int
forall a. Seq a -> Int
length Seq a
xs
#endif

instance Traversable ViewL where
    traverse :: (a -> f b) -> ViewL a -> f (ViewL b)
traverse a -> f b
_ ViewL a
EmptyL       = ViewL b -> f (ViewL b)
forall (f :: * -> *) a. Applicative f => a -> f a
Evidence bound by a type signature of the constraint type Applicative f
pure ViewL b
forall a. ViewL a
EmptyL
    traverse a -> f b
f (a
x :< Seq a
xs)    = (b -> Seq b -> ViewL b) -> f b -> f (Seq b) -> f (ViewL b)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
Evidence bound by a type signature of the constraint type Applicative f
liftA2 b -> Seq b -> ViewL b
forall a. a -> Seq a -> ViewL a
(:<) (a -> f b
f a
x) ((a -> f b) -> Seq a -> f (Seq b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
Evidence bound by a type signature of the constraint type Applicative f
Instance of class: Traversable of the constraint type Traversable Seq
traverse a -> f b
f Seq a
xs)

-- | \( O(1) \). Analyse the left end of a sequence.
viewl           ::  Seq a -> ViewL a
viewl :: Seq a -> ViewL a
viewl (Seq FingerTree (Elem a)
xs)  =  case FingerTree (Elem a) -> ViewLTree (Elem a)
forall a. Sized a => FingerTree a -> ViewLTree a
Instance of class: Sized of the constraint type forall a. Sized (Elem a)
viewLTree FingerTree (Elem a)
xs of
    ViewLTree (Elem a)
EmptyLTree -> ViewL a
forall a. ViewL a
EmptyL
    ConsLTree (Elem a
x) FingerTree (Elem a)
xs' -> a
x a -> Seq a -> ViewL a
forall a. a -> Seq a -> ViewL a
:< FingerTree (Elem a) -> Seq a
forall a. FingerTree (Elem a) -> Seq a
Seq FingerTree (Elem a)
xs'

{-# SPECIALIZE viewLTree :: FingerTree (Elem a) -> ViewLTree (Elem a) #-}
{-# SPECIALIZE viewLTree :: FingerTree (Node a) -> ViewLTree (Node a) #-}
viewLTree       :: Sized a => FingerTree a -> ViewLTree a
viewLTree :: FingerTree a -> ViewLTree a
viewLTree FingerTree a
EmptyT                = ViewLTree a
forall a. ViewLTree a
EmptyLTree
viewLTree (Single a
a)            = a -> FingerTree a -> ViewLTree a
forall a. a -> FingerTree a -> ViewLTree a
ConsLTree a
a FingerTree a
forall a. FingerTree a
EmptyT
viewLTree (Deep Int
s (One a
a) FingerTree (Node a)
m Digit a
sf) = a -> FingerTree a -> ViewLTree a
forall a. a -> FingerTree a -> ViewLTree a
ConsLTree a
a (Int -> FingerTree (Node a) -> Digit a -> FingerTree a
forall a. Int -> FingerTree (Node a) -> Digit a -> FingerTree a
pullL (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
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) =
    a -> FingerTree a -> ViewLTree a
forall a. a -> FingerTree a -> ViewLTree a
ConsLTree a
a (Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
size a
a) (a -> Digit 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) =
    a -> FingerTree a -> ViewLTree a
forall a. a -> FingerTree a -> ViewLTree a
ConsLTree a
a (Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
size a
a) (a -> a -> Digit a
forall a. a -> a -> Digit a
Two a
b a
c) FingerTree (Node a)
m Digit a
sf)
viewLTree (Deep Int
s (Four a
a a
b a
c a
d) FingerTree (Node a)
m Digit a
sf) =
    a -> FingerTree a -> ViewLTree a
forall a. a -> FingerTree a -> ViewLTree a
ConsLTree a
a (Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
size a
a) (a -> a -> a -> Digit a
forall a. a -> a -> a -> Digit a
Three a
b a
c a
d) FingerTree (Node a)
m Digit a
sf)

-- | View of the right end of a sequence.
data ViewR a
    = EmptyR        -- ^ empty sequence
    | Seq a :> a    -- ^ the sequence minus the rightmost element,
            -- and the rightmost element
    deriving (ViewR a -> ViewR a -> Bool
(ViewR a -> ViewR a -> Bool)
-> (ViewR a -> ViewR a -> Bool) -> Eq (ViewR a)
forall a. Eq a => ViewR a -> ViewR a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ViewR a -> ViewR a -> Bool
$c/= :: forall a. Eq a => ViewR a -> ViewR a -> Bool
== :: ViewR a -> ViewR a -> Bool
$c== :: forall a. Eq a => ViewR a -> ViewR a -> Bool
Instance of class: Eq of the constraint type forall a. Eq a => Eq (Seq a)
Evidence bound by a type signature of the constraint type Eq a
Eq, Eq (ViewR a)
Eq (ViewR a)
-> (ViewR a -> ViewR a -> Ordering)
-> (ViewR a -> ViewR a -> Bool)
-> (ViewR a -> ViewR a -> Bool)
-> (ViewR a -> ViewR a -> Bool)
-> (ViewR a -> ViewR a -> Bool)
-> (ViewR a -> ViewR a -> ViewR a)
-> (ViewR a -> ViewR a -> ViewR a)
-> Ord (ViewR a)
ViewR a -> ViewR a -> Bool
ViewR a -> ViewR a -> Ordering
ViewR a -> ViewR a -> ViewR a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {a}. Ord a => Eq (ViewR a)
forall a. Ord a => ViewR a -> ViewR a -> Bool
forall a. Ord a => ViewR a -> ViewR a -> Ordering
forall a. Ord a => ViewR a -> ViewR a -> ViewR a
min :: ViewR a -> ViewR a -> ViewR a
$cmin :: forall a. Ord a => ViewR a -> ViewR a -> ViewR a
max :: ViewR a -> ViewR a -> ViewR a
$cmax :: forall a. Ord a => ViewR a -> ViewR a -> ViewR a
>= :: ViewR a -> ViewR a -> Bool
$c>= :: forall a. Ord a => ViewR a -> ViewR a -> Bool
> :: ViewR a -> ViewR a -> Bool
$c> :: forall a. Ord a => ViewR a -> ViewR a -> Bool
<= :: ViewR a -> ViewR a -> Bool
$c<= :: forall a. Ord a => ViewR a -> ViewR a -> Bool
< :: ViewR a -> ViewR a -> Bool
$c< :: forall a. Ord a => ViewR a -> ViewR a -> Bool
compare :: ViewR a -> ViewR a -> Ordering
$ccompare :: forall a. Ord a => ViewR a -> ViewR a -> Ordering
Instance of class: Eq of the constraint type forall a. Eq a => Eq (ViewR a)
External instance of the constraint type forall a. Ord a => Eq a
Evidence bound by a type signature of the constraint type Ord a
External instance of the constraint type forall a. Ord a => Eq a
External instance of the constraint type forall a. Ord a => Eq a
Evidence bound by a type signature of the constraint type Ord a
Instance of class: Ord of the constraint type forall a. Ord a => Ord (Seq a)
Instance of class: Ord of the constraint type forall a. Ord a => Ord (ViewR a)
Evidence bound by a type signature of the constraint type Ord a
Instance of class: Eq of the constraint type forall a. Eq a => Eq (ViewR a)
Ord, Int -> ViewR a -> ShowS
[ViewR a] -> ShowS
ViewR a -> [Char]
(Int -> ViewR a -> ShowS)
-> (ViewR a -> [Char]) -> ([ViewR a] -> ShowS) -> Show (ViewR a)
forall a. Show a => Int -> ViewR a -> ShowS
forall a. Show a => [ViewR a] -> ShowS
forall a. Show a => ViewR a -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [ViewR a] -> ShowS
$cshowList :: forall a. Show a => [ViewR a] -> ShowS
show :: ViewR a -> [Char]
$cshow :: forall a. Show a => ViewR a -> [Char]
showsPrec :: Int -> ViewR a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> ViewR a -> ShowS
External instance of the constraint type Ord Int
Instance of class: Show of the constraint type forall a. Show a => Show (Seq a)
Evidence bound by a type signature of the constraint type Show a
Show, ReadPrec [ViewR a]
ReadPrec (ViewR a)
Int -> ReadS (ViewR a)
ReadS [ViewR a]
(Int -> ReadS (ViewR a))
-> ReadS [ViewR a]
-> ReadPrec (ViewR a)
-> ReadPrec [ViewR a]
-> Read (ViewR a)
forall a. Read a => ReadPrec [ViewR a]
forall a. Read a => ReadPrec (ViewR a)
forall a. Read a => Int -> ReadS (ViewR a)
forall a. Read a => ReadS [ViewR a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ViewR a]
$creadListPrec :: forall a. Read a => ReadPrec [ViewR a]
readPrec :: ReadPrec (ViewR a)
$creadPrec :: forall a. Read a => ReadPrec (ViewR a)
readList :: ReadS [ViewR a]
$creadList :: forall a. Read a => ReadS [ViewR a]
readsPrec :: Int -> ReadS (ViewR a)
$creadsPrec :: forall a. Read a => Int -> ReadS (ViewR a)
External instance of the constraint type Monad ReadPrec
External instance of the constraint type Monad ReadPrec
Instance of class: Read of the constraint type forall a. Read a => Read (Seq a)
Instance of class: Read of the constraint type forall a. Read a => Read (ViewR a)
Evidence bound by a type signature of the constraint type Read a
Read)

#ifdef __GLASGOW_HASKELL__
deriving instance Data a => Data (ViewR a)

-- | @since 0.5.8
deriving instance Generic1 ViewR

-- | @since 0.5.8
deriving instance Generic (ViewR a)
#endif

INSTANCE_TYPEABLE1(ViewR)

instance Functor ViewR where
    {-# INLINE fmap #-}
    fmap :: (a -> b) -> ViewR a -> ViewR b
fmap a -> b
_ ViewR a
EmptyR       = ViewR b
forall a. ViewR a
EmptyR
    fmap a -> b
f (Seq a
xs :> a
x)    = (a -> b) -> Seq a -> Seq b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Instance of class: Functor of the constraint type Functor Seq
fmap a -> b
f Seq a
xs Seq b -> b -> ViewR b
forall a. Seq a -> a -> ViewR a
:> a -> b
f a
x

instance Foldable ViewR where
    foldMap :: (a -> m) -> ViewR a -> m
foldMap a -> m
_ ViewR a
EmptyR = m
forall a. Monoid a => a
Evidence bound by a type signature of the constraint type Monoid m
mempty
    foldMap a -> m
f (Seq a
xs :> a
x) = (a -> m) -> Seq a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
Evidence bound by a type signature of the constraint type Monoid m
Instance of class: Foldable of the constraint type Foldable Seq
foldMap a -> m
f Seq a
xs m -> m -> m
forall a. Monoid a => a -> a -> a
Evidence bound by a type signature of the constraint type Monoid m
<> a -> m
f a
x

    foldr :: (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) = (a -> b -> b) -> b -> Seq a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
Instance of class: Foldable of the constraint type Foldable Seq
foldr a -> b -> b
f (a -> b -> b
f a
x b
z) Seq a
xs

    foldl :: (b -> a -> b) -> b -> ViewR a -> b
foldl b -> a -> b
_ b
z ViewR a
EmptyR = b
z
    foldl b -> a -> b
f b
z (Seq a
xs :> a
x) = (b -> a -> b) -> b -> Seq a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Instance of class: Foldable of the constraint type Foldable Seq
foldl b -> a -> b
f b
z Seq a
xs b -> a -> b
`f` a
x

    foldr1 :: (a -> a -> a) -> ViewR a -> a
foldr1 a -> a -> a
_ ViewR a
EmptyR = [Char] -> a
forall a. HasCallStack => [Char] -> a
error [Char]
"foldr1: empty view"
    foldr1 a -> a -> a
f (Seq a
xs :> a
x) = (a -> a -> a) -> a -> Seq a -> a
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
Instance of class: Foldable of the constraint type Foldable Seq
foldr a -> a -> a
f a
x Seq a
xs
#if MIN_VERSION_base(4,8,0)
    null :: ViewR a -> Bool
null ViewR a
EmptyR = Bool
True
    null (Seq a
_ :> a
_) = Bool
False

    length :: ViewR a -> Int
length ViewR a
EmptyR = Int
0
    length (Seq a
xs :> a
_) = Seq a -> Int
forall a. Seq a -> Int
length Seq a
xs Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Int
1
#endif

instance Traversable ViewR where
    traverse :: (a -> f b) -> ViewR a -> f (ViewR b)
traverse a -> f b
_ ViewR a
EmptyR       = ViewR b -> f (ViewR b)
forall (f :: * -> *) a. Applicative f => a -> f a
Evidence bound by a type signature of the constraint type Applicative f
pure ViewR b
forall a. ViewR a
EmptyR
    traverse a -> f b
f (Seq a
xs :> a
x)    = (Seq b -> b -> ViewR b) -> f (Seq b) -> f b -> f (ViewR b)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
Evidence bound by a type signature of the constraint type Applicative f
liftA2 Seq b -> b -> ViewR b
forall a. Seq a -> a -> ViewR a
(:>) ((a -> f b) -> Seq a -> f (Seq b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
Evidence bound by a type signature of the constraint type Applicative f
Instance of class: Traversable of the constraint type Traversable Seq
traverse a -> f b
f Seq a
xs) (a -> f b
f a
x)

-- | \( O(1) \). Analyse the right end of a sequence.
viewr           ::  Seq a -> ViewR a
viewr :: Seq a -> ViewR a
viewr (Seq FingerTree (Elem a)
xs)  =  case FingerTree (Elem a) -> ViewRTree (Elem a)
forall a. Sized a => FingerTree a -> ViewRTree a
Instance of class: Sized of the constraint type forall a. Sized (Elem a)
viewRTree FingerTree (Elem a)
xs of
    ViewRTree (Elem a)
EmptyRTree -> ViewR a
forall a. ViewR a
EmptyR
    SnocRTree FingerTree (Elem a)
xs' (Elem a
x) -> FingerTree (Elem a) -> Seq a
forall a. FingerTree (Elem a) -> Seq a
Seq FingerTree (Elem a)
xs' Seq a -> a -> ViewR a
forall a. Seq a -> a -> ViewR a
:> a
x

{-# SPECIALIZE viewRTree :: FingerTree (Elem a) -> ViewRTree (Elem a) #-}
{-# SPECIALIZE viewRTree :: FingerTree (Node a) -> ViewRTree (Node a) #-}
viewRTree       :: Sized a => FingerTree a -> ViewRTree a
viewRTree :: FingerTree a -> ViewRTree a
viewRTree FingerTree a
EmptyT                = ViewRTree a
forall a. ViewRTree a
EmptyRTree
viewRTree (Single a
z)            = FingerTree a -> a -> ViewRTree a
forall a. FingerTree a -> a -> ViewRTree a
SnocRTree FingerTree a
forall a. FingerTree a
EmptyT a
z
viewRTree (Deep Int
s Digit a
pr FingerTree (Node a)
m (One a
z)) = FingerTree a -> a -> ViewRTree a
forall a. FingerTree a -> a -> ViewRTree a
SnocRTree (Int -> Digit a -> FingerTree (Node a) -> FingerTree a
forall a. Int -> Digit a -> FingerTree (Node a) -> FingerTree a
pullR (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
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)) =
    FingerTree a -> a -> ViewRTree a
forall a. FingerTree a -> a -> ViewRTree a
SnocRTree (Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
size a
z) Digit a
pr FingerTree (Node a)
m (a -> Digit a
forall a. a -> Digit a
One a
y)) a
z
viewRTree (Deep Int
s Digit a
pr FingerTree (Node a)
m (Three a
x a
y a
z)) =
    FingerTree a -> a -> ViewRTree a
forall a. FingerTree a -> a -> ViewRTree a
SnocRTree (Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
size a
z) Digit a
pr FingerTree (Node a)
m (a -> a -> Digit a
forall a. a -> a -> Digit a
Two a
x a
y)) a
z
viewRTree (Deep Int
s Digit a
pr FingerTree (Node a)
m (Four a
w a
x a
y a
z)) =
    FingerTree a -> a -> ViewRTree a
forall a. FingerTree a -> a -> ViewRTree a
SnocRTree (Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
size a
z) Digit a
pr FingerTree (Node a)
m (a -> a -> a -> Digit a
forall a. a -> a -> a -> Digit a
Three a
w a
x a
y)) a
z

------------------------------------------------------------------------
-- Scans
--
-- These are not particularly complex applications of the Traversable
-- functor, though making the correspondence with Data.List exact
-- requires the use of (<|) and (|>).
--
-- Note that save for the single (<|) or (|>), we maintain the original
-- structure of the Seq, not having to do any restructuring of our own.
--
-- wasserman.louis@gmail.com, 5/23/09
------------------------------------------------------------------------

-- | 'scanl' is similar to 'foldl', but returns a sequence of reduced
-- values from the left:
--
-- > scanl f z (fromList [x1, x2, ...]) = fromList [z, z `f` x1, (z `f` x1) `f` x2, ...]
scanl :: (a -> b -> a) -> a -> Seq b -> Seq a
scanl :: (a -> b -> a) -> a -> Seq b -> Seq a
scanl a -> b -> a
f a
z0 Seq b
xs = a
z0 a -> Seq a -> Seq a
forall a. a -> Seq a -> Seq a
<| (a, Seq a) -> Seq a
forall a b. (a, b) -> b
snd ((a -> b -> (a, a)) -> a -> Seq b -> (a, Seq a)
forall (t :: * -> *) a b c.
Traversable t =>
(a -> b -> (a, c)) -> a -> t b -> (a, t c)
Instance of class: Traversable of the constraint type Traversable Seq
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' is a variant of 'scanl' that has no starting value argument:
--
-- > scanl1 f (fromList [x1, x2, ...]) = fromList [x1, x1 `f` x2, ...]
scanl1 :: (a -> a -> a) -> Seq a -> Seq a
scanl1 :: (a -> a -> a) -> Seq a -> Seq a
scanl1 a -> a -> a
f Seq a
xs = case Seq a -> ViewL a
forall a. Seq a -> ViewL a
viewl Seq a
xs of
    ViewL a
EmptyL          -> [Char] -> Seq a
forall a. HasCallStack => [Char] -> a
error [Char]
"scanl1 takes a nonempty sequence as an argument"
    a
x :< Seq a
xs'        -> (a -> a -> a) -> a -> Seq a -> Seq a
forall a b. (a -> b -> a) -> a -> Seq b -> Seq a
scanl a -> a -> a
f a
x Seq a
xs'

-- | 'scanr' is the right-to-left dual of 'scanl'.
scanr :: (a -> b -> b) -> b -> Seq a -> Seq b
scanr :: (a -> b -> b) -> b -> Seq a -> Seq b
scanr a -> b -> b
f b
z0 Seq a
xs = (b, Seq b) -> Seq b
forall a b. (a, b) -> b
snd ((b -> a -> (b, b)) -> b -> Seq a -> (b, Seq b)
forall (t :: * -> *) a b c.
Traversable t =>
(a -> b -> (a, c)) -> a -> t b -> (a, t c)
Instance of class: Traversable of the constraint type Traversable Seq
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) Seq b -> b -> Seq b
forall a. Seq a -> a -> Seq a
|> b
z0

-- | 'scanr1' is a variant of 'scanr' that has no starting value argument.
scanr1 :: (a -> a -> a) -> Seq a -> Seq a
scanr1 :: (a -> a -> a) -> Seq a -> Seq a
scanr1 a -> a -> a
f Seq a
xs = case Seq a -> ViewR a
forall a. Seq a -> ViewR a
viewr Seq a
xs of
    ViewR a
EmptyR          -> [Char] -> Seq a
forall a. HasCallStack => [Char] -> a
error [Char]
"scanr1 takes a nonempty sequence as an argument"
    Seq a
xs' :> a
x        -> (a -> a -> a) -> a -> Seq a -> Seq a
forall a b. (a -> b -> b) -> b -> Seq a -> Seq b
scanr a -> a -> a
f a
x Seq a
xs'

-- Indexing

-- | \( O(\log(\min(i,n-i))) \). The element at the specified position,
-- counting from 0.  The argument should thus be a non-negative
-- integer less than the size of the sequence.
-- If the position is out of range, 'index' fails with an error.
--
-- prop> xs `index` i = toList xs !! i
--
-- Caution: 'index' necessarily delays retrieving the requested
-- element until the result is forced. It can therefore lead to a space
-- leak if the result is stored, unforced, in another structure. To retrieve
-- an element immediately without forcing it, use 'lookup' or '(!?)'.
index           :: Seq a -> Int -> a
index :: Seq a -> Int -> a
index (Seq FingerTree (Elem a)
xs) Int
i
  -- See note on unsigned arithmetic in splitAt
  | Int -> Word
forall a b. (Integral a, Num b) => a -> b
External instance of the constraint type Num Word
External instance of the constraint type Integral Int
fromIntegral Int
i Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Word
< (Int -> Word
forall a b. (Integral a, Num b) => a -> b
External instance of the constraint type Num Word
External instance of the constraint type Integral Int
fromIntegral (FingerTree (Elem a) -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized a => Sized (FingerTree a)
Instance of class: Sized of the constraint type forall a. Sized (Elem a)
size FingerTree (Elem a)
xs) :: Word) = case Int -> FingerTree (Elem a) -> Place (Elem a)
forall a. Sized a => Int -> FingerTree a -> Place a
Instance of class: Sized of the constraint type forall a. Sized (Elem a)
lookupTree Int
i FingerTree (Elem a)
xs of
                Place Int
_ (Elem a
x) -> a
x
  | Bool
otherwise   = 
      [Char] -> a
forall a. HasCallStack => [Char] -> a
error ([Char] -> a) -> [Char] -> a
forall a b. (a -> b) -> a -> b
$ [Char]
"index out of bounds in call to: Data.Sequence.index " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
External instance of the constraint type Show Int
show Int
i

-- | \( O(\log(\min(i,n-i))) \). The element at the specified position,
-- counting from 0. If the specified position is negative or at
-- least the length of the sequence, 'lookup' returns 'Nothing'.
--
-- prop> 0 <= i < length xs ==> lookup i xs == Just (toList xs !! i)
-- prop> i < 0 || i >= length xs ==> lookup i xs = Nothing
--
-- Unlike 'index', this can be used to retrieve an element without
-- forcing it. For example, to insert the fifth element of a sequence
-- @xs@ into a 'Data.Map.Lazy.Map' @m@ at key @k@, you could use
--
-- @
-- case lookup 5 xs of
--   Nothing -> m
--   Just x -> 'Data.Map.Lazy.insert' k x m
-- @
--
-- @since 0.5.8
lookup            :: Int -> Seq a -> Maybe a
lookup :: Int -> Seq a -> Maybe a
lookup Int
i (Seq FingerTree (Elem a)
xs)
  -- Note: we perform the lookup *before* applying the Just constructor
  -- to ensure that we don't hold a reference to the whole sequence in
  -- a thunk. If we applied the Just constructor around the case, the
  -- actual lookup wouldn't be performed unless and until the value was
  -- forced.
  | Int -> Word
forall a b. (Integral a, Num b) => a -> b
External instance of the constraint type Num Word
External instance of the constraint type Integral Int
fromIntegral Int
i Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Word
< (Int -> Word
forall a b. (Integral a, Num b) => a -> b
External instance of the constraint type Num Word
External instance of the constraint type Integral Int
fromIntegral (FingerTree (Elem a) -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized a => Sized (FingerTree a)
Instance of class: Sized of the constraint type forall a. Sized (Elem a)
size FingerTree (Elem a)
xs) :: Word) = case Int -> FingerTree (Elem a) -> Place (Elem a)
forall a. Sized a => Int -> FingerTree a -> Place a
Instance of class: Sized of the constraint type forall a. Sized (Elem a)
lookupTree Int
i FingerTree (Elem a)
xs of
                Place Int
_ (Elem a
x) -> a -> Maybe a
forall a. a -> Maybe a
Just a
x
  | Bool
otherwise = Maybe a
forall a. Maybe a
Nothing

-- | \( O(\log(\min(i,n-i))) \). A flipped, infix version of `lookup`.
--
-- @since 0.5.8
(!?) ::           Seq a -> Int -> Maybe a
!? :: Seq a -> Int -> Maybe a
(!?) = (Int -> Seq a -> Maybe a) -> Seq a -> Int -> Maybe a
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> Seq a -> Maybe a
forall a. Int -> Seq a -> Maybe a
lookup

data Place a = Place {-# UNPACK #-} !Int a
#ifdef TESTING
    deriving Show
#endif

{-# SPECIALIZE lookupTree :: Int -> FingerTree (Elem a) -> Place (Elem a) #-}
{-# SPECIALIZE lookupTree :: Int -> FingerTree (Node a) -> Place (Node a) #-}
lookupTree :: Sized a => Int -> FingerTree a -> Place a
lookupTree :: Int -> FingerTree a -> Place a
lookupTree !Int
_ FingerTree a
EmptyT = [Char] -> Place a
forall a. HasCallStack => [Char] -> a
error [Char]
"lookupTree of empty tree"
lookupTree Int
i (Single a
x) = Int -> a -> Place a
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
spr     =  Int -> Digit a -> Place a
forall a. Sized a => Int -> Digit a -> Place a
Evidence bound by a type signature of the constraint type Sized a
lookupDigit Int
i Digit a
pr
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
spm     =  case Int -> FingerTree (Node a) -> Place (Node a)
forall a. Sized a => Int -> FingerTree a -> Place a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
lookupTree (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
spr) FingerTree (Node a)
m of
                   Place Int
i' Node a
xs -> Int -> Node a -> Place a
forall a. Sized a => Int -> Node a -> Place a
Evidence bound by a type signature of the constraint type Sized a
lookupNode Int
i' Node a
xs
  | Bool
otherwise   =  Int -> Digit a -> Place a
forall a. Sized a => Int -> Digit a -> Place a
Evidence bound by a type signature of the constraint type Sized a
lookupDigit (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
spm) Digit a
sf
  where
    spr :: Int
spr     = Digit a -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized a => Sized (Digit a)
Evidence bound by a type signature of the constraint type Sized a
size Digit a
pr
    spm :: Int
spm     = Int
spr Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ FingerTree (Node a) -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized a => Sized (FingerTree a)
Instance of class: Sized of the constraint type forall a. Sized (Node a)
size FingerTree (Node a)
m

{-# SPECIALIZE lookupNode :: Int -> Node (Elem a) -> Place (Elem a) #-}
{-# SPECIALIZE lookupNode :: Int -> Node (Node a) -> Place (Node a) #-}
lookupNode :: Sized a => Int -> Node a -> Place a
lookupNode :: Int -> Node a -> Place a
lookupNode Int
i (Node2 Int
_ a
a a
b)
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
sa      = Int -> a -> Place a
forall a. Int -> a -> Place a
Place Int
i a
a
  | Bool
otherwise   = Int -> a -> Place a
forall a. Int -> a -> Place a
Place (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
sa) a
b
  where
    sa :: Int
sa      = a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
size a
a
lookupNode Int
i (Node3 Int
_ a
a a
b a
c)
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
sa      = Int -> a -> Place a
forall a. Int -> a -> Place a
Place Int
i a
a
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
sab     = Int -> a -> Place a
forall a. Int -> a -> Place a
Place (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
sa) a
b
  | Bool
otherwise   = Int -> a -> Place a
forall a. Int -> a -> Place a
Place (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
sab) a
c
  where
    sa :: Int
sa      = a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
size a
a
    sab :: Int
sab     = Int
sa Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
size a
b

{-# SPECIALIZE lookupDigit :: Int -> Digit (Elem a) -> Place (Elem a) #-}
{-# SPECIALIZE lookupDigit :: Int -> Digit (Node a) -> Place (Node a) #-}
lookupDigit :: Sized a => Int -> Digit a -> Place a
lookupDigit :: Int -> Digit a -> Place a
lookupDigit Int
i (One a
a) = Int -> a -> Place a
forall a. Int -> a -> Place a
Place Int
i a
a
lookupDigit Int
i (Two a
a a
b)
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
sa      = Int -> a -> Place a
forall a. Int -> a -> Place a
Place Int
i a
a
  | Bool
otherwise   = Int -> a -> Place a
forall a. Int -> a -> Place a
Place (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
sa) a
b
  where
    sa :: Int
sa      = a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
size a
a
lookupDigit Int
i (Three a
a a
b a
c)
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
sa      = Int -> a -> Place a
forall a. Int -> a -> Place a
Place Int
i a
a
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
sab     = Int -> a -> Place a
forall a. Int -> a -> Place a
Place (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
sa) a
b
  | Bool
otherwise   = Int -> a -> Place a
forall a. Int -> a -> Place a
Place (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
sab) a
c
  where
    sa :: Int
sa      = a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
size a
a
    sab :: Int
sab     = Int
sa Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
size a
b
lookupDigit Int
i (Four a
a a
b a
c a
d)
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
sa      = Int -> a -> Place a
forall a. Int -> a -> Place a
Place Int
i a
a
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
sab     = Int -> a -> Place a
forall a. Int -> a -> Place a
Place (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
sa) a
b
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
sabc    = Int -> a -> Place a
forall a. Int -> a -> Place a
Place (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
sab) a
c
  | Bool
otherwise   = Int -> a -> Place a
forall a. Int -> a -> Place a
Place (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
sabc) a
d
  where
    sa :: Int
sa      = a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
size a
a
    sab :: Int
sab     = Int
sa Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
size a
b
    sabc :: Int
sabc    = Int
sab Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
size a
c

-- | \( O(\log(\min(i,n-i))) \). Replace the element at the specified position.
-- If the position is out of range, the original sequence is returned.
update          :: Int -> a -> Seq a -> Seq a
update :: Int -> a -> Seq a -> Seq a
update Int
i a
x (Seq FingerTree (Elem a)
xs)
  -- See note on unsigned arithmetic in splitAt
  | Int -> Word
forall a b. (Integral a, Num b) => a -> b
External instance of the constraint type Num Word
External instance of the constraint type Integral Int
fromIntegral Int
i Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Word
< (Int -> Word
forall a b. (Integral a, Num b) => a -> b
External instance of the constraint type Num Word
External instance of the constraint type Integral Int
fromIntegral (FingerTree (Elem a) -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized a => Sized (FingerTree a)
Instance of class: Sized of the constraint type forall a. Sized (Elem a)
size FingerTree (Elem a)
xs) :: Word) = FingerTree (Elem a) -> Seq a
forall a. FingerTree (Elem a) -> Seq a
Seq (Elem a -> Int -> FingerTree (Elem a) -> FingerTree (Elem a)
forall a.
Elem a -> Int -> FingerTree (Elem a) -> FingerTree (Elem a)
updateTree (a -> Elem a
forall a. a -> Elem a
Elem a
x) Int
i FingerTree (Elem a)
xs)
  | Bool
otherwise   = FingerTree (Elem a) -> Seq a
forall a. FingerTree (Elem a) -> Seq a
Seq FingerTree (Elem a)
xs

-- It seems a shame to copy the implementation of the top layer of
-- `adjust` instead of just using `update i x = adjust (const x) i`.
-- With the latter implementation, updating the same position many
-- times could lead to silly thunks building up around that position.
-- The thunks will each look like @const v a@, where @v@ is the new
-- value and @a@ the old.
updateTree      :: Elem a -> Int -> FingerTree (Elem a) -> FingerTree (Elem a)
updateTree :: Elem a -> Int -> FingerTree (Elem a) -> FingerTree (Elem a)
updateTree Elem a
_ !Int
_ FingerTree (Elem a)
EmptyT = FingerTree (Elem a)
forall a. FingerTree a
EmptyT -- Unreachable
updateTree Elem a
v Int
_i (Single Elem a
_) = Elem a -> FingerTree (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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
spr     = Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> FingerTree (Elem a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
s (Elem a -> Int -> Digit (Elem a) -> Digit (Elem a)
forall a. Elem a -> Int -> Digit (Elem a) -> Digit (Elem a)
updateDigit Elem a
v Int
i Digit (Elem a)
pr) FingerTree (Node (Elem a))
m Digit (Elem a)
sf
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
spm     = let !m' :: FingerTree (Node (Elem a))
m' = (Int -> Node (Elem a) -> Node (Elem a))
-> Int -> FingerTree (Node (Elem a)) -> FingerTree (Node (Elem a))
forall a.
(Sized a, MaybeForce a) =>
(Int -> a -> a) -> Int -> FingerTree a -> FingerTree a
Instance of class: MaybeForce of the constraint type forall a. MaybeForce (Node a)
Instance of class: Sized of the constraint type forall a. Sized (Node a)
adjustTree (Elem a -> Int -> Node (Elem a) -> Node (Elem a)
forall a. Elem a -> Int -> Node (Elem a) -> Node (Elem a)
updateNode Elem a
v) (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
spr) FingerTree (Node (Elem a))
m
                  in Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> FingerTree (Elem a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
s Digit (Elem a)
pr FingerTree (Node (Elem a))
m' Digit (Elem a)
sf
  | Bool
otherwise   = Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> FingerTree (Elem a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
s Digit (Elem a)
pr FingerTree (Node (Elem a))
m (Elem a -> Int -> Digit (Elem a) -> Digit (Elem a)
forall a. Elem a -> Int -> Digit (Elem a) -> Digit (Elem a)
updateDigit Elem a
v (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
spm) Digit (Elem a)
sf)
  where
    spr :: Int
spr     = Digit (Elem a) -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized a => Sized (Digit a)
Instance of class: Sized of the constraint type forall a. Sized (Elem a)
size Digit (Elem a)
pr
    spm :: Int
spm     = Int
spr Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ FingerTree (Node (Elem a)) -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized a => Sized (FingerTree a)
Instance of class: Sized of the constraint type forall a. Sized (Node a)
size FingerTree (Node (Elem a))
m

updateNode      :: Elem a -> Int -> Node (Elem a) -> Node (Elem a)
updateNode :: Elem a -> Int -> Node (Elem a) -> Node (Elem a)
updateNode Elem a
v Int
i (Node2 Int
s Elem a
a Elem a
b)
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
sa      = Int -> Elem a -> Elem a -> Node (Elem a)
forall a. Int -> a -> a -> Node a
Node2 Int
s Elem a
v Elem a
b
  | Bool
otherwise   = Int -> Elem a -> Elem a -> Node (Elem a)
forall a. Int -> a -> a -> Node a
Node2 Int
s Elem a
a Elem a
v
  where
    sa :: Int
sa      = Elem a -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized (Elem a)
size Elem a
a
updateNode Elem a
v Int
i (Node3 Int
s Elem a
a Elem a
b Elem a
c)
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
sa      = Int -> Elem a -> Elem a -> Elem a -> Node (Elem a)
forall a. Int -> a -> a -> a -> Node a
Node3 Int
s Elem a
v Elem a
b Elem a
c
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
sab     = Int -> Elem a -> Elem a -> Elem a -> Node (Elem a)
forall a. Int -> a -> a -> a -> Node a
Node3 Int
s Elem a
a Elem a
v Elem a
c
  | Bool
otherwise   = Int -> Elem a -> Elem a -> Elem a -> Node (Elem a)
forall a. Int -> a -> a -> a -> Node a
Node3 Int
s Elem a
a Elem a
b Elem a
v
  where
    sa :: Int
sa      = Elem a -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized (Elem a)
size Elem a
a
    sab :: Int
sab     = Int
sa Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Elem a -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized (Elem a)
size Elem a
b

updateDigit     :: Elem a -> Int -> Digit (Elem a) -> Digit (Elem a)
updateDigit :: Elem a -> Int -> Digit (Elem a) -> Digit (Elem a)
updateDigit Elem a
v !Int
_i (One Elem a
_) = Elem a -> Digit (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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
sa      = Elem a -> Elem a -> Digit (Elem a)
forall a. a -> a -> Digit a
Two Elem a
v Elem a
b
  | Bool
otherwise   = Elem a -> Elem a -> Digit (Elem a)
forall a. a -> a -> Digit a
Two Elem a
a Elem a
v
  where
    sa :: Int
sa      = Elem a -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized (Elem a)
size Elem a
a
updateDigit Elem a
v Int
i (Three Elem a
a Elem a
b Elem a
c)
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
sa      = Elem a -> Elem a -> Elem a -> Digit (Elem a)
forall a. a -> a -> a -> Digit a
Three Elem a
v Elem a
b Elem a
c
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
sab     = Elem a -> Elem a -> Elem a -> Digit (Elem a)
forall a. a -> a -> a -> Digit a
Three Elem a
a Elem a
v Elem a
c
  | Bool
otherwise   = Elem a -> Elem a -> Elem a -> Digit (Elem a)
forall a. a -> a -> a -> Digit a
Three Elem a
a Elem a
b Elem a
v
  where
    sa :: Int
sa      = Elem a -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized (Elem a)
size Elem a
a
    sab :: Int
sab     = Int
sa Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Elem a -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized (Elem a)
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
sa      = Elem a -> Elem a -> Elem a -> Elem a -> Digit (Elem a)
forall a. a -> a -> a -> a -> Digit a
Four Elem a
v Elem a
b Elem a
c Elem a
d
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
sab     = Elem a -> Elem a -> Elem a -> Elem a -> Digit (Elem a)
forall a. a -> a -> a -> a -> Digit a
Four Elem a
a Elem a
v Elem a
c Elem a
d
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
sabc    = Elem a -> Elem a -> Elem a -> Elem a -> Digit (Elem a)
forall a. a -> a -> a -> a -> Digit a
Four Elem a
a Elem a
b Elem a
v Elem a
d
  | Bool
otherwise   = Elem a -> Elem a -> Elem a -> Elem a -> Digit (Elem a)
forall a. a -> a -> a -> a -> Digit a
Four Elem a
a Elem a
b Elem a
c Elem a
v
  where
    sa :: Int
sa      = Elem a -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized (Elem a)
size Elem a
a
    sab :: Int
sab     = Int
sa Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Elem a -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized (Elem a)
size Elem a
b
    sabc :: Int
sabc    = Int
sab Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Elem a -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized (Elem a)
size Elem a
c

-- | \( O(\log(\min(i,n-i))) \). Update the element at the specified position.  If
-- the position is out of range, the original sequence is returned.  'adjust'
-- can lead to poor performance and even memory leaks, because it does not
-- force the new value before installing it in the sequence. 'adjust'' should
-- usually be preferred.
--
-- @since 0.5.8
adjust          :: (a -> a) -> Int -> Seq a -> Seq a
adjust :: (a -> a) -> Int -> Seq a -> Seq a
adjust a -> a
f Int
i (Seq FingerTree (Elem a)
xs)
  -- See note on unsigned arithmetic in splitAt
  | Int -> Word
forall a b. (Integral a, Num b) => a -> b
External instance of the constraint type Num Word
External instance of the constraint type Integral Int
fromIntegral Int
i Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Word
< (Int -> Word
forall a b. (Integral a, Num b) => a -> b
External instance of the constraint type Num Word
External instance of the constraint type Integral Int
fromIntegral (FingerTree (Elem a) -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized a => Sized (FingerTree a)
Instance of class: Sized of the constraint type forall a. Sized (Elem a)
size FingerTree (Elem a)
xs) :: Word) = FingerTree (Elem a) -> Seq a
forall a. FingerTree (Elem a) -> Seq a
Seq ((Int -> Elem a -> Elem a)
-> Int -> FingerTree (Elem a) -> FingerTree (Elem a)
forall a.
(Sized a, MaybeForce a) =>
(Int -> a -> a) -> Int -> FingerTree a -> FingerTree a
Instance of class: MaybeForce of the constraint type forall a. MaybeForce (Elem a)
Instance of class: Sized of the constraint type forall a. Sized (Elem a)
adjustTree (Int -> (Elem a -> Elem a) -> Elem a -> Elem a
`seq` (a -> a) -> Elem a -> Elem a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Instance of class: Functor of the constraint type Functor Elem
fmap a -> a
f) Int
i FingerTree (Elem a)
xs)
  | Bool
otherwise   = FingerTree (Elem a) -> Seq a
forall a. FingerTree (Elem a) -> Seq a
Seq FingerTree (Elem a)
xs

-- | \( O(\log(\min(i,n-i))) \). Update the element at the specified position.
-- If the position is out of range, the original sequence is returned.
-- The new value is forced before it is installed in the sequence.
--
-- @
-- adjust' f i xs =
--  case xs !? i of
--    Nothing -> xs
--    Just x -> let !x' = f x
--              in update i x' xs
-- @
--
-- @since 0.5.8
adjust'          :: forall a . (a -> a) -> Int -> Seq a -> Seq a
#if __GLASGOW_HASKELL__ >= 708
adjust' :: (a -> a) -> Int -> Seq a -> Seq a
adjust' a -> a
f Int
i Seq a
xs
  -- See note on unsigned arithmetic in splitAt
  | Int -> Word
forall a b. (Integral a, Num b) => a -> b
External instance of the constraint type Num Word
External instance of the constraint type Integral Int
fromIntegral Int
i Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Word
< (Int -> Word
forall a b. (Integral a, Num b) => a -> b
External instance of the constraint type Num Word
External instance of the constraint type Integral Int
fromIntegral (Seq a -> Int
forall a. Seq a -> Int
length Seq a
xs) :: Word) =
      FingerTree (ForceBox a) -> Seq a
coerce (FingerTree (ForceBox a) -> Seq a)
-> FingerTree (ForceBox a) -> Seq a
forall a b. (a -> b) -> a -> b
$ (Int -> ForceBox a -> ForceBox a)
-> Int -> FingerTree (ForceBox a) -> FingerTree (ForceBox a)
forall a.
(Sized a, MaybeForce a) =>
(Int -> a -> a) -> Int -> FingerTree a -> FingerTree a
Instance of class: MaybeForce of the constraint type forall a. MaybeForce (ForceBox a)
Instance of class: Sized of the constraint type forall a. Sized (ForceBox a)
adjustTree (\ !Int
_k (ForceBox a
a) -> a -> ForceBox a
forall a. a -> ForceBox a
ForceBox (a -> a
f a
a)) Int
i (Seq a -> FingerTree (ForceBox a)
coerce Seq a
xs)
  | Bool
otherwise   = Seq a
xs
#else
-- This is inefficient, but fixing it would take a lot of fuss and bother
-- for little immediate gain. We can deal with that when we have another
-- Haskell implementation to worry about.
adjust' f i xs =
  case xs !? i of
    Nothing -> xs
    Just x -> let !x' = f x
              in update i x' xs
#endif

{-# SPECIALIZE adjustTree :: (Int -> ForceBox a -> ForceBox a) -> Int -> FingerTree (ForceBox a) -> FingerTree (ForceBox a) #-}
{-# SPECIALIZE adjustTree :: (Int -> Elem a -> Elem a) -> Int -> FingerTree (Elem a) -> FingerTree (Elem a) #-}
{-# SPECIALIZE adjustTree :: (Int -> Node a -> Node a) -> Int -> FingerTree (Node a) -> FingerTree (Node a) #-}
adjustTree      :: (Sized a, MaybeForce a) => (Int -> a -> a) ->
             Int -> FingerTree a -> FingerTree a
adjustTree :: (Int -> a -> a) -> Int -> FingerTree a -> FingerTree a
adjustTree Int -> a -> a
_ !Int
_ FingerTree a
EmptyT = FingerTree a
forall a. FingerTree a
EmptyT -- Unreachable
adjustTree Int -> a -> a
f Int
i (Single a
x) = a -> FingerTree a
forall a. a -> FingerTree a
Single (a -> FingerTree a) -> a -> FingerTree a
forall a b. MaybeForce a => (a -> b) -> a -> b
Evidence bound by a type signature of the constraint type MaybeForce a
$!? 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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
spr     = Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
s ((Int -> a -> a) -> Int -> Digit a -> Digit a
forall a.
(Sized a, MaybeForce a) =>
(Int -> a -> a) -> Int -> Digit a -> Digit a
Evidence bound by a type signature of the constraint type MaybeForce a
Evidence bound by a type signature of the constraint type Sized a
adjustDigit Int -> a -> a
f Int
i Digit a
pr) FingerTree (Node a)
m Digit a
sf
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
spm     = let !m' :: FingerTree (Node a)
m' = (Int -> Node a -> Node a)
-> Int -> FingerTree (Node a) -> FingerTree (Node a)
forall a.
(Sized a, MaybeForce a) =>
(Int -> a -> a) -> Int -> FingerTree a -> FingerTree a
Instance of class: MaybeForce of the constraint type forall a. MaybeForce (Node a)
Instance of class: Sized of the constraint type forall a. Sized (Node a)
adjustTree ((Int -> a -> a) -> Int -> Node a -> Node a
forall a.
(Sized a, MaybeForce a) =>
(Int -> a -> a) -> Int -> Node a -> Node a
Evidence bound by a type signature of the constraint type MaybeForce a
Evidence bound by a type signature of the constraint type Sized a
adjustNode Int -> a -> a
f) (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
spr) FingerTree (Node a)
m
                  in Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
s Digit a
pr FingerTree (Node a)
m' Digit a
sf
  | Bool
otherwise   = Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
s Digit a
pr FingerTree (Node a)
m ((Int -> a -> a) -> Int -> Digit a -> Digit a
forall a.
(Sized a, MaybeForce a) =>
(Int -> a -> a) -> Int -> Digit a -> Digit a
Evidence bound by a type signature of the constraint type MaybeForce a
Evidence bound by a type signature of the constraint type Sized a
adjustDigit Int -> a -> a
f (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
spm) Digit a
sf)
  where
    spr :: Int
spr     = Digit a -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized a => Sized (Digit a)
Evidence bound by a type signature of the constraint type Sized a
size Digit a
pr
    spm :: Int
spm     = Int
spr Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ FingerTree (Node a) -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized a => Sized (FingerTree a)
Instance of class: Sized of the constraint type forall a. Sized (Node a)
size FingerTree (Node a)
m

{-# SPECIALIZE adjustNode :: (Int -> Elem a -> Elem a) -> Int -> Node (Elem a) -> Node (Elem a) #-}
{-# SPECIALIZE adjustNode :: (Int -> Node a -> Node a) -> Int -> Node (Node a) -> Node (Node a) #-}
adjustNode      :: (Sized a, MaybeForce a) => (Int -> a -> a) -> Int -> Node a -> Node a
adjustNode :: (Int -> a -> a) -> Int -> Node a -> Node a
adjustNode Int -> a -> a
f Int
i (Node2 Int
s a
a a
b)
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
sa      = let fia :: a
fia = Int -> a -> a
f Int
i a
a in a
fia a -> Node a -> Node a
forall a b. MaybeForce a => a -> b -> b
Evidence bound by a type signature of the constraint type MaybeForce a
`mseq` Int -> a -> a -> Node a
forall a. Int -> a -> a -> Node a
Node2 Int
s a
fia a
b
  | Bool
otherwise   = let fisab :: a
fisab = Int -> a -> a
f (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
sa) a
b in a
fisab a -> Node a -> Node a
forall a b. MaybeForce a => a -> b -> b
Evidence bound by a type signature of the constraint type MaybeForce a
`mseq` Int -> a -> a -> Node a
forall a. Int -> a -> a -> Node a
Node2 Int
s a
a a
fisab
  where
    sa :: Int
sa      = a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
size a
a
adjustNode Int -> a -> a
f Int
i (Node3 Int
s a
a a
b a
c)
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
sa      = let fia :: a
fia = Int -> a -> a
f Int
i a
a in a
fia a -> Node a -> Node a
forall a b. MaybeForce a => a -> b -> b
Evidence bound by a type signature of the constraint type MaybeForce a
`mseq` Int -> a -> a -> a -> Node a
forall a. Int -> a -> a -> a -> Node a
Node3 Int
s a
fia a
b a
c
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
sab     = let fisab :: a
fisab = Int -> a -> a
f (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
sa) a
b in a
fisab a -> Node a -> Node a
forall a b. MaybeForce a => a -> b -> b
Evidence bound by a type signature of the constraint type MaybeForce a
`mseq` Int -> a -> a -> a -> Node a
forall a. Int -> a -> a -> a -> Node a
Node3 Int
s a
a a
fisab a
c
  | Bool
otherwise   = let fisabc :: a
fisabc = Int -> a -> a
f (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
sab) a
c in a
fisabc a -> Node a -> Node a
forall a b. MaybeForce a => a -> b -> b
Evidence bound by a type signature of the constraint type MaybeForce a
`mseq` Int -> a -> a -> a -> Node a
forall a. Int -> a -> a -> a -> Node a
Node3 Int
s a
a a
b a
fisabc
  where
    sa :: Int
sa      = a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
size a
a
    sab :: Int
sab     = Int
sa Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
size a
b

{-# SPECIALIZE adjustDigit :: (Int -> Elem a -> Elem a) -> Int -> Digit (Elem a) -> Digit (Elem a) #-}
{-# SPECIALIZE adjustDigit :: (Int -> Node a -> Node a) -> Int -> Digit (Node a) -> Digit (Node a) #-}
adjustDigit     :: (Sized a, MaybeForce a) => (Int -> a -> a) -> Int -> Digit a -> Digit a
adjustDigit :: (Int -> a -> a) -> Int -> Digit a -> Digit a
adjustDigit Int -> a -> a
f !Int
i (One a
a) = a -> Digit a
forall a. a -> Digit a
One (a -> Digit a) -> a -> Digit a
forall a b. MaybeForce a => (a -> b) -> a -> b
Evidence bound by a type signature of the constraint type MaybeForce a
$!? Int -> a -> a
f Int
i a
a
adjustDigit Int -> a -> a
f Int
i (Two a
a a
b)
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
sa      = let fia :: a
fia = Int -> a -> a
f Int
i a
a in a
fia a -> Digit a -> Digit a
forall a b. MaybeForce a => a -> b -> b
Evidence bound by a type signature of the constraint type MaybeForce a
`mseq` a -> a -> Digit a
forall a. a -> a -> Digit a
Two a
fia a
b
  | Bool
otherwise   = let fisab :: a
fisab = Int -> a -> a
f (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
sa) a
b in a
fisab a -> Digit a -> Digit a
forall a b. MaybeForce a => a -> b -> b
Evidence bound by a type signature of the constraint type MaybeForce a
`mseq` a -> a -> Digit a
forall a. a -> a -> Digit a
Two a
a a
fisab
  where
    sa :: Int
sa      = a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
size a
a
adjustDigit Int -> a -> a
f Int
i (Three a
a a
b a
c)
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
sa      = let fia :: a
fia = Int -> a -> a
f Int
i a
a in a
fia a -> Digit a -> Digit a
forall a b. MaybeForce a => a -> b -> b
Evidence bound by a type signature of the constraint type MaybeForce a
`mseq` a -> a -> a -> Digit a
forall a. a -> a -> a -> Digit a
Three a
fia a
b a
c
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
sab     = let fisab :: a
fisab = Int -> a -> a
f (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
sa) a
b in a
fisab a -> Digit a -> Digit a
forall a b. MaybeForce a => a -> b -> b
Evidence bound by a type signature of the constraint type MaybeForce a
`mseq` a -> a -> a -> Digit a
forall a. a -> a -> a -> Digit a
Three a
a a
fisab a
c
  | Bool
otherwise   = let fisabc :: a
fisabc = Int -> a -> a
f (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
sab) a
c in a
fisabc a -> Digit a -> Digit a
forall a b. MaybeForce a => a -> b -> b
Evidence bound by a type signature of the constraint type MaybeForce a
`mseq` a -> a -> a -> Digit a
forall a. a -> a -> a -> Digit a
Three a
a a
b a
fisabc
  where
    sa :: Int
sa      = a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
size a
a
    sab :: Int
sab     = Int
sa Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
size a
b
adjustDigit Int -> a -> a
f Int
i (Four a
a a
b a
c a
d)
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
sa      = let fia :: a
fia = Int -> a -> a
f Int
i a
a in a
fia a -> Digit a -> Digit a
forall a b. MaybeForce a => a -> b -> b
Evidence bound by a type signature of the constraint type MaybeForce a
`mseq` a -> a -> a -> a -> Digit a
forall a. a -> a -> a -> a -> Digit a
Four a
fia a
b a
c a
d
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
sab     = let fisab :: a
fisab = Int -> a -> a
f (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
sa) a
b in a
fisab a -> Digit a -> Digit a
forall a b. MaybeForce a => a -> b -> b
Evidence bound by a type signature of the constraint type MaybeForce a
`mseq` a -> a -> a -> a -> Digit a
forall a. a -> a -> a -> a -> Digit a
Four a
a a
fisab a
c a
d
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
sabc    = let fisabc :: a
fisabc = Int -> a -> a
f (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
sab) a
c in a
fisabc a -> Digit a -> Digit a
forall a b. MaybeForce a => a -> b -> b
Evidence bound by a type signature of the constraint type MaybeForce a
`mseq` a -> a -> a -> a -> Digit a
forall a. a -> a -> a -> a -> Digit a
Four a
a a
b a
fisabc a
d
  | Bool
otherwise   = let fisabcd :: a
fisabcd = Int -> a -> a
f (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
sabc) a
d in a
fisabcd a -> Digit a -> Digit a
forall a b. MaybeForce a => a -> b -> b
Evidence bound by a type signature of the constraint type MaybeForce a
`mseq` a -> a -> a -> a -> Digit a
forall a. a -> a -> a -> a -> Digit a
Four a
a a
b a
c a
fisabcd
  where
    sa :: Int
sa      = a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
size a
a
    sab :: Int
sab     = Int
sa Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
size a
b
    sabc :: Int
sabc    = Int
sab Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
size a
c

-- | \( O(\log(\min(i,n-i))) \). @'insertAt' i x xs@ inserts @x@ into @xs@
-- at the index @i@, shifting the rest of the sequence over.
--
-- @
-- insertAt 2 x (fromList [a,b,c,d]) = fromList [a,b,x,c,d]
-- insertAt 4 x (fromList [a,b,c,d]) = insertAt 10 x (fromList [a,b,c,d])
--                                   = fromList [a,b,c,d,x]
-- @
--
-- prop> insertAt i x xs = take i xs >< singleton x >< drop i xs
--
-- @since 0.5.8
insertAt :: Int -> a -> Seq a -> Seq a
insertAt :: Int -> a -> Seq a -> Seq a
insertAt Int
i a
a s :: Seq a
s@(Seq FingerTree (Elem a)
xs)
  | Int -> Word
forall a b. (Integral a, Num b) => a -> b
External instance of the constraint type Num Word
External instance of the constraint type Integral Int
fromIntegral Int
i Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Word
< (Int -> Word
forall a b. (Integral a, Num b) => a -> b
External instance of the constraint type Num Word
External instance of the constraint type Integral Int
fromIntegral (FingerTree (Elem a) -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized a => Sized (FingerTree a)
Instance of class: Sized of the constraint type forall a. Sized (Elem a)
size FingerTree (Elem a)
xs) :: Word)
      = FingerTree (Elem a) -> Seq a
forall a. FingerTree (Elem a) -> Seq a
Seq ((Int -> Elem a -> Ins (Elem a))
-> Int -> FingerTree (Elem a) -> FingerTree (Elem a)
forall a.
Sized a =>
(Int -> a -> Ins a) -> Int -> FingerTree a -> FingerTree a
Instance of class: Sized of the constraint type forall a. Sized (Elem a)
insTree (Int -> (Elem a -> Ins (Elem a)) -> Elem a -> Ins (Elem a)
`seq` Elem a -> Elem a -> Ins (Elem a)
forall a. a -> a -> Ins a
InsTwo (a -> Elem a
forall a. a -> Elem a
Elem a
a)) Int
i FingerTree (Elem a)
xs)
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
<= Int
0 = a
a a -> Seq a -> Seq a
forall a. a -> Seq a -> Seq a
<| Seq a
s
  | Bool
otherwise = Seq a
s Seq a -> a -> Seq a
forall a. Seq a -> a -> Seq a
|> a
a

data Ins a = InsOne a | InsTwo a a

{-# SPECIALIZE insTree :: (Int -> Elem a -> Ins (Elem a)) -> Int -> FingerTree (Elem a) -> FingerTree (Elem a) #-}
{-# SPECIALIZE insTree :: (Int -> Node a -> Ins (Node a)) -> Int -> FingerTree (Node a) -> FingerTree (Node a) #-}
insTree      :: Sized a => (Int -> a -> Ins a) ->
             Int -> FingerTree a -> FingerTree a
insTree :: (Int -> a -> Ins a) -> Int -> FingerTree a -> FingerTree a
insTree Int -> a -> Ins a
_ !Int
_ FingerTree a
EmptyT = FingerTree a
forall a. FingerTree a
EmptyT -- Unreachable
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' -> a -> FingerTree a
forall a. a -> FingerTree a
Single a
x'
  InsTwo a
m a
n -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
forall a.
Sized a =>
Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Evidence bound by a type signature of the constraint type Sized a
deep (a -> Digit a
forall a. a -> Digit a
One a
m) FingerTree (Node a)
forall a. FingerTree a
EmptyT (a -> Digit a
forall a. a -> Digit a
One a
n)
insTree Int -> a -> Ins a
f Int
i (Deep Int
s Digit a
pr FingerTree (Node a)
m Digit a
sf)
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
spr     = case (Int -> a -> Ins a) -> Int -> Digit a -> InsDigNode a
forall a.
Sized a =>
(Int -> a -> Ins a) -> Int -> Digit a -> InsDigNode a
Evidence bound by a type signature of the constraint type Sized a
insLeftDigit Int -> a -> Ins a
f Int
i Digit a
pr of
     InsLeftDig Digit a
pr' -> Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Int
1) Digit a
pr' FingerTree (Node a)
m Digit a
sf
     InsDigNode Digit a
pr' Node a
n -> FingerTree (Node a)
m FingerTree (Node a) -> FingerTree a -> FingerTree a
`seq` Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Int
1) Digit a
pr' (Node a
n Node a -> FingerTree (Node a) -> FingerTree (Node a)
forall a. Sized a => a -> FingerTree a -> FingerTree a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
`consTree` FingerTree (Node a)
m) Digit a
sf
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
spm     = let !m' :: FingerTree (Node a)
m' = (Int -> Node a -> Ins (Node a))
-> Int -> FingerTree (Node a) -> FingerTree (Node a)
forall a.
Sized a =>
(Int -> a -> Ins a) -> Int -> FingerTree a -> FingerTree a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
insTree ((Int -> a -> Ins a) -> Int -> Node a -> Ins (Node a)
forall a.
Sized a =>
(Int -> a -> Ins a) -> Int -> Node a -> Ins (Node a)
Evidence bound by a type signature of the constraint type Sized a
insNode Int -> a -> Ins a
f) (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
spr) FingerTree (Node a)
m
                  in Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Int
1) Digit a
pr FingerTree (Node a)
m' Digit a
sf
  | Bool
otherwise   = case (Int -> a -> Ins a) -> Int -> Digit a -> InsNodeDig a
forall a.
Sized a =>
(Int -> a -> Ins a) -> Int -> Digit a -> InsNodeDig a
Evidence bound by a type signature of the constraint type Sized a
insRightDigit Int -> a -> Ins a
f (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
spm) Digit a
sf of
     InsRightDig Digit a
sf' -> Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Int
1) Digit a
pr FingerTree (Node a)
m Digit a
sf'
     InsNodeDig Node a
n Digit a
sf' -> FingerTree (Node a)
m FingerTree (Node a) -> FingerTree a -> FingerTree a
`seq` Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Int
1) Digit a
pr (FingerTree (Node a)
m FingerTree (Node a) -> Node a -> FingerTree (Node a)
forall a. Sized a => FingerTree a -> a -> FingerTree a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
`snocTree` Node a
n) Digit a
sf'
  where
    spr :: Int
spr     = Digit a -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized a => Sized (Digit a)
Evidence bound by a type signature of the constraint type Sized a
size Digit a
pr
    spm :: Int
spm     = Int
spr Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ FingerTree (Node a) -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized a => Sized (FingerTree a)
Instance of class: Sized of the constraint type forall a. Sized (Node a)
size FingerTree (Node a)
m

{-# SPECIALIZE insNode :: (Int -> Elem a -> Ins (Elem a)) -> Int -> Node (Elem a) -> Ins (Node (Elem a)) #-}
{-# SPECIALIZE insNode :: (Int -> Node a -> Ins (Node a)) -> Int -> Node (Node a) -> Ins (Node (Node a)) #-}
insNode :: Sized a => (Int -> a -> Ins a) -> Int -> Node a -> Ins (Node a)
insNode :: (Int -> a -> Ins a) -> Int -> Node a -> Ins (Node a)
insNode Int -> a -> Ins a
f Int
i (Node2 Int
s a
a a
b)
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
sa = case Int -> a -> Ins a
f Int
i a
a of
      InsOne a
n -> Node a -> Ins (Node a)
forall a. a -> Ins a
InsOne (Node a -> Ins (Node a)) -> Node a -> Ins (Node a)
forall a b. (a -> b) -> a -> b
$ Int -> a -> a -> Node a
forall a. Int -> a -> a -> Node a
Node2 (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Int
1) a
n a
b
      InsTwo a
m a
n -> Node a -> Ins (Node a)
forall a. a -> Ins a
InsOne (Node a -> Ins (Node a)) -> Node a -> Ins (Node a)
forall a b. (a -> b) -> a -> b
$ Int -> a -> a -> a -> Node a
forall a. Int -> a -> a -> a -> Node a
Node3 (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Int
1) a
m a
n a
b
  | Bool
otherwise = case Int -> a -> Ins a
f (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
sa) a
b of
      InsOne a
n -> Node a -> Ins (Node a)
forall a. a -> Ins a
InsOne (Node a -> Ins (Node a)) -> Node a -> Ins (Node a)
forall a b. (a -> b) -> a -> b
$ Int -> a -> a -> Node a
forall a. Int -> a -> a -> Node a
Node2 (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Int
1) a
a a
n
      InsTwo a
m a
n -> Node a -> Ins (Node a)
forall a. a -> Ins a
InsOne (Node a -> Ins (Node a)) -> Node a -> Ins (Node a)
forall a b. (a -> b) -> a -> b
$ Int -> a -> a -> a -> Node a
forall a. Int -> a -> a -> a -> Node a
Node3 (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Int
1) a
a a
m a
n
  where sa :: Int
sa = a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
size a
a
insNode Int -> a -> Ins a
f Int
i (Node3 Int
s a
a a
b a
c)
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
sa = case Int -> a -> Ins a
f Int
i a
a of
      InsOne a
n -> Node a -> Ins (Node a)
forall a. a -> Ins a
InsOne (Node a -> Ins (Node a)) -> Node a -> Ins (Node a)
forall a b. (a -> b) -> a -> b
$ Int -> a -> a -> a -> Node a
forall a. Int -> a -> a -> a -> Node a
Node3 (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Int
1) a
n a
b a
c
      InsTwo a
m a
n -> Node a -> Node a -> Ins (Node a)
forall a. a -> a -> Ins a
InsTwo (Int -> a -> a -> Node a
forall a. Int -> a -> a -> Node a
Node2 (Int
sa Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Int
1) a
m a
n) (Int -> a -> a -> Node a
forall a. Int -> a -> a -> Node a
Node2 (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
sa) a
b a
c)
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
sab = case Int -> a -> Ins a
f (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
sa) a
b of
      InsOne a
n -> Node a -> Ins (Node a)
forall a. a -> Ins a
InsOne (Node a -> Ins (Node a)) -> Node a -> Ins (Node a)
forall a b. (a -> b) -> a -> b
$ Int -> a -> a -> a -> Node a
forall a. Int -> a -> a -> a -> Node a
Node3 (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Int
1) a
a a
n a
c
      InsTwo a
m a
n -> Node a -> Node a -> Ins (Node a)
forall a. a -> a -> Ins a
InsTwo Node a
am Node a
nc
        where !am :: Node a
am = a -> a -> Node a
forall a. Sized a => a -> a -> Node a
Evidence bound by a type signature of the constraint type Sized a
node2 a
a a
m
              !nc :: Node a
nc = a -> a -> Node a
forall a. Sized a => a -> a -> Node a
Evidence bound by a type signature of the constraint type Sized a
node2 a
n a
c
  | Bool
otherwise = case Int -> a -> Ins a
f (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
sab) a
c of
      InsOne a
n -> Node a -> Ins (Node a)
forall a. a -> Ins a
InsOne (Node a -> Ins (Node a)) -> Node a -> Ins (Node a)
forall a b. (a -> b) -> a -> b
$ Int -> a -> a -> a -> Node a
forall a. Int -> a -> a -> a -> Node a
Node3 (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Int
1) a
a a
b a
n
      InsTwo a
m a
n -> Node a -> Node a -> Ins (Node a)
forall a. a -> a -> Ins a
InsTwo (Int -> a -> a -> Node a
forall a. Int -> a -> a -> Node a
Node2 Int
sab a
a a
b) (Int -> a -> a -> Node a
forall a. Int -> a -> a -> Node a
Node2 (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
sab Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Int
1) a
m a
n)
  where sa :: Int
sa = a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
size a
a
        sab :: Int
sab = Int
sa Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
size a
b

data InsDigNode a = InsLeftDig !(Digit a) | InsDigNode !(Digit a) !(Node a)
{-# SPECIALIZE insLeftDigit :: (Int -> Elem a -> Ins (Elem a)) -> Int -> Digit (Elem a) -> InsDigNode (Elem a) #-}
{-# SPECIALIZE insLeftDigit :: (Int -> Node a -> Ins (Node a)) -> Int -> Digit (Node a) -> InsDigNode (Node a) #-}
insLeftDigit :: Sized a => (Int -> a -> Ins a) -> Int -> Digit a -> InsDigNode a
insLeftDigit :: (Int -> a -> Ins a) -> Int -> Digit a -> InsDigNode a
insLeftDigit Int -> a -> Ins a
f !Int
i (One a
a) = case Int -> a -> Ins a
f Int
i a
a of
  InsOne a
a' -> Digit a -> InsDigNode a
forall a. Digit a -> InsDigNode a
InsLeftDig (Digit a -> InsDigNode a) -> Digit a -> InsDigNode a
forall a b. (a -> b) -> a -> b
$ a -> Digit a
forall a. a -> Digit a
One a
a'
  InsTwo a
a1 a
a2 -> Digit a -> InsDigNode a
forall a. Digit a -> InsDigNode a
InsLeftDig (Digit a -> InsDigNode a) -> Digit a -> InsDigNode a
forall a b. (a -> b) -> a -> b
$ a -> a -> Digit a
forall a. a -> a -> Digit a
Two a
a1 a
a2
insLeftDigit Int -> a -> Ins a
f Int
i (Two a
a a
b)
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
sa = case Int -> a -> Ins a
f Int
i a
a of
     InsOne a
a' -> Digit a -> InsDigNode a
forall a. Digit a -> InsDigNode a
InsLeftDig (Digit a -> InsDigNode a) -> Digit a -> InsDigNode a
forall a b. (a -> b) -> a -> b
$ a -> a -> Digit a
forall a. a -> a -> Digit a
Two a
a' a
b
     InsTwo a
a1 a
a2 -> Digit a -> InsDigNode a
forall a. Digit a -> InsDigNode a
InsLeftDig (Digit a -> InsDigNode a) -> Digit a -> InsDigNode a
forall a b. (a -> b) -> a -> b
$ a -> a -> a -> Digit a
forall a. a -> a -> a -> Digit a
Three a
a1 a
a2 a
b
  | Bool
otherwise = case Int -> a -> Ins a
f (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
sa) a
b of
     InsOne a
b' -> Digit a -> InsDigNode a
forall a. Digit a -> InsDigNode a
InsLeftDig (Digit a -> InsDigNode a) -> Digit a -> InsDigNode a
forall a b. (a -> b) -> a -> b
$ a -> a -> Digit a
forall a. a -> a -> Digit a
Two a
a a
b'
     InsTwo a
b1 a
b2 -> Digit a -> InsDigNode a
forall a. Digit a -> InsDigNode a
InsLeftDig (Digit a -> InsDigNode a) -> Digit a -> InsDigNode a
forall a b. (a -> b) -> a -> b
$ a -> a -> a -> Digit a
forall a. a -> a -> a -> Digit a
Three a
a a
b1 a
b2
  where sa :: Int
sa = a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
size a
a
insLeftDigit Int -> a -> Ins a
f Int
i (Three a
a a
b a
c)
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
sa = case Int -> a -> Ins a
f Int
i a
a of
     InsOne a
a' -> Digit a -> InsDigNode a
forall a. Digit a -> InsDigNode a
InsLeftDig (Digit a -> InsDigNode a) -> Digit a -> InsDigNode a
forall a b. (a -> b) -> a -> b
$ a -> a -> a -> Digit a
forall a. a -> a -> a -> Digit a
Three a
a' a
b a
c
     InsTwo a
a1 a
a2 -> Digit a -> InsDigNode a
forall a. Digit a -> InsDigNode a
InsLeftDig (Digit a -> InsDigNode a) -> Digit a -> InsDigNode a
forall a b. (a -> b) -> a -> b
$ a -> a -> a -> a -> Digit a
forall a. a -> a -> a -> a -> Digit a
Four a
a1 a
a2 a
b a
c
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
sab = case Int -> a -> Ins a
f (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
sa) a
b of
     InsOne a
b' -> Digit a -> InsDigNode a
forall a. Digit a -> InsDigNode a
InsLeftDig (Digit a -> InsDigNode a) -> Digit a -> InsDigNode a
forall a b. (a -> b) -> a -> b
$ a -> a -> a -> Digit a
forall a. a -> a -> a -> Digit a
Three a
a a
b' a
c
     InsTwo a
b1 a
b2 -> Digit a -> InsDigNode a
forall a. Digit a -> InsDigNode a
InsLeftDig (Digit a -> InsDigNode a) -> Digit a -> InsDigNode a
forall a b. (a -> b) -> a -> b
$ a -> a -> a -> a -> Digit a
forall a. a -> a -> a -> a -> Digit a
Four a
a a
b1 a
b2 a
c
  | Bool
otherwise = case Int -> a -> Ins a
f (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
sab) a
c of
     InsOne a
c' -> Digit a -> InsDigNode a
forall a. Digit a -> InsDigNode a
InsLeftDig (Digit a -> InsDigNode a) -> Digit a -> InsDigNode a
forall a b. (a -> b) -> a -> b
$ a -> a -> a -> Digit a
forall a. a -> a -> a -> Digit a
Three a
a a
b a
c'
     InsTwo a
c1 a
c2 -> Digit a -> InsDigNode a
forall a. Digit a -> InsDigNode a
InsLeftDig (Digit a -> InsDigNode a) -> Digit a -> InsDigNode a
forall a b. (a -> b) -> a -> b
$ a -> a -> a -> a -> Digit a
forall a. a -> a -> a -> a -> Digit a
Four a
a a
b a
c1 a
c2
  where sa :: Int
sa = a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
size a
a
        sab :: Int
sab = Int
sa Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
size a
b
insLeftDigit Int -> a -> Ins a
f Int
i (Four a
a a
b a
c a
d)
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
sa = case Int -> a -> Ins a
f Int
i a
a of
     InsOne a
a' -> Digit a -> InsDigNode a
forall a. Digit a -> InsDigNode a
InsLeftDig (Digit a -> InsDigNode a) -> Digit a -> InsDigNode a
forall a b. (a -> b) -> a -> b
$ a -> a -> a -> a -> Digit a
forall a. a -> a -> a -> a -> Digit a
Four a
a' a
b a
c a
d
     InsTwo a
a1 a
a2 -> Digit a -> Node a -> InsDigNode a
forall a. Digit a -> Node a -> InsDigNode a
InsDigNode (a -> a -> Digit a
forall a. a -> a -> Digit a
Two a
a1 a
a2) (a -> a -> a -> Node a
forall a. Sized a => a -> a -> a -> Node a
Evidence bound by a type signature of the constraint type Sized a
node3 a
b a
c a
d)
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
sab = case Int -> a -> Ins a
f (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
sa) a
b of
     InsOne a
b' -> Digit a -> InsDigNode a
forall a. Digit a -> InsDigNode a
InsLeftDig (Digit a -> InsDigNode a) -> Digit a -> InsDigNode a
forall a b. (a -> b) -> a -> b
$ a -> a -> a -> a -> Digit a
forall a. a -> a -> a -> a -> Digit a
Four a
a a
b' a
c a
d
     InsTwo a
b1 a
b2 -> Digit a -> Node a -> InsDigNode a
forall a. Digit a -> Node a -> InsDigNode a
InsDigNode (a -> a -> Digit a
forall a. a -> a -> Digit a
Two a
a a
b1) (a -> a -> a -> Node a
forall a. Sized a => a -> a -> a -> Node a
Evidence bound by a type signature of the constraint type Sized a
node3 a
b2 a
c a
d)
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
sabc = case Int -> a -> Ins a
f (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
sab) a
c of
     InsOne a
c' -> Digit a -> InsDigNode a
forall a. Digit a -> InsDigNode a
InsLeftDig (Digit a -> InsDigNode a) -> Digit a -> InsDigNode a
forall a b. (a -> b) -> a -> b
$ a -> a -> a -> a -> Digit a
forall a. a -> a -> a -> a -> Digit a
Four a
a a
b a
c' a
d
     InsTwo a
c1 a
c2 -> Digit a -> Node a -> InsDigNode a
forall a. Digit a -> Node a -> InsDigNode a
InsDigNode (a -> a -> Digit a
forall a. a -> a -> Digit a
Two a
a a
b) (a -> a -> a -> Node a
forall a. Sized a => a -> a -> a -> Node a
Evidence bound by a type signature of the constraint type Sized a
node3 a
c1 a
c2 a
d)
  | Bool
otherwise = case Int -> a -> Ins a
f (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
sabc) a
d of
     InsOne a
d' -> Digit a -> InsDigNode a
forall a. Digit a -> InsDigNode a
InsLeftDig (Digit a -> InsDigNode a) -> Digit a -> InsDigNode a
forall a b. (a -> b) -> a -> b
$ a -> a -> a -> a -> Digit a
forall a. a -> a -> a -> a -> Digit a
Four a
a a
b a
c a
d'
     InsTwo a
d1 a
d2 -> Digit a -> Node a -> InsDigNode a
forall a. Digit a -> Node a -> InsDigNode a
InsDigNode (a -> a -> Digit a
forall a. a -> a -> Digit a
Two a
a a
b) (a -> a -> a -> Node a
forall a. Sized a => a -> a -> a -> Node a
Evidence bound by a type signature of the constraint type Sized a
node3 a
c a
d1 a
d2)
  where sa :: Int
sa = a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
size a
a
        sab :: Int
sab = Int
sa Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
size a
b
        sabc :: Int
sabc = Int
sab Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
size a
c

data InsNodeDig a = InsRightDig !(Digit a) | InsNodeDig !(Node a) !(Digit a)
{-# SPECIALIZE insRightDigit :: (Int -> Elem a -> Ins (Elem a)) -> Int -> Digit (Elem a) -> InsNodeDig (Elem a) #-}
{-# SPECIALIZE insRightDigit :: (Int -> Node a -> Ins (Node a)) -> Int -> Digit (Node a) -> InsNodeDig (Node a) #-}
insRightDigit :: Sized a => (Int -> a -> Ins a) -> Int -> Digit a -> InsNodeDig a
insRightDigit :: (Int -> a -> Ins a) -> Int -> Digit a -> InsNodeDig a
insRightDigit Int -> a -> Ins a
f !Int
i (One a
a) = case Int -> a -> Ins a
f Int
i a
a of
  InsOne a
a' -> Digit a -> InsNodeDig a
forall a. Digit a -> InsNodeDig a
InsRightDig (Digit a -> InsNodeDig a) -> Digit a -> InsNodeDig a
forall a b. (a -> b) -> a -> b
$ a -> Digit a
forall a. a -> Digit a
One a
a'
  InsTwo a
a1 a
a2 -> Digit a -> InsNodeDig a
forall a. Digit a -> InsNodeDig a
InsRightDig (Digit a -> InsNodeDig a) -> Digit a -> InsNodeDig a
forall a b. (a -> b) -> a -> b
$ a -> a -> Digit a
forall a. a -> a -> Digit a
Two a
a1 a
a2
insRightDigit Int -> a -> Ins a
f Int
i (Two a
a a
b)
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
sa = case Int -> a -> Ins a
f Int
i a
a of
     InsOne a
a' -> Digit a -> InsNodeDig a
forall a. Digit a -> InsNodeDig a
InsRightDig (Digit a -> InsNodeDig a) -> Digit a -> InsNodeDig a
forall a b. (a -> b) -> a -> b
$ a -> a -> Digit a
forall a. a -> a -> Digit a
Two a
a' a
b
     InsTwo a
a1 a
a2 -> Digit a -> InsNodeDig a
forall a. Digit a -> InsNodeDig a
InsRightDig (Digit a -> InsNodeDig a) -> Digit a -> InsNodeDig a
forall a b. (a -> b) -> a -> b
$ a -> a -> a -> Digit a
forall a. a -> a -> a -> Digit a
Three a
a1 a
a2 a
b
  | Bool
otherwise = case Int -> a -> Ins a
f (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
sa) a
b of
     InsOne a
b' -> Digit a -> InsNodeDig a
forall a. Digit a -> InsNodeDig a
InsRightDig (Digit a -> InsNodeDig a) -> Digit a -> InsNodeDig a
forall a b. (a -> b) -> a -> b
$ a -> a -> Digit a
forall a. a -> a -> Digit a
Two a
a a
b'
     InsTwo a
b1 a
b2 -> Digit a -> InsNodeDig a
forall a. Digit a -> InsNodeDig a
InsRightDig (Digit a -> InsNodeDig a) -> Digit a -> InsNodeDig a
forall a b. (a -> b) -> a -> b
$ a -> a -> a -> Digit a
forall a. a -> a -> a -> Digit a
Three a
a a
b1 a
b2
  where sa :: Int
sa = a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
size a
a
insRightDigit Int -> a -> Ins a
f Int
i (Three a
a a
b a
c)
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
sa = case Int -> a -> Ins a
f Int
i a
a of
     InsOne a
a' -> Digit a -> InsNodeDig a
forall a. Digit a -> InsNodeDig a
InsRightDig (Digit a -> InsNodeDig a) -> Digit a -> InsNodeDig a
forall a b. (a -> b) -> a -> b
$ a -> a -> a -> Digit a
forall a. a -> a -> a -> Digit a
Three a
a' a
b a
c
     InsTwo a
a1 a
a2 -> Digit a -> InsNodeDig a
forall a. Digit a -> InsNodeDig a
InsRightDig (Digit a -> InsNodeDig a) -> Digit a -> InsNodeDig a
forall a b. (a -> b) -> a -> b
$ a -> a -> a -> a -> Digit a
forall a. a -> a -> a -> a -> Digit a
Four a
a1 a
a2 a
b a
c
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
sab = case Int -> a -> Ins a
f (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
sa) a
b of
     InsOne a
b' -> Digit a -> InsNodeDig a
forall a. Digit a -> InsNodeDig a
InsRightDig (Digit a -> InsNodeDig a) -> Digit a -> InsNodeDig a
forall a b. (a -> b) -> a -> b
$ a -> a -> a -> Digit a
forall a. a -> a -> a -> Digit a
Three a
a a
b' a
c
     InsTwo a
b1 a
b2 -> Digit a -> InsNodeDig a
forall a. Digit a -> InsNodeDig a
InsRightDig (Digit a -> InsNodeDig a) -> Digit a -> InsNodeDig a
forall a b. (a -> b) -> a -> b
$ a -> a -> a -> a -> Digit a
forall a. a -> a -> a -> a -> Digit a
Four a
a a
b1 a
b2 a
c
  | Bool
otherwise = case Int -> a -> Ins a
f (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
sab) a
c of
     InsOne a
c' -> Digit a -> InsNodeDig a
forall a. Digit a -> InsNodeDig a
InsRightDig (Digit a -> InsNodeDig a) -> Digit a -> InsNodeDig a
forall a b. (a -> b) -> a -> b
$ a -> a -> a -> Digit a
forall a. a -> a -> a -> Digit a
Three a
a a
b a
c'
     InsTwo a
c1 a
c2 -> Digit a -> InsNodeDig a
forall a. Digit a -> InsNodeDig a
InsRightDig (Digit a -> InsNodeDig a) -> Digit a -> InsNodeDig a
forall a b. (a -> b) -> a -> b
$ a -> a -> a -> a -> Digit a
forall a. a -> a -> a -> a -> Digit a
Four a
a a
b a
c1 a
c2
  where sa :: Int
sa = a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
size a
a
        sab :: Int
sab = Int
sa Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
size a
b
insRightDigit Int -> a -> Ins a
f Int
i (Four a
a a
b a
c a
d)
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
sa = case Int -> a -> Ins a
f Int
i a
a of
     InsOne a
a' -> Digit a -> InsNodeDig a
forall a. Digit a -> InsNodeDig a
InsRightDig (Digit a -> InsNodeDig a) -> Digit a -> InsNodeDig a
forall a b. (a -> b) -> a -> b
$ a -> a -> a -> a -> Digit a
forall a. a -> a -> a -> a -> Digit a
Four a
a' a
b a
c a
d
     InsTwo a
a1 a
a2 -> Node a -> Digit a -> InsNodeDig a
forall a. Node a -> Digit a -> InsNodeDig a
InsNodeDig (a -> a -> a -> Node a
forall a. Sized a => a -> a -> a -> Node a
Evidence bound by a type signature of the constraint type Sized a
node3 a
a1 a
a2 a
b) (a -> a -> Digit a
forall a. a -> a -> Digit a
Two a
c a
d)
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
sab = case Int -> a -> Ins a
f (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
sa) a
b of
     InsOne a
b' -> Digit a -> InsNodeDig a
forall a. Digit a -> InsNodeDig a
InsRightDig (Digit a -> InsNodeDig a) -> Digit a -> InsNodeDig a
forall a b. (a -> b) -> a -> b
$ a -> a -> a -> a -> Digit a
forall a. a -> a -> a -> a -> Digit a
Four a
a a
b' a
c a
d
     InsTwo a
b1 a
b2 -> Node a -> Digit a -> InsNodeDig a
forall a. Node a -> Digit a -> InsNodeDig a
InsNodeDig (a -> a -> a -> Node a
forall a. Sized a => a -> a -> a -> Node a
Evidence bound by a type signature of the constraint type Sized a
node3 a
a a
b1 a
b2) (a -> a -> Digit a
forall a. a -> a -> Digit a
Two a
c a
d)
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
sabc = case Int -> a -> Ins a
f (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
sab) a
c of
     InsOne a
c' -> Digit a -> InsNodeDig a
forall a. Digit a -> InsNodeDig a
InsRightDig (Digit a -> InsNodeDig a) -> Digit a -> InsNodeDig a
forall a b. (a -> b) -> a -> b
$ a -> a -> a -> a -> Digit a
forall a. a -> a -> a -> a -> Digit a
Four a
a a
b a
c' a
d
     InsTwo a
c1 a
c2 -> Node a -> Digit a -> InsNodeDig a
forall a. Node a -> Digit a -> InsNodeDig a
InsNodeDig (a -> a -> a -> Node a
forall a. Sized a => a -> a -> a -> Node a
Evidence bound by a type signature of the constraint type Sized a
node3 a
a a
b a
c1) (a -> a -> Digit a
forall a. a -> a -> Digit a
Two a
c2 a
d)
  | Bool
otherwise = case Int -> a -> Ins a
f (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
sabc) a
d of
     InsOne a
d' -> Digit a -> InsNodeDig a
forall a. Digit a -> InsNodeDig a
InsRightDig (Digit a -> InsNodeDig a) -> Digit a -> InsNodeDig a
forall a b. (a -> b) -> a -> b
$ a -> a -> a -> a -> Digit a
forall a. a -> a -> a -> a -> Digit a
Four a
a a
b a
c a
d'
     InsTwo a
d1 a
d2 -> Node a -> Digit a -> InsNodeDig a
forall a. Node a -> Digit a -> InsNodeDig a
InsNodeDig (a -> a -> a -> Node a
forall a. Sized a => a -> a -> a -> Node a
Evidence bound by a type signature of the constraint type Sized a
node3 a
a a
b a
c) (a -> a -> Digit a
forall a. a -> a -> Digit a
Two a
d1 a
d2)
  where sa :: Int
sa = a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
size a
a
        sab :: Int
sab = Int
sa Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
size a
b
        sabc :: Int
sabc = Int
sab Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
size a
c

-- | \( O(\log(\min(i,n-i))) \). Delete the element of a sequence at a given
-- index. Return the original sequence if the index is out of range.
--
-- @
-- deleteAt 2 [a,b,c,d] = [a,b,d]
-- deleteAt 4 [a,b,c,d] = deleteAt (-1) [a,b,c,d] = [a,b,c,d]
-- @
--
-- @since 0.5.8
deleteAt :: Int -> Seq a -> Seq a
deleteAt :: Int -> Seq a -> Seq a
deleteAt Int
i (Seq FingerTree (Elem a)
xs)
  | Int -> Word
forall a b. (Integral a, Num b) => a -> b
External instance of the constraint type Num Word
External instance of the constraint type Integral Int
fromIntegral Int
i Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Word
< (Int -> Word
forall a b. (Integral a, Num b) => a -> b
External instance of the constraint type Num Word
External instance of the constraint type Integral Int
fromIntegral (FingerTree (Elem a) -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized a => Sized (FingerTree a)
Instance of class: Sized of the constraint type forall a. Sized (Elem a)
size FingerTree (Elem a)
xs) :: Word) = FingerTree (Elem a) -> Seq a
forall a. FingerTree (Elem a) -> Seq a
Seq (FingerTree (Elem a) -> Seq a) -> FingerTree (Elem a) -> Seq a
forall a b. (a -> b) -> a -> b
$ Int -> FingerTree (Elem a) -> FingerTree (Elem a)
forall a. Int -> FingerTree (Elem a) -> FingerTree (Elem a)
delTreeE Int
i FingerTree (Elem a)
xs
  | Bool
otherwise = FingerTree (Elem a) -> Seq a
forall a. FingerTree (Elem a) -> Seq a
Seq FingerTree (Elem a)
xs

delTreeE :: Int -> FingerTree (Elem a) -> FingerTree (Elem a)
delTreeE :: Int -> FingerTree (Elem a) -> FingerTree (Elem a)
delTreeE !Int
_i FingerTree (Elem a)
EmptyT = FingerTree (Elem a)
forall a. FingerTree a
EmptyT -- Unreachable
delTreeE Int
_i Single{} = FingerTree (Elem a)
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
spr = Int
-> Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> FingerTree (Elem a)
forall a.
Int
-> Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> FingerTree (Elem a)
delLeftDigitE Int
i Int
s Digit (Elem a)
pr FingerTree (Node (Elem a))
m Digit (Elem a)
sf
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
spm = case (Int -> Node (Elem a) -> Del (Elem a))
-> Int -> FingerTree (Node (Elem a)) -> DelTree (Elem a)
forall a.
Sized a =>
(Int -> Node a -> Del a) -> Int -> FingerTree (Node a) -> DelTree a
Instance of class: Sized of the constraint type forall a. Sized (Elem a)
delTree Int -> Node (Elem a) -> Del (Elem a)
forall a. Int -> Node (Elem a) -> Del (Elem a)
delNodeE (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
spr) FingerTree (Node (Elem a))
m of
     FullTree FingerTree (Node (Elem a))
m' -> Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> FingerTree (Elem a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
1) Digit (Elem a)
pr FingerTree (Node (Elem a))
m' Digit (Elem a)
sf
     DefectTree Elem a
e -> Int
-> Digit (Elem a)
-> Elem a
-> Digit (Elem a)
-> FingerTree (Elem a)
forall a. Sized a => Int -> Digit a -> a -> Digit a -> FingerTree a
Instance of class: Sized of the constraint type forall a. Sized (Elem a)
delRebuildMiddle (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
1) Digit (Elem a)
pr Elem a
e Digit (Elem a)
sf
  | Bool
otherwise = Int
-> Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> FingerTree (Elem a)
forall a.
Int
-> Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> FingerTree (Elem a)
delRightDigitE (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
spm) Int
s Digit (Elem a)
pr FingerTree (Node (Elem a))
m Digit (Elem a)
sf
  where spr :: Int
spr = Digit (Elem a) -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized a => Sized (Digit a)
Instance of class: Sized of the constraint type forall a. Sized (Elem a)
size Digit (Elem a)
pr
        spm :: Int
spm = Int
spr Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ FingerTree (Node (Elem a)) -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized a => Sized (FingerTree a)
Instance of class: Sized of the constraint type forall a. Sized (Node a)
size FingerTree (Node (Elem a))
m

delNodeE :: Int -> Node (Elem a) -> Del (Elem a)
delNodeE :: 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 -> Node (Elem a) -> Del (Elem a)
forall a. Node a -> Del a
Full (Node (Elem a) -> Del (Elem a)) -> Node (Elem a) -> Del (Elem a)
forall a b. (a -> b) -> a -> b
$ Int -> Elem a -> Elem a -> Node (Elem a)
forall a. Int -> a -> a -> Node a
Node2 Int
2 Elem a
b Elem a
c
  Int
1 -> Node (Elem a) -> Del (Elem a)
forall a. Node a -> Del a
Full (Node (Elem a) -> Del (Elem a)) -> Node (Elem a) -> Del (Elem a)
forall a b. (a -> b) -> a -> b
$ Int -> Elem a -> Elem a -> Node (Elem a)
forall a. Int -> a -> a -> Node a
Node2 Int
2 Elem a
a Elem a
c
  Int
_ -> Node (Elem a) -> Del (Elem a)
forall a. Node a -> Del a
Full (Node (Elem a) -> Del (Elem a)) -> Node (Elem a) -> Del (Elem a)
forall a b. (a -> b) -> a -> b
$ Int -> Elem a -> Elem a -> Node (Elem a)
forall a. Int -> a -> a -> Node a
Node2 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 -> Elem a -> Del (Elem a)
forall a. a -> Del a
Defect Elem a
b
  Int
_ -> Elem a -> Del (Elem a)
forall a. a -> Del a
Defect Elem a
a


delLeftDigitE :: Int -> Int -> Digit (Elem a) -> FingerTree (Node (Elem a)) -> Digit (Elem a) -> FingerTree (Elem a)
delLeftDigitE :: Int
-> Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> FingerTree (Elem a)
delLeftDigitE !Int
_i Int
s One{} FingerTree (Node (Elem a))
m Digit (Elem a)
sf = Int
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> FingerTree (Elem a)
forall a. Int -> FingerTree (Node a) -> Digit a -> FingerTree a
pullL (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- 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 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq Int
== Int
0 = Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> FingerTree (Elem a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
1) (Elem a -> Digit (Elem a)
forall a. a -> Digit a
One Elem a
b) FingerTree (Node (Elem a))
m Digit (Elem a)
sf
  | Bool
otherwise = Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> FingerTree (Elem a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
1) (Elem a -> Digit (Elem a)
forall a. a -> Digit a
One Elem a
a) FingerTree (Node (Elem a))
m Digit (Elem a)
sf
delLeftDigitE 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 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq Int
== Int
0 = Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> FingerTree (Elem a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
1) (Elem a -> Elem a -> Digit (Elem a)
forall a. a -> a -> Digit a
Two Elem a
b Elem a
c) FingerTree (Node (Elem a))
m Digit (Elem a)
sf
  | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq Int
== Int
1 = Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> FingerTree (Elem a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
1) (Elem a -> Elem a -> Digit (Elem a)
forall a. a -> a -> Digit a
Two Elem a
a Elem a
c) FingerTree (Node (Elem a))
m Digit (Elem a)
sf
  | Bool
otherwise = Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> FingerTree (Elem a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
1) (Elem a -> Elem a -> Digit (Elem a)
forall a. a -> a -> Digit a
Two Elem a
a Elem a
b) FingerTree (Node (Elem a))
m Digit (Elem a)
sf
delLeftDigitE 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 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq Int
== Int
0 = Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> FingerTree (Elem a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
1) (Elem a -> Elem a -> Elem a -> Digit (Elem a)
forall a. a -> a -> a -> Digit a
Three Elem a
b Elem a
c Elem a
d) FingerTree (Node (Elem a))
m Digit (Elem a)
sf
  | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq Int
== Int
1 = Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> FingerTree (Elem a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
1) (Elem a -> Elem a -> Elem a -> Digit (Elem a)
forall a. a -> a -> a -> Digit a
Three Elem a
a Elem a
c Elem a
d) FingerTree (Node (Elem a))
m Digit (Elem a)
sf
  | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq Int
== Int
2 = Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> FingerTree (Elem a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
1) (Elem a -> Elem a -> Elem a -> Digit (Elem a)
forall a. a -> a -> a -> Digit a
Three Elem a
a Elem a
b Elem a
d) FingerTree (Node (Elem a))
m Digit (Elem a)
sf
  | Bool
otherwise = Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> FingerTree (Elem a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
1) (Elem a -> Elem a -> Elem a -> Digit (Elem a)
forall a. a -> a -> a -> Digit a
Three Elem a
a Elem a
b Elem a
c) FingerTree (Node (Elem a))
m Digit (Elem a)
sf

delRightDigitE :: Int -> Int -> Digit (Elem a) -> FingerTree (Node (Elem a)) -> Digit (Elem a) -> FingerTree (Elem a)
delRightDigitE :: Int
-> Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> FingerTree (Elem a)
delRightDigitE !Int
_i Int
s Digit (Elem a)
pr FingerTree (Node (Elem a))
m One{} = Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> FingerTree (Elem a)
forall a. Int -> Digit a -> FingerTree (Node a) -> FingerTree a
pullR (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- 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 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq Int
== Int
0 = Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> FingerTree (Elem a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
1) Digit (Elem a)
pr FingerTree (Node (Elem a))
m (Elem a -> Digit (Elem a)
forall a. a -> Digit a
One Elem a
b)
  | Bool
otherwise = Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> FingerTree (Elem a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
1) Digit (Elem a)
pr FingerTree (Node (Elem a))
m (Elem a -> Digit (Elem a)
forall a. a -> Digit a
One Elem a
a)
delRightDigitE 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 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq Int
== Int
0 = Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> FingerTree (Elem a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
1) Digit (Elem a)
pr FingerTree (Node (Elem a))
m (Elem a -> Elem a -> Digit (Elem a)
forall a. a -> a -> Digit a
Two Elem a
b Elem a
c)
  | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq Int
== Int
1 = Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> FingerTree (Elem a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
1) Digit (Elem a)
pr FingerTree (Node (Elem a))
m (Elem a -> Elem a -> Digit (Elem a)
forall a. a -> a -> Digit a
Two Elem a
a Elem a
c)
  | Bool
otherwise = Digit (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> FingerTree (Elem a)
forall a.
Sized a =>
Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Instance of class: Sized of the constraint type forall a. Sized (Elem a)
deep Digit (Elem a)
pr FingerTree (Node (Elem a))
m (Elem a -> Elem a -> Digit (Elem a)
forall a. a -> a -> Digit a
Two Elem a
a Elem a
b)
delRightDigitE 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 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq Int
== Int
0 = Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> FingerTree (Elem a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
1) Digit (Elem a)
pr FingerTree (Node (Elem a))
m (Elem a -> Elem a -> Elem a -> Digit (Elem a)
forall a. a -> a -> a -> Digit a
Three Elem a
b Elem a
c Elem a
d)
  | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq Int
== Int
1 = Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> FingerTree (Elem a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
1) Digit (Elem a)
pr FingerTree (Node (Elem a))
m (Elem a -> Elem a -> Elem a -> Digit (Elem a)
forall a. a -> a -> a -> Digit a
Three Elem a
a Elem a
c Elem a
d)
  | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq Int
== Int
2 = Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> FingerTree (Elem a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
1) Digit (Elem a)
pr FingerTree (Node (Elem a))
m (Elem a -> Elem a -> Elem a -> Digit (Elem a)
forall a. a -> a -> a -> Digit a
Three Elem a
a Elem a
b Elem a
d)
  | Bool
otherwise = Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> FingerTree (Elem a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
1) Digit (Elem a)
pr FingerTree (Node (Elem a))
m (Elem a -> Elem a -> Elem a -> Digit (Elem a)
forall a. a -> a -> a -> Digit a
Three Elem a
a Elem a
b Elem a
c)

data DelTree a = FullTree !(FingerTree (Node a)) | DefectTree a

{-# SPECIALIZE delTree :: (Int -> Node (Elem a) -> Del (Elem a)) -> Int -> FingerTree (Node (Elem a)) -> DelTree (Elem a) #-}
{-# SPECIALIZE delTree :: (Int -> Node (Node a) -> Del (Node a)) -> Int -> FingerTree (Node (Node a)) -> DelTree (Node a) #-}
delTree :: Sized a => (Int -> Node a -> Del a) -> Int -> FingerTree (Node a) -> DelTree a
delTree :: (Int -> Node a -> Del a) -> Int -> FingerTree (Node a) -> DelTree a
delTree Int -> Node a -> Del a
_f !Int
_i FingerTree (Node a)
EmptyT = FingerTree (Node a) -> DelTree a
forall a. FingerTree (Node a) -> DelTree a
FullTree FingerTree (Node a)
forall a. FingerTree a
EmptyT -- Unreachable
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' -> FingerTree (Node a) -> DelTree a
forall a. FingerTree (Node a) -> DelTree a
FullTree (Node a -> FingerTree (Node a)
forall a. a -> FingerTree a
Single Node a
a')
  Defect a
e -> a -> DelTree a
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
spr = case (Int -> Node a -> Del a) -> Int -> Digit (Node a) -> DelDig a
forall a.
Sized a =>
(Int -> Node a -> Del a) -> Int -> Digit (Node a) -> DelDig a
Evidence bound by a type signature of the constraint type Sized a
delDigit Int -> Node a -> Del a
f Int
i Digit (Node a)
pr of
     FullDig Digit (Node a)
pr' -> FingerTree (Node a) -> DelTree a
forall a. FingerTree (Node a) -> DelTree a
FullTree (FingerTree (Node a) -> DelTree a)
-> FingerTree (Node a) -> DelTree a
forall a b. (a -> b) -> a -> b
$ Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> FingerTree (Node a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
1) Digit (Node a)
pr' FingerTree (Node (Node a))
m Digit (Node a)
sf
     DefectDig a
e -> case FingerTree (Node (Node a)) -> ViewLTree (Node (Node a))
forall a. Sized a => FingerTree a -> ViewLTree a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
viewLTree FingerTree (Node (Node a))
m of
                      ViewLTree (Node (Node a))
EmptyLTree -> FingerTree (Node a) -> DelTree a
forall a. FingerTree (Node a) -> DelTree a
FullTree (FingerTree (Node a) -> DelTree a)
-> FingerTree (Node a) -> DelTree a
forall a b. (a -> b) -> a -> b
$ Int -> a -> Digit (Node a) -> FingerTree (Node a)
forall a.
Sized a =>
Int -> a -> Digit (Node a) -> FingerTree (Node a)
Evidence bound by a type signature of the constraint type Sized a
delRebuildRightDigit (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
1) a
e Digit (Node a)
sf
                      ConsLTree Node (Node a)
n FingerTree (Node (Node a))
m' -> FingerTree (Node a) -> DelTree a
forall a. FingerTree (Node a) -> DelTree a
FullTree (FingerTree (Node a) -> DelTree a)
-> FingerTree (Node a) -> DelTree a
forall a b. (a -> b) -> a -> b
$ Int
-> a
-> Node (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> FingerTree (Node a)
forall a.
Sized a =>
Int
-> a
-> Node (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> FingerTree (Node a)
Evidence bound by a type signature of the constraint type Sized a
delRebuildLeftSide (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
1) a
e Node (Node a)
n FingerTree (Node (Node a))
m' Digit (Node a)
sf
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
spm = case (Int -> Node (Node a) -> Del (Node a))
-> Int -> FingerTree (Node (Node a)) -> DelTree (Node a)
forall a.
Sized a =>
(Int -> Node a -> Del a) -> Int -> FingerTree (Node a) -> DelTree a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
delTree ((Int -> Node a -> Del a) -> Int -> Node (Node a) -> Del (Node a)
forall a.
Sized a =>
(Int -> Node a -> Del a) -> Int -> Node (Node a) -> Del (Node a)
Evidence bound by a type signature of the constraint type Sized a
delNode Int -> Node a -> Del a
f) (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
spr) FingerTree (Node (Node a))
m of
     FullTree FingerTree (Node (Node a))
m' -> FingerTree (Node a) -> DelTree a
forall a. FingerTree (Node a) -> DelTree a
FullTree (Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> FingerTree (Node a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
1) Digit (Node a)
pr FingerTree (Node (Node a))
m' Digit (Node a)
sf)
     DefectTree Node a
e -> FingerTree (Node a) -> DelTree a
forall a. FingerTree (Node a) -> DelTree a
FullTree (FingerTree (Node a) -> DelTree a)
-> FingerTree (Node a) -> DelTree a
forall a b. (a -> b) -> a -> b
$ Int
-> Digit (Node a)
-> Node a
-> Digit (Node a)
-> FingerTree (Node a)
forall a. Sized a => Int -> Digit a -> a -> Digit a -> FingerTree a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
delRebuildMiddle (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
1) Digit (Node a)
pr Node a
e Digit (Node a)
sf
  | Bool
otherwise = case (Int -> Node a -> Del a) -> Int -> Digit (Node a) -> DelDig a
forall a.
Sized a =>
(Int -> Node a -> Del a) -> Int -> Digit (Node a) -> DelDig a
Evidence bound by a type signature of the constraint type Sized a
delDigit Int -> Node a -> Del a
f (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
spm) Digit (Node a)
sf of
     FullDig Digit (Node a)
sf' -> FingerTree (Node a) -> DelTree a
forall a. FingerTree (Node a) -> DelTree a
FullTree (FingerTree (Node a) -> DelTree a)
-> FingerTree (Node a) -> DelTree a
forall a b. (a -> b) -> a -> b
$ Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> FingerTree (Node a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
1) Digit (Node a)
pr FingerTree (Node (Node a))
m Digit (Node a)
sf'
     DefectDig a
e -> case FingerTree (Node (Node a)) -> ViewRTree (Node (Node a))
forall a. Sized a => FingerTree a -> ViewRTree a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
viewRTree FingerTree (Node (Node a))
m of
                      ViewRTree (Node (Node a))
EmptyRTree -> FingerTree (Node a) -> DelTree a
forall a. FingerTree (Node a) -> DelTree a
FullTree (FingerTree (Node a) -> DelTree a)
-> FingerTree (Node a) -> DelTree a
forall a b. (a -> b) -> a -> b
$ Int -> Digit (Node a) -> a -> FingerTree (Node a)
forall a.
Sized a =>
Int -> Digit (Node a) -> a -> FingerTree (Node a)
Evidence bound by a type signature of the constraint type Sized a
delRebuildLeftDigit (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
1) Digit (Node a)
pr a
e
                      SnocRTree FingerTree (Node (Node a))
m' Node (Node a)
n -> FingerTree (Node a) -> DelTree a
forall a. FingerTree (Node a) -> DelTree a
FullTree (FingerTree (Node a) -> DelTree a)
-> FingerTree (Node a) -> DelTree a
forall a b. (a -> b) -> a -> b
$ Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> Node (Node a)
-> a
-> FingerTree (Node a)
forall a.
Sized a =>
Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> Node (Node a)
-> a
-> FingerTree (Node a)
Evidence bound by a type signature of the constraint type Sized a
delRebuildRightSide (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
1) Digit (Node a)
pr FingerTree (Node (Node a))
m' Node (Node a)
n a
e
  where spr :: Int
spr = Digit (Node a) -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized a => Sized (Digit a)
Instance of class: Sized of the constraint type forall a. Sized (Node a)
size Digit (Node a)
pr
        spm :: Int
spm = Int
spr Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ FingerTree (Node (Node a)) -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized a => Sized (FingerTree a)
Instance of class: Sized of the constraint type forall a. Sized (Node a)
size FingerTree (Node (Node a))
m

data Del a = Full !(Node a) | Defect a

{-# SPECIALIZE delNode :: (Int -> Node (Elem a) -> Del (Elem a)) -> Int -> Node (Node (Elem a)) -> Del (Node (Elem a)) #-}
{-# SPECIALIZE delNode :: (Int -> Node (Node a) -> Del (Node a)) -> Int -> Node (Node (Node a)) -> Del (Node (Node a)) #-}
delNode :: Sized a => (Int -> Node a -> Del a) -> Int -> Node (Node a) -> Del (Node a)
delNode :: (Int -> Node a -> Del a) -> Int -> Node (Node a) -> Del (Node a)
delNode Int -> Node a -> Del a
f Int
i (Node3 Int
s Node a
a Node a
b Node a
c)
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
sa = case Int -> Node a -> Del a
f Int
i Node a
a of
     Full Node a
a' -> Node (Node a) -> Del (Node a)
forall a. Node a -> Del a
Full (Node (Node a) -> Del (Node a)) -> Node (Node a) -> Del (Node a)
forall a b. (a -> b) -> a -> b
$ Int -> Node a -> Node a -> Node a -> Node (Node a)
forall a. Int -> a -> a -> a -> Node a
Node3 (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
1) Node a
a' Node a
b Node a
c
     Defect a
e -> let !se :: Int
se = a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
size a
e in case Node a
b of
       Node3 Int
sxyz a
x a
y a
z -> Node (Node a) -> Del (Node a)
forall a. Node a -> Del a
Full (Node (Node a) -> Del (Node a)) -> Node (Node a) -> Del (Node a)
forall a b. (a -> b) -> a -> b
$ Int -> Node a -> Node a -> Node a -> Node (Node a)
forall a. Int -> a -> a -> a -> Node a
Node3 (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
1) (Int -> a -> a -> Node a
forall a. Int -> a -> a -> Node a
Node2 (Int
se Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Int
sx) a
e a
x) (Int -> a -> a -> Node a
forall a. Int -> a -> a -> Node a
Node2 (Int
sxyz Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
sx) a
y a
z) Node a
c
         where !sx :: Int
sx = a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
size a
x
       Node2 Int
sxy a
x a
y -> Node (Node a) -> Del (Node a)
forall a. Node a -> Del a
Full (Node (Node a) -> Del (Node a)) -> Node (Node a) -> Del (Node a)
forall a b. (a -> b) -> a -> b
$ Int -> Node a -> Node a -> Node (Node a)
forall a. Int -> a -> a -> Node a
Node2 (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
1) (Int -> a -> a -> a -> Node a
forall a. Int -> a -> a -> a -> Node a
Node3 (Int
sxy Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Int
se) a
e a
x a
y) Node a
c
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
sab = case Int -> Node a -> Del a
f (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
sa) Node a
b of
     Full Node a
b' -> Node (Node a) -> Del (Node a)
forall a. Node a -> Del a
Full (Node (Node a) -> Del (Node a)) -> Node (Node a) -> Del (Node a)
forall a b. (a -> b) -> a -> b
$ Int -> Node a -> Node a -> Node a -> Node (Node a)
forall a. Int -> a -> a -> a -> Node a
Node3 (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
1) Node a
a Node a
b' Node a
c
     Defect a
e -> let !se :: Int
se = a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
size a
e in case Node a
a of
       Node3 Int
sxyz a
x a
y a
z -> Node (Node a) -> Del (Node a)
forall a. Node a -> Del a
Full (Node (Node a) -> Del (Node a)) -> Node (Node a) -> Del (Node a)
forall a b. (a -> b) -> a -> b
$ Int -> Node a -> Node a -> Node a -> Node (Node a)
forall a. Int -> a -> a -> a -> Node a
Node3 (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
1) (Int -> a -> a -> Node a
forall a. Int -> a -> a -> Node a
Node2 (Int
sxyz Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
sz) a
x a
y) (Int -> a -> a -> Node a
forall a. Int -> a -> a -> Node a
Node2 (Int
sz Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Int
se) a
z a
e) Node a
c
         where !sz :: Int
sz = a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
size a
z
       Node2 Int
sxy a
x a
y -> Node (Node a) -> Del (Node a)
forall a. Node a -> Del a
Full (Node (Node a) -> Del (Node a)) -> Node (Node a) -> Del (Node a)
forall a b. (a -> b) -> a -> b
$ Int -> Node a -> Node a -> Node (Node a)
forall a. Int -> a -> a -> Node a
Node2 (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
1) (Int -> a -> a -> a -> Node a
forall a. Int -> a -> a -> a -> Node a
Node3 (Int
sxy Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Int
se) a
x a
y a
e) Node a
c
  | Bool
otherwise = case Int -> Node a -> Del a
f (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
sab) Node a
c of
     Full Node a
c' -> Node (Node a) -> Del (Node a)
forall a. Node a -> Del a
Full (Node (Node a) -> Del (Node a)) -> Node (Node a) -> Del (Node a)
forall a b. (a -> b) -> a -> b
$ Int -> Node a -> Node a -> Node a -> Node (Node a)
forall a. Int -> a -> a -> a -> Node a
Node3 (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
1) Node a
a Node a
b Node a
c'
     Defect a
e -> let !se :: Int
se = a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
size a
e in case Node a
b of
       Node3 Int
sxyz a
x a
y a
z -> Node (Node a) -> Del (Node a)
forall a. Node a -> Del a
Full (Node (Node a) -> Del (Node a)) -> Node (Node a) -> Del (Node a)
forall a b. (a -> b) -> a -> b
$ Int -> Node a -> Node a -> Node a -> Node (Node a)
forall a. Int -> a -> a -> a -> Node a
Node3 (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
1) Node a
a (Int -> a -> a -> Node a
forall a. Int -> a -> a -> Node a
Node2 (Int
sxyz Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
sz) a
x a
y) (Int -> a -> a -> Node a
forall a. Int -> a -> a -> Node a
Node2 (Int
sz Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Int
se) a
z a
e)
         where !sz :: Int
sz = a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
size a
z
       Node2 Int
sxy a
x a
y -> Node (Node a) -> Del (Node a)
forall a. Node a -> Del a
Full (Node (Node a) -> Del (Node a)) -> Node (Node a) -> Del (Node a)
forall a b. (a -> b) -> a -> b
$ Int -> Node a -> Node a -> Node (Node a)
forall a. Int -> a -> a -> Node a
Node2 (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
1) Node a
a (Int -> a -> a -> a -> Node a
forall a. Int -> a -> a -> a -> Node a
Node3 (Int
sxy Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Int
se) a
x a
y a
e)
  where sa :: Int
sa = Node a -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized (Node a)
size Node a
a
        sab :: Int
sab = Int
sa Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Node a -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized (Node a)
size Node a
b
delNode Int -> Node a -> Del a
f Int
i (Node2 Int
s Node a
a Node a
b)
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
sa = case Int -> Node a -> Del a
f Int
i Node a
a of
     Full Node a
a' -> Node (Node a) -> Del (Node a)
forall a. Node a -> Del a
Full (Node (Node a) -> Del (Node a)) -> Node (Node a) -> Del (Node a)
forall a b. (a -> b) -> a -> b
$ Int -> Node a -> Node a -> Node (Node a)
forall a. Int -> a -> a -> Node a
Node2 (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
1) Node a
a' Node a
b
     Defect a
e -> let !se :: Int
se = a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
size a
e in case Node a
b of
       Node3 Int
sxyz a
x a
y a
z -> Node (Node a) -> Del (Node a)
forall a. Node a -> Del a
Full (Node (Node a) -> Del (Node a)) -> Node (Node a) -> Del (Node a)
forall a b. (a -> b) -> a -> b
$ Int -> Node a -> Node a -> Node (Node a)
forall a. Int -> a -> a -> Node a
Node2 (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
1) (Int -> a -> a -> Node a
forall a. Int -> a -> a -> Node a
Node2 (Int
se Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Int
sx) a
e a
x) (Int -> a -> a -> Node a
forall a. Int -> a -> a -> Node a
Node2 (Int
sxyz Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
sx) a
y a
z)
        where !sx :: Int
sx = a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
size a
x
       Node2 Int
_ a
x a
y -> Node a -> Del (Node a)
forall a. a -> Del a
Defect (Node a -> Del (Node a)) -> Node a -> Del (Node a)
forall a b. (a -> b) -> a -> b
$ Int -> a -> a -> a -> Node a
forall a. Int -> a -> a -> a -> Node a
Node3 (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
1) a
e a
x a
y
  | Bool
otherwise = case Int -> Node a -> Del a
f (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
sa) Node a
b of
     Full Node a
b' -> Node (Node a) -> Del (Node a)
forall a. Node a -> Del a
Full (Node (Node a) -> Del (Node a)) -> Node (Node a) -> Del (Node a)
forall a b. (a -> b) -> a -> b
$ Int -> Node a -> Node a -> Node (Node a)
forall a. Int -> a -> a -> Node a
Node2 (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
1) Node a
a Node a
b'
     Defect a
e -> let !se :: Int
se = a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
size a
e in case Node a
a of
       Node3 Int
sxyz a
x a
y a
z -> Node (Node a) -> Del (Node a)
forall a. Node a -> Del a
Full (Node (Node a) -> Del (Node a)) -> Node (Node a) -> Del (Node a)
forall a b. (a -> b) -> a -> b
$ Int -> Node a -> Node a -> Node (Node a)
forall a. Int -> a -> a -> Node a
Node2 (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
1) (Int -> a -> a -> Node a
forall a. Int -> a -> a -> Node a
Node2 (Int
sxyz Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
sz) a
x a
y) (Int -> a -> a -> Node a
forall a. Int -> a -> a -> Node a
Node2 (Int
sz Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Int
se) a
z a
e)
         where !sz :: Int
sz = a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
size a
z
       Node2 Int
_ a
x a
y -> Node a -> Del (Node a)
forall a. a -> Del a
Defect (Node a -> Del (Node a)) -> Node a -> Del (Node a)
forall a b. (a -> b) -> a -> b
$ Int -> a -> a -> a -> Node a
forall a. Int -> a -> a -> a -> Node a
Node3 (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
1) a
x a
y a
e
  where sa :: Int
sa = Node a -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized (Node a)
size Node a
a

{-# SPECIALIZE delRebuildRightDigit :: Int -> Elem a -> Digit (Node (Elem a)) -> FingerTree (Node (Elem a)) #-}
{-# SPECIALIZE delRebuildRightDigit :: Int -> Node a -> Digit (Node (Node a)) -> FingerTree (Node (Node a)) #-}
delRebuildRightDigit :: Sized a => Int -> a -> Digit (Node a) -> FingerTree (Node a)
delRebuildRightDigit :: Int -> a -> Digit (Node a) -> FingerTree (Node a)
delRebuildRightDigit Int
s a
p (One Node a
a) = let !sp :: Int
sp = a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
size a
p in case Node a
a of
  Node3 Int
sxyz a
x a
y a
z -> Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> FingerTree (Node a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
s (Node a -> Digit (Node a)
forall a. a -> Digit a
One (Int -> a -> a -> Node a
forall a. Int -> a -> a -> Node a
Node2 (Int
sp Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Int
sx) a
p a
x)) FingerTree (Node (Node a))
forall a. FingerTree a
EmptyT (Node a -> Digit (Node a)
forall a. a -> Digit a
One (Int -> a -> a -> Node a
forall a. Int -> a -> a -> Node a
Node2 (Int
sxyz Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
sx) a
y a
z))
    where !sx :: Int
sx = a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
size a
x
  Node2 Int
sxy a
x a
y -> Node a -> FingerTree (Node a)
forall a. a -> FingerTree a
Single (Int -> a -> a -> a -> Node a
forall a. Int -> a -> a -> a -> Node a
Node3 (Int
sp Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Int
sxy) a
p a
x a
y)
delRebuildRightDigit Int
s a
p (Two Node a
a Node a
b) = let !sp :: Int
sp = a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
size a
p in case Node a
a of
  Node3 Int
sxyz a
x a
y a
z -> Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> FingerTree (Node a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
s (Node a -> Node a -> Digit (Node a)
forall a. a -> a -> Digit a
Two (Int -> a -> a -> Node a
forall a. Int -> a -> a -> Node a
Node2 (Int
sp Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Int
sx) a
p a
x) (Int -> a -> a -> Node a
forall a. Int -> a -> a -> Node a
Node2 (Int
sxyz Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
sx) a
y a
z)) FingerTree (Node (Node a))
forall a. FingerTree a
EmptyT (Node a -> Digit (Node a)
forall a. a -> Digit a
One Node a
b)
    where !sx :: Int
sx = a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
size a
x
  Node2 Int
sxy a
x a
y -> Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> FingerTree (Node a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
s (Node a -> Digit (Node a)
forall a. a -> Digit a
One (Int -> a -> a -> a -> Node a
forall a. Int -> a -> a -> a -> Node a
Node3 (Int
sp Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Int
sxy) a
p a
x a
y)) FingerTree (Node (Node a))
forall a. FingerTree a
EmptyT (Node a -> Digit (Node a)
forall a. a -> Digit a
One Node a
b)
delRebuildRightDigit Int
s a
p (Three Node a
a Node a
b Node a
c) = let !sp :: Int
sp = a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
size a
p in case Node a
a of
  Node3 Int
sxyz a
x a
y a
z -> Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> FingerTree (Node a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
s (Node a -> Node a -> Digit (Node a)
forall a. a -> a -> Digit a
Two (Int -> a -> a -> Node a
forall a. Int -> a -> a -> Node a
Node2 (Int
sp Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Int
sx) a
p a
x) (Int -> a -> a -> Node a
forall a. Int -> a -> a -> Node a
Node2 (Int
sxyz Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
sx) a
y a
z)) FingerTree (Node (Node a))
forall a. FingerTree a
EmptyT (Node a -> Node a -> Digit (Node a)
forall a. a -> a -> Digit a
Two Node a
b Node a
c)
    where !sx :: Int
sx = a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
size a
x
  Node2 Int
sxy a
x a
y -> Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> FingerTree (Node a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
s (Node a -> Node a -> Digit (Node a)
forall a. a -> a -> Digit a
Two (Int -> a -> a -> a -> Node a
forall a. Int -> a -> a -> a -> Node a
Node3 (Int
sp Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Int
sxy) a
p a
x a
y) Node a
b) FingerTree (Node (Node a))
forall a. FingerTree a
EmptyT (Node a -> Digit (Node a)
forall a. a -> Digit a
One Node a
c)
delRebuildRightDigit Int
s a
p (Four Node a
a Node a
b Node a
c Node a
d) = let !sp :: Int
sp = a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
size a
p in case Node a
a of
  Node3 Int
sxyz a
x a
y a
z -> Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> FingerTree (Node a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
s (Node a -> Node a -> Node a -> Digit (Node a)
forall a. a -> a -> a -> Digit a
Three (Int -> a -> a -> Node a
forall a. Int -> a -> a -> Node a
Node2 (Int
sp Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Int
sx) a
p a
x) (Int -> a -> a -> Node a
forall a. Int -> a -> a -> Node a
Node2 (Int
sxyz Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
sx) a
y a
z) Node a
b) FingerTree (Node (Node a))
forall a. FingerTree a
EmptyT (Node a -> Node a -> Digit (Node a)
forall a. a -> a -> Digit a
Two Node a
c Node a
d)
    where !sx :: Int
sx = a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
size a
x
  Node2 Int
sxy a
x a
y -> Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> FingerTree (Node a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
s (Node a -> Node a -> Digit (Node a)
forall a. a -> a -> Digit a
Two (Int -> a -> a -> a -> Node a
forall a. Int -> a -> a -> a -> Node a
Node3 (Int
sp Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Int
sxy) a
p a
x a
y) Node a
b) FingerTree (Node (Node a))
forall a. FingerTree a
EmptyT (Node a -> Node a -> Digit (Node a)
forall a. a -> a -> Digit a
Two Node a
c Node a
d)

{-# SPECIALIZE delRebuildLeftDigit :: Int -> Digit (Node (Elem a)) -> Elem a -> FingerTree (Node (Elem a)) #-}
{-# SPECIALIZE delRebuildLeftDigit :: Int -> Digit (Node (Node a)) -> Node a -> FingerTree (Node (Node a)) #-}
delRebuildLeftDigit :: Sized a => Int -> Digit (Node a) -> a -> FingerTree (Node a)
delRebuildLeftDigit :: Int -> Digit (Node a) -> a -> FingerTree (Node a)
delRebuildLeftDigit Int
s (One Node a
a) a
p = let !sp :: Int
sp = a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
size a
p in case Node a
a of
  Node3 Int
sxyz a
x a
y a
z -> Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> FingerTree (Node a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
s (Node a -> Digit (Node a)
forall a. a -> Digit a
One (Int -> a -> a -> Node a
forall a. Int -> a -> a -> Node a
Node2 (Int
sxyz Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
sz) a
x a
y)) FingerTree (Node (Node a))
forall a. FingerTree a
EmptyT (Node a -> Digit (Node a)
forall a. a -> Digit a
One (Int -> a -> a -> Node a
forall a. Int -> a -> a -> Node a
Node2 (Int
sz Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Int
sp) a
z a
p))
    where !sz :: Int
sz = a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
size a
z
  Node2 Int
sxy a
x a
y -> Node a -> FingerTree (Node a)
forall a. a -> FingerTree a
Single (Int -> a -> a -> a -> Node a
forall a. Int -> a -> a -> a -> Node a
Node3 (Int
sxy Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Int
sp) a
x a
y a
p)
delRebuildLeftDigit Int
s (Two Node a
a Node a
b) a
p = let !sp :: Int
sp = a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
size a
p in case Node a
b of
  Node3 Int
sxyz a
x a
y a
z -> Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> FingerTree (Node a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
s (Node a -> Node a -> Digit (Node a)
forall a. a -> a -> Digit a
Two Node a
a (Int -> a -> a -> Node a
forall a. Int -> a -> a -> Node a
Node2 (Int
sxyz Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
sz) a
x a
y)) FingerTree (Node (Node a))
forall a. FingerTree a
EmptyT (Node a -> Digit (Node a)
forall a. a -> Digit a
One (Int -> a -> a -> Node a
forall a. Int -> a -> a -> Node a
Node2 (Int
sz Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Int
sp) a
z a
p))
    where !sz :: Int
sz = a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
size a
z
  Node2 Int
sxy a
x a
y -> Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> FingerTree (Node a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
s (Node a -> Digit (Node a)
forall a. a -> Digit a
One Node a
a) FingerTree (Node (Node a))
forall a. FingerTree a
EmptyT (Node a -> Digit (Node a)
forall a. a -> Digit a
One (Int -> a -> a -> a -> Node a
forall a. Int -> a -> a -> a -> Node a
Node3 (Int
sxy Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ 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 = a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
size a
p in case Node a
c of
  Node3 Int
sxyz a
x a
y a
z -> Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> FingerTree (Node a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
s (Node a -> Node a -> Digit (Node a)
forall a. a -> a -> Digit a
Two Node a
a Node a
b) FingerTree (Node (Node a))
forall a. FingerTree a
EmptyT (Node a -> Node a -> Digit (Node a)
forall a. a -> a -> Digit a
Two (Int -> a -> a -> Node a
forall a. Int -> a -> a -> Node a
Node2 (Int
sxyz Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
sz) a
x a
y) (Int -> a -> a -> Node a
forall a. Int -> a -> a -> Node a
Node2 (Int
sz Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Int
sp) a
z a
p))
    where !sz :: Int
sz = a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
size a
z
  Node2 Int
sxy a
x a
y -> Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> FingerTree (Node a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
s (Node a -> Node a -> Digit (Node a)
forall a. a -> a -> Digit a
Two Node a
a Node a
b) FingerTree (Node (Node a))
forall a. FingerTree a
EmptyT (Node a -> Digit (Node a)
forall a. a -> Digit a
One (Int -> a -> a -> a -> Node a
forall a. Int -> a -> a -> a -> Node a
Node3 (Int
sxy Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ 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 = a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
size a
p in case Node a
d of
  Node3 Int
sxyz a
x a
y a
z -> Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> FingerTree (Node a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
s (Node a -> Node a -> Node a -> Digit (Node a)
forall a. a -> a -> a -> Digit a
Three Node a
a Node a
b Node a
c) FingerTree (Node (Node a))
forall a. FingerTree a
EmptyT (Node a -> Node a -> Digit (Node a)
forall a. a -> a -> Digit a
Two (Int -> a -> a -> Node a
forall a. Int -> a -> a -> Node a
Node2 (Int
sxyz Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
sz) a
x a
y) (Int -> a -> a -> Node a
forall a. Int -> a -> a -> Node a
Node2 (Int
sz Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Int
sp) a
z a
p))
    where !sz :: Int
sz = a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
size a
z
  Node2 Int
sxy a
x a
y -> Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> FingerTree (Node a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
s (Node a -> Node a -> Digit (Node a)
forall a. a -> a -> Digit a
Two Node a
a Node a
b) FingerTree (Node (Node a))
forall a. FingerTree a
EmptyT (Node a -> Node a -> Digit (Node a)
forall a. a -> a -> Digit a
Two Node a
c (Int -> a -> a -> a -> Node a
forall a. Int -> a -> a -> a -> Node a
Node3 (Int
sxy Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Int
sp) a
x a
y a
p))

delRebuildLeftSide :: Sized a
                   => Int -> a -> Node (Node a) -> FingerTree (Node (Node a)) -> Digit (Node a)
                   -> FingerTree (Node a)
delRebuildLeftSide :: Int
-> a
-> Node (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> FingerTree (Node a)
delRebuildLeftSide 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 = a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
size a
p in case Node a
a of
  Node2 Int
sxy a
x a
y -> Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> FingerTree (Node a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
s (Node a -> Node a -> Digit (Node a)
forall a. a -> a -> Digit a
Two (Int -> a -> a -> a -> Node a
forall a. Int -> a -> a -> a -> Node a
Node3 (Int
sp Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ 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 -> Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> FingerTree (Node a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
s (Node a -> Node a -> Node a -> Digit (Node a)
forall a. a -> a -> a -> Digit a
Three (Int -> a -> a -> Node a
forall a. Int -> a -> a -> Node a
Node2 (Int
sp Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Int
sx) a
p a
x) (Int -> a -> a -> Node a
forall a. Int -> a -> a -> Node a
Node2 (Int
sxyz Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
sx) a
y a
z) Node a
b) FingerTree (Node (Node a))
m Digit (Node a)
sf
    where !sx :: Int
sx = a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
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 = a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
size a
p in case Node a
a of
  Node2 Int
sxy a
x a
y -> Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> FingerTree (Node a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
s (Node a -> Node a -> Node a -> Digit (Node a)
forall a. a -> a -> a -> Digit a
Three (Int -> a -> a -> a -> Node a
forall a. Int -> a -> a -> a -> Node a
Node3 (Int
sp Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ 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 -> Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> FingerTree (Node a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
s (Node a -> Node a -> Node a -> Node a -> Digit (Node a)
forall a. a -> a -> a -> a -> Digit a
Four (Int -> a -> a -> Node a
forall a. Int -> a -> a -> Node a
Node2 (Int
sp Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Int
sx) a
p a
x) (Int -> a -> a -> Node a
forall a. Int -> a -> a -> Node a
Node2 (Int
sxyz Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
sx) a
y a
z) Node a
b Node a
c) FingerTree (Node (Node a))
m Digit (Node a)
sf
    where !sx :: Int
sx = a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
size a
x

delRebuildRightSide :: Sized a
                    => Int -> Digit (Node a) -> FingerTree (Node (Node a)) -> Node (Node a) -> a
                    -> FingerTree (Node a)
delRebuildRightSide :: Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> Node (Node a)
-> a
-> FingerTree (Node a)
delRebuildRightSide 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 = a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
size a
p in case Node a
b of
  Node2 Int
sxy a
x a
y -> Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> FingerTree (Node a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
s Digit (Node a)
pr FingerTree (Node (Node a))
m (Node a -> Node a -> Digit (Node a)
forall a. a -> a -> Digit a
Two Node a
a (Int -> a -> a -> a -> Node a
forall a. Int -> a -> a -> a -> Node a
Node3 (Int
sxy Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Int
sp) a
x a
y a
p))
  Node3 Int
sxyz a
x a
y a
z -> Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> FingerTree (Node a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
s Digit (Node a)
pr FingerTree (Node (Node a))
m (Node a -> Node a -> Node a -> Digit (Node a)
forall a. a -> a -> a -> Digit a
Three Node a
a (Int -> a -> a -> Node a
forall a. Int -> a -> a -> Node a
Node2 (Int
sxyz Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
sz) a
x a
y) (Int -> a -> a -> Node a
forall a. Int -> a -> a -> Node a
Node2 (Int
sz Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Int
sp) a
z a
p))
    where !sz :: Int
sz = a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
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 = a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
size a
p in case Node a
c of
  Node2 Int
sxy a
x a
y -> Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> FingerTree (Node a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
s Digit (Node a)
pr FingerTree (Node (Node a))
m (Node a -> Node a -> Node a -> Digit (Node a)
forall a. a -> a -> a -> Digit a
Three Node a
a Node a
b (Int -> a -> a -> a -> Node a
forall a. Int -> a -> a -> a -> Node a
Node3 (Int
sxy Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Int
sp) a
x a
y a
p))
  Node3 Int
sxyz a
x a
y a
z -> Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> FingerTree (Node a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
s Digit (Node a)
pr FingerTree (Node (Node a))
m (Node a -> Node a -> Node a -> Node a -> Digit (Node a)
forall a. a -> a -> a -> a -> Digit a
Four Node a
a Node a
b (Int -> a -> a -> Node a
forall a. Int -> a -> a -> Node a
Node2 (Int
sxyz Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
sz) a
x a
y) (Int -> a -> a -> Node a
forall a. Int -> a -> a -> Node a
Node2 (Int
sz Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Int
sp) a
z a
p))
    where !sz :: Int
sz = a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
size a
z

delRebuildMiddle :: Sized a
                 => Int -> Digit a -> a -> Digit a
                 -> FingerTree a
delRebuildMiddle :: Int -> Digit a -> a -> Digit a -> FingerTree a
delRebuildMiddle Int
s (One a
a) a
e Digit a
sf = Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
s (a -> a -> Digit a
forall a. a -> a -> Digit a
Two a
a a
e) FingerTree (Node a)
forall a. FingerTree a
EmptyT Digit a
sf
delRebuildMiddle Int
s (Two a
a a
b) a
e Digit a
sf = Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
s (a -> a -> a -> Digit a
forall a. a -> a -> a -> Digit a
Three a
a a
b a
e) FingerTree (Node a)
forall a. FingerTree a
EmptyT Digit a
sf
delRebuildMiddle Int
s (Three a
a a
b a
c) a
e Digit a
sf = Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
s (a -> a -> a -> a -> Digit a
forall a. a -> a -> a -> a -> Digit a
Four a
a a
b a
c a
e) FingerTree (Node a)
forall a. FingerTree a
EmptyT Digit a
sf
delRebuildMiddle Int
s (Four a
a a
b a
c a
d) a
e Digit a
sf = Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
s (a -> a -> Digit a
forall a. a -> a -> Digit a
Two a
a a
b) (Node a -> FingerTree (Node a)
forall a. a -> FingerTree a
Single (a -> a -> a -> Node a
forall a. Sized a => a -> a -> a -> Node a
Evidence bound by a type signature of the constraint type Sized a
node3 a
c a
d a
e)) Digit a
sf

data DelDig a = FullDig !(Digit (Node a)) | DefectDig a

{-# SPECIALIZE delDigit :: (Int -> Node (Elem a) -> Del (Elem a)) -> Int -> Digit (Node (Elem a)) -> DelDig (Elem a) #-}
{-# SPECIALIZE delDigit :: (Int -> Node (Node a) -> Del (Node a)) -> Int -> Digit (Node (Node a)) -> DelDig (Node a) #-}
delDigit :: Sized a => (Int -> Node a -> Del a) -> Int -> Digit (Node a) -> DelDig a
delDigit :: (Int -> Node a -> Del a) -> Int -> Digit (Node a) -> DelDig a
delDigit 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' -> Digit (Node a) -> DelDig a
forall a. Digit (Node a) -> DelDig a
FullDig (Digit (Node a) -> DelDig a) -> Digit (Node a) -> DelDig a
forall a b. (a -> b) -> a -> b
$ Node a -> Digit (Node a)
forall a. a -> Digit a
One Node a
a'
  Defect a
e -> a -> DelDig a
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
sa = case Int -> Node a -> Del a
f Int
i Node a
a of
     Full Node a
a' -> Digit (Node a) -> DelDig a
forall a. Digit (Node a) -> DelDig a
FullDig (Digit (Node a) -> DelDig a) -> Digit (Node a) -> DelDig a
forall a b. (a -> b) -> a -> b
$ Node a -> Node a -> Digit (Node a)
forall a. a -> a -> Digit a
Two Node a
a' Node a
b
     Defect a
e -> let !se :: Int
se = a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
size a
e in case Node a
b of
       Node3 Int
sxyz a
x a
y a
z -> Digit (Node a) -> DelDig a
forall a. Digit (Node a) -> DelDig a
FullDig (Digit (Node a) -> DelDig a) -> Digit (Node a) -> DelDig a
forall a b. (a -> b) -> a -> b
$ Node a -> Node a -> Digit (Node a)
forall a. a -> a -> Digit a
Two (Int -> a -> a -> Node a
forall a. Int -> a -> a -> Node a
Node2 (Int
se Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Int
sx) a
e a
x) (Int -> a -> a -> Node a
forall a. Int -> a -> a -> Node a
Node2 (Int
sxyz Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
sx) a
y a
z)
         where !sx :: Int
sx = a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
size a
x
       Node2 Int
sxy a
x a
y -> Digit (Node a) -> DelDig a
forall a. Digit (Node a) -> DelDig a
FullDig (Digit (Node a) -> DelDig a) -> Digit (Node a) -> DelDig a
forall a b. (a -> b) -> a -> b
$ Node a -> Digit (Node a)
forall a. a -> Digit a
One (Int -> a -> a -> a -> Node a
forall a. Int -> a -> a -> a -> Node a
Node3 (Int
se Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Int
sxy) a
e a
x a
y)
  | Bool
otherwise = case Int -> Node a -> Del a
f (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
sa) Node a
b of
     Full Node a
b' -> Digit (Node a) -> DelDig a
forall a. Digit (Node a) -> DelDig a
FullDig (Digit (Node a) -> DelDig a) -> Digit (Node a) -> DelDig a
forall a b. (a -> b) -> a -> b
$ Node a -> Node a -> Digit (Node a)
forall a. a -> a -> Digit a
Two Node a
a Node a
b'
     Defect a
e -> let !se :: Int
se = a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
size a
e in case Node a
a of
       Node3 Int
sxyz a
x a
y a
z -> Digit (Node a) -> DelDig a
forall a. Digit (Node a) -> DelDig a
FullDig (Digit (Node a) -> DelDig a) -> Digit (Node a) -> DelDig a
forall a b. (a -> b) -> a -> b
$ Node a -> Node a -> Digit (Node a)
forall a. a -> a -> Digit a
Two (Int -> a -> a -> Node a
forall a. Int -> a -> a -> Node a
Node2 (Int
sxyz Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
sz) a
x a
y) (Int -> a -> a -> Node a
forall a. Int -> a -> a -> Node a
Node2 (Int
sz Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Int
se) a
z a
e)
         where !sz :: Int
sz = a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
size a
z
       Node2 Int
sxy a
x a
y -> Digit (Node a) -> DelDig a
forall a. Digit (Node a) -> DelDig a
FullDig (Digit (Node a) -> DelDig a) -> Digit (Node a) -> DelDig a
forall a b. (a -> b) -> a -> b
$ Node a -> Digit (Node a)
forall a. a -> Digit a
One (Int -> a -> a -> a -> Node a
forall a. Int -> a -> a -> a -> Node a
Node3 (Int
sxy Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Int
se) a
x a
y a
e)
  where sa :: Int
sa = Node a -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized (Node a)
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
sa = case Int -> Node a -> Del a
f Int
i Node a
a of
     Full Node a
a' -> Digit (Node a) -> DelDig a
forall a. Digit (Node a) -> DelDig a
FullDig (Digit (Node a) -> DelDig a) -> Digit (Node a) -> DelDig a
forall a b. (a -> b) -> a -> b
$ Node a -> Node a -> Node a -> Digit (Node a)
forall a. a -> a -> a -> Digit a
Three Node a
a' Node a
b Node a
c
     Defect a
e -> let !se :: Int
se = a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
size a
e in case Node a
b of
       Node3 Int
sxyz a
x a
y a
z -> Digit (Node a) -> DelDig a
forall a. Digit (Node a) -> DelDig a
FullDig (Digit (Node a) -> DelDig a) -> Digit (Node a) -> DelDig a
forall a b. (a -> b) -> a -> b
$ Node a -> Node a -> Node a -> Digit (Node a)
forall a. a -> a -> a -> Digit a
Three (Int -> a -> a -> Node a
forall a. Int -> a -> a -> Node a
Node2 (Int
se Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Int
sx) a
e a
x) (Int -> a -> a -> Node a
forall a. Int -> a -> a -> Node a
Node2 (Int
sxyz Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
sx) a
y a
z) Node a
c
         where !sx :: Int
sx = a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
size a
x
       Node2 Int
sxy a
x a
y -> Digit (Node a) -> DelDig a
forall a. Digit (Node a) -> DelDig a
FullDig (Digit (Node a) -> DelDig a) -> Digit (Node a) -> DelDig a
forall a b. (a -> b) -> a -> b
$ Node a -> Node a -> Digit (Node a)
forall a. a -> a -> Digit a
Two (Int -> a -> a -> a -> Node a
forall a. Int -> a -> a -> a -> Node a
Node3 (Int
se Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Int
sxy) a
e a
x a
y) Node a
c
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
sab = case Int -> Node a -> Del a
f (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
sa) Node a
b of
     Full Node a
b' -> Digit (Node a) -> DelDig a
forall a. Digit (Node a) -> DelDig a
FullDig (Digit (Node a) -> DelDig a) -> Digit (Node a) -> DelDig a
forall a b. (a -> b) -> a -> b
$ Node a -> Node a -> Node a -> Digit (Node a)
forall a. a -> a -> a -> Digit a
Three Node a
a Node a
b' Node a
c
     Defect a
e -> let !se :: Int
se = a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
size a
e in case Node a
a of
       Node3 Int
sxyz a
x a
y a
z -> Digit (Node a) -> DelDig a
forall a. Digit (Node a) -> DelDig a
FullDig (Digit (Node a) -> DelDig a) -> Digit (Node a) -> DelDig a
forall a b. (a -> b) -> a -> b
$ Node a -> Node a -> Node a -> Digit (Node a)
forall a. a -> a -> a -> Digit a
Three (Int -> a -> a -> Node a
forall a. Int -> a -> a -> Node a
Node2 (Int
sxyz Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
sz) a
x a
y) (Int -> a -> a -> Node a
forall a. Int -> a -> a -> Node a
Node2 (Int
sz Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Int
se) a
z a
e) Node a
c
         where !sz :: Int
sz = a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
size a
z
       Node2 Int
sxy a
x a
y -> Digit (Node a) -> DelDig a
forall a. Digit (Node a) -> DelDig a
FullDig (Digit (Node a) -> DelDig a) -> Digit (Node a) -> DelDig a
forall a b. (a -> b) -> a -> b
$ Node a -> Node a -> Digit (Node a)
forall a. a -> a -> Digit a
Two (Int -> a -> a -> a -> Node a
forall a. Int -> a -> a -> a -> Node a
Node3 (Int
sxy Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Int
se) a
x a
y a
e) Node a
c
  | Bool
otherwise = case Int -> Node a -> Del a
f (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
sab) Node a
c of
     Full Node a
c' -> Digit (Node a) -> DelDig a
forall a. Digit (Node a) -> DelDig a
FullDig (Digit (Node a) -> DelDig a) -> Digit (Node a) -> DelDig a
forall a b. (a -> b) -> a -> b
$ Node a -> Node a -> Node a -> Digit (Node a)
forall a. a -> a -> a -> Digit a
Three Node a
a Node a
b Node a
c'
     Defect a
e -> let !se :: Int
se = a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
size a
e in case Node a
b of
       Node3 Int
sxyz a
x a
y a
z -> Digit (Node a) -> DelDig a
forall a. Digit (Node a) -> DelDig a
FullDig (Digit (Node a) -> DelDig a) -> Digit (Node a) -> DelDig a
forall a b. (a -> b) -> a -> b
$ Node a -> Node a -> Node a -> Digit (Node a)
forall a. a -> a -> a -> Digit a
Three Node a
a (Int -> a -> a -> Node a
forall a. Int -> a -> a -> Node a
Node2 (Int
sxyz Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
sz) a
x a
y) (Int -> a -> a -> Node a
forall a. Int -> a -> a -> Node a
Node2 (Int
sz Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Int
se) a
z a
e)
         where !sz :: Int
sz = a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
size a
z
       Node2 Int
sxy a
x a
y -> Digit (Node a) -> DelDig a
forall a. Digit (Node a) -> DelDig a
FullDig (Digit (Node a) -> DelDig a) -> Digit (Node a) -> DelDig a
forall a b. (a -> b) -> a -> b
$ Node a -> Node a -> Digit (Node a)
forall a. a -> a -> Digit a
Two Node a
a (Int -> a -> a -> a -> Node a
forall a. Int -> a -> a -> a -> Node a
Node3 (Int
sxy Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Int
se) a
x a
y a
e)
  where sa :: Int
sa = Node a -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized (Node a)
size Node a
a
        sab :: Int
sab = Int
sa Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Node a -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized (Node a)
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
sa = case Int -> Node a -> Del a
f Int
i Node a
a of
     Full Node a
a' -> Digit (Node a) -> DelDig a
forall a. Digit (Node a) -> DelDig a
FullDig (Digit (Node a) -> DelDig a) -> Digit (Node a) -> DelDig a
forall a b. (a -> b) -> a -> b
$ Node a -> Node a -> Node a -> Node a -> Digit (Node a)
forall a. a -> a -> a -> a -> Digit a
Four Node a
a' Node a
b Node a
c Node a
d
     Defect a
e -> let !se :: Int
se = a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
size a
e in case Node a
b of
       Node3 Int
sxyz a
x a
y a
z -> Digit (Node a) -> DelDig a
forall a. Digit (Node a) -> DelDig a
FullDig (Digit (Node a) -> DelDig a) -> Digit (Node a) -> DelDig a
forall a b. (a -> b) -> a -> b
$ Node a -> Node a -> Node a -> Node a -> Digit (Node a)
forall a. a -> a -> a -> a -> Digit a
Four (Int -> a -> a -> Node a
forall a. Int -> a -> a -> Node a
Node2 (Int
se Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Int
sx) a
e a
x) (Int -> a -> a -> Node a
forall a. Int -> a -> a -> Node a
Node2 (Int
sxyz Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
sx) a
y a
z) Node a
c Node a
d
         where !sx :: Int
sx = a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
size a
x
       Node2 Int
sxy a
x a
y -> Digit (Node a) -> DelDig a
forall a. Digit (Node a) -> DelDig a
FullDig (Digit (Node a) -> DelDig a) -> Digit (Node a) -> DelDig a
forall a b. (a -> b) -> a -> b
$ Node a -> Node a -> Node a -> Digit (Node a)
forall a. a -> a -> a -> Digit a
Three (Int -> a -> a -> a -> Node a
forall a. Int -> a -> a -> a -> Node a
Node3 (Int
se Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Int
sxy) a
e a
x a
y) Node a
c Node a
d
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
sab = case Int -> Node a -> Del a
f (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
sa) Node a
b of
     Full Node a
b' -> Digit (Node a) -> DelDig a
forall a. Digit (Node a) -> DelDig a
FullDig (Digit (Node a) -> DelDig a) -> Digit (Node a) -> DelDig a
forall a b. (a -> b) -> a -> b
$ Node a -> Node a -> Node a -> Node a -> Digit (Node a)
forall a. a -> a -> a -> a -> Digit a
Four Node a
a Node a
b' Node a
c Node a
d
     Defect a
e -> let !se :: Int
se = a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
size a
e in case Node a
a of
       Node3 Int
sxyz a
x a
y a
z -> Digit (Node a) -> DelDig a
forall a. Digit (Node a) -> DelDig a
FullDig (Digit (Node a) -> DelDig a) -> Digit (Node a) -> DelDig a
forall a b. (a -> b) -> a -> b
$ Node a -> Node a -> Node a -> Node a -> Digit (Node a)
forall a. a -> a -> a -> a -> Digit a
Four (Int -> a -> a -> Node a
forall a. Int -> a -> a -> Node a
Node2 (Int
sxyz Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
sz) a
x a
y) (Int -> a -> a -> Node a
forall a. Int -> a -> a -> Node a
Node2 (Int
sz Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Int
se) a
z a
e) Node a
c Node a
d
         where !sz :: Int
sz = a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
size a
z
       Node2 Int
sxy a
x a
y -> Digit (Node a) -> DelDig a
forall a. Digit (Node a) -> DelDig a
FullDig (Digit (Node a) -> DelDig a) -> Digit (Node a) -> DelDig a
forall a b. (a -> b) -> a -> b
$ Node a -> Node a -> Node a -> Digit (Node a)
forall a. a -> a -> a -> Digit a
Three (Int -> a -> a -> a -> Node a
forall a. Int -> a -> a -> a -> Node a
Node3 (Int
sxy Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Int
se) a
x a
y a
e) Node a
c Node a
d
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
sabc = case Int -> Node a -> Del a
f (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
sab) Node a
c of
     Full Node a
c' -> Digit (Node a) -> DelDig a
forall a. Digit (Node a) -> DelDig a
FullDig (Digit (Node a) -> DelDig a) -> Digit (Node a) -> DelDig a
forall a b. (a -> b) -> a -> b
$ Node a -> Node a -> Node a -> Node a -> Digit (Node a)
forall a. a -> a -> a -> a -> Digit a
Four Node a
a Node a
b Node a
c' Node a
d
     Defect a
e -> let !se :: Int
se = a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
size a
e in case Node a
b of
       Node3 Int
sxyz a
x a
y a
z -> Digit (Node a) -> DelDig a
forall a. Digit (Node a) -> DelDig a
FullDig (Digit (Node a) -> DelDig a) -> Digit (Node a) -> DelDig a
forall a b. (a -> b) -> a -> b
$ Node a -> Node a -> Node a -> Node a -> Digit (Node a)
forall a. a -> a -> a -> a -> Digit a
Four Node a
a (Int -> a -> a -> Node a
forall a. Int -> a -> a -> Node a
Node2 (Int
sxyz Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
sz) a
x a
y) (Int -> a -> a -> Node a
forall a. Int -> a -> a -> Node a
Node2 (Int
sz Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Int
se) a
z a
e) Node a
d
         where !sz :: Int
sz = a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
size a
z
       Node2 Int
sxy a
x a
y -> Digit (Node a) -> DelDig a
forall a. Digit (Node a) -> DelDig a
FullDig (Digit (Node a) -> DelDig a) -> Digit (Node a) -> DelDig a
forall a b. (a -> b) -> a -> b
$ Node a -> Node a -> Node a -> Digit (Node a)
forall a. a -> a -> a -> Digit a
Three Node a
a (Int -> a -> a -> a -> Node a
forall a. Int -> a -> a -> a -> Node a
Node3 (Int
sxy Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Int
se) a
x a
y a
e) Node a
d
  | Bool
otherwise = case Int -> Node a -> Del a
f (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
sabc) Node a
d of
     Full Node a
d' -> Digit (Node a) -> DelDig a
forall a. Digit (Node a) -> DelDig a
FullDig (Digit (Node a) -> DelDig a) -> Digit (Node a) -> DelDig a
forall a b. (a -> b) -> a -> b
$ Node a -> Node a -> Node a -> Node a -> Digit (Node a)
forall a. a -> a -> a -> a -> Digit a
Four Node a
a Node a
b Node a
c Node a
d'
     Defect a
e -> let !se :: Int
se = a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
size a
e in case Node a
c of
       Node3 Int
sxyz a
x a
y a
z -> Digit (Node a) -> DelDig a
forall a. Digit (Node a) -> DelDig a
FullDig (Digit (Node a) -> DelDig a) -> Digit (Node a) -> DelDig a
forall a b. (a -> b) -> a -> b
$ Node a -> Node a -> Node a -> Node a -> Digit (Node a)
forall a. a -> a -> a -> a -> Digit a
Four Node a
a Node a
b (Int -> a -> a -> Node a
forall a. Int -> a -> a -> Node a
Node2 (Int
sxyz Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
sz) a
x a
y) (Int -> a -> a -> Node a
forall a. Int -> a -> a -> Node a
Node2 (Int
sz Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Int
se) a
z a
e)
         where !sz :: Int
sz = a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
size a
z
       Node2 Int
sxy a
x a
y -> Digit (Node a) -> DelDig a
forall a. Digit (Node a) -> DelDig a
FullDig (Digit (Node a) -> DelDig a) -> Digit (Node a) -> DelDig a
forall a b. (a -> b) -> a -> b
$ Node a -> Node a -> Node a -> Digit (Node a)
forall a. a -> a -> a -> Digit a
Three Node a
a Node a
b (Int -> a -> a -> a -> Node a
forall a. Int -> a -> a -> a -> Node a
Node3 (Int
sxy Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Int
se) a
x a
y a
e)
  where sa :: Int
sa = Node a -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized (Node a)
size Node a
a
        sab :: Int
sab = Int
sa Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Node a -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized (Node a)
size Node a
b
        sabc :: Int
sabc = Int
sab Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Node a -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized (Node a)
size Node a
c


-- | A generalization of 'fmap', 'mapWithIndex' takes a mapping
-- function that also depends on the element's index, and applies it to every
-- element in the sequence.
mapWithIndex :: (Int -> a -> b) -> Seq a -> Seq b
mapWithIndex :: (Int -> a -> b) -> Seq a -> Seq b
mapWithIndex Int -> a -> b
f' (Seq FingerTree (Elem a)
xs') = FingerTree (Elem b) -> Seq b
forall a. FingerTree (Elem a) -> Seq a
Seq (FingerTree (Elem b) -> Seq b) -> FingerTree (Elem b) -> Seq b
forall a b. (a -> b) -> a -> b
$ (Int -> Elem a -> Elem b)
-> Int -> FingerTree (Elem a) -> FingerTree (Elem b)
forall a b.
Sized a =>
(Int -> a -> b) -> Int -> FingerTree a -> FingerTree b
Instance of class: Sized of the constraint type forall a. Sized (Elem a)
mapWithIndexTree (\Int
s (Elem a
a) -> b -> Elem b
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 :: (Int -> a -> b) -> Int -> FingerTree a -> FingerTree b
mapWithIndexTree Int -> a -> b
_ !Int
_s FingerTree a
EmptyT = FingerTree b
forall a. FingerTree a
EmptyT
  mapWithIndexTree Int -> a -> b
f Int
s (Single a
xs) = b -> FingerTree b
forall a. a -> FingerTree a
Single (b -> FingerTree b) -> b -> FingerTree b
forall a b. (a -> b) -> a -> b
$ Int -> a -> b
f Int
s a
xs
  mapWithIndexTree Int -> a -> b
f Int
s (Deep Int
n Digit a
pr FingerTree (Node a)
m Digit a
sf) =
          Int -> Digit b -> FingerTree (Node b) -> Digit b -> FingerTree b
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
n
               ((Int -> a -> b) -> Int -> Digit a -> Digit b
forall a b. Sized a => (Int -> a -> b) -> Int -> Digit a -> Digit b
Evidence bound by a type signature of the constraint type Sized a
mapWithIndexDigit Int -> a -> b
f Int
s Digit a
pr)
               ((Int -> Node a -> Node b)
-> Int -> FingerTree (Node a) -> FingerTree (Node b)
forall a b.
Sized a =>
(Int -> a -> b) -> Int -> FingerTree a -> FingerTree b
Instance of class: Sized of the constraint type forall a. Sized (Node a)
mapWithIndexTree ((Int -> a -> b) -> Int -> Node a -> Node b
forall a b. Sized a => (Int -> a -> b) -> Int -> Node a -> Node b
Evidence bound by a type signature of the constraint type Sized a
mapWithIndexNode Int -> a -> b
f) Int
sPspr FingerTree (Node a)
m)
               ((Int -> a -> b) -> Int -> Digit a -> Digit b
forall a b. Sized a => (Int -> a -> b) -> Int -> Digit a -> Digit b
Evidence bound by a type signature of the constraint type Sized a
mapWithIndexDigit Int -> a -> b
f Int
sPsprm Digit a
sf)
    where
      !sPspr :: Int
sPspr = Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Digit a -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized a => Sized (Digit a)
Evidence bound by a type signature of the constraint type Sized a
size Digit a
pr
      !sPsprm :: Int
sPsprm = Int
sPspr Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ FingerTree (Node a) -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized a => Sized (FingerTree a)
Instance of class: Sized of the constraint type forall a. Sized (Node a)
size FingerTree (Node a)
m

  {-# SPECIALIZE mapWithIndexDigit :: (Int -> Elem y -> b) -> Int -> Digit (Elem y) -> Digit b #-}
  {-# SPECIALIZE mapWithIndexDigit :: (Int -> Node y -> b) -> Int -> Digit (Node y) -> Digit b #-}
  mapWithIndexDigit :: Sized a => (Int -> a -> b) -> Int -> Digit a -> Digit b
  mapWithIndexDigit :: (Int -> a -> b) -> Int -> Digit a -> Digit b
mapWithIndexDigit Int -> a -> b
f !Int
s (One a
a) = b -> Digit b
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) = b -> b -> Digit b
forall a. a -> a -> Digit a
Two (Int -> a -> b
f Int
s a
a) (Int -> a -> b
f Int
sPsa a
b)
    where
      !sPsa :: Int
sPsa = Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
size a
a
  mapWithIndexDigit Int -> a -> b
f Int
s (Three a
a a
b a
c) =
                                      b -> b -> b -> Digit b
forall a. a -> a -> a -> Digit a
Three (Int -> a -> b
f Int
s a
a) (Int -> a -> b
f Int
sPsa a
b) (Int -> a -> b
f Int
sPsab a
c)
    where
      !sPsa :: Int
sPsa = Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
size a
a
      !sPsab :: Int
sPsab = Int
sPsa Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
size a
b
  mapWithIndexDigit Int -> a -> b
f Int
s (Four a
a a
b a
c a
d) =
                          b -> b -> b -> b -> Digit b
forall a. a -> a -> a -> a -> Digit a
Four (Int -> a -> b
f Int
s a
a) (Int -> a -> b
f Int
sPsa a
b) (Int -> a -> b
f Int
sPsab a
c) (Int -> a -> b
f Int
sPsabc a
d)
    where
      !sPsa :: Int
sPsa = Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
size a
a
      !sPsab :: Int
sPsab = Int
sPsa Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
size a
b
      !sPsabc :: Int
sPsabc = Int
sPsab Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
size a
c

  {-# SPECIALIZE mapWithIndexNode :: (Int -> Elem y -> b) -> Int -> Node (Elem y) -> Node b #-}
  {-# SPECIALIZE mapWithIndexNode :: (Int -> Node y -> b) -> Int -> Node (Node y) -> Node b #-}
  mapWithIndexNode :: Sized a => (Int -> a -> b) -> Int -> Node a -> Node b
  mapWithIndexNode :: (Int -> a -> b) -> Int -> Node a -> Node b
mapWithIndexNode Int -> a -> b
f Int
s (Node2 Int
ns a
a a
b) = Int -> b -> b -> Node b
forall a. Int -> a -> a -> Node a
Node2 Int
ns (Int -> a -> b
f Int
s a
a) (Int -> a -> b
f Int
sPsa a
b)
    where
      !sPsa :: Int
sPsa = Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
size a
a
  mapWithIndexNode Int -> a -> b
f Int
s (Node3 Int
ns a
a a
b a
c) =
                                     Int -> b -> b -> b -> Node b
forall a. Int -> a -> a -> a -> Node a
Node3 Int
ns (Int -> a -> b
f Int
s a
a) (Int -> a -> b
f Int
sPsa a
b) (Int -> a -> b
f Int
sPsab a
c)
    where
      !sPsa :: Int
sPsa = Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
size a
a
      !sPsab :: Int
sPsab = Int
sPsa Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
size a
b

#ifdef __GLASGOW_HASKELL__
{-# NOINLINE [1] mapWithIndex #-}
{-# RULES
"mapWithIndex/mapWithIndex" forall f g xs . mapWithIndex f (mapWithIndex g xs) =
  mapWithIndex (\k a -> f k (g k a)) xs
"mapWithIndex/fmapSeq" forall f g xs . mapWithIndex f (fmapSeq g xs) =
  mapWithIndex (\k a -> f k (g a)) xs
"fmapSeq/mapWithIndex" forall f g xs . fmapSeq f (mapWithIndex g xs) =
  mapWithIndex (\k a -> f (g k a)) xs
 #-}
#endif

{-# INLINE foldWithIndexDigit #-}
foldWithIndexDigit :: Sized a => (b -> b -> b) -> (Int -> a -> b) -> Int -> Digit a -> b
foldWithIndexDigit :: (b -> b -> b) -> (Int -> a -> b) -> Int -> Digit a -> b
foldWithIndexDigit 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 Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
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 Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
size a
a
    !sPsab :: Int
sPsab = Int
sPsa Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
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 Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
size a
a
    !sPsab :: Int
sPsab = Int
sPsa Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
size a
b
    !sPsabc :: Int
sPsabc = Int
sPsab Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
size a
c

{-# INLINE foldWithIndexNode #-}
foldWithIndexNode :: Sized a => (m -> m -> m) -> (Int -> a -> m) -> Int -> Node a -> m
foldWithIndexNode :: (m -> m -> m) -> (Int -> a -> m) -> Int -> Node a -> m
foldWithIndexNode m -> m -> m
(<+>) 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 Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
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 Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
size a
a
    !sPsab :: Int
sPsab = Int
sPsa Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
size a
b

-- A generalization of 'foldMap', 'foldMapWithIndex' takes a folding
-- function that also depends on the element's index, and applies it to every
-- element in the sequence.
--
-- @since 0.5.8
foldMapWithIndex :: Monoid m => (Int -> a -> m) -> Seq a -> m
foldMapWithIndex :: (Int -> a -> m) -> Seq a -> m
foldMapWithIndex Int -> a -> m
f' (Seq FingerTree (Elem a)
xs') = (Int -> Elem a -> m) -> Int -> FingerTree (Elem a) -> m
forall m a.
Monoid m =>
(Int -> Elem a -> m) -> Int -> FingerTree (Elem a) -> m
Evidence bound by a type signature of the constraint type Monoid m
foldMapWithIndexTreeE ((Int -> a -> m) -> Int -> Elem a -> m
forall a m. (Int -> a -> m) -> Int -> Elem a -> m
lift_elem Int -> a -> m
f') Int
0 FingerTree (Elem a)
xs'
 where
  lift_elem :: (Int -> a -> m) -> (Int -> Elem a -> m)
#if __GLASGOW_HASKELL__ >= 708
  lift_elem :: (Int -> a -> m) -> Int -> Elem a -> m
lift_elem Int -> a -> m
g = (Int -> a -> m) -> Int -> Elem a -> m
coerce Int -> a -> m
g
#else
  lift_elem g = \s (Elem a) -> g s a
#endif
  {-# INLINE lift_elem #-}
-- We have to specialize these functions by hand, unfortunately, because
-- GHC does not specialize until *all* instances are determined.
-- Although the Sized instance is known at compile time, the Monoid
-- instance generally is not.
  foldMapWithIndexTreeE :: Monoid m => (Int -> Elem a -> m) -> Int -> FingerTree (Elem a) -> m
  foldMapWithIndexTreeE :: (Int -> Elem a -> m) -> Int -> FingerTree (Elem a) -> m
foldMapWithIndexTreeE Int -> Elem a -> m
_ !Int
_s FingerTree (Elem a)
EmptyT = m
forall a. Monoid a => a
Evidence bound by a type signature of the constraint type Monoid m
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) =
               (Int -> Elem a -> m) -> Int -> Digit (Elem a) -> m
forall m a.
Monoid m =>
(Int -> Elem a -> m) -> Int -> Digit (Elem a) -> m
Evidence bound by a type signature of the constraint type Monoid m
foldMapWithIndexDigitE Int -> Elem a -> m
f Int
s Digit (Elem a)
pr m -> m -> m
forall a. Monoid a => a -> a -> a
Evidence bound by a type signature of the constraint type Monoid m
<>
               (Int -> Node (Elem a) -> m)
-> Int -> FingerTree (Node (Elem a)) -> m
forall m a.
Monoid m =>
(Int -> Node a -> m) -> Int -> FingerTree (Node a) -> m
Evidence bound by a type signature of the constraint type Monoid m
foldMapWithIndexTreeN ((Int -> Elem a -> m) -> Int -> Node (Elem a) -> m
forall m a.
Monoid m =>
(Int -> Elem a -> m) -> Int -> Node (Elem a) -> m
Evidence bound by a type signature of the constraint type Monoid m
foldMapWithIndexNodeE Int -> Elem a -> m
f) Int
sPspr FingerTree (Node (Elem a))
m m -> m -> m
forall a. Monoid a => a -> a -> a
Evidence bound by a type signature of the constraint type Monoid m
<>
               (Int -> Elem a -> m) -> Int -> Digit (Elem a) -> m
forall m a.
Monoid m =>
(Int -> Elem a -> m) -> Int -> Digit (Elem a) -> m
Evidence bound by a type signature of the constraint type Monoid m
foldMapWithIndexDigitE Int -> Elem a -> m
f Int
sPsprm Digit (Elem a)
sf
    where
      !sPspr :: Int
sPspr = Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Digit (Elem a) -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized a => Sized (Digit a)
Instance of class: Sized of the constraint type forall a. Sized (Elem a)
size Digit (Elem a)
pr
      !sPsprm :: Int
sPsprm = Int
sPspr Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ FingerTree (Node (Elem a)) -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized a => Sized (FingerTree a)
Instance of class: Sized of the constraint type forall a. Sized (Node a)
size FingerTree (Node (Elem a))
m

  foldMapWithIndexTreeN :: Monoid m => (Int -> Node a -> m) -> Int -> FingerTree (Node a) -> m
  foldMapWithIndexTreeN :: (Int -> Node a -> m) -> Int -> FingerTree (Node a) -> m
foldMapWithIndexTreeN Int -> Node a -> m
_ !Int
_s FingerTree (Node a)
EmptyT = m
forall a. Monoid a => a
Evidence bound by a type signature of the constraint type Monoid m
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) =
               (Int -> Node a -> m) -> Int -> Digit (Node a) -> m
forall m a.
Monoid m =>
(Int -> Node a -> m) -> Int -> Digit (Node a) -> m
Evidence bound by a type signature of the constraint type Monoid m
foldMapWithIndexDigitN Int -> Node a -> m
f Int
s Digit (Node a)
pr m -> m -> m
forall a. Monoid a => a -> a -> a
Evidence bound by a type signature of the constraint type Monoid m
<>
               (Int -> Node (Node a) -> m)
-> Int -> FingerTree (Node (Node a)) -> m
forall m a.
Monoid m =>
(Int -> Node a -> m) -> Int -> FingerTree (Node a) -> m
Evidence bound by a type signature of the constraint type Monoid m
foldMapWithIndexTreeN ((Int -> Node a -> m) -> Int -> Node (Node a) -> m
forall m a.
Monoid m =>
(Int -> Node a -> m) -> Int -> Node (Node a) -> m
Evidence bound by a type signature of the constraint type Monoid m
foldMapWithIndexNodeN Int -> Node a -> m
f) Int
sPspr FingerTree (Node (Node a))
m m -> m -> m
forall a. Monoid a => a -> a -> a
Evidence bound by a type signature of the constraint type Monoid m
<>
               (Int -> Node a -> m) -> Int -> Digit (Node a) -> m
forall m a.
Monoid m =>
(Int -> Node a -> m) -> Int -> Digit (Node a) -> m
Evidence bound by a type signature of the constraint type Monoid m
foldMapWithIndexDigitN Int -> Node a -> m
f Int
sPsprm Digit (Node a)
sf
    where
      !sPspr :: Int
sPspr = Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Digit (Node a) -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized a => Sized (Digit a)
Instance of class: Sized of the constraint type forall a. Sized (Node a)
size Digit (Node a)
pr
      !sPsprm :: Int
sPsprm = Int
sPspr Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ FingerTree (Node (Node a)) -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized a => Sized (FingerTree a)
Instance of class: Sized of the constraint type forall a. Sized (Node a)
size FingerTree (Node (Node a))
m

  foldMapWithIndexDigitE :: Monoid m => (Int -> Elem a -> m) -> Int -> Digit (Elem a) -> m
  foldMapWithIndexDigitE :: (Int -> Elem a -> m) -> Int -> Digit (Elem a) -> m
foldMapWithIndexDigitE Int -> Elem a -> m
f Int
i Digit (Elem a)
t = (m -> m -> m) -> (Int -> Elem a -> m) -> Int -> Digit (Elem a) -> m
forall a b.
Sized a =>
(b -> b -> b) -> (Int -> a -> b) -> Int -> Digit a -> b
Instance of class: Sized of the constraint type forall a. Sized (Elem a)
foldWithIndexDigit m -> m -> m
forall a. Monoid a => a -> a -> a
Evidence bound by a type signature of the constraint type Monoid 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 :: (Int -> Node a -> m) -> Int -> Digit (Node a) -> m
foldMapWithIndexDigitN Int -> Node a -> m
f Int
i Digit (Node a)
t = (m -> m -> m) -> (Int -> Node a -> m) -> Int -> Digit (Node a) -> m
forall a b.
Sized a =>
(b -> b -> b) -> (Int -> a -> b) -> Int -> Digit a -> b
Instance of class: Sized of the constraint type forall a. Sized (Node a)
foldWithIndexDigit m -> m -> m
forall a. Monoid a => a -> a -> a
Evidence bound by a type signature of the constraint type Monoid 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 :: (Int -> Elem a -> m) -> Int -> Node (Elem a) -> m
foldMapWithIndexNodeE Int -> Elem a -> m
f Int
i Node (Elem a)
t = (m -> m -> m) -> (Int -> Elem a -> m) -> Int -> Node (Elem a) -> m
forall a m.
Sized a =>
(m -> m -> m) -> (Int -> a -> m) -> Int -> Node a -> m
Instance of class: Sized of the constraint type forall a. Sized (Elem a)
foldWithIndexNode m -> m -> m
forall a. Monoid a => a -> a -> a
Evidence bound by a type signature of the constraint type Monoid 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 :: (Int -> Node a -> m) -> Int -> Node (Node a) -> m
foldMapWithIndexNodeN Int -> Node a -> m
f Int
i Node (Node a)
t = (m -> m -> m) -> (Int -> Node a -> m) -> Int -> Node (Node a) -> m
forall a m.
Sized a =>
(m -> m -> m) -> (Int -> a -> m) -> Int -> Node a -> m
Instance of class: Sized of the constraint type forall a. Sized (Node a)
foldWithIndexNode m -> m -> m
forall a. Monoid a => a -> a -> a
Evidence bound by a type signature of the constraint type Monoid m
(<>) Int -> Node a -> m
f Int
i Node (Node a)
t

#if __GLASGOW_HASKELL__
{-# INLINABLE foldMapWithIndex #-}
#endif

-- | 'traverseWithIndex' is a version of 'traverse' that also offers
-- access to the index of each element.
--
-- @since 0.5.8
traverseWithIndex :: Applicative f => (Int -> a -> f b) -> Seq a -> f (Seq b)
traverseWithIndex :: (Int -> a -> f b) -> Seq a -> f (Seq b)
traverseWithIndex Int -> a -> f b
f' (Seq FingerTree (Elem a)
xs') = FingerTree (Elem b) -> Seq b
forall a. FingerTree (Elem a) -> Seq a
Seq (FingerTree (Elem b) -> Seq b)
-> f (FingerTree (Elem b)) -> f (Seq b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
External instance of the constraint type forall (f :: * -> *). Applicative f => Functor f
Evidence bound by a type signature of the constraint type Applicative f
<$> (Int -> Elem a -> f (Elem b))
-> Int -> FingerTree (Elem a) -> f (FingerTree (Elem b))
forall (f :: * -> *) a b.
Applicative f =>
(Int -> Elem a -> f b)
-> Int -> FingerTree (Elem a) -> f (FingerTree b)
Evidence bound by a type signature of the constraint type Applicative f
traverseWithIndexTreeE (\Int
s (Elem a
a) -> b -> Elem b
forall a. a -> Elem a
Elem (b -> Elem b) -> f b -> f (Elem b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
External instance of the constraint type forall (f :: * -> *). Applicative f => Functor f
Evidence bound by a type signature of the constraint type Applicative f
<$> Int -> a -> f b
f' Int
s a
a) Int
0 FingerTree (Elem a)
xs'
 where
-- We have to specialize these functions by hand, unfortunately, because
-- GHC does not specialize until *all* instances are determined.
-- Although the Sized instance is known at compile time, the Applicative
-- instance generally is not.
  traverseWithIndexTreeE :: Applicative f => (Int -> Elem a -> f b) -> Int -> FingerTree (Elem a) -> f (FingerTree b)
  traverseWithIndexTreeE :: (Int -> Elem a -> f b)
-> Int -> FingerTree (Elem a) -> f (FingerTree b)
traverseWithIndexTreeE Int -> Elem a -> f b
_ !Int
_s FingerTree (Elem a)
EmptyT = FingerTree b -> f (FingerTree b)
forall (f :: * -> *) a. Applicative f => a -> f a
Evidence bound by a type signature of the constraint type Applicative f
pure FingerTree b
forall a. FingerTree a
EmptyT
  traverseWithIndexTreeE Int -> Elem a -> f b
f Int
s (Single Elem a
xs) = b -> FingerTree b
forall a. a -> FingerTree a
Single (b -> FingerTree b) -> f b -> f (FingerTree b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
External instance of the constraint type forall (f :: * -> *). Applicative f => Functor f
Evidence bound by a type signature of the constraint type Applicative f
<$> 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) =
          (Digit b -> FingerTree (Node b) -> Digit b -> FingerTree b)
-> f (Digit b)
-> f (FingerTree (Node b))
-> f (Digit b)
-> f (FingerTree b)
forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
Evidence bound by a type signature of the constraint type Applicative f
liftA3 (Int -> Digit b -> FingerTree (Node b) -> Digit b -> FingerTree b
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
n)
               ((Int -> Elem a -> f b) -> Int -> Digit (Elem a) -> f (Digit b)
forall (f :: * -> *) a b.
Applicative f =>
(Int -> Elem a -> f b) -> Int -> Digit (Elem a) -> f (Digit b)
Evidence bound by a type signature of the constraint type Applicative f
traverseWithIndexDigitE Int -> Elem a -> f b
f Int
s Digit (Elem a)
pr)
               ((Int -> Node (Elem a) -> f (Node b))
-> Int -> FingerTree (Node (Elem a)) -> f (FingerTree (Node b))
forall (f :: * -> *) a b.
Applicative f =>
(Int -> Node a -> f b)
-> Int -> FingerTree (Node a) -> f (FingerTree b)
Evidence bound by a type signature of the constraint type Applicative f
traverseWithIndexTreeN ((Int -> Elem a -> f b) -> Int -> Node (Elem a) -> f (Node b)
forall (f :: * -> *) a b.
Applicative f =>
(Int -> Elem a -> f b) -> Int -> Node (Elem a) -> f (Node b)
Evidence bound by a type signature of the constraint type Applicative f
traverseWithIndexNodeE Int -> Elem a -> f b
f) Int
sPspr FingerTree (Node (Elem a))
m)
               ((Int -> Elem a -> f b) -> Int -> Digit (Elem a) -> f (Digit b)
forall (f :: * -> *) a b.
Applicative f =>
(Int -> Elem a -> f b) -> Int -> Digit (Elem a) -> f (Digit b)
Evidence bound by a type signature of the constraint type Applicative f
traverseWithIndexDigitE Int -> Elem a -> f b
f Int
sPsprm Digit (Elem a)
sf)
    where
      !sPspr :: Int
sPspr = Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Digit (Elem a) -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized a => Sized (Digit a)
Instance of class: Sized of the constraint type forall a. Sized (Elem a)
size Digit (Elem a)
pr
      !sPsprm :: Int
sPsprm = Int
sPspr Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ FingerTree (Node (Elem a)) -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized a => Sized (FingerTree a)
Instance of class: Sized of the constraint type forall a. Sized (Node a)
size FingerTree (Node (Elem a))
m

  traverseWithIndexTreeN :: Applicative f => (Int -> Node a -> f b) -> Int -> FingerTree (Node a) -> f (FingerTree b)
  traverseWithIndexTreeN :: (Int -> Node a -> f b)
-> Int -> FingerTree (Node a) -> f (FingerTree b)
traverseWithIndexTreeN Int -> Node a -> f b
_ !Int
_s FingerTree (Node a)
EmptyT = FingerTree b -> f (FingerTree b)
forall (f :: * -> *) a. Applicative f => a -> f a
Evidence bound by a type signature of the constraint type Applicative f
pure FingerTree b
forall a. FingerTree a
EmptyT
  traverseWithIndexTreeN Int -> Node a -> f b
f Int
s (Single Node a
xs) = b -> FingerTree b
forall a. a -> FingerTree a
Single (b -> FingerTree b) -> f b -> f (FingerTree b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
External instance of the constraint type forall (f :: * -> *). Applicative f => Functor f
Evidence bound by a type signature of the constraint type Applicative f
<$> 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) =
          (Digit b -> FingerTree (Node b) -> Digit b -> FingerTree b)
-> f (Digit b)
-> f (FingerTree (Node b))
-> f (Digit b)
-> f (FingerTree b)
forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
Evidence bound by a type signature of the constraint type Applicative f
liftA3 (Int -> Digit b -> FingerTree (Node b) -> Digit b -> FingerTree b
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
n)
               ((Int -> Node a -> f b) -> Int -> Digit (Node a) -> f (Digit b)
forall (f :: * -> *) a b.
Applicative f =>
(Int -> Node a -> f b) -> Int -> Digit (Node a) -> f (Digit b)
Evidence bound by a type signature of the constraint type Applicative f
traverseWithIndexDigitN Int -> Node a -> f b
f Int
s Digit (Node a)
pr)
               ((Int -> Node (Node a) -> f (Node b))
-> Int -> FingerTree (Node (Node a)) -> f (FingerTree (Node b))
forall (f :: * -> *) a b.
Applicative f =>
(Int -> Node a -> f b)
-> Int -> FingerTree (Node a) -> f (FingerTree b)
Evidence bound by a type signature of the constraint type Applicative f
traverseWithIndexTreeN ((Int -> Node a -> f b) -> Int -> Node (Node a) -> f (Node b)
forall (f :: * -> *) a b.
Applicative f =>
(Int -> Node a -> f b) -> Int -> Node (Node a) -> f (Node b)
Evidence bound by a type signature of the constraint type Applicative f
traverseWithIndexNodeN Int -> Node a -> f b
f) Int
sPspr FingerTree (Node (Node a))
m)
               ((Int -> Node a -> f b) -> Int -> Digit (Node a) -> f (Digit b)
forall (f :: * -> *) a b.
Applicative f =>
(Int -> Node a -> f b) -> Int -> Digit (Node a) -> f (Digit b)
Evidence bound by a type signature of the constraint type Applicative f
traverseWithIndexDigitN Int -> Node a -> f b
f Int
sPsprm Digit (Node a)
sf)
    where
      !sPspr :: Int
sPspr = Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Digit (Node a) -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized a => Sized (Digit a)
Instance of class: Sized of the constraint type forall a. Sized (Node a)
size Digit (Node a)
pr
      !sPsprm :: Int
sPsprm = Int
sPspr Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ FingerTree (Node (Node a)) -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized a => Sized (FingerTree a)
Instance of class: Sized of the constraint type forall a. Sized (Node a)
size FingerTree (Node (Node a))
m

  traverseWithIndexDigitE :: Applicative f => (Int -> Elem a -> f b) -> Int -> Digit (Elem a) -> f (Digit b)
  traverseWithIndexDigitE :: (Int -> Elem a -> f b) -> Int -> Digit (Elem a) -> f (Digit b)
traverseWithIndexDigitE Int -> Elem a -> f b
f Int
i Digit (Elem a)
t = (Int -> Elem a -> f b) -> Int -> Digit (Elem a) -> f (Digit b)
forall (f :: * -> *) a b.
(Applicative f, Sized a) =>
(Int -> a -> f b) -> Int -> Digit a -> f (Digit b)
Instance of class: Sized of the constraint type forall a. Sized (Elem a)
Evidence bound by a type signature of the constraint type Applicative f
traverseWithIndexDigit Int -> Elem a -> f b
f Int
i Digit (Elem a)
t

  traverseWithIndexDigitN :: Applicative f => (Int -> Node a -> f b) -> Int -> Digit (Node a) -> f (Digit b)
  traverseWithIndexDigitN :: (Int -> Node a -> f b) -> Int -> Digit (Node a) -> f (Digit b)
traverseWithIndexDigitN Int -> Node a -> f b
f Int
i Digit (Node a)
t = (Int -> Node a -> f b) -> Int -> Digit (Node a) -> f (Digit b)
forall (f :: * -> *) a b.
(Applicative f, Sized a) =>
(Int -> a -> f b) -> Int -> Digit a -> f (Digit b)
Instance of class: Sized of the constraint type forall a. Sized (Node a)
Evidence bound by a type signature of the constraint type Applicative f
traverseWithIndexDigit Int -> Node a -> f b
f Int
i Digit (Node a)
t

  {-# INLINE traverseWithIndexDigit #-}
  traverseWithIndexDigit :: (Applicative f, Sized a) => (Int -> a -> f b) -> Int -> Digit a -> f (Digit b)
  traverseWithIndexDigit :: (Int -> a -> f b) -> Int -> Digit a -> f (Digit b)
traverseWithIndexDigit Int -> a -> f b
f !Int
s (One a
a) = b -> Digit b
forall a. a -> Digit a
One (b -> Digit b) -> f b -> f (Digit b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
External instance of the constraint type forall (f :: * -> *). Applicative f => Functor f
Evidence bound by a type signature of the constraint type Applicative f
<$> Int -> a -> f b
f Int
s a
a
  traverseWithIndexDigit Int -> a -> f b
f Int
s (Two a
a a
b) = (b -> b -> Digit b) -> f b -> f b -> f (Digit b)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
Evidence bound by a type signature of the constraint type Applicative f
liftA2 b -> b -> Digit b
forall a. a -> a -> Digit a
Two (Int -> a -> f b
f Int
s a
a) (Int -> a -> f b
f Int
sPsa a
b)
    where
      !sPsa :: Int
sPsa = Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
size a
a
  traverseWithIndexDigit Int -> a -> f b
f Int
s (Three a
a a
b a
c) =
                                      (b -> b -> b -> Digit b) -> f b -> f b -> f b -> f (Digit b)
forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
Evidence bound by a type signature of the constraint type Applicative f
liftA3 b -> b -> b -> Digit b
forall a. a -> a -> a -> Digit a
Three (Int -> a -> f b
f Int
s a
a) (Int -> a -> f b
f Int
sPsa a
b) (Int -> a -> f b
f Int
sPsab a
c)
    where
      !sPsa :: Int
sPsa = Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
size a
a
      !sPsab :: Int
sPsab = Int
sPsa Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
size a
b
  traverseWithIndexDigit Int -> a -> f b
f Int
s (Four a
a a
b a
c a
d) =
                          (b -> b -> b -> b -> Digit b)
-> f b -> f b -> f b -> f (b -> Digit b)
forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
Evidence bound by a type signature of the constraint type Applicative f
liftA3 b -> b -> b -> b -> Digit b
forall a. a -> a -> a -> a -> Digit a
Four (Int -> a -> f b
f Int
s a
a) (Int -> a -> f b
f Int
sPsa a
b) (Int -> a -> f b
f Int
sPsab a
c) f (b -> Digit b) -> f b -> f (Digit b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Evidence bound by a type signature of the constraint type Applicative f
<*> Int -> a -> f b
f Int
sPsabc a
d
    where
      !sPsa :: Int
sPsa = Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
size a
a
      !sPsab :: Int
sPsab = Int
sPsa Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
size a
b
      !sPsabc :: Int
sPsabc = Int
sPsab Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
size a
c

  traverseWithIndexNodeE :: Applicative f => (Int -> Elem a -> f b) -> Int -> Node (Elem a) -> f (Node b)
  traverseWithIndexNodeE :: (Int -> Elem a -> f b) -> Int -> Node (Elem a) -> f (Node b)
traverseWithIndexNodeE Int -> Elem a -> f b
f Int
i Node (Elem a)
t = (Int -> Elem a -> f b) -> Int -> Node (Elem a) -> f (Node b)
forall (f :: * -> *) a b.
(Applicative f, Sized a) =>
(Int -> a -> f b) -> Int -> Node a -> f (Node b)
Instance of class: Sized of the constraint type forall a. Sized (Elem a)
Evidence bound by a type signature of the constraint type Applicative f
traverseWithIndexNode Int -> Elem a -> f b
f Int
i Node (Elem a)
t

  traverseWithIndexNodeN :: Applicative f => (Int -> Node a -> f b) -> Int -> Node (Node a) -> f (Node b)
  traverseWithIndexNodeN :: (Int -> Node a -> f b) -> Int -> Node (Node a) -> f (Node b)
traverseWithIndexNodeN Int -> Node a -> f b
f Int
i Node (Node a)
t = (Int -> Node a -> f b) -> Int -> Node (Node a) -> f (Node b)
forall (f :: * -> *) a b.
(Applicative f, Sized a) =>
(Int -> a -> f b) -> Int -> Node a -> f (Node b)
Instance of class: Sized of the constraint type forall a. Sized (Node a)
Evidence bound by a type signature of the constraint type Applicative f
traverseWithIndexNode Int -> Node a -> f b
f Int
i Node (Node a)
t

  {-# INLINE traverseWithIndexNode #-}
  traverseWithIndexNode :: (Applicative f, Sized a) => (Int -> a -> f b) -> Int -> Node a -> f (Node b)
  traverseWithIndexNode :: (Int -> a -> f b) -> Int -> Node a -> f (Node b)
traverseWithIndexNode Int -> a -> f b
f !Int
s (Node2 Int
ns a
a a
b) = (b -> b -> Node b) -> f b -> f b -> f (Node b)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
Evidence bound by a type signature of the constraint type Applicative f
liftA2 (Int -> b -> b -> Node b
forall a. Int -> a -> a -> Node a
Node2 Int
ns) (Int -> a -> f b
f Int
s a
a) (Int -> a -> f b
f Int
sPsa a
b)
    where
      !sPsa :: Int
sPsa = Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
size a
a
  traverseWithIndexNode Int -> a -> f b
f Int
s (Node3 Int
ns a
a a
b a
c) =
                           (b -> b -> b -> Node b) -> f b -> f b -> f b -> f (Node b)
forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
Evidence bound by a type signature of the constraint type Applicative f
liftA3 (Int -> b -> b -> b -> Node b
forall a. Int -> a -> a -> a -> Node a
Node3 Int
ns) (Int -> a -> f b
f Int
s a
a) (Int -> a -> f b
f Int
sPsa a
b) (Int -> a -> f b
f Int
sPsab a
c)
    where
      !sPsa :: Int
sPsa = Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
size a
a
      !sPsab :: Int
sPsab = Int
sPsa Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
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
{-
It might be nice to be able to rewrite

traverseWithIndex f (fromFunction i g)
to
replicateAWithIndex i (\k -> f k (g k))
and
traverse f (fromFunction i g)
to
replicateAWithIndex i (f . g)

but we don't have replicateAWithIndex as yet.

We might wish for a rule like
"fmapSeq/travWithIndex" forall f g xs . fmapSeq f <$> traverseWithIndex g xs =
  traverseWithIndex (\k a -> f <$> g k a) xs
Unfortunately, this rule could screw up the inliner's treatment of
fmap in general, and it also relies on the arbitrary Functor being
valid.
-}


-- | \( O(n) \). Convert a given sequence length and a function representing that
-- sequence into a sequence.
--
-- @since 0.5.6.2
fromFunction :: Int -> (Int -> a) -> Seq a
fromFunction :: Int -> (Int -> a) -> Seq a
fromFunction Int
len Int -> a
f | Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
0 = [Char] -> Seq a
forall a. HasCallStack => [Char] -> a
error [Char]
"Data.Sequence.fromFunction called with negative len"
                   | Int
len Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq Int
== Int
0 = Seq a
forall a. Seq a
empty
                   | Bool
otherwise = FingerTree (Elem a) -> Seq a
forall a. FingerTree (Elem a) -> Seq a
Seq (FingerTree (Elem a) -> Seq a) -> FingerTree (Elem a) -> Seq a
forall a b. (a -> b) -> a -> b
$ (Int -> Elem a) -> Int -> Int -> Int -> FingerTree (Elem a)
forall a. (Int -> a) -> Int -> Int -> Int -> FingerTree a
create ((Int -> a) -> Int -> Elem a
forall a. (Int -> a) -> Int -> Elem a
lift_elem Int -> a
f) Int
1 Int
0 Int
len
  where
    create :: (Int -> a) -> Int -> Int -> Int -> FingerTree a
    create :: (Int -> a) -> Int -> Int -> Int -> FingerTree a
create Int -> a
b{-tree_builder-} !Int
s{-tree_size-} !Int
i{-start_index-} Int
trees = case Int
trees of
       Int
1 -> a -> FingerTree a
forall a. a -> FingerTree a
Single (a -> FingerTree a) -> a -> FingerTree a
forall a b. (a -> b) -> a -> b
$ Int -> a
b Int
i
       Int
2 -> Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
*Int
s) (a -> Digit a
forall a. a -> Digit a
One (Int -> a
b Int
i)) FingerTree (Node a)
forall a. FingerTree a
EmptyT (a -> Digit a
forall a. a -> Digit a
One (Int -> a
b (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+Int
s)))
       Int
3 -> Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
3Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
*Int
s) (Int -> Digit a
createTwo Int
i) FingerTree (Node a)
forall a. FingerTree a
EmptyT (a -> Digit a
forall a. a -> Digit a
One (Int -> a
b (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
*Int
s)))
       Int
4 -> Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
4Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
*Int
s) (Int -> Digit a
createTwo Int
i) FingerTree (Node a)
forall a. FingerTree a
EmptyT (Int -> Digit a
createTwo (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
*Int
s))
       Int
5 -> Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
5Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
*Int
s) (Int -> Digit a
createThree Int
i) FingerTree (Node a)
forall a. FingerTree a
EmptyT (Int -> Digit a
createTwo (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+Int
3Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
*Int
s))
       Int
6 -> Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
6Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
*Int
s) (Int -> Digit a
createThree Int
i) FingerTree (Node a)
forall a. FingerTree a
EmptyT (Int -> Digit a
createThree (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+Int
3Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
*Int
s))
       Int
_ -> case Int
trees Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
External instance of the constraint type Integral Int
`quotRem` Int
3 of
           (Int
trees', Int
1) -> Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
treesInt -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
*Int
s) (Int -> Digit a
createTwo Int
i)
                              ((Int -> Node a) -> Int -> Int -> Int -> FingerTree (Node a)
forall a. (Int -> a) -> Int -> Int -> Int -> FingerTree a
create Int -> Node a
mb (Int
3Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
*Int
s) (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
*Int
s) (Int
trees'Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
-Int
1))
                              (Int -> Digit a
createTwo (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+(Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+Int
3Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
*(Int
trees'Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
-Int
1))Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
*Int
s))
           (Int
trees', Int
2) -> Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
treesInt -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
*Int
s) (Int -> Digit a
createThree Int
i)
                              ((Int -> Node a) -> Int -> Int -> Int -> FingerTree (Node a)
forall a. (Int -> a) -> Int -> Int -> Int -> FingerTree a
create Int -> Node a
mb (Int
3Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
*Int
s) (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+Int
3Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
*Int
s) (Int
trees'Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
-Int
1))
                              (Int -> Digit a
createTwo (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+(Int
3Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+Int
3Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
*(Int
trees'Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
-Int
1))Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
*Int
s))
           (Int
trees', Int
_) -> Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
treesInt -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
*Int
s) (Int -> Digit a
createThree Int
i)
                              ((Int -> Node a) -> Int -> Int -> Int -> FingerTree (Node a)
forall a. (Int -> a) -> Int -> Int -> Int -> FingerTree a
create Int -> Node a
mb (Int
3Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
*Int
s) (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+Int
3Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
*Int
s) (Int
trees'Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
-Int
2))
                              (Int -> Digit a
createThree (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+(Int
3Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+Int
3Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
*(Int
trees'Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
-Int
2))Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
*Int
s))
      where
        createTwo :: Int -> Digit a
createTwo Int
j = a -> a -> Digit a
forall a. a -> a -> Digit a
Two (Int -> a
b Int
j) (Int -> a
b (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Int
s))
        {-# INLINE createTwo #-}
        createThree :: Int -> Digit a
createThree Int
j = a -> a -> a -> Digit a
forall a. a -> a -> a -> Digit a
Three (Int -> a
b Int
j) (Int -> a
b (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Int
s)) (Int -> a
b (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
*Int
s))
        {-# INLINE createThree #-}
        mb :: Int -> Node a
mb Int
j = Int -> a -> a -> a -> Node a
forall a. Int -> a -> a -> a -> Node a
Node3 (Int
3Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
*Int
s) (Int -> a
b Int
j) (Int -> a
b (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Int
s)) (Int -> a
b (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
*Int
s))
        {-# INLINE mb #-}

    lift_elem :: (Int -> a) -> (Int -> Elem a)
#if __GLASGOW_HASKELL__ >= 708
    lift_elem :: (Int -> a) -> Int -> Elem a
lift_elem Int -> a
g = (Int -> a) -> Int -> Elem a
coerce Int -> a
g
#else
    lift_elem g = Elem . g
#endif
    {-# INLINE lift_elem #-}

-- | \( O(n) \). Create a sequence consisting of the elements of an 'Array'.
-- Note that the resulting sequence elements may be evaluated lazily (as on GHC),
-- so you must force the entire structure to be sure that the original array
-- can be garbage-collected.
--
-- @since 0.5.6.2
fromArray :: Ix i => Array i a -> Seq a
#ifdef __GLASGOW_HASKELL__
fromArray :: Array i a -> Seq a
fromArray Array i a
a = Int -> (Int -> a) -> Seq a
forall a. Int -> (Int -> a) -> Seq a
fromFunction (Array i a -> Int
forall i e. Array i e -> Int
GHC.Arr.numElements Array i a
a) (Array i a -> Int -> a
forall i e. Array i e -> Int -> e
GHC.Arr.unsafeAt Array i a
a)
 where
  -- The following definition uses (Ix i) constraing, which is needed for the
  -- other fromArray definition.
  Int
_ = (i, i) -> Int
forall a. Ix a => (a, a) -> Int
Evidence bound by a type signature of the constraint type Ix i
Data.Array.rangeSize (Array i a -> (i, i)
forall i e. Array i e -> (i, i)
Data.Array.bounds Array i a
a)
#else
fromArray a = fromList2 (Data.Array.rangeSize (Data.Array.bounds a)) (Data.Array.elems a)
#endif

-- Splitting

-- | \( O(\log(\min(i,n-i))) \). The first @i@ elements of a sequence.
-- If @i@ is negative, @'take' i s@ yields the empty sequence.
-- If the sequence contains fewer than @i@ elements, the whole sequence
-- is returned.
take :: Int -> Seq a -> Seq a
take :: Int -> Seq a -> Seq a
take Int
i xs :: Seq a
xs@(Seq FingerTree (Elem a)
t)
    -- See note on unsigned arithmetic in splitAt
  | Int -> Word
forall a b. (Integral a, Num b) => a -> b
External instance of the constraint type Num Word
External instance of the constraint type Integral Int
fromIntegral Int
i Word -> Word -> Word
forall a. Num a => a -> a -> a
External instance of the constraint type Num Word
- Word
1 Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Word
< (Int -> Word
forall a b. (Integral a, Num b) => a -> b
External instance of the constraint type Num Word
External instance of the constraint type Integral Int
fromIntegral (Seq a -> Int
forall a. Seq a -> Int
length Seq a
xs) Word -> Word -> Word
forall a. Num a => a -> a -> a
External instance of the constraint type Num Word
- Word
1 :: Word) =
      FingerTree (Elem a) -> Seq a
forall a. FingerTree (Elem a) -> Seq a
Seq (Int -> FingerTree (Elem a) -> FingerTree (Elem a)
forall a. Int -> FingerTree (Elem a) -> FingerTree (Elem a)
takeTreeE Int
i FingerTree (Elem a)
t)
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
<= Int
0 = Seq a
forall a. Seq a
empty
  | Bool
otherwise = Seq a
xs

takeTreeE :: Int -> FingerTree (Elem a) -> FingerTree (Elem a)
takeTreeE :: Int -> FingerTree (Elem a) -> FingerTree (Elem a)
takeTreeE !Int
_i FingerTree (Elem a)
EmptyT = FingerTree (Elem a)
forall a. FingerTree a
EmptyT
takeTreeE Int
i t :: FingerTree (Elem a)
t@(Single Elem a
_)
   | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
<= Int
0 = FingerTree (Elem a)
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
spr     = Int -> Digit (Elem a) -> FingerTree (Elem a)
forall a. Int -> Digit (Elem a) -> FingerTree (Elem a)
takePrefixE Int
i Digit (Elem a)
pr
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
spm     = case Int
-> FingerTree (Node (Elem a))
-> StrictPair (FingerTree (Node (Elem a))) (Node (Elem a))
forall a.
Int
-> FingerTree (Node a) -> StrictPair (FingerTree (Node a)) (Node a)
takeTreeN Int
im FingerTree (Node (Elem a))
m of
            FingerTree (Node (Elem a))
ml :*: Node (Elem a)
xs -> Int
-> Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> Node (Elem a)
-> FingerTree (Elem a)
forall a.
Int
-> Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> Node (Elem a)
-> FingerTree (Elem a)
takeMiddleE (Int
im Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- FingerTree (Node (Elem a)) -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized a => Sized (FingerTree a)
Instance of class: Sized of the constraint type forall a. Sized (Node a)
size FingerTree (Node (Elem a))
ml) Int
spr Digit (Elem a)
pr FingerTree (Node (Elem a))
ml Node (Elem a)
xs
  | Bool
otherwise   = Int
-> Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> FingerTree (Elem a)
forall a.
Int
-> Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> FingerTree (Elem a)
takeSuffixE (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
spm) Int
s Digit (Elem a)
pr FingerTree (Node (Elem a))
m Digit (Elem a)
sf
  where
    spr :: Int
spr     = Digit (Elem a) -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized a => Sized (Digit a)
Instance of class: Sized of the constraint type forall a. Sized (Elem a)
size Digit (Elem a)
pr
    spm :: Int
spm     = Int
spr Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ FingerTree (Node (Elem a)) -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized a => Sized (FingerTree a)
Instance of class: Sized of the constraint type forall a. Sized (Node a)
size FingerTree (Node (Elem a))
m
    im :: Int
im      = Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
spr

takeTreeN :: Int -> FingerTree (Node a) -> StrictPair (FingerTree (Node a)) (Node a)
takeTreeN :: Int
-> FingerTree (Node a) -> StrictPair (FingerTree (Node a)) (Node a)
takeTreeN !Int
_i FingerTree (Node a)
EmptyT = [Char] -> StrictPair (FingerTree (Node a)) (Node a)
forall a. HasCallStack => [Char] -> a
error [Char]
"takeTreeN of empty tree"
takeTreeN Int
_i (Single Node a
x) = FingerTree (Node a)
forall a. FingerTree a
EmptyT FingerTree (Node a)
-> Node a -> StrictPair (FingerTree (Node a)) (Node a)
forall a b. a -> b -> StrictPair a b
:*: Node a
x
takeTreeN Int
i (Deep Int
s Digit (Node a)
pr FingerTree (Node (Node a))
m Digit (Node a)
sf)
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
spr     = Int -> Digit (Node a) -> StrictPair (FingerTree (Node a)) (Node a)
forall a.
Int -> Digit (Node a) -> StrictPair (FingerTree (Node a)) (Node a)
takePrefixN Int
i Digit (Node a)
pr
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
spm     = case Int
-> FingerTree (Node (Node a))
-> StrictPair (FingerTree (Node (Node a))) (Node (Node a))
forall a.
Int
-> FingerTree (Node a) -> StrictPair (FingerTree (Node a)) (Node a)
takeTreeN Int
im FingerTree (Node (Node a))
m of
            FingerTree (Node (Node a))
ml :*: Node (Node a)
xs -> Int
-> Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> Node (Node a)
-> StrictPair (FingerTree (Node a)) (Node a)
forall a.
Int
-> Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> Node (Node a)
-> StrictPair (FingerTree (Node a)) (Node a)
takeMiddleN (Int
im Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- FingerTree (Node (Node a)) -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized a => Sized (FingerTree a)
Instance of class: Sized of the constraint type forall a. Sized (Node a)
size FingerTree (Node (Node a))
ml) Int
spr Digit (Node a)
pr FingerTree (Node (Node a))
ml Node (Node a)
xs
  | Bool
otherwise   = Int
-> Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> StrictPair (FingerTree (Node a)) (Node a)
forall a.
Int
-> Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> StrictPair (FingerTree (Node a)) (Node a)
takeSuffixN (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
spm) Int
s Digit (Node a)
pr FingerTree (Node (Node a))
m Digit (Node a)
sf  where
    spr :: Int
spr     = Digit (Node a) -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized a => Sized (Digit a)
Instance of class: Sized of the constraint type forall a. Sized (Node a)
size Digit (Node a)
pr
    spm :: Int
spm     = Int
spr Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ FingerTree (Node (Node a)) -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized a => Sized (FingerTree a)
Instance of class: Sized of the constraint type forall a. Sized (Node a)
size FingerTree (Node (Node a))
m
    im :: Int
im      = Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
spr

takeMiddleN :: Int -> Int
             -> Digit (Node a) -> FingerTree (Node (Node a)) -> Node (Node a)
             -> StrictPair (FingerTree (Node a)) (Node a)
takeMiddleN :: Int
-> Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> Node (Node a)
-> StrictPair (FingerTree (Node a)) (Node a)
takeMiddleN Int
i Int
spr Digit (Node a)
pr FingerTree (Node (Node a))
ml (Node2 Int
_ Node a
a Node a
b)
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
sa      = Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node a)
forall a. Int -> Digit a -> FingerTree (Node a) -> FingerTree a
pullR Int
sprml Digit (Node a)
pr FingerTree (Node (Node a))
ml FingerTree (Node a)
-> Node a -> StrictPair (FingerTree (Node a)) (Node a)
forall a b. a -> b -> StrictPair a b
:*: Node a
a
  | Bool
otherwise   = Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> FingerTree (Node a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
sprmla Digit (Node a)
pr FingerTree (Node (Node a))
ml (Node a -> Digit (Node a)
forall a. a -> Digit a
One Node a
a) FingerTree (Node a)
-> Node a -> StrictPair (FingerTree (Node a)) (Node a)
forall a b. a -> b -> StrictPair a b
:*: Node a
b
  where
    sa :: Int
sa      = Node a -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized (Node a)
size Node a
a
    sprml :: Int
sprml   = Int
spr Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ FingerTree (Node (Node a)) -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized a => Sized (FingerTree a)
Instance of class: Sized of the constraint type forall a. Sized (Node a)
size FingerTree (Node (Node a))
ml
    sprmla :: Int
sprmla  = Int
sa Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ 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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
sa      = Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node a)
forall a. Int -> Digit a -> FingerTree (Node a) -> FingerTree a
pullR Int
sprml Digit (Node a)
pr FingerTree (Node (Node a))
ml FingerTree (Node a)
-> Node a -> StrictPair (FingerTree (Node a)) (Node a)
forall a b. a -> b -> StrictPair a b
:*: Node a
a
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
sab     = Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> FingerTree (Node a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
sprmla Digit (Node a)
pr FingerTree (Node (Node a))
ml (Node a -> Digit (Node a)
forall a. a -> Digit a
One Node a
a) FingerTree (Node a)
-> Node a -> StrictPair (FingerTree (Node a)) (Node a)
forall a b. a -> b -> StrictPair a b
:*: Node a
b
  | Bool
otherwise   = Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> FingerTree (Node a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
sprmlab Digit (Node a)
pr FingerTree (Node (Node a))
ml (Node a -> Node a -> Digit (Node a)
forall a. a -> a -> Digit a
Two Node a
a Node a
b) FingerTree (Node a)
-> Node a -> StrictPair (FingerTree (Node a)) (Node a)
forall a b. a -> b -> StrictPair a b
:*: Node a
c
  where
    sa :: Int
sa      = Node a -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized (Node a)
size Node a
a
    sab :: Int
sab     = Int
sa Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Node a -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized (Node a)
size Node a
b
    sprml :: Int
sprml   = Int
spr Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ FingerTree (Node (Node a)) -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized a => Sized (FingerTree a)
Instance of class: Sized of the constraint type forall a. Sized (Node a)
size FingerTree (Node (Node a))
ml
    sprmla :: Int
sprmla  = Int
sa Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Int
sprml
    sprmlab :: Int
sprmlab = Int
sprmla Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Node a -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized (Node a)
size Node a
b

takeMiddleE :: Int -> Int
             -> Digit (Elem a) -> FingerTree (Node (Elem a)) -> Node (Elem a)
             -> FingerTree (Elem a)
takeMiddleE :: Int
-> Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> Node (Elem a)
-> FingerTree (Elem a)
takeMiddleE Int
i Int
spr Digit (Elem a)
pr FingerTree (Node (Elem a))
ml (Node2 Int
_ Elem a
a Elem a
_)
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
1       = Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> FingerTree (Elem a)
forall a. Int -> Digit a -> FingerTree (Node a) -> FingerTree a
pullR Int
sprml Digit (Elem a)
pr FingerTree (Node (Elem a))
ml
  | Bool
otherwise   = Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> FingerTree (Elem a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
sprmla Digit (Elem a)
pr FingerTree (Node (Elem a))
ml (Elem a -> Digit (Elem a)
forall a. a -> Digit a
One Elem a
a)
  where
    sprml :: Int
sprml   = Int
spr Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ FingerTree (Node (Elem a)) -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized a => Sized (FingerTree a)
Instance of class: Sized of the constraint type forall a. Sized (Node a)
size FingerTree (Node (Elem a))
ml
    sprmla :: Int
sprmla  = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ 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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
1       = Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> FingerTree (Elem a)
forall a. Int -> Digit a -> FingerTree (Node a) -> FingerTree a
pullR Int
sprml Digit (Elem a)
pr FingerTree (Node (Elem a))
ml
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
2       = Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> FingerTree (Elem a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
sprmla Digit (Elem a)
pr FingerTree (Node (Elem a))
ml (Elem a -> Digit (Elem a)
forall a. a -> Digit a
One Elem a
a)
  | Bool
otherwise   = Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> FingerTree (Elem a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
sprmlab Digit (Elem a)
pr FingerTree (Node (Elem a))
ml (Elem a -> Elem a -> Digit (Elem a)
forall a. a -> a -> Digit a
Two Elem a
a Elem a
b)
  where
    sprml :: Int
sprml   = Int
spr Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ FingerTree (Node (Elem a)) -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized a => Sized (FingerTree a)
Instance of class: Sized of the constraint type forall a. Sized (Node a)
size FingerTree (Node (Elem a))
ml
    sprmla :: Int
sprmla  = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Int
sprml
    sprmlab :: Int
sprmlab = Int
sprmla Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Int
1

takePrefixE :: Int -> Digit (Elem a) -> FingerTree (Elem a)
takePrefixE :: Int -> Digit (Elem a) -> FingerTree (Elem a)
takePrefixE !Int
_i (One Elem a
_) = FingerTree (Elem a)
forall a. FingerTree a
EmptyT
takePrefixE Int
i (Two Elem a
a Elem a
_)
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
1       = FingerTree (Elem a)
forall a. FingerTree a
EmptyT
  | Bool
otherwise   = Elem a -> FingerTree (Elem a)
forall a. a -> FingerTree a
Single Elem a
a
takePrefixE Int
i (Three Elem a
a Elem a
b Elem a
_)
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
1       = FingerTree (Elem a)
forall a. FingerTree a
EmptyT
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
2       = Elem a -> FingerTree (Elem a)
forall a. a -> FingerTree a
Single Elem a
a
  | Bool
otherwise   = Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> FingerTree (Elem a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
2 (Elem a -> Digit (Elem a)
forall a. a -> Digit a
One Elem a
a) FingerTree (Node (Elem a))
forall a. FingerTree a
EmptyT (Elem a -> Digit (Elem a)
forall a. a -> Digit a
One Elem a
b)
takePrefixE Int
i (Four Elem a
a Elem a
b Elem a
c Elem a
_)
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
1       = FingerTree (Elem a)
forall a. FingerTree a
EmptyT
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
2       = Elem a -> FingerTree (Elem a)
forall a. a -> FingerTree a
Single Elem a
a
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
3       = Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> FingerTree (Elem a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
2 (Elem a -> Digit (Elem a)
forall a. a -> Digit a
One Elem a
a) FingerTree (Node (Elem a))
forall a. FingerTree a
EmptyT (Elem a -> Digit (Elem a)
forall a. a -> Digit a
One Elem a
b)
  | Bool
otherwise   = Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> FingerTree (Elem a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
3 (Elem a -> Elem a -> Digit (Elem a)
forall a. a -> a -> Digit a
Two Elem a
a Elem a
b) FingerTree (Node (Elem a))
forall a. FingerTree a
EmptyT (Elem a -> Digit (Elem a)
forall a. a -> Digit a
One Elem a
c)

takePrefixN :: Int -> Digit (Node a)
                    -> StrictPair (FingerTree (Node a)) (Node a)
takePrefixN :: Int -> Digit (Node a) -> StrictPair (FingerTree (Node a)) (Node a)
takePrefixN !Int
_i (One Node a
a) = FingerTree (Node a)
forall a. FingerTree a
EmptyT FingerTree (Node a)
-> Node a -> StrictPair (FingerTree (Node a)) (Node a)
forall a b. a -> b -> StrictPair a b
:*: Node a
a
takePrefixN Int
i (Two Node a
a Node a
b)
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
sa      = FingerTree (Node a)
forall a. FingerTree a
EmptyT FingerTree (Node a)
-> Node a -> StrictPair (FingerTree (Node a)) (Node a)
forall a b. a -> b -> StrictPair a b
:*: Node a
a
  | Bool
otherwise   = Node a -> FingerTree (Node a)
forall a. a -> FingerTree a
Single Node a
a FingerTree (Node a)
-> Node a -> StrictPair (FingerTree (Node a)) (Node a)
forall a b. a -> b -> StrictPair a b
:*: Node a
b
  where
    sa :: Int
sa      = Node a -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized (Node a)
size Node a
a
takePrefixN Int
i (Three Node a
a Node a
b Node a
c)
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
sa      = FingerTree (Node a)
forall a. FingerTree a
EmptyT FingerTree (Node a)
-> Node a -> StrictPair (FingerTree (Node a)) (Node a)
forall a b. a -> b -> StrictPair a b
:*: Node a
a
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
sab     = Node a -> FingerTree (Node a)
forall a. a -> FingerTree a
Single Node a
a FingerTree (Node a)
-> Node a -> StrictPair (FingerTree (Node a)) (Node a)
forall a b. a -> b -> StrictPair a b
:*: Node a
b
  | Bool
otherwise   = Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> FingerTree (Node a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
sab (Node a -> Digit (Node a)
forall a. a -> Digit a
One Node a
a) FingerTree (Node (Node a))
forall a. FingerTree a
EmptyT (Node a -> Digit (Node a)
forall a. a -> Digit a
One Node a
b) FingerTree (Node a)
-> Node a -> StrictPair (FingerTree (Node a)) (Node a)
forall a b. a -> b -> StrictPair a b
:*: Node a
c
  where
    sa :: Int
sa      = Node a -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized (Node a)
size Node a
a
    sab :: Int
sab     = Int
sa Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Node a -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized (Node a)
size Node a
b
takePrefixN Int
i (Four Node a
a Node a
b Node a
c Node a
d)
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
sa      = FingerTree (Node a)
forall a. FingerTree a
EmptyT FingerTree (Node a)
-> Node a -> StrictPair (FingerTree (Node a)) (Node a)
forall a b. a -> b -> StrictPair a b
:*: Node a
a
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
sab     = Node a -> FingerTree (Node a)
forall a. a -> FingerTree a
Single Node a
a FingerTree (Node a)
-> Node a -> StrictPair (FingerTree (Node a)) (Node a)
forall a b. a -> b -> StrictPair a b
:*: Node a
b
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
sabc    = Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> FingerTree (Node a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
sab (Node a -> Digit (Node a)
forall a. a -> Digit a
One Node a
a) FingerTree (Node (Node a))
forall a. FingerTree a
EmptyT (Node a -> Digit (Node a)
forall a. a -> Digit a
One Node a
b) FingerTree (Node a)
-> Node a -> StrictPair (FingerTree (Node a)) (Node a)
forall a b. a -> b -> StrictPair a b
:*: Node a
c
  | Bool
otherwise   = Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> FingerTree (Node a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
sabc (Node a -> Node a -> Digit (Node a)
forall a. a -> a -> Digit a
Two Node a
a Node a
b) FingerTree (Node (Node a))
forall a. FingerTree a
EmptyT (Node a -> Digit (Node a)
forall a. a -> Digit a
One Node a
c) FingerTree (Node a)
-> Node a -> StrictPair (FingerTree (Node a)) (Node a)
forall a b. a -> b -> StrictPair a b
:*: Node a
d
  where
    sa :: Int
sa      = Node a -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized (Node a)
size Node a
a
    sab :: Int
sab     = Int
sa Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Node a -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized (Node a)
size Node a
b
    sabc :: Int
sabc    = Int
sab Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Node a -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized (Node a)
size Node a
c

takeSuffixE :: Int -> Int -> Digit (Elem a) -> FingerTree (Node (Elem a)) -> Digit (Elem a) ->
   FingerTree (Elem a)
takeSuffixE :: Int
-> Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> FingerTree (Elem a)
takeSuffixE !Int
_i !Int
s Digit (Elem a)
pr FingerTree (Node (Elem a))
m (One Elem a
_) = Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> FingerTree (Elem a)
forall a. Int -> Digit a -> FingerTree (Node a) -> FingerTree a
pullR (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- 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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
1      = Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> FingerTree (Elem a)
forall a. Int -> Digit a -> FingerTree (Node a) -> FingerTree a
pullR (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
2) Digit (Elem a)
pr FingerTree (Node (Elem a))
m
  | Bool
otherwise  = Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> FingerTree (Elem a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
1) Digit (Elem a)
pr FingerTree (Node (Elem a))
m (Elem a -> Digit (Elem a)
forall a. a -> Digit a
One Elem a
a)
takeSuffixE Int
i Int
s Digit (Elem a)
pr FingerTree (Node (Elem a))
m (Three Elem a
a Elem a
b Elem a
_)
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
1      = Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> FingerTree (Elem a)
forall a. Int -> Digit a -> FingerTree (Node a) -> FingerTree a
pullR (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
3) Digit (Elem a)
pr FingerTree (Node (Elem a))
m
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
2      = Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> FingerTree (Elem a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
2) Digit (Elem a)
pr FingerTree (Node (Elem a))
m (Elem a -> Digit (Elem a)
forall a. a -> Digit a
One Elem a
a)
  | Bool
otherwise  = Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> FingerTree (Elem a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
1) Digit (Elem a)
pr FingerTree (Node (Elem a))
m (Elem a -> Elem a -> Digit (Elem a)
forall a. a -> a -> Digit a
Two Elem a
a Elem a
b)
takeSuffixE 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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
1      = Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> FingerTree (Elem a)
forall a. Int -> Digit a -> FingerTree (Node a) -> FingerTree a
pullR (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
4) Digit (Elem a)
pr FingerTree (Node (Elem a))
m
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
2      = Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> FingerTree (Elem a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
3) Digit (Elem a)
pr FingerTree (Node (Elem a))
m (Elem a -> Digit (Elem a)
forall a. a -> Digit a
One Elem a
a)
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
3      = Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> FingerTree (Elem a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
2) Digit (Elem a)
pr FingerTree (Node (Elem a))
m (Elem a -> Elem a -> Digit (Elem a)
forall a. a -> a -> Digit a
Two Elem a
a Elem a
b)
  | Bool
otherwise  = Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> FingerTree (Elem a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
1) Digit (Elem a)
pr FingerTree (Node (Elem a))
m (Elem a -> Elem a -> Elem a -> Digit (Elem a)
forall a. a -> a -> a -> Digit a
Three Elem a
a Elem a
b Elem a
c)

takeSuffixN :: Int -> Int -> Digit (Node a) -> FingerTree (Node (Node a)) -> Digit (Node a) ->
   StrictPair (FingerTree (Node a)) (Node a)
takeSuffixN :: Int
-> Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> StrictPair (FingerTree (Node a)) (Node a)
takeSuffixN !Int
_i !Int
s Digit (Node a)
pr FingerTree (Node (Node a))
m (One Node a
a) = Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node a)
forall a. Int -> Digit a -> FingerTree (Node a) -> FingerTree a
pullR (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Node a -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized (Node a)
size Node a
a) Digit (Node a)
pr FingerTree (Node (Node a))
m FingerTree (Node a)
-> Node a -> StrictPair (FingerTree (Node a)) (Node a)
forall a b. a -> b -> StrictPair a b
:*: Node a
a
takeSuffixN Int
i Int
s Digit (Node a)
pr FingerTree (Node (Node a))
m (Two Node a
a Node a
b)
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
sa      = Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node a)
forall a. Int -> Digit a -> FingerTree (Node a) -> FingerTree a
pullR (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
sa Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Node a -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized (Node a)
size Node a
b) Digit (Node a)
pr FingerTree (Node (Node a))
m FingerTree (Node a)
-> Node a -> StrictPair (FingerTree (Node a)) (Node a)
forall a b. a -> b -> StrictPair a b
:*: Node a
a
  | Bool
otherwise   = Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> FingerTree (Node a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Node a -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized (Node a)
size Node a
b) Digit (Node a)
pr FingerTree (Node (Node a))
m (Node a -> Digit (Node a)
forall a. a -> Digit a
One Node a
a) FingerTree (Node a)
-> Node a -> StrictPair (FingerTree (Node a)) (Node a)
forall a b. a -> b -> StrictPair a b
:*: Node a
b
  where
    sa :: Int
sa      = Node a -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized (Node a)
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
sa      = Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node a)
forall a. Int -> Digit a -> FingerTree (Node a) -> FingerTree a
pullR (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
sab Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Node a -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized (Node a)
size Node a
c) Digit (Node a)
pr FingerTree (Node (Node a))
m FingerTree (Node a)
-> Node a -> StrictPair (FingerTree (Node a)) (Node a)
forall a b. a -> b -> StrictPair a b
:*: Node a
a
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
sab     = Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> FingerTree (Node a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Node a -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized (Node a)
size Node a
b Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Node a -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized (Node a)
size Node a
c) Digit (Node a)
pr FingerTree (Node (Node a))
m (Node a -> Digit (Node a)
forall a. a -> Digit a
One Node a
a) FingerTree (Node a)
-> Node a -> StrictPair (FingerTree (Node a)) (Node a)
forall a b. a -> b -> StrictPair a b
:*: Node a
b
  | Bool
otherwise   = Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> FingerTree (Node a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Node a -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized (Node a)
size Node a
c) Digit (Node a)
pr FingerTree (Node (Node a))
m (Node a -> Node a -> Digit (Node a)
forall a. a -> a -> Digit a
Two Node a
a Node a
b) FingerTree (Node a)
-> Node a -> StrictPair (FingerTree (Node a)) (Node a)
forall a b. a -> b -> StrictPair a b
:*: Node a
c
  where
    sa :: Int
sa      = Node a -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized (Node a)
size Node a
a
    sab :: Int
sab     = Int
sa Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Node a -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized (Node a)
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
sa      = Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node a)
forall a. Int -> Digit a -> FingerTree (Node a) -> FingerTree a
pullR (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
sa Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
sbcd) Digit (Node a)
pr FingerTree (Node (Node a))
m FingerTree (Node a)
-> Node a -> StrictPair (FingerTree (Node a)) (Node a)
forall a b. a -> b -> StrictPair a b
:*: Node a
a
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
sab     = Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> FingerTree (Node a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
sbcd) Digit (Node a)
pr FingerTree (Node (Node a))
m (Node a -> Digit (Node a)
forall a. a -> Digit a
One Node a
a) FingerTree (Node a)
-> Node a -> StrictPair (FingerTree (Node a)) (Node a)
forall a b. a -> b -> StrictPair a b
:*: Node a
b
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
sabc    = Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> FingerTree (Node a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
scd) Digit (Node a)
pr FingerTree (Node (Node a))
m (Node a -> Node a -> Digit (Node a)
forall a. a -> a -> Digit a
Two Node a
a Node a
b) FingerTree (Node a)
-> Node a -> StrictPair (FingerTree (Node a)) (Node a)
forall a b. a -> b -> StrictPair a b
:*: Node a
c
  | Bool
otherwise   = Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> FingerTree (Node a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
sd) Digit (Node a)
pr FingerTree (Node (Node a))
m (Node a -> Node a -> Node a -> Digit (Node a)
forall a. a -> a -> a -> Digit a
Three Node a
a Node a
b Node a
c) FingerTree (Node a)
-> Node a -> StrictPair (FingerTree (Node a)) (Node a)
forall a b. a -> b -> StrictPair a b
:*: Node a
d
  where
    sa :: Int
sa      = Node a -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized (Node a)
size Node a
a
    sab :: Int
sab     = Int
sa Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Node a -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized (Node a)
size Node a
b
    sabc :: Int
sabc    = Int
sab Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Node a -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized (Node a)
size Node a
c
    sd :: Int
sd      = Node a -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized (Node a)
size Node a
d
    scd :: Int
scd     = Node a -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized (Node a)
size Node a
c Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Int
sd
    sbcd :: Int
sbcd    = Node a -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized (Node a)
size Node a
b Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Int
scd

-- | \( O(\log(\min(i,n-i))) \). Elements of a sequence after the first @i@.
-- If @i@ is negative, @'drop' i s@ yields the whole sequence.
-- If the sequence contains fewer than @i@ elements, the empty sequence
-- is returned.
drop            :: Int -> Seq a -> Seq a
drop :: Int -> Seq a -> Seq a
drop Int
i xs :: Seq a
xs@(Seq FingerTree (Elem a)
t)
    -- See note on unsigned arithmetic in splitAt
  | Int -> Word
forall a b. (Integral a, Num b) => a -> b
External instance of the constraint type Num Word
External instance of the constraint type Integral Int
fromIntegral Int
i Word -> Word -> Word
forall a. Num a => a -> a -> a
External instance of the constraint type Num Word
- Word
1 Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Word
< (Int -> Word
forall a b. (Integral a, Num b) => a -> b
External instance of the constraint type Num Word
External instance of the constraint type Integral Int
fromIntegral (Seq a -> Int
forall a. Seq a -> Int
length Seq a
xs) Word -> Word -> Word
forall a. Num a => a -> a -> a
External instance of the constraint type Num Word
- Word
1 :: Word) =
      FingerTree (Elem a) -> Seq a
forall a. FingerTree (Elem a) -> Seq a
Seq (Int -> FingerTree (Elem a) -> FingerTree (Elem a)
forall a. Int -> FingerTree (Elem a) -> FingerTree (Elem a)
takeTreeER (Seq a -> Int
forall a. Seq a -> Int
length Seq a
xs Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
i) FingerTree (Elem a)
t)
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
<= Int
0 = Seq a
xs
  | Bool
otherwise = Seq a
forall a. Seq a
empty

-- We implement `drop` using a "take from the rear" strategy.  There's no
-- particular technical reason for this; it just lets us reuse the arithmetic
-- from `take` (which itself reuses the arithmetic from `splitAt`) instead of
-- figuring it out from scratch and ending up with lots of off-by-one errors.
takeTreeER :: Int -> FingerTree (Elem a) -> FingerTree (Elem a)
takeTreeER :: Int -> FingerTree (Elem a) -> FingerTree (Elem a)
takeTreeER !Int
_i FingerTree (Elem a)
EmptyT = FingerTree (Elem a)
forall a. FingerTree a
EmptyT
takeTreeER Int
i t :: FingerTree (Elem a)
t@(Single Elem a
_)
   | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
<= Int
0 = FingerTree (Elem a)
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
ssf     = Int -> Digit (Elem a) -> FingerTree (Elem a)
forall a. Int -> Digit (Elem a) -> FingerTree (Elem a)
takeSuffixER Int
i Digit (Elem a)
sf
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
ssm     = case Int
-> FingerTree (Node (Elem a))
-> StrictPair (Node (Elem a)) (FingerTree (Node (Elem a)))
forall a.
Int
-> FingerTree (Node a) -> StrictPair (Node a) (FingerTree (Node a))
takeTreeNR Int
im FingerTree (Node (Elem a))
m of
            Node (Elem a)
xs :*: FingerTree (Node (Elem a))
mr -> Int
-> Int
-> Node (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> FingerTree (Elem a)
forall a.
Int
-> Int
-> Node (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> FingerTree (Elem a)
takeMiddleER (Int
im Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- FingerTree (Node (Elem a)) -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized a => Sized (FingerTree a)
Instance of class: Sized of the constraint type forall a. Sized (Node a)
size FingerTree (Node (Elem a))
mr) Int
ssf Node (Elem a)
xs FingerTree (Node (Elem a))
mr Digit (Elem a)
sf
  | Bool
otherwise   = Int
-> Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> FingerTree (Elem a)
forall a.
Int
-> Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> FingerTree (Elem a)
takePrefixER (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
ssm) Int
s Digit (Elem a)
pr FingerTree (Node (Elem a))
m Digit (Elem a)
sf
  where
    ssf :: Int
ssf     = Digit (Elem a) -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized a => Sized (Digit a)
Instance of class: Sized of the constraint type forall a. Sized (Elem a)
size Digit (Elem a)
sf
    ssm :: Int
ssm     = Int
ssf Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ FingerTree (Node (Elem a)) -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized a => Sized (FingerTree a)
Instance of class: Sized of the constraint type forall a. Sized (Node a)
size FingerTree (Node (Elem a))
m
    im :: Int
im      = Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
ssf

takeTreeNR :: Int -> FingerTree (Node a) -> StrictPair (Node a) (FingerTree (Node a))
takeTreeNR :: Int
-> FingerTree (Node a) -> StrictPair (Node a) (FingerTree (Node a))
takeTreeNR !Int
_i FingerTree (Node a)
EmptyT = [Char] -> StrictPair (Node a) (FingerTree (Node a))
forall a. HasCallStack => [Char] -> a
error [Char]
"takeTreeNR of empty tree"
takeTreeNR Int
_i (Single Node a
x) = Node a
x Node a
-> FingerTree (Node a) -> StrictPair (Node a) (FingerTree (Node a))
forall a b. a -> b -> StrictPair a b
:*: FingerTree (Node a)
forall a. FingerTree a
EmptyT
takeTreeNR Int
i (Deep Int
s Digit (Node a)
pr FingerTree (Node (Node a))
m Digit (Node a)
sf)
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
ssf     = Int -> Digit (Node a) -> StrictPair (Node a) (FingerTree (Node a))
forall a.
Int -> Digit (Node a) -> StrictPair (Node a) (FingerTree (Node a))
takeSuffixNR Int
i Digit (Node a)
sf
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
ssm     = case Int
-> FingerTree (Node (Node a))
-> StrictPair (Node (Node a)) (FingerTree (Node (Node a)))
forall a.
Int
-> FingerTree (Node a) -> StrictPair (Node a) (FingerTree (Node a))
takeTreeNR Int
im FingerTree (Node (Node a))
m of
            Node (Node a)
xs :*: FingerTree (Node (Node a))
mr -> Int
-> Int
-> Node (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> StrictPair (Node a) (FingerTree (Node a))
forall a.
Int
-> Int
-> Node (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> StrictPair (Node a) (FingerTree (Node a))
takeMiddleNR (Int
im Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- FingerTree (Node (Node a)) -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized a => Sized (FingerTree a)
Instance of class: Sized of the constraint type forall a. Sized (Node a)
size FingerTree (Node (Node a))
mr) Int
ssf Node (Node a)
xs FingerTree (Node (Node a))
mr Digit (Node a)
sf
  | Bool
otherwise   = Int
-> Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> StrictPair (Node a) (FingerTree (Node a))
forall a.
Int
-> Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> StrictPair (Node a) (FingerTree (Node a))
takePrefixNR (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
ssm) Int
s Digit (Node a)
pr FingerTree (Node (Node a))
m Digit (Node a)
sf  where
    ssf :: Int
ssf     = Digit (Node a) -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized a => Sized (Digit a)
Instance of class: Sized of the constraint type forall a. Sized (Node a)
size Digit (Node a)
sf
    ssm :: Int
ssm     = Int
ssf Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ FingerTree (Node (Node a)) -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized a => Sized (FingerTree a)
Instance of class: Sized of the constraint type forall a. Sized (Node a)
size FingerTree (Node (Node a))
m
    im :: Int
im      = Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
ssf

takeMiddleNR :: Int -> Int
             -> Node (Node a) -> FingerTree (Node (Node a)) -> Digit (Node a)
             -> StrictPair (Node a) (FingerTree (Node a))
takeMiddleNR :: Int
-> Int
-> Node (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> StrictPair (Node a) (FingerTree (Node a))
takeMiddleNR Int
i Int
ssf (Node2 Int
_ Node a
a Node a
b) FingerTree (Node (Node a))
mr Digit (Node a)
sf
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
sb      = Node a
b Node a
-> FingerTree (Node a) -> StrictPair (Node a) (FingerTree (Node a))
forall a b. a -> b -> StrictPair a b
:*: Int
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> FingerTree (Node a)
forall a. Int -> FingerTree (Node a) -> Digit a -> FingerTree a
pullL Int
ssfmr FingerTree (Node (Node a))
mr Digit (Node a)
sf
  | Bool
otherwise   = Node a
a Node a
-> FingerTree (Node a) -> StrictPair (Node a) (FingerTree (Node a))
forall a b. a -> b -> StrictPair a b
:*: Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> FingerTree (Node a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
ssfmrb (Node a -> Digit (Node a)
forall a. a -> Digit a
One Node a
b) FingerTree (Node (Node a))
mr Digit (Node a)
sf
  where
    sb :: Int
sb      = Node a -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized (Node a)
size Node a
b
    ssfmr :: Int
ssfmr   = Int
ssf Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ FingerTree (Node (Node a)) -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized a => Sized (FingerTree a)
Instance of class: Sized of the constraint type forall a. Sized (Node a)
size FingerTree (Node (Node a))
mr
    ssfmrb :: Int
ssfmrb  = Int
sb Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ 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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
sc      = Node a
c Node a
-> FingerTree (Node a) -> StrictPair (Node a) (FingerTree (Node a))
forall a b. a -> b -> StrictPair a b
:*: Int
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> FingerTree (Node a)
forall a. Int -> FingerTree (Node a) -> Digit a -> FingerTree a
pullL Int
ssfmr FingerTree (Node (Node a))
mr Digit (Node a)
sf
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
sbc     = Node a
b Node a
-> FingerTree (Node a) -> StrictPair (Node a) (FingerTree (Node a))
forall a b. a -> b -> StrictPair a b
:*: Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> FingerTree (Node a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
ssfmrc (Node a -> Digit (Node a)
forall a. a -> Digit a
One Node a
c) FingerTree (Node (Node a))
mr Digit (Node a)
sf
  | Bool
otherwise   = Node a
a Node a
-> FingerTree (Node a) -> StrictPair (Node a) (FingerTree (Node a))
forall a b. a -> b -> StrictPair a b
:*: Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> FingerTree (Node a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
ssfmrbc (Node a -> Node a -> Digit (Node a)
forall a. a -> a -> Digit a
Two Node a
b Node a
c) FingerTree (Node (Node a))
mr Digit (Node a)
sf
  where
    sc :: Int
sc      = Node a -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized (Node a)
size Node a
c
    sbc :: Int
sbc     = Int
sc Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Node a -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized (Node a)
size Node a
b
    ssfmr :: Int
ssfmr   = Int
ssf Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ FingerTree (Node (Node a)) -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized a => Sized (FingerTree a)
Instance of class: Sized of the constraint type forall a. Sized (Node a)
size FingerTree (Node (Node a))
mr
    ssfmrc :: Int
ssfmrc  = Int
sc Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Int
ssfmr
    ssfmrbc :: Int
ssfmrbc = Int
ssfmrc Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Node a -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized (Node a)
size Node a
b

takeMiddleER :: Int -> Int
             -> Node (Elem a) -> FingerTree (Node (Elem a)) -> Digit (Elem a)
             -> FingerTree (Elem a)
takeMiddleER :: Int
-> Int
-> Node (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> FingerTree (Elem a)
takeMiddleER Int
i Int
ssf (Node2 Int
_ Elem a
_ Elem a
b) FingerTree (Node (Elem a))
mr Digit (Elem a)
sf
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
1       = Int
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> FingerTree (Elem a)
forall a. Int -> FingerTree (Node a) -> Digit a -> FingerTree a
pullL Int
ssfmr FingerTree (Node (Elem a))
mr Digit (Elem a)
sf
  | Bool
otherwise   = Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> FingerTree (Elem a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
ssfmrb (Elem a -> Digit (Elem a)
forall a. a -> Digit a
One Elem a
b) FingerTree (Node (Elem a))
mr Digit (Elem a)
sf
  where
    ssfmr :: Int
ssfmr   = Int
ssf Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ FingerTree (Node (Elem a)) -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized a => Sized (FingerTree a)
Instance of class: Sized of the constraint type forall a. Sized (Node a)
size FingerTree (Node (Elem a))
mr
    ssfmrb :: Int
ssfmrb  = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ 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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
1       = Int
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> FingerTree (Elem a)
forall a. Int -> FingerTree (Node a) -> Digit a -> FingerTree a
pullL Int
ssfmr FingerTree (Node (Elem a))
mr Digit (Elem a)
sf
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
2       = Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> FingerTree (Elem a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
ssfmrc (Elem a -> Digit (Elem a)
forall a. a -> Digit a
One Elem a
c) FingerTree (Node (Elem a))
mr Digit (Elem a)
sf
  | Bool
otherwise   = Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> FingerTree (Elem a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
ssfmrbc (Elem a -> Elem a -> Digit (Elem a)
forall a. a -> a -> Digit a
Two Elem a
b Elem a
c) FingerTree (Node (Elem a))
mr Digit (Elem a)
sf
  where
    ssfmr :: Int
ssfmr   = Int
ssf Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ FingerTree (Node (Elem a)) -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized a => Sized (FingerTree a)
Instance of class: Sized of the constraint type forall a. Sized (Node a)
size FingerTree (Node (Elem a))
mr
    ssfmrc :: Int
ssfmrc  = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Int
ssfmr
    ssfmrbc :: Int
ssfmrbc = Int
ssfmr Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Int
2

takeSuffixER :: Int -> Digit (Elem a) -> FingerTree (Elem a)
takeSuffixER :: Int -> Digit (Elem a) -> FingerTree (Elem a)
takeSuffixER !Int
_i (One Elem a
_) = FingerTree (Elem a)
forall a. FingerTree a
EmptyT
takeSuffixER Int
i (Two Elem a
_ Elem a
b)
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
1       = FingerTree (Elem a)
forall a. FingerTree a
EmptyT
  | Bool
otherwise   = Elem a -> FingerTree (Elem a)
forall a. a -> FingerTree a
Single Elem a
b
takeSuffixER Int
i (Three Elem a
_ Elem a
b Elem a
c)
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
1       = FingerTree (Elem a)
forall a. FingerTree a
EmptyT
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
2       = Elem a -> FingerTree (Elem a)
forall a. a -> FingerTree a
Single Elem a
c
  | Bool
otherwise   = Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> FingerTree (Elem a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
2 (Elem a -> Digit (Elem a)
forall a. a -> Digit a
One Elem a
b) FingerTree (Node (Elem a))
forall a. FingerTree a
EmptyT (Elem a -> Digit (Elem a)
forall a. a -> Digit a
One Elem a
c)
takeSuffixER Int
i (Four Elem a
_ Elem a
b Elem a
c Elem a
d)
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
1       = FingerTree (Elem a)
forall a. FingerTree a
EmptyT
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
2       = Elem a -> FingerTree (Elem a)
forall a. a -> FingerTree a
Single Elem a
d
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
3       = Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> FingerTree (Elem a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
2 (Elem a -> Digit (Elem a)
forall a. a -> Digit a
One Elem a
c) FingerTree (Node (Elem a))
forall a. FingerTree a
EmptyT (Elem a -> Digit (Elem a)
forall a. a -> Digit a
One Elem a
d)
  | Bool
otherwise   = Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> FingerTree (Elem a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
3 (Elem a -> Elem a -> Digit (Elem a)
forall a. a -> a -> Digit a
Two Elem a
b Elem a
c) FingerTree (Node (Elem a))
forall a. FingerTree a
EmptyT (Elem a -> Digit (Elem a)
forall a. a -> Digit a
One Elem a
d)

takeSuffixNR :: Int -> Digit (Node a)
                    -> StrictPair (Node a) (FingerTree (Node a))
takeSuffixNR :: Int -> Digit (Node a) -> StrictPair (Node a) (FingerTree (Node a))
takeSuffixNR !Int
_i (One Node a
a) = Node a
a Node a
-> FingerTree (Node a) -> StrictPair (Node a) (FingerTree (Node a))
forall a b. a -> b -> StrictPair a b
:*: FingerTree (Node a)
forall a. FingerTree a
EmptyT
takeSuffixNR Int
i (Two Node a
a Node a
b)
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
sb      = Node a
b Node a
-> FingerTree (Node a) -> StrictPair (Node a) (FingerTree (Node a))
forall a b. a -> b -> StrictPair a b
:*: FingerTree (Node a)
forall a. FingerTree a
EmptyT
  | Bool
otherwise   = Node a
a Node a
-> FingerTree (Node a) -> StrictPair (Node a) (FingerTree (Node a))
forall a b. a -> b -> StrictPair a b
:*: Node a -> FingerTree (Node a)
forall a. a -> FingerTree a
Single Node a
b
  where
    sb :: Int
sb      = Node a -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized (Node a)
size Node a
b
takeSuffixNR Int
i (Three Node a
a Node a
b Node a
c)
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
sc      = Node a
c Node a
-> FingerTree (Node a) -> StrictPair (Node a) (FingerTree (Node a))
forall a b. a -> b -> StrictPair a b
:*: FingerTree (Node a)
forall a. FingerTree a
EmptyT
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
sbc     = Node a
b Node a
-> FingerTree (Node a) -> StrictPair (Node a) (FingerTree (Node a))
forall a b. a -> b -> StrictPair a b
:*: Node a -> FingerTree (Node a)
forall a. a -> FingerTree a
Single Node a
c
  | Bool
otherwise   = Node a
a Node a
-> FingerTree (Node a) -> StrictPair (Node a) (FingerTree (Node a))
forall a b. a -> b -> StrictPair a b
:*: Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> FingerTree (Node a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
sbc (Node a -> Digit (Node a)
forall a. a -> Digit a
One Node a
b) FingerTree (Node (Node a))
forall a. FingerTree a
EmptyT (Node a -> Digit (Node a)
forall a. a -> Digit a
One Node a
c)
  where
    sc :: Int
sc      = Node a -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized (Node a)
size Node a
c
    sbc :: Int
sbc     = Int
sc Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Node a -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized (Node a)
size Node a
b
takeSuffixNR Int
i (Four Node a
a Node a
b Node a
c Node a
d)
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
sd      = Node a
d Node a
-> FingerTree (Node a) -> StrictPair (Node a) (FingerTree (Node a))
forall a b. a -> b -> StrictPair a b
:*: FingerTree (Node a)
forall a. FingerTree a
EmptyT
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
scd     = Node a
c Node a
-> FingerTree (Node a) -> StrictPair (Node a) (FingerTree (Node a))
forall a b. a -> b -> StrictPair a b
:*: Node a -> FingerTree (Node a)
forall a. a -> FingerTree a
Single Node a
d
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
sbcd    = Node a
b Node a
-> FingerTree (Node a) -> StrictPair (Node a) (FingerTree (Node a))
forall a b. a -> b -> StrictPair a b
:*: Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> FingerTree (Node a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
scd (Node a -> Digit (Node a)
forall a. a -> Digit a
One Node a
c) FingerTree (Node (Node a))
forall a. FingerTree a
EmptyT (Node a -> Digit (Node a)
forall a. a -> Digit a
One Node a
d)
  | Bool
otherwise   = Node a
a Node a
-> FingerTree (Node a) -> StrictPair (Node a) (FingerTree (Node a))
forall a b. a -> b -> StrictPair a b
:*: Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> FingerTree (Node a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
sbcd (Node a -> Node a -> Digit (Node a)
forall a. a -> a -> Digit a
Two Node a
b Node a
c) FingerTree (Node (Node a))
forall a. FingerTree a
EmptyT (Node a -> Digit (Node a)
forall a. a -> Digit a
One Node a
d)
  where
    sd :: Int
sd      = Node a -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized (Node a)
size Node a
d
    scd :: Int
scd     = Int
sd Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Node a -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized (Node a)
size Node a
c
    sbcd :: Int
sbcd    = Int
scd Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Node a -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized (Node a)
size Node a
b

takePrefixER :: Int -> Int -> Digit (Elem a) -> FingerTree (Node (Elem a)) -> Digit (Elem a) ->
   FingerTree (Elem a)
takePrefixER :: Int
-> Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> FingerTree (Elem a)
takePrefixER !Int
_i !Int
s (One Elem a
_) FingerTree (Node (Elem a))
m Digit (Elem a)
sf = Int
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> FingerTree (Elem a)
forall a. Int -> FingerTree (Node a) -> Digit a -> FingerTree a
pullL (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- 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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
1      = Int
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> FingerTree (Elem a)
forall a. Int -> FingerTree (Node a) -> Digit a -> FingerTree a
pullL (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
2) FingerTree (Node (Elem a))
m Digit (Elem a)
sf
  | Bool
otherwise  = Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> FingerTree (Elem a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
1) (Elem a -> Digit (Elem a)
forall a. a -> Digit a
One Elem a
b) FingerTree (Node (Elem a))
m Digit (Elem a)
sf
takePrefixER Int
i Int
s (Three Elem a
_ Elem a
b Elem a
c) FingerTree (Node (Elem a))
m Digit (Elem a)
sf
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
1      = Int
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> FingerTree (Elem a)
forall a. Int -> FingerTree (Node a) -> Digit a -> FingerTree a
pullL (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
3) FingerTree (Node (Elem a))
m Digit (Elem a)
sf
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
2      = Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> FingerTree (Elem a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
2) (Elem a -> Digit (Elem a)
forall a. a -> Digit a
One Elem a
c) FingerTree (Node (Elem a))
m Digit (Elem a)
sf
  | Bool
otherwise  = Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> FingerTree (Elem a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
1) (Elem a -> Elem a -> Digit (Elem a)
forall a. a -> a -> Digit a
Two Elem a
b Elem a
c) FingerTree (Node (Elem a))
m Digit (Elem a)
sf
takePrefixER 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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
1      = Int
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> FingerTree (Elem a)
forall a. Int -> FingerTree (Node a) -> Digit a -> FingerTree a
pullL (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
4) FingerTree (Node (Elem a))
m Digit (Elem a)
sf
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
2      = Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> FingerTree (Elem a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
3) (Elem a -> Digit (Elem a)
forall a. a -> Digit a
One Elem a
d) FingerTree (Node (Elem a))
m Digit (Elem a)
sf
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
3      = Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> FingerTree (Elem a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
2) (Elem a -> Elem a -> Digit (Elem a)
forall a. a -> a -> Digit a
Two Elem a
c Elem a
d) FingerTree (Node (Elem a))
m Digit (Elem a)
sf
  | Bool
otherwise  = Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> FingerTree (Elem a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
1) (Elem a -> Elem a -> Elem a -> Digit (Elem a)
forall a. a -> a -> a -> Digit a
Three Elem a
b Elem a
c Elem a
d) FingerTree (Node (Elem a))
m Digit (Elem a)
sf

takePrefixNR :: Int -> Int -> Digit (Node a) -> FingerTree (Node (Node a)) -> Digit (Node a) ->
   StrictPair (Node a) (FingerTree (Node a))
takePrefixNR :: Int
-> Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> StrictPair (Node a) (FingerTree (Node a))
takePrefixNR !Int
_i !Int
s (One Node a
a) FingerTree (Node (Node a))
m Digit (Node a)
sf = Node a
a Node a
-> FingerTree (Node a) -> StrictPair (Node a) (FingerTree (Node a))
forall a b. a -> b -> StrictPair a b
:*: Int
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> FingerTree (Node a)
forall a. Int -> FingerTree (Node a) -> Digit a -> FingerTree a
pullL (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Node a -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized (Node a)
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
sb      = Node a
b Node a
-> FingerTree (Node a) -> StrictPair (Node a) (FingerTree (Node a))
forall a b. a -> b -> StrictPair a b
:*: Int
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> FingerTree (Node a)
forall a. Int -> FingerTree (Node a) -> Digit a -> FingerTree a
pullL (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
sb Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Node a -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized (Node a)
size Node a
a) FingerTree (Node (Node a))
m Digit (Node a)
sf
  | Bool
otherwise   = Node a
a Node a
-> FingerTree (Node a) -> StrictPair (Node a) (FingerTree (Node a))
forall a b. a -> b -> StrictPair a b
:*: Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> FingerTree (Node a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Node a -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized (Node a)
size Node a
a) (Node a -> Digit (Node a)
forall a. a -> Digit a
One Node a
b) FingerTree (Node (Node a))
m Digit (Node a)
sf
  where
    sb :: Int
sb      = Node a -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized (Node a)
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
sc      = Node a
c Node a
-> FingerTree (Node a) -> StrictPair (Node a) (FingerTree (Node a))
forall a b. a -> b -> StrictPair a b
:*: Int
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> FingerTree (Node a)
forall a. Int -> FingerTree (Node a) -> Digit a -> FingerTree a
pullL (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
sbc Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Node a -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized (Node a)
size Node a
a) FingerTree (Node (Node a))
m Digit (Node a)
sf
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
sbc     = Node a
b Node a
-> FingerTree (Node a) -> StrictPair (Node a) (FingerTree (Node a))
forall a b. a -> b -> StrictPair a b
:*: Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> FingerTree (Node a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Node a -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized (Node a)
size Node a
b Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Node a -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized (Node a)
size Node a
a) (Node a -> Digit (Node a)
forall a. a -> Digit a
One Node a
c) FingerTree (Node (Node a))
m Digit (Node a)
sf
  | Bool
otherwise   = Node a
a Node a
-> FingerTree (Node a) -> StrictPair (Node a) (FingerTree (Node a))
forall a b. a -> b -> StrictPair a b
:*: Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> FingerTree (Node a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Node a -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized (Node a)
size Node a
a) (Node a -> Node a -> Digit (Node a)
forall a. a -> a -> Digit a
Two Node a
b Node a
c) FingerTree (Node (Node a))
m Digit (Node a)
sf
  where
    sc :: Int
sc      = Node a -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized (Node a)
size Node a
c
    sbc :: Int
sbc     = Int
sc Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Node a -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized (Node a)
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
sd      = Node a
d Node a
-> FingerTree (Node a) -> StrictPair (Node a) (FingerTree (Node a))
forall a b. a -> b -> StrictPair a b
:*: Int
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> FingerTree (Node a)
forall a. Int -> FingerTree (Node a) -> Digit a -> FingerTree a
pullL (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
sd Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
sabc) FingerTree (Node (Node a))
m Digit (Node a)
sf
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
scd     = Node a
c Node a
-> FingerTree (Node a) -> StrictPair (Node a) (FingerTree (Node a))
forall a b. a -> b -> StrictPair a b
:*: Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> FingerTree (Node a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
sabc) (Node a -> Digit (Node a)
forall a. a -> Digit a
One Node a
d) FingerTree (Node (Node a))
m Digit (Node a)
sf
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
sbcd    = Node a
b Node a
-> FingerTree (Node a) -> StrictPair (Node a) (FingerTree (Node a))
forall a b. a -> b -> StrictPair a b
:*: Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> FingerTree (Node a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
sab) (Node a -> Node a -> Digit (Node a)
forall a. a -> a -> Digit a
Two Node a
c Node a
d) FingerTree (Node (Node a))
m Digit (Node a)
sf
  | Bool
otherwise   = Node a
a Node a
-> FingerTree (Node a) -> StrictPair (Node a) (FingerTree (Node a))
forall a b. a -> b -> StrictPair a b
:*: Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> FingerTree (Node a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
sa) (Node a -> Node a -> Node a -> Digit (Node a)
forall a. a -> a -> a -> Digit a
Three Node a
b Node a
c Node a
d) FingerTree (Node (Node a))
m Digit (Node a)
sf
  where
    sa :: Int
sa      = Node a -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized (Node a)
size Node a
a
    sab :: Int
sab     = Int
sa Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Node a -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized (Node a)
size Node a
b
    sabc :: Int
sabc    = Int
sab Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Node a -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized (Node a)
size Node a
c
    sd :: Int
sd      = Node a -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized (Node a)
size Node a
d
    scd :: Int
scd     = Node a -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized (Node a)
size Node a
c Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Int
sd
    sbcd :: Int
sbcd    = Node a -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized (Node a)
size Node a
b Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Int
scd

-- | \( O(\log(\min(i,n-i))) \). Split a sequence at a given position.
-- @'splitAt' i s = ('take' i s, 'drop' i s)@.
splitAt                  :: Int -> Seq a -> (Seq a, Seq a)
splitAt :: Int -> Seq a -> (Seq a, Seq a)
splitAt Int
i xs :: Seq a
xs@(Seq FingerTree (Elem a)
t)
  -- We use an unsigned comparison to make the common case
  -- faster. This only works because our representation of
  -- sizes as (signed) Ints gives us a free high bit to play
  -- with. Note also that there's no sharing to lose in the
  -- case that the length is 0.
  | Int -> Word
forall a b. (Integral a, Num b) => a -> b
External instance of the constraint type Num Word
External instance of the constraint type Integral Int
fromIntegral Int
i Word -> Word -> Word
forall a. Num a => a -> a -> a
External instance of the constraint type Num Word
- Word
1 Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Word
< (Int -> Word
forall a b. (Integral a, Num b) => a -> b
External instance of the constraint type Num Word
External instance of the constraint type Integral Int
fromIntegral (Seq a -> Int
forall a. Seq a -> Int
length Seq a
xs) Word -> Word -> Word
forall a. Num a => a -> a -> a
External instance of the constraint type Num Word
- Word
1 :: Word) =
      case Int
-> FingerTree (Elem a)
-> StrictPair (FingerTree (Elem a)) (FingerTree (Elem a))
forall a.
Int
-> FingerTree (Elem a)
-> StrictPair (FingerTree (Elem a)) (FingerTree (Elem a))
splitTreeE Int
i FingerTree (Elem a)
t of
        FingerTree (Elem a)
l :*: FingerTree (Elem a)
r -> (FingerTree (Elem a) -> Seq a
forall a. FingerTree (Elem a) -> Seq a
Seq FingerTree (Elem a)
l, FingerTree (Elem a) -> Seq a
forall a. FingerTree (Elem a) -> Seq a
Seq FingerTree (Elem a)
r)
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
<= Int
0 = (Seq a
forall a. Seq a
empty, Seq a
xs)
  | Bool
otherwise = (Seq a
xs, Seq a
forall a. Seq a
empty)

-- | \( O(\log(\min(i,n-i))) \) A version of 'splitAt' that does not attempt to
-- enhance sharing when the split point is less than or equal to 0, and that
-- gives completely wrong answers when the split point is at least the length
-- of the sequence, unless the sequence is a singleton. This is used to
-- implement zipWith and chunksOf, which are extremely sensitive to the cost of
-- splitting very short sequences. There is just enough of a speed increase to
-- make this worth the trouble.
uncheckedSplitAt :: Int -> Seq a -> (Seq a, Seq a)
uncheckedSplitAt :: Int -> Seq a -> (Seq a, Seq a)
uncheckedSplitAt Int
i (Seq FingerTree (Elem a)
xs) = case Int
-> FingerTree (Elem a)
-> StrictPair (FingerTree (Elem a)) (FingerTree (Elem a))
forall a.
Int
-> FingerTree (Elem a)
-> StrictPair (FingerTree (Elem a)) (FingerTree (Elem a))
splitTreeE Int
i FingerTree (Elem a)
xs of
  FingerTree (Elem a)
l :*: FingerTree (Elem a)
r -> (FingerTree (Elem a) -> Seq a
forall a. FingerTree (Elem a) -> Seq a
Seq FingerTree (Elem a)
l, FingerTree (Elem a) -> Seq a
forall a. FingerTree (Elem a) -> Seq a
Seq FingerTree (Elem a)
r)

data Split a = Split !(FingerTree (Node a)) !(Node a) !(FingerTree (Node a))
#ifdef TESTING
    deriving Show
#endif

splitTreeE :: Int -> FingerTree (Elem a) -> StrictPair (FingerTree (Elem a)) (FingerTree (Elem a))
splitTreeE :: Int
-> FingerTree (Elem a)
-> StrictPair (FingerTree (Elem a)) (FingerTree (Elem a))
splitTreeE !Int
_i FingerTree (Elem a)
EmptyT = FingerTree (Elem a)
forall a. FingerTree a
EmptyT FingerTree (Elem a)
-> FingerTree (Elem a)
-> StrictPair (FingerTree (Elem a)) (FingerTree (Elem a))
forall a b. a -> b -> StrictPair a b
:*: FingerTree (Elem a)
forall a. FingerTree a
EmptyT
splitTreeE Int
i t :: FingerTree (Elem a)
t@(Single Elem a
_)
   | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
<= Int
0 = FingerTree (Elem a)
forall a. FingerTree a
EmptyT FingerTree (Elem a)
-> FingerTree (Elem a)
-> StrictPair (FingerTree (Elem a)) (FingerTree (Elem a))
forall a b. a -> b -> StrictPair a b
:*: FingerTree (Elem a)
t
   | Bool
otherwise = FingerTree (Elem a)
t FingerTree (Elem a)
-> FingerTree (Elem a)
-> StrictPair (FingerTree (Elem a)) (FingerTree (Elem a))
forall a b. a -> b -> StrictPair a b
:*: FingerTree (Elem a)
forall a. FingerTree a
EmptyT
splitTreeE Int
i (Deep Int
s Digit (Elem a)
pr FingerTree (Node (Elem a))
m Digit (Elem a)
sf)
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
spr     = Int
-> Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> StrictPair (FingerTree (Elem a)) (FingerTree (Elem a))
forall a.
Int
-> Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> StrictPair (FingerTree (Elem a)) (FingerTree (Elem a))
splitPrefixE Int
i Int
s Digit (Elem a)
pr FingerTree (Node (Elem a))
m Digit (Elem a)
sf
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
spm     = case Int -> FingerTree (Node (Elem a)) -> Split (Elem a)
forall a. Int -> FingerTree (Node a) -> Split a
splitTreeN Int
im FingerTree (Node (Elem a))
m of
            Split FingerTree (Node (Elem a))
ml Node (Elem a)
xs FingerTree (Node (Elem a))
mr -> Int
-> Int
-> Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> Node (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> StrictPair (FingerTree (Elem a)) (FingerTree (Elem a))
forall a.
Int
-> Int
-> Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> Node (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> StrictPair (FingerTree (Elem a)) (FingerTree (Elem a))
splitMiddleE (Int
im Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- FingerTree (Node (Elem a)) -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized a => Sized (FingerTree a)
Instance of class: Sized of the constraint type forall a. Sized (Node a)
size FingerTree (Node (Elem a))
ml) Int
s Int
spr Digit (Elem a)
pr FingerTree (Node (Elem a))
ml Node (Elem a)
xs FingerTree (Node (Elem a))
mr Digit (Elem a)
sf
  | Bool
otherwise   = Int
-> Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> StrictPair (FingerTree (Elem a)) (FingerTree (Elem a))
forall a.
Int
-> Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> StrictPair (FingerTree (Elem a)) (FingerTree (Elem a))
splitSuffixE (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
spm) Int
s Digit (Elem a)
pr FingerTree (Node (Elem a))
m Digit (Elem a)
sf
  where
    spr :: Int
spr     = Digit (Elem a) -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized a => Sized (Digit a)
Instance of class: Sized of the constraint type forall a. Sized (Elem a)
size Digit (Elem a)
pr
    spm :: Int
spm     = Int
spr Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ FingerTree (Node (Elem a)) -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized a => Sized (FingerTree a)
Instance of class: Sized of the constraint type forall a. Sized (Node a)
size FingerTree (Node (Elem a))
m
    im :: Int
im      = Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
spr

splitTreeN :: Int -> FingerTree (Node a) -> Split a
splitTreeN :: Int -> FingerTree (Node a) -> Split a
splitTreeN !Int
_i FingerTree (Node a)
EmptyT = [Char] -> Split a
forall a. HasCallStack => [Char] -> a
error [Char]
"splitTreeN of empty tree"
splitTreeN Int
_i (Single Node a
x) = FingerTree (Node a) -> Node a -> FingerTree (Node a) -> Split a
forall a.
FingerTree (Node a) -> Node a -> FingerTree (Node a) -> Split a
Split FingerTree (Node a)
forall a. FingerTree a
EmptyT Node a
x FingerTree (Node a)
forall a. FingerTree a
EmptyT
splitTreeN Int
i (Deep Int
s Digit (Node a)
pr FingerTree (Node (Node a))
m Digit (Node a)
sf)
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
spr     = Int
-> Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> Split a
forall a.
Int
-> Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> Split a
splitPrefixN Int
i Int
s Digit (Node a)
pr FingerTree (Node (Node a))
m Digit (Node a)
sf
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
spm     = case Int -> FingerTree (Node (Node a)) -> Split (Node a)
forall a. Int -> FingerTree (Node a) -> Split a
splitTreeN Int
im FingerTree (Node (Node a))
m of
            Split FingerTree (Node (Node a))
ml Node (Node a)
xs FingerTree (Node (Node a))
mr -> Int
-> Int
-> Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> Node (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> Split a
forall a.
Int
-> Int
-> Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> Node (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> Split a
splitMiddleN (Int
im Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- FingerTree (Node (Node a)) -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized a => Sized (FingerTree a)
Instance of class: Sized of the constraint type forall a. Sized (Node a)
size FingerTree (Node (Node a))
ml) Int
s Int
spr Digit (Node a)
pr FingerTree (Node (Node a))
ml Node (Node a)
xs FingerTree (Node (Node a))
mr Digit (Node a)
sf
  | Bool
otherwise   = Int
-> Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> Split a
forall a.
Int
-> Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> Split a
splitSuffixN (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
spm) Int
s Digit (Node a)
pr FingerTree (Node (Node a))
m Digit (Node a)
sf  where
    spr :: Int
spr     = Digit (Node a) -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized a => Sized (Digit a)
Instance of class: Sized of the constraint type forall a. Sized (Node a)
size Digit (Node a)
pr
    spm :: Int
spm     = Int
spr Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ FingerTree (Node (Node a)) -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized a => Sized (FingerTree a)
Instance of class: Sized of the constraint type forall a. Sized (Node a)
size FingerTree (Node (Node a))
m
    im :: Int
im      = Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
spr

splitMiddleN :: Int -> Int -> Int
             -> Digit (Node a) -> FingerTree (Node (Node a)) -> Node (Node a) -> FingerTree (Node (Node a)) -> Digit (Node a)
             -> Split a
splitMiddleN :: Int
-> Int
-> Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> Node (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> Split a
splitMiddleN 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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
sa      = FingerTree (Node a) -> Node a -> FingerTree (Node a) -> Split a
forall a.
FingerTree (Node a) -> Node a -> FingerTree (Node a) -> Split a
Split (Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node a)
forall a. Int -> Digit a -> FingerTree (Node a) -> FingerTree a
pullR Int
sprml Digit (Node a)
pr FingerTree (Node (Node a))
ml) Node a
a (Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> FingerTree (Node a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
sprmla) (Node a -> Digit (Node a)
forall a. a -> Digit a
One Node a
b) FingerTree (Node (Node a))
mr Digit (Node a)
sf)
  | Bool
otherwise   = FingerTree (Node a) -> Node a -> FingerTree (Node a) -> Split a
forall a.
FingerTree (Node a) -> Node a -> FingerTree (Node a) -> Split a
Split (Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> FingerTree (Node a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
sprmla Digit (Node a)
pr FingerTree (Node (Node a))
ml (Node a -> Digit (Node a)
forall a. a -> Digit a
One Node a
a)) Node a
b (Int
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> FingerTree (Node a)
forall a. Int -> FingerTree (Node a) -> Digit a -> FingerTree a
pullL (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
sprmla Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Node a -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized (Node a)
size Node a
b) FingerTree (Node (Node a))
mr Digit (Node a)
sf)
  where
    sa :: Int
sa      = Node a -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized (Node a)
size Node a
a
    sprml :: Int
sprml   = Int
spr Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ FingerTree (Node (Node a)) -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized a => Sized (FingerTree a)
Instance of class: Sized of the constraint type forall a. Sized (Node a)
size FingerTree (Node (Node a))
ml
    sprmla :: Int
sprmla  = Int
sa Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ 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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
sa      = FingerTree (Node a) -> Node a -> FingerTree (Node a) -> Split a
forall a.
FingerTree (Node a) -> Node a -> FingerTree (Node a) -> Split a
Split (Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node a)
forall a. Int -> Digit a -> FingerTree (Node a) -> FingerTree a
pullR Int
sprml Digit (Node a)
pr FingerTree (Node (Node a))
ml) Node a
a (Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> FingerTree (Node a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
sprmla) (Node a -> Node a -> Digit (Node a)
forall a. a -> a -> Digit a
Two Node a
b Node a
c) FingerTree (Node (Node a))
mr Digit (Node a)
sf)
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
sab     = FingerTree (Node a) -> Node a -> FingerTree (Node a) -> Split a
forall a.
FingerTree (Node a) -> Node a -> FingerTree (Node a) -> Split a
Split (Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> FingerTree (Node a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
sprmla Digit (Node a)
pr FingerTree (Node (Node a))
ml (Node a -> Digit (Node a)
forall a. a -> Digit a
One Node a
a)) Node a
b (Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> FingerTree (Node a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
sprmlab) (Node a -> Digit (Node a)
forall a. a -> Digit a
One Node a
c) FingerTree (Node (Node a))
mr Digit (Node a)
sf)
  | Bool
otherwise   = FingerTree (Node a) -> Node a -> FingerTree (Node a) -> Split a
forall a.
FingerTree (Node a) -> Node a -> FingerTree (Node a) -> Split a
Split (Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> FingerTree (Node a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
sprmlab Digit (Node a)
pr FingerTree (Node (Node a))
ml (Node a -> Node a -> Digit (Node a)
forall a. a -> a -> Digit a
Two Node a
a Node a
b)) Node a
c (Int
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> FingerTree (Node a)
forall a. Int -> FingerTree (Node a) -> Digit a -> FingerTree a
pullL (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
sprmlab Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Node a -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized (Node a)
size Node a
c) FingerTree (Node (Node a))
mr Digit (Node a)
sf)
  where
    sa :: Int
sa      = Node a -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized (Node a)
size Node a
a
    sab :: Int
sab     = Int
sa Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Node a -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized (Node a)
size Node a
b
    sprml :: Int
sprml   = Int
spr Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ FingerTree (Node (Node a)) -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized a => Sized (FingerTree a)
Instance of class: Sized of the constraint type forall a. Sized (Node a)
size FingerTree (Node (Node a))
ml
    sprmla :: Int
sprmla  = Int
sa Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Int
sprml
    sprmlab :: Int
sprmlab = Int
sprmla Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Node a -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized (Node a)
size Node a
b

splitMiddleE :: Int -> Int -> Int
             -> Digit (Elem a) -> FingerTree (Node (Elem a)) -> Node (Elem a) -> FingerTree (Node (Elem a)) -> Digit (Elem a)
             -> StrictPair (FingerTree (Elem a)) (FingerTree (Elem a))
splitMiddleE :: Int
-> Int
-> Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> Node (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> StrictPair (FingerTree (Elem a)) (FingerTree (Elem a))
splitMiddleE 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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
1       = Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> FingerTree (Elem a)
forall a. Int -> Digit a -> FingerTree (Node a) -> FingerTree a
pullR Int
sprml Digit (Elem a)
pr FingerTree (Node (Elem a))
ml FingerTree (Elem a)
-> FingerTree (Elem a)
-> StrictPair (FingerTree (Elem a)) (FingerTree (Elem a))
forall a b. a -> b -> StrictPair a b
:*: Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> FingerTree (Elem a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
sprml) (Elem a -> Elem a -> Digit (Elem a)
forall a. a -> a -> Digit a
Two Elem a
a Elem a
b) FingerTree (Node (Elem a))
mr Digit (Elem a)
sf
  | Bool
otherwise   = Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> FingerTree (Elem a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
sprmla Digit (Elem a)
pr FingerTree (Node (Elem a))
ml (Elem a -> Digit (Elem a)
forall a. a -> Digit a
One Elem a
a) FingerTree (Elem a)
-> FingerTree (Elem a)
-> StrictPair (FingerTree (Elem a)) (FingerTree (Elem a))
forall a b. a -> b -> StrictPair a b
:*: Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> FingerTree (Elem a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
sprmla) (Elem a -> Digit (Elem a)
forall a. a -> Digit a
One Elem a
b) FingerTree (Node (Elem a))
mr Digit (Elem a)
sf
  where
    sprml :: Int
sprml   = Int
spr Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ FingerTree (Node (Elem a)) -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized a => Sized (FingerTree a)
Instance of class: Sized of the constraint type forall a. Sized (Node a)
size FingerTree (Node (Elem a))
ml
    sprmla :: Int
sprmla  = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ 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 -> Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> FingerTree (Elem a)
forall a. Int -> Digit a -> FingerTree (Node a) -> FingerTree a
pullR Int
sprml Digit (Elem a)
pr FingerTree (Node (Elem a))
ml FingerTree (Elem a)
-> FingerTree (Elem a)
-> StrictPair (FingerTree (Elem a)) (FingerTree (Elem a))
forall a b. a -> b -> StrictPair a b
:*: Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> FingerTree (Elem a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
sprml) (Elem a -> Elem a -> Elem a -> Digit (Elem a)
forall a. a -> a -> a -> Digit a
Three Elem a
a Elem a
b Elem a
c) FingerTree (Node (Elem a))
mr Digit (Elem a)
sf
  Int
1 -> Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> FingerTree (Elem a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
sprmla Digit (Elem a)
pr FingerTree (Node (Elem a))
ml (Elem a -> Digit (Elem a)
forall a. a -> Digit a
One Elem a
a) FingerTree (Elem a)
-> FingerTree (Elem a)
-> StrictPair (FingerTree (Elem a)) (FingerTree (Elem a))
forall a b. a -> b -> StrictPair a b
:*: Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> FingerTree (Elem a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
sprmla) (Elem a -> Elem a -> Digit (Elem a)
forall a. a -> a -> Digit a
Two Elem a
b Elem a
c) FingerTree (Node (Elem a))
mr Digit (Elem a)
sf
  Int
_ -> Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> FingerTree (Elem a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
sprmlab Digit (Elem a)
pr FingerTree (Node (Elem a))
ml (Elem a -> Elem a -> Digit (Elem a)
forall a. a -> a -> Digit a
Two Elem a
a Elem a
b) FingerTree (Elem a)
-> FingerTree (Elem a)
-> StrictPair (FingerTree (Elem a)) (FingerTree (Elem a))
forall a b. a -> b -> StrictPair a b
:*: Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> FingerTree (Elem a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
sprmlab) (Elem a -> Digit (Elem a)
forall a. a -> Digit a
One Elem a
c) FingerTree (Node (Elem a))
mr Digit (Elem a)
sf
  where
    sprml :: Int
sprml   = Int
spr Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ FingerTree (Node (Elem a)) -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized a => Sized (FingerTree a)
Instance of class: Sized of the constraint type forall a. Sized (Node a)
size FingerTree (Node (Elem a))
ml
    sprmla :: Int
sprmla  = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Int
sprml
    sprmlab :: Int
sprmlab = Int
sprmla Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Int
1

splitPrefixE :: Int -> Int -> Digit (Elem a) -> FingerTree (Node (Elem a)) -> Digit (Elem a) ->
                    StrictPair (FingerTree (Elem a)) (FingerTree (Elem a))
splitPrefixE :: Int
-> Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> StrictPair (FingerTree (Elem a)) (FingerTree (Elem a))
splitPrefixE !Int
_i !Int
s (One Elem a
a) FingerTree (Node (Elem a))
m Digit (Elem a)
sf = FingerTree (Elem a)
forall a. FingerTree a
EmptyT FingerTree (Elem a)
-> FingerTree (Elem a)
-> StrictPair (FingerTree (Elem a)) (FingerTree (Elem a))
forall a b. a -> b -> StrictPair a b
:*: Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> FingerTree (Elem a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
s (Elem a -> Digit (Elem a)
forall a. a -> Digit a
One Elem a
a) FingerTree (Node (Elem a))
m Digit (Elem a)
sf
splitPrefixE 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 -> FingerTree (Elem a)
forall a. FingerTree a
EmptyT FingerTree (Elem a)
-> FingerTree (Elem a)
-> StrictPair (FingerTree (Elem a)) (FingerTree (Elem a))
forall a b. a -> b -> StrictPair a b
:*: Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> FingerTree (Elem a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
s (Elem a -> Elem a -> Digit (Elem a)
forall a. a -> a -> Digit a
Two Elem a
a Elem a
b) FingerTree (Node (Elem a))
m Digit (Elem a)
sf
  Int
_ -> Elem a -> FingerTree (Elem a)
forall a. a -> FingerTree a
Single Elem a
a FingerTree (Elem a)
-> FingerTree (Elem a)
-> StrictPair (FingerTree (Elem a)) (FingerTree (Elem a))
forall a b. a -> b -> StrictPair a b
:*: Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> FingerTree (Elem a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
1) (Elem a -> Digit (Elem a)
forall a. a -> Digit a
One Elem a
b) FingerTree (Node (Elem a))
m Digit (Elem a)
sf
splitPrefixE 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 -> FingerTree (Elem a)
forall a. FingerTree a
EmptyT FingerTree (Elem a)
-> FingerTree (Elem a)
-> StrictPair (FingerTree (Elem a)) (FingerTree (Elem a))
forall a b. a -> b -> StrictPair a b
:*: Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> FingerTree (Elem a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
s (Elem a -> Elem a -> Elem a -> Digit (Elem a)
forall a. a -> a -> a -> Digit a
Three Elem a
a Elem a
b Elem a
c) FingerTree (Node (Elem a))
m Digit (Elem a)
sf
  Int
1 -> Elem a -> FingerTree (Elem a)
forall a. a -> FingerTree a
Single Elem a
a FingerTree (Elem a)
-> FingerTree (Elem a)
-> StrictPair (FingerTree (Elem a)) (FingerTree (Elem a))
forall a b. a -> b -> StrictPair a b
:*: Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> FingerTree (Elem a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
1) (Elem a -> Elem a -> Digit (Elem a)
forall a. a -> a -> Digit a
Two Elem a
b Elem a
c) FingerTree (Node (Elem a))
m Digit (Elem a)
sf
  Int
_ -> Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> FingerTree (Elem a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
2 (Elem a -> Digit (Elem a)
forall a. a -> Digit a
One Elem a
a) FingerTree (Node (Elem a))
forall a. FingerTree a
EmptyT (Elem a -> Digit (Elem a)
forall a. a -> Digit a
One Elem a
b) FingerTree (Elem a)
-> FingerTree (Elem a)
-> StrictPair (FingerTree (Elem a)) (FingerTree (Elem a))
forall a b. a -> b -> StrictPair a b
:*: Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> FingerTree (Elem a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
2) (Elem a -> Digit (Elem a)
forall a. a -> Digit a
One Elem a
c) FingerTree (Node (Elem a))
m Digit (Elem a)
sf
splitPrefixE 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 -> FingerTree (Elem a)
forall a. FingerTree a
EmptyT FingerTree (Elem a)
-> FingerTree (Elem a)
-> StrictPair (FingerTree (Elem a)) (FingerTree (Elem a))
forall a b. a -> b -> StrictPair a b
:*: Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> FingerTree (Elem a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
s (Elem a -> Elem a -> Elem a -> Elem a -> Digit (Elem a)
forall a. a -> a -> a -> a -> Digit a
Four Elem a
a Elem a
b Elem a
c Elem a
d) FingerTree (Node (Elem a))
m Digit (Elem a)
sf
  Int
1 -> Elem a -> FingerTree (Elem a)
forall a. a -> FingerTree a
Single Elem a
a FingerTree (Elem a)
-> FingerTree (Elem a)
-> StrictPair (FingerTree (Elem a)) (FingerTree (Elem a))
forall a b. a -> b -> StrictPair a b
:*: Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> FingerTree (Elem a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
1) (Elem a -> Elem a -> Elem a -> Digit (Elem a)
forall a. a -> a -> a -> Digit a
Three Elem a
b Elem a
c Elem a
d) FingerTree (Node (Elem a))
m Digit (Elem a)
sf
  Int
2 -> Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> FingerTree (Elem a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
2 (Elem a -> Digit (Elem a)
forall a. a -> Digit a
One Elem a
a) FingerTree (Node (Elem a))
forall a. FingerTree a
EmptyT (Elem a -> Digit (Elem a)
forall a. a -> Digit a
One Elem a
b) FingerTree (Elem a)
-> FingerTree (Elem a)
-> StrictPair (FingerTree (Elem a)) (FingerTree (Elem a))
forall a b. a -> b -> StrictPair a b
:*: Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> FingerTree (Elem a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
2) (Elem a -> Elem a -> Digit (Elem a)
forall a. a -> a -> Digit a
Two Elem a
c Elem a
d) FingerTree (Node (Elem a))
m Digit (Elem a)
sf
  Int
_ -> Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> FingerTree (Elem a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
3 (Elem a -> Elem a -> Digit (Elem a)
forall a. a -> a -> Digit a
Two Elem a
a Elem a
b) FingerTree (Node (Elem a))
forall a. FingerTree a
EmptyT (Elem a -> Digit (Elem a)
forall a. a -> Digit a
One Elem a
c) FingerTree (Elem a)
-> FingerTree (Elem a)
-> StrictPair (FingerTree (Elem a)) (FingerTree (Elem a))
forall a b. a -> b -> StrictPair a b
:*: Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> FingerTree (Elem a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
3) (Elem a -> Digit (Elem a)
forall a. a -> Digit a
One Elem a
d) FingerTree (Node (Elem a))
m Digit (Elem a)
sf

splitPrefixN :: Int -> Int -> Digit (Node a) -> FingerTree (Node (Node a)) -> Digit (Node a) ->
                    Split a
splitPrefixN :: Int
-> Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> Split a
splitPrefixN !Int
_i !Int
s (One Node a
a) FingerTree (Node (Node a))
m Digit (Node a)
sf = FingerTree (Node a) -> Node a -> FingerTree (Node a) -> Split a
forall a.
FingerTree (Node a) -> Node a -> FingerTree (Node a) -> Split a
Split FingerTree (Node a)
forall a. FingerTree a
EmptyT Node a
a (Int
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> FingerTree (Node a)
forall a. Int -> FingerTree (Node a) -> Digit a -> FingerTree a
pullL (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Node a -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized (Node a)
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
sa      = FingerTree (Node a) -> Node a -> FingerTree (Node a) -> Split a
forall a.
FingerTree (Node a) -> Node a -> FingerTree (Node a) -> Split a
Split FingerTree (Node a)
forall a. FingerTree a
EmptyT Node a
a (Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> FingerTree (Node a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
sa) (Node a -> Digit (Node a)
forall a. a -> Digit a
One Node a
b) FingerTree (Node (Node a))
m Digit (Node a)
sf)
  | Bool
otherwise   = FingerTree (Node a) -> Node a -> FingerTree (Node a) -> Split a
forall a.
FingerTree (Node a) -> Node a -> FingerTree (Node a) -> Split a
Split (Node a -> FingerTree (Node a)
forall a. a -> FingerTree a
Single Node a
a) Node a
b (Int
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> FingerTree (Node a)
forall a. Int -> FingerTree (Node a) -> Digit a -> FingerTree a
pullL (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
sa Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Node a -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized (Node a)
size Node a
b) FingerTree (Node (Node a))
m Digit (Node a)
sf)
  where
    sa :: Int
sa      = Node a -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized (Node a)
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
sa      = FingerTree (Node a) -> Node a -> FingerTree (Node a) -> Split a
forall a.
FingerTree (Node a) -> Node a -> FingerTree (Node a) -> Split a
Split FingerTree (Node a)
forall a. FingerTree a
EmptyT Node a
a (Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> FingerTree (Node a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
sa) (Node a -> Node a -> Digit (Node a)
forall a. a -> a -> Digit a
Two Node a
b Node a
c) FingerTree (Node (Node a))
m Digit (Node a)
sf)
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
sab     = FingerTree (Node a) -> Node a -> FingerTree (Node a) -> Split a
forall a.
FingerTree (Node a) -> Node a -> FingerTree (Node a) -> Split a
Split (Node a -> FingerTree (Node a)
forall a. a -> FingerTree a
Single Node a
a) Node a
b (Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> FingerTree (Node a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
sab) (Node a -> Digit (Node a)
forall a. a -> Digit a
One Node a
c) FingerTree (Node (Node a))
m Digit (Node a)
sf)
  | Bool
otherwise   = FingerTree (Node a) -> Node a -> FingerTree (Node a) -> Split a
forall a.
FingerTree (Node a) -> Node a -> FingerTree (Node a) -> Split a
Split (Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> FingerTree (Node a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
sab (Node a -> Digit (Node a)
forall a. a -> Digit a
One Node a
a) FingerTree (Node (Node a))
forall a. FingerTree a
EmptyT (Node a -> Digit (Node a)
forall a. a -> Digit a
One Node a
b)) Node a
c (Int
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> FingerTree (Node a)
forall a. Int -> FingerTree (Node a) -> Digit a -> FingerTree a
pullL (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
sab Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Node a -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized (Node a)
size Node a
c) FingerTree (Node (Node a))
m Digit (Node a)
sf)
  where
    sa :: Int
sa      = Node a -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized (Node a)
size Node a
a
    sab :: Int
sab     = Int
sa Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Node a -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized (Node a)
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
sa      = FingerTree (Node a) -> Node a -> FingerTree (Node a) -> Split a
forall a.
FingerTree (Node a) -> Node a -> FingerTree (Node a) -> Split a
Split FingerTree (Node a)
forall a. FingerTree a
EmptyT Node a
a (FingerTree (Node a) -> Split a) -> FingerTree (Node a) -> Split a
forall a b. (a -> b) -> a -> b
$ Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> FingerTree (Node a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
sa) (Node a -> Node a -> Node a -> Digit (Node a)
forall a. a -> a -> a -> Digit a
Three Node a
b Node a
c Node a
d) FingerTree (Node (Node a))
m Digit (Node a)
sf
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
sab     = FingerTree (Node a) -> Node a -> FingerTree (Node a) -> Split a
forall a.
FingerTree (Node a) -> Node a -> FingerTree (Node a) -> Split a
Split (Node a -> FingerTree (Node a)
forall a. a -> FingerTree a
Single Node a
a) Node a
b (FingerTree (Node a) -> Split a) -> FingerTree (Node a) -> Split a
forall a b. (a -> b) -> a -> b
$ Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> FingerTree (Node a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
sab) (Node a -> Node a -> Digit (Node a)
forall a. a -> a -> Digit a
Two Node a
c Node a
d) FingerTree (Node (Node a))
m Digit (Node a)
sf
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
sabc    = FingerTree (Node a) -> Node a -> FingerTree (Node a) -> Split a
forall a.
FingerTree (Node a) -> Node a -> FingerTree (Node a) -> Split a
Split (Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> FingerTree (Node a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
sab (Node a -> Digit (Node a)
forall a. a -> Digit a
One Node a
a) FingerTree (Node (Node a))
forall a. FingerTree a
EmptyT (Node a -> Digit (Node a)
forall a. a -> Digit a
One Node a
b)) Node a
c (FingerTree (Node a) -> Split a) -> FingerTree (Node a) -> Split a
forall a b. (a -> b) -> a -> b
$ Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> FingerTree (Node a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
sabc) (Node a -> Digit (Node a)
forall a. a -> Digit a
One Node a
d) FingerTree (Node (Node a))
m Digit (Node a)
sf
  | Bool
otherwise   = FingerTree (Node a) -> Node a -> FingerTree (Node a) -> Split a
forall a.
FingerTree (Node a) -> Node a -> FingerTree (Node a) -> Split a
Split (Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> FingerTree (Node a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
sabc (Node a -> Node a -> Digit (Node a)
forall a. a -> a -> Digit a
Two Node a
a Node a
b) FingerTree (Node (Node a))
forall a. FingerTree a
EmptyT (Node a -> Digit (Node a)
forall a. a -> Digit a
One Node a
c)) Node a
d (FingerTree (Node a) -> Split a) -> FingerTree (Node a) -> Split a
forall a b. (a -> b) -> a -> b
$ Int
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> FingerTree (Node a)
forall a. Int -> FingerTree (Node a) -> Digit a -> FingerTree a
pullL (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
sabc Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Node a -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized (Node a)
size Node a
d) FingerTree (Node (Node a))
m Digit (Node a)
sf
  where
    sa :: Int
sa      = Node a -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized (Node a)
size Node a
a
    sab :: Int
sab     = Int
sa Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Node a -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized (Node a)
size Node a
b
    sabc :: Int
sabc    = Int
sab Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Node a -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized (Node a)
size Node a
c

splitSuffixE :: Int -> Int -> Digit (Elem a) -> FingerTree (Node (Elem a)) -> Digit (Elem a) ->
   StrictPair (FingerTree (Elem a)) (FingerTree (Elem a))
splitSuffixE :: Int
-> Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> StrictPair (FingerTree (Elem a)) (FingerTree (Elem a))
splitSuffixE !Int
_i !Int
s Digit (Elem a)
pr FingerTree (Node (Elem a))
m (One Elem a
a) = Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> FingerTree (Elem a)
forall a. Int -> Digit a -> FingerTree (Node a) -> FingerTree a
pullR (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
1) Digit (Elem a)
pr FingerTree (Node (Elem a))
m FingerTree (Elem a)
-> FingerTree (Elem a)
-> StrictPair (FingerTree (Elem a)) (FingerTree (Elem a))
forall a b. a -> b -> StrictPair a b
:*: Elem a -> FingerTree (Elem a)
forall a. a -> FingerTree a
Single Elem a
a
splitSuffixE 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 -> Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> FingerTree (Elem a)
forall a. Int -> Digit a -> FingerTree (Node a) -> FingerTree a
pullR (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
2) Digit (Elem a)
pr FingerTree (Node (Elem a))
m FingerTree (Elem a)
-> FingerTree (Elem a)
-> StrictPair (FingerTree (Elem a)) (FingerTree (Elem a))
forall a b. a -> b -> StrictPair a b
:*: Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> FingerTree (Elem a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
2 (Elem a -> Digit (Elem a)
forall a. a -> Digit a
One Elem a
a) FingerTree (Node (Elem a))
forall a. FingerTree a
EmptyT (Elem a -> Digit (Elem a)
forall a. a -> Digit a
One Elem a
b)
  Int
_ -> Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> FingerTree (Elem a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
1) Digit (Elem a)
pr FingerTree (Node (Elem a))
m (Elem a -> Digit (Elem a)
forall a. a -> Digit a
One Elem a
a) FingerTree (Elem a)
-> FingerTree (Elem a)
-> StrictPair (FingerTree (Elem a)) (FingerTree (Elem a))
forall a b. a -> b -> StrictPair a b
:*: Elem a -> FingerTree (Elem a)
forall a. a -> FingerTree a
Single Elem a
b
splitSuffixE 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 -> Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> FingerTree (Elem a)
forall a. Int -> Digit a -> FingerTree (Node a) -> FingerTree a
pullR (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
3) Digit (Elem a)
pr FingerTree (Node (Elem a))
m FingerTree (Elem a)
-> FingerTree (Elem a)
-> StrictPair (FingerTree (Elem a)) (FingerTree (Elem a))
forall a b. a -> b -> StrictPair a b
:*: Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> FingerTree (Elem a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
3 (Elem a -> Elem a -> Digit (Elem a)
forall a. a -> a -> Digit a
Two Elem a
a Elem a
b) FingerTree (Node (Elem a))
forall a. FingerTree a
EmptyT (Elem a -> Digit (Elem a)
forall a. a -> Digit a
One Elem a
c)
  Int
1 -> Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> FingerTree (Elem a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
2) Digit (Elem a)
pr FingerTree (Node (Elem a))
m (Elem a -> Digit (Elem a)
forall a. a -> Digit a
One Elem a
a) FingerTree (Elem a)
-> FingerTree (Elem a)
-> StrictPair (FingerTree (Elem a)) (FingerTree (Elem a))
forall a b. a -> b -> StrictPair a b
:*: Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> FingerTree (Elem a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
2 (Elem a -> Digit (Elem a)
forall a. a -> Digit a
One Elem a
b) FingerTree (Node (Elem a))
forall a. FingerTree a
EmptyT (Elem a -> Digit (Elem a)
forall a. a -> Digit a
One Elem a
c)
  Int
_ -> Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> FingerTree (Elem a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
1) Digit (Elem a)
pr FingerTree (Node (Elem a))
m (Elem a -> Elem a -> Digit (Elem a)
forall a. a -> a -> Digit a
Two Elem a
a Elem a
b) FingerTree (Elem a)
-> FingerTree (Elem a)
-> StrictPair (FingerTree (Elem a)) (FingerTree (Elem a))
forall a b. a -> b -> StrictPair a b
:*: Elem a -> FingerTree (Elem a)
forall a. a -> FingerTree a
Single Elem a
c
splitSuffixE 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 -> Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> FingerTree (Elem a)
forall a. Int -> Digit a -> FingerTree (Node a) -> FingerTree a
pullR (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
4) Digit (Elem a)
pr FingerTree (Node (Elem a))
m FingerTree (Elem a)
-> FingerTree (Elem a)
-> StrictPair (FingerTree (Elem a)) (FingerTree (Elem a))
forall a b. a -> b -> StrictPair a b
:*: Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> FingerTree (Elem a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
4 (Elem a -> Elem a -> Digit (Elem a)
forall a. a -> a -> Digit a
Two Elem a
a Elem a
b) FingerTree (Node (Elem a))
forall a. FingerTree a
EmptyT (Elem a -> Elem a -> Digit (Elem a)
forall a. a -> a -> Digit a
Two Elem a
c Elem a
d)
  Int
1 -> Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> FingerTree (Elem a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
3) Digit (Elem a)
pr FingerTree (Node (Elem a))
m (Elem a -> Digit (Elem a)
forall a. a -> Digit a
One Elem a
a) FingerTree (Elem a)
-> FingerTree (Elem a)
-> StrictPair (FingerTree (Elem a)) (FingerTree (Elem a))
forall a b. a -> b -> StrictPair a b
:*: Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> FingerTree (Elem a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
3 (Elem a -> Elem a -> Digit (Elem a)
forall a. a -> a -> Digit a
Two Elem a
b Elem a
c) FingerTree (Node (Elem a))
forall a. FingerTree a
EmptyT (Elem a -> Digit (Elem a)
forall a. a -> Digit a
One Elem a
d)
  Int
2 -> Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> FingerTree (Elem a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
2) Digit (Elem a)
pr FingerTree (Node (Elem a))
m (Elem a -> Elem a -> Digit (Elem a)
forall a. a -> a -> Digit a
Two Elem a
a Elem a
b) FingerTree (Elem a)
-> FingerTree (Elem a)
-> StrictPair (FingerTree (Elem a)) (FingerTree (Elem a))
forall a b. a -> b -> StrictPair a b
:*: Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> FingerTree (Elem a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
2 (Elem a -> Digit (Elem a)
forall a. a -> Digit a
One Elem a
c) FingerTree (Node (Elem a))
forall a. FingerTree a
EmptyT (Elem a -> Digit (Elem a)
forall a. a -> Digit a
One Elem a
d)
  Int
_ -> Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> FingerTree (Elem a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
1) Digit (Elem a)
pr FingerTree (Node (Elem a))
m (Elem a -> Elem a -> Elem a -> Digit (Elem a)
forall a. a -> a -> a -> Digit a
Three Elem a
a Elem a
b Elem a
c) FingerTree (Elem a)
-> FingerTree (Elem a)
-> StrictPair (FingerTree (Elem a)) (FingerTree (Elem a))
forall a b. a -> b -> StrictPair a b
:*: Elem a -> FingerTree (Elem a)
forall a. a -> FingerTree a
Single Elem a
d

splitSuffixN :: Int -> Int -> Digit (Node a) -> FingerTree (Node (Node a)) -> Digit (Node a) ->
   Split a
splitSuffixN :: Int
-> Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> Split a
splitSuffixN !Int
_i !Int
s Digit (Node a)
pr FingerTree (Node (Node a))
m (One Node a
a) = FingerTree (Node a) -> Node a -> FingerTree (Node a) -> Split a
forall a.
FingerTree (Node a) -> Node a -> FingerTree (Node a) -> Split a
Split (Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node a)
forall a. Int -> Digit a -> FingerTree (Node a) -> FingerTree a
pullR (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Node a -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized (Node a)
size Node a
a) Digit (Node a)
pr FingerTree (Node (Node a))
m) Node a
a FingerTree (Node a)
forall a. FingerTree a
EmptyT
splitSuffixN Int
i Int
s Digit (Node a)
pr FingerTree (Node (Node a))
m (Two Node a
a Node a
b)
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
sa      = FingerTree (Node a) -> Node a -> FingerTree (Node a) -> Split a
forall a.
FingerTree (Node a) -> Node a -> FingerTree (Node a) -> Split a
Split (Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node a)
forall a. Int -> Digit a -> FingerTree (Node a) -> FingerTree a
pullR (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
sa Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Node a -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized (Node a)
size Node a
b) Digit (Node a)
pr FingerTree (Node (Node a))
m) Node a
a (Node a -> FingerTree (Node a)
forall a. a -> FingerTree a
Single Node a
b)
  | Bool
otherwise   = FingerTree (Node a) -> Node a -> FingerTree (Node a) -> Split a
forall a.
FingerTree (Node a) -> Node a -> FingerTree (Node a) -> Split a
Split (Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> FingerTree (Node a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Node a -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized (Node a)
size Node a
b) Digit (Node a)
pr FingerTree (Node (Node a))
m (Node a -> Digit (Node a)
forall a. a -> Digit a
One Node a
a)) Node a
b FingerTree (Node a)
forall a. FingerTree a
EmptyT
  where
    sa :: Int
sa      = Node a -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized (Node a)
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
sa      = FingerTree (Node a) -> Node a -> FingerTree (Node a) -> Split a
forall a.
FingerTree (Node a) -> Node a -> FingerTree (Node a) -> Split a
Split (Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node a)
forall a. Int -> Digit a -> FingerTree (Node a) -> FingerTree a
pullR (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
sab Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Node a -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized (Node a)
size Node a
c) Digit (Node a)
pr FingerTree (Node (Node a))
m) Node a
a (Digit (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> FingerTree (Node a)
forall a.
Sized a =>
Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
deep (Node a -> Digit (Node a)
forall a. a -> Digit a
One Node a
b) FingerTree (Node (Node a))
forall a. FingerTree a
EmptyT (Node a -> Digit (Node a)
forall a. a -> Digit a
One Node a
c))
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
sab     = FingerTree (Node a) -> Node a -> FingerTree (Node a) -> Split a
forall a.
FingerTree (Node a) -> Node a -> FingerTree (Node a) -> Split a
Split (Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> FingerTree (Node a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Node a -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized (Node a)
size Node a
b Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Node a -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized (Node a)
size Node a
c) Digit (Node a)
pr FingerTree (Node (Node a))
m (Node a -> Digit (Node a)
forall a. a -> Digit a
One Node a
a)) Node a
b (Node a -> FingerTree (Node a)
forall a. a -> FingerTree a
Single Node a
c)
  | Bool
otherwise   = FingerTree (Node a) -> Node a -> FingerTree (Node a) -> Split a
forall a.
FingerTree (Node a) -> Node a -> FingerTree (Node a) -> Split a
Split (Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> FingerTree (Node a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Node a -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized (Node a)
size Node a
c) Digit (Node a)
pr FingerTree (Node (Node a))
m (Node a -> Node a -> Digit (Node a)
forall a. a -> a -> Digit a
Two Node a
a Node a
b)) Node a
c FingerTree (Node a)
forall a. FingerTree a
EmptyT
  where
    sa :: Int
sa      = Node a -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized (Node a)
size Node a
a
    sab :: Int
sab     = Int
sa Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Node a -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized (Node a)
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
sa      = FingerTree (Node a) -> Node a -> FingerTree (Node a) -> Split a
forall a.
FingerTree (Node a) -> Node a -> FingerTree (Node a) -> Split a
Split (Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> FingerTree (Node a)
forall a. Int -> Digit a -> FingerTree (Node a) -> FingerTree a
pullR (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
sa Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
sbcd) Digit (Node a)
pr FingerTree (Node (Node a))
m) Node a
a (Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> FingerTree (Node a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
sbcd (Node a -> Node a -> Digit (Node a)
forall a. a -> a -> Digit a
Two Node a
b Node a
c) FingerTree (Node (Node a))
forall a. FingerTree a
EmptyT (Node a -> Digit (Node a)
forall a. a -> Digit a
One Node a
d))
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
sab     = FingerTree (Node a) -> Node a -> FingerTree (Node a) -> Split a
forall a.
FingerTree (Node a) -> Node a -> FingerTree (Node a) -> Split a
Split (Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> FingerTree (Node a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
sbcd) Digit (Node a)
pr FingerTree (Node (Node a))
m (Node a -> Digit (Node a)
forall a. a -> Digit a
One Node a
a)) Node a
b (Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> FingerTree (Node a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
scd (Node a -> Digit (Node a)
forall a. a -> Digit a
One Node a
c) FingerTree (Node (Node a))
forall a. FingerTree a
EmptyT (Node a -> Digit (Node a)
forall a. a -> Digit a
One Node a
d))
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
sabc    = FingerTree (Node a) -> Node a -> FingerTree (Node a) -> Split a
forall a.
FingerTree (Node a) -> Node a -> FingerTree (Node a) -> Split a
Split (Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> FingerTree (Node a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
scd) Digit (Node a)
pr FingerTree (Node (Node a))
m (Node a -> Node a -> Digit (Node a)
forall a. a -> a -> Digit a
Two Node a
a Node a
b)) Node a
c (Node a -> FingerTree (Node a)
forall a. a -> FingerTree a
Single Node a
d)
  | Bool
otherwise   = FingerTree (Node a) -> Node a -> FingerTree (Node a) -> Split a
forall a.
FingerTree (Node a) -> Node a -> FingerTree (Node a) -> Split a
Split (Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> FingerTree (Node a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
sd) Digit (Node a)
pr FingerTree (Node (Node a))
m (Node a -> Node a -> Node a -> Digit (Node a)
forall a. a -> a -> a -> Digit a
Three Node a
a Node a
b Node a
c)) Node a
d FingerTree (Node a)
forall a. FingerTree a
EmptyT
  where
    sa :: Int
sa      = Node a -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized (Node a)
size Node a
a
    sab :: Int
sab     = Int
sa Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Node a -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized (Node a)
size Node a
b
    sabc :: Int
sabc    = Int
sab Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Node a -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized (Node a)
size Node a
c
    sd :: Int
sd      = Node a -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized (Node a)
size Node a
d
    scd :: Int
scd     = Node a -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized (Node a)
size Node a
c Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Int
sd
    sbcd :: Int
sbcd    = Node a -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized (Node a)
size Node a
b Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Int
scd

-- | \(O \Bigl(\bigl(\frac{n}{c}\bigr) \log c\Bigr)\). @chunksOf c xs@ splits @xs@ into chunks of size @c>0@.
-- If @c@ does not divide the length of @xs@ evenly, then the last element
-- of the result will be short.
--
-- Side note: the given performance bound is missing some messy terms that only
-- really affect edge cases. Performance degrades smoothly from \( O(1) \) (for
-- \( c = n \)) to \( O(n) \) (for \( c = 1 \)). The true bound is more like
-- \( O \Bigl( \bigl(\frac{n}{c} - 1\bigr) (\log (c + 1)) + 1 \Bigr) \)
--
-- @since 0.5.8
chunksOf :: Int -> Seq a -> Seq (Seq a)
chunksOf :: Int -> Seq a -> Seq (Seq a)
chunksOf Int
n Seq a
xs | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
<= Int
0 =
  if Seq a -> Bool
forall a. Seq a -> Bool
null Seq a
xs
    then Seq (Seq a)
forall a. Seq a
empty
    else [Char] -> Seq (Seq a)
forall a. HasCallStack => [Char] -> a
error [Char]
"chunksOf: A non-empty sequence can only be broken up into positively-sized chunks."
chunksOf Int
1 Seq a
s = (a -> Seq a) -> Seq a -> Seq (Seq a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Instance of class: Functor of the constraint type Functor Seq
fmap a -> Seq a
forall a. a -> Seq a
singleton Seq a
s
chunksOf Int
n Seq a
s = (Int -> Seq a -> (Seq a, Seq a))
-> (Seq a -> () -> Seq a) -> Seq a -> Seq () -> Seq (Seq a)
forall s a' b'.
(Int -> s -> (s, s)) -> (s -> a' -> b') -> s -> Seq a' -> Seq b'
splitMap (Int -> Seq a -> (Seq a, Seq a)
forall a. Int -> Seq a -> (Seq a, Seq a)
uncheckedSplitAt (Int -> Seq a -> (Seq a, Seq a))
-> (Int -> Int) -> Int -> Seq a -> (Seq a, Seq a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
*Int
n)) Seq a -> () -> Seq a
forall a b. a -> b -> a
const Seq a
most (Int -> () -> Seq ()
forall a. Int -> a -> Seq a
replicate Int
numReps ())
                 Seq (Seq a) -> Seq (Seq a) -> Seq (Seq a)
forall a. Seq a -> Seq a -> Seq a
>< if Seq a -> Bool
forall a. Seq a -> Bool
null Seq a
end then Seq (Seq a)
forall a. Seq a
empty else Seq a -> Seq (Seq a)
forall a. a -> Seq a
singleton Seq a
end
  where
    (Int
numReps, Int
endLength) = Seq a -> Int
forall a. Seq a -> Int
length Seq a
s Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
External instance of the constraint type Integral Int
`quotRem` Int
n
    (Seq a
most, Seq a
end) = Int -> Seq a -> (Seq a, Seq a)
forall a. Int -> Seq a -> (Seq a, Seq a)
splitAt (Seq a -> Int
forall a. Seq a -> Int
length Seq a
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
endLength) Seq a
s

-- | \( O(n) \).  Returns a sequence of all suffixes of this sequence,
-- longest first.  For example,
--
-- > tails (fromList "abc") = fromList [fromList "abc", fromList "bc", fromList "c", fromList ""]
--
-- Evaluating the \( i \)th suffix takes \( O(\log(\min(i, n-i))) \), but evaluating
-- every suffix in the sequence takes \( O(n) \) due to sharing.
tails                   :: Seq a -> Seq (Seq a)
tails :: Seq a -> Seq (Seq a)
tails (Seq FingerTree (Elem a)
xs)          = FingerTree (Elem (Seq a)) -> Seq (Seq a)
forall a. FingerTree (Elem a) -> Seq a
Seq ((FingerTree (Elem a) -> Elem (Seq a))
-> FingerTree (Elem a) -> FingerTree (Elem (Seq a))
forall a b.
Sized a =>
(FingerTree a -> b) -> FingerTree a -> FingerTree b
Instance of class: Sized of the constraint type forall a. Sized (Elem a)
tailsTree (Seq a -> Elem (Seq a)
forall a. a -> Elem a
Elem (Seq a -> Elem (Seq a))
-> (FingerTree (Elem a) -> Seq a)
-> FingerTree (Elem a)
-> Elem (Seq a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FingerTree (Elem a) -> Seq a
forall a. FingerTree (Elem a) -> Seq a
Seq) FingerTree (Elem a)
xs) Seq (Seq a) -> Seq a -> Seq (Seq a)
forall a. Seq a -> a -> Seq a
|> Seq a
forall a. Seq a
empty

-- | \( O(n) \).  Returns a sequence of all prefixes of this sequence,
-- shortest first.  For example,
--
-- > inits (fromList "abc") = fromList [fromList "", fromList "a", fromList "ab", fromList "abc"]
--
-- Evaluating the \( i \)th prefix takes \( O(\log(\min(i, n-i))) \), but evaluating
-- every prefix in the sequence takes \( O(n) \) due to sharing.
inits                   :: Seq a -> Seq (Seq a)
inits :: Seq a -> Seq (Seq a)
inits (Seq FingerTree (Elem a)
xs)          = Seq a
forall a. Seq a
empty Seq a -> Seq (Seq a) -> Seq (Seq a)
forall a. a -> Seq a -> Seq a
<| FingerTree (Elem (Seq a)) -> Seq (Seq a)
forall a. FingerTree (Elem a) -> Seq a
Seq ((FingerTree (Elem a) -> Elem (Seq a))
-> FingerTree (Elem a) -> FingerTree (Elem (Seq a))
forall a b.
Sized a =>
(FingerTree a -> b) -> FingerTree a -> FingerTree b
Instance of class: Sized of the constraint type forall a. Sized (Elem a)
initsTree (Seq a -> Elem (Seq a)
forall a. a -> Elem a
Elem (Seq a -> Elem (Seq a))
-> (FingerTree (Elem a) -> Seq a)
-> FingerTree (Elem a)
-> Elem (Seq a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FingerTree (Elem a) -> Seq a
forall a. FingerTree (Elem a) -> Seq a
Seq) FingerTree (Elem a)
xs)

-- This implementation of tails (and, analogously, inits) has the
-- following algorithmic advantages:
--      Evaluating each tail in the sequence takes linear total time,
--      which is better than we could say for
--              @fromList [drop n xs | n <- [0..length xs]]@.
--      Evaluating any individual tail takes logarithmic time, which is
--      better than we can say for either
--              @scanr (<|) empty xs@ or @iterateN (length xs + 1) (\ xs -> let _ :< xs' = viewl xs in xs') xs@.
--
-- Moreover, if we actually look at every tail in the sequence, the
-- following benchmarks demonstrate that this implementation is modestly
-- faster than any of the above:
--
-- Times (ms)
--               min      mean    +/-sd    median    max
-- Seq.tails:   21.986   24.961   10.169   22.417   86.485
-- scanr:       85.392   87.942    2.488   87.425  100.217
-- iterateN:       29.952   31.245    1.574   30.412   37.268
--
-- The algorithm for tails (and, analogously, inits) is as follows:
--
-- A Node in the FingerTree of tails is constructed by evaluating the
-- corresponding tail of the FingerTree of Nodes, considering the first
-- Node in this tail, and constructing a Node in which each tail of this
-- Node is made to be the prefix of the remaining tree.  This ends up
-- working quite elegantly, as the remainder of the tail of the FingerTree
-- of Nodes becomes the middle of a new tail, the suffix of the Node is
-- the prefix, and the suffix of the original tree is retained.
--
-- In particular, evaluating the /i/th tail involves making as
-- many partial evaluations as the Node depth of the /i/th element.
-- In addition, when we evaluate the /i/th tail, and we also evaluate
-- the /j/th tail, and /m/ Nodes are on the path to both /i/ and /j/,
-- each of those /m/ evaluations are shared between the computation of
-- the /i/th and /j/th tails.
--
-- wasserman.louis@gmail.com, 7/16/09

tailsDigit :: Digit a -> Digit (Digit a)
tailsDigit :: Digit a -> Digit (Digit a)
tailsDigit (One a
a) = Digit a -> Digit (Digit a)
forall a. a -> Digit a
One (a -> Digit a
forall a. a -> Digit a
One a
a)
tailsDigit (Two a
a a
b) = Digit a -> Digit a -> Digit (Digit a)
forall a. a -> a -> Digit a
Two (a -> a -> Digit a
forall a. a -> a -> Digit a
Two a
a a
b) (a -> Digit a
forall a. a -> Digit a
One a
b)
tailsDigit (Three a
a a
b a
c) = Digit a -> Digit a -> Digit a -> Digit (Digit a)
forall a. a -> a -> a -> Digit a
Three (a -> a -> a -> Digit a
forall a. a -> a -> a -> Digit a
Three a
a a
b a
c) (a -> a -> Digit a
forall a. a -> a -> Digit a
Two a
b a
c) (a -> Digit a
forall a. a -> Digit a
One a
c)
tailsDigit (Four a
a a
b a
c a
d) = Digit a -> Digit a -> Digit a -> Digit a -> Digit (Digit a)
forall a. a -> a -> a -> a -> Digit a
Four (a -> a -> a -> a -> Digit a
forall a. a -> a -> a -> a -> Digit a
Four a
a a
b a
c a
d) (a -> a -> a -> Digit a
forall a. a -> a -> a -> Digit a
Three a
b a
c a
d) (a -> a -> Digit a
forall a. a -> a -> Digit a
Two a
c a
d) (a -> Digit a
forall a. a -> Digit a
One a
d)

initsDigit :: Digit a -> Digit (Digit a)
initsDigit :: Digit a -> Digit (Digit a)
initsDigit (One a
a) = Digit a -> Digit (Digit a)
forall a. a -> Digit a
One (a -> Digit a
forall a. a -> Digit a
One a
a)
initsDigit (Two a
a a
b) = Digit a -> Digit a -> Digit (Digit a)
forall a. a -> a -> Digit a
Two (a -> Digit a
forall a. a -> Digit a
One a
a) (a -> a -> Digit a
forall a. a -> a -> Digit a
Two a
a a
b)
initsDigit (Three a
a a
b a
c) = Digit a -> Digit a -> Digit a -> Digit (Digit a)
forall a. a -> a -> a -> Digit a
Three (a -> Digit a
forall a. a -> Digit a
One a
a) (a -> a -> Digit a
forall a. a -> a -> Digit a
Two a
a a
b) (a -> a -> a -> Digit a
forall a. a -> a -> a -> Digit a
Three a
a a
b a
c)
initsDigit (Four a
a a
b a
c a
d) = Digit a -> Digit a -> Digit a -> Digit a -> Digit (Digit a)
forall a. a -> a -> a -> a -> Digit a
Four (a -> Digit a
forall a. a -> Digit a
One a
a) (a -> a -> Digit a
forall a. a -> a -> Digit a
Two a
a a
b) (a -> a -> a -> Digit a
forall a. a -> a -> a -> Digit a
Three a
a a
b a
c) (a -> a -> a -> a -> Digit a
forall a. a -> a -> a -> a -> Digit a
Four a
a a
b a
c a
d)

tailsNode :: Node a -> Node (Digit a)
tailsNode :: Node a -> Node (Digit a)
tailsNode (Node2 Int
s a
a a
b) = Int -> Digit a -> Digit a -> Node (Digit a)
forall a. Int -> a -> a -> Node a
Node2 Int
s (a -> a -> Digit a
forall a. a -> a -> Digit a
Two a
a a
b) (a -> Digit a
forall a. a -> Digit a
One a
b)
tailsNode (Node3 Int
s a
a a
b a
c) = Int -> Digit a -> Digit a -> Digit a -> Node (Digit a)
forall a. Int -> a -> a -> a -> Node a
Node3 Int
s (a -> a -> a -> Digit a
forall a. a -> a -> a -> Digit a
Three a
a a
b a
c) (a -> a -> Digit a
forall a. a -> a -> Digit a
Two a
b a
c) (a -> Digit a
forall a. a -> Digit a
One a
c)

initsNode :: Node a -> Node (Digit a)
initsNode :: Node a -> Node (Digit a)
initsNode (Node2 Int
s a
a a
b) = Int -> Digit a -> Digit a -> Node (Digit a)
forall a. Int -> a -> a -> Node a
Node2 Int
s (a -> Digit a
forall a. a -> Digit a
One a
a) (a -> a -> Digit a
forall a. a -> a -> Digit a
Two a
a a
b)
initsNode (Node3 Int
s a
a a
b a
c) = Int -> Digit a -> Digit a -> Digit a -> Node (Digit a)
forall a. Int -> a -> a -> a -> Node a
Node3 Int
s (a -> Digit a
forall a. a -> Digit a
One a
a) (a -> a -> Digit a
forall a. a -> a -> Digit a
Two a
a a
b) (a -> a -> a -> Digit a
forall a. a -> a -> a -> Digit a
Three a
a a
b a
c)

{-# SPECIALIZE tailsTree :: (FingerTree (Elem a) -> Elem b) -> FingerTree (Elem a) -> FingerTree (Elem b) #-}
{-# SPECIALIZE tailsTree :: (FingerTree (Node a) -> Node b) -> FingerTree (Node a) -> FingerTree (Node b) #-}
-- | Given a function to apply to tails of a tree, applies that function
-- to every tail of the specified tree.
tailsTree :: Sized a => (FingerTree a -> b) -> FingerTree a -> FingerTree b
tailsTree :: (FingerTree a -> b) -> FingerTree a -> FingerTree b
tailsTree FingerTree a -> b
_ FingerTree a
EmptyT = FingerTree b
forall a. FingerTree a
EmptyT
tailsTree FingerTree a -> b
f (Single a
x) = b -> FingerTree b
forall a. a -> FingerTree a
Single (FingerTree a -> b
f (a -> FingerTree a
forall a. a -> FingerTree a
Single a
x))
tailsTree FingerTree a -> b
f (Deep Int
n Digit a
pr FingerTree (Node a)
m Digit a
sf) =
    Int -> Digit b -> FingerTree (Node b) -> Digit b -> FingerTree b
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
n ((Digit a -> b) -> Digit (Digit a) -> Digit b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Instance of class: Functor of the constraint type Functor Digit
fmap (\ Digit a
pr' -> FingerTree a -> b
f (Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
forall a.
Sized a =>
Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Evidence bound by a type signature of the constraint type Sized a
deep Digit a
pr' FingerTree (Node a)
m Digit a
sf)) (Digit a -> Digit (Digit a)
forall a. Digit a -> Digit (Digit a)
tailsDigit Digit a
pr))
        ((FingerTree (Node a) -> Node b)
-> FingerTree (Node a) -> FingerTree (Node b)
forall a b.
Sized a =>
(FingerTree a -> b) -> FingerTree a -> FingerTree b
Instance of class: Sized of the constraint type forall a. Sized (Node a)
tailsTree FingerTree (Node a) -> Node b
f' FingerTree (Node a)
m)
        ((Digit a -> b) -> Digit (Digit a) -> Digit b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Instance of class: Functor of the constraint type Functor Digit
fmap (FingerTree a -> b
f (FingerTree a -> b) -> (Digit a -> FingerTree a) -> Digit a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Digit a -> FingerTree a
forall a. Sized a => Digit a -> FingerTree a
Evidence bound by a type signature of the constraint type Sized a
digitToTree) (Digit a -> Digit (Digit a)
forall a. Digit a -> Digit (Digit a)
tailsDigit Digit a
sf))
  where
    f' :: FingerTree (Node a) -> Node b
f' FingerTree (Node a)
ms = let ConsLTree Node a
node FingerTree (Node a)
m' = FingerTree (Node a) -> ViewLTree (Node a)
forall a. Sized a => FingerTree a -> ViewLTree a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
viewLTree FingerTree (Node a)
ms in
        (Digit a -> b) -> Node (Digit a) -> Node b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Instance of class: Functor of the constraint type Functor Node
fmap (\ Digit a
pr' -> FingerTree a -> b
f (Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
forall a.
Sized a =>
Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Evidence bound by a type signature of the constraint type Sized a
deep Digit a
pr' FingerTree (Node a)
m' Digit a
sf)) (Node a -> Node (Digit a)
forall a. Node a -> Node (Digit a)
tailsNode Node a
node)

{-# SPECIALIZE initsTree :: (FingerTree (Elem a) -> Elem b) -> FingerTree (Elem a) -> FingerTree (Elem b) #-}
{-# SPECIALIZE initsTree :: (FingerTree (Node a) -> Node b) -> FingerTree (Node a) -> FingerTree (Node b) #-}
-- | Given a function to apply to inits of a tree, applies that function
-- to every init of the specified tree.
initsTree :: Sized a => (FingerTree a -> b) -> FingerTree a -> FingerTree b
initsTree :: (FingerTree a -> b) -> FingerTree a -> FingerTree b
initsTree FingerTree a -> b
_ FingerTree a
EmptyT = FingerTree b
forall a. FingerTree a
EmptyT
initsTree FingerTree a -> b
f (Single a
x) = b -> FingerTree b
forall a. a -> FingerTree a
Single (FingerTree a -> b
f (a -> FingerTree a
forall a. a -> FingerTree a
Single a
x))
initsTree FingerTree a -> b
f (Deep Int
n Digit a
pr FingerTree (Node a)
m Digit a
sf) =
    Int -> Digit b -> FingerTree (Node b) -> Digit b -> FingerTree b
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
n ((Digit a -> b) -> Digit (Digit a) -> Digit b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Instance of class: Functor of the constraint type Functor Digit
fmap (FingerTree a -> b
f (FingerTree a -> b) -> (Digit a -> FingerTree a) -> Digit a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Digit a -> FingerTree a
forall a. Sized a => Digit a -> FingerTree a
Evidence bound by a type signature of the constraint type Sized a
digitToTree) (Digit a -> Digit (Digit a)
forall a. Digit a -> Digit (Digit a)
initsDigit Digit a
pr))
        ((FingerTree (Node a) -> Node b)
-> FingerTree (Node a) -> FingerTree (Node b)
forall a b.
Sized a =>
(FingerTree a -> b) -> FingerTree a -> FingerTree b
Instance of class: Sized of the constraint type forall a. Sized (Node a)
initsTree FingerTree (Node a) -> Node b
f' FingerTree (Node a)
m)
        ((Digit a -> b) -> Digit (Digit a) -> Digit b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Instance of class: Functor of the constraint type Functor Digit
fmap (FingerTree a -> b
f (FingerTree a -> b) -> (Digit a -> FingerTree a) -> Digit a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
forall a.
Sized a =>
Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Evidence bound by a type signature of the constraint type Sized a
deep Digit a
pr FingerTree (Node a)
m) (Digit a -> Digit (Digit a)
forall a. Digit a -> Digit (Digit a)
initsDigit Digit a
sf))
  where
    f' :: FingerTree (Node a) -> Node b
f' FingerTree (Node a)
ms =  let SnocRTree FingerTree (Node a)
m' Node a
node = FingerTree (Node a) -> ViewRTree (Node a)
forall a. Sized a => FingerTree a -> ViewRTree a
Instance of class: Sized of the constraint type forall a. Sized (Node a)
viewRTree FingerTree (Node a)
ms in
             (Digit a -> b) -> Node (Digit a) -> Node b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Instance of class: Functor of the constraint type Functor Node
fmap (\ Digit a
sf' -> FingerTree a -> b
f (Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
forall a.
Sized a =>
Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Evidence bound by a type signature of the constraint type Sized a
deep Digit a
pr FingerTree (Node a)
m' Digit a
sf')) (Node a -> Node (Digit a)
forall a. Node a -> Node (Digit a)
initsNode Node a
node)

{-# INLINE foldlWithIndex #-}
-- | 'foldlWithIndex' is a version of 'foldl' that also provides access
-- to the index of each element.
foldlWithIndex :: (b -> Int -> a -> b) -> b -> Seq a -> b
foldlWithIndex :: (b -> Int -> a -> b) -> b -> Seq a -> b
foldlWithIndex b -> Int -> a -> b
f b
z Seq a
xs = ((Int -> b) -> a -> Int -> b) -> (Int -> b) -> Seq a -> Int -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Instance of class: Foldable of the constraint type Foldable Seq
foldl (\ Int -> b
g a
x !Int
i -> b -> Int -> a -> b
f (Int -> b
g (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
1)) Int
i a
x) (b -> Int -> b
forall a b. a -> b -> a
const b
z) Seq a
xs (Seq a -> Int
forall a. Seq a -> Int
length Seq a
xs Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
1)

{-# INLINE foldrWithIndex #-}
-- | 'foldrWithIndex' is a version of 'foldr' that also provides access
-- to the index of each element.
foldrWithIndex :: (Int -> a -> b -> b) -> b -> Seq a -> b
foldrWithIndex :: (Int -> a -> b -> b) -> b -> Seq a -> b
foldrWithIndex Int -> a -> b -> b
f b
z Seq a
xs = (a -> (Int -> b) -> Int -> b) -> (Int -> b) -> Seq a -> Int -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
Instance of class: Foldable of the constraint type Foldable Seq
foldr (\ a
x Int -> b
g !Int
i -> Int -> a -> b -> b
f Int
i a
x (Int -> b
g (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+Int
1))) (b -> Int -> b
forall a b. a -> b -> a
const b
z) Seq a
xs Int
0

{-# INLINE listToMaybe' #-}
-- 'listToMaybe\'' is a good consumer version of 'listToMaybe'.
listToMaybe' :: [a] -> Maybe a
listToMaybe' :: [a] -> Maybe a
listToMaybe' = (a -> Maybe a -> Maybe a) -> Maybe a -> [a] -> Maybe a
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
External instance of the constraint type Foldable []
foldr (\ a
x Maybe a
_ -> a -> Maybe a
forall a. a -> Maybe a
Just a
x) Maybe a
forall a. Maybe a
Nothing

-- | \( O(i) \) where \( i \) is the prefix length. 'takeWhileL', applied
-- to a predicate @p@ and a sequence @xs@, returns the longest prefix
-- (possibly empty) of @xs@ of elements that satisfy @p@.
takeWhileL :: (a -> Bool) -> Seq a -> Seq a
takeWhileL :: (a -> Bool) -> Seq a -> Seq a
takeWhileL a -> Bool
p = (Seq a, Seq a) -> Seq a
forall a b. (a, b) -> a
fst ((Seq a, Seq a) -> Seq a)
-> (Seq a -> (Seq a, Seq a)) -> Seq a -> Seq a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Bool) -> Seq a -> (Seq a, Seq a)
forall a. (a -> Bool) -> Seq a -> (Seq a, Seq a)
spanl a -> Bool
p

-- | \( O(i) \) where \( i \) is the suffix length.  'takeWhileR', applied
-- to a predicate @p@ and a sequence @xs@, returns the longest suffix
-- (possibly empty) of @xs@ of elements that satisfy @p@.
--
-- @'takeWhileR' p xs@ is equivalent to @'reverse' ('takeWhileL' p ('reverse' xs))@.
takeWhileR :: (a -> Bool) -> Seq a -> Seq a
takeWhileR :: (a -> Bool) -> Seq a -> Seq a
takeWhileR a -> Bool
p = (Seq a, Seq a) -> Seq a
forall a b. (a, b) -> a
fst ((Seq a, Seq a) -> Seq a)
-> (Seq a -> (Seq a, Seq a)) -> Seq a -> Seq a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Bool) -> Seq a -> (Seq a, Seq a)
forall a. (a -> Bool) -> Seq a -> (Seq a, Seq a)
spanr a -> Bool
p

-- | \( O(i) \) where \( i \) is the prefix length.  @'dropWhileL' p xs@ returns
-- the suffix remaining after @'takeWhileL' p xs@.
dropWhileL :: (a -> Bool) -> Seq a -> Seq a
dropWhileL :: (a -> Bool) -> Seq a -> Seq a
dropWhileL a -> Bool
p = (Seq a, Seq a) -> Seq a
forall a b. (a, b) -> b
snd ((Seq a, Seq a) -> Seq a)
-> (Seq a -> (Seq a, Seq a)) -> Seq a -> Seq a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Bool) -> Seq a -> (Seq a, Seq a)
forall a. (a -> Bool) -> Seq a -> (Seq a, Seq a)
spanl a -> Bool
p

-- | \( O(i) \) where \( i \) is the suffix length.  @'dropWhileR' p xs@ returns
-- the prefix remaining after @'takeWhileR' p xs@.
--
-- @'dropWhileR' p xs@ is equivalent to @'reverse' ('dropWhileL' p ('reverse' xs))@.
dropWhileR :: (a -> Bool) -> Seq a -> Seq a
dropWhileR :: (a -> Bool) -> Seq a -> Seq a
dropWhileR a -> Bool
p = (Seq a, Seq a) -> Seq a
forall a b. (a, b) -> b
snd ((Seq a, Seq a) -> Seq a)
-> (Seq a -> (Seq a, Seq a)) -> Seq a -> Seq a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Bool) -> Seq a -> (Seq a, Seq a)
forall a. (a -> Bool) -> Seq a -> (Seq a, Seq a)
spanr a -> Bool
p

-- | \( O(i) \) where \( i \) is the prefix length.  'spanl', applied to
-- a predicate @p@ and a sequence @xs@, returns a pair whose first
-- element is the longest prefix (possibly empty) of @xs@ of elements that
-- satisfy @p@ and the second element is the remainder of the sequence.
spanl :: (a -> Bool) -> Seq a -> (Seq a, Seq a)
spanl :: (a -> Bool) -> Seq a -> (Seq a, Seq a)
spanl a -> Bool
p = (a -> Bool) -> Seq a -> (Seq a, Seq a)
forall a. (a -> Bool) -> Seq a -> (Seq a, Seq a)
breakl (Bool -> Bool
not (Bool -> Bool) -> (a -> Bool) -> a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Bool
p)

-- | \( O(i) \) where \( i \) is the suffix length.  'spanr', applied to a
-- predicate @p@ and a sequence @xs@, returns a pair whose /first/ element
-- is the longest /suffix/ (possibly empty) of @xs@ of elements that
-- satisfy @p@ and the second element is the remainder of the sequence.
spanr :: (a -> Bool) -> Seq a -> (Seq a, Seq a)
spanr :: (a -> Bool) -> Seq a -> (Seq a, Seq a)
spanr a -> Bool
p = (a -> Bool) -> Seq a -> (Seq a, Seq a)
forall a. (a -> Bool) -> Seq a -> (Seq a, Seq a)
breakr (Bool -> Bool
not (Bool -> Bool) -> (a -> Bool) -> a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Bool
p)

{-# INLINE breakl #-}
-- | \( O(i) \) where \( i \) is the breakpoint index.  'breakl', applied to a
-- predicate @p@ and a sequence @xs@, returns a pair whose first element
-- is the longest prefix (possibly empty) of @xs@ of elements that
-- /do not satisfy/ @p@ and the second element is the remainder of
-- the sequence.
--
-- @'breakl' p@ is equivalent to @'spanl' (not . p)@.
breakl :: (a -> Bool) -> Seq a -> (Seq a, Seq a)
breakl :: (a -> Bool) -> Seq a -> (Seq a, Seq a)
breakl a -> Bool
p Seq a
xs = (Int -> (Seq a, Seq a) -> (Seq a, Seq a))
-> (Seq a, Seq a) -> [Int] -> (Seq a, Seq a)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
External instance of the constraint type Foldable []
foldr (\ Int
i (Seq a, Seq a)
_ -> Int -> Seq a -> (Seq a, Seq a)
forall a. Int -> Seq a -> (Seq a, Seq a)
splitAt Int
i Seq a
xs) (Seq a
xs, Seq a
forall a. Seq a
empty) ((a -> Bool) -> Seq a -> [Int]
forall a. (a -> Bool) -> Seq a -> [Int]
findIndicesL a -> Bool
p Seq a
xs)

{-# INLINE breakr #-}
-- | @'breakr' p@ is equivalent to @'spanr' (not . p)@.
breakr :: (a -> Bool) -> Seq a -> (Seq a, Seq a)
breakr :: (a -> Bool) -> Seq a -> (Seq a, Seq a)
breakr a -> Bool
p Seq a
xs = (Int -> (Seq a, Seq a) -> (Seq a, Seq a))
-> (Seq a, Seq a) -> [Int] -> (Seq a, Seq a)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
External instance of the constraint type Foldable []
foldr (\ Int
i (Seq a, Seq a)
_ -> (Seq a, Seq a) -> (Seq a, Seq a)
forall {b} {a}. (b, a) -> (a, b)
flipPair (Int -> Seq a -> (Seq a, Seq a)
forall a. Int -> Seq a -> (Seq a, Seq a)
splitAt (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Int
1) Seq a
xs)) (Seq a
xs, Seq a
forall a. Seq a
empty) ((a -> Bool) -> Seq a -> [Int]
forall a. (a -> Bool) -> Seq a -> [Int]
findIndicesR a -> Bool
p Seq a
xs)
  where flipPair :: (b, a) -> (a, b)
flipPair (b
x, a
y) = (a
y, b
x)

-- | \( O(n) \).  The 'partition' function takes a predicate @p@ and a
-- sequence @xs@ and returns sequences of those elements which do and
-- do not satisfy the predicate.
partition :: (a -> Bool) -> Seq a -> (Seq a, Seq a)
partition :: (a -> Bool) -> Seq a -> (Seq a, Seq a)
partition a -> Bool
p = StrictPair (Seq a) (Seq a) -> (Seq a, Seq a)
forall a b. StrictPair a b -> (a, b)
toPair (StrictPair (Seq a) (Seq a) -> (Seq a, Seq a))
-> (Seq a -> StrictPair (Seq a) (Seq a)) -> Seq a -> (Seq a, Seq a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrictPair (Seq a) (Seq a) -> a -> StrictPair (Seq a) (Seq a))
-> StrictPair (Seq a) (Seq a)
-> Seq a
-> StrictPair (Seq a) (Seq a)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Instance of class: Foldable of the constraint type Foldable Seq
foldl' StrictPair (Seq a) (Seq a) -> a -> StrictPair (Seq a) (Seq a)
part (Seq a
forall a. Seq a
empty Seq a -> Seq a -> StrictPair (Seq a) (Seq a)
forall a b. a -> b -> StrictPair a b
:*: Seq a
forall a. Seq a
empty)
  where
    part :: StrictPair (Seq a) (Seq a) -> a -> StrictPair (Seq a) (Seq a)
part (Seq a
xs :*: Seq a
ys) a
x
      | a -> Bool
p a
x         = (Seq a
xs Seq a -> a -> Seq a
forall a. Seq a -> a -> Seq a
`snoc'` a
x) Seq a -> Seq a -> StrictPair (Seq a) (Seq a)
forall a b. a -> b -> StrictPair a b
:*: Seq a
ys
      | Bool
otherwise   = Seq a
xs Seq a -> Seq a -> StrictPair (Seq a) (Seq a)
forall a b. a -> b -> StrictPair a b
:*: (Seq a
ys Seq a -> a -> Seq a
forall a. Seq a -> a -> Seq a
`snoc'` a
x)

-- | \( O(n) \).  The 'filter' function takes a predicate @p@ and a sequence
-- @xs@ and returns a sequence of those elements which satisfy the
-- predicate.
filter :: (a -> Bool) -> Seq a -> Seq a
filter :: (a -> Bool) -> Seq a -> Seq a
filter a -> Bool
p = (Seq a -> a -> Seq a) -> Seq a -> Seq a -> Seq a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Instance of class: Foldable of the constraint type Foldable Seq
foldl' (\ Seq a
xs a
x -> if a -> Bool
p a
x then Seq a
xs Seq a -> a -> Seq a
forall a. Seq a -> a -> Seq a
`snoc'` a
x else Seq a
xs) Seq a
forall a. Seq a
empty

-- Indexing sequences

-- | 'elemIndexL' finds the leftmost index of the specified element,
-- if it is present, and otherwise 'Nothing'.
elemIndexL :: Eq a => a -> Seq a -> Maybe Int
elemIndexL :: a -> Seq a -> Maybe Int
elemIndexL a
x = (a -> Bool) -> Seq a -> Maybe Int
forall a. (a -> Bool) -> Seq a -> Maybe Int
findIndexL (a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
Evidence bound by a type signature of the constraint type Eq a
==)

-- | 'elemIndexR' finds the rightmost index of the specified element,
-- if it is present, and otherwise 'Nothing'.
elemIndexR :: Eq a => a -> Seq a -> Maybe Int
elemIndexR :: a -> Seq a -> Maybe Int
elemIndexR a
x = (a -> Bool) -> Seq a -> Maybe Int
forall a. (a -> Bool) -> Seq a -> Maybe Int
findIndexR (a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
Evidence bound by a type signature of the constraint type Eq a
==)

-- | 'elemIndicesL' finds the indices of the specified element, from
-- left to right (i.e. in ascending order).
elemIndicesL :: Eq a => a -> Seq a -> [Int]
elemIndicesL :: a -> Seq a -> [Int]
elemIndicesL a
x = (a -> Bool) -> Seq a -> [Int]
forall a. (a -> Bool) -> Seq a -> [Int]
findIndicesL (a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
Evidence bound by a type signature of the constraint type Eq a
==)

-- | 'elemIndicesR' finds the indices of the specified element, from
-- right to left (i.e. in descending order).
elemIndicesR :: Eq a => a -> Seq a -> [Int]
elemIndicesR :: a -> Seq a -> [Int]
elemIndicesR a
x = (a -> Bool) -> Seq a -> [Int]
forall a. (a -> Bool) -> Seq a -> [Int]
findIndicesR (a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
Evidence bound by a type signature of the constraint type Eq a
==)

-- | @'findIndexL' p xs@ finds the index of the leftmost element that
-- satisfies @p@, if any exist.
findIndexL :: (a -> Bool) -> Seq a -> Maybe Int
findIndexL :: (a -> Bool) -> Seq a -> Maybe Int
findIndexL a -> Bool
p = [Int] -> Maybe Int
forall a. [a] -> Maybe a
listToMaybe' ([Int] -> Maybe Int) -> (Seq a -> [Int]) -> Seq a -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Bool) -> Seq a -> [Int]
forall a. (a -> Bool) -> Seq a -> [Int]
findIndicesL a -> Bool
p

-- | @'findIndexR' p xs@ finds the index of the rightmost element that
-- satisfies @p@, if any exist.
findIndexR :: (a -> Bool) -> Seq a -> Maybe Int
findIndexR :: (a -> Bool) -> Seq a -> Maybe Int
findIndexR a -> Bool
p = [Int] -> Maybe Int
forall a. [a] -> Maybe a
listToMaybe' ([Int] -> Maybe Int) -> (Seq a -> [Int]) -> Seq a -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Bool) -> Seq a -> [Int]
forall a. (a -> Bool) -> Seq a -> [Int]
findIndicesR a -> Bool
p

{-# INLINE findIndicesL #-}
-- | @'findIndicesL' p@ finds all indices of elements that satisfy @p@,
-- in ascending order.
findIndicesL :: (a -> Bool) -> Seq a -> [Int]
#if __GLASGOW_HASKELL__
findIndicesL :: (a -> Bool) -> Seq a -> [Int]
findIndicesL a -> Bool
p Seq a
xs = (forall b. (Int -> b -> b) -> b -> b) -> [Int]
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
                (Int -> a -> b -> b) -> b -> Seq a -> b
forall a b. (Int -> a -> b -> b) -> b -> Seq a -> b
foldrWithIndex Int -> a -> b -> b
g b
n Seq a
xs)
#else
findIndicesL p xs = foldrWithIndex g [] xs
  where g i x is = if p x then i:is else is
#endif

{-# INLINE findIndicesR #-}
-- | @'findIndicesR' p@ finds all indices of elements that satisfy @p@,
-- in descending order.
findIndicesR :: (a -> Bool) -> Seq a -> [Int]
#if __GLASGOW_HASKELL__
findIndicesR :: (a -> Bool) -> Seq a -> [Int]
findIndicesR a -> Bool
p Seq a
xs = (forall b. (Int -> b -> b) -> b -> b) -> [Int]
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 (b -> Int -> a -> b) -> b -> Seq a -> b
forall b a. (b -> Int -> a -> b) -> b -> Seq a -> b
foldlWithIndex b -> Int -> a -> b
g b
n Seq a
xs)
#else
findIndicesR p xs = foldlWithIndex g [] xs
  where g is i x = if p x then i:is else is
#endif

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

-- The implementation below is based on an idea by Ross Paterson and
-- implemented by Lennart Spitzner. It avoids the rebuilding the original
-- (|>)-based implementation suffered from. It also avoids the excessive pair
-- allocations Paterson's implementation suffered from.
--
-- David Feuer suggested building in nine-element chunks, which reduces
-- intermediate conses from around (1/2)*n to around (1/8)*n with a concomitant
-- improvement in benchmark constant factors. In fact, it should be even
-- better to work in chunks of 27 `Elem`s and chunks of three `Node`s, rather
-- than nine of each, but it seems hard to avoid a code explosion with
-- such large chunks.
--
-- Paterson's code can be seen, for example, in
-- https://github.com/haskell/containers/blob/74034b3244fa4817c7bef1202e639b887a975d9e/Data/Sequence.hs#L3532
--
-- Given a list
--
-- [1..302]
--
-- the original code forms Three 1 2 3 | [node3 4 5 6, node3 7 8 9, node3 10 11
-- 12, ...] | Two 301 302
--
-- Then it recurses on the middle list. The middle lists become successively
-- shorter as their elements become successively deeper nodes.
--
-- The original implementation of the list shortener, getNodes, included the
-- recursive step

--     getNodes s x1 (x2:x3:x4:xs) = (Node3 s x1 x2 x3:ns, d)
--            where (ns, d) = getNodes s x4 xs

-- This allocates a cons and a lazy pair at each 3-element step. It relies on
-- the Haskell implementation using Wadler's technique, described in "Fixing
-- some space leaks with a garbage collector"
-- http://homepages.inf.ed.ac.uk/wadler/papers/leak/leak.ps.gz, to repeatedly
-- simplify the `d` thunk. Although GHC uses this GC trick, heap profiling at
-- least appears to indicate that the pair constructors and conses build up
-- with this implementation.
--
-- Spitzner's implementation uses a similar approach, but replaces the middle
-- list, in each level, with a customized stream type that finishes off with
-- the final digit in that level and (since it works in nines) in the one
-- above. To work around the nested tree structure, the overall computation is
-- structured using continuation-passing style, with a function that, at the
-- bottom of the tree, deals with a stream that terminates in a nested-pair
-- representation of the entire right side of the tree. Perhaps someone will
-- eventually find a less mind-bending way to accomplish this.

-- | \( O(n) \). Create a sequence from a finite list of elements.
-- There is a function 'toList' in the opposite direction for all
-- instances of the 'Foldable' class, including 'Seq'.
fromList        :: [a] -> Seq a
-- Note: we can avoid map_elem if we wish by scattering
-- Elem applications throughout mkTreeE and getNodesE, but
-- it gets a bit hard to read.
fromList :: [a] -> Seq a
fromList = FingerTree (Elem a) -> Seq a
forall a. FingerTree (Elem a) -> Seq a
Seq (FingerTree (Elem a) -> Seq a)
-> ([a] -> FingerTree (Elem a)) -> [a] -> Seq a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Elem a] -> FingerTree (Elem a)
forall a'. [Elem a'] -> FingerTree (Elem a')
mkTree ([Elem a] -> FingerTree (Elem a))
-> ([a] -> [Elem a]) -> [a] -> FingerTree (Elem a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [Elem a]
forall a. [a] -> [Elem a]
map_elem
  where
#ifdef __GLASGOW_HASKELL__
    mkTree :: forall a' . [Elem a'] -> FingerTree (Elem a')
#else
    mkTree :: [Elem a] -> FingerTree (Elem a)
#endif
    mkTree :: [Elem a'] -> FingerTree (Elem a')
mkTree [] = FingerTree (Elem a')
forall a. FingerTree a
EmptyT
    mkTree [Elem a'
x1] = Elem a' -> FingerTree (Elem a')
forall a. a -> FingerTree a
Single Elem a'
x1
    mkTree [Elem a'
x1, Elem a'
x2] = Int
-> Digit (Elem a')
-> FingerTree (Node (Elem a'))
-> Digit (Elem a')
-> FingerTree (Elem a')
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
2 (Elem a' -> Digit (Elem a')
forall a. a -> Digit a
One Elem a'
x1) FingerTree (Node (Elem a'))
forall a. FingerTree a
EmptyT (Elem a' -> Digit (Elem a')
forall a. a -> Digit a
One Elem a'
x2)
    mkTree [Elem a'
x1, Elem a'
x2, Elem a'
x3] = Int
-> Digit (Elem a')
-> FingerTree (Node (Elem a'))
-> Digit (Elem a')
-> FingerTree (Elem a')
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
3 (Elem a' -> Elem a' -> Digit (Elem a')
forall a. a -> a -> Digit a
Two Elem a'
x1 Elem a'
x2) FingerTree (Node (Elem a'))
forall a. FingerTree a
EmptyT (Elem a' -> Digit (Elem a')
forall a. a -> Digit a
One Elem a'
x3)
    mkTree [Elem a'
x1, Elem a'
x2, Elem a'
x3, Elem a'
x4] = Int
-> Digit (Elem a')
-> FingerTree (Node (Elem a'))
-> Digit (Elem a')
-> FingerTree (Elem a')
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
4 (Elem a' -> Elem a' -> Digit (Elem a')
forall a. a -> a -> Digit a
Two Elem a'
x1 Elem a'
x2) FingerTree (Node (Elem a'))
forall a. FingerTree a
EmptyT (Elem a' -> Elem a' -> Digit (Elem a')
forall a. a -> a -> Digit a
Two Elem a'
x3 Elem a'
x4)
    mkTree [Elem a'
x1, Elem a'
x2, Elem a'
x3, Elem a'
x4, Elem a'
x5] = Int
-> Digit (Elem a')
-> FingerTree (Node (Elem a'))
-> Digit (Elem a')
-> FingerTree (Elem a')
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
5 (Elem a' -> Elem a' -> Elem a' -> Digit (Elem a')
forall a. a -> a -> a -> Digit a
Three Elem a'
x1 Elem a'
x2 Elem a'
x3) FingerTree (Node (Elem a'))
forall a. FingerTree a
EmptyT (Elem a' -> Elem a' -> Digit (Elem a')
forall a. a -> a -> Digit a
Two Elem a'
x4 Elem a'
x5)
    mkTree [Elem a'
x1, Elem a'
x2, Elem a'
x3, Elem a'
x4, Elem a'
x5, Elem a'
x6] =
      Int
-> Digit (Elem a')
-> FingerTree (Node (Elem a'))
-> Digit (Elem a')
-> FingerTree (Elem a')
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
6 (Elem a' -> Elem a' -> Elem a' -> Digit (Elem a')
forall a. a -> a -> a -> Digit a
Three Elem a'
x1 Elem a'
x2 Elem a'
x3) FingerTree (Node (Elem a'))
forall a. FingerTree a
EmptyT (Elem a' -> Elem a' -> Elem a' -> Digit (Elem a')
forall a. a -> a -> a -> Digit a
Three Elem a'
x4 Elem a'
x5 Elem a'
x6)
    mkTree [Elem a'
x1, Elem a'
x2, Elem a'
x3, Elem a'
x4, Elem a'
x5, Elem a'
x6, Elem a'
x7] =
      Int
-> Digit (Elem a')
-> FingerTree (Node (Elem a'))
-> Digit (Elem a')
-> FingerTree (Elem a')
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
7 (Elem a' -> Elem a' -> Digit (Elem a')
forall a. a -> a -> Digit a
Two Elem a'
x1 Elem a'
x2) (Node (Elem a') -> FingerTree (Node (Elem a'))
forall a. a -> FingerTree a
Single (Int -> Elem a' -> Elem a' -> Elem a' -> Node (Elem a')
forall a. Int -> a -> a -> a -> Node a
Node3 Int
3 Elem a'
x3 Elem a'
x4 Elem a'
x5)) (Elem a' -> Elem a' -> Digit (Elem a')
forall a. a -> a -> Digit a
Two Elem a'
x6 Elem a'
x7)
    mkTree [Elem a'
x1, Elem a'
x2, Elem a'
x3, Elem a'
x4, Elem a'
x5, Elem a'
x6, Elem a'
x7, Elem a'
x8] =
      Int
-> Digit (Elem a')
-> FingerTree (Node (Elem a'))
-> Digit (Elem a')
-> FingerTree (Elem a')
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
8 (Elem a' -> Elem a' -> Elem a' -> Digit (Elem a')
forall a. a -> a -> a -> Digit a
Three Elem a'
x1 Elem a'
x2 Elem a'
x3) (Node (Elem a') -> FingerTree (Node (Elem a'))
forall a. a -> FingerTree a
Single (Int -> Elem a' -> Elem a' -> Elem a' -> Node (Elem a')
forall a. Int -> a -> a -> a -> Node a
Node3 Int
3 Elem a'
x4 Elem a'
x5 Elem a'
x6)) (Elem a' -> Elem a' -> Digit (Elem a')
forall a. a -> a -> Digit a
Two Elem a'
x7 Elem a'
x8)
    mkTree [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] =
      Int
-> Digit (Elem a')
-> FingerTree (Node (Elem a'))
-> Digit (Elem a')
-> FingerTree (Elem a')
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
9 (Elem a' -> Elem a' -> Elem a' -> Digit (Elem a')
forall a. a -> a -> a -> Digit a
Three Elem a'
x1 Elem a'
x2 Elem a'
x3) (Node (Elem a') -> FingerTree (Node (Elem a'))
forall a. a -> FingerTree a
Single (Int -> Elem a' -> Elem a' -> Elem a' -> Node (Elem a')
forall a. Int -> a -> a -> a -> Node a
Node3 Int
3 Elem a'
x4 Elem a'
x5 Elem a'
x6)) (Elem a' -> Elem a' -> Elem a' -> Digit (Elem a')
forall a. a -> a -> a -> Digit a
Three Elem a'
x7 Elem a'
x8 Elem a'
x9)
    mkTree [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] =
      Int
-> Digit (Elem a')
-> FingerTree (Node (Elem a'))
-> Digit (Elem a')
-> FingerTree (Elem a')
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
10 (Elem a' -> Elem a' -> Digit (Elem a')
forall a. a -> a -> Digit a
Two Elem a'
x1 Elem a'
x2)
              (Int
-> Digit (Node (Elem a'))
-> FingerTree (Node (Node (Elem a')))
-> Digit (Node (Elem a'))
-> FingerTree (Node (Elem a'))
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
6 (Node (Elem a') -> Digit (Node (Elem a'))
forall a. a -> Digit a
One (Int -> Elem a' -> Elem a' -> Elem a' -> Node (Elem a')
forall a. Int -> a -> a -> a -> Node a
Node3 Int
3 Elem a'
x3 Elem a'
x4 Elem a'
x5)) FingerTree (Node (Node (Elem a')))
forall a. FingerTree a
EmptyT (Node (Elem a') -> Digit (Node (Elem a'))
forall a. a -> Digit a
One (Int -> Elem a' -> Elem a' -> Elem a' -> Node (Elem a')
forall a. Int -> a -> a -> a -> Node a
Node3 Int
3 Elem a'
x6 Elem a'
x7 Elem a'
x8)))
              (Elem a' -> Elem a' -> Digit (Elem a')
forall a. a -> a -> Digit a
Two Elem a'
y0 Elem a'
y1)
    mkTree [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] =
      Int
-> Digit (Elem a')
-> FingerTree (Node (Elem a'))
-> Digit (Elem a')
-> FingerTree (Elem a')
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
11 (Elem a' -> Elem a' -> Elem a' -> Digit (Elem a')
forall a. a -> a -> a -> Digit a
Three Elem a'
x1 Elem a'
x2 Elem a'
x3)
              (Int
-> Digit (Node (Elem a'))
-> FingerTree (Node (Node (Elem a')))
-> Digit (Node (Elem a'))
-> FingerTree (Node (Elem a'))
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
6 (Node (Elem a') -> Digit (Node (Elem a'))
forall a. a -> Digit a
One (Int -> Elem a' -> Elem a' -> Elem a' -> Node (Elem a')
forall a. Int -> a -> a -> a -> Node a
Node3 Int
3 Elem a'
x4 Elem a'
x5 Elem a'
x6)) FingerTree (Node (Node (Elem a')))
forall a. FingerTree a
EmptyT (Node (Elem a') -> Digit (Node (Elem a'))
forall a. a -> Digit a
One (Int -> Elem a' -> Elem a' -> Elem a' -> Node (Elem a')
forall a. Int -> a -> a -> a -> Node a
Node3 Int
3 Elem a'
x7 Elem a'
x8 Elem a'
x9)))
              (Elem a' -> Elem a' -> Digit (Elem a')
forall a. a -> a -> Digit a
Two Elem a'
y0 Elem a'
y1)
    mkTree [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] =
      Int
-> Digit (Elem a')
-> FingerTree (Node (Elem a'))
-> Digit (Elem a')
-> FingerTree (Elem a')
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
12 (Elem a' -> Elem a' -> Elem a' -> Digit (Elem a')
forall a. a -> a -> a -> Digit a
Three Elem a'
x1 Elem a'
x2 Elem a'
x3)
              (Int
-> Digit (Node (Elem a'))
-> FingerTree (Node (Node (Elem a')))
-> Digit (Node (Elem a'))
-> FingerTree (Node (Elem a'))
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
6 (Node (Elem a') -> Digit (Node (Elem a'))
forall a. a -> Digit a
One (Int -> Elem a' -> Elem a' -> Elem a' -> Node (Elem a')
forall a. Int -> a -> a -> a -> Node a
Node3 Int
3 Elem a'
x4 Elem a'
x5 Elem a'
x6)) FingerTree (Node (Node (Elem a')))
forall a. FingerTree a
EmptyT (Node (Elem a') -> Digit (Node (Elem a'))
forall a. a -> Digit a
One (Int -> Elem a' -> Elem a' -> Elem a' -> Node (Elem a')
forall a. Int -> a -> a -> a -> Node a
Node3 Int
3 Elem a'
x7 Elem a'
x8 Elem a'
x9)))
              (Elem a' -> Elem a' -> Elem a' -> Digit (Elem a')
forall a. a -> a -> a -> Digit a
Three Elem a'
y0 Elem a'
y1 Elem a'
y2)
    mkTree [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] =
      Int
-> Digit (Elem a')
-> FingerTree (Node (Elem a'))
-> Digit (Elem a')
-> FingerTree (Elem a')
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
13 (Elem a' -> Elem a' -> Digit (Elem a')
forall a. a -> a -> Digit a
Two Elem a'
x1 Elem a'
x2)
              (Int
-> Digit (Node (Elem a'))
-> FingerTree (Node (Node (Elem a')))
-> Digit (Node (Elem a'))
-> FingerTree (Node (Elem a'))
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
9 (Node (Elem a') -> Node (Elem a') -> Digit (Node (Elem a'))
forall a. a -> a -> Digit a
Two (Int -> Elem a' -> Elem a' -> Elem a' -> Node (Elem a')
forall a. Int -> a -> a -> a -> Node a
Node3 Int
3 Elem a'
x3 Elem a'
x4 Elem a'
x5) (Int -> Elem a' -> Elem a' -> Elem a' -> Node (Elem a')
forall a. Int -> a -> a -> a -> Node a
Node3 Int
3 Elem a'
x6 Elem a'
x7 Elem a'
x8)) FingerTree (Node (Node (Elem a')))
forall a. FingerTree a
EmptyT (Node (Elem a') -> Digit (Node (Elem a'))
forall a. a -> Digit a
One (Int -> Elem a' -> Elem a' -> Elem a' -> Node (Elem a')
forall a. Int -> a -> a -> a -> Node a
Node3 Int
3 Elem a'
y0 Elem a'
y1 Elem a'
y2)))
              (Elem a' -> Elem a' -> Digit (Elem a')
forall a. a -> a -> Digit a
Two Elem a'
y3 Elem a'
y4)
    mkTree [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] =
      Int
-> Digit (Elem a')
-> FingerTree (Node (Elem a'))
-> Digit (Elem a')
-> FingerTree (Elem a')
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
14 (Elem a' -> Elem a' -> Elem a' -> Digit (Elem a')
forall a. a -> a -> a -> Digit a
Three Elem a'
x1 Elem a'
x2 Elem a'
x3)
              (Int
-> Digit (Node (Elem a'))
-> FingerTree (Node (Node (Elem a')))
-> Digit (Node (Elem a'))
-> FingerTree (Node (Elem a'))
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
9 (Node (Elem a') -> Node (Elem a') -> Digit (Node (Elem a'))
forall a. a -> a -> Digit a
Two (Int -> Elem a' -> Elem a' -> Elem a' -> Node (Elem a')
forall a. Int -> a -> a -> a -> Node a
Node3 Int
3 Elem a'
x4 Elem a'
x5 Elem a'
x6) (Int -> Elem a' -> Elem a' -> Elem a' -> Node (Elem a')
forall a. Int -> a -> a -> a -> Node a
Node3 Int
3 Elem a'
x7 Elem a'
x8 Elem a'
x9)) FingerTree (Node (Node (Elem a')))
forall a. FingerTree a
EmptyT (Node (Elem a') -> Digit (Node (Elem a'))
forall a. a -> Digit a
One (Int -> Elem a' -> Elem a' -> Elem a' -> Node (Elem a')
forall a. Int -> a -> a -> a -> Node a
Node3 Int
3 Elem a'
y0 Elem a'
y1 Elem a'
y2)))
              (Elem a' -> Elem a' -> Digit (Elem a')
forall a. a -> a -> Digit a
Two Elem a'
y3 Elem a'
y4)
    mkTree [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] =
      Int
-> Digit (Elem a')
-> FingerTree (Node (Elem a'))
-> Digit (Elem a')
-> FingerTree (Elem a')
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
15 (Elem a' -> Elem a' -> Elem a' -> Digit (Elem a')
forall a. a -> a -> a -> Digit a
Three Elem a'
x1 Elem a'
x2 Elem a'
x3)
              (Int
-> Digit (Node (Elem a'))
-> FingerTree (Node (Node (Elem a')))
-> Digit (Node (Elem a'))
-> FingerTree (Node (Elem a'))
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
9 (Node (Elem a') -> Node (Elem a') -> Digit (Node (Elem a'))
forall a. a -> a -> Digit a
Two (Int -> Elem a' -> Elem a' -> Elem a' -> Node (Elem a')
forall a. Int -> a -> a -> a -> Node a
Node3 Int
3 Elem a'
x4 Elem a'
x5 Elem a'
x6) (Int -> Elem a' -> Elem a' -> Elem a' -> Node (Elem a')
forall a. Int -> a -> a -> a -> Node a
Node3 Int
3 Elem a'
x7 Elem a'
x8 Elem a'
x9)) FingerTree (Node (Node (Elem a')))
forall a. FingerTree a
EmptyT (Node (Elem a') -> Digit (Node (Elem a'))
forall a. a -> Digit a
One (Int -> Elem a' -> Elem a' -> Elem a' -> Node (Elem a')
forall a. Int -> a -> a -> a -> Node a
Node3 Int
3 Elem a'
y0 Elem a'
y1 Elem a'
y2)))
              (Elem a' -> Elem a' -> Elem a' -> Digit (Elem a')
forall a. a -> a -> a -> Digit a
Three Elem a'
y3 Elem a'
y4 Elem a'
y5)
    mkTree (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) =
        ((Digit (Node (Elem a')), Digit (Elem a'))
 -> FingerTree (Node (Node (Elem a'))) -> FingerTree (Elem a'))
-> Int
-> ListFinal
     (Node (Node (Elem a'))) (Digit (Node (Elem a')), Digit (Elem a'))
-> FingerTree (Elem a')
forall a b c.
(b -> FingerTree (Node a) -> c) -> Int -> ListFinal (Node a) b -> c
mkTreeC (Digit (Node (Elem a')), Digit (Elem a'))
-> FingerTree (Node (Node (Elem a'))) -> FingerTree (Elem a')
cont Int
9 (Int
-> Node (Elem a')
-> Elem a'
-> [Elem a']
-> ListFinal
     (Node (Node (Elem a'))) (Digit (Node (Elem a')), Digit (Elem a'))
forall a.
Int
-> Node a
-> a
-> [a]
-> ListFinal (Node (Node a)) (Digit (Node a), Digit a)
getNodes Int
3 (Int -> Elem a' -> Elem a' -> Elem a' -> Node (Elem a')
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 = Elem a' -> Elem a' -> Elem a' -> Digit (Elem a')
forall a. a -> a -> a -> Digit a
Three Elem a'
x1 Elem a'
x2 Elem a'
x3
        d1 :: Digit (Node (Elem a'))
d1 = Node (Elem a')
-> Node (Elem a') -> Node (Elem a') -> Digit (Node (Elem a'))
forall a. a -> a -> a -> Digit a
Three (Int -> Elem a' -> Elem a' -> Elem a' -> Node (Elem a')
forall a. Int -> a -> a -> a -> Node a
Node3 Int
3 Elem a'
x4 Elem a'
x5 Elem a'
x6) (Int -> Elem a' -> Elem a' -> Elem a' -> Node (Elem a')
forall a. Int -> a -> a -> a -> Node a
Node3 Int
3 Elem a'
x7 Elem a'
x8 Elem a'
x9) (Int -> Elem a' -> Elem a' -> Elem a' -> Node (Elem a')
forall a. Int -> a -> a -> a -> Node a
Node3 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 = Int
-> Digit (Node (Elem a'))
-> FingerTree (Node (Node (Elem a')))
-> Digit (Node (Elem a'))
-> FingerTree (Node (Elem a'))
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
9 Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Digit (Node (Elem a')) -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized a => Sized (Digit a)
Instance of class: Sized of the constraint type forall a. Sized (Node a)
size Digit (Node (Elem a'))
r1 Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ FingerTree (Node (Node (Elem a'))) -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized a => Sized (FingerTree a)
Instance of class: Sized of the constraint type forall a. Sized (Node a)
size FingerTree (Node (Node (Elem a')))
sub) Digit (Node (Elem a'))
d1 FingerTree (Node (Node (Elem a')))
sub Digit (Node (Elem a'))
r1
          in Int
-> Digit (Elem a')
-> FingerTree (Node (Elem a'))
-> Digit (Elem a')
-> FingerTree (Elem a')
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
3 Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Digit (Elem a') -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized a => Sized (Digit a)
Instance of class: Sized of the constraint type forall a. Sized (Elem a)
size Digit (Elem a')
r2 Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ FingerTree (Node (Elem a')) -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized a => Sized (FingerTree a)
Instance of class: Sized of the constraint type forall a. Sized (Node a)
size FingerTree (Node (Elem a'))
sub1) Digit (Elem a')
d2 FingerTree (Node (Elem a'))
sub1 Digit (Elem a')
r2

    getNodes :: forall a . Int
             -> Node a
             -> a
             -> [a]
             -> ListFinal (Node (Node a)) (Digit (Node a), Digit a)
    getNodes :: Int
-> Node a
-> a
-> [a]
-> ListFinal (Node (Node a)) (Digit (Node a), Digit a)
getNodes !Int
_ Node a
n1 a
x1 [] = (Digit (Node a), Digit a)
-> ListFinal (Node (Node a)) (Digit (Node a), Digit a)
forall a cont. cont -> ListFinal a cont
LFinal (Node a -> Digit (Node a)
forall a. a -> Digit a
One Node a
n1, a -> Digit a
forall a. a -> Digit a
One a
x1)
    getNodes Int
_ Node a
n1 a
x1 [a
x2] = (Digit (Node a), Digit a)
-> ListFinal (Node (Node a)) (Digit (Node a), Digit a)
forall a cont. cont -> ListFinal a cont
LFinal (Node a -> Digit (Node a)
forall a. a -> Digit a
One Node a
n1, a -> a -> Digit a
forall a. a -> a -> Digit a
Two a
x1 a
x2)
    getNodes Int
_ Node a
n1 a
x1 [a
x2, a
x3] = (Digit (Node a), Digit a)
-> ListFinal (Node (Node a)) (Digit (Node a), Digit a)
forall a cont. cont -> ListFinal a cont
LFinal (Node a -> Digit (Node a)
forall a. a -> Digit a
One Node a
n1, a -> a -> a -> Digit a
forall a. a -> a -> a -> Digit a
Three a
x1 a
x2 a
x3)
    getNodes Int
s Node a
n1 a
x1 [a
x2, a
x3, a
x4] = (Digit (Node a), Digit a)
-> ListFinal (Node (Node a)) (Digit (Node a), Digit a)
forall a cont. cont -> ListFinal a cont
LFinal (Node a -> Node a -> Digit (Node a)
forall a. a -> a -> Digit a
Two Node a
n1 (Int -> a -> a -> a -> Node a
forall a. Int -> a -> a -> a -> Node a
Node3 Int
s a
x1 a
x2 a
x3), a -> Digit a
forall a. a -> Digit a
One a
x4)
    getNodes Int
s Node a
n1 a
x1 [a
x2, a
x3, a
x4, a
x5] = (Digit (Node a), Digit a)
-> ListFinal (Node (Node a)) (Digit (Node a), Digit a)
forall a cont. cont -> ListFinal a cont
LFinal (Node a -> Node a -> Digit (Node a)
forall a. a -> a -> Digit a
Two Node a
n1 (Int -> a -> a -> a -> Node a
forall a. Int -> a -> a -> a -> Node a
Node3 Int
s a
x1 a
x2 a
x3), a -> a -> Digit a
forall a. a -> a -> Digit a
Two a
x4 a
x5)
    getNodes Int
s Node a
n1 a
x1 [a
x2, a
x3, a
x4, a
x5, a
x6] = (Digit (Node a), Digit a)
-> ListFinal (Node (Node a)) (Digit (Node a), Digit a)
forall a cont. cont -> ListFinal a cont
LFinal (Node a -> Node a -> Digit (Node a)
forall a. a -> a -> Digit a
Two Node a
n1 (Int -> a -> a -> a -> Node a
forall a. Int -> a -> a -> a -> Node a
Node3 Int
s a
x1 a
x2 a
x3), a -> a -> a -> Digit a
forall a. a -> a -> a -> Digit a
Three a
x4 a
x5 a
x6)
    getNodes Int
s Node a
n1 a
x1 [a
x2, a
x3, a
x4, a
x5, a
x6, a
x7] = (Digit (Node a), Digit a)
-> ListFinal (Node (Node a)) (Digit (Node a), Digit a)
forall a cont. cont -> ListFinal a cont
LFinal (Node a -> Node a -> Node a -> Digit (Node a)
forall a. a -> a -> a -> Digit a
Three Node a
n1 (Int -> a -> a -> a -> Node a
forall a. Int -> a -> a -> a -> Node a
Node3 Int
s a
x1 a
x2 a
x3) (Int -> a -> a -> a -> Node a
forall a. Int -> a -> a -> a -> Node a
Node3 Int
s a
x4 a
x5 a
x6), a -> Digit a
forall a. a -> Digit a
One a
x7)
    getNodes Int
s Node a
n1 a
x1 [a
x2, a
x3, a
x4, a
x5, a
x6, a
x7, a
x8] = (Digit (Node a), Digit a)
-> ListFinal (Node (Node a)) (Digit (Node a), Digit a)
forall a cont. cont -> ListFinal a cont
LFinal (Node a -> Node a -> Node a -> Digit (Node a)
forall a. a -> a -> a -> Digit a
Three Node a
n1 (Int -> a -> a -> a -> Node a
forall a. Int -> a -> a -> a -> Node a
Node3 Int
s a
x1 a
x2 a
x3) (Int -> a -> a -> a -> Node a
forall a. Int -> a -> a -> a -> Node a
Node3 Int
s a
x4 a
x5 a
x6), a -> a -> Digit a
forall a. a -> a -> Digit a
Two a
x7 a
x8)
    getNodes Int
s Node a
n1 a
x1 [a
x2, a
x3, a
x4, a
x5, a
x6, a
x7, a
x8, a
x9] = (Digit (Node a), Digit a)
-> ListFinal (Node (Node a)) (Digit (Node a), Digit a)
forall a cont. cont -> ListFinal a cont
LFinal (Node a -> Node a -> Node a -> Digit (Node a)
forall a. a -> a -> a -> Digit a
Three Node a
n1 (Int -> a -> a -> a -> Node a
forall a. Int -> a -> a -> a -> Node a
Node3 Int
s a
x1 a
x2 a
x3) (Int -> a -> a -> a -> Node a
forall a. Int -> a -> a -> a -> Node a
Node3 Int
s a
x4 a
x5 a
x6), a -> a -> a -> Digit a
forall a. a -> a -> a -> Digit a
Three a
x7 a
x8 a
x9)
    getNodes 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) = Node (Node a)
-> ListFinal (Node (Node a)) (Digit (Node a), Digit a)
-> ListFinal (Node (Node a)) (Digit (Node a), Digit a)
forall a cont. a -> ListFinal a cont -> ListFinal a cont
LCons Node (Node a)
n10 (Int
-> Node a
-> a
-> [a]
-> ListFinal (Node (Node a)) (Digit (Node a), Digit a)
forall a.
Int
-> Node a
-> a
-> [a]
-> ListFinal (Node (Node a)) (Digit (Node a), Digit a)
getNodes Int
s (Int -> a -> a -> a -> Node a
forall a. Int -> a -> a -> a -> Node a
Node3 Int
s a
x7 a
x8 a
x9) a
x10 [a]
xs)
      where !n2 :: Node a
n2 = Int -> a -> a -> a -> Node a
forall a. Int -> a -> a -> a -> Node a
Node3 Int
s a
x1 a
x2 a
x3
            !n3 :: Node a
n3 = Int -> a -> a -> a -> Node a
forall a. Int -> a -> a -> a -> Node a
Node3 Int
s a
x4 a
x5 a
x6
            !n10 :: Node (Node a)
n10 = Int -> Node a -> Node a -> Node a -> Node (Node a)
forall a. Int -> a -> a -> a -> Node a
Node3 (Int
3Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
*Int
s) Node a
n1 Node a
n2 Node a
n3

    mkTreeC ::
#ifdef __GLASGOW_HASKELL__
               forall a b c .
#endif
               (b -> FingerTree (Node a) -> c)
            -> Int
            -> ListFinal (Node a) b
            -> c
    mkTreeC :: (b -> FingerTree (Node a) -> c) -> Int -> ListFinal (Node a) b -> c
mkTreeC b -> FingerTree (Node a) -> c
cont !Int
_ (LFinal b
b) =
      b -> FingerTree (Node a) -> c
cont b
b FingerTree (Node a)
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 (Node a -> FingerTree (Node a)
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 (Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> FingerTree (Node a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
*Int
s) (Node a -> Digit (Node a)
forall a. a -> Digit a
One Node a
x1) FingerTree (Node (Node a))
forall a. FingerTree a
EmptyT (Node a -> Digit (Node a)
forall a. a -> Digit a
One Node a
x2))
    mkTreeC 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 (Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> FingerTree (Node a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
3Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
*Int
s) (Node a -> Node a -> Digit (Node a)
forall a. a -> a -> Digit a
Two Node a
x1 Node a
x2) FingerTree (Node (Node a))
forall a. FingerTree a
EmptyT (Node a -> Digit (Node a)
forall a. a -> Digit a
One Node a
x3))
    mkTreeC 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 (Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> FingerTree (Node a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
4Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
*Int
s) (Node a -> Node a -> Digit (Node a)
forall a. a -> a -> Digit a
Two Node a
x1 Node a
x2) FingerTree (Node (Node a))
forall a. FingerTree a
EmptyT (Node a -> Node a -> Digit (Node a)
forall a. a -> a -> Digit a
Two Node a
x3 Node a
x4))
    mkTreeC 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 (Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> FingerTree (Node a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
5Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
*Int
s) (Node a -> Node a -> Node a -> Digit (Node a)
forall a. a -> a -> a -> Digit a
Three Node a
x1 Node a
x2 Node a
x3) FingerTree (Node (Node a))
forall a. FingerTree a
EmptyT (Node a -> Node a -> Digit (Node a)
forall a. a -> a -> Digit a
Two Node a
x4 Node a
x5))
    mkTreeC 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 (Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> FingerTree (Node a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
6Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
*Int
s) (Node a -> Node a -> Node a -> Digit (Node a)
forall a. a -> a -> a -> Digit a
Three Node a
x1 Node a
x2 Node a
x3) FingerTree (Node (Node a))
forall a. FingerTree a
EmptyT (Node a -> Node a -> Node a -> Digit (Node a)
forall a. a -> a -> a -> Digit a
Three Node a
x4 Node a
x5 Node a
x6))
    mkTreeC 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 (Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> FingerTree (Node a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
7Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
*Int
s) (Node a -> Node a -> Digit (Node a)
forall a. a -> a -> Digit a
Two Node a
x1 Node a
x2) (Node (Node a) -> FingerTree (Node (Node a))
forall a. a -> FingerTree a
Single (Int -> Node a -> Node a -> Node a -> Node (Node a)
forall a. Int -> a -> a -> a -> Node a
Node3 (Int
3Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
*Int
s) Node a
x3 Node a
x4 Node a
x5)) (Node a -> Node a -> Digit (Node a)
forall a. a -> a -> Digit a
Two Node a
x6 Node a
x7))
    mkTreeC 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 (Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> FingerTree (Node a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
8Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
*Int
s) (Node a -> Node a -> Node a -> Digit (Node a)
forall a. a -> a -> a -> Digit a
Three Node a
x1 Node a
x2 Node a
x3) (Node (Node a) -> FingerTree (Node (Node a))
forall a. a -> FingerTree a
Single (Int -> Node a -> Node a -> Node a -> Node (Node a)
forall a. Int -> a -> a -> a -> Node a
Node3 (Int
3Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
*Int
s) Node a
x4 Node a
x5 Node a
x6)) (Node a -> Node a -> Digit (Node a)
forall a. a -> a -> Digit a
Two Node a
x7 Node a
x8))
    mkTreeC 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 (Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> FingerTree (Node a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
9Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
*Int
s) (Node a -> Node a -> Node a -> Digit (Node a)
forall a. a -> a -> a -> Digit a
Three Node a
x1 Node a
x2 Node a
x3) (Node (Node a) -> FingerTree (Node (Node a))
forall a. a -> FingerTree a
Single (Int -> Node a -> Node a -> Node a -> Node (Node a)
forall a. Int -> a -> a -> a -> Node a
Node3 (Int
3Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
*Int
s) Node a
x4 Node a
x5 Node a
x6)) (Node a -> Node a -> Node a -> Digit (Node a)
forall a. a -> a -> a -> Digit a
Three Node a
x7 Node a
x8 Node a
x9))
    mkTreeC 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 (Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> FingerTree (Node a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
10Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
*Int
s) (Node a -> Node a -> Digit (Node a)
forall a. a -> a -> Digit a
Two Node a
x1 Node a
x2) (Int
-> Digit (Node (Node a))
-> FingerTree (Node (Node (Node a)))
-> Digit (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
6Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
*Int
s) (Node (Node a) -> Digit (Node (Node a))
forall a. a -> Digit a
One (Int -> Node a -> Node a -> Node a -> Node (Node a)
forall a. Int -> a -> a -> a -> Node a
Node3 (Int
3Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
*Int
s) Node a
x3 Node a
x4 Node a
x5)) FingerTree (Node (Node (Node a)))
forall a. FingerTree a
EmptyT (Node (Node a) -> Digit (Node (Node a))
forall a. a -> Digit a
One (Int -> Node a -> Node a -> Node a -> Node (Node a)
forall a. Int -> a -> a -> a -> Node a
Node3 (Int
3Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
*Int
s) Node a
x6 Node a
x7 Node a
x8))) (Node a -> Node a -> Digit (Node a)
forall a. a -> a -> Digit a
Two Node a
y0 Node a
y1))
    mkTreeC 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 (Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> FingerTree (Node a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
11Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
*Int
s) (Node a -> Node a -> Node a -> Digit (Node a)
forall a. a -> a -> a -> Digit a
Three Node a
x1 Node a
x2 Node a
x3) (Int
-> Digit (Node (Node a))
-> FingerTree (Node (Node (Node a)))
-> Digit (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
6Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
*Int
s) (Node (Node a) -> Digit (Node (Node a))
forall a. a -> Digit a
One (Int -> Node a -> Node a -> Node a -> Node (Node a)
forall a. Int -> a -> a -> a -> Node a
Node3 (Int
3Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
*Int
s) Node a
x4 Node a
x5 Node a
x6)) FingerTree (Node (Node (Node a)))
forall a. FingerTree a
EmptyT (Node (Node a) -> Digit (Node (Node a))
forall a. a -> Digit a
One (Int -> Node a -> Node a -> Node a -> Node (Node a)
forall a. Int -> a -> a -> a -> Node a
Node3 (Int
3Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
*Int
s) Node a
x7 Node a
x8 Node a
x9))) (Node a -> Node a -> Digit (Node a)
forall a. a -> a -> Digit a
Two Node a
y0 Node a
y1))
    mkTreeC 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 (Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> FingerTree (Node a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
12Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
*Int
s) (Node a -> Node a -> Node a -> Digit (Node a)
forall a. a -> a -> a -> Digit a
Three Node a
x1 Node a
x2 Node a
x3) (Int
-> Digit (Node (Node a))
-> FingerTree (Node (Node (Node a)))
-> Digit (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
6Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
*Int
s) (Node (Node a) -> Digit (Node (Node a))
forall a. a -> Digit a
One (Int -> Node a -> Node a -> Node a -> Node (Node a)
forall a. Int -> a -> a -> a -> Node a
Node3 (Int
3Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
*Int
s) Node a
x4 Node a
x5 Node a
x6)) FingerTree (Node (Node (Node a)))
forall a. FingerTree a
EmptyT (Node (Node a) -> Digit (Node (Node a))
forall a. a -> Digit a
One (Int -> Node a -> Node a -> Node a -> Node (Node a)
forall a. Int -> a -> a -> a -> Node a
Node3 (Int
3Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
*Int
s) Node a
x7 Node a
x8 Node a
x9))) (Node a -> Node a -> Node a -> Digit (Node a)
forall a. a -> a -> a -> Digit a
Three Node a
y0 Node a
y1 Node a
y2))
    mkTreeC 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 (Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> FingerTree (Node a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
13Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
*Int
s) (Node a -> Node a -> Digit (Node a)
forall a. a -> a -> Digit a
Two Node a
x1 Node a
x2) (Int
-> Digit (Node (Node a))
-> FingerTree (Node (Node (Node a)))
-> Digit (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
9Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
*Int
s) (Node (Node a) -> Node (Node a) -> Digit (Node (Node a))
forall a. a -> a -> Digit a
Two (Int -> Node a -> Node a -> Node a -> Node (Node a)
forall a. Int -> a -> a -> a -> Node a
Node3 (Int
3Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
*Int
s) Node a
x3 Node a
x4 Node a
x5) (Int -> Node a -> Node a -> Node a -> Node (Node a)
forall a. Int -> a -> a -> a -> Node a
Node3 (Int
3Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
*Int
s) Node a
x6 Node a
x7 Node a
x8)) FingerTree (Node (Node (Node a)))
forall a. FingerTree a
EmptyT (Node (Node a) -> Digit (Node (Node a))
forall a. a -> Digit a
One (Int -> Node a -> Node a -> Node a -> Node (Node a)
forall a. Int -> a -> a -> a -> Node a
Node3 (Int
3Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
*Int
s) Node a
y0 Node a
y1 Node a
y2))) (Node a -> Node a -> Digit (Node a)
forall a. a -> a -> Digit a
Two Node a
y3 Node a
y4))
    mkTreeC 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 (Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> FingerTree (Node a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
14Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
*Int
s) (Node a -> Node a -> Node a -> Digit (Node a)
forall a. a -> a -> a -> Digit a
Three Node a
x1 Node a
x2 Node a
x3) (Int
-> Digit (Node (Node a))
-> FingerTree (Node (Node (Node a)))
-> Digit (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
9Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
*Int
s) (Node (Node a) -> Node (Node a) -> Digit (Node (Node a))
forall a. a -> a -> Digit a
Two (Int -> Node a -> Node a -> Node a -> Node (Node a)
forall a. Int -> a -> a -> a -> Node a
Node3 (Int
3Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
*Int
s) Node a
x4 Node a
x5 Node a
x6) (Int -> Node a -> Node a -> Node a -> Node (Node a)
forall a. Int -> a -> a -> a -> Node a
Node3 (Int
3Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
*Int
s) Node a
x7 Node a
x8 Node a
x9)) FingerTree (Node (Node (Node a)))
forall a. FingerTree a
EmptyT (Node (Node a) -> Digit (Node (Node a))
forall a. a -> Digit a
One (Int -> Node a -> Node a -> Node a -> Node (Node a)
forall a. Int -> a -> a -> a -> Node a
Node3 (Int
3Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
*Int
s) Node a
y0 Node a
y1 Node a
y2))) (Node a -> Node a -> Digit (Node a)
forall a. a -> a -> Digit a
Two Node a
y3 Node a
y4))
    mkTreeC 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 (Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> FingerTree (Node a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
15Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
*Int
s) (Node a -> Node a -> Node a -> Digit (Node a)
forall a. a -> a -> a -> Digit a
Three Node a
x1 Node a
x2 Node a
x3) (Int
-> Digit (Node (Node a))
-> FingerTree (Node (Node (Node a)))
-> Digit (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
9Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
*Int
s) (Node (Node a) -> Node (Node a) -> Digit (Node (Node a))
forall a. a -> a -> Digit a
Two (Int -> Node a -> Node a -> Node a -> Node (Node a)
forall a. Int -> a -> a -> a -> Node a
Node3 (Int
3Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
*Int
s) Node a
x4 Node a
x5 Node a
x6) (Int -> Node a -> Node a -> Node a -> Node (Node a)
forall a. Int -> a -> a -> a -> Node a
Node3 (Int
3Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
*Int
s) Node a
x7 Node a
x8 Node a
x9)) FingerTree (Node (Node (Node a)))
forall a. FingerTree a
EmptyT (Node (Node a) -> Digit (Node (Node a))
forall a. a -> Digit a
One (Int -> Node a -> Node a -> Node a -> Node (Node a)
forall a. Int -> a -> a -> a -> Node a
Node3 (Int
3Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
*Int
s) Node a
y0 Node a
y1 Node a
y2))) (Node a -> Node a -> Node a -> Digit (Node a)
forall a. a -> a -> a -> Digit a
Three Node a
y3 Node a
y4 Node a
y5))
    mkTreeC 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)))))))))))))))) =
      ((b, Digit (Node (Node a)), Digit (Node a))
 -> FingerTree (Node (Node (Node a))) -> c)
-> Int
-> ListFinal
     (Node (Node (Node a))) (b, Digit (Node (Node a)), Digit (Node a))
-> c
forall a b c.
(b -> FingerTree (Node a) -> c) -> Int -> ListFinal (Node a) b -> c
mkTreeC (b, Digit (Node (Node a)), Digit (Node a))
-> FingerTree (Node (Node (Node a))) -> c
cont2 (Int
9Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
*Int
s) (Int
-> Node (Node a)
-> Node a
-> ListFinal (Node a) b
-> ListFinal
     (Node (Node (Node a))) (b, Digit (Node (Node a)), Digit (Node a))
forall a b.
Int
-> Node a
-> a
-> ListFinal a b
-> ListFinal (Node (Node a)) (b, Digit (Node a), Digit a)
getNodesC (Int
3Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
*Int
s) (Int -> Node a -> Node a -> Node a -> Node (Node a)
forall a. Int -> a -> a -> a -> Node a
Node3 (Int
3Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
*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 = Node a -> Node a -> Node a -> Digit (Node a)
forall a. a -> a -> a -> Digit a
Three Node a
x1 Node a
x2 Node a
x3
              d1 :: Digit (Node (Node a))
d1 = Node (Node a)
-> Node (Node a) -> Node (Node a) -> Digit (Node (Node a))
forall a. a -> a -> a -> Digit a
Three (Int -> Node a -> Node a -> Node a -> Node (Node a)
forall a. Int -> a -> a -> a -> Node a
Node3 (Int
3Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
*Int
s) Node a
x4 Node a
x5 Node a
x6) (Int -> Node a -> Node a -> Node a -> Node (Node a)
forall a. Int -> a -> a -> a -> Node a
Node3 (Int
3Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
*Int
s) Node a
x7 Node a
x8 Node a
x9) (Int -> Node a -> Node a -> Node a -> Node (Node a)
forall a. Int -> a -> a -> a -> Node a
Node3 (Int
3Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
*Int
s) Node a
y0 Node a
y1 Node a
y2)
              !sub1 :: FingerTree (Node (Node a))
sub1 = Int
-> Digit (Node (Node a))
-> FingerTree (Node (Node (Node a)))
-> Digit (Node (Node a))
-> FingerTree (Node (Node a))
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
9Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
*Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Digit (Node (Node a)) -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized a => Sized (Digit a)
Instance of class: Sized of the constraint type forall a. Sized (Node a)
size Digit (Node (Node a))
r1 Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ FingerTree (Node (Node (Node a))) -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized a => Sized (FingerTree a)
Instance of class: Sized of the constraint type forall a. Sized (Node a)
size FingerTree (Node (Node (Node a)))
sub) Digit (Node (Node a))
d1 FingerTree (Node (Node (Node a)))
sub Digit (Node (Node a))
r1
          in b -> FingerTree (Node a) -> c
cont b
b (FingerTree (Node a) -> c) -> FingerTree (Node a) -> c
forall a b. (a -> b) -> a -> b
$! Int
-> Digit (Node a)
-> FingerTree (Node (Node a))
-> Digit (Node a)
-> FingerTree (Node a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
3Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
*Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Digit (Node a) -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized a => Sized (Digit a)
Instance of class: Sized of the constraint type forall a. Sized (Node a)
size Digit (Node a)
r2 Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ FingerTree (Node (Node a)) -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized a => Sized (FingerTree a)
Instance of class: Sized of the constraint type forall a. Sized (Node a)
size FingerTree (Node (Node a))
sub1) Digit (Node a)
d2 FingerTree (Node (Node a))
sub1 Digit (Node a)
r2

    getNodesC :: Int
              -> Node a
              -> a
              -> ListFinal a b
              -> ListFinal (Node (Node a)) (b, Digit (Node a), Digit a)
    getNodesC :: Int
-> Node a
-> a
-> ListFinal a b
-> ListFinal (Node (Node a)) (b, Digit (Node a), Digit a)
getNodesC !Int
_ Node a
n1 a
x1 (LFinal b
b) = (b, Digit (Node a), Digit a)
-> ListFinal (Node (Node a)) (b, Digit (Node a), Digit a)
forall a cont. cont -> ListFinal a cont
LFinal ((b, Digit (Node a), Digit a)
 -> ListFinal (Node (Node a)) (b, Digit (Node a), Digit a))
-> (b, Digit (Node a), Digit a)
-> ListFinal (Node (Node a)) (b, Digit (Node a), Digit a)
forall a b. (a -> b) -> a -> b
$ (b
b, Node a -> Digit (Node a)
forall a. a -> Digit a
One Node a
n1, a -> Digit a
forall a. a -> Digit a
One a
x1)
    getNodesC Int
_  Node a
n1  a
x1 (LCons a
x2 (LFinal b
b)) = (b, Digit (Node a), Digit a)
-> ListFinal (Node (Node a)) (b, Digit (Node a), Digit a)
forall a cont. cont -> ListFinal a cont
LFinal ((b, Digit (Node a), Digit a)
 -> ListFinal (Node (Node a)) (b, Digit (Node a), Digit a))
-> (b, Digit (Node a), Digit a)
-> ListFinal (Node (Node a)) (b, Digit (Node a), Digit a)
forall a b. (a -> b) -> a -> b
$ (b
b, Node a -> Digit (Node a)
forall a. a -> Digit a
One Node a
n1, a -> a -> Digit a
forall a. a -> a -> Digit a
Two a
x1 a
x2)
    getNodesC Int
_  Node a
n1  a
x1 (LCons a
x2 (LCons a
x3 (LFinal b
b))) = (b, Digit (Node a), Digit a)
-> ListFinal (Node (Node a)) (b, Digit (Node a), Digit a)
forall a cont. cont -> ListFinal a cont
LFinal ((b, Digit (Node a), Digit a)
 -> ListFinal (Node (Node a)) (b, Digit (Node a), Digit a))
-> (b, Digit (Node a), Digit a)
-> ListFinal (Node (Node a)) (b, Digit (Node a), Digit a)
forall a b. (a -> b) -> a -> b
$ (b
b, Node a -> Digit (Node a)
forall a. a -> Digit a
One Node a
n1, a -> a -> a -> Digit a
forall a. a -> a -> a -> Digit a
Three a
x1 a
x2 a
x3)
    getNodesC Int
s  Node a
n1  a
x1 (LCons a
x2 (LCons a
x3 (LCons a
x4 (LFinal b
b)))) =
      let !n2 :: Node a
n2 = Int -> a -> a -> a -> Node a
forall a. Int -> a -> a -> a -> Node a
Node3 Int
s a
x1 a
x2 a
x3
      in (b, Digit (Node a), Digit a)
-> ListFinal (Node (Node a)) (b, Digit (Node a), Digit a)
forall a cont. cont -> ListFinal a cont
LFinal ((b, Digit (Node a), Digit a)
 -> ListFinal (Node (Node a)) (b, Digit (Node a), Digit a))
-> (b, Digit (Node a), Digit a)
-> ListFinal (Node (Node a)) (b, Digit (Node a), Digit a)
forall a b. (a -> b) -> a -> b
$ (b
b, Node a -> Node a -> Digit (Node a)
forall a. a -> a -> Digit a
Two Node a
n1 Node a
n2, a -> Digit a
forall a. a -> Digit a
One a
x4)
    getNodesC 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 = Int -> a -> a -> a -> Node a
forall a. Int -> a -> a -> a -> Node a
Node3 Int
s a
x1 a
x2 a
x3
      in (b, Digit (Node a), Digit a)
-> ListFinal (Node (Node a)) (b, Digit (Node a), Digit a)
forall a cont. cont -> ListFinal a cont
LFinal ((b, Digit (Node a), Digit a)
 -> ListFinal (Node (Node a)) (b, Digit (Node a), Digit a))
-> (b, Digit (Node a), Digit a)
-> ListFinal (Node (Node a)) (b, Digit (Node a), Digit a)
forall a b. (a -> b) -> a -> b
$ (b
b, Node a -> Node a -> Digit (Node a)
forall a. a -> a -> Digit a
Two Node a
n1 Node a
n2, a -> a -> Digit a
forall a. a -> a -> Digit a
Two a
x4 a
x5)
    getNodesC 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 = Int -> a -> a -> a -> Node a
forall a. Int -> a -> a -> a -> Node a
Node3 Int
s a
x1 a
x2 a
x3
      in (b, Digit (Node a), Digit a)
-> ListFinal (Node (Node a)) (b, Digit (Node a), Digit a)
forall a cont. cont -> ListFinal a cont
LFinal ((b, Digit (Node a), Digit a)
 -> ListFinal (Node (Node a)) (b, Digit (Node a), Digit a))
-> (b, Digit (Node a), Digit a)
-> ListFinal (Node (Node a)) (b, Digit (Node a), Digit a)
forall a b. (a -> b) -> a -> b
$ (b
b, Node a -> Node a -> Digit (Node a)
forall a. a -> a -> Digit a
Two Node a
n1 Node a
n2, a -> a -> a -> Digit a
forall a. a -> a -> a -> Digit a
Three a
x4 a
x5 a
x6)
    getNodesC 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 = Int -> a -> a -> a -> Node a
forall a. Int -> a -> a -> a -> Node a
Node3 Int
s a
x1 a
x2 a
x3
          !n3 :: Node a
n3 = Int -> a -> a -> a -> Node a
forall a. Int -> a -> a -> a -> Node a
Node3 Int
s a
x4 a
x5 a
x6
      in (b, Digit (Node a), Digit a)
-> ListFinal (Node (Node a)) (b, Digit (Node a), Digit a)
forall a cont. cont -> ListFinal a cont
LFinal ((b, Digit (Node a), Digit a)
 -> ListFinal (Node (Node a)) (b, Digit (Node a), Digit a))
-> (b, Digit (Node a), Digit a)
-> ListFinal (Node (Node a)) (b, Digit (Node a), Digit a)
forall a b. (a -> b) -> a -> b
$ (b
b, Node a -> Node a -> Node a -> Digit (Node a)
forall a. a -> a -> a -> Digit a
Three Node a
n1 Node a
n2 Node a
n3, a -> Digit a
forall a. a -> Digit a
One a
x7)
    getNodesC 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 = Int -> a -> a -> a -> Node a
forall a. Int -> a -> a -> a -> Node a
Node3 Int
s a
x1 a
x2 a
x3
          !n3 :: Node a
n3 = Int -> a -> a -> a -> Node a
forall a. Int -> a -> a -> a -> Node a
Node3 Int
s a
x4 a
x5 a
x6
      in (b, Digit (Node a), Digit a)
-> ListFinal (Node (Node a)) (b, Digit (Node a), Digit a)
forall a cont. cont -> ListFinal a cont
LFinal ((b, Digit (Node a), Digit a)
 -> ListFinal (Node (Node a)) (b, Digit (Node a), Digit a))
-> (b, Digit (Node a), Digit a)
-> ListFinal (Node (Node a)) (b, Digit (Node a), Digit a)
forall a b. (a -> b) -> a -> b
$ (b
b, Node a -> Node a -> Node a -> Digit (Node a)
forall a. a -> a -> a -> Digit a
Three Node a
n1 Node a
n2 Node a
n3, a -> a -> Digit a
forall a. a -> a -> Digit a
Two a
x7 a
x8)
    getNodesC 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 = Int -> a -> a -> a -> Node a
forall a. Int -> a -> a -> a -> Node a
Node3 Int
s a
x1 a
x2 a
x3
          !n3 :: Node a
n3 = Int -> a -> a -> a -> Node a
forall a. Int -> a -> a -> a -> Node a
Node3 Int
s a
x4 a
x5 a
x6
      in (b, Digit (Node a), Digit a)
-> ListFinal (Node (Node a)) (b, Digit (Node a), Digit a)
forall a cont. cont -> ListFinal a cont
LFinal ((b, Digit (Node a), Digit a)
 -> ListFinal (Node (Node a)) (b, Digit (Node a), Digit a))
-> (b, Digit (Node a), Digit a)
-> ListFinal (Node (Node a)) (b, Digit (Node a), Digit a)
forall a b. (a -> b) -> a -> b
$ (b
b, Node a -> Node a -> Node a -> Digit (Node a)
forall a. a -> a -> a -> Digit a
Three Node a
n1 Node a
n2 Node a
n3, a -> a -> a -> Digit a
forall a. a -> a -> a -> Digit a
Three a
x7 a
x8 a
x9)
    getNodesC 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))))))))) =
        Node (Node a)
-> ListFinal (Node (Node a)) (b, Digit (Node a), Digit a)
-> ListFinal (Node (Node a)) (b, Digit (Node a), Digit a)
forall a cont. a -> ListFinal a cont -> ListFinal a cont
LCons Node (Node a)
n10 (ListFinal (Node (Node a)) (b, Digit (Node a), Digit a)
 -> ListFinal (Node (Node a)) (b, Digit (Node a), Digit a))
-> ListFinal (Node (Node a)) (b, Digit (Node a), Digit a)
-> ListFinal (Node (Node a)) (b, Digit (Node a), Digit a)
forall a b. (a -> b) -> a -> b
$ Int
-> Node a
-> a
-> ListFinal a b
-> ListFinal (Node (Node a)) (b, Digit (Node a), Digit a)
forall a b.
Int
-> Node a
-> a
-> ListFinal a b
-> ListFinal (Node (Node a)) (b, Digit (Node a), Digit a)
getNodesC Int
s (Int -> a -> a -> a -> Node a
forall a. Int -> a -> a -> a -> Node a
Node3 Int
s a
x7 a
x8 a
x9) a
x10 ListFinal a b
xs
      where !n2 :: Node a
n2 = Int -> a -> a -> a -> Node a
forall a. Int -> a -> a -> a -> Node a
Node3 Int
s a
x1 a
x2 a
x3
            !n3 :: Node a
n3 = Int -> a -> a -> a -> Node a
forall a. Int -> a -> a -> a -> Node a
Node3 Int
s a
x4 a
x5 a
x6
            !n10 :: Node (Node a)
n10 = Int -> Node a -> Node a -> Node a -> Node (Node a)
forall a. Int -> a -> a -> a -> Node a
Node3 (Int
3Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
*Int
s) Node a
n1 Node a
n2 Node a
n3

    map_elem :: [a] -> [Elem a]
#if __GLASGOW_HASKELL__ >= 708
    map_elem :: [a] -> [Elem a]
map_elem [a]
xs = [a] -> [Elem a]
coerce [a]
xs
#else
    map_elem xs = Data.List.map Elem xs
#endif
    {-# INLINE map_elem #-}

-- essentially: Free ((,) a) b.
data ListFinal a cont = LFinal !cont | LCons !a (ListFinal a cont)

#if __GLASGOW_HASKELL__ >= 708
instance GHC.Exts.IsList (Seq a) where
    type Item (Seq a) = a
    fromList :: [Item (Seq a)] -> Seq a
fromList = [Item (Seq a)] -> Seq a
forall a. [a] -> Seq a
fromList
    fromListN :: Int -> [Item (Seq a)] -> Seq a
fromListN = Int -> [Item (Seq a)] -> Seq a
forall a. Int -> [a] -> Seq a
fromList2
    toList :: Seq a -> [Item (Seq a)]
toList = Seq a -> [Item (Seq a)]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Instance of class: Foldable of the constraint type Foldable Seq
toList
#endif

#ifdef __GLASGOW_HASKELL__
-- | @since 0.5.7
instance a ~ Char => IsString (Seq a) where
    fromString :: [Char] -> Seq a
fromString = [Char] -> Seq a
forall a. [a] -> Seq a
fromList
#endif

------------------------------------------------------------------------
-- Reverse
------------------------------------------------------------------------

-- | \( O(n) \). The reverse of a sequence.
reverse :: Seq a -> Seq a
reverse :: Seq a -> Seq a
reverse (Seq FingerTree (Elem a)
xs) = FingerTree (Elem a) -> Seq a
forall a. FingerTree (Elem a) -> Seq a
Seq ((Elem a -> Elem a) -> FingerTree (Elem a) -> FingerTree (Elem a)
forall a b. (a -> b) -> FingerTree a -> FingerTree b
fmapReverseTree Elem a -> Elem a
forall a. a -> a
id FingerTree (Elem a)
xs)

#ifdef __GLASGOW_HASKELL__
{-# NOINLINE [1] reverse #-}

-- | \( O(n) \). Reverse a sequence while mapping over it. This is not
-- currently exported, but is used in rewrite rules.
fmapReverse :: (a -> b) -> Seq a -> Seq b
fmapReverse :: (a -> b) -> Seq a -> Seq b
fmapReverse a -> b
f (Seq FingerTree (Elem a)
xs) = FingerTree (Elem b) -> Seq b
forall a. FingerTree (Elem a) -> Seq a
Seq ((Elem a -> Elem b) -> FingerTree (Elem a) -> FingerTree (Elem b)
forall a b. (a -> b) -> FingerTree a -> FingerTree b
fmapReverseTree ((a -> b) -> Elem a -> Elem b
forall a b. (a -> b) -> Elem a -> Elem b
lift_elem a -> b
f) FingerTree (Elem a)
xs)
  where
    lift_elem :: (a -> b) -> (Elem a -> Elem b)
#if __GLASGOW_HASKELL__ >= 708
    lift_elem :: (a -> b) -> Elem a -> Elem b
lift_elem = (a -> b) -> Elem a -> Elem b
coerce
#else
    lift_elem g (Elem a) = Elem (g a)
#endif

-- If we're mapping over a sequence, we can reverse it at the same time
-- at no extra charge.
{-# RULES
"fmapSeq/reverse" forall f xs . fmapSeq f (reverse xs) = fmapReverse f xs
"reverse/fmapSeq" forall f xs . reverse (fmapSeq f xs) = fmapReverse f xs
 #-}
#endif

fmapReverseTree :: (a -> b) -> FingerTree a -> FingerTree b
fmapReverseTree :: (a -> b) -> FingerTree a -> FingerTree b
fmapReverseTree a -> b
_ FingerTree a
EmptyT = FingerTree b
forall a. FingerTree a
EmptyT
fmapReverseTree a -> b
f (Single a
x) = b -> FingerTree b
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) =
    Int -> Digit b -> FingerTree (Node b) -> Digit b -> FingerTree b
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
s ((a -> b) -> Digit a -> Digit b
forall a b. (a -> b) -> Digit a -> Digit b
reverseDigit a -> b
f Digit a
sf)
        ((Node a -> Node b) -> FingerTree (Node a) -> FingerTree (Node b)
forall a b. (a -> b) -> FingerTree a -> FingerTree b
fmapReverseTree ((a -> b) -> Node a -> Node b
forall a b. (a -> b) -> Node a -> Node b
reverseNode a -> b
f) FingerTree (Node a)
m)
        ((a -> b) -> Digit a -> Digit b
forall a b. (a -> b) -> Digit a -> Digit b
reverseDigit a -> b
f Digit a
pr)

{-# INLINE reverseDigit #-}
reverseDigit :: (a -> b) -> Digit a -> Digit b
reverseDigit :: (a -> b) -> Digit a -> Digit b
reverseDigit a -> b
f (One a
a) = b -> Digit b
forall a. a -> Digit a
One (a -> b
f a
a)
reverseDigit a -> b
f (Two a
a a
b) = b -> b -> Digit 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) = b -> b -> b -> Digit b
forall a. a -> a -> a -> Digit a
Three (a -> b
f a
c) (a -> b
f a
b) (a -> b
f a
a)
reverseDigit a -> b
f (Four a
a a
b a
c a
d) = b -> b -> b -> b -> Digit b
forall a. a -> a -> a -> a -> Digit a
Four (a -> b
f a
d) (a -> b
f a
c) (a -> b
f a
b) (a -> b
f a
a)

reverseNode :: (a -> b) -> Node a -> Node b
reverseNode :: (a -> b) -> Node a -> Node b
reverseNode a -> b
f (Node2 Int
s a
a a
b) = Int -> b -> b -> Node b
forall a. Int -> a -> a -> Node a
Node2 Int
s (a -> b
f a
b) (a -> b
f a
a)
reverseNode a -> b
f (Node3 Int
s a
a a
b a
c) = Int -> b -> b -> b -> Node b
forall a. Int -> a -> a -> a -> Node a
Node3 Int
s (a -> b
f a
c) (a -> b
f a
b) (a -> b
f a
a)

------------------------------------------------------------------------
-- Mapping with a splittable value
------------------------------------------------------------------------

-- For zipping, it is useful to build a result by
-- traversing a sequence while splitting up something else.  For zipping, we
-- traverse the first sequence while splitting up the second.
--
-- What makes all this crazy code a good idea:
--
-- Suppose we zip together two sequences of the same length:
--
-- zs = zip xs ys
--
-- We want to get reasonably fast indexing into zs immediately, rather than
-- needing to construct the entire thing first, as the previous implementation
-- required. The first aspect is that we build the result "outside-in" or
-- "top-down", rather than left to right. That gives us access to both ends
-- quickly. But that's not enough, by itself, to give immediate access to the
-- center of zs. For that, we need to be able to skip over larger segments of
-- zs, delaying their construction until we actually need them. The way we do
-- this is to traverse xs, while splitting up ys according to the structure of
-- xs. If we have a Deep _ pr m sf, we split ys into three pieces, and hand off
-- one piece to the prefix, one to the middle, and one to the suffix of the
-- result. The key point is that we don't need to actually do anything further
-- with those pieces until we actually need them; the computations to split
-- them up further and zip them with their matching pieces can be delayed until
-- they're actually needed. We do the same thing for Digits (splitting into
-- between one and four pieces) and Nodes (splitting into two or three). The
-- ultimate result is that we can index into, or split at, any location in zs
-- in polylogarithmic time *immediately*, while still being able to force all
-- the thunks in O(n) time.
--
-- Benchmark info, and alternatives:
--
-- The old zipping code used mapAccumL to traverse the first sequence while
-- cutting down the second sequence one piece at a time.
--
-- An alternative way to express that basic idea is to convert both sequences
-- to lists, zip the lists, and then convert the result back to a sequence.
-- I'll call this the "listy" implementation.
--
-- I benchmarked two operations: Each started by zipping two sequences
-- constructed with replicate and/or fromList. The first would then immediately
-- index into the result. The second would apply deepseq to force the entire
-- result.  The new implementation worked much better than either of the others
-- on the immediate indexing test, as expected. It also worked better than the
-- old implementation for all the deepseq tests. For short sequences, the listy
-- implementation outperformed all the others on the deepseq test. However, the
-- splitting implementation caught up and surpassed it once the sequences grew
-- long enough. It seems likely that by avoiding rebuilding, it interacts
-- better with the cache hierarchy.
--
-- David Feuer, with some guidance from Carter Schonwald, December 2014

-- | \( O(n) \). Constructs a new sequence with the same structure as an existing
-- sequence using a user-supplied mapping function along with a splittable
-- value and a way to split it. The value is split up lazily according to the
-- structure of the sequence, so one piece of the value is distributed to each
-- element of the sequence. The caller should provide a splitter function that
-- takes a number, @n@, and a splittable value, breaks off a chunk of size @n@
-- from the value, and returns that chunk and the remainder as a pair. The
-- following examples will hopefully make the usage clear:
--
-- > zipWith :: (a -> b -> c) -> Seq a -> Seq b -> Seq c
-- > zipWith f s1 s2 = splitMap splitAt (\b a -> f a (b `index` 0)) s2' s1'
-- >   where
-- >     minLen = min (length s1) (length s2)
-- >     s1' = take minLen s1
-- >     s2' = take minLen s2
--
-- > mapWithIndex :: (Int -> a -> b) -> Seq a -> Seq b
-- > mapWithIndex f = splitMap (\n i -> (i, n+i)) f 0
#ifdef __GLASGOW_HASKELL__
-- We use ScopedTypeVariables to improve performance and make
-- performance less sensitive to minor changes.

-- We INLINE this so GHC can see that the function passed in is
-- strict in its Int argument.
{-# INLINE splitMap #-}
splitMap :: forall s a' b' . (Int -> s -> (s,s)) -> (s -> a' -> b') -> s -> Seq a' -> Seq b'
splitMap :: (Int -> s -> (s, s)) -> (s -> a' -> b') -> s -> Seq a' -> Seq b'
splitMap Int -> s -> (s, s)
splt s -> a' -> b'
f0 s
s0 (Seq FingerTree (Elem a')
xs0) = FingerTree (Elem b') -> Seq b'
forall a. FingerTree (Elem a) -> Seq a
Seq (FingerTree (Elem b') -> Seq b') -> FingerTree (Elem b') -> Seq b'
forall a b. (a -> b) -> a -> b
$ (s -> Elem a' -> Elem b')
-> s -> FingerTree (Elem a') -> FingerTree (Elem b')
forall y b.
(s -> Elem y -> b) -> s -> FingerTree (Elem y) -> FingerTree b
splitMapTreeE (\s
s' (Elem a'
a) -> b' -> Elem b'
forall a. a -> Elem a
Elem (s -> a' -> b'
f0 s
s' a'
a)) s
s0 FingerTree (Elem a')
xs0
  where
    {-# INLINE splitMapTreeE #-}
    splitMapTreeE :: (s -> Elem y -> b) -> s -> FingerTree (Elem y) -> FingerTree b
    splitMapTreeE :: (s -> Elem y -> b) -> s -> FingerTree (Elem y) -> FingerTree b
splitMapTreeE  s -> Elem y -> b
_ s
_ FingerTree (Elem y)
EmptyT = FingerTree b
forall a. FingerTree a
EmptyT
    splitMapTreeE  s -> Elem y -> b
f s
s (Single Elem y
xs) = b -> FingerTree b
forall a. a -> FingerTree a
Single (b -> FingerTree b) -> b -> FingerTree b
forall a b. (a -> b) -> a -> b
$ s -> Elem y -> b
f s
s Elem y
xs
    splitMapTreeE  s -> Elem y -> b
f s
s (Deep Int
n Digit (Elem y)
pr FingerTree (Node (Elem y))
m Digit (Elem y)
sf) = Int -> Digit b -> FingerTree (Node b) -> Digit b -> FingerTree b
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
n ((s -> Elem y -> b) -> s -> Digit (Elem y) -> Digit b
forall a b. Sized a => (s -> a -> b) -> s -> Digit a -> Digit b
Instance of class: Sized of the constraint type forall a. Sized (Elem a)
splitMapDigit s -> Elem y -> b
f s
prs Digit (Elem y)
pr) ((s -> Node (Elem y) -> Node b)
-> s -> FingerTree (Node (Elem y)) -> FingerTree (Node b)
forall a b.
(s -> Node a -> b) -> s -> FingerTree (Node a) -> FingerTree b
splitMapTreeN (\s
eta1 Node (Elem y)
eta2 -> (s -> Elem y -> b) -> s -> Node (Elem y) -> Node b
forall a b. Sized a => (s -> a -> b) -> s -> Node a -> Node b
Instance of class: Sized of the constraint type forall a. Sized (Elem a)
splitMapNode s -> Elem y -> b
f s
eta1 Node (Elem y)
eta2) s
ms FingerTree (Node (Elem y))
m) ((s -> Elem y -> b) -> s -> Digit (Elem y) -> Digit b
forall a b. Sized a => (s -> a -> b) -> s -> Digit a -> Digit b
Instance of class: Sized of the constraint type forall a. Sized (Elem a)
splitMapDigit s -> Elem y -> b
f s
sfs Digit (Elem y)
sf)
          where
            !spr :: Int
spr = Digit (Elem y) -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized a => Sized (Digit a)
Instance of class: Sized of the constraint type forall a. Sized (Elem a)
size Digit (Elem y)
pr
            !sm :: Int
sm = Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
spr Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Digit (Elem y) -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized a => Sized (Digit a)
Instance of class: Sized of the constraint type forall a. Sized (Elem a)
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 :: (s -> Node a -> b) -> s -> FingerTree (Node a) -> FingerTree b
splitMapTreeN s -> Node a -> b
_ s
_ FingerTree (Node a)
EmptyT = FingerTree b
forall a. FingerTree a
EmptyT
    splitMapTreeN s -> Node a -> b
f s
s (Single Node a
xs) = b -> FingerTree b
forall a. a -> FingerTree a
Single (b -> FingerTree b) -> b -> FingerTree b
forall a b. (a -> b) -> a -> b
$ s -> Node a -> b
f s
s Node a
xs
    splitMapTreeN s -> Node a -> b
f s
s (Deep Int
n Digit (Node a)
pr FingerTree (Node (Node a))
m Digit (Node a)
sf) = Int -> Digit b -> FingerTree (Node b) -> Digit b -> FingerTree b
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
n ((s -> Node a -> b) -> s -> Digit (Node a) -> Digit b
forall a b. Sized a => (s -> a -> b) -> s -> Digit a -> Digit b
Instance of class: Sized of the constraint type forall a. Sized (Node a)
splitMapDigit s -> Node a -> b
f s
prs Digit (Node a)
pr) ((s -> Node (Node a) -> Node b)
-> s -> FingerTree (Node (Node a)) -> FingerTree (Node b)
forall a b.
(s -> Node a -> b) -> s -> FingerTree (Node a) -> FingerTree b
splitMapTreeN (\s
eta1 Node (Node a)
eta2 -> (s -> Node a -> b) -> s -> Node (Node a) -> Node b
forall a b. Sized a => (s -> a -> b) -> s -> Node a -> Node b
Instance of class: Sized of the constraint type forall a. Sized (Node a)
splitMapNode s -> Node a -> b
f s
eta1 Node (Node a)
eta2) s
ms FingerTree (Node (Node a))
m) ((s -> Node a -> b) -> s -> Digit (Node a) -> Digit b
forall a b. Sized a => (s -> a -> b) -> s -> Digit a -> Digit b
Instance of class: Sized of the constraint type forall a. Sized (Node a)
splitMapDigit s -> Node a -> b
f s
sfs Digit (Node a)
sf)
          where
            (s
prs, s
r) = Int -> s -> (s, s)
splt (Digit (Node a) -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized a => Sized (Digit a)
Instance of class: Sized of the constraint type forall a. Sized (Node a)
size Digit (Node a)
pr) s
s
            (s
ms, s
sfs) = Int -> s -> (s, s)
splt (FingerTree (Node (Node a)) -> Int
forall a. Sized a => a -> Int
Instance of class: Sized of the constraint type forall a. Sized a => Sized (FingerTree a)
Instance of class: Sized of the constraint type forall a. Sized (Node a)
size FingerTree (Node (Node a))
m) s
r

    {-# INLINE splitMapDigit #-}
    splitMapDigit :: Sized a => (s -> a -> b) -> s -> Digit a -> Digit b
    splitMapDigit :: (s -> a -> b) -> s -> Digit a -> Digit b
splitMapDigit s -> a -> b
f s
s (One a
a) = b -> Digit b
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) = b -> b -> Digit b
forall a. a -> a -> Digit a
Two (s -> a -> b
f s
first a
a) (s -> a -> b
f s
second a
b)
      where
        (s
first, s
second) = Int -> s -> (s, s)
splt (a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
size a
a) s
s
    splitMapDigit s -> a -> b
f s
s (Three a
a a
b a
c) = b -> b -> b -> Digit b
forall a. a -> a -> a -> Digit a
Three (s -> a -> b
f s
first a
a) (s -> a -> b
f s
second a
b) (s -> a -> b
f s
third a
c)
      where
        (s
first, s
r) = Int -> s -> (s, s)
splt (a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
size a
a) s
s
        (s
second, s
third) = Int -> s -> (s, s)
splt (a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
size a
b) s
r
    splitMapDigit s -> a -> b
f s
s (Four a
a a
b a
c a
d) = b -> b -> b -> b -> Digit b
forall a. a -> a -> a -> a -> Digit a
Four (s -> a -> b
f s
first a
a) (s -> a -> b
f s
second a
b) (s -> a -> b
f s
third a
c) (s -> a -> b
f s
fourth a
d)
      where
        (s
first, s
s') = Int -> s -> (s, s)
splt (a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
size a
a) s
s
        (s
middle, s
fourth) = Int -> s -> (s, s)
splt (a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
size a
b Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
size a
c) s
s'
        (s
second, s
third) = Int -> s -> (s, s)
splt (a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
size a
b) s
middle

    {-# INLINE splitMapNode #-}
    splitMapNode :: Sized a => (s -> a -> b) -> s -> Node a -> Node b
    splitMapNode :: (s -> a -> b) -> s -> Node a -> Node b
splitMapNode s -> a -> b
f s
s (Node2 Int
ns a
a a
b) = Int -> b -> b -> Node b
forall a. Int -> a -> a -> Node a
Node2 Int
ns (s -> a -> b
f s
first a
a) (s -> a -> b
f s
second a
b)
      where
        (s
first, s
second) = Int -> s -> (s, s)
splt (a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
size a
a) s
s
    splitMapNode s -> a -> b
f s
s (Node3 Int
ns a
a a
b a
c) = Int -> b -> b -> b -> Node b
forall a. Int -> a -> a -> a -> Node a
Node3 Int
ns (s -> a -> b
f s
first a
a) (s -> a -> b
f s
second a
b) (s -> a -> b
f s
third a
c)
      where
        (s
first, s
r) = Int -> s -> (s, s)
splt (a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
size a
a) s
s
        (s
second, s
third) = Int -> s -> (s, s)
splt (a -> Int
forall a. Sized a => a -> Int
Evidence bound by a type signature of the constraint type Sized a
size a
b) s
r

#else
-- Implementation without ScopedTypeVariables--somewhat slower,
-- and much more sensitive to minor changes in various places.

{-# 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

------------------------------------------------------------------------
-- Zipping
------------------------------------------------------------------------

-- We use a custom definition of munzip to avoid retaining
-- memory longer than necessary. Using the default definition, if
-- we write
--
-- let (xs,ys) = munzip zs
-- in xs `deepseq` (... ys ...)
--
-- then ys will retain the entire zs sequence until ys itself is fully forced.
-- This implementation uses the selector thunk optimization to prevent that.
-- Unfortunately, that optimization is fragile, so we can't actually guarantee
-- anything.

-- | @ 'mzipWith' = 'zipWith' @
--
-- @ 'munzip' = 'unzip' @
instance MonadZip Seq where
  mzipWith :: (a -> b -> c) -> Seq a -> Seq b -> Seq c
mzipWith = (a -> b -> c) -> Seq a -> Seq b -> Seq c
forall a b c. (a -> b -> c) -> Seq a -> Seq b -> Seq c
zipWith
  munzip :: Seq (a, b) -> (Seq a, Seq b)
munzip = Seq (a, b) -> (Seq a, Seq b)
forall a b. Seq (a, b) -> (Seq a, Seq b)
unzip

-- | Unzip a sequence of pairs.
--
-- @
-- unzip ps = ps ``seq`` ('fmap' 'fst' ps) ('fmap' 'snd' ps)
-- @
--
-- Example:
--
-- @
-- unzip $ fromList [(1,"a"), (2,"b"), (3,"c")] =
--   (fromList [1,2,3], fromList ["a", "b", "c"])
-- @
--
-- See the note about efficiency at 'unzipWith'.
--
-- @since 0.5.11
unzip :: Seq (a, b) -> (Seq a, Seq b)
unzip :: Seq (a, b) -> (Seq a, Seq b)
unzip Seq (a, b)
xs = ((a, b) -> (a, b)) -> Seq (a, b) -> (Seq a, Seq b)
forall a b c. (a -> (b, c)) -> Seq a -> (Seq b, Seq c)
unzipWith (a, b) -> (a, b)
forall a. a -> a
id Seq (a, b)
xs

-- | \( O(n) \). Unzip a sequence using a function to divide elements.
--
-- @ unzipWith f xs == 'unzip' ('fmap' f xs) @
--
-- Efficiency note:
--
-- @unzipWith@ produces its two results in lockstep. If you calculate
-- @ unzipWith f xs @ and fully force /either/ of the results, then the
-- entire structure of the /other/ one will be built as well. This
-- behavior allows the garbage collector to collect each calculated
-- pair component as soon as it dies, without having to wait for its mate
-- to die. If you do not need this behavior, you may be better off simply
-- calculating the sequence of pairs and using 'fmap' to extract each
-- component sequence.
--
-- @since 0.5.11
unzipWith :: (a -> (b, c)) -> Seq a -> (Seq b, Seq c)
unzipWith :: (a -> (b, c)) -> Seq a -> (Seq b, Seq c)
unzipWith a -> (b, c)
f = (a -> (b, c)) -> Seq a -> (Seq b, Seq c)
forall (f :: * -> *) x a b.
UnzipWith f =>
(x -> (a, b)) -> f x -> (f a, f b)
Instance of class: UnzipWith of the constraint type UnzipWith Seq
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))
-- Why do we lazify `f`? Because we don't want the strictness to depend
-- on exactly how the sequence is balanced. For example, what do we want
-- from
--
-- unzip [(1,2), undefined, (5,6)]?
--
-- The argument could be represented as
--
-- Seq $ Deep 3 (One (Elem (1,2))) EmptyT (Two undefined (Elem (5,6)))
--
-- or as
--
-- Seq $ Deep 3 (Two (Elem (1,2)) undefined) EmptyT (One (Elem (5,6)))
--
-- We don't want the tree balance to determine whether we get
--
-- ([1, undefined, undefined], [2, undefined, undefined])
--
-- or
--
-- ([undefined, undefined, 5], [undefined, undefined, 6])
--
-- so we pretty much have to be completely lazy in the elements.

#ifdef __GLASGOW_HASKELL__
{-# NOINLINE [1] unzipWith #-}

-- We don't need a special rule for unzip:
--
-- unzip (fmap f xs) = unzipWith id f xs,
--
-- which rewrites to unzipWith (id . f) xs
--
-- It's true that if GHC doesn't know the arity of `f` then
-- it won't reduce further, but that doesn't seem like too
-- big a deal here.
{-# 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)

-- This instance is only used at the very top of the tree;
-- the rest of the elements are handled by unzipWithNodeElem
instance UnzipWith Elem where
#if __GLASGOW_HASKELL__ >= 708
  unzipWith' :: (x -> (a, b)) -> Elem x -> (Elem a, Elem b)
unzipWith' = (x -> (a, b)) -> Elem x -> (Elem a, Elem b)
coerce
#else
  unzipWith' f (Elem a) = case f a of (x, y) -> (Elem x, Elem y)
#endif

-- We're very lazy here for the sake of efficiency. We want to be able to
-- reach any element of either result in logarithmic time. If we pattern
-- match strictly, we'll end up building entire 2-3 trees at once, which
-- would take linear time.
--
-- However, we're not *entirely* lazy! We are careful to build pieces
-- of each sequence as the corresponding pieces of the *other* sequence
-- are demanded. This allows the garbage collector to get rid of each
-- *component* of each result pair as soon as it is dead.
--
-- Note that this instance is used only for *internal* nodes. Nodes
-- containing elements are handled by 'unzipWithNodeElem'
instance UnzipWith Node where
  unzipWith' :: (x -> (a, b)) -> Node x -> (Node a, Node b)
unzipWith' x -> (a, b)
f (Node2 Int
s x
x x
y) =
    ( Int -> a -> a -> Node a
forall a. Int -> a -> a -> Node a
Node2 Int
s a
x1 a
y1
    , Int -> b -> b -> Node b
forall a. Int -> a -> a -> Node a
Node2 Int
s b
x2 b
y2)
    where
      {-# NOINLINE fx #-}
      {-# NOINLINE fy #-}
      fx :: (a, b)
fx = (a, b) -> (a, b)
forall a b. (a, b) -> (a, b)
strictifyPair (x -> (a, b)
f x
x)
      fy :: (a, b)
fy = (a, b) -> (a, b)
forall a b. (a, b) -> (a, b)
strictifyPair (x -> (a, b)
f x
y)
      (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) =
    ( Int -> a -> a -> a -> Node a
forall a. Int -> a -> a -> a -> Node a
Node3 Int
s a
x1 a
y1 a
z1
    , Int -> b -> b -> b -> Node b
forall a. Int -> a -> a -> a -> Node a
Node3 Int
s b
x2 b
y2 b
z2)
    where
      {-# NOINLINE fx #-}
      {-# NOINLINE fy #-}
      {-# NOINLINE fz #-}
      fx :: (a, b)
fx = (a, b) -> (a, b)
forall a b. (a, b) -> (a, b)
strictifyPair (x -> (a, b)
f x
x)
      fy :: (a, b)
fy = (a, b) -> (a, b)
forall a b. (a, b) -> (a, b)
strictifyPair (x -> (a, b)
f x
y)
      fz :: (a, b)
fz = (a, b) -> (a, b)
forall a b. (a, b) -> (a, b)
strictifyPair (x -> (a, b)
f x
z)
      (a
x1, b
x2) = (a, b)
fx
      (a
y1, b
y2) = (a, b)
fy
      (a
z1, b
z2) = (a, b)
fz

-- Force both elements of a pair
strictifyPair :: (a, b) -> (a, b)
strictifyPair :: (a, b) -> (a, b)
strictifyPair (!a
x, !b
y) = (a
x, b
y)

-- We're strict here for the sake of efficiency. The Node instance
-- is lazy, so we don't particularly need to add an extra thunk on top
-- of each node.
instance UnzipWith Digit where
  unzipWith' :: (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
    = (a -> Digit a
forall a. a -> Digit a
One a
x1, b -> Digit b
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
    = ( a -> a -> Digit a
forall a. a -> a -> Digit a
Two a
x1 a
y1
      , b -> b -> Digit b
forall a. a -> a -> Digit a
Two b
x2 b
y2)
  unzipWith' 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
    = ( a -> a -> a -> Digit a
forall a. a -> a -> a -> Digit a
Three a
x1 a
y1 a
z1
      , b -> b -> b -> Digit b
forall a. a -> a -> a -> Digit a
Three b
x2 b
y2 b
z2)
  unzipWith' 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
    = ( a -> a -> a -> a -> Digit a
forall a. a -> a -> a -> a -> Digit a
Four a
x1 a
y1 a
z1 a
w1
      , b -> b -> b -> b -> Digit b
forall a. a -> a -> a -> a -> Digit a
Four b
x2 b
y2 b
z2 b
w2)

instance UnzipWith FingerTree where
  unzipWith' :: (x -> (a, b)) -> FingerTree x -> (FingerTree a, FingerTree b)
unzipWith' x -> (a, b)
_ FingerTree x
EmptyT = (FingerTree a
forall a. FingerTree a
EmptyT, FingerTree b
forall a. FingerTree a
EmptyT)
  unzipWith' x -> (a, b)
f (Single x
x)
    | (a
x1, b
x2) <- x -> (a, b)
f x
x
    = (a -> FingerTree a
forall a. a -> FingerTree a
Single a
x1, b -> FingerTree b
forall a. a -> FingerTree a
Single b
x2)
  unzipWith' x -> (a, b)
f (Deep Int
s Digit x
pr FingerTree (Node x)
m Digit x
sf)
    | (!Digit a
pr1, !Digit b
pr2) <- (x -> (a, b)) -> Digit x -> (Digit a, Digit b)
forall (f :: * -> *) x a b.
UnzipWith f =>
(x -> (a, b)) -> f x -> (f a, f b)
Instance of class: UnzipWith of the constraint type UnzipWith Digit
unzipWith' x -> (a, b)
f Digit x
pr
    , (!Digit a
sf1, !Digit b
sf2) <- (x -> (a, b)) -> Digit x -> (Digit a, Digit b)
forall (f :: * -> *) x a b.
UnzipWith f =>
(x -> (a, b)) -> f x -> (f a, f b)
Instance of class: UnzipWith of the constraint type UnzipWith Digit
unzipWith' x -> (a, b)
f Digit x
sf
    = (Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
s Digit a
pr1 FingerTree (Node a)
m1 Digit a
sf1, Int -> Digit b -> FingerTree (Node b) -> Digit b -> FingerTree b
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
s Digit b
pr2 FingerTree (Node b)
m2 Digit b
sf2)
    where
      {-# NOINLINE m1m2 #-}
      m1m2 :: (FingerTree (Node a), FingerTree (Node b))
m1m2 = (FingerTree (Node a), FingerTree (Node b))
-> (FingerTree (Node a), FingerTree (Node b))
forall a b. (a, b) -> (a, b)
strictifyPair ((FingerTree (Node a), FingerTree (Node b))
 -> (FingerTree (Node a), FingerTree (Node b)))
-> (FingerTree (Node a), FingerTree (Node b))
-> (FingerTree (Node a), FingerTree (Node b))
forall a b. (a -> b) -> a -> b
$ (Node x -> (Node a, Node b))
-> FingerTree (Node x)
-> (FingerTree (Node a), FingerTree (Node b))
forall (f :: * -> *) x a b.
UnzipWith f =>
(x -> (a, b)) -> f x -> (f a, f b)
Instance of class: UnzipWith of the constraint type UnzipWith FingerTree
unzipWith' ((x -> (a, b)) -> Node x -> (Node a, Node b)
forall (f :: * -> *) x a b.
UnzipWith f =>
(x -> (a, b)) -> f x -> (f a, f b)
Instance of class: UnzipWith of the constraint type UnzipWith Node
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' :: (x -> (a, b)) -> Seq x -> (Seq a, Seq b)
unzipWith' x -> (a, b)
_ (Seq FingerTree (Elem x)
EmptyT) = (Seq a
forall a. Seq a
empty, Seq b
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
    = (a -> Seq a
forall a. a -> Seq a
singleton a
x1, b -> Seq b
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) <- (Elem x -> (Elem a, Elem b))
-> Digit (Elem x) -> (Digit (Elem a), Digit (Elem b))
forall (f :: * -> *) x a b.
UnzipWith f =>
(x -> (a, b)) -> f x -> (f a, f b)
Instance of class: UnzipWith of the constraint type UnzipWith Digit
unzipWith' ((x -> (a, b)) -> Elem x -> (Elem a, Elem b)
forall (f :: * -> *) x a b.
UnzipWith f =>
(x -> (a, b)) -> f x -> (f a, f b)
Instance of class: UnzipWith of the constraint type UnzipWith Elem
unzipWith' x -> (a, b)
f) Digit (Elem x)
pr
    , (!Digit (Elem a)
sf1, !Digit (Elem b)
sf2) <- (Elem x -> (Elem a, Elem b))
-> Digit (Elem x) -> (Digit (Elem a), Digit (Elem b))
forall (f :: * -> *) x a b.
UnzipWith f =>
(x -> (a, b)) -> f x -> (f a, f b)
Instance of class: UnzipWith of the constraint type UnzipWith Digit
unzipWith' ((x -> (a, b)) -> Elem x -> (Elem a, Elem b)
forall (f :: * -> *) x a b.
UnzipWith f =>
(x -> (a, b)) -> f x -> (f a, f b)
Instance of class: UnzipWith of the constraint type UnzipWith Elem
unzipWith' x -> (a, b)
f) Digit (Elem x)
sf
    = (FingerTree (Elem a) -> Seq a
forall a. FingerTree (Elem a) -> Seq a
Seq (Int
-> Digit (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> FingerTree (Elem a)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
s Digit (Elem a)
pr1 FingerTree (Node (Elem a))
m1 Digit (Elem a)
sf1), FingerTree (Elem b) -> Seq b
forall a. FingerTree (Elem a) -> Seq a
Seq (Int
-> Digit (Elem b)
-> FingerTree (Node (Elem b))
-> Digit (Elem b)
-> FingerTree (Elem b)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
s Digit (Elem b)
pr2 FingerTree (Node (Elem b))
m2 Digit (Elem b)
sf2))
    where
      {-# NOINLINE m1m2 #-}
      m1m2 :: (FingerTree (Node (Elem a)), FingerTree (Node (Elem b)))
m1m2 = (FingerTree (Node (Elem a)), FingerTree (Node (Elem b)))
-> (FingerTree (Node (Elem a)), FingerTree (Node (Elem b)))
forall a b. (a, b) -> (a, b)
strictifyPair ((FingerTree (Node (Elem a)), FingerTree (Node (Elem b)))
 -> (FingerTree (Node (Elem a)), FingerTree (Node (Elem b))))
-> (FingerTree (Node (Elem a)), FingerTree (Node (Elem b)))
-> (FingerTree (Node (Elem a)), FingerTree (Node (Elem b)))
forall a b. (a -> b) -> a -> b
$ (Node (Elem x) -> (Node (Elem a), Node (Elem b)))
-> FingerTree (Node (Elem x))
-> (FingerTree (Node (Elem a)), FingerTree (Node (Elem b)))
forall (f :: * -> *) x a b.
UnzipWith f =>
(x -> (a, b)) -> f x -> (f a, f b)
Instance of class: UnzipWith of the constraint type UnzipWith FingerTree
unzipWith' ((x -> (a, b)) -> Node (Elem x) -> (Node (Elem a), Node (Elem b))
forall x a b.
(x -> (a, b)) -> Node (Elem x) -> (Node (Elem a), Node (Elem b))
unzipWithNodeElem x -> (a, b)
f) FingerTree (Node (Elem x))
m
      (FingerTree (Node (Elem a))
m1, FingerTree (Node (Elem b))
m2) = (FingerTree (Node (Elem a)), FingerTree (Node (Elem b)))
m1m2

-- Here we need to be lazy in the children (because they're
-- Elems), but we can afford to be strict in the results
-- of `f` because it's sure to return a pair immediately
-- (unzipWith lazifies the function it's passed).
unzipWithNodeElem :: (x -> (a, b))
       -> Node (Elem x) -> (Node (Elem a), Node (Elem b))
unzipWithNodeElem :: (x -> (a, b)) -> Node (Elem x) -> (Node (Elem a), Node (Elem b))
unzipWithNodeElem 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
  = ( Int -> Elem a -> Elem a -> Node (Elem a)
forall a. Int -> a -> a -> Node a
Node2 Int
s (a -> Elem a
forall a. a -> Elem a
Elem a
x1) (a -> Elem a
forall a. a -> Elem a
Elem a
y1)
    , Int -> Elem b -> Elem b -> Node (Elem b)
forall a. Int -> a -> a -> Node a
Node2 Int
s (b -> Elem b
forall a. a -> Elem a
Elem b
x2) (b -> Elem b
forall a. a -> Elem a
Elem b
y2))
unzipWithNodeElem 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
  = ( Int -> Elem a -> Elem a -> Elem a -> Node (Elem a)
forall a. Int -> a -> a -> a -> Node a
Node3 Int
s (a -> Elem a
forall a. a -> Elem a
Elem a
x1) (a -> Elem a
forall a. a -> Elem a
Elem a
y1) (a -> Elem a
forall a. a -> Elem a
Elem a
z1)
    , Int -> Elem b -> Elem b -> Elem b -> Node (Elem b)
forall a. Int -> a -> a -> a -> Node a
Node3 Int
s (b -> Elem b
forall a. a -> Elem a
Elem b
x2) (b -> Elem b
forall a. a -> Elem a
Elem b
y2) (b -> Elem b
forall a. a -> Elem a
Elem b
z2))

-- | \( O(\min(n_1,n_2)) \).  'zip' takes two sequences and returns a sequence
-- of corresponding pairs.  If one input is short, excess elements are
-- discarded from the right end of the longer sequence.
zip :: Seq a -> Seq b -> Seq (a, b)
zip :: Seq a -> Seq b -> Seq (a, b)
zip = (a -> b -> (a, b)) -> Seq a -> Seq b -> Seq (a, b)
forall a b c. (a -> b -> c) -> Seq a -> Seq b -> Seq c
zipWith (,)

-- | \( O(\min(n_1,n_2)) \).  'zipWith' generalizes 'zip' by zipping with the
-- function given as the first argument, instead of a tupling function.
-- For example, @zipWith (+)@ is applied to two sequences to take the
-- sequence of corresponding sums.
zipWith :: (a -> b -> c) -> Seq a -> Seq b -> Seq c
zipWith :: (a -> b -> c) -> Seq a -> Seq b -> Seq c
zipWith a -> b -> c
f Seq a
s1 Seq b
s2 = (a -> b -> c) -> Seq a -> Seq b -> Seq c
forall a b c. (a -> b -> c) -> Seq a -> Seq b -> Seq c
zipWith' a -> b -> c
f Seq a
s1' Seq b
s2'
  where
    minLen :: Int
minLen = Int -> Int -> Int
forall a. Ord a => a -> a -> a
External instance of the constraint type Ord Int
min (Seq a -> Int
forall a. Seq a -> Int
length Seq a
s1) (Seq b -> Int
forall a. Seq a -> Int
length Seq b
s2)
    s1' :: Seq a
s1' = Int -> Seq a -> Seq a
forall a. Int -> Seq a -> Seq a
take Int
minLen Seq a
s1
    s2' :: Seq b
s2' = Int -> Seq b -> Seq b
forall a. Int -> Seq a -> Seq a
take Int
minLen Seq b
s2

-- | A version of zipWith that assumes the sequences have the same length.
zipWith' :: (a -> b -> c) -> Seq a -> Seq b -> Seq c
zipWith' :: (a -> b -> c) -> Seq a -> Seq b -> Seq c
zipWith' a -> b -> c
f Seq a
s1 Seq b
s2 = (Int -> Seq b -> (Seq b, Seq b))
-> (Seq b -> a -> c) -> Seq b -> Seq a -> Seq c
forall s a' b'.
(Int -> s -> (s, s)) -> (s -> a' -> b') -> s -> Seq a' -> Seq b'
splitMap Int -> Seq b -> (Seq b, Seq b)
forall a. Int -> Seq a -> (Seq a, Seq a)
uncheckedSplitAt Seq b -> a -> c
goLeaf Seq b
s2 Seq a
s1
  where
    goLeaf :: Seq b -> a -> c
goLeaf (Seq (Single (Elem b
b))) a
a = a -> b -> c
f a
a b
b
    goLeaf Seq b
_ a
_ = [Char] -> c
forall a. HasCallStack => [Char] -> a
error [Char]
"Data.Sequence.zipWith'.goLeaf internal error: not a singleton"

-- | \( O(\min(n_1,n_2,n_3)) \).  'zip3' takes three sequences and returns a
-- sequence of triples, analogous to 'zip'.
zip3 :: Seq a -> Seq b -> Seq c -> Seq (a,b,c)
zip3 :: Seq a -> Seq b -> Seq c -> Seq (a, b, c)
zip3 = (a -> b -> c -> (a, b, c))
-> Seq a -> Seq b -> Seq c -> Seq (a, b, c)
forall a b c d.
(a -> b -> c -> d) -> Seq a -> Seq b -> Seq c -> Seq d
zipWith3 (,,)

-- | \( O(\min(n_1,n_2,n_3)) \).  'zipWith3' takes a function which combines
-- three elements, as well as three sequences and returns a sequence of
-- their point-wise combinations, analogous to 'zipWith'.
zipWith3 :: (a -> b -> c -> d) -> Seq a -> Seq b -> Seq c -> Seq d
zipWith3 :: (a -> b -> c -> d) -> Seq a -> Seq b -> Seq c -> Seq d
zipWith3 a -> b -> c -> d
f Seq a
s1 Seq b
s2 Seq c
s3 = ((c -> d) -> c -> d) -> Seq (c -> d) -> Seq c -> Seq d
forall a b c. (a -> b -> c) -> Seq a -> Seq b -> Seq c
zipWith' (c -> d) -> c -> d
forall a b. (a -> b) -> a -> b
($) ((a -> b -> c -> d) -> Seq a -> Seq b -> Seq (c -> d)
forall a b c. (a -> b -> c) -> Seq a -> Seq b -> Seq c
zipWith' a -> b -> c -> d
f Seq a
s1' Seq b
s2') Seq c
s3'
  where
    minLen :: Int
minLen = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
External instance of the constraint type Ord Int
External instance of the constraint type Foldable []
minimum [Seq a -> Int
forall a. Seq a -> Int
length Seq a
s1, Seq b -> Int
forall a. Seq a -> Int
length Seq b
s2, Seq c -> Int
forall a. Seq a -> Int
length Seq c
s3]
    s1' :: Seq a
s1' = Int -> Seq a -> Seq a
forall a. Int -> Seq a -> Seq a
take Int
minLen Seq a
s1
    s2' :: Seq b
s2' = Int -> Seq b -> Seq b
forall a. Int -> Seq a -> Seq a
take Int
minLen Seq b
s2
    s3' :: Seq c
s3' = Int -> Seq c -> Seq c
forall a. Int -> Seq a -> Seq a
take Int
minLen Seq c
s3

zipWith3' :: (a -> b -> c -> d) -> Seq a -> Seq b -> Seq c -> Seq d
zipWith3' :: (a -> b -> c -> d) -> Seq a -> Seq b -> Seq c -> Seq d
zipWith3' a -> b -> c -> d
f Seq a
s1 Seq b
s2 Seq c
s3 = ((c -> d) -> c -> d) -> Seq (c -> d) -> Seq c -> Seq d
forall a b c. (a -> b -> c) -> Seq a -> Seq b -> Seq c
zipWith' (c -> d) -> c -> d
forall a b. (a -> b) -> a -> b
($) ((a -> b -> c -> d) -> Seq a -> Seq b -> Seq (c -> d)
forall a b c. (a -> b -> c) -> Seq a -> Seq b -> Seq c
zipWith' a -> b -> c -> d
f Seq a
s1 Seq b
s2) Seq c
s3

-- | \( O(\min(n_1,n_2,n_3,n_4)) \).  'zip4' takes four sequences and returns a
-- sequence of quadruples, analogous to 'zip'.
zip4 :: Seq a -> Seq b -> Seq c -> Seq d -> Seq (a,b,c,d)
zip4 :: Seq a -> Seq b -> Seq c -> Seq d -> Seq (a, b, c, d)
zip4 = (a -> b -> c -> d -> (a, b, c, d))
-> Seq a -> Seq b -> Seq c -> Seq d -> Seq (a, b, c, d)
forall a b c d e.
(a -> b -> c -> d -> e)
-> Seq a -> Seq b -> Seq c -> Seq d -> Seq e
zipWith4 (,,,)

-- | \( O(\min(n_1,n_2,n_3,n_4)) \).  'zipWith4' takes a function which combines
-- four elements, as well as four sequences and returns a sequence of
-- their point-wise combinations, analogous to 'zipWith'.
zipWith4 :: (a -> b -> c -> d -> e) -> Seq a -> Seq b -> Seq c -> Seq d -> Seq e
zipWith4 :: (a -> b -> c -> d -> e)
-> Seq a -> Seq b -> Seq c -> Seq d -> Seq e
zipWith4 a -> b -> c -> d -> e
f Seq a
s1 Seq b
s2 Seq c
s3 Seq d
s4 = ((d -> e) -> d -> e) -> Seq (d -> e) -> Seq d -> Seq e
forall a b c. (a -> b -> c) -> Seq a -> Seq b -> Seq c
zipWith' (d -> e) -> d -> e
forall a b. (a -> b) -> a -> b
($) ((a -> b -> c -> d -> e) -> Seq a -> Seq b -> Seq c -> Seq (d -> e)
forall a b c d.
(a -> b -> c -> d) -> Seq a -> Seq b -> Seq c -> Seq d
zipWith3' a -> b -> c -> d -> e
f Seq a
s1' Seq b
s2' Seq c
s3') Seq d
s4'
  where
    minLen :: Int
minLen = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
External instance of the constraint type Ord Int
External instance of the constraint type Foldable []
minimum [Seq a -> Int
forall a. Seq a -> Int
length Seq a
s1, Seq b -> Int
forall a. Seq a -> Int
length Seq b
s2, Seq c -> Int
forall a. Seq a -> Int
length Seq c
s3, Seq d -> Int
forall a. Seq a -> Int
length Seq d
s4]
    s1' :: Seq a
s1' = Int -> Seq a -> Seq a
forall a. Int -> Seq a -> Seq a
take Int
minLen Seq a
s1
    s2' :: Seq b
s2' = Int -> Seq b -> Seq b
forall a. Int -> Seq a -> Seq a
take Int
minLen Seq b
s2
    s3' :: Seq c
s3' = Int -> Seq c -> Seq c
forall a. Int -> Seq a -> Seq a
take Int
minLen Seq c
s3
    s4' :: Seq d
s4' = Int -> Seq d -> Seq d
forall a. Int -> Seq a -> Seq a
take Int
minLen Seq d
s4

-- | fromList2, given a list and its length, constructs a completely
-- balanced Seq whose elements are that list using the replicateA
-- generalization.
fromList2 :: Int -> [a] -> Seq a
fromList2 :: Int -> [a] -> Seq a
fromList2 Int
n = State [a] (Seq a) -> [a] -> Seq a
forall s a. State s a -> s -> a
execState (Int -> State [a] a -> State [a] (Seq a)
forall (f :: * -> *) a. Applicative f => Int -> f a -> f (Seq a)
External instance of the constraint type forall s. Applicative (State s)
replicateA Int
n (([a] -> ([a], a)) -> State [a] a
forall s a. (s -> (s, a)) -> State s a
State [a] -> ([a], a)
forall {b}. [b] -> ([b], b)
ht))
  where
    ht :: [b] -> ([b], b)
ht (b
x:[b]
xs) = ([b]
xs, b
x)
    ht []     = [Char] -> ([b], b)
forall a. HasCallStack => [Char] -> a
error [Char]
"fromList2: short list"