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

Wed Jun 24 13:45:17 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**20090624174517
 Ignore-this: 1b9b00fabd8360c3d3c43d3b2779de62
] {
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
+       iterate,        -- :: 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)
+       -- ** 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 84
        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 97
        ) where
 
 import Prelude hiding (
-       null, length, take, drop, splitAt, foldl, foldl1, foldr, foldr1,
-       reverse)
+       null, length, take, drop, splitAt, foldl, foldl1, foldr, foldr1, span,
+       scanl, scanl1, scanr, scanr1, replicate, zip, zipWith, zip3, zipWith3,
+       takeWhile, dropWhile, break, iterate, reverse)
 import qualified Data.List (foldl')
 import Control.Applicative (Applicative(..), (<$>))
 import Control.Monad (MonadPlus(..))
hunk ./Data/Sequence.hs 119
 #endif
 
 #if TESTING
-import Control.Monad (liftM, liftM3, liftM4)
+import Control.Monad (liftM, liftM2, liftM3, liftM4)
 import Test.QuickCheck
 #endif
 
hunk ./Data/Sequence.hs 125
 infixr 5 `consTree`
 infixl 5 `snocTree`
+infixr 5 `consDigitToTree`
+infixl 6 `snocDigitToTree`
 
 infixr 5 ><
 infixr 5 <|, :<
hunk ./Data/Sequence.hs 279
                        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 317
        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
        traverse f (One a) = One <$> f a
hunk ./Data/Sequence.hs 329
        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 364
        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 425
 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 _ | n < 0 = error "replicate takes a nonnegative integer argument"
+replicate n x  = Seq (replicateFinger n (Elem x))
+
+{-# SPECIALIZE replicateFinger :: Int -> Elem a -> FingerTree (Elem a) #-}
+{-# SPECIALIZE replicateFinger :: Int -> Node a -> FingerTree (Node a) #-}
+replicateFinger :: Sized a => Int -> a -> FingerTree a
+-- Replicates an element in a FingerTree using /O(log n)/ space with careful use of
+-- node sharing.  The reduction in allocation over @fromList (Prelude.replicate n x)@
+-- is tremendous.
+replicateFinger n x = case n of
+       0       -> Empty
+       1       -> Single x
+       2       -> deep one Empty one
+       3       -> deep two Empty one
+       4       -> deep two Empty two
+       5       -> deep three Empty two
+       6       -> deep three Empty three
+       7       -> deep four Empty three
+       8       -> deep four Empty four
+       _       -> let node = node3 x x x in case (n - 8) `quotRem` 3 of
+               (q, 0)  -> deep four (replicateFinger q node) four
+               (q, 1)  -> deep three (replicateFinger (q+1) node) three
+               (q, _)  -> deep four (replicateFinger (q+1) node) three
+       where   one = One x             -- Maximize node sharing.
+               two = Two x x
+               three = Three x x x
+               four = Four x x x 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 551
 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 553
-       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 593
 
 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 595
-       xs `snocTree` a `snocTree` b
+       xs `snocDigitToTree` Two a b
 appendTree2 (Single x) a b xs =
hunk ./Data/Sequence.hs 597
-       x `consTree` a `consTree` b `consTree` xs
+       Three x a b `consDigitToTree` xs
 appendTree2 xs a b (Single x) =
hunk ./Data/Sequence.hs 599
-       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 639
 
 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 641
-       xs `snocTree` a `snocTree` b `snocTree` c
+       xs `snocDigitToTree` Three a b c
 appendTree3 (Single x) a b c xs =
hunk ./Data/Sequence.hs 643
-       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 645
-       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 685
 
 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 687
-       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 689
-       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 691
-       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 729
 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.
+-- 
+-- > iterate n f x = fromList (Prelude.take n (Prelude.iterate f x))
+iterate :: Int -> (a -> a) -> a -> Seq a
+-- borrows the structure of the sequence from replicate and preserves it with mapAccumL
+iterate n f x = n `seq` snd (mapAccumL iterate' x (replicate n ())) where
+       iterate' y _ = let y' = f y in (y', y)
+
 ------------------------------------------------------------------------
 -- Deconstruction
 ------------------------------------------------------------------------
hunk ./Data/Sequence.hs 964
 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 1153
 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 ""]
+-- 
+-- The suffixes are computed lazily from left to right. 
+tails                  :: Seq a -> Seq (Seq a)
+-- Observation: If one value every n/log n values were computed with an application of drop to the original sequence,
+-- and the remaining values were computed from these, viewing any individual tail would cost O(log n) and viewing every tail
+-- would cost O(n).  This is probably an overcomplication, though.
+tails xs               = scanl tail' xs 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"]
+-- 
+-- The prefixes are computed lazily from left to right.  
+inits                  :: Seq a -> Seq (Seq a)
+inits                  = scanl (|>) empty
+
 split :: Int -> FingerTree (Elem a) ->
        (FingerTree (Elem a), FingerTree (Elem a))
 split i Empty  = i `seq` (Empty, Empty)
hunk ./Data/Sequence.hs 1205
        spm     = spr + size m
        im      = i - spr
 
+{-# 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 pull :: FingerTree (Node (Elem a)) -> FingerTree (Elem a) #-}
+{-# SPECIALIZE pull :: FingerTree (Node (Node a)) -> FingerTree (Node a) #-}
+-- Pulls a left and a right digit out of a deep finger tree to make a new tree.  pull t == deepLR Nothing t Nothing.
+pull :: Sized a => FingerTree (Node a) -> FingerTree a
+pull t = case viewLTree t of
+       Nothing2        -> Empty
+       Just2 pr t'     -> pullL (nodeToDigit pr) t'
+
 {-# 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 1230
-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 1236
 {-# 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
 
hunk ./Data/Sequence.hs 1239
+{-# SPECIALIZE INLINE deepLR :: Maybe (Digit (Elem a)) -> FingerTree (Node (Elem a)) -> Maybe (Digit (Elem a)) -> FingerTree (Elem a) #-}
+{-# SPECIALIZE INLINE deepLR :: Maybe (Digit (Node a)) -> FingerTree (Node (Node a)) -> Maybe (Digit (Node a)) -> FingerTree (Node a) #-}
+deepLR :: Sized a => Maybe (Digit a) -> FingerTree (Node a) -> Maybe (Digit a) -> FingerTree a
+deepLR (Just pr) m Nothing = pullL pr m
+deepLR (Just pr) m (Just sf) = deep pr m sf
+deepLR Nothing m (Just sf) = pullR m sf
+deepLR Nothing m Nothing = pull m
+
 {-# 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
hunk ./Data/Sequence.hs 1284
        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)
+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 (Seq xs) = case partitionTree (\ (Elem x) -> p x) xs of
+       (xsT, xsF) -> (Seq xsT, Seq xsF)
+
+{-# SPECIALIZE partitionTree :: (Elem a -> Bool) -> FingerTree (Elem a) -> (FingerTree (Elem a), FingerTree (Elem a)) #-}
+partitionTree :: Sized a => (a -> Bool) -> FingerTree a -> (FingerTree a, FingerTree a)
+partitionTree _ Empty  = (Empty, Empty)
+partitionTree p (Single x)
+       | p x           = (Single x, Empty)
+       | otherwise     = (Empty, Single x)
+partitionTree p (Deep _ pr m sf) = case (partitionDigit p pr, partitionDigit p sf, partitionTree p (pull m)) of
+       ((prT, prF), (sfT, sfF), (mT, mF)) -> (combine prT mT sfT, combine prF mF sfF)
+       where   combineL pr m = foldr consDigitToTree m pr -- Golly gee, possibly consing a Maybe value onto a tree
+               combineR m sf = foldl snocDigitToTree m sf -- is a fold!  Whoaaaaa!
+               combine pr m sf = pr `combineL` m `combineR` sf
+
+partitionDigit :: (a -> Bool) -> Digit a -> (Maybe (Digit a), Maybe (Digit a))
+partitionDigit p (One a) = case (p a) of
+       (False)         -> (Nothing, Just (One a))
+       (True)          -> (Just (One a), Nothing)
+partitionDigit p (Two a b) = case (p a, p b) of
+       (False, False)          -> (Nothing, Just (Two a b))
+       (False, True)           -> (Just (One b), Just (One a))
+       (True, False)           -> (Just (One a), Just (One b))
+       (True, True)            -> (Just (Two a b), Nothing)
+partitionDigit p (Three a b c) = case (p a, p b, p c) of
+       (False, False, False)           -> (Nothing, Just (Three a b c))
+       (False, False, True)            -> (Just (One c), Just (Two a b))
+       (False, True, False)            -> (Just (One b), Just (Two a c))
+       (False, True, True)             -> (Just (Two b c), Just (One a))
+       (True, False, False)            -> (Just (One a), Just (Two b c))
+       (True, False, True)             -> (Just (Two a c), Just (One b))
+       (True, True, False)             -> (Just (Two a b), Just (One c))
+       (True, True, True)              -> (Just (Three a b c), Nothing)
+partitionDigit p (Four a b c d) = case (p a, p b, p c, p d) of
+       (False, False, False, False)            -> (Nothing, Just (Four a b c d))
+       (False, False, False, True)             -> (Just (One d), Just (Three a b c))
+       (False, False, True, False)             -> (Just (One c), Just (Three a b d))
+       (False, False, True, True)              -> (Just (Two c d), Just (Two a b))
+       (False, True, False, False)             -> (Just (One b), Just (Three a c d))
+       (False, True, False, True)              -> (Just (Two b d), Just (Two a c))
+       (False, True, True, False)              -> (Just (Two b c), Just (Two a d))
+       (False, True, True, True)               -> (Just (Three b c d), Just (One a))
+       (True, False, False, False)             -> (Just (One a), Just (Three b c d))
+       (True, False, False, True)              -> (Just (Two a d), Just (Two b c))
+       (True, False, True, False)              -> (Just (Two a c), Just (Two b d))
+       (True, False, True, True)               -> (Just (Three a c d), Just (One b))
+       (True, True, False, False)              -> (Just (Two a b), Just (Two c d))
+       (True, True, False, True)               -> (Just (Three a b d), Just (One c))
+       (True, True, True, False)               -> (Just (Three a b c), Just (One d))
+       (True, True, True, True)                -> (Just (Four a b c d), Nothing)
+
 ------------------------------------------------------------------------
 -- Lists
 ------------------------------------------------------------------------
hunk ./Data/Sequence.hs 1381
                (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 1392
 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 s1 s2 = zipTrunc f (trunc s1) (trunc s2)
+       where   n = length s1 `min` length s2
+               trunc = take n
+
+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 = zipTrunc ($) (zipTrunc f (trunc s1) (trunc s2)) (trunc s3)
+       where   n = length s1 `min` length s2 `min` length s3
+               trunc = take n
+
+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 = ((zipTrunc f (trunc s1) (trunc s2)) `zipApply` trunc s3) `zipApply` trunc s4
+       where   n = length s1 `min` length s2 `min` length s3 `min` length s4
+               trunc = take n
+               zipApply = zipTrunc ($)
+
+-- assumes its arguments are the same length
+zipTrunc :: (a -> b -> c) -> Seq a -> Seq b -> Seq c
+zipTrunc f (Seq a) (Seq b) = Seq (zipWithTree (\ (Elem x) (Elem y) -> Elem (f x y)) a b)
+
+-- We maintain as an invariant that t1 and t2 have the same size, guaranteeing that they will always
+-- have the same FingerTree constructor.  We construct the zipped sequence from both sides at once,
+-- and at each stage "zip" the left and right digits of t1 and t2 and recurse, handling excess appropriately.
+zipWithTree :: (Elem a -> Elem b -> Elem c) -> FingerTree (Elem a) -> FingerTree (Elem b) -> 
+       FingerTree (Elem c)
+zipWithTree f = zipper where
+       Empty `zipper` Empty =
+               Empty
+       Single a `zipper` Single x =
+               Single (a `f` x)
+       Deep _ l1 m1 r1 `zipper` Deep _ l2 m2 r2 = case (zipL f l1 l2, zipR f r1 r2) of
+               ((lZip, l1', l2'), (rZip, r1', r2')) ->
+                       lZip `consDigitToTree` deepLR l1' m1 r1' `zipper` deepLR l2' m2 r2' `snocDigitToTree` rZip
+       _ `zipper` _ = error "Invariant failure in Data.Sequence.zipWith"
+
+{-# INLINE zipL #-}
+-- Zips two digits from the left side, returning the zipped result and remainders.
+zipL :: (a -> b -> c) -> Digit a -> Digit b -> (Digit c, Maybe (Digit a), Maybe (Digit b))
+zipL f (One a) (One x)                         = (One (a `f` x), Nothing, Nothing)
+zipL f (One a) (Two x y)               = (One (a `f` x), Nothing, Just (One y))
+zipL f (One a) (Three x y z)           = (One (a `f` x), Nothing, Just (Two y z))
+zipL f (One a) (Four x y z w)          = (One (a `f` x), Nothing, Just (Three y z w))
+zipL f (Two a b) (One x)               = (One (a `f` x), Just (One b), Nothing)
+zipL f (Two a b) (Two x y)             = (Two (a `f` x) (b `f` y), Nothing, Nothing)
+zipL f (Two a b) (Three x y z)                 = (Two (a `f` x) (b `f` y), Nothing, Just (One z))
+zipL f (Two a b) (Four x y z w)        = (Two (a `f` x) (b `f` y), Nothing, Just (Two z w))
+zipL f (Three a b c) (One x)           = (One (a `f` x), Just (Two b c), Nothing)
+zipL f (Three a b c) (Two x y)                 = (Two (a `f` x) (b `f` y), Just (One c), Nothing)
+zipL f (Three a b c) (Three x y z)     = (Three (a `f` x) (b `f` y) (c `f` z), Nothing, Nothing)
+zipL f (Three a b c) (Four x y z w)    = (Three (a `f` x) (b `f` y) (c `f` z), Nothing, Just (One w))
+zipL f (Four a b c d) (One x)          = (One (a `f` x), Just (Three b c d), Nothing)
+zipL f (Four a b c d) (Two x y)        = (Two (a `f` x) (b `f` y), Just (Two c d), Nothing)
+zipL f (Four a b c d) (Three x y z)    = (Three (a `f` x) (b `f` y) (c `f` z), Just (One d), Nothing)
+zipL f (Four a b c d) (Four x y z w)   = (Four (a `f` x) (b `f` y) (c `f` z) (d `f` w), Nothing, Nothing)
+
+-- Zips two digits from the right, returning the zipped result and both remainders.
+zipR :: (a -> b -> c) -> Digit a -> Digit b -> (Digit c, Maybe (Digit a), Maybe (Digit b))
+zipR f (One a) (One x)                         = (One (a `f` x), Nothing, Nothing)
+zipR f (One a) (Two x y)               = (One (a `f` y), Nothing, Just (One x))
+zipR f (One a) (Three x y z)           = (One (a `f` z), Nothing, Just (Two x y))
+zipR f (One a) (Four x y z w)          = (One (a `f` w), Nothing, Just (Three x y z))
+zipR f (Two a b) (One x)               = (One (b `f` x), Just (One a), Nothing)
+zipR f (Two a b) (Two x y)             = (Two (a `f` x) (b `f` y), Nothing, Nothing)
+zipR f (Two a b) (Three x y z)         = (Two (a `f` y) (b `f` z), Nothing, Just (One x))
+zipR f (Two a b) (Four x y z w)        = (Two (a `f` z) (b `f` w), Nothing, Just (Two x y))
+zipR f (Three a b c) (One x)           = (One (c `f` x), Just (Two a b), Nothing)
+zipR f (Three a b c) (Two x y)                 = (Two (b `f` x) (c `f` y), Just (One a), Nothing)
+zipR f (Three a b c) (Three x y z)     = (Three (a `f` x) (b `f` y) (c `f` z), Nothing, Nothing)
+zipR f (Three a b c) (Four x y z w)    = (Three (a `f` y) (b `f` z) (c `f` w), Nothing, Just (One x))
+zipR f (Four a b c d) (One x)          = (One (d `f` x), Just (Three a b c), Nothing)
+zipR f (Four a b c d) (Two x y)        = (Two (c `f` x) (d `f` y), Just (Two a b), Nothing)
+zipR f (Four a b c d) (Three x y z)    = (Three (b `f` x) (c `f` y) (d `f` z), Just (One a), Nothing)
+zipR f (Four a b c d) (Four x y z w)   = (Four (a `f` x) (b `f` y) (c `f` z) (d `f` w), Nothing, Nothing)
+
+------------------------------------------------------------------------
+-- Sorting
+--
+-- After exhaustive examination, I decided that sophisticated attempts to exploit the structure of
+-- finger trees for a sophisticated merge sort were inevitably slower than the plain and simple
+-- approach taken by Data.List.  Nevertheless, some improvements are feasible.
+-- Here small, finite blocks of elements are sorted and used as seeds to merge recursively.
+-- These small, finite blocks are left and right digits, internally sorted and then merged.
+-- After some careful tuning, GHC's optimizer almost completely inlines the procedures for
+-- sorting these finite lists.
+--
+-- Much of this code was automatically generated.
+------------------------------------------------------------------------
+
+-- | /O(n log n)/.  Sorts the specified 'Seq' by the default ordering.  The sort is not stable.  For a stable sort, convert to a list and use 'Data.List.sort', which is very nearly as fast.
+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.  For a stable sort, convert to a list and use 'Data.List.sortBy', which is approximately as fast.  (Note: Benchmarks indicate that the two methods take roughly the same average time, but this implementation is considerably more consistent in its speed.)
+sortBy :: (a -> a -> Ordering) -> Seq a -> Seq a
+sortBy cmp (Seq (Deep _ pr m sf)) = merger ((mrg `on` sortDigit cmp) pr sf : wrap' m) where
+       sortN = sortNode cmp
+
+       wrap' Empty = []
+       wrap' (Single n) = [toList (sortN n)]
+       wrap' (Deep _ pr m sf) = case zipL (mergeNode cmp `on` sortN) pr sf of
+               (z, pr', sf')   -> foldr (:) (wrap' (deepLR pr' m sf')) z
+
+       merger [] = empty
+       merger [xs] = fromList xs
+       merger xss = merger (mergePairs xss)
+       mergePairs (xs:ys:zss) = mrg xs ys:mergePairs zss
+       mergePairs xss = xss
+       mrg = mergeList cmp
+sortBy _ xs = xs
+
+on :: (b -> b -> c) -> (a -> b) -> a -> a -> c
+f `on` g = \ x y -> f (g x) (g y)
+
+-- Sorts the elements of a Digit.  Used only two times in any call to sortBy, but nevertheless necessary.
+-- (Note: Makes an optimal number of comparisons.)
+sortDigit :: (a -> a -> Ordering) -> Digit (Elem a) -> [a]
+sortDigit cmp = sortDigit' where
+       {-# NOINLINE order2 #-}
+       order2 p q
+               | cmp p q == GT = [q,p]
+               | otherwise     = [p,q]
+       order = orderPair cmp
+       p < q = cmp p q == LT
+       sortDigit' (One (Elem x))
+               = [x]
+       sortDigit' (Two (Elem p) (Elem q))
+               = order2 p q
+       sortDigit' (Three (Elem p) (Elem q) (Elem r)) = case order p q of
+               (p', q')        -> if r < p' then [r,p',q'] else p':order2 q' r
+       sortDigit' (Four (Elem p) (Elem q) (Elem r) (Elem s)) = case (order p q, order r s) of
+               ((a, b), (x, y))
+                       | a < x         -> a:if b < x then [b,x,y] else x:order2 b y
+                       | otherwise     -> x:if a < y then a:order2 b y else [y,a,b]
+
+{-# INLINE sortNode #-}
+-- Convenience method to sort nodes.
+sortNode :: (a -> a -> Ordering) -> Node (Elem a) -> Node a
+sortNode cmp (Node2 n (Elem a) (Elem b)) = uncurry (Node2 n) $! orderPair cmp a b
+sortNode cmp (Node3 n (Elem a) (Elem b) (Elem c)) = case orderPair cmp a b of
+       (a',b') | cmp c b' == GT        -> Node3 n a' b' c
+               | cmp c a' == GT        -> Node3 n a' c b'
+               | otherwise             -> Node3 n c a' b'
+
+orderPair :: (a -> a -> Ordering) -> a -> a -> (a, a)
+orderPair cmp x y
+       | cmp y x == LT = (y, x)
+       | otherwise     = (x, y)
+
+-- Merges two sorted lists.
+{-# INLINE mergeList #-}
+mergeList :: (a -> a -> Ordering) -> [a] -> [a] -> [a]
+mergeList cmp = mergeList' where
+       mergeList' xs@(x:xs') ys@(y:ys')
+               | cmp y x == LT = y:mergeList' xs ys'
+               | otherwise     = x:mergeList' ys xs'
+       mergeList' xs [] = xs
+       mergeList' [] ys = ys
+
+-- Merges two sorted nodes into a list very quickly.
+mergeNode :: (a -> a -> Ordering) -> Node a -> Node a -> [a]
+mergeNode cmp = mergeNode' where
+       p < q = cmp p q == LT
+       order2 p q = if p < q then [p,q] else [q,p]
+       merge22 a b x y
+               | a < x         = a:if b < x then [b, x, y] else x:order2 b y
+               | otherwise     = x:if a < y then a:order2 b y else [y, a, b]
+       merge23 a b x y z       -- note the binary search in the first case!
+               | a < x = a:if b < y    then if b < x then [b, x, y, z] else [x, b, y, z]
+                                       else x:y:order2 b z
+               | otherwise = x:merge22 a b y z
+       merge33 a b c x y z
+               | a < x         = a:merge23 b c x y z
+               | otherwise     = x:merge23 y z a b c
+       mergeNode' (Node2 _ a b) (Node2 _ x y) = merge22 a b x y
+       mergeNode' (Node2 _ a b) (Node3 _ x y z) = merge23 a b x y z
+       mergeNode' (Node3 _ a b c) (Node2 _ x y) = merge23 x y a b c
+       mergeNode' (Node3 _ a b c) (Node3 _ x y z) = merge33 a b c x y z
+
 #if TESTING
 
 ------------------------------------------------------------------------
}

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:
6d83a683a4b67a29268cb19890d3e5ec5a20795b