diff --git a/Data/IntMap.hs b/Data/IntMap.hs
--- a/Data/IntMap.hs
+++ b/Data/IntMap.hs
@@ -96,6 +96,7 @@
             , mapWithKey
             , mapAccum
             , mapAccumWithKey
+            , mapAccumRWithKey
             
             -- ** Fold
             , fold
@@ -168,18 +169,20 @@
 import Data.Maybe (fromMaybe)
 import Data.Typeable
 import Data.Foldable (Foldable(foldMap))
+import Data.Traversable (Traversable(traverse))
+import Control.Applicative (Applicative(pure,(<*>)),(<$>))
 import Control.Monad ( liftM )
 {-
 -- just for testing
 import qualified Prelude
-import Debug.QuickCheck 
+import Test.QuickCheck 
 import List (nub,sort)
 import qualified List
 -}  
 
 #if __GLASGOW_HASKELL__
 import Text.Read
-import Data.Data (Data(..), mkNorepType)
+import Data.Data (Data(..), mkNoRepType)
 #endif
 
 #if __GLASGOW_HASKELL__ >= 503
@@ -252,6 +255,11 @@
     foldMap f (Tip _k v) = f v
     foldMap f (Bin _ _ l r) = foldMap f l `mappend` foldMap f r
 
+instance Traversable IntMap where
+    traverse _ Nil = pure Nil
+    traverse f (Tip k v) = Tip k <$> f v
+    traverse f (Bin p m l r) = Bin p m <$> traverse f l <*> traverse f r
+
 #if __GLASGOW_HASKELL__
 
 {--------------------------------------------------------------------
@@ -265,7 +273,7 @@
   gfoldl f z im = z fromList `f` (toList im)
   toConstr _    = error "toConstr"
   gunfold _ _   = error "gunfold"
-  dataTypeOf _  = mkNorepType "Data.IntMap.IntMap"
+  dataTypeOf _  = mkNoRepType "Data.IntMap.IntMap"
   dataCast1 f   = gcast1 f
 
 #endif
@@ -787,7 +795,7 @@
 --
 -- > intersectionWith (++) (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) == singleton 5 "aA"
 
-intersectionWith :: (a -> b -> a) -> IntMap a -> IntMap b -> IntMap a
+intersectionWith :: (a -> b -> c) -> IntMap a -> IntMap b -> IntMap c
 intersectionWith f m1 m2
   = intersectionWithKey (\_ x y -> f x y) m1 m2
 
@@ -796,7 +804,7 @@
 -- > let f k al ar = (show k) ++ ":" ++ al ++ "|" ++ ar
 -- > intersectionWithKey f (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) == singleton 5 "5:a|A"
 
-intersectionWithKey :: (Key -> a -> b -> a) -> IntMap a -> IntMap b -> IntMap a
+intersectionWithKey :: (Key -> a -> b -> c) -> IntMap a -> IntMap b -> IntMap c
 intersectionWithKey f t1@(Bin p1 m1 l1 r1) t2@(Bin p2 m2 l2 r2)
   | shorter m1 m2  = intersection1
   | shorter m2 m1  = intersection2
@@ -950,12 +958,26 @@
 deleteFindMin = fromMaybe (error "deleteFindMin: empty map has no minimal element") . minView
 
 -- | /O(log n)/. The minimal key of the map.
-findMin :: IntMap a -> a
-findMin = maybe (error "findMin: empty map has no minimal element") fst . minView
+findMin :: IntMap a -> (Int,a)
+findMin Nil = error $ "findMin: empty map has no minimal element"
+findMin (Tip k v) = (k,v)
+findMin (Bin _ m l r)
+  |   m < 0   = find r
+  | otherwise = find l
+    where find (Tip k v)      = (k,v)
+          find (Bin _ _ l' _) = find l'
+          find Nil            = error "findMax Nil"
 
 -- | /O(log n)/. The maximal key of the map.
-findMax :: IntMap a -> a
-findMax = maybe (error "findMax: empty map has no maximal element") fst . maxView
+findMax :: IntMap a -> (Int,a)
+findMax Nil = error $ "findMax: empty map has no maximal element"
+findMax (Tip k v) = (k,v)
+findMax (Bin _ m l r) 
+  |   m < 0   = find l
+  | otherwise = find r
+    where find (Tip k v)      = (k,v)
+          find (Bin _ _ _ r') = find r'
+          find Nil            = error "findMax Nil"
 
 -- | /O(log n)/. Delete the minimal key.
 deleteMin :: IntMap a -> IntMap a
@@ -1112,20 +1134,16 @@
       Tip k x     -> let (a',x') = f a k x in (a',Tip k x')
       Nil         -> (a,Nil)
 
-{-
-XXX unused code
-
 -- | /O(n)/. The function @'mapAccumR'@ threads an accumulating
--- argument throught the map in descending order of keys.
-mapAccumR :: (a -> Key -> b -> (a,c)) -> a -> IntMap b -> (a,IntMap c)
-mapAccumR f a t
+-- argument through the map in descending order of keys.
+mapAccumRWithKey :: (a -> Key -> b -> (a,c)) -> a -> IntMap b -> (a,IntMap c)
+mapAccumRWithKey f a t
   = case t of
-      Bin p m l r -> let (a1,r') = mapAccumR f a r
-                         (a2,l') = mapAccumR f a1 l
+      Bin p m l r -> let (a1,r') = mapAccumRWithKey f a r
+                         (a2,l') = mapAccumRWithKey f a1 l
                      in (a2,Bin p m l' r')
       Tip k x     -> let (a',x') = f a k x in (a',Tip k x')
       Nil         -> (a,Nil)
--}
 
 {--------------------------------------------------------------------
   Filter
@@ -1455,7 +1473,7 @@
   where
     ins t (k,x) = insertWithKey f k x t
 
--- | /O(n*min(n,W))/. Build a map from a list of key\/value pairs where
+-- | /O(n)/. Build a map from a list of key\/value pairs where
 -- the keys are in ascending order.
 --
 -- > fromAscList [(3,"b"), (5,"a")]          == fromList [(3, "b"), (5, "a")]
@@ -1463,36 +1481,64 @@
 
 fromAscList :: [(Key,a)] -> IntMap a
 fromAscList xs
-  = fromList xs
+  = fromAscListWithKey (\_ x _ -> x) xs
 
--- | /O(n*min(n,W))/. Build a map from a list of key\/value pairs where
+-- | /O(n)/. Build a map from a list of key\/value pairs where
 -- the keys are in ascending order, with a combining function on equal keys.
+-- /The precondition (input list is ascending) is not checked./
 --
 -- > fromAscListWith (++) [(3,"b"), (5,"a"), (5,"b")] == fromList [(3, "b"), (5, "ba")]
 
 fromAscListWith :: (a -> a -> a) -> [(Key,a)] -> IntMap a
 fromAscListWith f xs
-  = fromListWith f xs
+  = fromAscListWithKey (\_ x y -> f x y) xs
 
--- | /O(n*min(n,W))/. Build a map from a list of key\/value pairs where
+-- | /O(n)/. Build a map from a list of key\/value pairs where
 -- the keys are in ascending order, with a combining function on equal keys.
+-- /The precondition (input list is ascending) is not checked./
 --
 -- > fromAscListWith (++) [(3,"b"), (5,"a"), (5,"b")] == fromList [(3, "b"), (5, "ba")]
 
 fromAscListWithKey :: (Key -> a -> a -> a) -> [(Key,a)] -> IntMap a
-fromAscListWithKey f xs
-  = fromListWithKey f xs
+fromAscListWithKey _ []         = Nil
+fromAscListWithKey f (x0 : xs0) = fromDistinctAscList (combineEq x0 xs0)
+  where
+    -- [combineEq f xs] combines equal elements with function [f] in an ordered list [xs]
+    combineEq z [] = [z]
+    combineEq z@(kz,zz) (x@(kx,xx):xs)
+      | kx==kz    = let yy = f kx xx zz in combineEq (kx,yy) xs
+      | otherwise = z:combineEq x xs
 
--- | /O(n*min(n,W))/. Build a map from a list of key\/value pairs where
+-- | /O(n)/. Build a map from a list of key\/value pairs where
 -- the keys are in ascending order and all distinct.
+-- /The precondition (input list is strictly ascending) is not checked./
 --
 -- > fromDistinctAscList [(3,"b"), (5,"a")] == fromList [(3, "b"), (5, "a")]
 
 fromDistinctAscList :: [(Key,a)] -> IntMap a
-fromDistinctAscList xs
-  = fromList xs
+fromDistinctAscList []         = Nil
+fromDistinctAscList (z0 : zs0) = work z0 zs0 Nada
+  where
+    work (kx,vx) []            stk = finish kx (Tip kx vx) stk
+    work (kx,vx) (z@(kz,_):zs) stk = reduce z zs (branchMask kx kz) kx (Tip kx vx) stk
 
+    reduce :: (Key,a) -> [(Key,a)] -> Mask -> Prefix -> IntMap a -> Stack a -> IntMap a
+    reduce z zs _ px tx Nada = work z zs (Push px tx Nada)
+    reduce z zs m px tx stk@(Push py ty stk') =
+        let mxy = branchMask px py
+            pxy = mask px mxy
+        in  if shorter m mxy
+                 then reduce z zs m pxy (Bin pxy mxy ty tx) stk'
+                 else work z zs (Push px tx stk)
 
+    finish _  t  Nada = t
+    finish px tx (Push py ty stk) = finish p (join py ty px tx) stk
+        where m = branchMask px py
+              p = mask px m
+
+data Stack a = Push {-# UNPACK #-} !Prefix !(IntMap a) !(Stack a) | Nada
+
+
 {--------------------------------------------------------------------
   Eq 
 --------------------------------------------------------------------}
@@ -1850,7 +1896,7 @@
 --------------------------------------------------------------------}
 prop_Ordered
   = forAll (choose (5,100)) $ \n ->
-    let xs = [(x,()) | x <- [0..n::Int]] 
+    let xs = concat [[(x-n,()),(x-n,())] | x <- [0..2*n::Int]] 
     in fromAscList xs == fromList xs
 
 prop_List :: [Key] -> Bool
diff --git a/Data/IntSet.hs b/Data/IntSet.hs
--- a/Data/IntSet.hs
+++ b/Data/IntSet.hs
@@ -119,7 +119,7 @@
 
 #if __GLASGOW_HASKELL__
 import Text.Read
-import Data.Data (Data(..), mkNorepType)
+import Data.Data (Data(..), mkNoRepType)
 #endif
 
 #if __GLASGOW_HASKELL__ >= 503
@@ -197,7 +197,7 @@
   gfoldl f z is = z fromList `f` (toList is)
   toConstr _    = error "toConstr"
   gunfold _ _   = error "gunfold"
-  dataTypeOf _  = mkNorepType "Data.IntSet.IntSet"
+  dataTypeOf _  = mkNoRepType "Data.IntSet.IntSet"
 
 #endif
 
@@ -591,14 +591,30 @@
 deleteFindMax :: IntSet -> (Int, IntSet)
 deleteFindMax = fromMaybe (error "deleteFindMax: empty set has no maximal element") . maxView
 
--- | /O(min(n,W))/. The minimal element of a set.
+
+-- | /O(min(n,W))/. The minimal element of the set.
 findMin :: IntSet -> Int
-findMin = maybe (error "findMin: empty set has no minimal element") fst . minView
+findMin Nil = error "findMin: empty set has no minimal element"
+findMin (Tip x) = x
+findMin (Bin _ m l r)
+  |   m < 0   = find r
+  | otherwise = find l
+    where find (Tip x)        = x
+          find (Bin _ _ l' _) = find l'
+          find Nil            = error "findMin Nil"
 
 -- | /O(min(n,W))/. The maximal element of a set.
 findMax :: IntSet -> Int
-findMax = maybe (error "findMax: empty set has no maximal element") fst . maxView
+findMax Nil = error "findMax: empty set has no maximal element"
+findMax (Tip x) = x
+findMax (Bin _ m l r)
+  |   m < 0   = find l
+  | otherwise = find r
+    where find (Tip x)        = x
+          find (Bin _ _ _ r') = find r'
+          find Nil            = error "findMax Nil"
 
+
 -- | /O(min(n,W))/. Delete the minimal element.
 deleteMin :: IntSet -> IntSet
 deleteMin = maybe (error "deleteMin: empty set has no minimal element") snd . minView
@@ -670,17 +686,42 @@
   where
     ins t x  = insert x t
 
--- | /O(n*min(n,W))/. Build a set from an ascending list of elements.
+-- | /O(n)/. Build a set from an ascending list of elements.
+-- /The precondition (input list is ascending) is not checked./
 fromAscList :: [Int] -> IntSet 
-fromAscList xs
-  = fromList xs
+fromAscList [] = Nil
+fromAscList (x0 : xs0) = fromDistinctAscList (combineEq x0 xs0)
+  where 
+    combineEq x' [] = [x']
+    combineEq x' (x:xs) 
+      | x==x'     = combineEq x' xs
+      | otherwise = x' : combineEq x xs
 
--- | /O(n*min(n,W))/. Build a set from an ascending list of distinct elements.
+-- | /O(n)/. Build a set from an ascending list of distinct elements.
+-- /The precondition (input list is strictly ascending) is not checked./
 fromDistinctAscList :: [Int] -> IntSet
-fromDistinctAscList xs
-  = fromList xs
+fromDistinctAscList []         = Nil
+fromDistinctAscList (z0 : zs0) = work z0 zs0 Nada
+  where
+    work x []     stk = finish x (Tip x) stk
+    work x (z:zs) stk = reduce z zs (branchMask z x) x (Tip x) stk
 
+    reduce z zs _ px tx Nada = work z zs (Push px tx Nada)
+    reduce z zs m px tx stk@(Push py ty stk') =
+        let mxy = branchMask px py
+            pxy = mask px mxy
+        in  if shorter m mxy
+                 then reduce z zs m pxy (Bin pxy mxy ty tx) stk'
+                 else work z zs (Push px tx stk)
 
+    finish _  t  Nada = t
+    finish px tx (Push py ty stk) = finish p (join py ty px tx) stk
+        where m = branchMask px py
+              p = mask px m
+
+data Stack = Push {-# UNPACK #-} !Prefix !IntSet !Stack | Nada
+
+
 {--------------------------------------------------------------------
   Eq 
 --------------------------------------------------------------------}
@@ -1024,7 +1065,7 @@
 --------------------------------------------------------------------}
 prop_Ordered
   = forAll (choose (5,100)) $ \n ->
-    let xs = [0..n::Int]
+    let xs = concat [[i-n,i-n]|i<-[0..2*n :: Int]]
     in fromAscList xs == fromList xs
 
 prop_List :: [Int] -> Bool
diff --git a/Data/Map.hs b/Data/Map.hs
--- a/Data/Map.hs
+++ b/Data/Map.hs
@@ -96,6 +96,7 @@
             , mapWithKey
             , mapAccum
             , mapAccumWithKey
+            , mapAccumRWithKey
             , mapKeys
             , mapKeysWith
             , mapKeysMonotonic
@@ -103,6 +104,8 @@
             -- ** Fold
             , fold
             , foldWithKey
+            , foldrWithKey
+            , foldlWithKey
 
             -- * Conversion
             , elems
@@ -118,6 +121,7 @@
 
             -- ** Ordered lists
             , toAscList
+            , toDescList
             , fromAscList
             , fromAscListWith
             , fromAscListWithKey
@@ -170,7 +174,7 @@
             , valid
             ) where
 
-import Prelude hiding (lookup,map,filter,foldr,foldl,null)
+import Prelude hiding (lookup,map,filter,null)
 import qualified Data.Set as Set
 import qualified Data.List as List
 import Data.Monoid (Monoid(..))
@@ -193,7 +197,7 @@
 
 #if __GLASGOW_HASKELL__
 import Text.Read
-import Data.Data (Data(..), mkNorepType, gcast2)
+import Data.Data (Data(..), mkNoRepType, gcast2)
 #endif
 
 {--------------------------------------------------------------------
@@ -241,7 +245,7 @@
   gfoldl f z m   = z fromList `f` toList m
   toConstr _     = error "toConstr"
   gunfold _ _    = error "gunfold"
-  dataTypeOf _   = mkNorepType "Data.Map.Map"
+  dataTypeOf _   = mkNoRepType "Data.Map.Map"
   dataCast2 f    = gcast2 f
 
 #endif
@@ -1331,21 +1335,17 @@
                  (a3,r') = mapAccumL f a2 r
              in (a3,Bin sx kx x' l' r')
 
-{-
-XXX unused code
-
 -- | /O(n)/. The function 'mapAccumR' threads an accumulating
--- argument throught the map in descending order of keys.
-mapAccumR :: (a -> k -> b -> (a,c)) -> a -> Map k b -> (a,Map k c)
-mapAccumR f a t
+-- argument through the map in descending order of keys.
+mapAccumRWithKey :: (a -> k -> b -> (a,c)) -> a -> Map k b -> (a,Map k c)
+mapAccumRWithKey f a t
   = case t of
       Tip -> (a,Tip)
       Bin sx kx x l r 
-          -> let (a1,r') = mapAccumR f a r
+          -> let (a1,r') = mapAccumRWithKey f a r
                  (a2,x') = f a1 kx x
-                 (a3,l') = mapAccumR f a2 l
+                 (a3,l') = mapAccumRWithKey f a2 l
              in (a3,Bin sx kx x' l' r')
--}
 
 -- | /O(n*log n)/.
 -- @'mapKeys' f s@ is the map obtained by applying @f@ to each key of @s@.
@@ -1424,10 +1424,13 @@
 --
 -- > let f k a result = result ++ "(" ++ (show k) ++ ":" ++ a ++ ")"
 -- > foldWithKey f "Map: " (fromList [(5,"a"), (3,"b")]) == "Map: (5:a)(3:b)"
+--
+-- This is identical to 'foldrWithKey', and you should use that one instead of
+-- this one.  This name is kept for backward compatibility.
 
 foldWithKey :: (k -> a -> b -> b) -> b -> Map k a -> b
 foldWithKey f z t
-  = foldr f z t
+  = foldrWithKey f z t
 
 {-
 XXX unused code
@@ -1438,19 +1441,20 @@
 foldi f z (Bin _ kx x l r)  = f kx x (foldi f z l) (foldi f z r)
 -}
 
--- | /O(n)/. Post-order fold.
-foldr :: (k -> a -> b -> b) -> b -> Map k a -> b
-foldr _ z Tip              = z
-foldr f z (Bin _ kx x l r) = foldr f (f kx x (foldr f z r)) l
+-- | /O(n)/. Post-order fold.  The function will be applied from the lowest
+-- value to the highest.
+foldrWithKey :: (k -> a -> b -> b) -> b -> Map k a -> b
+foldrWithKey _ z Tip              = z
+foldrWithKey f z (Bin _ kx x l r) =
+    foldrWithKey f (f kx x (foldrWithKey f z r)) l
 
-{-
-XXX unused code
 
--- | /O(n)/. Pre-order fold.
-foldl :: (b -> k -> a -> b) -> b -> Map k a -> b
-foldl _ z Tip              = z
-foldl f z (Bin _ kx x l r) = foldl f (f (foldl f z l) kx x) r
--}
+-- | /O(n)/. Pre-order fold.  The function will be applied from the highest
+-- value to the lowest.
+foldlWithKey :: (b -> k -> a -> b) -> b -> Map k a -> b
+foldlWithKey _ z Tip              = z
+foldlWithKey f z (Bin _ kx x l r) =
+    foldlWithKey f (f (foldlWithKey f z l) kx x) r
 
 {--------------------------------------------------------------------
   List variations 
@@ -1543,15 +1547,11 @@
 -- > toAscList (fromList [(5,"a"), (3,"b")]) == [(3,"b"), (5,"a")]
 
 toAscList :: Map k a -> [(k,a)]
-toAscList t   = foldr (\k x xs -> (k,x):xs) [] t
-
-{-
-XXX unused code
+toAscList t   = foldrWithKey (\k x xs -> (k,x):xs) [] t
 
--- | /O(n)/.
+-- | /O(n)/. Convert to a descending list.
 toDescList :: Map k a -> [(k,a)]
-toDescList t  = foldl (\xs k x -> (k,x):xs) [] t
--}
+toDescList t  = foldlWithKey (\xs k x -> (k,x):xs) [] t
 
 {--------------------------------------------------------------------
   Building trees from ascending/descending lists can be done in linear time.
diff --git a/Data/Sequence.hs b/Data/Sequence.hs
--- a/Data/Sequence.hs
+++ b/Data/Sequence.hs
@@ -3,6 +3,7 @@
 -- |
 -- Module      :  Data.Sequence
 -- Copyright   :  (c) Ross Paterson 2005
+--                (c) Louis Wasserman 2009
 -- License     :  BSD-style
 -- Maintainer  :  libraries@haskell.org
 -- Stability   :  experimental
@@ -40,6 +41,14 @@
 	(|>),		-- :: Seq a -> a -> Seq a
 	(><),		-- :: Seq a -> Seq a -> Seq a
 	fromList,	-- :: [a] -> Seq a
+	-- ** Repetition
+	replicate,	-- :: Int -> a -> Seq a
+	replicateA,	-- :: Applicative f => Int -> f a -> f (Seq a)
+	replicateM,	-- :: Monad m => Int -> m a -> m (Seq a)
+	-- ** Iterative construction
+	iterateN,	-- :: Int -> (a -> a) -> a -> Seq a
+	unfoldr,	-- :: (b -> Maybe (a, b)) -> b -> Seq a
+	unfoldl,	-- :: (b -> Maybe (b, a)) -> b -> Seq a
 	-- * Deconstruction
 	-- | Additional functions for deconstructing sequences are available
 	-- via the 'Foldable' instance of 'Seq'.
@@ -52,27 +61,78 @@
 	viewl,		-- :: Seq a -> ViewL a
 	ViewR(..),
 	viewr,		-- :: Seq a -> ViewR a
-	-- ** Indexing
+	-- * Scans
+	scanl,		-- :: (a -> b -> a) -> a -> Seq b -> Seq a
+	scanl1,		-- :: (a -> a -> a) -> Seq a -> Seq a
+	scanr,		-- :: (a -> b -> b) -> b -> Seq a -> Seq b
+	scanr1,		-- :: (a -> a -> a) -> Seq a -> Seq a
+	-- * Sublists
+	tails,		-- :: Seq a -> Seq (Seq a)
+	inits,		-- :: Seq a -> Seq (Seq a)
+	-- ** Sequential searches
+	takeWhileL,	-- :: (a -> Bool) -> Seq a -> Seq a
+	takeWhileR,	-- :: (a -> Bool) -> Seq a -> Seq a
+	dropWhileL,	-- :: (a -> Bool) -> Seq a -> Seq a
+	dropWhileR,	-- :: (a -> Bool) -> Seq a -> Seq a
+	spanl,		-- :: (a -> Bool) -> Seq a -> (Seq a, Seq a)
+	spanr,		-- :: (a -> Bool) -> Seq a -> (Seq a, Seq a)
+	breakl,		-- :: (a -> Bool) -> Seq a -> (Seq a, Seq a)
+	breakr,		-- :: (a -> Bool) -> Seq a -> (Seq a, Seq a)
+	partition,	-- :: (a -> Bool) -> Seq a -> (Seq a, Seq a)
+	filter,		-- :: (a -> Bool) -> Seq a -> Seq a
+	-- * Sorting
+	sort,		-- :: Ord a => Seq a -> Seq a
+	sortBy,		-- :: (a -> a -> Ordering) -> Seq a -> Seq a
+	unstableSort,	-- :: Ord a => Seq a -> Seq a
+	unstableSortBy,	-- :: (a -> a -> Ordering) -> Seq a -> Seq a
+	-- * Indexing
 	index,		-- :: Seq a -> Int -> a
 	adjust,		-- :: (a -> a) -> Int -> Seq a -> Seq a
 	update,		-- :: Int -> a -> Seq a -> Seq a
 	take,		-- :: Int -> Seq a -> Seq a
 	drop,		-- :: Int -> Seq a -> Seq a
 	splitAt,	-- :: Int -> Seq a -> (Seq a, Seq a)
+	-- ** Indexing with predicates
+	-- | These functions perform sequential searches from the left
+	-- or right ends of the sequence, returning indices of matching
+	-- elements.
+	elemIndexL,	-- :: Eq a => a -> Seq a -> Maybe Int
+	elemIndicesL,	-- :: Eq a => a -> Seq a -> [Int]
+	elemIndexR,	-- :: Eq a => a -> Seq a -> Maybe Int
+	elemIndicesR,	-- :: Eq a => a -> Seq a -> [Int]
+	findIndexL,	-- :: (a -> Bool) -> Seq a -> Maybe Int
+	findIndicesL,	-- :: (a -> Bool) -> Seq a -> [Int]
+	findIndexR,	-- :: (a -> Bool) -> Seq a -> Maybe Int
+	findIndicesR,	-- :: (a -> Bool) -> Seq a -> [Int]
+	-- * Folds
+	-- | General folds are available via the 'Foldable' instance of 'Seq'.
+	foldlWithIndex,	-- :: (b -> Int -> a -> b) -> b -> Seq a -> b
+	foldrWithIndex, -- :: (Int -> a -> b -> b) -> b -> Seq a -> b
 	-- * Transformations
+	mapWithIndex,	-- :: (Int -> a -> b) -> Seq a -> Seq b
 	reverse,	-- :: Seq a -> Seq a
+	-- ** Zips
+	zip,		-- :: Seq a -> Seq b -> Seq (a, b)
+	zipWith, 	-- :: (a -> b -> c) -> Seq a -> Seq b -> Seq c
+	zip3,		-- :: Seq a -> Seq b -> Seq c -> Seq (a, b, c)
+	zipWith3,	-- :: (a -> b -> c -> d) -> Seq a -> Seq b -> Seq c -> Seq d
+	zip4,		-- :: Seq a -> Seq b -> Seq c -> Seq d -> Seq (a, b, c, d)
+	zipWith4,	-- :: (a -> b -> c -> d -> e) -> Seq a -> Seq b -> Seq c -> Seq d -> Seq e
 #if TESTING
 	valid,
 #endif
 	) where
 
 import Prelude hiding (
+	Functor(..),
 	null, length, take, drop, splitAt, foldl, foldl1, foldr, foldr1,
-	reverse)
-import qualified Data.List (foldl')
-import Control.Applicative (Applicative(..), (<$>))
-import Control.Monad (MonadPlus(..))
+	scanl, scanl1, scanr, scanr1, replicate, zip, zipWith, zip3, zipWith3,
+	takeWhile, dropWhile, iterate, reverse, filter, mapM, sum, all)
+import qualified Data.List (foldl', sortBy)
+import Control.Applicative (Applicative(..), (<$>), WrappedMonad(..), liftA, liftA2, liftA3)
+import Control.Monad (MonadPlus(..), ap)
 import Data.Monoid (Monoid(..))
+import Data.Functor (Functor(..))
 import Data.Foldable
 import Data.Traversable
 #ifndef __GLASGOW_HASKELL__
@@ -81,6 +141,7 @@
 import Data.Typeable (TyCon, Typeable1(..), mkTyCon, mkTyConApp )
 
 #ifdef __GLASGOW_HASKELL__
+import GHC.Exts (build)
 import Text.Read (Lexeme(Ident), lexP, parens, prec,
 	readPrec, readListPrec, readListPrecDefault)
 import Data.Data (Data(..), DataType, Constr, Fixity(..),
@@ -88,8 +149,9 @@
 #endif
 
 #if TESTING
-import Control.Monad (liftM, liftM3, liftM4)
-import Test.QuickCheck
+import Control.Monad (liftM, liftM2, liftM3, liftM4)
+import qualified Data.List (zipWith)
+import Test.QuickCheck hiding ((><))
 #endif
 
 infixr 5 `consTree`
@@ -107,6 +169,7 @@
 
 instance Functor Seq where
 	fmap f (Seq xs) = Seq (fmap (fmap f) xs)
+	x <$ s = replicate (length s) x
 
 instance Foldable Seq where
 	foldr f z (Seq xs) = foldr (flip (foldr f)) z xs
@@ -246,11 +309,35 @@
 			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
 
+{-# INLINE pullL #-}
+pullL :: Sized a => Int -> FingerTree (Node a) -> Digit a -> FingerTree a
+pullL s m sf = case viewLTree m of
+	Nothing2	-> digitToTree' s sf
+	Just2 pr m'	-> Deep s (nodeToDigit pr) m' sf
+
+{-# INLINE pullR #-}
+pullR :: Sized a => Int -> Digit a -> FingerTree (Node a) -> FingerTree a
+pullR s pr m = case viewRTree m of
+	Nothing2	-> digitToTree' s pr
+	Just2 m' sf	-> Deep s pr m' (nodeToDigit sf)
+
+{-# SPECIALIZE deepL :: Maybe (Digit (Elem a)) -> FingerTree (Node (Elem a)) -> Digit (Elem a) -> FingerTree (Elem a) #-}
+{-# SPECIALIZE deepL :: Maybe (Digit (Node a)) -> FingerTree (Node (Node a)) -> Digit (Node a) -> FingerTree (Node a) #-}
+deepL :: Sized a => Maybe (Digit a) -> FingerTree (Node a) -> Digit a -> FingerTree a
+deepL Nothing m sf	= pullL (size m + size sf) m sf
+deepL (Just pr) m sf	= deep pr m sf
+
+{-# SPECIALIZE deepR :: Digit (Elem a) -> FingerTree (Node (Elem a)) -> Maybe (Digit (Elem a)) -> FingerTree (Elem a) #-}
+{-# SPECIALIZE deepR :: Digit (Node a) -> FingerTree (Node (Node a)) -> Maybe (Digit (Node a)) -> FingerTree (Node a) #-}
+deepR :: Sized a => Digit a -> FingerTree (Node a) -> Maybe (Digit a) -> FingerTree a
+deepR pr m Nothing	= pullR (size m + size pr) pr m
+deepR pr m (Just sf)	= deep pr m sf
+
 -- Digits
 
 data Digit a
@@ -287,15 +374,15 @@
 	fmap = fmapDefault
 
 instance Traversable Digit where
+	{-# INLINE traverse #-}
 	traverse f (One a) = One <$> f a
 	traverse f (Two a b) = Two <$> f a <*> f b
 	traverse f (Three a b c) = Three <$> f a <*> f b <*> f c
 	traverse f (Four a b c d) = Four <$> f a <*> f b <*> f c <*> f d
 
 instance 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
+	{-# INLINE size #-}
+	size = foldl1 (+) . fmap size
 
 {-# SPECIALIZE digitToTree :: Digit (Elem a) -> FingerTree (Elem a) #-}
 {-# SPECIALIZE digitToTree :: Digit (Node a) -> FingerTree (Node a) #-}
@@ -305,6 +392,14 @@
 digitToTree (Three a b c) = deep (Two a b) Empty (One c)
 digitToTree (Four a b c d) = deep (Two a b) Empty (Two c d)
 
+-- | Given the size of a digit and the digit itself, efficiently converts
+-- it to a FingerTree.
+digitToTree' :: Int -> Digit a -> FingerTree a
+digitToTree' n (Four a b c d) = Deep n (Two a b) Empty (Two c d)
+digitToTree' n (Three a b c) = Deep n (Two a b) Empty (One c)
+digitToTree' n (Two a b) = Deep n (One a) Empty (One b)
+digitToTree' n (One a) = n `seq` Single a
+
 -- Nodes
 
 data Node a
@@ -322,9 +417,11 @@
 	foldl f z (Node3 _ a b c) = ((z `f` a) `f` b) `f` c
 
 instance Functor Node where
+	{-# INLINE fmap #-}
 	fmap = fmapDefault
 
 instance Traversable Node where
+	{-# INLINE traverse #-}
 	traverse f (Node2 v a b) = Node2 v <$> f a <*> f b
 	traverse f (Node3 v a b c) = Node3 v <$> f a <*> f b <*> f c
 
@@ -370,6 +467,81 @@
 	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 Monad Id where
+	return = Id
+	m >>= k = k (runId m)
+
+instance Applicative Id where
+	pure = return
+	(<*>) = ap
+
+-- | This is essentially a clone of Control.Monad.State.Strict.
+newtype State s a = State {runState :: s -> (s, a)}
+
+instance Functor (State s) where
+	fmap = liftA
+
+instance Monad (State s) where
+	{-# INLINE return #-}
+	{-# INLINE (>>=) #-}
+	return x = State $ \ s -> (s, x)
+	m >>= k = State $ \ s -> case runState m s of
+		(s', x)	-> runState (k x) s'
+
+instance Applicative (State s) where
+	pure = return
+	(<*>) = ap
+
+execState :: State s a -> s -> a
+execState m x = snd (runState m x)
+
+-- | A helper method: a strict version of mapAccumL.
+mapAccumL' :: Traversable t => (a -> b -> (a, c)) -> a -> t b -> (a, t c)
+mapAccumL' f s t = runState (traverse (State . flip f) t) s
+
+-- | 'applicativeTree' takes an Applicative-wrapped construction of a
+-- piece of a FingerTree, assumed to always have the same size (which
+-- is put in the second argument), and replicates it as many times as
+-- specified.  This is a generalization of 'replicateA', which itself
+-- is a generalization of many Data.Sequence methods.
+{-# SPECIALIZE applicativeTree :: Int -> Int -> State s a -> State s (FingerTree a) #-}
+{-# SPECIALIZE applicativeTree :: Int -> Int -> Id a -> Id (FingerTree a) #-}
+-- Special note: the Id specialization automatically does node sharing,
+-- reducing memory usage of the resulting tree to /O(log n)/.
+applicativeTree :: Applicative f => Int -> Int -> f a -> f (FingerTree a)
+applicativeTree n mSize m = mSize `seq` case n of
+	0 -> emptyTree
+	1 -> liftA Single m
+	2 -> deepA one emptyTree one
+	3 -> deepA two emptyTree one
+	4 -> deepA two emptyTree two
+	5 -> deepA three emptyTree two
+	6 -> deepA three emptyTree three
+	7 -> deepA four emptyTree three
+	8 -> deepA four emptyTree four
+	_ -> let (q, r) = n `quotRem` 3 in q `seq` case r of
+		0 -> deepA three (applicativeTree (q - 2) mSize' n3) three
+		1 -> deepA four (applicativeTree (q - 2) mSize' n3) three
+		_ -> deepA four (applicativeTree (q - 2) mSize' n3) four
+  where
+	one = liftA One m
+	two = liftA2 Two m m
+	three = liftA3 Three m m m
+	four = liftA3 Four m m m <*> m
+	deepA = liftA3 (Deep (n * mSize))
+	mSize' = 3 * mSize
+	n3 = liftA3 (Node3 mSize') m m m
+	emptyTree = pure Empty
+
 ------------------------------------------------------------------------
 -- Construction
 ------------------------------------------------------------------------
@@ -382,6 +554,29 @@
 singleton	:: a -> Seq a
 singleton x	=  Seq (Single (Elem x))
 
+-- | /O(log n)/. @replicate n x@ is a sequence consisting of @n@ copies of @x@.
+replicate	:: Int -> a -> Seq a
+replicate n x
+  | n >= 0	= runId (replicateA n (Id x))
+  | otherwise	= error "replicate takes a nonnegative integer argument"
+
+-- | 'replicateA' is an 'Applicative' version of 'replicate', and makes
+-- /O(log n)/ calls to '<*>' and 'pure'.
+--
+-- > replicateA n x = sequenceA (replicate n x)
+replicateA :: Applicative f => Int -> f a -> f (Seq a)
+replicateA n x
+  | n >= 0	= Seq <$> applicativeTree n 1 (Elem <$> x)
+  | otherwise	= error "replicateA takes a nonnegative integer argument"
+
+-- | 'replicateM' is a sequence counterpart of 'Control.Monad.replicateM'.
+--
+-- > replicateM n x = sequence (replicate n x)
+replicateM :: Monad m => Int -> m a -> m (Seq a)
+replicateM n x
+  | n >= 0	= unwrapMonad (replicateA n (WrapMonad x))
+  | otherwise	= error "replicateM takes a nonnegative integer argument"
+
 -- | /O(1)/. Add an element to the left end of a sequence.
 -- Mnemonic: a triangle with the single element at the pointy end.
 (<|)		:: a -> Seq a -> Seq a
@@ -656,6 +851,28 @@
 addDigits4 m1 (Four a b c d) e f g h (Four i j k l) m2 =
 	appendTree4 m1 (node3 a b c) (node3 d e f) (node3 g h i) (node3 j k l) m2
 
+-- | Builds a sequence from a seed value.  Takes time linear in the
+-- number of generated elements.  /WARNING:/ If the number of generated
+-- elements is infinite, this method will not terminate.
+unfoldr :: (b -> Maybe (a, b)) -> b -> Seq a
+unfoldr f = unfoldr' empty
+  -- uses tail recursion rather than, for instance, the List implementation.
+  where unfoldr' as b = maybe as (\ (a, b') -> unfoldr' (as |> a) b') (f b)
+
+-- | @'unfoldl' f x@ is equivalent to @'reverse' ('unfoldr' (swap . f) x)@.
+unfoldl :: (b -> Maybe (b, a)) -> b -> Seq a
+unfoldl f = unfoldl' empty
+  where unfoldl' as b = maybe as (\ (b', a) -> unfoldl' (a <| as) b') (f b)
+
+-- | /O(n)/.  Constructs a sequence by repeated application of a function
+-- to a seed value.
+--
+-- > iterateN n f x = fromList (Prelude.take n (Prelude.iterate f x))
+iterateN :: Int -> (a -> a) -> a -> Seq a
+iterateN n f x
+  | n >= 0	= replicateA n (State (\ y -> (f y, y))) `execState` x
+  | otherwise	= error "iterateN takes a nonnegative integer argument"
+
 ------------------------------------------------------------------------
 -- Deconstruction
 ------------------------------------------------------------------------
@@ -721,9 +938,7 @@
 viewLTree	:: Sized a => FingerTree a -> Maybe2 a (FingerTree a)
 viewLTree Empty			= Nothing2
 viewLTree (Single a)		= Just2 a Empty
-viewLTree (Deep s (One a) m sf) = Just2 a (case viewLTree m of
-	Nothing2	-> digitToTree sf
-	Just2 b m'	-> Deep (s - size a) (nodeToDigit b) m' sf)
+viewLTree (Deep s (One a) m sf) = Just2 a (pullL (s - size a) m sf)
 viewLTree (Deep s (Two a b) m sf) =
 	Just2 a (Deep (s - size a) (One b) m sf)
 viewLTree (Deep s (Three a b c) m sf) =
@@ -760,7 +975,7 @@
 	foldr f z (xs :> x) = foldr f (f x z) xs
 
 	foldl _ z EmptyR = z
-	foldl f z (xs :> x) = f (foldl f z xs) x
+	foldl f z (xs :> x) = foldl f z xs `f` x
 
 	foldr1 _ EmptyR = error "foldr1: empty view"
 	foldr1 f (xs :> x) = foldr f x xs
@@ -780,9 +995,7 @@
 viewRTree	:: Sized a => FingerTree a -> Maybe2 (FingerTree a) a
 viewRTree Empty			= Nothing2
 viewRTree (Single z)		= Just2 Empty z
-viewRTree (Deep s pr m (One z)) = Just2 (case viewRTree m of
-	Nothing2	->  digitToTree pr
-	Just2 m' y	->  Deep (s - size z) pr m' (nodeToDigit y)) z
+viewRTree (Deep s pr m (One z)) = Just2 (pullR (s - size z) pr m) z
 viewRTree (Deep s pr m (Two y z)) =
 	Just2 (Deep (s - size z) pr m (One y)) z
 viewRTree (Deep s pr m (Three x y z)) =
@@ -790,10 +1003,49 @@
 viewRTree (Deep s pr m (Four w x y z)) =
 	Just2 (Deep (s - size z) pr m (Three w x y)) z
 
+------------------------------------------------------------------------
+-- Scans
+--
+-- These are not particularly complex applications of the Traversable
+-- functor, though making the correspondence with Data.List exact
+-- requires the use of (<|) and (|>).
+--
+-- Note that save for the single (<|) or (|>), we maintain the original
+-- structure of the Seq, not having to do any restructuring of our own.
+--
+-- wasserman.louis@gmail.com, 5/23/09
+------------------------------------------------------------------------
+
+-- | 'scanl' is similar to 'foldl', but returns a sequence of reduced
+-- values from the left:
+--
+-- > scanl f z (fromList [x1, x2, ...]) = fromList [z, z `f` x1, (z `f` x1) `f` x2, ...]
+scanl :: (a -> b -> a) -> a -> Seq b -> Seq a
+scanl f z0 xs = z0 <| snd (mapAccumL (\ x z -> let x' = f x z in (x', x')) z0 xs)
+
+-- | 'scanl1' is a variant of 'scanl' that has no starting value argument:
+--
+-- > scanl1 f (fromList [x1, x2, ...]) = fromList [x1, x1 `f` x2, ...]
+scanl1 :: (a -> a -> a) -> Seq a -> Seq a
+scanl1 f xs = case viewl xs of
+	EmptyL		-> error "scanl1 takes a nonempty sequence as an argument"
+	x :< xs'	-> scanl f x xs'
+
+-- | 'scanr' is the right-to-left dual of 'scanl'.
+scanr :: (a -> b -> b) -> b -> Seq a -> Seq b
+scanr f z0 xs = snd (mapAccumR (\ z x -> let z' = f x z in (z', z')) z0 xs) |> z0
+
+-- | 'scanr1' is a variant of 'scanr' that has no starting value argument.
+scanr1 :: (a -> a -> a) -> Seq a -> Seq a
+scanr1 f xs = case viewr xs of
+	EmptyR		-> error "scanr1 takes a nonempty sequence as an argument"
+	xs' :> x	-> scanr f x xs'
+
 -- Indexing
 
 -- | /O(log(min(i,n-i)))/. The element at the specified position,
--- which should be a positive integer less than the size of the sequence.
+-- counting from 0.  The argument should thus be a non-negative
+-- integer less than the size of the sequence.
 -- If the position is out of range, 'index' fails with an error.
 index		:: Seq a -> Int -> a
 index (Seq xs) i
@@ -918,6 +1170,12 @@
 	sab	= sa + size b
 	sabc	= sab + size c
 
+-- | A generalization of 'fmap', 'mapWithIndex' takes a mapping function
+-- that also depends on the element's index, and applies it to every
+-- element in the sequence.
+mapWithIndex :: (Int -> a -> b) -> Seq a -> Seq b
+mapWithIndex f xs = snd (mapAccumL' (\ i x -> (i + 1, f i x)) 0 xs)
+
 -- Splitting
 
 -- | /O(log(min(i,n-i)))/. The first @i@ elements of a sequence.
@@ -928,7 +1186,7 @@
 take i		=  fst . splitAt i
 
 -- | /O(log(min(i,n-i)))/. Elements of a sequence after the first @i@.
--- If @i@ is negative, @'take' i s@ yields the whole sequence.
+-- If @i@ is negative, @'drop' i s@ yields the whole sequence.
 -- If the sequence contains fewer than @i@ elements, the empty sequence
 -- is returned.
 drop		:: Int -> Seq a -> Seq a
@@ -963,29 +1221,13 @@
 			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
-			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
 
-{-# SPECIALIZE deepL :: Maybe (Digit (Elem a)) -> FingerTree (Node (Elem a)) -> Digit (Elem a) -> FingerTree (Elem a) #-}
-{-# SPECIALIZE deepL :: Maybe (Digit (Node a)) -> FingerTree (Node (Node a)) -> Digit (Node a) -> FingerTree (Node a) #-}
-deepL :: Sized a => Maybe (Digit a) -> FingerTree (Node a) -> Digit a -> FingerTree a
-deepL Nothing m sf	= case viewLTree m of
-	Nothing2	-> digitToTree sf
-	Just2 a m'	-> Deep (size m + size sf) (nodeToDigit a) m' sf
-deepL (Just pr) m sf	= deep pr m sf
-
-{-# SPECIALIZE deepR :: Digit (Elem a) -> FingerTree (Node (Elem a)) -> Maybe (Digit (Elem a)) -> FingerTree (Elem a) #-}
-{-# SPECIALIZE deepR :: Digit (Node a) -> FingerTree (Node (Node a)) -> Maybe (Digit (Node a)) -> FingerTree (Node a) #-}
-deepR :: Sized a => Digit a -> FingerTree (Node a) -> Maybe (Digit a) -> FingerTree a
-deepR pr m Nothing	= case viewRTree m of
-	Nothing2	-> digitToTree pr
-	Just2 m' a	-> Deep (size pr + size m) pr m' (nodeToDigit a)
-deepR pr m (Just sf)	= deep pr m sf
-
 {-# 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
@@ -1023,6 +1265,257 @@
 	sab	= sa + size b
 	sabc	= sab + size c
 
+-- | /O(n)/.  Returns a sequence of all suffixes of this sequence,
+-- longest first.  For example,
+--
+-- > tails (fromList "abc") = fromList [fromList "abc", fromList "bc", fromList "c", fromList ""]
+--
+-- Evaluating the /i/th suffix takes /O(log(min(i, n-i)))/, but evaluating
+-- every suffix in the sequence takes /O(n)/ due to sharing.
+tails			:: Seq a -> Seq (Seq a)
+tails (Seq xs)		= Seq (tailsTree (Elem . Seq) xs) |> empty
+
+-- | /O(n)/.  Returns a sequence of all prefixes of this sequence,
+-- shortest first.  For example,
+--
+-- > inits (fromList "abc") = fromList [fromList "", fromList "a", fromList "ab", fromList "abc"]
+--
+-- Evaluating the /i/th prefix takes /O(log(min(i, n-i)))/, but evaluating
+-- every prefix in the sequence takes /O(n)/ due to sharing.
+inits			:: Seq a -> Seq (Seq a)
+inits (Seq xs) 		= empty <| Seq (initsTree (Elem . Seq) xs)
+
+-- This implementation of tails (and, analogously, inits) has the
+-- following algorithmic advantages:
+--	Evaluating each tail in the sequence takes linear total time,
+--	which is better than we could say for
+-- 		@fromList [drop n xs | n <- [0..length xs]]@.
+--	Evaluating any individual tail takes logarithmic time, which is
+--	better than we can say for either
+-- 		@scanr (<|) empty xs@ or @iterateN (length xs + 1) (\ xs -> let _ :< xs' = viewl xs in xs') xs@.
+--
+-- Moreover, if we actually look at every tail in the sequence, the
+-- following benchmarks demonstrate that this implementation is modestly
+-- faster than any of the above:
+--
+-- Times (ms)
+--               min      mean    +/-sd    median    max
+-- Seq.tails:   21.986   24.961   10.169   22.417   86.485
+-- scanr:       85.392   87.942    2.488   87.425  100.217
+-- iterateN:       29.952   31.245    1.574   30.412   37.268
+--
+-- The algorithm for tails (and, analogously, inits) is as follows:
+--
+-- A Node in the FingerTree of tails is constructed by evaluating the
+-- corresponding tail of the FingerTree of Nodes, considering the first
+-- Node in this tail, and constructing a Node in which each tail of this
+-- Node is made to be the prefix of the remaining tree.  This ends up
+-- working quite elegantly, as the remainder of the tail of the FingerTree
+-- of Nodes becomes the middle of a new tail, the suffix of the Node is
+-- the prefix, and the suffix of the original tree is retained.
+--
+-- In particular, evaluating the /i/th tail involves making as
+-- many partial evaluations as the Node depth of the /i/th element.
+-- In addition, when we evaluate the /i/th tail, and we also evaluate
+-- the /j/th tail, and /m/ Nodes are on the path to both /i/ and /j/,
+-- each of those /m/ evaluations are shared between the computation of
+-- the /i/th and /j/th tails.
+--
+-- wasserman.louis@gmail.com, 7/16/09
+
+tailsDigit :: Digit a -> Digit (Digit a)
+tailsDigit (One a) = One (One a)
+tailsDigit (Two a b) = Two (Two a b) (One b)
+tailsDigit (Three a b c) = Three (Three a b c) (Two b c) (One c)
+tailsDigit (Four a b c d) = Four (Four a b c d) (Three b c d) (Two c d) (One d)
+
+initsDigit :: Digit a -> Digit (Digit a)
+initsDigit (One a) = One (One a)
+initsDigit (Two a b) = Two (One a) (Two a b)
+initsDigit (Three a b c) = Three (One a) (Two a b) (Three a b c)
+initsDigit (Four a b c d) = Four (One a) (Two a b) (Three a b c) (Four a b c d)
+
+tailsNode :: Node a -> Node (Digit a)
+tailsNode (Node2 s a b) = Node2 s (Two a b) (One b)
+tailsNode (Node3 s a b c) = Node3 s (Three a b c) (Two b c) (One c)
+
+initsNode :: Node a -> Node (Digit a)
+initsNode (Node2 s a b) = Node2 s (One a) (Two a b)
+initsNode (Node3 s a b c) = Node3 s (One a) (Two a b) (Three a b c)
+
+{-# SPECIALIZE tailsTree :: (FingerTree (Elem a) -> Elem b) -> FingerTree (Elem a) -> FingerTree (Elem b) #-}
+{-# SPECIALIZE tailsTree :: (FingerTree (Node a) -> Node b) -> FingerTree (Node a) -> FingerTree (Node b) #-}
+-- | Given a function to apply to tails of a tree, applies that function
+-- to every tail of the specified tree.
+tailsTree :: (Sized a, Sized b) => (FingerTree a -> b) -> FingerTree a -> FingerTree b
+tailsTree _ Empty = Empty
+tailsTree f (Single x) = Single (f (Single x))
+tailsTree f (Deep n pr m sf) =
+	Deep n (fmap (\ pr' -> f (deep pr' m sf)) (tailsDigit pr))
+		(tailsTree f' m)
+		(fmap (f . digitToTree) (tailsDigit sf))
+  where	f' ms = let Just2 node m' = viewLTree ms in
+		fmap (\ pr' -> f (deep pr' m' sf)) (tailsNode node)
+
+{-# SPECIALIZE initsTree :: (FingerTree (Elem a) -> Elem b) -> FingerTree (Elem a) -> FingerTree (Elem b) #-}
+{-# SPECIALIZE initsTree :: (FingerTree (Node a) -> Node b) -> FingerTree (Node a) -> FingerTree (Node b) #-}
+-- | Given a function to apply to inits of a tree, applies that function
+-- to every init of the specified tree.
+initsTree :: (Sized a, Sized b) => (FingerTree a -> b) -> FingerTree a -> FingerTree b
+initsTree _ Empty = Empty
+initsTree f (Single x) = Single (f (Single x))
+initsTree f (Deep n pr m sf) =
+	Deep n (fmap (f . digitToTree) (initsDigit pr))
+		(initsTree f' m)
+		(fmap (f . deep pr m) (initsDigit sf))
+  where	f' ms =  let Just2 m' node = viewRTree ms in
+		 fmap (\ sf' -> f (deep pr m' sf')) (initsNode node)
+
+{-# INLINE foldlWithIndex #-}
+-- | 'foldlWithIndex' is a version of 'foldl' that also provides access
+-- to the index of each element.
+foldlWithIndex :: (b -> Int -> a -> b) -> b -> Seq a -> b
+foldlWithIndex f z xs = foldl (\ g x i -> i `seq` f (g (i - 1)) i x) (const z) xs (length xs - 1)
+
+{-# INLINE foldrWithIndex #-}
+-- | 'foldrWithIndex' is a version of 'foldr' that also provides access
+-- to the index of each element.
+foldrWithIndex :: (Int -> a -> b -> b) -> b -> Seq a -> b
+foldrWithIndex f z xs = foldr (\ x g i -> i `seq` f i x (g (i+1))) (const z) xs 0
+
+{-# INLINE listToMaybe' #-}
+-- 'listToMaybe\'' is a good consumer version of 'listToMaybe'.
+listToMaybe' :: [a] -> Maybe a
+listToMaybe' = foldr (\ x _ -> Just x) Nothing
+
+-- | /O(i)/ where /i/ is the prefix length.  'takeWhileL', applied
+-- to a predicate @p@ and a sequence @xs@, returns the longest prefix
+-- (possibly empty) of @xs@ of elements that satisfy @p@.
+takeWhileL :: (a -> Bool) -> Seq a -> Seq a
+takeWhileL p = fst . spanl p
+
+-- | /O(i)/ where /i/ is the suffix length.  'takeWhileR', applied
+-- to a predicate @p@ and a sequence @xs@, returns the longest suffix
+-- (possibly empty) of @xs@ of elements that satisfy @p@.
+--
+-- @'takeWhileR' p xs@ is equivalent to @'reverse' ('takeWhileL' p ('reverse' xs))@.
+takeWhileR :: (a -> Bool) -> Seq a -> Seq a
+takeWhileR p = fst . spanr p
+
+-- | /O(i)/ where /i/ is the prefix length.  @'dropWhileL' p xs@ returns
+-- the suffix remaining after @'takeWhileL' p xs@.
+dropWhileL :: (a -> Bool) -> Seq a -> Seq a
+dropWhileL p = snd . spanl p
+
+-- | /O(i)/ where /i/ is the suffix length.  @'dropWhileR' p xs@ returns
+-- the prefix remaining after @'takeWhileR' p xs@.
+--
+-- @'dropWhileR' p xs@ is equivalent to @'reverse' ('dropWhileL' p ('reverse' xs))@.
+dropWhileR :: (a -> Bool) -> Seq a -> Seq a
+dropWhileR p = snd . spanr p
+
+-- | /O(i)/ where /i/ is the prefix length.  'spanl', applied to
+-- a predicate @p@ and a sequence @xs@, returns a pair whose first
+-- element is the longest prefix (possibly empty) of @xs@ of elements that
+-- satisfy @p@ and the second element is the remainder of the sequence.
+spanl :: (a -> Bool) -> Seq a -> (Seq a, Seq a)
+spanl p = breakl (not . p)
+
+-- | /O(i)/ where /i/ is the suffix length.  'spanr', applied to a
+-- predicate @p@ and a sequence @xs@, returns a pair whose /first/ element
+-- is the longest /suffix/ (possibly empty) of @xs@ of elements that
+-- satisfy @p@ and the second element is the remainder of the sequence.
+spanr :: (a -> Bool) -> Seq a -> (Seq a, Seq a)
+spanr p = breakr (not . p)
+
+{-# INLINE breakl #-}
+-- | /O(i)/ where /i/ is the breakpoint index.  'breakl', applied to a
+-- predicate @p@ and a sequence @xs@, returns a pair whose first element
+-- is the longest prefix (possibly empty) of @xs@ of elements that
+-- /do not satisfy/ @p@ and the second element is the remainder of
+-- the sequence.
+--
+-- @'breakl' p@ is equivalent to @'spanl' (not . p)@.
+breakl :: (a -> Bool) -> Seq a -> (Seq a, Seq a)
+breakl p xs = foldr (\ i _ -> splitAt i xs) (xs, empty) (findIndicesL p xs)
+
+{-# INLINE breakr #-}
+-- | @'breakr' p@ is equivalent to @'spanr' (not . p)@.
+breakr :: (a -> Bool) -> Seq a -> (Seq a, Seq a)
+breakr p xs = foldr (\ i _ -> flipPair (splitAt i xs)) (xs, empty) (findIndicesR p xs)
+  where flipPair (x, y) = (y, x)
+
+-- | /O(n)/.  The 'partition' function takes a predicate @p@ and a
+-- sequence @xs@ and returns sequences of those elements which do and
+-- do not satisfy the predicate.
+partition :: (a -> Bool) -> Seq a -> (Seq a, Seq a)
+partition p = foldl part (empty, empty)
+  where part (xs, ys) x
+	  | p x		= (xs |> x, ys)
+	  | otherwise 	= (xs, ys |> x)
+
+-- | /O(n)/.  The 'filter' function takes a predicate @p@ and a sequence
+-- @xs@ and returns a sequence of those elements which satisfy the
+-- predicate.
+filter :: (a -> Bool) -> Seq a -> Seq a
+filter p = foldl (\ xs x -> if p x then xs |> x else xs) empty
+
+-- Indexing sequences
+
+-- | 'elemIndexL' finds the leftmost index of the specified element,
+-- if it is present, and otherwise 'Nothing'.
+elemIndexL :: Eq a => a -> Seq a -> Maybe Int
+elemIndexL x = findIndexL (x ==)
+
+-- | 'elemIndexR' finds the rightmost index of the specified element,
+-- if it is present, and otherwise 'Nothing'.
+elemIndexR :: Eq a => a -> Seq a -> Maybe Int
+elemIndexR x = findIndexR (x ==)
+
+-- | 'elemIndicesL' finds the indices of the specified element, from
+-- left to right (i.e. in ascending order).
+elemIndicesL :: Eq a => a -> Seq a -> [Int]
+elemIndicesL x = findIndicesL (x ==)
+
+-- | 'elemIndicesR' finds the indices of the specified element, from
+-- right to left (i.e. in descending order).
+elemIndicesR :: Eq a => a -> Seq a -> [Int]
+elemIndicesR x = findIndicesR (x ==)
+
+-- | @'findIndexL' p xs@ finds the index of the leftmost element that
+-- satisfies @p@, if any exist.
+findIndexL :: (a -> Bool) -> Seq a -> Maybe Int
+findIndexL p = listToMaybe' . findIndicesL p
+
+-- | @'findIndexR' p xs@ finds the index of the rightmost element that
+-- satisfies @p@, if any exist.
+findIndexR :: (a -> Bool) -> Seq a -> Maybe Int
+findIndexR p = listToMaybe' . findIndicesR p
+
+{-# INLINE findIndicesL #-}
+-- | @'findIndicesL' p@ finds all indices of elements that satisfy @p@,
+-- in ascending order.
+findIndicesL :: (a -> Bool) -> Seq a -> [Int]
+#if __GLASGOW_HASKELL__
+findIndicesL p xs = build (\ c n -> let g i x z = if p x then c i z else z in
+				foldrWithIndex g n xs)
+#else
+findIndicesL p xs = foldrWithIndex g [] xs where
+g i x is = if p x then i:is else is
+#endif
+
+{-# INLINE findIndicesR #-}
+-- | @'findIndicesR' p@ finds all indices of elements that satisfy @p@,
+-- in descending order.
+findIndicesR :: (a -> Bool) -> Seq a -> [Int]
+#if __GLASGOW_HASKELL__
+findIndicesR p xs = build (\ c n -> let g z i x = if p x then c i z else z in
+				foldlWithIndex g n xs)
+#else
+findIndicesR p xs = foldlWithIndex g [] xs where
+g is i x = if p x then i:is else is
+#endif
+
 ------------------------------------------------------------------------
 -- Lists
 ------------------------------------------------------------------------
@@ -1049,6 +1542,7 @@
 		(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)
@@ -1059,19 +1553,216 @@
 reverseNode f (Node2 s a b) = Node2 s (f b) (f a)
 reverseNode f (Node3 s a b c) = Node3 s (f c) (f b) (f a)
 
+------------------------------------------------------------------------
+-- Zipping
+------------------------------------------------------------------------
+
+-- | /O(min(n1,n2))/.  'zip' takes two sequences and returns a sequence
+-- of corresponding pairs.  If one input is short, excess elements are
+-- discarded from the right end of the longer sequence.
+zip :: Seq a -> Seq b -> Seq (a, b)
+zip = zipWith (,)
+
+-- | /O(min(n1,n2))/.  'zipWith' generalizes 'zip' by zipping with the
+-- function given as the first argument, instead of a tupling function.
+-- For example, @zipWith (+)@ is applied to two sequences to take the
+-- sequence of corresponding sums.
+zipWith :: (a -> b -> c) -> Seq a -> Seq b -> Seq c
+zipWith f xs ys
+  | length xs <= length ys	= zipWith' f xs ys
+  | otherwise			= zipWith' (flip f) ys xs
+
+-- like 'zipWith', but assumes length xs <= length ys
+zipWith' :: (a -> b -> c) -> Seq a -> Seq b -> Seq c
+zipWith' f xs ys = snd (mapAccumL ((\ (z :< zs) x -> (zs, f x z)) . viewl) ys xs)
+
+-- | /O(min(n1,n2,n3))/.  'zip3' takes three sequences and returns a
+-- sequence of triples, analogous to 'zip'.
+zip3 :: Seq a -> Seq b -> Seq c -> Seq (a,b,c)
+zip3 = zipWith3 (,,)
+
+-- | /O(min(n1,n2,n3))/.  'zipWith3' takes a function which combines
+-- three elements, as well as three sequences and returns a sequence of
+-- their point-wise combinations, analogous to 'zipWith'.
+zipWith3 :: (a -> b -> c -> d) -> Seq a -> Seq b -> Seq c -> Seq d
+zipWith3 f s1 s2 s3 = zipWith ($) (zipWith f s1 s2) s3
+
+-- | /O(min(n1,n2,n3,n4))/.  'zip4' takes four sequences and returns a
+-- sequence of quadruples, analogous to 'zip'.
+zip4 :: Seq a -> Seq b -> Seq c -> Seq d -> Seq (a,b,c,d)
+zip4 = zipWith4 (,,,)
+
+-- | /O(min(n1,n2,n3,n4))/.  'zipWith4' takes a function which combines
+-- four elements, as well as four sequences and returns a sequence of
+-- their point-wise combinations, analogous to 'zipWith'.
+zipWith4 :: (a -> b -> c -> d -> e) -> Seq a -> Seq b -> Seq c -> Seq d -> Seq e
+zipWith4 f s1 s2 s3 s4 = zipWith ($) (zipWith ($) (zipWith f s1 s2) s3) s4
+
+------------------------------------------------------------------------
+-- Sorting
+--
+-- sort and sortBy are implemented by simple deforestations of
+-- 	\ xs -> fromList2 (length xs) . Data.List.sortBy cmp . toList
+-- which does not get deforested automatically, it would appear.
+--
+-- Unstable sorting is performed by a heap sort implementation based on
+-- pairing heaps.  Because the internal structure of sequences is quite
+-- varied, it is difficult to get blocks of elements of roughly the same
+-- length, which would improve merge sort performance.  Pairing heaps,
+-- on the other hand, are relatively resistant to the effects of merging
+-- heaps of wildly different sizes, as guaranteed by its amortized
+-- constant-time merge operation.  Moreover, extensive use of SpecConstr
+-- transformations can be done on pairing heaps, especially when we're
+-- only constructing them to immediately be unrolled.
+--
+-- On purely random sequences of length 50000, with no RTS options,
+-- I get the following statistics, in which heapsort is about 42.5%
+-- faster:  (all comparisons done with -O2)
+--
+-- Times (ms)            min      mean    +/-sd    median    max
+-- to/from list:       103.802  108.572    7.487  106.436  143.339
+-- unstable heapsort:   60.686   62.968    4.275   61.187   79.151
+--
+-- Heapsort, it would seem, is less of a memory hog than Data.List.sortBy.
+-- The gap is narrowed when more memory is available, but heapsort still
+-- wins, 15% faster, with +RTS -H128m:
+--
+-- Times (ms)            min    mean    +/-sd  median    max
+-- to/from list:       42.692  45.074   2.596  44.600  56.601
+-- unstable heapsort:  37.100  38.344   3.043  37.715  55.526
+--
+-- In addition, on strictly increasing sequences the gap is even wider
+-- than normal; heapsort is 68.5% faster with no RTS options:
+-- Times (ms)            min    mean    +/-sd  median    max
+-- to/from list:       52.236  53.574   1.987  53.034  62.098
+-- unstable heapsort:  16.433  16.919   0.931  16.681  21.622
+--
+-- This may be attributed to the elegant nature of the pairing heap.
+--
+-- wasserman.louis@gmail.com, 7/20/09
+------------------------------------------------------------------------
+
+-- | /O(n log n)/.  'sort' sorts the specified 'Seq' by the natural
+-- ordering of its elements.  The sort is stable.
+-- If stability is not required, 'unstableSort' can be considerably
+-- faster, and in particular uses less memory.
+sort :: Ord a => Seq a -> Seq a
+sort = sortBy compare
+
+-- | /O(n log n)/.  'sortBy' sorts the specified 'Seq' according to the
+-- specified comparator.  The sort is stable.
+-- If stability is not required, 'unstableSortBy' can be considerably
+-- faster, and in particular uses less memory.
+sortBy :: (a -> a -> Ordering) -> Seq a -> Seq a
+sortBy cmp xs = fromList2 (length xs) (Data.List.sortBy cmp (toList xs))
+
+-- | /O(n log n)/.  'unstableSort' sorts the specified 'Seq' by
+-- the natural ordering of its elements, but the sort is not stable.
+-- This algorithm is frequently faster and uses less memory than 'sort',
+-- and performs extremely well -- frequently twice as fast as 'sort' --
+-- when the sequence is already nearly sorted.
+unstableSort :: Ord a => Seq a -> Seq a
+unstableSort = unstableSortBy compare
+
+-- | /O(n log n)/.  A generalization of 'unstableSort', 'unstableSortBy'
+-- takes an arbitrary comparator and sorts the specified sequence.
+-- The sort is not stable.  This algorithm is frequently faster and
+-- uses less memory than 'sortBy', and performs extremely well --
+-- frequently twice as fast as 'sortBy' -- when the sequence is already
+-- nearly sorted.
+unstableSortBy :: (a -> a -> Ordering) -> Seq a -> Seq a
+unstableSortBy cmp (Seq xs) =
+	fromList2 (size xs) $ maybe [] (unrollPQ cmp) $
+		toPQ cmp (\ (Elem x) -> PQueue x Nil) xs
+
+-- | fromList2, given a list and its length, constructs a completely
+-- balanced Seq whose elements are that list using the applicativeTree
+-- generalization.
+fromList2 :: Int -> [a] -> Seq a
+fromList2 n = execState (replicateA n (State (\ (x:xs) -> (xs, x))))
+
+-- | A 'PQueue' is a simple pairing heap.
+data PQueue e = PQueue e (PQL e)
+data PQL e = Nil | {-# UNPACK #-} !(PQueue e) :& PQL e
+
+infixr 8 :&
+
 #if TESTING
 
+instance Functor PQueue where
+	fmap f (PQueue x ts) = PQueue (f x) (fmap f ts)
+
+instance Functor PQL where
+	fmap f (q :& qs) = fmap f q :& fmap f qs
+	fmap _ Nil = Nil
+
+instance Show e => Show (PQueue e) where
+	show = unlines . draw . fmap show
+
+-- borrowed wholesale from Data.Tree, as Data.Tree actually depends
+-- on Data.Sequence
+draw :: PQueue String -> [String]
+draw (PQueue x ts0) = x : drawSubTrees ts0
+  where drawSubTrees Nil = []
+	drawSubTrees (t :& Nil) =
+		"|" : shift "`- " "   " (draw t)
+	drawSubTrees (t :& ts) =
+		"|" : shift "+- " "|  " (draw t) ++ drawSubTrees ts
+
+	shift first other = Data.List.zipWith (++) (first : repeat other)
+#endif
+
+-- | 'unrollPQ', given a comparator function, unrolls a 'PQueue' into
+-- a sorted list.
+unrollPQ :: (e -> e -> Ordering) -> PQueue e -> [e]
+unrollPQ cmp = unrollPQ'
+  where
+	{-# INLINE unrollPQ' #-}
+	unrollPQ' (PQueue x ts) = x:mergePQs0 ts
+	(<>) = mergePQ cmp
+	mergePQs0 Nil = []
+	mergePQs0 (t :& Nil) = unrollPQ' t
+	mergePQs0 (t1 :& t2 :& ts) = mergePQs (t1 <> t2) ts
+	mergePQs t ts = t `seq` case ts of
+		Nil		-> unrollPQ' t
+		t1 :& Nil	-> unrollPQ' (t <> t1)
+		t1 :& t2 :& ts'	-> mergePQs (t <> (t1 <> t2)) ts'
+
+-- | 'toPQ', given an ordering function and a mechanism for queueifying
+-- elements, converts a 'FingerTree' to a 'PQueue'.
+toPQ :: (e -> e -> Ordering) -> (a -> PQueue e) -> FingerTree a -> Maybe (PQueue e)
+toPQ _ _ Empty = Nothing
+toPQ _ f (Single x) = Just (f x)
+toPQ cmp f (Deep _ pr m sf) = Just (maybe (pr' <> sf') ((pr' <> sf') <>) (toPQ cmp fNode m))
+  where
+	fDigit digit = case fmap f digit of
+		One a		-> a
+		Two a b		-> a <> b
+		Three a b c	-> a <> b <> c
+		Four a b c d	-> (a <> b) <> (c <> d)
+	(<>) = mergePQ cmp
+	fNode = fDigit . nodeToDigit
+	pr' = fDigit pr
+	sf' = fDigit sf
+
+-- | 'mergePQ' merges two 'PQueue's.
+mergePQ :: (a -> a -> Ordering) -> PQueue a -> PQueue a -> PQueue a
+mergePQ cmp q1@(PQueue x1 ts1) q2@(PQueue x2 ts2)
+  | cmp x1 x2 == GT	= PQueue x2 (q1 :& ts2)
+  | otherwise		= PQueue x1 (q2 :& ts1)
+
+#if TESTING
+
 ------------------------------------------------------------------------
 -- QuickCheck
 ------------------------------------------------------------------------
 
 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
-	coarbitrary (Elem x) = coarbitrary x
 
 instance (Arbitrary a, Sized a) => Arbitrary (FingerTree a) where
 	arbitrary = sized arb
@@ -1080,33 +1771,39 @@
 		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 x) = map Single (shrink x)
+	shrink Empty = []
 
 instance (Arbitrary a, Sized a) => Arbitrary (Node a) where
 	arbitrary = oneof [
-			liftM2 node2 arbitrary arbitrary,
-			liftM3 node3 arbitrary arbitrary arbitrary]
+		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 [
-			liftM One arbitrary,
-			liftM2 Two arbitrary arbitrary,
-			liftM3 Three arbitrary arbitrary arbitrary,
-			liftM4 Four arbitrary arbitrary arbitrary arbitrary]
+		liftM One arbitrary,
+		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
@@ -1128,14 +1825,9 @@
 		s == size pr + size m + size sf && valid pr && valid m && valid sf
 
 instance (Sized a, Valid a) => Valid (Node a) where
-	valid (Node2 s a b) = s == size a + size b && valid a && valid b
-	valid (Node3 s a b c) =
-		s == size a + size b + size c && valid a && valid b && valid c
+	valid node = size node == sum (fmap size node) && all valid node
 
 instance Valid a => Valid (Digit a) where
-	valid (One a) = valid a
-	valid (Two a b) = valid a && valid b
-	valid (Three a b c) = valid a && valid b && valid c
-	valid (Four a b c d) = valid a && valid b && valid c && valid d
+	valid = all valid
 
 #endif
diff --git a/Data/Set.hs b/Data/Set.hs
--- a/Data/Set.hs
+++ b/Data/Set.hs
@@ -1,3 +1,4 @@
+{-# OPTIONS -cpp #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  Data.Set
@@ -118,7 +119,7 @@
 
 #if __GLASGOW_HASKELL__
 import Text.Read
-import Data.Data (Data(..), mkNorepType, gcast1)
+import Data.Data (Data(..), mkNoRepType, gcast1)
 #endif
 
 {--------------------------------------------------------------------
@@ -161,7 +162,7 @@
   gfoldl f z set = z fromList `f` (toList set)
   toConstr _     = error "toConstr"
   gunfold _ _    = error "gunfold"
-  dataTypeOf _   = mkNorepType "Data.Set.Set"
+  dataTypeOf _   = mkNoRepType "Data.Set.Set"
   dataCast1 f    = gcast1 f
 
 #endif
diff --git a/containers.cabal b/containers.cabal
--- a/containers.cabal
+++ b/containers.cabal
@@ -1,8 +1,9 @@
 name:       containers
-version:    0.2.0.1
+version:    0.3.0.0
 license:    BSD3
 license-file:    LICENSE
 maintainer:    libraries@haskell.org
+bug-reports: http://hackage.haskell.org/trac/ghc/newticket?component=libraries%20%28other%29
 synopsis:   Assorted concrete container types
 category:   Data Structures
 description:
@@ -11,11 +12,15 @@
         each operation is either worst-case or amortized, but remains
         valid even if structures are shared.
 build-type: Simple
-cabal-version:  >=1.2
+cabal-version:  >=1.6
 extra-source-files: include/Typeable.h
 
+source-repository head
+    type:     darcs
+    location: http://darcs.haskell.org/packages/containers/
+
 Library {
-    build-depends: base, array
+    build-depends: base >= 4.2 && < 6, array
     exposed-modules:
         Data.Graph
         Data.IntMap