Ticket #3271: new-methods-for-data_sequence.3.dpatch

Thu Jul 16 20:04:53 EDT 2009  wasserman.louis@gmail.com
  * Ticket #3271: New methods for Data.Sequence

New patches:

[Ticket #3271: New methods for Data.Sequence
wasserman.louis@gmail.com**20090717000453
 Ignore-this: 2afb31c5ec1ae0fa48bc5e191082a128
] {
hunk ./Data/Sequence.hs 39
        -- * Construction
        empty,          -- :: Seq a
        singleton,      -- :: a -> Seq a
+       replicate,      -- :: Int -> a -> Seq a
        (<|),           -- :: a -> Seq a -> Seq a
        (|>),           -- :: Seq a -> a -> Seq a
        (><),           -- :: Seq a -> Seq a -> Seq a
hunk ./Data/Sequence.hs 44
        fromList,       -- :: [a] -> Seq a
+       -- ** Sequential construction
+       iterateN,       -- :: Int -> (a -> a) -> a -> Seq a
+       unfoldr,        -- :: (b -> Maybe (a, b)) -> b -> Seq a
        -- * Deconstruction
        -- | Additional functions for deconstructing sequences are available
        -- via the 'Foldable' instance of 'Seq'.
hunk ./Data/Sequence.hs 59
        viewl,          -- :: Seq a -> ViewL a
        ViewR(..),
        viewr,          -- :: Seq a -> ViewR a
+       -- ** Scanning
+       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)
+       takeWhile,      -- :: (a -> Bool) -> Seq a -> Seq a
+       dropWhile,      -- :: (a -> Bool) -> Seq a -> Seq a
+       span,           -- :: (a -> Bool) -> Seq a -> (Seq a, Seq a)
+       break,          -- :: (a -> Bool) -> Seq a -> (Seq a, Seq a)
+       partition,      -- :: (a -> Bool) -> Seq a -> (Seq a, Seq a)
+       filter,         -- :: (a -> Bool) -> Seq a -> Seq a
+       -- ** Sorts
+       sort,           -- :: Ord a => Seq a -> Seq a
+       sortBy,         -- :: (a -> a -> Ordering) -> Seq a -> Seq a
        -- ** Indexing
        index,          -- :: Seq a -> Int -> a
        adjust,         -- :: (a -> a) -> Int -> Seq a -> Seq a
hunk ./Data/Sequence.hs 85
        splitAt,        -- :: Int -> Seq a -> (Seq a, Seq a)
        -- * Transformations
        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
        valid,
 #endif
