{-# LANGUAGE CPP #-}

#if __GLASGOW_HASKELL__

{-# LANGUAGE DeriveDataTypeable, StandaloneDeriving #-}

#endif

#if __GLASGOW_HASKELL__ >= 703

{-# LANGUAGE Trustworthy #-}

#endif

-----------------------------------------------------------------------------

-- |

-- Module : Data.Sequence

-- Copyright : (c) Ross Paterson 2005

-- (c) Louis Wasserman 2009

-- License : BSD-style

-- Maintainer : [email protected]

-- Stability : experimental

-- Portability : portable

--

-- General purpose finite sequences.

-- Apart from being finite and having strict operations, sequences

-- also differ from lists in supporting a wider variety of operations

-- efficiently.

--

-- An amortized running time is given for each operation, with /n/ referring

-- to the length of the sequence and /i/ being the integral index used by

-- some operations. These bounds hold even in a persistent (shared) setting.

--

-- The implementation uses 2-3 finger trees annotated with sizes,

-- as described in section 4.2 of

--

-- * Ralf Hinze and Ross Paterson,

-- \"Finger trees: a simple general-purpose data structure\",

-- /Journal of Functional Programming/ 16:2 (2006) pp 197-217.

-- <http://www.soi.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.

--

-----------------------------------------------------------------------------

module Data.Sequence (

#if !defined(TESTING)

Seq,

#else

Seq(..), Elem(..), FingerTree(..), Node(..), Digit(..),

#endif

-- * 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

-- ** Repetition

replicate, -- :: Int -> a -> Seq a

replicateA, -- :: Applicative f => Int -> f a -> f (Seq a)

replicateM, -- :: Monad m => Int -> m a -> m (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)

-- ** 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

-- * Sorting

sort, -- :: Ord a => Seq a -> Seq a

sortBy, -- :: (a -> a -> Ordering) -> Seq a -> Seq a

unstableSort, -- :: Ord a => Seq a -> Seq a

unstableSortBy, -- :: (a -> a -> Ordering) -> Seq a -> Seq a

-- * Indexing

index, -- :: Seq a -> Int -> a

adjust, -- :: (a -> a) -> Int -> Seq a -> Seq a

update, -- :: Int -> a -> Seq a -> Seq a

take, -- :: Int -> Seq a -> Seq a

drop, -- :: Int -> Seq a -> Seq a

splitAt, -- :: Int -> Seq a -> (Seq a, Seq a)

-- ** 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'.

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

reverse, -- :: Seq a -> Seq a

-- ** Zips

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

#if TESTING

Sized(..),

deep,

node2,

node3,

#endif

) where

import Prelude hiding (

Functor(..),

null, length, take, drop, splitAt, foldl, foldl1, foldr, foldr1,

scanl, scanl1, scanr, scanr1, replicate, zip, zipWith, zip3, zipWith3,

takeWhile, dropWhile, iterate, reverse, filter, mapM, sum, all)

import qualified Data.List

import Control.Applicative (Applicative(..), (<$>), WrappedMonad(..), liftA, liftA2, liftA3)

import Control.DeepSeq (NFData(rnf))

import Control.Monad (MonadPlus(..), ap)

import Data.Monoid (Monoid(..))

import Data.Functor (Functor(..))

import Data.Foldable

import Data.Traversable

import Data.Typeable

#ifdef __GLASGOW_HASKELL__

import GHC.Exts (build)

import Text.Read (Lexeme(Ident), lexP, parens, prec,

readPrec, readListPrec, readListPrecDefault)

import Data.Data

#endif

infixr 5 `consTree`

infixl 5 `snocTree`

infixr 5 ><

infixr 5 <|, :<

infixl 5 |>, :>

class Sized a where

size :: a -> Int

-- | General-purpose finite sequences.

newtype Seq a = Seq (FingerTree (Elem a))

instance Functor Seq where

fmap f (Seq xs) = Seq (fmap (fmap f) xs)

#ifdef __GLASGOW_HASKELL__

x <$ s = replicate (length s) x

#endif

instance Foldable Seq where

foldr f z (Seq xs) = foldr (flip (foldr f)) z xs

foldl f z (Seq xs) = foldl (foldl f) z xs

foldr1 f (Seq xs) = getElem (foldr1 f' xs)

where f' (Elem x) (Elem y) = Elem (f x y)

foldl1 f (Seq xs) = getElem (foldl1 f' xs)

where f' (Elem x) (Elem y) = Elem (f x y)

instance Traversable Seq where

traverse f (Seq xs) = Seq <$> traverse (traverse f) xs

instance NFData a => NFData (Seq a) where

rnf (Seq xs) = rnf xs

instance Monad Seq where

return = singleton

xs >>= f = foldl' add empty xs

where add ys x = ys >< f x

instance MonadPlus Seq where

mzero = empty

mplus = (><)

instance Eq a => Eq (Seq a) where

xs == ys = length xs == length ys && toList xs == toList ys

instance Ord a => Ord (Seq a) where

compare xs ys = compare (toList xs) (toList ys)

#if TESTING

instance Show a => Show (Seq a) where

showsPrec p (Seq x) = showsPrec p x

#else

instance Show a => Show (Seq a) where

showsPrec p xs = showParen (p > 10) $

showString "fromList " . shows (toList xs)

#endif

instance Read a => Read (Seq a) where

#ifdef __GLASGOW_HASKELL__

readPrec = parens $ prec 10 $ do

Ident "fromList" <- lexP

xs <- readPrec

return (fromList xs)

readListPrec = readListPrecDefault

#else

readsPrec p = readParen (p > 10) $ \ r -> do

("fromList",s) <- lex r

(xs,t) <- reads s

return (fromList xs,t)

#endif

instance Monoid (Seq a) where

mempty = empty

mappend = (><)

#include "Typeable.h"

INSTANCE_TYPEABLE1(Seq,seqTc,"Seq")

#if __GLASGOW_HASKELL__

instance Data a => Data (Seq a) where

gfoldl f z s = case viewl s of

EmptyL -> z empty

x :< xs -> z (<|) `f` x `f` xs

gunfold k z c = case constrIndex c of

1 -> z empty

2 -> k (k (z (<|)))

_ -> error "gunfold"

toConstr xs

| null xs = emptyConstr

| otherwise = consConstr

dataTypeOf _ = seqDataType

dataCast1 f = gcast1 f

emptyConstr, consConstr :: Constr

emptyConstr = mkConstr seqDataType "empty" [] Prefix

consConstr = mkConstr seqDataType "<|" [] Infix

seqDataType :: DataType

seqDataType = mkDataType "Data.Sequence.Seq" [emptyConstr, consConstr]

#endif

-- Finger trees

data FingerTree a

= Empty

| Single a

| Deep {-# UNPACK #-} !Int !(Digit a) (FingerTree (Node a)) !(Digit a)

#if TESTING

deriving Show

#endif

instance Sized a => Sized (FingerTree a) where

{-# SPECIALIZE instance Sized (FingerTree (Elem a)) #-}

{-# SPECIALIZE instance Sized (FingerTree (Node a)) #-}

size Empty = 0

size (Single x) = size x

size (Deep v _ _ _) = v

instance Foldable FingerTree where

foldr _ z Empty = z

foldr f z (Single x) = x `f` z

foldr f z (Deep _ pr m sf) =

foldr f (foldr (flip (foldr f)) (foldr f z sf) m) pr

foldl _ z Empty = z

foldl f z (Single x) = z `f` x

foldl f z (Deep _ pr m sf) =

foldl f (foldl (foldl f) (foldl f z pr) m) sf

foldr1 _ Empty = error "foldr1: empty sequence"

foldr1 _ (Single x) = x

foldr1 f (Deep _ pr m sf) =

foldr f (foldr (flip (foldr f)) (foldr1 f sf) m) pr

foldl1 _ Empty = error "foldl1: empty sequence"

foldl1 _ (Single x) = x

foldl1 f (Deep _ pr m sf) =

foldl f (foldl (foldl f) (foldl1 f pr) m) sf

instance Functor FingerTree where

fmap _ Empty = Empty

fmap f (Single x) = Single (f x)

fmap f (Deep v pr m sf) =

Deep v (fmap f pr) (fmap (fmap f) m) (fmap f sf)

instance Traversable FingerTree where

traverse _ Empty = pure Empty

traverse f (Single x) = Single <$> f x

traverse f (Deep v pr m sf) =

Deep v <$> traverse f pr <*> traverse (traverse f) m <*>

traverse f sf

instance NFData a => NFData (FingerTree a) where

rnf (Empty) = ()

rnf (Single x) = rnf x

rnf (Deep _ pr m sf) = rnf pr `seq` rnf m `seq` rnf sf

{-# INLINE deep #-}

{-# SPECIALIZE INLINE deep :: Digit (Elem a) -> FingerTree (Node (Elem a)) -> Digit (Elem a) -> FingerTree (Elem a) #-}

{-# SPECIALIZE INLINE deep :: Digit (Node a) -> FingerTree (Node (Node a)) -> Digit (Node a) -> FingerTree (Node a) #-}

deep :: Sized a => Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a

deep pr m sf = Deep (size pr + size m + size sf) pr m sf

{-# INLINE pullL #-}

pullL :: Sized a => Int -> FingerTree (Node a) -> Digit a -> FingerTree a

pullL s m sf = case viewLTree m of

Nothing2 -> digitToTree' s sf

Just2 pr m' -> Deep s (nodeToDigit pr) m' sf

{-# INLINE pullR #-}

pullR :: Sized a => Int -> Digit a -> FingerTree (Node a) -> FingerTree a

pullR s pr m = case viewRTree m of

Nothing2 -> digitToTree' s pr

Just2 m' sf -> Deep s pr m' (nodeToDigit sf)

{-# SPECIALIZE deepL :: Maybe (Digit (Elem a)) -> FingerTree (Node (Elem a)) -> Digit (Elem a) -> FingerTree (Elem a) #-}

{-# SPECIALIZE deepL :: Maybe (Digit (Node a)) -> FingerTree (Node (Node a)) -> Digit (Node a) -> FingerTree (Node a) #-}

deepL :: Sized a => Maybe (Digit a) -> FingerTree (Node a) -> Digit a -> FingerTree a

deepL Nothing m sf = pullL (size m + size sf) m sf

deepL (Just pr) m sf = deep pr m sf

{-# SPECIALIZE deepR :: Digit (Elem a) -> FingerTree (Node (Elem a)) -> Maybe (Digit (Elem a)) -> FingerTree (Elem a) #-}

{-# SPECIALIZE deepR :: Digit (Node a) -> FingerTree (Node (Node a)) -> Maybe (Digit (Node a)) -> FingerTree (Node a) #-}

deepR :: Sized a => Digit a -> FingerTree (Node a) -> Maybe (Digit a) -> FingerTree a

deepR pr m Nothing = pullR (size m + size pr) pr m

deepR pr m (Just sf) = deep pr m sf

-- Digits

data Digit a

= One a

| Two a a

| Three a a a

| Four a a a a

#if TESTING

deriving Show

#endif

instance Foldable Digit where

foldr f z (One a) = a `f` z

foldr f z (Two a b) = a `f` (b `f` z)

foldr f z (Three a b c) = a `f` (b `f` (c `f` z))

foldr f z (Four a b c d) = a `f` (b `f` (c `f` (d `f` z)))

foldl f z (One a) = z `f` a

foldl f z (Two a b) = (z `f` a) `f` b

foldl f z (Three a b c) = ((z `f` a) `f` b) `f` c

foldl f z (Four a b c d) = (((z `f` a) `f` b) `f` c) `f` d

foldr1 _ (One a) = a

foldr1 f (Two a b) = a `f` b

foldr1 f (Three a b c) = a `f` (b `f` c)

foldr1 f (Four a b c d) = a `f` (b `f` (c `f` d))

foldl1 _ (One a) = a

foldl1 f (Two a b) = a `f` b

foldl1 f (Three a b c) = (a `f` b) `f` c

foldl1 f (Four a b c d) = ((a `f` b) `f` c) `f` d

instance Functor Digit where

{-# INLINE fmap #-}

fmap f (One a) = One (f a)

fmap f (Two a b) = Two (f a) (f b)

fmap f (Three a b c) = Three (f a) (f b) (f c)

fmap f (Four a b c d) = Four (f a) (f b) (f c) (f d)

instance Traversable Digit where

{-# INLINE traverse #-}

traverse f (One a) = One <$> f a

traverse f (Two a b) = Two <$> f a <*> f b

traverse f (Three a b c) = Three <$> f a <*> f b <*> f c

traverse f (Four a b c d) = Four <$> f a <*> f b <*> f c <*> f d

instance NFData a => NFData (Digit a) where

rnf (One a) = rnf a

rnf (Two a b) = rnf a `seq` rnf b

rnf (Three a b c) = rnf a `seq` rnf b `seq` rnf c

rnf (Four a b c d) = rnf a `seq` rnf b `seq` rnf c `seq` rnf d

instance Sized a => Sized (Digit a) where

{-# INLINE size #-}

size = foldl1 (+) . fmap 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 (One a) = Single a

digitToTree (Two a b) = deep (One a) Empty (One b)

digitToTree (Three a b c) = deep (Two a b) Empty (One c)

digitToTree (Four a b c d) = deep (Two a b) Empty (Two c d)

-- | Given the size of a digit and the digit itself, efficiently converts

-- it to a FingerTree.

digitToTree' :: Int -> Digit a -> FingerTree a

digitToTree' n (Four a b c d) = Deep n (Two a b) Empty (Two c d)

digitToTree' n (Three a b c) = Deep n (Two a b) Empty (One c)

digitToTree' n (Two a b) = Deep n (One a) Empty (One b)

digitToTree' n (One a) = n `seq` Single a

-- Nodes

data Node a

= Node2 {-# UNPACK #-} !Int a a

| Node3 {-# UNPACK #-} !Int a a a

#if TESTING

deriving Show

#endif

instance Foldable Node where

foldr f z (Node2 _ a b) = a `f` (b `f` z)

foldr f z (Node3 _ a b c) = a `f` (b `f` (c `f` z))

foldl f z (Node2 _ a b) = (z `f` a) `f` b

foldl f z (Node3 _ a b c) = ((z `f` a) `f` b) `f` c

instance Functor Node where

{-# INLINE fmap #-}

fmap f (Node2 v a b) = Node2 v (f a) (f b)

fmap f (Node3 v a b c) = Node3 v (f a) (f b) (f c)

instance Traversable Node where

{-# INLINE traverse #-}

traverse f (Node2 v a b) = Node2 v <$> f a <*> f b

traverse f (Node3 v a b c) = Node3 v <$> f a <*> f b <*> f c

instance NFData a => NFData (Node a) where

rnf (Node2 _ a b) = rnf a `seq` rnf b

rnf (Node3 _ a b c) = rnf a `seq` rnf b `seq` rnf c

instance Sized (Node a) where

size (Node2 v _ _) = v

size (Node3 v _ _ _) = v

{-# INLINE node2 #-}

{-# SPECIALIZE node2 :: Elem a -> Elem a -> Node (Elem a) #-}

{-# SPECIALIZE node2 :: Node a -> Node a -> Node (Node a) #-}

node2 :: Sized a => a -> a -> Node a

node2 a b = Node2 (size a + size b) a b

{-# INLINE node3 #-}

{-# SPECIALIZE node3 :: Elem a -> Elem a -> Elem a -> Node (Elem a) #-}

{-# SPECIALIZE node3 :: Node a -> Node a -> Node a -> Node (Node a) #-}

node3 :: Sized a => a -> a -> a -> Node a

node3 a b c = Node3 (size a + size b + size c) a b c

nodeToDigit :: Node a -> Digit a

nodeToDigit (Node2 _ a b) = Two a b

nodeToDigit (Node3 _ a b c) = Three a b c

-- Elements

newtype Elem a = Elem { getElem :: a }

#if TESTING

deriving Show

#endif

instance Sized (Elem a) where

size _ = 1

instance Functor Elem where

fmap f (Elem x) = Elem (f x)

instance Foldable Elem where

foldr f z (Elem x) = f x z

foldl f z (Elem x) = f z x

instance Traversable Elem where

traverse f (Elem x) = Elem <$> f x

instance NFData a => NFData (Elem a) where

rnf (Elem x) = rnf x

-------------------------------------------------------

-- Applicative construction

-------------------------------------------------------

newtype Id a = Id {runId :: a}

instance Functor Id where

fmap f (Id x) = Id (f x)

instance Monad Id where

return = Id

m >>= k = k (runId m)

instance Applicative Id where

pure = return

(<*>) = ap

-- | This is essentially a clone of Control.Monad.State.Strict.

newtype State s a = State {runState :: s -> (s, a)}

instance Functor (State s) where

fmap = liftA

instance Monad (State s) where

{-# INLINE return #-}

{-# INLINE (>>=) #-}

return x = State $ \ s -> (s, x)

m >>= k = State $ \ s -> case runState m s of

(s', x) -> runState (k x) s'

instance Applicative (State s) where

pure = return

(<*>) = ap

execState :: State s a -> s -> a

execState m x = snd (runState m x)

-- | A helper method: a strict version of mapAccumL.

mapAccumL' :: Traversable t => (a -> b -> (a, c)) -> a -> t b -> (a, t c)

mapAccumL' f s t = runState (traverse (State . flip f) t) s

-- | '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 -> Id a -> Id (FingerTree a) #-}

-- Special note: the Id 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 n mSize m = mSize `seq` case n of

0 -> pure Empty

1 -> liftA Single m

2 -> deepA one emptyTree one

3 -> deepA two emptyTree one

4 -> deepA two emptyTree two

5 -> deepA three emptyTree two

6 -> deepA three emptyTree three

7 -> deepA four emptyTree three

8 -> deepA four emptyTree four

_ -> let (q, r) = n `quotRem` 3 in q `seq` case r of

0 -> deepA three (applicativeTree (q - 2) mSize' n3) three

1 -> deepA four (applicativeTree (q - 2) mSize' n3) three

_ -> deepA four (applicativeTree (q - 2) mSize' n3) four

where

one = liftA One m

two = liftA2 Two m m

three = liftA3 Three m m m

four = liftA3 Four m m m <*> m

deepA = liftA3 (Deep (n * mSize))

mSize' = 3 * mSize

n3 = liftA3 (Node3 mSize') m m m

emptyTree = pure Empty

------------------------------------------------------------------------

-- Construction

------------------------------------------------------------------------

-- | /O(1)/. The empty sequence.

empty :: Seq a

empty = Seq Empty

-- | /O(1)/. A singleton sequence.

singleton :: a -> Seq a

singleton x = Seq (Single (Elem x))

-- | /O(log n)/. @replicate n x@ is a sequence consisting of @n@ copies of @x@.

replicate :: Int -> a -> Seq a

replicate n x

| n >= 0 = runId (replicateA n (Id x))

| otherwise = error "replicate takes a nonnegative integer argument"

-- | 'replicateA' is an 'Applicative' version of 'replicate', and makes

-- /O(log n)/ calls to '<*>' and 'pure'.

--

-- > replicateA n x = sequenceA (replicate n x)

replicateA :: Applicative f => Int -> f a -> f (Seq a)

replicateA n x

| n >= 0 = Seq <$> applicativeTree n 1 (Elem <$> x)

| otherwise = error "replicateA takes a nonnegative integer argument"

-- | 'replicateM' is a sequence counterpart of 'Control.Monad.replicateM'.

--

-- > replicateM n x = sequence (replicate n x)

replicateM :: Monad m => Int -> m a -> m (Seq a)

replicateM n x

| n >= 0 = unwrapMonad (replicateA n (WrapMonad x))

| otherwise = error "replicateM takes a nonnegative integer argument"

-- | /O(1)/. Add an element to the left end of a sequence.

-- Mnemonic: a triangle with the single element at the pointy end.

(<|) :: a -> Seq a -> Seq a

x <| Seq xs = Seq (Elem x `consTree` 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 Empty = Single a

consTree a (Single b) = deep (One a) Empty (One b)

consTree a (Deep s (Four b c d e) m sf) = m `seq`

Deep (size a + s) (Two a b) (node3 c d e `consTree` m) sf

consTree a (Deep s (Three b c d) m sf) =

Deep (size a + s) (Four a b c d) m sf

consTree a (Deep s (Two b c) m sf) =

Deep (size a + s) (Three a b c) m sf

consTree a (Deep s (One b) m sf) =

Deep (size a + s) (Two a b) m sf

-- | /O(1)/. Add an element to the right end of a sequence.

-- Mnemonic: a triangle with the single element at the pointy end.

(|>) :: Seq a -> a -> Seq a

Seq xs |> x = Seq (xs `snocTree` Elem 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 Empty a = Single a

snocTree (Single a) b = deep (One a) Empty (One b)

snocTree (Deep s pr m (Four a b c d)) e = m `seq`

Deep (s + size e) pr (m `snocTree` node3 a b c) (Two d e)

snocTree (Deep s pr m (Three a b c)) d =

Deep (s + size d) pr m (Four a b c d)

snocTree (Deep s pr m (Two a b)) c =

Deep (s + size c) pr m (Three a b c)

snocTree (Deep s pr m (One a)) b =

Deep (s + size b) pr m (Two a b)

-- | /O(log(min(n1,n2)))/. Concatenate two sequences.

(><) :: Seq a -> Seq a -> Seq a

Seq xs >< Seq ys = Seq (appendTree0 xs ys)

-- The appendTree/addDigits gunk below is machine generated

appendTree0 :: FingerTree (Elem a) -> FingerTree (Elem a) -> FingerTree (Elem a)

appendTree0 Empty xs =

xs

appendTree0 xs Empty =

xs

appendTree0 (Single x) xs =

x `consTree` xs

appendTree0 xs (Single x) =

xs `snocTree` x

appendTree0 (Deep s1 pr1 m1 sf1) (Deep s2 pr2 m2 sf2) =

Deep (s1 + s2) pr1 (addDigits0 m1 sf1 pr2 m2) sf2

addDigits0 :: FingerTree (Node (Elem a)) -> Digit (Elem a) -> Digit (Elem a) -> FingerTree (Node (Elem a)) -> FingerTree (Node (Elem a))

addDigits0 m1 (One a) (One b) m2 =

appendTree1 m1 (node2 a b) m2

addDigits0 m1 (One a) (Two b c) m2 =

appendTree1 m1 (node3 a b c) m2

addDigits0 m1 (One a) (Three b c d) m2 =

appendTree2 m1 (node2 a b) (node2 c d) m2

addDigits0 m1 (One a) (Four b c d e) m2 =

appendTree2 m1 (node3 a b c) (node2 d e) m2

addDigits0 m1 (Two a b) (One c) m2 =

appendTree1 m1 (node3 a b c) m2

addDigits0 m1 (Two a b) (Two c d) m2 =

appendTree2 m1 (node2 a b) (node2 c d) m2

addDigits0 m1 (Two a b) (Three c d e) m2 =

appendTree2 m1 (node3 a b c) (node2 d e) m2

addDigits0 m1 (Two a b) (Four c d e f) m2 =

appendTree2 m1 (node3 a b c) (node3 d e f) m2

addDigits0 m1 (Three a b c) (One d) m2 =

appendTree2 m1 (node2 a b) (node2 c d) m2

addDigits0 m1 (Three a b c) (Two d e) m2 =

appendTree2 m1 (node3 a b c) (node2 d e) m2

addDigits0 m1 (Three a b c) (Three d e f) m2 =

appendTree2 m1 (node3 a b c) (node3 d e f) m2

addDigits0 m1 (Three a b c) (Four d e f g) m2 =

appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2

addDigits0 m1 (Four a b c d) (One e) m2 =

appendTree2 m1 (node3 a b c) (node2 d e) m2

addDigits0 m1 (Four a b c d) (Two e f) m2 =

appendTree2 m1 (node3 a b c) (node3 d e f) m2

addDigits0 m1 (Four a b c d) (Three e f g) m2 =

appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2

addDigits0 m1 (Four a b c d) (Four e f g h) m2 =

appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2

appendTree1 :: FingerTree (Node a) -> Node a -> FingerTree (Node a) -> FingerTree (Node a)

appendTree1 Empty a xs =

a `consTree` xs

appendTree1 xs a Empty =

xs `snocTree` a

appendTree1 (Single x) a xs =

x `consTree` a `consTree` xs

appendTree1 xs a (Single x) =

xs `snocTree` a `snocTree` x

appendTree1 (Deep s1 pr1 m1 sf1) a (Deep s2 pr2 m2 sf2) =

Deep (s1 + size a + s2) pr1 (addDigits1 m1 sf1 a pr2 m2) sf2

addDigits1 :: FingerTree (Node (Node a)) -> Digit (Node a) -> Node a -> Digit (Node a) -> FingerTree (Node (Node a)) -> FingerTree (Node (Node a))

addDigits1 m1 (One a) b (One c) m2 =

appendTree1 m1 (node3 a b c) m2

addDigits1 m1 (One a) b (Two c d) m2 =

appendTree2 m1 (node2 a b) (node2 c d) m2

addDigits1 m1 (One a) b (Three c d e) m2 =

appendTree2 m1 (node3 a b c) (node2 d e) m2

addDigits1 m1 (One a) b (Four c d e f) m2 =

appendTree2 m1 (node3 a b c) (node3 d e f) m2

addDigits1 m1 (Two a b) c (One d) m2 =

appendTree2 m1 (node2 a b) (node2 c d) m2

addDigits1 m1 (Two a b) c (Two d e) m2 =

appendTree2 m1 (node3 a b c) (node2 d e) m2

addDigits1 m1 (Two a b) c (Three d e f) m2 =

appendTree2 m1 (node3 a b c) (node3 d e f) m2

addDigits1 m1 (Two a b) c (Four d e f g) m2 =

appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2

addDigits1 m1 (Three a b c) d (One e) m2 =

appendTree2 m1 (node3 a b c) (node2 d e) m2

addDigits1 m1 (Three a b c) d (Two e f) m2 =

appendTree2 m1 (node3 a b c) (node3 d e f) m2

addDigits1 m1 (Three a b c) d (Three e f g) m2 =

appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2

addDigits1 m1 (Three a b c) d (Four e f g h) m2 =

appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2

addDigits1 m1 (Four a b c d) e (One f) m2 =

appendTree2 m1 (node3 a b c) (node3 d e f) m2

addDigits1 m1 (Four a b c d) e (Two f g) m2 =

appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2

addDigits1 m1 (Four a b c d) e (Three f g h) m2 =

appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2

addDigits1 m1 (Four a b c d) e (Four f g h i) m2 =

appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2

appendTree2 :: FingerTree (Node a) -> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a)

appendTree2 Empty a b xs =

a `consTree` b `consTree` xs

appendTree2 xs a b Empty =

xs `snocTree` a `snocTree` b

appendTree2 (Single x) a b xs =

x `consTree` a `consTree` b `consTree` xs

appendTree2 xs a b (Single x) =

xs `snocTree` a `snocTree` b `snocTree` x

appendTree2 (Deep s1 pr1 m1 sf1) a b (Deep s2 pr2 m2 sf2) =

Deep (s1 + size a + size b + s2) pr1 (addDigits2 m1 sf1 a b pr2 m2) sf2

addDigits2 :: FingerTree (Node (Node a)) -> Digit (Node a) -> Node a -> Node a -> Digit (Node a) -> FingerTree (Node (Node a)) -> FingerTree (Node (Node a))

addDigits2 m1 (One a) b c (One d) m2 =

appendTree2 m1 (node2 a b) (node2 c d) m2

addDigits2 m1 (One a) b c (Two d e) m2 =

appendTree2 m1 (node3 a b c) (node2 d e) m2

addDigits2 m1 (One a) b c (Three d e f) m2 =

appendTree2 m1 (node3 a b c) (node3 d e f) m2

addDigits2 m1 (One a) b c (Four d e f g) m2 =

appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2

addDigits2 m1 (Two a b) c d (One e) m2 =

appendTree2 m1 (node3 a b c) (node2 d e) m2

addDigits2 m1 (Two a b) c d (Two e f) m2 =

appendTree2 m1 (node3 a b c) (node3 d e f) m2

addDigits2 m1 (Two a b) c d (Three e f g) m2 =

appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2

addDigits2 m1 (Two a b) c d (Four e f g h) m2 =

appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2

addDigits2 m1 (Three a b c) d e (One f) m2 =

appendTree2 m1 (node3 a b c) (node3 d e f) m2

addDigits2 m1 (Three a b c) d e (Two f g) m2 =

appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2

addDigits2 m1 (Three a b c) d e (Three f g h) m2 =

appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2

addDigits2 m1 (Three a b c) d e (Four f g h i) m2 =

appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2

addDigits2 m1 (Four a b c d) e f (One g) m2 =

appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2

addDigits2 m1 (Four a b c d) e f (Two g h) m2 =

appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2

addDigits2 m1 (Four a b c d) e f (Three g h i) m2 =

appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2

addDigits2 m1 (Four a b c d) e f (Four g h i j) m2 =

appendTree4 m1 (node3 a b c) (node3 d e f) (node2 g h) (node2 i j) m2

appendTree3 :: FingerTree (Node a) -> Node a -> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a)

appendTree3 Empty a b c xs =

a `consTree` b `consTree` c `consTree` xs

appendTree3 xs a b c Empty =

xs `snocTree` a `snocTree` b `snocTree` c

appendTree3 (Single x) a b c xs =

x `consTree` a `consTree` b `consTree` c `consTree` xs

appendTree3 xs a b c (Single x) =

xs `snocTree` a `snocTree` b `snocTree` c `snocTree` x

appendTree3 (Deep s1 pr1 m1 sf1) a b c (Deep s2 pr2 m2 sf2) =

Deep (s1 + size a + size b + size c + s2) pr1 (addDigits3 m1 sf1 a b c pr2 m2) sf2

addDigits3 :: FingerTree (Node (Node a)) -> Digit (Node a) -> Node a -> Node a -> Node a -> Digit (Node a) -> FingerTree (Node (Node a)) -> FingerTree (Node (Node a))

addDigits3 m1 (One a) b c d (One e) m2 =

appendTree2 m1 (node3 a b c) (node2 d e) m2

addDigits3 m1 (One a) b c d (Two e f) m2 =

appendTree2 m1 (node3 a b c) (node3 d e f) m2

addDigits3 m1 (One a) b c d (Three e f g) m2 =

appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2

addDigits3 m1 (One a) b c d (Four e f g h) m2 =

appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2

addDigits3 m1 (Two a b) c d e (One f) m2 =

appendTree2 m1 (node3 a b c) (node3 d e f) m2

addDigits3 m1 (Two a b) c d e (Two f g) m2 =

appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2

addDigits3 m1 (Two a b) c d e (Three f g h) m2 =

appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2

addDigits3 m1 (Two a b) c d e (Four f g h i) m2 =

appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2

addDigits3 m1 (Three a b c) d e f (One g) m2 =

appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2

addDigits3 m1 (Three a b c) d e f (Two g h) m2 =

appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2

addDigits3 m1 (Three a b c) d e f (Three g h i) m2 =

appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2

addDigits3 m1 (Three a b c) d e f (Four g h i j) m2 =

appendTree4 m1 (node3 a b c) (node3 d e f) (node2 g h) (node2 i j) m2

addDigits3 m1 (Four a b c d) e f g (One h) m2 =

appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2

addDigits3 m1 (Four a b c d) e f g (Two h i) m2 =

appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2

addDigits3 m1 (Four a b c d) e f g (Three h i j) m2 =

appendTree4 m1 (node3 a b c) (node3 d e f) (node2 g h) (node2 i j) m2

addDigits3 m1 (Four a b c d) e f g (Four h i j k) m2 =

appendTree4 m1 (node3 a b c) (node3 d e f) (node3 g h i) (node2 j k) m2

appendTree4 :: FingerTree (Node a) -> Node a -> Node a -> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a)

appendTree4 Empty a b c d xs =

a `consTree` b `consTree` c `consTree` d `consTree` xs

appendTree4 xs a b c d Empty =

xs `snocTree` a `snocTree` b `snocTree` c `snocTree` d

appendTree4 (Single x) a b c d xs =

x `consTree` a `consTree` b `consTree` c `consTree` d `consTree` xs

appendTree4 xs a b c d (Single x) =

xs `snocTree` a `snocTree` b `snocTree` c `snocTree` d `snocTree` x

appendTree4 (Deep s1 pr1 m1 sf1) a b c d (Deep s2 pr2 m2 sf2) =

Deep (s1 + size a + size b + size c + size d + s2) pr1 (addDigits4 m1 sf1 a b c d pr2 m2) sf2

addDigits4 :: FingerTree (Node (Node a)) -> Digit (Node a) -> Node a -> Node a -> Node a -> Node a -> Digit (Node a) -> FingerTree (Node (Node a)) -> FingerTree (Node (Node a))

addDigits4 m1 (One a) b c d e (One f) m2 =

appendTree2 m1 (node3 a b c) (node3 d e f) m2

addDigits4 m1 (One a) b c d e (Two f g) m2 =

appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2

addDigits4 m1 (One a) b c d e (Three f g h) m2 =

appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2

addDigits4 m1 (One a) b c d e (Four f g h i) m2 =

appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2

addDigits4 m1 (Two a b) c d e f (One g) m2 =

appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2

addDigits4 m1 (Two a b) c d e f (Two g h) m2 =

appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2

addDigits4 m1 (Two a b) c d e f (Three g h i) m2 =

appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2

addDigits4 m1 (Two a b) c d e f (Four g h i j) m2 =

appendTree4 m1 (node3 a b c) (node3 d e f) (node2 g h) (node2 i j) m2

addDigits4 m1 (Three a b c) d e f g (One h) m2 =

appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2

addDigits4 m1 (Three a b c) d e f g (Two h i) m2 =

appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2

addDigits4 m1 (Three a b c) d e f g (Three h i j) m2 =

appendTree4 m1 (node3 a b c) (node3 d e f) (node2 g h) (node2 i j) m2

addDigits4 m1 (Three a b c) d e f g (Four h i j k) m2 =

appendTree4 m1 (node3 a b c) (node3 d e f) (node3 g h i) (node2 j k) m2

addDigits4 m1 (Four a b c d) e f g h (One i) m2 =

appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2

addDigits4 m1 (Four a b c d) e f g h (Two i j) m2 =

appendTree4 m1 (node3 a b c) (node3 d e f) (node2 g h) (node2 i j) m2

addDigits4 m1 (Four a b c d) e f g h (Three i j k) m2 =

appendTree4 m1 (node3 a b c) (node3 d e f) (node3 g h i) (node2 j k) m2

addDigits4 m1 (Four a b c d) e f g h (Four i j k l) m2 =

appendTree4 m1 (node3 a b c) (node3 d e f) (node3 g h i) (node3 j k l) 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 f = unfoldr' empty

-- uses tail recursion rather than, for instance, the List implementation.

where unfoldr' as b = maybe as (\ (a, b') -> unfoldr' (as |> a) b') (f b)

-- | @'unfoldl' f x@ is equivalent to @'reverse' ('unfoldr' ('fmap' swap . f) x)@.

unfoldl :: (b -> Maybe (b, a)) -> b -> Seq a

unfoldl f = unfoldl' empty

where unfoldl' as b = maybe as (\ (b', a) -> unfoldl' (a <| as) b') (f 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 n f x

| n >= 0 = replicateA n (State (\ y -> (f y, y))) `execState` x

| otherwise = error "iterateN takes a nonnegative integer argument"

------------------------------------------------------------------------

-- Deconstruction

------------------------------------------------------------------------

-- | /O(1)/. Is this the empty sequence?

null :: Seq a -> Bool

null (Seq Empty) = True

null _ = False

-- | /O(1)/. The number of elements in the sequence.

length :: Seq a -> Int

length (Seq xs) = size xs

-- Views

data Maybe2 a b = Nothing2 | Just2 a b

-- | View of the left end of a sequence.

data ViewL a

= EmptyL -- ^ empty sequence

| a :< Seq a -- ^ leftmost element and the rest of the sequence

#if __GLASGOW_HASKELL__

deriving (Eq, Ord, Show, Read, Data)

#else

deriving (Eq, Ord, Show, Read)

#endif

INSTANCE_TYPEABLE1(ViewL,viewLTc,"ViewL")

instance Functor ViewL where

{-# INLINE fmap #-}

fmap _ EmptyL = EmptyL

fmap f (x :< xs) = f x :< fmap f xs

instance Foldable ViewL where

foldr _ z EmptyL = z

foldr f z (x :< xs) = f x (foldr f z xs)

foldl _ z EmptyL = z

foldl f z (x :< xs) = foldl f (f z x) xs

foldl1 _ EmptyL = error "foldl1: empty view"

foldl1 f (x :< xs) = foldl f x xs

instance Traversable ViewL where

traverse _ EmptyL = pure EmptyL

traverse f (x :< xs) = (:<) <$> f x <*> traverse f xs

-- | /O(1)/. Analyse the left end of a sequence.

viewl :: Seq a -> ViewL a

viewl (Seq xs) = case viewLTree xs of

Nothing2 -> EmptyL

Just2 (Elem x) xs' -> x :< Seq xs'

{-# SPECIALIZE viewLTree :: FingerTree (Elem a) -> Maybe2 (Elem a) (FingerTree (Elem a)) #-}

{-# SPECIALIZE viewLTree :: FingerTree (Node a) -> Maybe2 (Node a) (FingerTree (Node a)) #-}

viewLTree :: Sized a => FingerTree a -> Maybe2 a (FingerTree a)

viewLTree Empty = Nothing2

viewLTree (Single a) = Just2 a Empty

viewLTree (Deep s (One a) m sf) = Just2 a (pullL (s - size a) m sf)

viewLTree (Deep s (Two a b) m sf) =

Just2 a (Deep (s - size a) (One b) m sf)

viewLTree (Deep s (Three a b c) m sf) =

Just2 a (Deep (s - size a) (Two b c) m sf)

viewLTree (Deep s (Four a b c d) m sf) =

Just2 a (Deep (s - size a) (Three b c d) m 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

#if __GLASGOW_HASKELL__

deriving (Eq, Ord, Show, Read, Data)

#else

deriving (Eq, Ord, Show, Read)

#endif

INSTANCE_TYPEABLE1(ViewR,viewRTc,"ViewR")

instance Functor ViewR where

{-# INLINE fmap #-}

fmap _ EmptyR = EmptyR

fmap f (xs :> x) = fmap f xs :> f x

instance Foldable ViewR where

foldr _ z EmptyR = z

foldr f z (xs :> x) = foldr f (f x z) xs

foldl _ z EmptyR = z

foldl f z (xs :> x) = foldl f z xs `f` x

foldr1 _ EmptyR = error "foldr1: empty view"

foldr1 f (xs :> x) = foldr f x xs