content: {-# 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  :  libraries@haskell.org
  -- 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 #-}
  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 #-}
  node2           :: Sized a => a -> a -> Node a
  node2 a b       =  Node2 (size a + size b) a b
  
  {-# INLINE node3 #-}
  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
  
  instance Traversable ViewR where
      traverse _ EmptyR       = pure EmptyR
      traverse f (xs :> x)    = (:>) <$> traverse f xs <*> f x
  
  -- | /O(1)/. Analyse the right end of a sequence.
  viewr           ::  Seq a -> ViewR a
  viewr (Seq xs)  =  case viewRTree xs of
      Nothing2 -> EmptyR
      Just2 xs' (Elem x) -> Seq xs' :> x
  
  {-# SPECIALIZE viewRTree :: FingerTree (Elem a) -> Maybe2 (FingerTree (Elem a)) (Elem a) #-}
  {-# SPECIALIZE viewRTree :: FingerTree (Node a) -> Maybe2 (FingerTree (Node a)) (Node a) #-}
  viewRTree       :: Sized a => FingerTree a -> Maybe2 (FingerTree a) a
  viewRTree Empty                 = Nothing2
  viewRTree (Single z)            = Just2 Empty z
  viewRTree (Deep s pr m (One z)) = Just2 (pullR (s - size z) pr m) z
  viewRTree (Deep s pr m (Two y z)) =
      Just2 (Deep (s - size z) pr m (One y)) z
  viewRTree (Deep s pr m (Three x y z)) =
      Just2 (Deep (s - size z) pr m (Two x y)) z
  viewRTree (Deep s pr m (Four w x y z)) =
      Just2 (Deep (s - size z) pr m (Three w x y)) 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 f z0 xs = z0 <| snd (mapAccumL (\ x z -> let x' = f x z in (x', x')) z0 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 f xs = case viewl xs of
      EmptyL          -> error "scanl1 takes a nonempty sequence as an argument"
      x :< xs'        -> scanl f x xs'
  
  -- | 'scanr' is the right-to-left dual of 'scanl'.
  scanr :: (a -> b -> b) -> b -> Seq a -> Seq b
  scanr f z0 xs = snd (mapAccumR (\ z x -> let z' = f x z in (z', z')) z0 xs) |> z0
  
  -- | 'scanr1' is a variant of 'scanr' that has no starting value argument.
  scanr1 :: (a -> a -> a) -> Seq a -> Seq a
  scanr1 f xs = case viewr xs of
      EmptyR          -> error "scanr1 takes a nonempty sequence as an argument"
      xs' :> x        -> scanr f x 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.
  index           :: Seq a -> Int -> a
  index (Seq xs) i
    | 0 <= i && i < size xs = case lookupTree i xs of
                  Place _ (Elem x) -> x
    | otherwise   = error "index out of bounds"
  
  data Place a = Place {-# UNPACK #-} !Int a
  #if TESTING
      deriving Show
  #endif
  
  {-# SPECIALIZE lookupTree :: Int -> FingerTree (Elem a) -> Place (Elem a) #-}
  {-# SPECIALIZE lookupTree :: Int -> FingerTree (Node a) -> Place (Node a) #-}
  lookupTree :: Sized a => Int -> FingerTree a -> Place a
  lookupTree _ Empty = error "lookupTree of empty tree"
  lookupTree i (Single x) = Place i x
  lookupTree i (Deep _ pr m sf)
    | i < spr     =  lookupDigit i pr
    | i < spm     =  case lookupTree (i - spr) m of
                     Place i' xs -> lookupNode i' xs
    | otherwise   =  lookupDigit (i - spm) sf
    where
      spr     = size pr
      spm     = spr + size 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 i (Node2 _ a b)
    | i < sa      = Place i a
    | otherwise   = Place (i - sa) b
    where
      sa      = size a
  lookupNode i (Node3 _ a b c)
    | i < sa      = Place i a
    | i < sab     = Place (i - sa) b
    | otherwise   = Place (i - sab) c
    where
      sa      = size a
      sab     = sa + size 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 i (One a) = Place i a
  lookupDigit i (Two a b)
    | i < sa      = Place i a
    | otherwise   = Place (i - sa) b
    where
      sa      = size a
  lookupDigit i (Three a b c)
    | i < sa      = Place i a
    | i < sab     = Place (i - sa) b
    | otherwise   = Place (i - sab) c
    where
      sa      = size a
      sab     = sa + size b
  lookupDigit i (Four a b c d)
    | i < sa      = Place i a
    | i < sab     = Place (i - sa) b
    | i < sabc    = Place (i - sab) c
    | otherwise   = Place (i - sabc) d
    where
      sa      = size a
      sab     = sa + size b
      sabc    = sab + size 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 i x      = adjust (const x) i
  
  -- | /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          :: (a -> a) -> Int -> Seq a -> Seq a
  adjust f i (Seq xs)
    | 0 <= i && i < size xs = Seq (adjustTree (const (fmap f)) i xs)
    | otherwise   = Seq xs
  
  {-# SPECIALIZE adjustTree :: (Int -> Elem a -> Elem a) -> Int -> FingerTree (Elem a) -> FingerTree (Elem a) #-}
  {-# SPECIALIZE adjustTree :: (Int -> Node a -> Node a) -> Int -> FingerTree (Node a) -> FingerTree (Node a) #-}
  adjustTree      :: Sized a => (Int -> a -> a) ->
              Int -> FingerTree a -> FingerTree a
  adjustTree _ _ Empty = error "adjustTree of empty tree"
  adjustTree f i (Single x) = Single (f i x)
  adjustTree f i (Deep s pr m sf)
    | i < spr     = Deep s (adjustDigit f i pr) m sf
    | i < spm     = Deep s pr (adjustTree (adjustNode f) (i - spr) m) sf
    | otherwise   = Deep s pr m (adjustDigit f (i - spm) sf)
    where
      spr     = size pr
      spm     = spr + size m
  
  {-# SPECIALIZE adjustNode :: (Int -> Elem a -> Elem a) -> Int -> Node (Elem a) -> Node (Elem a) #-}
  {-# SPECIALIZE adjustNode :: (Int -> Node a -> Node a) -> Int -> Node (Node a) -> Node (Node a) #-}
  adjustNode      :: Sized a => (Int -> a -> a) -> Int -> Node a -> Node a
  adjustNode f i (Node2 s a b)
    | i < sa      = Node2 s (f i a) b
    | otherwise   = Node2 s a (f (i - sa) b)
    where
      sa      = size a
  adjustNode f i (Node3 s a b c)
    | i < sa      = Node3 s (f i a) b c
    | i < sab     = Node3 s a (f (i - sa) b) c
    | otherwise   = Node3 s a b (f (i - sab) c)
    where
      sa      = size a
      sab     = sa + size b
  
  {-# SPECIALIZE adjustDigit :: (Int -> Elem a -> Elem a) -> Int -> Digit (Elem a) -> Digit (Elem a) #-}
  {-# SPECIALIZE adjustDigit :: (Int -> Node a -> Node a) -> Int -> Digit (Node a) -> Digit (Node a) #-}
  adjustDigit     :: Sized a => (Int -> a -> a) -> Int -> Digit a -> Digit a
  adjustDigit f i (One a) = One (f i a)
  adjustDigit f i (Two a b)
    | i < sa      = Two (f i a) b
    | otherwise   = Two a (f (i - sa) b)
    where
      sa      = size a
  adjustDigit f i (Three a b c)
    | i < sa      = Three (f i a) b c
    | i < sab     = Three a (f (i - sa) b) c
    | otherwise   = Three a b (f (i - sab) c)
    where
      sa      = size a
      sab     = sa + size b
  adjustDigit f i (Four a b c d)
    | i < sa      = Four (f i a) b c d
    | i < sab     = Four a (f (i - sa) b) c d
    | i < sabc    = Four a b (f (i - sab) c) d
    | otherwise   = Four a b c (f (i- sabc) d)
    where
      sa      = size a
      sab     = sa + size b
      sabc    = sab + size 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 f xs = snd (mapAccumL' (\ i x -> (i + 1, f i x)) 0 xs)
  
  -- 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 i          =  fst . splitAt i
  
  -- | /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 i          =  snd . splitAt i
  
  -- | /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 i (Seq xs)      =  (Seq l, Seq r)
    where (l, r)          =  split i xs
  
  split :: Int -> FingerTree (Elem a) ->
      (FingerTree (Elem a), FingerTree (Elem a))
  split i Empty   = i `seq` (Empty, Empty)
  split i xs
    | size xs > i = (l, consTree x r)
    | otherwise   = (xs, Empty)
    where Split l x r = splitTree i xs
  
  data Split t a = Split t a t
  #if TESTING
      deriving Show
  #endif
  
  {-# SPECIALIZE splitTree :: Int -> FingerTree (Elem a) -> Split (FingerTree (Elem a)) (Elem a) #-}
  {-# SPECIALIZE splitTree :: Int -> FingerTree (Node a) -> Split (FingerTree (Node a)) (Node a) #-}
  splitTree :: Sized a => Int -> FingerTree a -> Split (FingerTree a) a
  splitTree _ Empty = error "splitTree of empty tree"
  splitTree i (Single x) = i `seq` Split Empty x Empty
  splitTree i (Deep _ pr m sf)
    | i < spr     = case splitDigit i pr of
              Split l x r -> Split (maybe Empty digitToTree l) x (deepL r m sf)
    | i < spm     = case splitTree im m of
              Split ml xs mr -> case splitNode (im - size ml) xs of
                  Split l x r -> Split (deepR pr ml l) x (deepL r mr sf)
    | otherwise   = case splitDigit (i - spm) sf of
              Split l x r -> Split (deepR pr m l) x (maybe Empty digitToTree r)
    where
      spr     = size pr
      spm     = spr + size m
      im      = i - spr
  
  {-# SPECIALIZE splitNode :: Int -> Node (Elem a) -> Split (Maybe (Digit (Elem a))) (Elem a) #-}
  {-# SPECIALIZE splitNode :: Int -> Node (Node a) -> Split (Maybe (Digit (Node a))) (Node a) #-}
  splitNode :: Sized a => Int -> Node a -> Split (Maybe (Digit a)) a
  splitNode i (Node2 _ a b)
    | i < sa      = Split Nothing a (Just (One b))
    | otherwise   = Split (Just (One a)) b Nothing
    where
      sa      = size a
  splitNode i (Node3 _ a b c)
    | i < sa      = Split Nothing a (Just (Two b c))
    | i < sab     = Split (Just (One a)) b (Just (One c))
    | otherwise   = Split (Just (Two a b)) c Nothing
    where
      sa      = size a
      sab     = sa + size b
  
  {-# SPECIALIZE splitDigit :: Int -> Digit (Elem a) -> Split (Maybe (Digit (Elem a))) (Elem a) #-}
  {-# SPECIALIZE splitDigit :: Int -> Digit (Node a) -> Split (Maybe (Digit (Node a))) (Node a) #-}
  splitDigit :: Sized a => Int -> Digit a -> Split (Maybe (Digit a)) a
  splitDigit i (One a) = i `seq` Split Nothing a Nothing
  splitDigit i (Two a b)
    | i < sa      = Split Nothing a (Just (One b))
    | otherwise   = Split (Just (One a)) b Nothing
    where
      sa      = size a
  splitDigit i (Three a b c)
    | i < sa      = Split Nothing a (Just (Two b c))
    | i < sab     = Split (Just (One a)) b (Just (One c))
    | otherwise   = Split (Just (Two a b)) c Nothing
    where
      sa      = size a
      sab     = sa + size b
  splitDigit i (Four a b c d)
    | i < sa      = Split Nothing a (Just (Three b c d))
    | i < sab     = Split (Just (One a)) b (Just (Two c d))
    | i < sabc    = Split (Just (Two a b)) c (Just (One d))
    | otherwise   = Split (Just (Three a b c)) d Nothing
    where
      sa      = size a
      sab     = sa + size b
      sabc    = sab + size c
  
  -- | /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 xs)          = Seq (tailsTree (Elem . Seq) xs) |> 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 xs)          = empty <| Seq (initsTree (Elem . Seq) 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 (One a) = One (One a)
  tailsDigit (Two a b) = Two (Two a b) (One b)
  tailsDigit (Three a b c) = Three (Three a b c) (Two b c) (One c)
  tailsDigit (Four a b c d) = Four (Four a b c d) (Three b c d) (Two c d) (One d)
  
  initsDigit :: Digit a -> Digit (Digit a)
  initsDigit (One a) = One (One a)
  initsDigit (Two a b) = Two (One a) (Two a b)
  initsDigit (Three a b c) = Three (One a) (Two a b) (Three a b c)
  initsDigit (Four a b c d) = Four (One a) (Two a b) (Three a b c) (Four a b c d)
  
  tailsNode :: Node a -> Node (Digit a)
  tailsNode (Node2 s a b) = Node2 s (Two a b) (One b)
  tailsNode (Node3 s a b c) = Node3 s (Three a b c) (Two b c) (One c)
  
  initsNode :: Node a -> Node (Digit a)
  initsNode (Node2 s a b) = Node2 s (One a) (Two a b)
  initsNode (Node3 s a b c) = Node3 s (One a) (Two a b) (Three a b 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, Sized b) => (FingerTree a -> b) -> FingerTree a -> FingerTree b
  tailsTree _ Empty = Empty
  tailsTree f (Single x) = Single (f (Single x))
  tailsTree f (Deep n pr m sf) =
      Deep n (fmap (\ pr' -> f (deep pr' m sf)) (tailsDigit pr))
          (tailsTree f' m)
          (fmap (f . digitToTree) (tailsDigit sf))
    where
      f' ms = let Just2 node m' = viewLTree ms in
          fmap (\ pr' -> f (deep pr' m' sf)) (tailsNode 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, Sized b) => (FingerTree a -> b) -> FingerTree a -> FingerTree b
  initsTree _ Empty = Empty
  initsTree f (Single x) = Single (f (Single x))
  initsTree f (Deep n pr m sf) =
      Deep n (fmap (f . digitToTree) (initsDigit pr))
          (initsTree f' m)
          (fmap (f . deep pr m) (initsDigit sf))
    where
      f' ms =  let Just2 m' node = viewRTree ms in
               fmap (\ sf' -> f (deep pr m' sf')) (initsNode 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 f z xs = foldl (\ g x i -> i `seq` f (g (i - 1)) i x) (const z) xs (length xs - 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 f z xs = foldr (\ x g i -> i `seq` f i x (g (i+1))) (const z) xs 0
  
  {-# INLINE listToMaybe' #-}
  -- 'listToMaybe\'' is a good consumer version of 'listToMaybe'.
  listToMaybe' :: [a] -> Maybe a
  listToMaybe' = foldr (\ x _ -> Just x) 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 p = fst . spanl 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 p = fst . spanr 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 p = snd . spanl 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 p = snd . spanr 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 p = breakl (not . 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 p = breakr (not . 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 p xs = foldr (\ i _ -> splitAt i xs) (xs, empty) (findIndicesL p xs)
  
  {-# INLINE breakr #-}
  -- | @'breakr' p@ is equivalent to @'spanr' (not . p)@.
  breakr :: (a -> Bool) -> Seq a -> (Seq a, Seq a)
  breakr p xs = foldr (\ i _ -> flipPair (splitAt (i + 1) xs)) (xs, empty) (findIndicesR p xs)
    where flipPair (x, y) = (y, 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 p = foldl part (empty, empty)
    where
      part (xs, ys) x
        | p x         = (xs |> x, ys)
        | otherwise   = (xs, ys |> 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 p = foldl (\ xs x -> if p x then xs |> x else xs) 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 x = findIndexL (x ==)
  
  -- | '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 x = findIndexR (x ==)
  
  -- | '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 x = findIndicesL (x ==)
  
  -- | '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 x = findIndicesR (x ==)
  
  -- | @'findIndexL' p xs@ finds the index of the leftmost element that
  -- satisfies @p@, if any exist.
  findIndexL :: (a -> Bool) -> Seq a -> Maybe Int
  findIndexL p = listToMaybe' . findIndicesL 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 p = listToMaybe' . findIndicesR 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 p xs = build (\ c n -> let g i x z = if p x then c i z else z in
                  foldrWithIndex g n 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 p xs = build (\ c n ->
      let g z i x = if p x then c i z else z in foldlWithIndex g n xs)
  #else
  findIndicesR p xs = foldlWithIndex g [] xs
    where g is i x = if p x then i:is else is
  #endif
  
  ------------------------------------------------------------------------
  -- Lists
  ------------------------------------------------------------------------
  
  -- | /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
  fromList        =  Data.List.foldl' (|>) empty
  
  ------------------------------------------------------------------------
  -- Reverse
  ------------------------------------------------------------------------
  
  -- | /O(n)/. The reverse of a sequence.
  reverse :: Seq a -> Seq a
  reverse (Seq xs) = Seq (reverseTree id xs)
  
  reverseTree :: (a -> a) -> FingerTree a -> FingerTree a
  reverseTree _ Empty = Empty
  reverseTree f (Single x) = Single (f x)
  reverseTree f (Deep s pr m sf) =
      Deep s (reverseDigit f sf)
          (reverseTree (reverseNode f) m)
          (reverseDigit f pr)
  
  {-# INLINE reverseDigit #-}
  reverseDigit :: (a -> a) -> Digit a -> Digit a
  reverseDigit f (One a) = One (f a)
  reverseDigit f (Two a b) = Two (f b) (f a)
  reverseDigit f (Three a b c) = Three (f c) (f b) (f a)
  reverseDigit f (Four a b c d) = Four (f d) (f c) (f b) (f a)
  
  reverseNode :: (a -> a) -> Node a -> Node a
  reverseNode f (Node2 s a b) = Node2 s (f b) (f a)
  reverseNode f (Node3 s a b c) = Node3 s (f c) (f b) (f a)
  
  ------------------------------------------------------------------------
  -- Zipping
  ------------------------------------------------------------------------
  
  -- | /O(min(n1,n2))/.  '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 = zipWith (,)
  
  -- | /O(min(n1,n2))/.  '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 f xs ys
    | length xs <= length ys      = zipWith' f xs ys
    | otherwise                   = zipWith' (flip f) ys xs
  
  -- like 'zipWith', but assumes length xs <= length ys
  zipWith' :: (a -> b -> c) -> Seq a -> Seq b -> Seq c
  zipWith' f xs ys = snd (mapAccumL k ys xs)
    where
      k kys x = case viewl kys of
             (z :< zs) -> (zs, f x z)
             EmptyL    -> error "zipWith': unexpected EmptyL"
  
  -- | /O(min(n1,n2,n3))/.  '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 = zipWith3 (,,)
  
  -- | /O(min(n1,n2,n3))/.  '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 f s1 s2 s3 = zipWith ($) (zipWith f s1 s2) s3
  
  -- | /O(min(n1,n2,n3,n4))/.  '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 = zipWith4 (,,,)
  
  -- | /O(min(n1,n2,n3,n4))/.  '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 f s1 s2 s3 s4 = zipWith ($) (zipWith ($) (zipWith f s1 s2) s3) s4
  
  ------------------------------------------------------------------------
  -- Sorting
  --
  -- sort and sortBy are implemented by simple deforestations of
  --      \ xs -> fromList2 (length xs) . Data.List.sortBy cmp . toList
  -- which does not get deforested automatically, it would appear.
  --
  -- Unstable sorting is performed by a heap sort implementation based on
  -- pairing heaps.  Because the internal structure of sequences is quite
  -- varied, it is difficult to get blocks of elements of roughly the same
  -- length, which would improve merge sort performance.  Pairing heaps,
  -- on the other hand, are relatively resistant to the effects of merging
  -- heaps of wildly different sizes, as guaranteed by its amortized
  -- constant-time merge operation.  Moreover, extensive use of SpecConstr
  -- transformations can be done on pairing heaps, especially when we're
  -- only constructing them to immediately be unrolled.
  --
  -- On purely random sequences of length 50000, with no RTS options,
  -- I get the following statistics, in which heapsort is about 42.5%
  -- faster:  (all comparisons done with -O2)
  --
  -- Times (ms)            min      mean    +/-sd    median    max
  -- to/from list:       103.802  108.572    7.487  106.436  143.339
  -- unstable heapsort:   60.686   62.968    4.275   61.187   79.151
  --
  -- Heapsort, it would seem, is less of a memory hog than Data.List.sortBy.
  -- The gap is narrowed when more memory is available, but heapsort still
  -- wins, 15% faster, with +RTS -H128m:
  --
  -- Times (ms)            min    mean    +/-sd  median    max
  -- to/from list:       42.692  45.074   2.596  44.600  56.601
  -- unstable heapsort:  37.100  38.344   3.043  37.715  55.526
  --
  -- In addition, on strictly increasing sequences the gap is even wider
  -- than normal; heapsort is 68.5% faster with no RTS options:
  -- Times (ms)            min    mean    +/-sd  median    max
  -- to/from list:       52.236  53.574   1.987  53.034  62.098
  -- unstable heapsort:  16.433  16.919   0.931  16.681  21.622
  --
  -- This may be attributed to the elegant nature of the pairing heap.
  --
  -- wasserman.louis@gmail.com, 7/20/09
  ------------------------------------------------------------------------
  
  -- | /O(n log n)/.  'sort' sorts the specified 'Seq' by the natural
  -- ordering of its elements.  The sort is stable.
  -- If stability is not required, 'unstableSort' can be considerably
  -- faster, and in particular uses less memory.
  sort :: Ord a => Seq a -> Seq a
  sort = sortBy compare
  
  -- | /O(n log n)/.  'sortBy' sorts the specified 'Seq' according to the
  -- specified comparator.  The sort is stable.
  -- If stability is not required, 'unstableSortBy' can be considerably
  -- faster, and in particular uses less memory.
  sortBy :: (a -> a -> Ordering) -> Seq a -> Seq a
  sortBy cmp xs = fromList2 (length xs) (Data.List.sortBy cmp (toList xs))
  
  -- | /O(n log n)/.  'unstableSort' sorts the specified 'Seq' by
  -- the natural ordering of its elements, but the sort is not stable.
  -- This algorithm is frequently faster and uses less memory than 'sort',
  -- and performs extremely well -- frequently twice as fast as 'sort' --
  -- when the sequence is already nearly sorted.
  unstableSort :: Ord a => Seq a -> Seq a
  unstableSort = unstableSortBy compare
  
  -- | /O(n log n)/.  A generalization of 'unstableSort', 'unstableSortBy'
  -- takes an arbitrary comparator and sorts the specified sequence.
  -- The sort is not stable.  This algorithm is frequently faster and
  -- uses less memory than 'sortBy', and performs extremely well --
  -- frequently twice as fast as 'sortBy' -- when the sequence is already
  -- nearly sorted.
  unstableSortBy :: (a -> a -> Ordering) -> Seq a -> Seq a
  unstableSortBy cmp (Seq xs) =
      fromList2 (size xs) $ maybe [] (unrollPQ cmp) $
          toPQ cmp (\ (Elem x) -> PQueue x Nil) xs
  
  -- | fromList2, given a list and its length, constructs a completely
  -- balanced Seq whose elements are that list using the applicativeTree
  -- generalization.
  fromList2 :: Int -> [a] -> Seq a
  fromList2 n = execState (replicateA n (State ht))
    where
      ht (x:xs) = (xs, x)
      ht []     = error "fromList2: short list"
  
  -- | A 'PQueue' is a simple pairing heap.
  data PQueue e = PQueue e (PQL e)
  data PQL e = Nil | {-# UNPACK #-} !(PQueue e) :& PQL e
  
  infixr 8 :&
  
  #if TESTING
  
  instance Functor PQueue where
      fmap f (PQueue x ts) = PQueue (f x) (fmap f ts)
  
  instance Functor PQL where
      fmap f (q :& qs) = fmap f q :& fmap f qs
      fmap _ Nil = Nil
  
  instance Show e => Show (PQueue e) where
      show = unlines . draw . fmap show
  
  -- borrowed wholesale from Data.Tree, as Data.Tree actually depends
  -- on Data.Sequence
  draw :: PQueue String -> [String]
  draw (PQueue x ts0) = x : drawSubTrees ts0
    where
      drawSubTrees Nil = []
      drawSubTrees (t :& Nil) =
          "|" : shift "`- " "   " (draw t)
      drawSubTrees (t :& ts) =
          "|" : shift "+- " "|  " (draw t) ++ drawSubTrees ts
  
      shift first other = Data.List.zipWith (++) (first : repeat other)
  #endif
  
  -- | 'unrollPQ', given a comparator function, unrolls a 'PQueue' into
  -- a sorted list.
  unrollPQ :: (e -> e -> Ordering) -> PQueue e -> [e]
  unrollPQ cmp = unrollPQ'
    where
      {-# INLINE unrollPQ' #-}
      unrollPQ' (PQueue x ts) = x:mergePQs0 ts
      (<>) = mergePQ cmp
      mergePQs0 Nil = []
      mergePQs0 (t :& Nil) = unrollPQ' t
      mergePQs0 (t1 :& t2 :& ts) = mergePQs (t1 <> t2) ts
      mergePQs t ts = t `seq` case ts of
          Nil             -> unrollPQ' t
          t1 :& Nil       -> unrollPQ' (t <> t1)
          t1 :& t2 :& ts' -> mergePQs (t <> (t1 <> t2)) ts'
  
  -- | 'toPQ', given an ordering function and a mechanism for queueifying
  -- elements, converts a 'FingerTree' to a 'PQueue'.
  toPQ :: (e -> e -> Ordering) -> (a -> PQueue e) -> FingerTree a -> Maybe (PQueue e)
  toPQ _ _ Empty = Nothing
  toPQ _ f (Single x) = Just (f x)
  toPQ cmp f (Deep _ pr m sf) = Just (maybe (pr' <> sf') ((pr' <> sf') <>) (toPQ cmp fNode m))
    where
      fDigit digit = case fmap f digit of
          One a           -> a
          Two a b         -> a <> b
          Three a b c     -> a <> b <> c
          Four a b c d    -> (a <> b) <> (c <> d)
      (<>) = mergePQ cmp
      fNode = fDigit . nodeToDigit
      pr' = fDigit pr
      sf' = fDigit sf
  
  -- | 'mergePQ' merges two 'PQueue's.
  mergePQ :: (a -> a -> Ordering) -> PQueue a -> PQueue a -> PQueue a
  mergePQ cmp q1@(PQueue x1 ts1) q2@(PQueue x2 ts2)
    | cmp x1 x2 == GT     = PQueue x2 (q1 :& ts2)
    | otherwise           = PQueue x1 (q2 :& ts1)
  