hunk ./Data/Sequence.hs 98
        ) where
 
 import Prelude hiding (
-       null, length, take, drop, splitAt, foldl, foldl1, foldr, foldr1,
-       reverse)
-import qualified Data.List (foldl')
-import Control.Applicative (Applicative(..), (<$>))
+       null, length, take, drop, splitAt, foldl, foldl1, foldr, foldr1, span,
+       scanl, scanl1, scanr, scanr1, replicate, zip, zipWith, zip3, zipWith3,
+       takeWhile, dropWhile, break, iterate, reverse, filter)
+import qualified Data.List (foldl', zipWith)
+import Control.Applicative (Applicative(..), (<$>), liftA, liftA2, liftA3)
 import Control.Monad (MonadPlus(..))
 import Data.Monoid (Monoid(..))
 import Data.Foldable
hunk ./Data/Sequence.hs 120
 #endif
 
 #if TESTING
-import Control.Monad (liftM, liftM3, liftM4)
-import Test.QuickCheck
+import Control.Monad (liftM, liftM2, liftM3, liftM4)
+import Test.QuickCheck hiding ((><))
 #endif
 
 infixr 5 `consTree`
hunk ./Data/Sequence.hs 126
 infixl 5 `snocTree`
+infixr 5 `consDigitToTree`
+infixl 6 `snocDigitToTree`
 
 infixr 5 ><
 infixr 5 <|, :<
hunk ./Data/Sequence.hs 280
                        traverse f sf
 
 {-# INLINE deep #-}
-{-# SPECIALIZE deep :: Digit (Elem a) -> FingerTree (Node (Elem a)) -> Digit (Elem a) -> FingerTree (Elem a) #-}
-{-# SPECIALIZE deep :: Digit (Node a) -> FingerTree (Node (Node a)) -> Digit (Node a) -> FingerTree (Node a) #-}
+{-# 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
 
hunk ./Data/Sequence.hs 318
        foldl1 f (Four a b c d) = ((a `f` b) `f` c) `f` d
 
 instance Functor Digit where
-       fmap = fmapDefault
+       fmap f (One x) = One (f x)
+       fmap f (Two x y) = Two (f x) (f y)
+       fmap f (Three x y z) = Three (f x) (f y) (f z)
+       fmap f (Four x y z w) = Four (f x) (f y) (f z) (f w)
 
 instance Traversable Digit where
hunk ./Data/Sequence.hs 324
+       {-# 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
hunk ./Data/Sequence.hs 331
        traverse f (Four a b c d) = Four <$> f a <*> f b <*> f c <*> f d
 
 instance Sized a => Sized (Digit a) where
-       {-# SPECIALIZE instance Sized (Digit (Elem a)) #-}
-       {-# SPECIALIZE instance Sized (Digit (Node a)) #-}
-       size xs = foldl (\ i x -> i + size x) 0 xs
+       size = sizeDigit
+
+{-# SPECIALIZE sizeDigit :: Digit (Elem a) -> Int #-}
+{-# SPECIALIZE sizeDigit :: Digit (Node a) -> Int #-}
+sizeDigit :: Sized a => Digit a -> Int
+sizeDigit (One x) = size x
+sizeDigit (Two x y) = size x + size y
+sizeDigit (Three x y z) = size x + size y + size z
+sizeDigit (Four x y z w) = size x + size y + size z + size w
 
 {-# SPECIALIZE digitToTree :: Digit (Elem a) -> FingerTree (Elem a) #-}
 {-# SPECIALIZE digitToTree :: Digit (Node a) -> FingerTree (Node a) #-}
hunk ./Data/Sequence.hs 366
        foldl f z (Node3 _ a b c) = ((z `f` a) `f` b) `f` c
 
 instance Functor Node where
-       fmap = fmapDefault
+       fmap f (Node2 n a b) = Node2 n (f a) (f b)
+       fmap f (Node3 n a b c) = Node3 n (f a) (f b) (f c)
 
 instance Traversable Node where
        traverse f (Node2 v a b) = Node2 v <$> f a <*> f b
hunk ./Data/Sequence.hs 415
        showsPrec p (Elem x) = showsPrec p x
 #endif
 
+-- Applicative construction
+
+newtype Id a = Id {runId :: a}
+
+instance Functor Id where
+       fmap f (Id x) = Id (f x)
+
+instance Applicative Id where
+       pure = Id
+       m <*> k = Id (runId m (runId k))
+
+newtype State s a = State {runState :: s -> (s, a)}
+
+instance Functor (State s) where
+       fmap = liftA
+
+instance Applicative (State s) where
+       pure x = State $ \ s -> (s, x)
+       m <*> k = State $ \ s -> case runState m s of
+               (s', f) -> case runState k s' of
+                       (s'', x) -> (s'', f x)
+
+execState :: State s a -> s -> a
+execState m x = snd (runState m x)
+
+-- | '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 encapsulates the behavior of several procedures, most notably iterate and replicate.
+
+{-# 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 empty one
+       3       -> deepA two empty one
+       4       -> deepA two empty two
+       5       -> deepA three empty two
+       6       -> deepA three empty three
+       7       -> deepA four empty three
+       8       -> deepA four empty 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
+               empty = pure Empty
+
 ------------------------------------------------------------------------
 -- Construction
 ------------------------------------------------------------------------
hunk ./Data/Sequence.hs 484
 singleton      :: a -> Seq a
 singleton x    =  Seq (Single (Elem x))
 
+-- | /O(log n)/. @replicate n x@ is a sequence of length @n@ with @x@ the value of every element.
+replicate      :: Int -> a -> Seq a
+replicate n x  = Seq (runId (applicativeTree n 1 (Id (Elem x))))
+
 -- | /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
hunk ./Data/Sequence.hs 584
 appendTree1 xs a Empty =
        xs `snocTree` a
 appendTree1 (Single x) a xs =
-       x `consTree` a `consTree` xs
+       Two x a `consDigitToTree` xs
 appendTree1 xs a (Single x) =
hunk ./Data/Sequence.hs 586
-       xs `snocTree` a `snocTree` x
+       xs `snocDigitToTree` Two a 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
 
hunk ./Data/Sequence.hs 626
 
 appendTree2 :: FingerTree (Node a) -> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
 appendTree2 Empty a b xs =
-       a `consTree` b `consTree` xs
+       Two a b `consDigitToTree` xs
 appendTree2 xs a b Empty =
hunk ./Data/Sequence.hs 628
-       xs `snocTree` a `snocTree` b
+       xs `snocDigitToTree` Two a b
 appendTree2 (Single x) a b xs =
hunk ./Data/Sequence.hs 630
-       x `consTree` a `consTree` b `consTree` xs
+       Three x a b `consDigitToTree` xs
 appendTree2 xs a b (Single x) =
hunk ./Data/Sequence.hs 632
-       xs `snocTree` a `snocTree` b `snocTree` x
+       xs `snocDigitToTree` Three a b 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
 
hunk ./Data/Sequence.hs 672
 
 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
+       Three a b c `consDigitToTree` xs
 appendTree3 xs a b c Empty =
hunk ./Data/Sequence.hs 674
-       xs `snocTree` a `snocTree` b `snocTree` c
+       xs `snocDigitToTree` Three a b c
 appendTree3 (Single x) a b c xs =
hunk ./Data/Sequence.hs 676
-       x `consTree` a `consTree` b `consTree` c `consTree` xs
+       Four x a b c `consDigitToTree` xs
 appendTree3 xs a b c (Single x) =
hunk ./Data/Sequence.hs 678
-       xs `snocTree` a `snocTree` b `snocTree` c `snocTree` x
+       xs `snocDigitToTree` Four a b c 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
 
hunk ./Data/Sequence.hs 718
 
 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
+       Four a b c d `consDigitToTree` xs
 appendTree4 xs a b c d Empty =
hunk ./Data/Sequence.hs 720
-       xs `snocTree` a `snocTree` b `snocTree` c `snocTree` d
+       xs `snocDigitToTree` Four a b c d
 appendTree4 (Single x) a b c d xs =
hunk ./Data/Sequence.hs 722
-       x `consTree` a `consTree` b `consTree` c `consTree` d `consTree` xs
+       x `consTree` Four a b c d `consDigitToTree` xs
 appendTree4 xs a b c d (Single x) =
hunk ./Data/Sequence.hs 724
-       xs `snocTree` a `snocTree` b `snocTree` c `snocTree` d `snocTree` x
+       xs `snocDigitToTree` Four a b c 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
 
hunk ./Data/Sequence.hs 762
 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
 
+-- Cons and snoc for entire digits at once.  This code was automatically generated.
+-- 
+-- For general internal use, this is *considerably more efficient* than repeated use of 
+-- consTree or snocTree, which end up case'ing the appropriate digit once for every
+-- insertion, while this code only does it once.
+
+{-# SPECIALIZE consDigitToTree :: Digit (Elem a) -> FingerTree (Elem a) -> FingerTree (Elem a) #-}
+{-# SPECIALIZE consDigitToTree :: Digit (Node a) -> FingerTree (Node a) -> FingerTree (Node a) #-}
+consDigitToTree :: Sized a => Digit a -> FingerTree a -> FingerTree a
+consDigitToTree dig Empty
+       = digitToTree dig
+consDigitToTree dig (Single a)
+       = Deep (size dig + size a) dig Empty (One a)
+consDigitToTree dig@(One a) (Deep n (One x) m sf) 
+       = Deep (n + size dig) (Two a x) m sf
+consDigitToTree dig@(One a) (Deep n (Two x y) m sf) 
+       = Deep (n + size dig) (Three a x y) m sf
+consDigitToTree dig@(One a) (Deep n (Three x y z) m sf) 
+       = Deep (n + size dig) (Four a x y z) m sf
+consDigitToTree dig@(One a) (Deep n (Four x y z w) m sf) 
+       = Deep (n + size dig) (Two a x) ((node3 y z w) `consTree` m) sf
+consDigitToTree dig@(Two a b) (Deep n (One x) m sf) 
+       = Deep (n + size dig) (Three a b x) m sf
+consDigitToTree dig@(Two a b) (Deep n (Two x y) m sf) 
+       = Deep (n + size dig) (Four a b x y) m sf
+consDigitToTree dig@(Two a b) (Deep n (Three x y z) m sf) 
+       = Deep (n + size dig) (Two a b) ((node3 x y z) `consTree` m) sf
+consDigitToTree dig@(Two a b) (Deep n (Four x y z w) m sf) 
+       = Deep (n + size dig) (Three a b x) ((node3 y z w) `consTree` m) sf
+consDigitToTree dig@(Three a b c) (Deep n (One x) m sf) 
+       = Deep (n + size dig) (Four a b c x) m sf
+consDigitToTree dig@(Three a b c) (Deep n (Two x y) m sf) 
+       = Deep (n + size dig) (Two a b) ((node3 c x y) `consTree` m) sf
+consDigitToTree dig@(Three a b c) (Deep n (Three x y z) m sf) 
+       = Deep (n + size dig) (Three a b c) ((node3 x y z) `consTree` m) sf
+consDigitToTree dig@(Three a b c) (Deep n (Four x y z w) m sf) 
+       = Deep (n + size dig) (One a) (Two (node3 b c x) (node3 y z w) `consDigitToTree` m) sf
+consDigitToTree dig@(Four a b c d) (Deep n (One x) m sf) 
+       = Deep (n + size dig) (Two a b) ((node3 c d x) `consTree` m) sf
+consDigitToTree dig@(Four a b c d) (Deep n (Two x y) m sf) 
+       = Deep (n + size dig) (Three a b c) ((node3 d x y) `consTree` m) sf
+consDigitToTree dig@(Four a b c d) (Deep n (Three x y z) m sf) 
+       = Deep (n + size dig) (One a) (Two (node3 b c d) (node3 x y z) `consDigitToTree` m) sf
+consDigitToTree dig@(Four a b c d) (Deep n (Four x y z w) m sf) 
+       = Deep (n + size dig) (Two a b) (Two (node3 c d x) (node3 y z w) `consDigitToTree` m) sf
+
+{-# SPECIALIZE snocDigitToTree :: FingerTree (Elem a) -> Digit (Elem a) -> FingerTree (Elem a) #-}
+{-# SPECIALIZE snocDigitToTree :: FingerTree (Node a) -> Digit (Node a) -> FingerTree (Node a) #-}
+snocDigitToTree :: Sized a => FingerTree a -> Digit a -> FingerTree a
+snocDigitToTree Empty dig 
+       = digitToTree dig
+snocDigitToTree (Single a) dig 
+       = Deep (size a + size dig) (One a) Empty dig
+snocDigitToTree (Deep n pr m (One a)) dig@(One x) 
+       = Deep (n + size dig) pr m (Two a x)
+snocDigitToTree (Deep n pr m (One a)) dig@(Two x y) 
+       = Deep (n + size dig) pr m (Three a x y)
+snocDigitToTree (Deep n pr m (One a)) dig@(Three x y z) 
+       = Deep (n + size dig) pr m (Four a x y z)
+snocDigitToTree (Deep n pr m (One a)) dig@(Four x y z w) 
+       = Deep (n + size dig) pr (m `snocTree` (node3 a x y)) (Two z w)
+snocDigitToTree (Deep n pr m (Two a b)) dig@(One x) 
+       = Deep (n + size dig) pr m (Three a b x)
+snocDigitToTree (Deep n pr m (Two a b)) dig@(Two x y) 
+       = Deep (n + size dig) pr m (Four a b x y)
+snocDigitToTree (Deep n pr m (Two a b)) dig@(Three x y z) 
+       = Deep (n + size dig) pr (m `snocTree` (node3 a b x)) (Two y z)
+snocDigitToTree (Deep n pr m (Two a b)) dig@(Four x y z w) 
+       = Deep (n + size dig) pr (m `snocTree` (node3 a b x)) (Three y z w)
+snocDigitToTree (Deep n pr m (Three a b c)) dig@(One x) 
+       = Deep (n + size dig) pr m (Four a b c x)
+snocDigitToTree (Deep n pr m (Three a b c)) dig@(Two x y) 
+       = Deep (n + size dig) pr (m `snocTree` (node3 a b c)) (Two x y)
+snocDigitToTree (Deep n pr m (Three a b c)) dig@(Three x y z) 
+       = Deep (n + size dig) pr (m `snocTree` (node3 a b c)) (Three x y z)
+snocDigitToTree (Deep n pr m (Three a b c)) dig@(Four x y z w) 
+       = Deep (n + size dig) pr (m `snocDigitToTree` Two (node3 a b c) (node3 x y z)) (One w)
+snocDigitToTree (Deep n pr m (Four a b c d)) dig@(One x) 
+       = Deep (n + size dig) pr (m `snocTree` (node3 a b c)) (Two d x)
+snocDigitToTree (Deep n pr m (Four a b c d)) dig@(Two x y) 
+       = Deep (n + size dig) pr (m `snocTree` (node3 a b c)) (Three d x y)
+snocDigitToTree (Deep n pr m (Four a b c d)) dig@(Three x y z) 
+       = Deep (n + size dig) pr (m `snocDigitToTree` Two (node3 a b c) (node3 d x y)) (One z)
+snocDigitToTree (Deep n pr m (Four a b c d)) dig@(Four x y z w) 
+       = Deep (n + size dig) pr (m `snocDigitToTree` Two (node3 a b c) (node3 d x y)) (Two z w)
+
+-- | 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 b = unfoldr' empty b where
+       -- uses tail recursion rather than, for instance, the List implementation.
+       unfoldr' as b = case f b of
+               Nothing         -> as
+               Just (a, b')    -> unfoldr' (as |> a) 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
+-- borrows the structure of the sequence from replicate and preserves it with mapAccumL
+iterateN n f x = n `seq` Seq (execState (applicativeTree n 1 run) x)
+       where   run = State $ \ x -> (f x, Elem x)
+
+
 ------------------------------------------------------------------------
 -- Deconstruction
 ------------------------------------------------------------------------
hunk ./Data/Sequence.hs 999
 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 accum z0 xs)
+       where accum x z = let x' = f x z in (x', x')
+
+-- | '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 accum z0 xs) |> z0
+       where accum z x = let z' = f x z in (z', z')
+
+-- | '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,
hunk ./Data/Sequence.hs 1188
 splitAt i (Seq xs)     =  (Seq l, Seq r)
   where        (l, r)          =  split i xs
 
+-- | /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 tail takes /O(log(min(i, n-i)))/, but evaluating every tail in the sequence 
+-- takes /O(n)/ due to sharing.
+tails                  :: Seq a -> Seq (Seq a)
+tails (Seq xs)         = Seq (tailsTree (Elem . Seq) xs) |> empty
+{-
+tails xs = iterateN (length xs + 1) tail' xs where
+       tail' ys _ = case viewl ys of
+               _ :< ys'        -> ys'
+               _               -> error "Invariant failure in Data.Sequence.tails" -- should never happen
+-}
+
+-- | /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 init takes /O(log(min(i, n-i)))/, but evaluating every init in the sequence 
+-- takes /O(n)/ due to sharing.  
+inits                  :: Seq a -> Seq (Seq a)
+inits (Seq xs)                 = empty <| Seq (initsTree (Elem . Seq) xs)
+-- inits = scanl (|>) empty
+
+-- 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 actually slightly faster than any of the above:
+-- 
+-- Times (ms)    min    mean    +/-sd  median    max
+-- Seq.tails:  16.875  20.405   4.247  19.663  47.972
+-- scanr:      68.429  76.948   6.505  75.264  99.650
+-- iterateN:   17.571  22.231   1.031  22.251  23.917
+-- 
+-- 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
+
+-- | 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
+
+{-# INLINE scanlSize #-}
+scanlSize :: (Traversable f, Sized a) => (b -> Int -> b) -> b -> f a -> f b
+scanlSize f z d = snd (mapAccumL (\ acc x -> let ans = f acc (size x) in (ans, ans)) z d)
+
+{-# INLINE scanrSize #-}
+scanrSize :: (Traversable f, Sized a) => (Int -> b -> b) -> b -> f a -> f b
+scanrSize f z d = snd (mapAccumR (\ acc x -> let ans = size x `f` acc in (ans, ans)) z d)
+
+{-# INLINE tailPr #-}
+-- | Given a Deep FingerTree, constructs the prefix of its tree of tails.
+tailPr :: Sized a => Int -> Digit a -> FingerTree (Node a) -> Digit a -> Digit (FingerTree a)
+tailPr n pr m sf = n `seq` let t = Deep n pr m sf in case (pr, scanlSize (-) n pr) of
+       (One _, _)      -> One t
+       (Two a b, Two sza _)
+                       -> sza `seq` Two t (Deep sza (One b) m sf)
+       (Three a b c, Three sza szb _)
+                       -> szb `seq` Three t (Deep sza (Two b c) m sf) (Deep szb (One c) m sf)
+       (Four a b c d, Four sza szb szc _)
+                       -> szc `seq` Four t (Deep sza (Three b c d) m sf) (Deep szb (Two c d) m sf)
+                               (Deep szc (One d) m sf)
+
+{-# INLINE initPr #-}
+-- | Constructs the inits of the specified digits.
+initPr :: Sized a => Digit a -> Digit (FingerTree a)
+initPr pr = case (pr, scanlSize (+) 0 pr) of
+       (One a, _)      -> One (Single a)
+       (Two a b, Two _ szb)
+                       -> szb `seq` Two (Single a) (digitToTree' szb (Two a b))
+       (Three a b c, Three _ szb szc)
+                       -> szc `seq` Three (Single a) (digitToTree' szb (Two a b)) (digitToTree' szc (Three a b c))
+       (Four a b c d, Four _ szb szc szd)
+                       -> szd `seq` Four (Single a) (digitToTree' szb (Two a b)) (digitToTree' szc (Three a b c))
+                               (digitToTree' szd (Four a b c d))
+
+{-# INLINE tailSf #-}
+-- | Constructs the tails of the specified digit.
+tailSf :: Sized a => Digit a -> Digit (FingerTree a)
+tailSf sf = case (sf, scanrSize (+) 0 sf) of
+       (One a, _)      -> One (Single a)
+       (Two a b, Two sza _)
+                       -> sza `seq` Two (digitToTree' sza (Two a b)) (Single b)
+       (Three a b c, Three sza szb _)
+                       -> sza `seq` Three (digitToTree' sza (Three a b c)) (digitToTree' szb (Two b c))
+                               (Single c)
+       (Four a b c d, Four sza szb szc _)
+                       -> sza `seq` Four (digitToTree' sza (Four a b c d)) (digitToTree' szb (Three b c d))
+                               (digitToTree' szc (Two c d)) (Single d)
+
+{-# INLINE initSf #-}
+-- | Constructs the suffix of the tree of inits of the specified Deep tree.
+initSf :: (Sized a) => Int -> Digit a -> FingerTree (Node a) -> Digit a -> Digit (FingerTree a)
+initSf n pr m sf = n `seq` let t = Deep n pr m sf in case (sf, (scanrSize subtract n sf)) of
+       (One _, _)      -> One t
+       (Two a b, Two sza _)
+                       -> sza `seq` Two (Deep sza pr m (One a)) t
+       (Three a b c, Three sza szb _)
+                       -> sza `seq` Three (Deep sza pr m (One a)) (Deep szb pr m (Two a b)) t
+       (Four a b c d, Four sza szb szc _)
+                       -> sza `seq` Four (Deep sza pr m (One a)) (Deep szb pr m (Two a b)) (Deep szc pr m (Three a b c)) t
+
+{-# 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) = sfSize `seq`
+       Deep n (fmap f (tailPr n pr m sf)) (tailsTree f' m) (fmap f (tailSf sf))
+       where   sfSize = size sf
+               f' ms = case viewLTree ms of
+                       Nothing2 -> error "tailsTree should not encounter empty tails"
+                       Just2 (Node2 n' a b) m' -> let sz2 = sz + size a; sz = size b + size m' + sfSize in
+                               sz2 `seq` Node2 n' (f (Deep sz2 (Two a b) m' sf))
+                                       (f (Deep sz (One b) m' sf))
+                       Just2 (Node3 n' a b c) m' ->
+                               let     sz = size c + size m' + sfSize
+                                       sz2 = size b + sz
+                                       sz3 = size a + sz2
+                                in sz3 `seq` Node3 n' (f (Deep sz3 (Three a b c) m' sf))
+                                               (f (Deep sz2 (Two b c) m' sf))
+                                               (f (Deep sz (One c) m' sf))
+
+{-# 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) = prSize `seq`
+       Deep n (fmap f (initPr pr)) (initsTree f' m) (fmap f (initSf n pr m sf))
+       where   prSize = size pr
+               f' ms = case viewRTree ms of
+                       Nothing2 -> error "initsTree should not encounter empty inits"
+                       Just2 m' (Node2 n' a b) -> let sza = prSize + size m' + size a; szb = sza + size b in szb `seq`
+                               Node2 n' (f (Deep sza pr m' (One a)))
+                                       (f (Deep szb pr m' (Two a b)))
+                       Just2 m' (Node3 n' a b c) -> let        sza = prSize + size m' + size a
+                                                               szb = sza + size b
+                                                               szc = szb + size c in
+                               szc `seq` Node3 n' (f (Deep sza pr m' (One a)))
+                                               (f (Deep szb pr m' (Two a b)))
+                                               (f (Deep szc pr m' (Three a b c)))
+
 split :: Int -> FingerTree (Elem a) ->
        (FingerTree (Elem a), FingerTree (Elem a))
 split i Empty  = i `seq` (Empty, Empty)
hunk ./Data/Sequence.hs 1375
                        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)
+                           Split l x r -> Split (deepR pr ml l) x (deepL r mr sf)
   | otherwise  = case splitDigit (i - spm) sf of
hunk ./Data/Sequence.hs 1377
-                       Split l x r -> Split (deepR pr  m  l) x (maybe Empty digitToTree r)
+                       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
hunk ./Data/Sequence.hs 1382
 
+{-# SPECIALIZE pullL :: Digit (Elem a) -> FingerTree (Node (Elem a)) -> FingerTree (Elem a) #-}
+{-# SPECIALIZE pullL :: Digit (Node a) -> FingerTree (Node (Node a)) -> FingerTree (Node a) #-}
+pullL :: Sized a => Digit a -> FingerTree (Node a) -> FingerTree a
+pullL pr m = case viewRTree m of
+       Nothing2        -> digitToTree pr
+       Just2 m' sf     -> Deep (size pr + size m) pr m' (nodeToDigit sf)
+
+{-# SPECIALIZE pullR :: FingerTree (Node (Elem a)) -> Digit (Elem a) -> FingerTree (Elem a) #-}
+{-# SPECIALIZE pullR :: FingerTree (Node (Node a)) -> Digit (Node a) -> FingerTree (Node a) #-}
+pullR :: Sized a => FingerTree (Node a) -> Digit a -> FingerTree a
+pullR m sf = case viewLTree m of
+       Nothing2        -> digitToTree sf
+       Just2 pr m'     -> Deep (size sf + size m) (nodeToDigit pr) m' 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
hunk ./Data/Sequence.hs 1399
-deepL Nothing m sf     = case viewLTree m of
-       Nothing2        -> digitToTree sf
-       Just2 a m'      -> Deep (size m + size sf) (nodeToDigit a) m' sf
+deepL Nothing m sf     = pullR 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) #-}
hunk ./Data/Sequence.hs 1405
 {-# 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     = case viewRTree m of
-       Nothing2        -> digitToTree pr
-       Just2 m' a      -> Deep (size pr + size m) pr m' (nodeToDigit a)
+deepR pr m Nothing     = pullL pr m
 deepR pr m (Just sf)   = deep pr m sf
 
 {-# SPECIALIZE splitNode :: Int -> Node (Elem a) -> Split (Maybe (Digit (Elem a))) (Elem a) #-}
hunk ./Data/Sequence.hs 1445
        sab     = sa + size b
        sabc    = sab + size c
 
+-- | /O(i)/ where /i/ is the breakpoint index.  'takeWhile', applied to a predicate @p@ and a sequence @xs@, returns the longest prefix (possibly empty) of @xs@ of elements that satisfy @p@.
+takeWhile :: (a -> Bool) -> Seq a -> Seq a
+takeWhile p xs = fst (span p xs)
+
+-- | /O(i)/ where /i/ is the breakpoint index.  @'dropWhile' p xs@ returns the suffix remaining after @takeWhile p xs@.
+dropWhile :: (a -> Bool) -> Seq a -> Seq a
+dropWhile p xs = snd (span p xs)
+
+-- | /O(i)/ where /i/ is the breakpoint index.  'span', applied to a predicate @p@ and a sequence @xs@, returns a tuple 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.
+span :: (a -> Bool) -> Seq a -> (Seq a, Seq a)
+-- This doesn't make any more of a traversal than is necessary, exploiting the laziness of foldr and the structure preservation of mapAccumL.
+span p xs = splitAt ix xs
+       where   indexed = snd (mapAccumL (\ i x -> i `seq` (i + 1, (x, i))) 0 xs)
+               ix = foldr (\ (x, i) i' -> if p x then i' else i) (length xs) indexed
+
+-- | /O(i)/ where /i/ is the breakpoint index.  'break', applied to a predicate @p@ and a sequence @xs@, returns a tuple 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.
+break :: (a -> Bool) -> Seq a -> (Seq a, Seq a)
+break p xs = span (not . p) xs
+
+-- | /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' partition' (empty, empty) where
+       partition' (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' filter' empty where
+       filter' ys x
+               | p x           = ys |> x
+               | otherwise     = ys
+
 ------------------------------------------------------------------------
 -- Lists
 ------------------------------------------------------------------------
hunk ./Data/Sequence.hs 1504
                (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)
hunk ./Data/Sequence.hs 1515
 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
+--
+-- We implement zipping on sequences by zipping left and right digits simultaneously and
+-- processing excess appropriately.  This allows several elements to be ``zipped'' 
+-- in a single go, which is significantly faster than it might be for a linked-list approach,
+-- where we'd have to do at least one dereference for each element.
+------------------------------------------------------------------------
+
+-- | /O(n)/.  'zip' takes two sequences and returns a sequence of corresponding pairs.  
+-- If one input is short, excess elements of the longer sequence are discarded.
+zip :: Seq a -> Seq b -> Seq (a, b)
+zip = zipWith (,)
+
+-- | /O(n)/.  '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
+       where  zipWith' f xs ys = 
+               let zipper ys x = case viewl ys of
+                       EmptyL  -> error "zipper should never encounter an empty second string"
+                       y :< ys -> (ys, f x y)
+                       in snd (mapAccumL zipper ys xs)
+
+zip3 :: Seq a -> Seq b -> Seq c -> Seq (a,b,c)
+zip3 = zipWith3 (,,)
+
+zipWith3 :: (a -> b -> c -> d) -> Seq a -> Seq b -> Seq c -> Seq d
+zipWith3 f s1 s2 s3 = zipWith ($) (zipWith f s1 s2) s3
+
+zip4 :: Seq a -> Seq b -> Seq c -> Seq d -> Seq (a,b,c,d)
+zip4 = zipWith4 (,,,)
+
+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
+--
+-- This is an unstable 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, I get the following statistics:
+-- 
+-- Times (ms)       min    mean    +/-sd  median    max
+-- to/from list:  52.506  54.734   1.097  54.487  59.053
+-- pairing heap:  29.966  30.402   0.753  30.253  35.372
+-- 
+-- In addition, on strictly increasing sequences, I get the following measurements:
+-- 
+-- Times (ms)       min    mean    +/-sd  median    max
+-- to/from list:  31.788  33.924   1.431  33.835  41.310
+-- pairing heap:   8.578   9.029   0.289   8.956  10.066
+-- 
+-- These measurements are with no RTS options.  With +RTS -H128m, on pure random sequences of length 50000,
+-- the margin is considerably thinner, but still in place.  
+-- 
+-- Times (ms)       min    mean    +/-sd  median    max
+-- to/from list:  28.262  43.814   5.922  43.127  55.574
+-- pairing heap:  23.953  38.682   4.811  39.536  51.857
+
+-- 
+-- In exchange for such a significant increase in performance, forcing users to convert  to and 
+-- from lists to get a stable sort seems acceptable.  (The idiom is (fromList . Data.List.sort . toList),
+-- which is sufficiently short not to be a major issue.)
+-- 
+-- wasserman.louis@gmail.com, 7/16/09
+------------------------------------------------------------------------
+
+-- | /O(n log n)/.  'sort' sorts the specified 'Seq' by the natural ordering of its elements.  The sort is not stable.  
+-- The fastest way to stably sort a 'Seq' is to convert it to a list, use 'Data.List.sort', and convert it back to a 'Seq'.
+sort :: Ord a => Seq a -> Seq a
+sort = sortBy compare
+
+-- | /O(n log n)/.  A generalization of 'sort', 'sortBy' takes an arbitrary comparator and sorts the specified sequence.  The sort is not stable.
+-- The fastest way to stably sort a 'Seq' is to convert it to a list, use 'Data.List.sortBy', and convert it back to a 'Seq'.
+sortBy :: (a -> a -> Ordering) -> Seq a -> Seq a
+       -- Todo: examine whether or not stable sorting could be brute-forced by adding an index tag to PQueues.
+sortBy cmp (Seq xs) = fromList2 (size xs) $ maybe [] (unrollPQ cmp) $ toPQ cmp (\ (Elem x) -> PQueue x Nil) xs
+       --fromList . Data.List.sortBy cmp . toList
+
+fromList2 :: Int -> [a] -> Seq a
+-- fromList2, given a list and its length, constructs a completely balanced Seq whose elements are that list
+-- using the applicativeTree generalization.
+fromList2 n xs = Seq (execState (applicativeTree n 1 (State run)) xs) where
+       run (x:xs) = (xs, Elem x)
+
+-- | A 'PQueue' is a simple pairing heap.
+data PQueue e = PQueue e (PQL e) 
+
+data PQL e = Nil | {-# UNPACK #-} !(PQueue e) :& PQL e 
+       -- admittedly a glorified list of PQueues, but nevertheless encourages SpecConstr use
+
+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 f 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 cmp f (Deep _ pr m sf) = Just $ case toPQ cmp fNode m of
+       Nothing -> fDig pr <> fDig sf
+       Just m' -> fDig pr <> m' <> fDig sf
+ where fNode (Node2 _ a b) = f a <> f b
+       fNode (Node3 _ a b c) = f a <> f b <> f c
+       (<>) = mergePQ cmp
+       fDig (One a) = f a
+       fDig (Two a b) = f a <> f b
+       fDig (Three a b c) = f a <> f b <> f c
+       fDig (Four a b c d) = (f a <> f b) <> (f c <> f d)
+toPQ _ f (Single x) = Just (f x)
+toPQ _ _ Empty = Nothing
+
+-- | 'mergePQ' merges two 'PQueue's.
+mergePQ :: (a -> a -> Ordering) -> PQueue a -> PQueue a -> PQueue a
+mergePQ cmp (PQueue x1 ts1) (PQueue x2 ts2)
+       | cmp x1 x2 == GT       = PQueue x2 (PQueue x1 ts1 :& ts2)
+       | otherwise             = PQueue x1 (PQueue x2 ts2 :& ts1)
+
 #if TESTING
 
 ------------------------------------------------------------------------
hunk ./Data/Sequence.hs 1684
 
 instance Arbitrary a => Arbitrary (Seq a) where
        arbitrary = liftM Seq arbitrary
-       coarbitrary (Seq x) = coarbitrary x
+       shrink (Seq x) = map Seq (shrink x)
 
 instance Arbitrary a => Arbitrary (Elem a) where
        arbitrary = liftM Elem arbitrary
hunk ./Data/Sequence.hs 1688
-       coarbitrary (Elem x) = coarbitrary x
+       shrink _ = []
 
 instance (Arbitrary a, Sized a) => Arbitrary (FingerTree a) where
        arbitrary = sized arb
hunk ./Data/Sequence.hs 1697
                arb 1 = liftM Single arbitrary
                arb n = liftM3 deep arbitrary (arb (n `div` 2)) arbitrary
 
-       coarbitrary Empty = variant 0
-       coarbitrary (Single x) = variant 1 . coarbitrary x
-       coarbitrary (Deep _ pr m sf) =
-               variant 2 . coarbitrary pr . coarbitrary m . coarbitrary sf
+       shrink (Deep _ (One a) Empty (One b)) = [Single a, Single b]
+       shrink (Deep _ pr m sf) = [deep pr' m sf | pr' <- shrink pr] ++ [deep pr m' sf | m' <- shrink m] ++ [deep pr m sf' | sf' <- shrink sf]
+       shrink (Single _) = [Empty]
+       shrink Empty = []
 
 instance (Arbitrary a, Sized a) => Arbitrary (Node a) where
        arbitrary = oneof [
hunk ./Data/Sequence.hs 1707
                        liftM2 node2 arbitrary arbitrary,
                        liftM3 node3 arbitrary arbitrary arbitrary]
 
-       coarbitrary (Node2 _ a b) = variant 0 . coarbitrary a . coarbitrary b
-       coarbitrary (Node3 _ a b c) =
-               variant 1 . coarbitrary a . coarbitrary b . coarbitrary c
+       shrink (Node2 _ a b) = [node2 a' b | a' <- shrink a] ++ [node2 a b' | b' <- shrink b]
+       shrink (Node3 _ a b c) = [node2 a b, node2 a c, node2 b c] ++ 
+               [node3 a' b c | a' <- shrink a] ++ [node3 a b' c | b' <- shrink b] ++ [node3 a b c' | c' <- shrink c]
 
 instance Arbitrary a => Arbitrary (Digit a) where
        arbitrary = oneof [
hunk ./Data/Sequence.hs 1717
                        liftM2 Two arbitrary arbitrary,
                        liftM3 Three arbitrary arbitrary arbitrary,
                        liftM4 Four arbitrary arbitrary arbitrary arbitrary]
-
-       coarbitrary (One a) = variant 0 . coarbitrary a
-       coarbitrary (Two a b) = variant 1 . coarbitrary a . coarbitrary b
-       coarbitrary (Three a b c) =
-               variant 2 . coarbitrary a . coarbitrary b . coarbitrary c
-       coarbitrary (Four a b c d) =
-               variant 3 . coarbitrary a . coarbitrary b . coarbitrary c . coarbitrary d
+       
+       shrink (One a) = map One (shrink a)
+       shrink (Two a b) = [One a, One b]
+       shrink (Three a b c) = [Two a b, Two a c, Two b c]
+       shrink (Four a b c d) = [Three a b c, Three a b d, Three a c d, Three b c d]
 
 ------------------------------------------------------------------------
 -- Valid trees
hunk ./containers.cabal 23
     location: http://darcs.haskell.org/packages/containers/
 
 Library {
-    build-depends: base, array
+    build-depends: base >= 4.0.0.0, array
     exposed-modules:
         Data.Graph
         Data.IntMap
}

Context:

[Use left/right rather than old/new to describe the arguments to unionWithKey
Ian Lynagh <igloo@earth.li>**20090208192132
 Fixes trac #3002.
] 
[help nhc98 by making import decl more explicit
Malcolm.Wallace@cs.york.ac.uk**20090203142144] 
[Add instance Data.Traversable for IntMap
Matti Niemenmaa <matti.niemenmaa+darcs@iki.fi>**20090116190353
 Ignore-this: df88a286935926aecec3f8a5dd291699
] 
[Require Cabal version >= 1.6
Ian Lynagh <igloo@earth.li>**20090122011256] 
[Add "bug-reports" and "source-repository" info to the Cabal file
Ian Lynagh <igloo@earth.li>**20090121182106] 
[Fix warnings in containers
Ian Lynagh <igloo@earth.li>**20090116200251] 
[optimize IntMap/IntSet findMin/findMax
sedillard@gmail.com**20081002152055] 
[O(n) fromAscList IntSet / IntMap
sedillard@gmail.com**20080521195941
 
 Added algorithm by Scott Dillard and Bertram Felgenhauer to build IntSets and
 IntMaps from sorted input in linear time. Also changed quickcheck prop_Ordered
 (no longer a tautology!) to include negative and duplicate keys.
 
] 
[correct type for IntMap.intersectionWith[Key]
sedillard@gmail.com**20081002144828] 
[Export mapAccumRWithKey from Map and IntMap (Trac #2769)
matti.niemenmaa+darcs@iki.fi**20081210160205] 
[Bump the version number to 0.2.0.1, to work-around cabal-install problems
Ian Lynagh <igloo@earth.li>**20081212201829] 
[Fix #2760: change mkNorepType to mkNoRepType
'Jose Pedro Magalhaes <jpm@cs.uu.nl>'**20081202083424] 
[Doc fix, from hackage trac #378
Ian Lynagh <igloo@earth.li>**20081024143949] 
[import Data.Data instead of Data.Generics.*, eliminating the dependency on syb
Ross Paterson <ross@soi.city.ac.uk>**20081005002559] 
[fixed typo in highestBitMask
sedillard@gmail.com**20081002215438] 
[export Data.Map.toDescList, foldlWithKey, and foldrWithKey (trac ticket 2580)
qdunkan@gmail.com**20080922213200
 
 toDescList was previously implemented, but not exported.
 
 foldlWithKey was previously implemented, but not exported.  It can be used to
 implement toDescList.
 
 foldrWithKey is already exported as foldWithKey, but foldrWithKey is explicitly
 the mirror of foldlWithKey, and foldWithKey kept for compatibility.
] 
[Bump version number to 0.2.0.0
Ian Lynagh <igloo@earth.li>**20080920160016] 
[TAG 6.10 branch has been forked
Ian Lynagh <igloo@earth.li>**20080919123438] 
[Fixed typo in updateMinWithKey / updateMaxWithKey
sedillard@gmail.com**20080704054350] 
[follow library changes
Ian Lynagh <igloo@earth.li>**20080903223610] 
[add include/Typeable.h to extra-source-files
Ross Paterson <ross@soi.city.ac.uk>**20080831181402] 
[fix cabal build-depends for nhc98
Malcolm.Wallace@cs.york.ac.uk**20080828104248] 
[Add a dep on syb
Ian Lynagh <igloo@earth.li>**20080825214314] 
[add category field
Ross Paterson <ross@soi.city.ac.uk>**20080824003013] 
[we depend on st, now split off from base
Ian Lynagh <igloo@earth.li>**20080823223053] 
[specialize functions that fail in a Monad to Maybe (proposal #2309)
Ross Paterson <ross@soi.city.ac.uk>**20080722154812
 
 Specialize functions signatures like
 
        lookup :: (Monad m, Ord k) => k -> Map k a -> m a
 to
        lookup :: (Ord k) => k -> Map k a -> Maybe a
 
 for simplicity and safety.  No information is lost, as each of these
 functions had only one use of fail, which is now changed to Nothing.
] 
[tighter description of split (addresses #2447)
Ross Paterson <ross@soi.city.ac.uk>**20080717064838] 
[Make warning-clean with GHC again
Ian Lynagh <igloo@earth.li>**20080623232023
 With any luck we have now converged on a solution that works everywhere!
] 
[Undo more Data.Typeable-related breakage for non-ghc.
Malcolm.Wallace@cs.york.ac.uk**20080623092757] 
[Placate GHC with explicit import lists
Ian Lynagh <igloo@earth.li>**20080620183926] 
[undo breakage caused by -Wall cleaning
Malcolm.Wallace@cs.york.ac.uk**20080620093922
 The import of Data.Typeable is still required, at least for non-GHC.
] 
[Make the package -Wall clean
Ian Lynagh <igloo@earth.li>**20080618233627] 
[List particular extensions rather than -fglasgow-exts
Ian Lynagh <igloo@earth.li>**20080616232035] 
[Avoid using deprecated flags
Ian Lynagh <igloo@earth.li>**20080616145241] 
[TAG 2008-05-28
Ian Lynagh <igloo@earth.li>**20080528004309] 
Patch bundle hash:
34a6b333944f7de1e11f31999b2894092a7f0acc