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

File new-methods-for-data_sequence.6.dpatch, 48.7 KB (added by LouisWasserman, 6 years ago)

Reduced usage of partial pattern matches, and standardization of the XXXL/XXXR methods. New methods: foldWithIndexL, foldWithIndexR.

Line 
1Fri Aug 21 00:46:25 EDT 2009  [email protected]
2  * Ticket #3271: New methods for Data.Sequence
3
4New patches:
5
6[Ticket #3271: New methods for Data.Sequence
7[email protected]**20090821044625
8 Ignore-this: f92f642d4fd04bd7a03bb5b5c20b39f6
9] {
10hunk ./Data/IntMap.hs 185
11 
12 #if __GLASGOW_HASKELL__
13 import Text.Read
14-import Data.Data (Data(..), mkNoRepType)
15+import Data.Data (Data(..), mkNorepType)
16 #endif
17 
18 #if __GLASGOW_HASKELL__ >= 503
19hunk ./Data/IntMap.hs 276
20   gfoldl f z im = z fromList `f` (toList im)
21   toConstr _    = error "toConstr"
22   gunfold _ _   = error "gunfold"
23-  dataTypeOf _  = mkNoRepType "Data.IntMap.IntMap"
24+  dataTypeOf _  = mkNorepType "Data.IntMap.IntMap"
25   dataCast1 f   = gcast1 f
26 
27 #endif
28hunk ./Data/IntSet.hs 122
29 
30 #if __GLASGOW_HASKELL__
31 import Text.Read
32-import Data.Data (Data(..), mkNoRepType)
33+import Data.Data (Data(..), mkNorepType)
34 #endif
35 
36 #if __GLASGOW_HASKELL__ >= 503
37hunk ./Data/IntSet.hs 200
38   gfoldl f z is = z fromList `f` (toList is)
39   toConstr _    = error "toConstr"
40   gunfold _ _   = error "gunfold"
41-  dataTypeOf _  = mkNoRepType "Data.IntSet.IntSet"
42+  dataTypeOf _  = mkNorepType "Data.IntSet.IntSet"
43 
44 #endif
45 
46hunk ./Data/Map.hs 200
47 
48 #if __GLASGOW_HASKELL__
49 import Text.Read
50-import Data.Data (Data(..), mkNoRepType, gcast2)
51+import Data.Data (Data(..), mkNorepType, gcast2)
52 #endif
53 
54 {--------------------------------------------------------------------
55hunk ./Data/Map.hs 248
56   gfoldl f z m   = z fromList `f` toList m
57   toConstr _     = error "toConstr"
58   gunfold _ _    = error "gunfold"
59-  dataTypeOf _   = mkNoRepType "Data.Map.Map"
60+  dataTypeOf _   = mkNorepType "Data.Map.Map"
61   dataCast2 f    = gcast2 f
62 
63 #endif
64hunk ./Data/Sequence.hs 6
65 -- |
66 -- Module      :  Data.Sequence
67 -- Copyright   :  (c) Ross Paterson 2005
68+--                (c) Louis Wasserman 2009
69 -- License     :  BSD-style
70 -- Maintainer  :  [email protected]
71 -- Stability   :  experimental
72hunk ./Data/Sequence.hs 40
73        -- * Construction
74        empty,          -- :: Seq a
75        singleton,      -- :: a -> Seq a
76+       replicate,      -- :: Int -> a -> Seq a
77+       replicateA,     -- :: Applicative f => Int -> f a -> f (Seq a)
78+       replicateM,     -- :: Monad m => Int -> m a -> m (Seq a)
79        (<|),           -- :: a -> Seq a -> Seq a
80        (|>),           -- :: Seq a -> a -> Seq a
81        (><),           -- :: Seq a -> Seq a -> Seq a
82hunk ./Data/Sequence.hs 47
83        fromList,       -- :: [a] -> Seq a
84+       -- ** Sequential construction
85+       iterateN,       -- :: Int -> (a -> a) -> a -> Seq a
86+       unfoldr,        -- :: (b -> Maybe (a, b)) -> b -> Seq a
87+       unfoldl,        -- :: (b -> Maybe (b, a)) -> b -> Seq a
88        -- * Deconstruction
89        -- | Additional functions for deconstructing sequences are available
90        -- via the 'Foldable' instance of 'Seq'.
91hunk ./Data/Sequence.hs 63
92        viewl,          -- :: Seq a -> ViewL a
93        ViewR(..),
94        viewr,          -- :: Seq a -> ViewR a
95-       -- ** Indexing
96+       -- * Scanning
97+       scanl,          -- :: (a -> b -> a) -> a -> Seq b -> Seq a
98+       scanl1,         -- :: (a -> a -> a) -> Seq a -> Seq a
99+       scanr,          -- :: (a -> b -> b) -> b -> Seq a -> Seq b
100+       scanr1,         -- :: (a -> a -> a) -> Seq a -> Seq a
101+       -- * Sublists
102+       tails,          -- :: Seq a -> Seq (Seq a)
103+       inits,          -- :: Seq a -> Seq (Seq a)
104+       takeWhileL,     -- :: (a -> Bool) -> Seq a -> Seq a
105+       takeWhileR,     -- :: (a -> Bool) -> Seq a -> Seq a
106+       dropWhileL,     -- :: (a -> Bool) -> Seq a -> Seq a
107+       dropWhileR,     -- :: (a -> Bool) -> Seq a -> Seq a
108+       spanl,          -- :: (a -> Bool) -> Seq a -> (Seq a, Seq a)
109+       spanr,  -- :: (a -> Bool) -> Seq a -> (Seq a, Seq a)
110+       breakl,         -- :: (a -> Bool) -> Seq a -> (Seq a, Seq a)
111+       breakr,         -- :: (a -> Bool) -> Seq a -> (Seq a, Seq a)
112+       partition,      -- :: (a -> Bool) -> Seq a -> (Seq a, Seq a)
113+       filter,         -- :: (a -> Bool) -> Seq a -> Seq a
114+       -- * Sorts
115+       sort,           -- :: Ord a => Seq a -> Seq a
116+       sortBy,         -- :: (a -> a -> Ordering) -> Seq a -> Seq a
117+       unstableSort,   -- :: Ord a => Seq a -> Seq a
118+       unstableSortBy, -- :: (a -> a -> Ordering) -> Seq a -> Seq a
119+       -- * Indexing
120        index,          -- :: Seq a -> Int -> a
121        adjust,         -- :: (a -> a) -> Int -> Seq a -> Seq a
122        update,         -- :: Int -> a -> Seq a -> Seq a
123hunk ./Data/Sequence.hs 93
124        take,           -- :: Int -> Seq a -> Seq a
125        drop,           -- :: Int -> Seq a -> Seq a
126        splitAt,        -- :: Int -> Seq a -> (Seq a, Seq a)
127+       -- ** Indexing with predicates
128+       elemIndexL,     -- :: Eq a => a -> Seq a -> Maybe Int
129+       elemIndicesL,   -- :: Eq a => a -> Seq a -> [Int]
130+       elemIndexR,     -- :: Eq a => a -> Seq a -> Maybe Ind
131+       elemIndicesR,-- :: Eq a => a -> Seq a -> [Int]
132+       findIndexL,     -- :: (a -> Bool) -> Seq a -> Maybe Int
133+       findIndicesL,   -- :: (a -> Bool) -> Seq a -> [Int]
134+       findIndexR,     -- :: (a -> Bool) -> Seq a -> Maybe Int
135+       findIndicesR,   -- :: (a -> Bool) -> Seq a -> [Int]
136+       -- * Folds
137+       foldWithIndexL, -- :: (b -> Int -> a -> b) -> b -> Seq a -> b
138+       foldWithIndexR, -- :: (Int -> a -> b -> b) -> b -> Seq a -> b
139        -- * Transformations
140hunk ./Data/Sequence.hs 106
141+       mapWithIndex,   -- :: (Int -> a -> b) -> Seq a -> Seq b
142        reverse,        -- :: Seq a -> Seq a
143hunk ./Data/Sequence.hs 108
144+       -- ** Zips
145+       zip,            -- :: Seq a -> Seq b -> Seq (a, b)
146+       zipWith,        -- :: (a -> b -> c) -> Seq a -> Seq b -> Seq c
147+       zip3,           -- :: Seq a -> Seq b -> Seq c -> Seq (a, b, c)
148+       zipWith3,       -- :: (a -> b -> c -> d) -> Seq a -> Seq b -> Seq c -> Seq d
149+       zip4,           -- :: Seq a -> Seq b -> Seq c -> Seq d -> Seq (a, b, c, d)
150+       zipWith4,       -- :: (a -> b -> c -> d -> e) -> Seq a -> Seq b -> Seq c -> Seq d -> Seq e
151 #if TESTING
152        valid,
153 #endif
154hunk ./Data/Sequence.hs 121
155        ) where
156 
157 import Prelude hiding (
158-       null, length, take, drop, splitAt, foldl, foldl1, foldr, foldr1,
159-       reverse)
160-import qualified Data.List (foldl')
161-import Control.Applicative (Applicative(..), (<$>))
162-import Control.Monad (MonadPlus(..))
163+       null, length, take, drop, splitAt, foldl, foldl1, foldr, foldr1, span,
164+       scanl, scanl1, scanr, scanr1, replicate, zip, zipWith, zip3, zipWith3,
165+       takeWhile, dropWhile, break, iterate, reverse, filter, mapM, all)
166+import qualified Data.List (foldl', zipWith)
167+import Control.Applicative (Applicative(..), (<$>), WrappedMonad(..), liftA, liftA2, liftA3)
168+import Control.Monad (MonadPlus(..), ap, liftM, liftM2, liftM3, liftM4)
169+import qualified Control.Monad
170 import Data.Monoid (Monoid(..))
171 import Data.Foldable
172 import Data.Traversable
173hunk ./Data/Sequence.hs 137
174 import Data.Typeable (TyCon, Typeable1(..), mkTyCon, mkTyConApp )
175 
176 #ifdef __GLASGOW_HASKELL__
177+import GHC.Exts (build)
178 import Text.Read (Lexeme(Ident), lexP, parens, prec,
179        readPrec, readListPrec, readListPrecDefault)
180 import Data.Data (Data(..), DataType, Constr, Fixity(..),
181hunk ./Data/Sequence.hs 145
182 #endif
183 
184 #if TESTING
185-import Control.Monad (liftM, liftM3, liftM4)
186-import Test.QuickCheck
187+import Test.QuickCheck hiding ((><))
188 #endif
189 
190 infixr 5 `consTree`
191hunk ./Data/Sequence.hs 302
192                        traverse f sf
193 
194 {-# INLINE deep #-}
195-{-# SPECIALIZE deep :: Digit (Elem a) -> FingerTree (Node (Elem a)) -> Digit (Elem a) -> FingerTree (Elem a) #-}
196-{-# SPECIALIZE deep :: Digit (Node a) -> FingerTree (Node (Node a)) -> Digit (Node a) -> FingerTree (Node a) #-}
197+{-# SPECIALIZE INLINE deep :: Digit (Elem a) -> FingerTree (Node (Elem a)) -> Digit (Elem a) -> FingerTree (Elem a) #-}
198+{-# SPECIALIZE INLINE deep :: Digit (Node a) -> FingerTree (Node (Node a)) -> Digit (Node a) -> FingerTree (Node a) #-}
199 deep           :: Sized a => Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
200 deep pr m sf   =  Deep (size pr + size m + size sf) pr m sf
201 
202hunk ./Data/Sequence.hs 307
203+{-# INLINE pullL #-}
204+pullL :: Sized a => Int -> FingerTree (Node a) -> Digit a -> FingerTree a
205+pullL s m sf = case viewLTree m of
206+       Nothing2        -> digitToTree' s sf
207+       Just2 pr m'     -> Deep s (nodeToDigit pr) m' sf
208+
209+{-# INLINE pullR #-}
210+pullR :: Sized a => Int -> Digit a -> FingerTree (Node a) -> FingerTree a
211+pullR s pr m = case viewRTree m of
212+       Nothing2        -> digitToTree' s pr
213+       Just2 m' sf     -> Deep s pr m' (nodeToDigit sf)
214+
215+{-# SPECIALIZE deepL :: Maybe (Digit (Elem a)) -> FingerTree (Node (Elem a)) -> Digit (Elem a) -> FingerTree (Elem a) #-}
216+{-# SPECIALIZE deepL :: Maybe (Digit (Node a)) -> FingerTree (Node (Node a)) -> Digit (Node a) -> FingerTree (Node a) #-}
217+deepL :: Sized a => Maybe (Digit a) -> FingerTree (Node a) -> Digit a -> FingerTree a
218+deepL Nothing m sf     = pullL (size m + size sf) m sf
219+deepL (Just pr) m sf   = deep pr m sf
220+
221+{-# SPECIALIZE deepR :: Digit (Elem a) -> FingerTree (Node (Elem a)) -> Maybe (Digit (Elem a)) -> FingerTree (Elem a) #-}
222+{-# SPECIALIZE deepR :: Digit (Node a) -> FingerTree (Node (Node a)) -> Maybe (Digit (Node a)) -> FingerTree (Node a) #-}
223+deepR :: Sized a => Digit a -> FingerTree (Node a) -> Maybe (Digit a) -> FingerTree a
224+deepR pr m Nothing     = pullR (size m + size pr) pr m
225+deepR pr m (Just sf)   = deep pr m sf
226+
227 -- Digits
228 
229 data Digit a
230hunk ./Data/Sequence.hs 367
231        fmap = fmapDefault
232 
233 instance Traversable Digit where
234+       {-# INLINE traverse #-}
235        traverse f (One a) = One <$> f a
236        traverse f (Two a b) = Two <$> f a <*> f b
237        traverse f (Three a b c) = Three <$> f a <*> f b <*> f c
238hunk ./Data/Sequence.hs 374
239        traverse f (Four a b c d) = Four <$> f a <*> f b <*> f c <*> f d
240 
241 instance Sized a => Sized (Digit a) where
242-       {-# SPECIALIZE instance Sized (Digit (Elem a)) #-}
243-       {-# SPECIALIZE instance Sized (Digit (Node a)) #-}
244-       size xs = foldl (\ i x -> i + size x) 0 xs
245+       {-# INLINE size #-}
246+       size = foldl1 (+) . fmap size
247 
248 {-# SPECIALIZE digitToTree :: Digit (Elem a) -> FingerTree (Elem a) #-}
249 {-# SPECIALIZE digitToTree :: Digit (Node a) -> FingerTree (Node a) #-}
250hunk ./Data/Sequence.hs 385
251 digitToTree (Three a b c) = deep (Two a b) Empty (One c)
252 digitToTree (Four a b c d) = deep (Two a b) Empty (Two c d)
253 
254+-- | Given the size of a digit and the digit itself, efficiently converts it to a FingerTree.
255+digitToTree' :: Int -> Digit a -> FingerTree a
256+digitToTree' n (Four a b c d) = Deep n (Two a b) Empty (Two c d)
257+digitToTree' n (Three a b c) = Deep n (Two a b) Empty (One c)
258+digitToTree' n (Two a b) = Deep n (One a) Empty (One b)
259+digitToTree' n (One a) = n `seq` Single a
260+
261+
262+
263 -- Nodes
264 
265 data Node a
266hunk ./Data/Sequence.hs 411
267        foldl f z (Node3 _ a b c) = ((z `f` a) `f` b) `f` c
268 
269 instance Functor Node where
270+       {-# INLINE fmap #-}
271        fmap = fmapDefault
272 
273 instance Traversable Node where
274hunk ./Data/Sequence.hs 415
275+       {-# INLINE traverse #-}
276        traverse f (Node2 v a b) = Node2 v <$> f a <*> f b
277        traverse f (Node3 v a b c) = Node3 v <$> f a <*> f b <*> f c
278 
279hunk ./Data/Sequence.hs 461
280        showsPrec p (Elem x) = showsPrec p x
281 #endif
282 
283+-------------------------------------------------------
284+-- Applicative construction
285+-------------------------------------------------------
286+
287+newtype Id a = Id {runId :: a}
288+
289+instance Functor Id where
290+       fmap f (Id x) = Id (f x)
291+
292+instance Monad Id where
293+       return = Id
294+       m >>= k = k (runId m)
295+
296+instance Applicative Id where
297+       pure = return
298+       (<*>) = ap
299+
300+-- | This is essentially a clone of Control.Monad.State.Strict.
301+newtype State s a = State {runState :: s -> (s, a)}
302+
303+instance Functor (State s) where
304+       fmap = liftA
305+
306+instance Monad (State s) where
307+       {-# INLINE return #-}
308+       {-# INLINE (>>=) #-}
309+       return x = State $ \ s -> (s, x)
310+       m >>= k = State $ \ s -> case runState m s of
311+               (s', x) -> runState (k x) s'
312+
313+instance Applicative (State s) where
314+       pure = return
315+       (<*>) = ap
316+
317+execState :: State s a -> s -> a
318+execState m x = snd (runState m x)
319+
320+-- | A helper method: a strict version of mapAccumL.
321+mapAccumL' :: Traversable t => (a -> b -> (a, c)) -> a -> t b -> (a, t c)
322+mapAccumL' f s t = runState (traverse (State . flip f) t) s
323+
324+-- | 'applicativeTree' takes an Applicative-wrapped construction of a piece of a FingerTree, assumed
325+-- to always have the same size (which is put in the second argument), and replicates it as many times
326+-- as specified.  This is a generalization of 'replicateA', which itself is a generalization of many
327+-- Data.Sequence methods.
328+{-# SPECIALIZE applicativeTree :: Int -> Int -> State s a -> State s (FingerTree a) #-}
329+{-# SPECIALIZE applicativeTree :: Int -> Int -> Id a -> Id (FingerTree a) #-}
330+       -- Special note: the Id specialization automatically does node sharing, reducing memory usage of the
331+       -- resulting tree to /O(log n)/.
332+applicativeTree :: Applicative f => Int -> Int -> f a -> f (FingerTree a)
333+applicativeTree n mSize m = mSize `seq` case n of
334+       0       -> pure Empty
335+       1       -> liftA Single m
336+       2       -> deepA one empty one
337+       3       -> deepA two empty one
338+       4       -> deepA two empty two
339+       5       -> deepA three empty two
340+       6       -> deepA three empty three
341+       7       -> deepA four empty three
342+       8       -> deepA four empty four
343+       _       -> let (q, r) = n `quotRem` 3 in q `seq` case r of
344+               0       -> deepA three (applicativeTree (q - 2) mSize' n3) three
345+               1       -> deepA four (applicativeTree (q - 2) mSize' n3) three
346+               _       -> deepA four (applicativeTree (q - 2) mSize' n3) four
347+       where   one = liftA One m
348+               two = liftA2 Two m m
349+               three = liftA3 Three m m m
350+               four = liftA3 Four m m m <*> m
351+               deepA = liftA3 (Deep (n * mSize))
352+               mSize' = 3 * mSize
353+               n3 = liftA3 (Node3 mSize') m m m
354+               empty = pure Empty
355+
356 ------------------------------------------------------------------------
357 -- Construction
358 ------------------------------------------------------------------------
359hunk ./Data/Sequence.hs 546
360 singleton      :: a -> Seq a
361 singleton x    =  Seq (Single (Elem x))
362 
363+-- | /O(log n)/. @replicate n x@ is a sequence of length @n@ with @x@ the value of every element.
364+replicate      :: Int -> a -> Seq a
365+replicate n x
366+       | n < 0         = error "replicate takes a nonnegative integer argument"
367+       | otherwise     = runId (replicateA n (Id x))
368+
369+-- | 'replicateA' is an 'Applicative' version of 'replicate', and makes /O(log n)/ calls to '<*>' and 'pure'.  @'replicateA' n x@ is equivalent to @'sequenceA' ('replicate' n x)@. 
370+replicateA :: Applicative f => Int -> f a -> f (Seq a)
371+replicateA n x
372+       | n < 0         = error "replicateA takes a nonnegative integer argument"
373+       | otherwise     = Seq <$> applicativeTree n 1 (Elem <$> x)
374+
375+-- | 'replicateM' is a generalization of 'Control.Monad.replicateM'.
376+replicateM :: Monad m => Int -> m a -> m (Seq a)
377+replicateM n x
378+       | n < 0         = error "replicateM takes a nonnegative integer argument"
379+       | otherwise     = unwrapMonad (replicateA n (WrapMonad x))
380+
381 -- | /O(1)/. Add an element to the left end of a sequence.
382 -- Mnemonic: a triangle with the single element at the pointy end.
383 (<|)           :: a -> Seq a -> Seq a
384hunk ./Data/Sequence.hs 838
385 addDigits4 m1 (Four a b c d) e f g h (Four i j k l) m2 =
386        appendTree4 m1 (node3 a b c) (node3 d e f) (node3 g h i) (node3 j k l) m2
387 
388+-- | 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./
389+unfoldr :: (b -> Maybe (a, b)) -> b -> Seq a
390+unfoldr f b = unfoldr' empty b where
391+       -- uses tail recursion rather than, for instance, the List implementation.
392+       unfoldr' as b = maybe as (\ (a, b') -> unfoldr' (as |> a) b') (f b)
393+
394+-- | @'unfoldl' f x@ is equivalent to @'reverse' ('unfoldr' f x)@.
395+unfoldl :: (b -> Maybe (b, a)) -> b -> Seq a
396+unfoldl f b = unfoldl' empty b where
397+       unfoldl' as b = maybe as (\ (b', a) -> unfoldl' (a <| as) b') (f b)
398+
399+-- | /O(n)/.  Constructs a sequence by repeated application of a function to a seed value.
400+--
401+-- > iterateN n f x = fromList (Prelude.take n (Prelude.iterate f x))
402+iterateN :: Int -> (a -> a) -> a -> Seq a
403+iterateN n f x
404+       | n < 0         = error "iterateN takes a nonnegative integer argument"
405+       | otherwise     = replicateA n (State (\ x -> (f x, x))) `execState` x
406+
407 ------------------------------------------------------------------------
408 -- Deconstruction
409 ------------------------------------------------------------------------
410hunk ./Data/Sequence.hs 922
411 viewLTree      :: Sized a => FingerTree a -> Maybe2 a (FingerTree a)
412 viewLTree Empty                        = Nothing2
413 viewLTree (Single a)           = Just2 a Empty
414-viewLTree (Deep s (One a) m sf) = Just2 a (case viewLTree m of
415-       Nothing2        -> digitToTree sf
416-       Just2 b m'      -> Deep (s - size a) (nodeToDigit b) m' sf)
417+viewLTree (Deep s (One a) m sf) = Just2 a (pullL (s - size a) m sf)
418 viewLTree (Deep s (Two a b) m sf) =
419        Just2 a (Deep (s - size a) (One b) m sf)
420 viewLTree (Deep s (Three a b c) m sf) =
421hunk ./Data/Sequence.hs 959
422        foldr f z (xs :> x) = foldr f (f x z) xs
423 
424        foldl _ z EmptyR = z
425-       foldl f z (xs :> x) = f (foldl f z xs) x
426+       foldl f z (xs :> x) = foldl f z xs `f` x
427 
428        foldr1 _ EmptyR = error "foldr1: empty view"
429        foldr1 f (xs :> x) = foldr f x xs
430hunk ./Data/Sequence.hs 979
431 viewRTree      :: Sized a => FingerTree a -> Maybe2 (FingerTree a) a
432 viewRTree Empty                        = Nothing2
433 viewRTree (Single z)           = Just2 Empty z
434-viewRTree (Deep s pr m (One z)) = Just2 (case viewRTree m of
435-       Nothing2        ->  digitToTree pr
436-       Just2 m' y      ->  Deep (s - size z) pr m' (nodeToDigit y)) z
437+viewRTree (Deep s pr m (One z)) = Just2 (pullR (s - size z) pr m) z
438 viewRTree (Deep s pr m (Two y z)) =
439        Just2 (Deep (s - size z) pr m (One y)) z
440 viewRTree (Deep s pr m (Three x y z)) =
441hunk ./Data/Sequence.hs 987
442 viewRTree (Deep s pr m (Four w x y z)) =
443        Just2 (Deep (s - size z) pr m (Three w x y)) z
444 
445+------------------------------------------------------------------------
446+-- Scans
447+--
448+-- These are not particularly complex applications of the Traversable
449+-- functor, though making the correspondence with Data.List exact
450+-- requires the use of (<|) and (|>).
451+--
452+-- Note that save for the single (<|) or (|>), we maintain the original
453+-- structure of the Seq, not having to do any restructuring of our own.
454+--
455+-- [email protected], 5/23/09
456+------------------------------------------------------------------------
457+
458+-- | 'scanl' is similar to 'foldl', but returns a sequence of reduced values from the left:
459+--
460+-- > scanl f z (fromList [x1, x2, ...]) = fromList [z, z `f` x1, (z `f` x1) `f` x2, ...]
461+scanl :: (a -> b -> a) -> a -> Seq b -> Seq a
462+scanl f z0 xs = z0 <| snd (mapAccumL (\ x z -> let x' = f x z in (x', x')) z0 xs)
463+
464+-- | 'scanl1' is a variant of 'scanl' that has no starting value argument:
465+--
466+-- > scanl1 f (fromList [x1, x2, ...]) = fromList [x1, x1 `f` x2, ...]
467+scanl1 :: (a -> a -> a) -> Seq a -> Seq a
468+scanl1 f xs = case viewl xs of
469+       EmptyL          -> error "scanl1 takes a nonempty sequence as an argument"
470+       x :< xs'        -> scanl f x xs'
471+
472+-- | 'scanr' is the right-to-left dual of 'scanl'.
473+scanr :: (a -> b -> b) -> b -> Seq a -> Seq b
474+scanr f z0 xs = snd (mapAccumR (\ z x -> let z' = f x z in (z', z')) z0 xs) |> z0
475+
476+-- | 'scanr1' is a variant of 'scanr' that has no starting value argument.
477+scanr1 :: (a -> a -> a) -> Seq a -> Seq a
478+scanr1 f xs = case viewr xs of
479+       EmptyR          -> error "scanr1 takes a nonempty sequence as an argument"
480+       xs' :> x        -> scanr f x xs'
481+
482 -- Indexing
483 
484 -- | /O(log(min(i,n-i)))/. The element at the specified position,
485hunk ./Data/Sequence.hs 1152
486        sab     = sa + size b
487        sabc    = sab + size c
488 
489+-- | A generalization of 'fmap', 'mapWithIndex' takes a mapping function that also depends on the element's
490+-- index, and applies it to every element in the sequence.
491+mapWithIndex :: (Int -> a -> b) -> Seq a -> Seq b
492+mapWithIndex f xs = snd (mapAccumL' (\ i x -> (i + 1, f i x)) 0 xs)
493+
494 -- Splitting
495 
496 -- | /O(log(min(i,n-i)))/. The first @i@ elements of a sequence.
497hunk ./Data/Sequence.hs 1167
498 take i         =  fst . splitAt i
499 
500 -- | /O(log(min(i,n-i)))/. Elements of a sequence after the first @i@.
501--- If @i@ is negative, @'take' i s@ yields the whole sequence.
502+-- If @i@ is negative, @'drop' i s@ yields the whole sequence.
503 -- If the sequence contains fewer than @i@ elements, the empty sequence
504 -- is returned.
505 drop           :: Int -> Seq a -> Seq a
506hunk ./Data/Sequence.hs 1202
507                        Split l x r -> Split (maybe Empty digitToTree l) x (deepL r m sf)
508   | i < spm    = case splitTree im m of
509                        Split ml xs mr -> case splitNode (im - size ml) xs of
510-                           Split l x r -> Split (deepR pr  ml l) x (deepL r mr sf)
511+                           Split l x r -> Split (deepR pr ml l) x (deepL r mr sf)
512   | otherwise  = case splitDigit (i - spm) sf of
513hunk ./Data/Sequence.hs 1204
514-                       Split l x r -> Split (deepR pr  m  l) x (maybe Empty digitToTree r)
515+                       Split l x r -> Split (deepR pr m l) x (maybe Empty digitToTree r)
516   where        spr     = size pr
517        spm     = spr + size m
518        im      = i - spr
519hunk ./Data/Sequence.hs 1209
520 
521-{-# SPECIALIZE deepL :: Maybe (Digit (Elem a)) -> FingerTree (Node (Elem a)) -> Digit (Elem a) -> FingerTree (Elem a) #-}
522-{-# SPECIALIZE deepL :: Maybe (Digit (Node a)) -> FingerTree (Node (Node a)) -> Digit (Node a) -> FingerTree (Node a) #-}
523-deepL :: Sized a => Maybe (Digit a) -> FingerTree (Node a) -> Digit a -> FingerTree a
524-deepL Nothing m sf     = case viewLTree m of
525-       Nothing2        -> digitToTree sf
526-       Just2 a m'      -> Deep (size m + size sf) (nodeToDigit a) m' sf
527-deepL (Just pr) m sf   = deep pr m sf
528-
529-{-# SPECIALIZE deepR :: Digit (Elem a) -> FingerTree (Node (Elem a)) -> Maybe (Digit (Elem a)) -> FingerTree (Elem a) #-}
530-{-# SPECIALIZE deepR :: Digit (Node a) -> FingerTree (Node (Node a)) -> Maybe (Digit (Node a)) -> FingerTree (Node a) #-}
531-deepR :: Sized a => Digit a -> FingerTree (Node a) -> Maybe (Digit a) -> FingerTree a
532-deepR pr m Nothing     = case viewRTree m of
533-       Nothing2        -> digitToTree pr
534-       Just2 m' a      -> Deep (size pr + size m) pr m' (nodeToDigit a)
535-deepR pr m (Just sf)   = deep pr m sf
536-
537 {-# SPECIALIZE splitNode :: Int -> Node (Elem a) -> Split (Maybe (Digit (Elem a))) (Elem a) #-}
538 {-# SPECIALIZE splitNode :: Int -> Node (Node a) -> Split (Maybe (Digit (Node a))) (Node a) #-}
539 splitNode :: Sized a => Int -> Node a -> Split (Maybe (Digit a)) a
540hunk ./Data/Sequence.hs 1245
541   where        sa      = size a
542        sab     = sa + size b
543        sabc    = sab + size c
544+
545+-- | /O(n)/.  Returns a sequence of all suffixes of this sequence, longest first.  For example,
546+--
547+-- > tails (fromList "abc") = fromList [fromList "abc", fromList "bc", fromList "c", fromList ""]
548+--
549+-- Evaluating the /i/th suffix takes /O(log(min(i, n-i)))/, but evaluating every suffix in the sequence
550+-- takes /O(n)/ due to sharing.
551+tails                  :: Seq a -> Seq (Seq a)
552+tails (Seq xs)         = Seq (tailsTree (Elem . Seq) xs) |> empty
553+
554+-- | /O(n)/.  Returns a sequence of all prefixes of this sequence, shortest first. For example,
555+--
556+-- > inits (fromList "abc") = fromList [fromList "", fromList "a", fromList "ab", fromList "abc"]
557+--
558+-- Evaluating the /i/th prefix takes /O(log(min(i, n-i)))/, but evaluating every prefix in the sequence
559+-- takes /O(n)/ due to sharing.
560+inits                  :: Seq a -> Seq (Seq a)
561+inits (Seq xs)                 = empty <| Seq (initsTree (Elem . Seq) xs)
562+
563+-- This implementation of tails (and, analogously, inits) has the following algorithmic advantages:
564+--     Evaluating each tail in the sequence takes linear total time, which is better than we could say for
565+--             @fromList [drop n xs | n <- [0..length xs]]@.
566+--     Evaluating any individual tail takes logarithmic time, which is better than we can say for either
567+--             @scanr (<|) empty xs@ or @iterateN (length xs + 1) (\ xs -> let _ :< xs' = viewl xs in xs') xs@.
568+--
569+-- Moreover, if we actually look at every tail in the sequence, the following benchmarks demonstrate that
570+-- this implementation is modestly faster than any of the above:
571+--
572+-- Times (ms)
573+--               min      mean    +/-sd    median    max
574+-- Seq.tails:   21.986   24.961   10.169   22.417   86.485
575+-- scanr:       85.392   87.942    2.488   87.425  100.217
576+-- iterateN:       29.952   31.245    1.574   30.412   37.268
577+--
578+-- The algorithm for tails (and, analogously, inits) is as follows:
579+--
580+-- A Node in the FingerTree of tails is constructed by evaluating the corresponding tail of the FingerTree
581+-- of Nodes, considering the first Node in this tail, and constructing a Node in which each tail of this
582+-- Node is made to be the prefix of the remaining tree.  This ends up working quite elegantly, as the remainder of
583+-- the tail of the FingerTree of Nodes becomes the middle of a new tail, the suffix of the Node is the
584+-- prefix, and the suffix of the original tree is retained.
585+--
586+-- In particular, evaluating the /i/th tail involves making as many partial evaluations as the Node depth of
587+-- the /i/th element.  In addition, when we evaluate the /i/th tail, and we also evaluate the /j/th tail,
588+-- and /m/ Nodes are on the path to both /i/ and /j/, each of those /m/ evaluations are shared between
589+-- the computation of the /i/th and /j/th tails.
590+--
591+-- [email protected], 7/16/09
592+
593+tailsDigit :: Digit a -> Digit (Digit a)
594+tailsDigit (One a) = One (One a)
595+tailsDigit (Two a b) = Two (Two a b) (One b)
596+tailsDigit (Three a b c) = Three (Three a b c) (Two b c) (One c)
597+tailsDigit (Four a b c d) = Four (Four a b c d) (Three b c d) (Two c d) (One d)
598+
599+initsDigit :: Digit a -> Digit (Digit a)
600+initsDigit (One a) = One (One a)
601+initsDigit (Two a b) = Two (One a) (Two a b)
602+initsDigit (Three a b c) = Three (One a) (Two a b) (Three a b c)
603+initsDigit (Four a b c d) = Four (One a) (Two a b) (Three a b c) (Four a b c d)
604+
605+tailsNode :: Node a -> Node (Digit a)
606+tailsNode (Node2 s a b) = Node2 s (Two a b) (One b)
607+tailsNode (Node3 s a b c) = Node3 s (Three a b c) (Two b c) (One c)
608+
609+initsNode :: Node a -> Node (Digit a)
610+initsNode (Node2 s a b) = Node2 s (One a) (Two a b)
611+initsNode (Node3 s a b c) = Node3 s (One a) (Two a b) (Three a b c)
612+
613+{-# SPECIALIZE tailsTree :: (FingerTree (Elem a) -> Elem b) -> FingerTree (Elem a) -> FingerTree (Elem b) #-}
614+{-# SPECIALIZE tailsTree :: (FingerTree (Node a) -> Node b) -> FingerTree (Node a) -> FingerTree (Node b) #-}
615+-- | Given a function to apply to tails of a tree, applies that function to every tail of the specified tree.
616+tailsTree :: (Sized a, Sized b) => (FingerTree a -> b) -> FingerTree a -> FingerTree b
617+tailsTree _ Empty = Empty
618+tailsTree f (Single x) = Single (f (Single x))
619+tailsTree f (Deep n pr m sf) =
620+       Deep n (fmap (\ pr' -> f (deep pr' m sf)) (tailsDigit pr))
621+               (tailsTree f' m)
622+               (fmap (f . digitToTree) (tailsDigit sf))
623+       where   f' ms = let Just2 node m' = viewLTree ms in
624+                       fmap (\ pr' -> f (deep pr' m' sf)) (tailsNode node)
625+
626+{-# SPECIALIZE initsTree :: (FingerTree (Elem a) -> Elem b) -> FingerTree (Elem a) -> FingerTree (Elem b) #-}
627+{-# SPECIALIZE initsTree :: (FingerTree (Node a) -> Node b) -> FingerTree (Node a) -> FingerTree (Node b) #-}
628+-- | Given a function to apply to inits of a tree, applies that function to every init of the specified tree.
629+initsTree :: (Sized a, Sized b) => (FingerTree a -> b) -> FingerTree a -> FingerTree b
630+initsTree _ Empty = Empty
631+initsTree f (Single x) = Single (f (Single x))
632+initsTree f (Deep n pr m sf) =
633+       Deep n (fmap (f . digitToTree) (initsDigit pr))
634+               (initsTree f' m)
635+               (fmap (f . deep pr m) (initsDigit sf))
636+       where   f' ms =  let Just2 m' node = viewRTree ms in
637+                        fmap (\ sf' -> f (deep pr m' sf')) (initsNode node)
638 
639hunk ./Data/Sequence.hs 1340
640+{-# INLINE foldWithIndexL #-}
641+-- | 'foldWithIndexL' is a version of 'foldl' that also provides access to the index of each element.
642+foldWithIndexL :: (b -> Int -> a -> b) -> b -> Seq a -> b
643+foldWithIndexL f z xs = foldl (\ g x i -> i `seq` f (g (i - 1)) i x) (const z) xs (length xs - 1)
644+
645+{-# INLINE foldWithIndexR #-}
646+-- | 'foldWithIndexR' is a version of 'foldr' that also provides access to the index of each element.
647+foldWithIndexR :: (Int -> a -> b -> b) -> b -> Seq a -> b
648+foldWithIndexR f z xs = foldr (\ x g i -> i `seq` f i x (g (i+1))) (const z) xs 0
649+
650+{-# INLINE [1] foldIndicesR #-}
651+-- | foldIndicesR folds in every satisfying value, from right to left.
652+foldIndicesR :: (a -> Bool) -> Seq a -> (Int -> b -> b) -> b -> b
653+foldIndicesR p xs f z0 =
654+       foldl (\ z x n -> n `seq` if p x then f n (z (n-1)) else z (n-1))
655+               (const z0) xs (length xs - 1)
656+
657+{-# INLINE listToMaybe' #-}
658+-- 'listToMaybe\'' is a good consumer version of 'listToMaybe'.
659+listToMaybe' :: [a] -> Maybe a
660+listToMaybe' = foldr (\ x _ -> Just x) Nothing
661+
662+-- | /O(i)/ where /i/ is the prefix length.  'takeWhileL', applied to a predicate @p@ and a sequence @xs@, returns the
663+--  longest prefix (possibly empty) of @xs@ of elements that satisfy @p@.
664+takeWhileL :: (a -> Bool) -> Seq a -> Seq a
665+takeWhileL p = fst . spanl p
666+
667+-- | /O(i)/ where /i/ is the suffix length.  'takeWhileR', applied to a predicate @p@ and a sequence @xs@, returns
668+--  the longest suffix (possibly empty) of @xs@ of elements that satisfy @p@.
669+--
670+-- @'takeWhileR' p xs@ is equivalent to @'reverse' ('takeWhileL' p ('reverse' xs))@.
671+takeWhileR :: (a -> Bool) -> Seq a -> Seq a
672+takeWhileR p = fst . spanr p
673+
674+-- | /O(i)/ where /i/ is the prefix length.  @'dropWhileL' p xs@ returns the suffix remaining after @'takeWhileL' p xs@.
675+dropWhileL :: (a -> Bool) -> Seq a -> Seq a
676+dropWhileL p = snd . spanl p
677+
678+-- | /O(i)/ where /i/ is the suffix length.  @'dropWhileR' p xs@ returns the prefix remaining after @'takeWhileR' p xs@.
679+--
680+-- @'dropWhileR' p xs@ is equivalent to @'reverse' ('dropWhileL' p ('reverse' xs))@.
681+dropWhileR :: (a -> Bool) -> Seq a -> Seq a
682+dropWhileR p = snd . spanr p
683+
684+-- | /O(i)/ where /i/ is the prefix length.  'spanl', applied to a predicate @p@ and a sequence @xs@, returns a tuple
685+-- whose first element is the longest prefix (possibly empty) of @xs@ of elements that satisfy @p@ and the second
686+-- element is the remainder of the sequence.
687+spanl :: (a -> Bool) -> Seq a -> (Seq a, Seq a)
688+spanl p = breakl (not . p)
689+
690+-- | /O(i)/ where /i/ is the suffix length.  'spanr', applied to a predicate @p@ and a sequence @xs@, returns a tuple
691+-- whose /first/ element is the longest /suffix/ (possibly empty) of @xs@ of elements that satisfy @p@ and the second
692+-- element is the remainder of the sequence.
693+spanr :: (a -> Bool) -> Seq a -> (Seq a, Seq a)
694+spanr p = breakr (not . p)
695+
696+{-# INLINE breakl #-}
697+-- | /O(i)/ where /i/ is the breakpoint index.  'breakl', applied to a predicate @p@ and a sequence @xs@, returns a tuple
698+-- whose first element is the longest prefix (possibly empty) of @xs@ of elements that /do not satisfy/ @p@ and the
699+-- second element is the remainder of the sequence.
700+--
701+-- @'breakl' p@ is equivalent to @'spanl' (not . p)@.
702+breakl :: (a -> Bool) -> Seq a -> (Seq a, Seq a)
703+breakl p xs = foldr (\ i _ -> splitAt i xs) (xs, empty) (findIndicesL p xs)
704+
705+{-# INLINE breakr #-}
706+-- | @'breakr' p@ is equivalent to @'spanr' (not . p)@.
707+breakr :: (a -> Bool) -> Seq a -> (Seq a, Seq a)
708+breakr p xs = foldr (\ i _ -> flipPair (splitAt i xs)) (xs, empty) (findIndicesR p xs) where
709+       flipPair (x, y) = (y, x)
710+
711+-- | /O(n)/.  The 'partition' function takes a predicate @p@ and a sequence @xs@ and returns sequences of those
712+-- elements which do and do not satisfy the predicate.
713+partition :: (a -> Bool) -> Seq a -> (Seq a, Seq a)
714+partition p = foldl part (empty, empty) where
715+       part (xs, ys) x
716+               | p x           = (xs |> x, ys)
717+               | otherwise     = (xs, ys |> x)
718+
719+-- | /O(n)/.  The 'filter' function takes a predicate @p@ and a sequence @xs@ and returns a sequence of those
720+-- elements which satisfy the predicate.
721+filter :: (a -> Bool) -> Seq a -> Seq a
722+filter p = foldl (\ xs x -> if p x then xs |> x else xs) empty
723+
724+-- Indexing sequences
725+
726+-- | 'elemIndexL' finds the first index of the specified element, if it is present.
727+elemIndexL :: Eq a => a -> Seq a -> Maybe Int
728+elemIndexL x = findIndexL (x ==)
729+
730+-- | 'elemIndexR' finds the last index of the specified element, if it is present.
731+elemIndexR :: Eq a => a -> Seq a -> Maybe Int
732+elemIndexR x = findIndexR (x ==)
733+
734+-- | 'elemIndicesL' finds the indices of the specified element, in ascending order.
735+elemIndicesL :: Eq a => a -> Seq a -> [Int]
736+elemIndicesL x = findIndicesL (x ==)
737+
738+-- | 'elemIndicesR' finds the indices of the specified element, in descending order.
739+elemIndicesR :: Eq a => a -> Seq a -> [Int]
740+elemIndicesR x = findIndicesR (x ==)
741+
742+-- | @'findIndexL' p xs@ finds the index of the first element that satisfies @p@, if any exist.
743+findIndexL :: (a -> Bool) -> Seq a -> Maybe Int
744+findIndexL p = listToMaybe' . findIndicesL p
745+
746+-- | @'findIndexR' p xs@ finds the index of the last element that satisfies @p@, if any exist.
747+findIndexR :: (a -> Bool) -> Seq a -> Maybe Int
748+findIndexR p = listToMaybe' . findIndicesR p
749+
750+{-# INLINE findIndicesL #-}
751+-- | @'findIndicesL' p@ finds all indices of elements that satisfy @p@, in ascending order.
752+findIndicesL :: (a -> Bool) -> Seq a -> [Int]
753+#if __GLASGOW_HASKELL__
754+findIndicesL p xs = build (\ c n -> let g i x z = if p x then i `c` z else z in
755+                                       foldWithIndexR g n xs)
756+#else
757+findIndicesL p xs = foldWithIndexR g [] xs where
758+       g i x is = if p x then i:is else is
759+#endif
760+
761+{-# INLINE findIndicesR #-}
762+-- | @'findIndicesR' p@ finds all indices of elements that satisfy @p@, in descending order.
763+findIndicesR :: (a -> Bool) -> Seq a -> [Int]
764+#if __GLASGOW_HASKELL__
765+findIndicesR p xs = build (\ c n -> let g z i x = if p x then i `c` z else z in
766+                                       foldWithIndexL g n xs)
767+#else
768+findIndicesR p xs = foldWithIndexL g [] xs where
769+       g is i x = if p x then i:is else is
770+#endif
771+
772 ------------------------------------------------------------------------
773 -- Lists
774 ------------------------------------------------------------------------
775hunk ./Data/Sequence.hs 1498
776                (reverseTree (reverseNode f) m)
777                (reverseDigit f pr)
778 
779+{-# INLINE reverseDigit #-}
780 reverseDigit :: (a -> a) -> Digit a -> Digit a
781 reverseDigit f (One a) = One (f a)
782 reverseDigit f (Two a b) = Two (f b) (f a)
783hunk ./Data/Sequence.hs 1509
784 reverseNode f (Node2 s a b) = Node2 s (f b) (f a)
785 reverseNode f (Node3 s a b c) = Node3 s (f c) (f b) (f a)
786 
787+------------------------------------------------------------------------
788+-- Zipping
789+------------------------------------------------------------------------
790+
791+-- | /O(n)/.  'zip' takes two sequences and returns a sequence of corresponding pairs. 
792+-- If one input is short, excess elements of the longer sequence are discarded.
793+zip :: Seq a -> Seq b -> Seq (a, b)
794+zip = zipWith (,)
795+
796+-- | /O(n)/.  'zipWith' generalizes 'zip' by zipping with the function given as the first argument,
797+-- instead of a tupling function.  For example, @zipWith (+)@ is applied to two sequences to take
798+-- the sequence of corresponding sums.
799+zipWith :: (a -> b -> c) -> Seq a -> Seq b -> Seq c
800+zipWith f xs ys
801+       | length xs <= length ys        = zipWith' f xs ys
802+       | otherwise                     = zipWith' (flip f) ys xs
803+       where  zipWith' f xs ys = snd (mapAccumL ((\ (y :< ys) x -> (ys, f x y)) . viewl) ys xs)
804+
805+zip3 :: Seq a -> Seq b -> Seq c -> Seq (a,b,c)
806+zip3 = zipWith3 (,,)
807+
808+zipWith3 :: (a -> b -> c -> d) -> Seq a -> Seq b -> Seq c -> Seq d
809+zipWith3 f s1 s2 s3 = zipWith ($) (zipWith f s1 s2) s3
810+
811+zip4 :: Seq a -> Seq b -> Seq c -> Seq d -> Seq (a,b,c,d)
812+zip4 = zipWith4 (,,,)
813+
814+zipWith4 :: (a -> b -> c -> d -> e) -> Seq a -> Seq b -> Seq c -> Seq d -> Seq e
815+zipWith4 f s1 s2 s3 s4 = zipWith ($) (zipWith ($) (zipWith f s1 s2) s3) s4
816+
817+------------------------------------------------------------------------
818+-- Sorting
819+--
820+-- sort and sortBy are implemented by simple deforestations of
821+--     \ xs -> fromList2 (length xs) . Data.List.sortBy cmp . toList
822+-- which does not get deforested automatically, it would appear.
823+--
824+-- Unstable sorting is performed by a heap sort implementation based on pairing heaps.  Because the
825+-- internal structure of sequences is quite varied, it is difficult to get blocks of elements of
826+-- roughly the same length, which would improve merge sort performance.  Pairing heaps, on the other
827+-- hand, are relatively resistant to the effects of merging heaps of wildly different sizes, as
828+-- guaranteed by its amortized constant-time merge operation.  Moreover, extensive use of SpecConstr
829+-- transformations can be done on pairing heaps, especially when we're only constructing them
830+-- to immediately be unrolled.
831+--
832+-- On purely random sequences of length 50000, with no RTS options, I get the following statistics,
833+-- in which heapsort is about 42.5% faster:  (all comparisons done with -O2)
834+--
835+-- Times (ms)            min      mean    +/-sd    median    max
836+-- to/from list:       103.802  108.572    7.487  106.436  143.339
837+-- unstable heapsort:   60.686   62.968    4.275   61.187   79.151
838+--
839+-- Heapsort, it would seem, is less of a memory hog than Data.List.sortBy.  The gap is narrowed
840+-- when more memory is available, but heapsort still wins, 15% faster, with +RTS -H128m:
841+--
842+-- Times (ms)            min    mean    +/-sd  median    max
843+-- to/from list:       42.692  45.074   2.596  44.600  56.601
844+-- unstable heapsort:  37.100  38.344   3.043  37.715  55.526
845+--
846+-- In addition, on strictly increasing sequences the gap is even wider than normal; heapsort is
847+-- 68.5% faster with no RTS options:
848+-- Times (ms)            min    mean    +/-sd  median    max
849+-- to/from list:       52.236  53.574   1.987  53.034  62.098
850+-- unstable heapsort:  16.433  16.919   0.931  16.681  21.622
851+--
852+-- This may be attributed to the elegant nature of the pairing heap.
853+--
854+-- [email protected], 7/20/09
855+------------------------------------------------------------------------
856+
857+-- | /O(n log n)/.  'sort' sorts the specified 'Seq' by the natural ordering of its elements.  The sort is stable.
858+-- If a stable sort is not required, 'unstableSort' can be considerably faster, and in particular uses less memory.
859+sort :: Ord a => Seq a -> Seq a
860+sort = sortBy compare
861+
862+-- | /O(n log n)/.  'sortBy' sorts the specified 'Seq' according to the specified comparator.  The sort is stable.
863+-- If a stable sort is not required, 'unstableSortBy' can be considerably faster, and in particular uses less memory.
864+sortBy :: (a -> a -> Ordering) -> Seq a -> Seq a
865+-- fromList . Data.List.sortBy cmp . toList doesn't actually deforest well, so I did so manually and got a moderate
866+-- performance boost.
867+sortBy cmp xs = case foldr (\ x -> ([x]:)) [] xs of
868+       []      -> empty
869+       ys:yss  -> fromList2 (length xs) (merger0 ys yss)
870+       where   xs@(x:xs1) <> ys@(y:ys1) = case cmp x y of
871+                       GT      -> y:(xs <> ys1)
872+                       _       -> x:(xs1 <> ys)
873+               [] <> ys = ys
874+               xs <> [] = xs
875+               merger (xs1:xs2:xss) = (xs1 <> xs2) : merger xss
876+               merger xss = xss
877+               merger0 xs1 (xs2:xss) = merger0 (xs1 <> xs2) (merger xss)
878+               merger0 xs [] = xs
879+
880+-- | /O(n log n)/.  'unstableSort' sorts the specified 'Seq' by the natural ordering of its elements, but the sort is not stable.
881+-- This algorithm is frequently faster and uses less memory than 'sort', and performs extremely well -- frequently twice as fast as
882+-- 'sort' -- when the sequence is already nearly sorted.
883+unstableSort :: Ord a => Seq a -> Seq a
884+unstableSort = unstableSortBy compare
885+
886+-- | /O(n log n)/.  A generalization of 'unstableSort', 'unstableSortBy' takes an arbitrary comparator and sorts the specified sequence. 
887+-- The sort is not stable.  This algorithm is frequently faster and uses less memory than 'sortBy', and performs extremely well --
888+-- frequently twice as fast as 'sortBy' -- when the sequence is already nearly sorted.
889+unstableSortBy :: (a -> a -> Ordering) -> Seq a -> Seq a
890+unstableSortBy cmp (Seq xs) = fromList2 (size xs) $ maybe [] (unrollPQ cmp) $ toPQ cmp (\ (Elem x) -> PQueue x Nil) xs
891+
892+fromList2 :: Int -> [a] -> Seq a
893+-- fromList2, given a list and its length, constructs a completely balanced Seq whose elements are that list
894+-- using the applicativeTree generalization.
895+fromList2 n = execState (replicateA n (State (\ (x:xs) -> (xs, x))))
896+
897+-- | A 'PQueue' is a simple pairing heap.
898+data PQueue e = PQueue e (PQL e)
899+data PQL e = Nil | {-# UNPACK #-} !(PQueue e) :& PQL e
900+
901+infixr 8 :&
902+
903+#if TESTING
904+
905+instance Functor PQueue where
906+       fmap f (PQueue x ts) = PQueue (f x) (fmap f ts)
907+
908+instance Functor PQL where
909+       fmap f (q :& qs) = fmap f q :& fmap f qs
910+       fmap _ Nil = Nil
911+
912+instance Show e => Show (PQueue e) where
913+       show = unlines . draw . fmap show
914+
915+-- borrowed wholesale from Data.Tree, as Data.Tree actually depends on Data.Sequence
916+draw :: PQueue String -> [String]
917+draw (PQueue x ts0) = x : drawSubTrees ts0
918+  where drawSubTrees Nil = []
919+       drawSubTrees (t :& Nil) =
920+               "|" : shift "`- " "   " (draw t)
921+       drawSubTrees (t :& ts) =
922+               "|" : shift "+- " "|  " (draw t) ++ drawSubTrees ts
923+
924+       shift first other = Data.List.zipWith (++) (first : repeat other)
925+#endif
926+
927+-- | 'unrollPQ', given a comparator function, unrolls a 'PQueue' into a sorted list.
928+unrollPQ :: (e -> e -> Ordering) -> PQueue e -> [e]
929+unrollPQ cmp = unrollPQ' where
930+       {-# INLINE unrollPQ' #-}
931+       unrollPQ' (PQueue x ts) = x:mergePQs0 ts
932+       (<>) = mergePQ cmp
933+       mergePQs0 Nil = []
934+       mergePQs0 (t :& Nil) = unrollPQ' t
935+       mergePQs0 (t1 :& t2 :& ts) = mergePQs (t1 <> t2) ts
936+       mergePQs t ts = t `seq` case ts of
937+               Nil             -> unrollPQ' t
938+               t1 :& Nil       -> unrollPQ' (t <> t1)
939+               t1 :& t2 :& ts  -> mergePQs (t <> (t1 <> t2)) ts
940+
941+-- | 'toPQ', given an ordering function and a mechanism for queueifying elements, converts a 'FingerTree' to a 'PQueue'.
942+toPQ :: (e -> e -> Ordering) -> (a -> PQueue e) -> FingerTree a -> Maybe (PQueue e)
943+toPQ _ _ Empty = Nothing
944+toPQ _ f (Single x) = Just (f x)
945+toPQ cmp f (Deep _ pr m sf) = Just (maybe (pr' <> sf') ((pr' <> sf') <>) (toPQ cmp fNode m)) where
946+       fDigit d = case fmap f d of
947+               One a           -> a
948+               Two a b         -> a <> b
949+               Three a b c     -> a <> b <> c
950+               Four a b c d    -> (a <> b) <> (c <> d)
951+       (<>) = mergePQ cmp
952+       fNode = fDigit . nodeToDigit
953+       pr' = fDigit pr
954+       sf' = fDigit sf
955+
956+-- | 'mergePQ' merges two 'PQueue's.
957+mergePQ :: (a -> a -> Ordering) -> PQueue a -> PQueue a -> PQueue a
958+mergePQ cmp q1@(PQueue x1 ts1) q2@(PQueue x2 ts2)
959+       | cmp x1 x2 == GT       = PQueue x2 (q1 :& ts2)
960+       | otherwise             = PQueue x1 (q2 :& ts1)
961+
962 #if TESTING
963 
964 ------------------------------------------------------------------------
965hunk ./Data/Sequence.hs 1692
966 
967 instance Arbitrary a => Arbitrary (Seq a) where
968        arbitrary = liftM Seq arbitrary
969-       coarbitrary (Seq x) = coarbitrary x
970+       shrink (Seq x) = map Seq (shrink x)
971 
972 instance Arbitrary a => Arbitrary (Elem a) where
973        arbitrary = liftM Elem arbitrary
974hunk ./Data/Sequence.hs 1696
975-       coarbitrary (Elem x) = coarbitrary x
976 
977 instance (Arbitrary a, Sized a) => Arbitrary (FingerTree a) where
978        arbitrary = sized arb
979hunk ./Data/Sequence.hs 1704
980                arb 1 = liftM Single arbitrary
981                arb n = liftM3 deep arbitrary (arb (n `div` 2)) arbitrary
982 
983-       coarbitrary Empty = variant 0
984-       coarbitrary (Single x) = variant 1 . coarbitrary x
985-       coarbitrary (Deep _ pr m sf) =
986-               variant 2 . coarbitrary pr . coarbitrary m . coarbitrary sf
987+       shrink (Deep _ (One a) Empty (One b)) = [Single a, Single b]
988+       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]
989+       shrink (Single x) = map Single (shrink x)
990+       shrink Empty = []
991 
992 instance (Arbitrary a, Sized a) => Arbitrary (Node a) where
993        arbitrary = oneof [
994hunk ./Data/Sequence.hs 1714
995                        liftM2 node2 arbitrary arbitrary,
996                        liftM3 node3 arbitrary arbitrary arbitrary]
997 
998-       coarbitrary (Node2 _ a b) = variant 0 . coarbitrary a . coarbitrary b
999-       coarbitrary (Node3 _ a b c) =
1000-               variant 1 . coarbitrary a . coarbitrary b . coarbitrary c
1001+       shrink (Node2 _ a b) = [node2 a' b | a' <- shrink a] ++ [node2 a b' | b' <- shrink b]
1002+       shrink (Node3 _ a b c) = [node2 a b, node2 a c, node2 b c] ++
1003+               [node3 a' b c | a' <- shrink a] ++ [node3 a b' c | b' <- shrink b] ++ [node3 a b c' | c' <- shrink c]
1004 
1005 instance Arbitrary a => Arbitrary (Digit a) where
1006        arbitrary = oneof [
1007hunk ./Data/Sequence.hs 1724
1008                        liftM2 Two arbitrary arbitrary,
1009                        liftM3 Three arbitrary arbitrary arbitrary,
1010                        liftM4 Four arbitrary arbitrary arbitrary arbitrary]
1011-
1012-       coarbitrary (One a) = variant 0 . coarbitrary a
1013-       coarbitrary (Two a b) = variant 1 . coarbitrary a . coarbitrary b
1014-       coarbitrary (Three a b c) =
1015-               variant 2 . coarbitrary a . coarbitrary b . coarbitrary c
1016-       coarbitrary (Four a b c d) =
1017-               variant 3 . coarbitrary a . coarbitrary b . coarbitrary c . coarbitrary d
1018+       
1019+       shrink (One a) = map One (shrink a)
1020+       shrink (Two a b) = [One a, One b]
1021+       shrink (Three a b c) = [Two a b, Two a c, Two b c]
1022+       shrink (Four a b c d) = [Three a b c, Three a b d, Three a c d, Three b c d]
1023 
1024 ------------------------------------------------------------------------
1025 -- Valid trees
1026hunk ./Data/Sequence.hs 1750
1027                s == size pr + size m + size sf && valid pr && valid m && valid sf
1028 
1029 instance (Sized a, Valid a) => Valid (Node a) where
1030-       valid (Node2 s a b) = s == size a + size b && valid a && valid b
1031-       valid (Node3 s a b c) =
1032-               s == size a + size b + size c && valid a && valid b && valid c
1033+       valid node = (size node == foldl1 (+) (fmap size node)) && (all valid node)
1034 
1035 instance Valid a => Valid (Digit a) where
1036hunk ./Data/Sequence.hs 1753
1037-       valid (One a) = valid a
1038-       valid (Two a b) = valid a && valid b
1039-       valid (Three a b c) = valid a && valid b && valid c
1040-       valid (Four a b c d) = valid a && valid b && valid c && valid d
1041+       valid = all valid
1042 
1043 #endif
1044hunk ./Data/Set.hs 122
1045 
1046 #if __GLASGOW_HASKELL__
1047 import Text.Read
1048-import Data.Data (Data(..), mkNoRepType, gcast1)
1049+import Data.Data (Data(..), mkNorepType, gcast1)
1050 #endif
1051 
1052 {--------------------------------------------------------------------
1053hunk ./Data/Set.hs 165
1054   gfoldl f z set = z fromList `f` (toList set)
1055   toConstr _     = error "toConstr"
1056   gunfold _ _    = error "gunfold"
1057-  dataTypeOf _   = mkNoRepType "Data.Set.Set"
1058+  dataTypeOf _   = mkNorepType "Data.Set.Set"
1059   dataCast1 f    = gcast1 f
1060 
1061 #endif
1062hunk ./containers.cabal 23
1063     location: http://darcs.haskell.org/packages/containers/
1064 
1065 Library {
1066-    build-depends: base, array
1067+    build-depends: base >= 4.0.0.0, array
1068     exposed-modules:
1069         Data.Graph
1070         Data.IntMap
1071}
1072
1073Context:
1074
1075[Use left/right rather than old/new to describe the arguments to unionWithKey
1076Ian Lynagh <[email protected]>**20090208192132
1077 Fixes trac #3002.
1078]
1079[help nhc98 by making import decl more explicit
1080[email protected]**20090203142144]
1081[Add instance Data.Traversable for IntMap
1082Matti Niemenmaa <[email protected]>**20090116190353
1083 Ignore-this: df88a286935926aecec3f8a5dd291699
1084]
1085[Require Cabal version >= 1.6
1086Ian Lynagh <[email protected]>**20090122011256]
1087[Add "bug-reports" and "source-repository" info to the Cabal file
1088Ian Lynagh <[email protected]>**20090121182106]
1089[Fix warnings in containers
1090Ian Lynagh <[email protected]>**20090116200251]
1091[optimize IntMap/IntSet findMin/findMax
1092[email protected]**20081002152055]
1093[O(n) fromAscList IntSet / IntMap
1094[email protected]**20080521195941
1095 
1096 Added algorithm by Scott Dillard and Bertram Felgenhauer to build IntSets and
1097 IntMaps from sorted input in linear time. Also changed quickcheck prop_Ordered
1098 (no longer a tautology!) to include negative and duplicate keys.
1099 
1100]
1101[correct type for IntMap.intersectionWith[Key]
1102[email protected]**20081002144828]
1103[Export mapAccumRWithKey from Map and IntMap (Trac #2769)
1104[email protected]**20081210160205]
1105[Bump the version number to 0.2.0.1, to work-around cabal-install problems
1106Ian Lynagh <[email protected]>**20081212201829]
1107[Fix #2760: change mkNorepType to mkNoRepType
1108'Jose Pedro Magalhaes <[email protected]>'**20081202083424]
1109[Doc fix, from hackage trac #378
1110Ian Lynagh <[email protected]>**20081024143949]
1111[import Data.Data instead of Data.Generics.*, eliminating the dependency on syb
1112Ross Paterson <[email protected]>**20081005002559]
1113[fixed typo in highestBitMask
1114[email protected]**20081002215438]
1115[export Data.Map.toDescList, foldlWithKey, and foldrWithKey (trac ticket 2580)
1116[email protected]**20080922213200
1117 
1118 toDescList was previously implemented, but not exported.
1119 
1120 foldlWithKey was previously implemented, but not exported.  It can be used to
1121 implement toDescList.
1122 
1123 foldrWithKey is already exported as foldWithKey, but foldrWithKey is explicitly
1124 the mirror of foldlWithKey, and foldWithKey kept for compatibility.
1125]
1126[Bump version number to 0.2.0.0
1127Ian Lynagh <[email protected]>**20080920160016]
1128[TAG 6.10 branch has been forked
1129Ian Lynagh <[email protected]>**20080919123438]
1130[Fixed typo in updateMinWithKey / updateMaxWithKey
1131[email protected]**20080704054350]
1132[follow library changes
1133Ian Lynagh <[email protected]>**20080903223610]
1134[add include/Typeable.h to extra-source-files
1135Ross Paterson <[email protected]>**20080831181402]
1136[fix cabal build-depends for nhc98
1137[email protected]**20080828104248]
1138[Add a dep on syb
1139Ian Lynagh <[email protected]>**20080825214314]
1140[add category field
1141Ross Paterson <[email protected]>**20080824003013]
1142[we depend on st, now split off from base
1143Ian Lynagh <[email protected]>**20080823223053]
1144[specialize functions that fail in a Monad to Maybe (proposal #2309)
1145Ross Paterson <[email protected]>**20080722154812
1146 
1147 Specialize functions signatures like
1148 
1149        lookup :: (Monad m, Ord k) => k -> Map k a -> m a
1150 to
1151        lookup :: (Ord k) => k -> Map k a -> Maybe a
1152 
1153 for simplicity and safety.  No information is lost, as each of these
1154 functions had only one use of fail, which is now changed to Nothing.
1155]
1156[tighter description of split (addresses #2447)
1157Ross Paterson <[email protected]>**20080717064838]
1158[Make warning-clean with GHC again
1159Ian Lynagh <[email protected]>**20080623232023
1160 With any luck we have now converged on a solution that works everywhere!
1161]
1162[Undo more Data.Typeable-related breakage for non-ghc.
1163[email protected]**20080623092757]
1164[Placate GHC with explicit import lists
1165Ian Lynagh <[email protected]>**20080620183926]
1166[undo breakage caused by -Wall cleaning
1167[email protected]**20080620093922
1168 The import of Data.Typeable is still required, at least for non-GHC.
1169]
1170[Make the package -Wall clean
1171Ian Lynagh <[email protected]>**20080618233627]
1172[List particular extensions rather than -fglasgow-exts
1173Ian Lynagh <[email protected]>**20080616232035]
1174[Avoid using deprecated flags
1175Ian Lynagh <[email protected]>**20080616145241]
1176[TAG 2008-05-28
1177Ian Lynagh <[email protected]>**20080528004309]
1178Patch bundle hash:
11796c3e5d64b47db0d11f2d860c23ad3d77430e8da6