List.hs 42.2 KB
Newer Older
1
{-# LANGUAGE Trustworthy #-}
2
3
{-# LANGUAGE CPP, NoImplicitPrelude, MagicHash #-}

4
-----------------------------------------------------------------------------
5
-- |
6
7
-- Module      :  Data.List
-- Copyright   :  (c) The University of Glasgow 2001
8
-- License     :  BSD-style (see the file libraries/base/LICENSE)
9
10
-- 
-- Maintainer  :  libraries@haskell.org
11
-- Stability   :  stable
12
13
14
15
16
17
18
-- Portability :  portable
--
-- Operations on lists.
--
-----------------------------------------------------------------------------

module Data.List
Don Stewart's avatar
Don Stewart committed
19
   (
20
21
22
23
#ifdef __NHC__
     [] (..)
   ,
#endif
24

ross's avatar
ross committed
25
   -- * Basic functions
26

Don Stewart's avatar
Don Stewart committed
27
28
29
30
     (++)              -- :: [a] -> [a] -> [a]
   , head              -- :: [a] -> a
   , last              -- :: [a] -> a
   , tail              -- :: [a] -> [a]
31
   , init              -- :: [a] -> [a]
Don Stewart's avatar
Don Stewart committed
32
33
   , null              -- :: [a] -> Bool
   , length            -- :: [a] -> Int
ross's avatar
ross committed
34
35
36
37
38
39

   -- * List transformations
   , map               -- :: (a -> b) -> [a] -> [b]
   , reverse           -- :: [a] -> [a]

   , intersperse       -- :: a -> [a] -> [a]
40
   , intercalate       -- :: [a] -> [[a]] -> [a]
ross's avatar
ross committed
41
   , transpose         -- :: [[a]] -> [[a]]
42
43
44
   
   , subsequences      -- :: [a] -> [[a]]
   , permutations      -- :: [a] -> [[a]]
ross's avatar
ross committed
45
46
47

   -- * Reducing lists (folds)

48
49
   , foldl             -- :: (b -> a -> b) -> b -> [a] -> b
   , foldl'            -- :: (b -> a -> b) -> b -> [a] -> b
Don Stewart's avatar
Don Stewart committed
50
51
   , foldl1            -- :: (a -> a -> a) -> [a] -> a
   , foldl1'           -- :: (a -> a -> a) -> [a] -> a
52
53
   , foldr             -- :: (a -> b -> b) -> b -> [a] -> b
   , foldr1            -- :: (a -> a -> a) -> [a] -> a
ross's avatar
ross committed
54
55
56
57
58

   -- ** Special folds

   , concat            -- :: [[a]] -> [a]
   , concatMap         -- :: (a -> [b]) -> [a] -> [b]
Don Stewart's avatar
Don Stewart committed
59
   , and               -- :: [Bool] -> Bool
ross's avatar
ross committed
60
61
62
63
64
65
66
67
68
69
70
   , or                -- :: [Bool] -> Bool
   , any               -- :: (a -> Bool) -> [a] -> Bool
   , all               -- :: (a -> Bool) -> [a] -> Bool
   , sum               -- :: (Num a) => [a] -> a
   , product           -- :: (Num a) => [a] -> a
   , maximum           -- :: (Ord a) => [a] -> a
   , minimum           -- :: (Ord a) => [a] -> a

   -- * Building lists

   -- ** Scans
71
   , scanl             -- :: (b -> a -> b) -> b -> [a] -> [b]
ross's avatar
ross committed
72
   , scanl1            -- :: (a -> a -> a) -> [a] -> [a]
73
74
   , scanr             -- :: (a -> b -> b) -> b -> [a] -> [b]
   , scanr1            -- :: (a -> a -> a) -> [a] -> [a]
ross's avatar
ross committed
75
76
77
78
79
80

   -- ** Accumulating maps
   , mapAccumL         -- :: (a -> b -> (a,c)) -> a -> [b] -> (a,[c])
   , mapAccumR         -- :: (a -> b -> (a,c)) -> a -> [b] -> (a,[c])

   -- ** Infinite lists
81
82
83
84
   , iterate           -- :: (a -> a) -> a -> [a]
   , repeat            -- :: a -> [a]
   , replicate         -- :: Int -> a -> [a]
   , cycle             -- :: [a] -> [a]
ross's avatar
ross committed
85
86

   -- ** Unfolding
Don Stewart's avatar
Don Stewart committed
87
   , unfoldr           -- :: (b -> Maybe (a, b)) -> b -> [a]
ross's avatar
ross committed
88
89
90
91

   -- * Sublists

   -- ** Extracting sublists
92
93
94
   , take              -- :: Int -> [a] -> [a]
   , drop              -- :: Int -> [a] -> [a]
   , splitAt           -- :: Int -> [a] -> ([a], [a])
ross's avatar
ross committed
95

96
97
   , takeWhile         -- :: (a -> Bool) -> [a] -> [a]
   , dropWhile         -- :: (a -> Bool) -> [a] -> [a]
98
   , dropWhileEnd      -- :: (a -> Bool) -> [a] -> [a]
99
100
101
   , span              -- :: (a -> Bool) -> [a] -> ([a], [a])
   , break             -- :: (a -> Bool) -> [a] -> ([a], [a])

102
103
   , stripPrefix       -- :: Eq a => [a] -> [a] -> Maybe [a]

ross's avatar
ross committed
104
105
106
107
108
109
110
111
   , group             -- :: Eq a => [a] -> [[a]]

   , inits             -- :: [a] -> [[a]]
   , tails             -- :: [a] -> [[a]]

   -- ** Predicates
   , isPrefixOf        -- :: (Eq a) => [a] -> [a] -> Bool
   , isSuffixOf        -- :: (Eq a) => [a] -> [a] -> Bool
112
   , isInfixOf         -- :: (Eq a) => [a] -> [a] -> Bool
ross's avatar
ross committed
113
114
115
116

   -- * Searching lists

   -- ** Searching by equality
117
118
119
   , elem              -- :: a -> [a] -> Bool
   , notElem           -- :: a -> [a] -> Bool
   , lookup            -- :: (Eq a) => a -> [(a,b)] -> Maybe b
ross's avatar
ross committed
120
121

   -- ** Searching with a predicate
Don Stewart's avatar
Don Stewart committed
122
123
   , find              -- :: (a -> Bool) -> [a] -> Maybe a
   , filter            -- :: (a -> Bool) -> [a] -> [a]
ross's avatar
ross committed
124
125
126
127
128
129
   , partition         -- :: (a -> Bool) -> [a] -> ([a], [a])

   -- * Indexing lists
   -- | These functions treat a list @xs@ as a indexed collection,
   -- with indices ranging from 0 to @'length' xs - 1@.

Don Stewart's avatar
Don Stewart committed
130
   , (!!)              -- :: [a] -> Int -> a
ross's avatar
ross committed
131

Don Stewart's avatar
Don Stewart committed
132
   , elemIndex         -- :: (Eq a) => a -> [a] -> Maybe Int
ross's avatar
ross committed
133
134
   , elemIndices       -- :: (Eq a) => a -> [a] -> [Int]

Don Stewart's avatar
Don Stewart committed
135
   , findIndex         -- :: (a -> Bool) -> [a] -> Maybe Int
ross's avatar
ross committed
136
137
138
139
   , findIndices       -- :: (a -> Bool) -> [a] -> [Int]

   -- * Zipping and unzipping lists

140
   , zip               -- :: [a] -> [b] -> [(a,b)]
Don Stewart's avatar
Don Stewart committed
141
   , zip3
ross's avatar
ross committed
142
143
   , zip4, zip5, zip6, zip7

144
145
   , zipWith           -- :: (a -> b -> c) -> [a] -> [b] -> [c]
   , zipWith3
ross's avatar
ross committed
146
147
   , zipWith4, zipWith5, zipWith6, zipWith7

148
149
   , unzip             -- :: [(a,b)] -> ([a],[b])
   , unzip3
ross's avatar
ross committed
150
151
152
153
154
   , unzip4, unzip5, unzip6, unzip7

   -- * Special lists

   -- ** Functions on strings
Don Stewart's avatar
Don Stewart committed
155
156
   , lines             -- :: String   -> [String]
   , words             -- :: String   -> [String]
ross's avatar
ross committed
157
158
159
160
   , unlines           -- :: [String] -> String
   , unwords           -- :: [String] -> String

   -- ** \"Set\" operations
Don Stewart's avatar
Don Stewart committed
161

ross's avatar
ross committed
162
163
164
165
   , nub               -- :: (Eq a) => [a] -> [a]

   , delete            -- :: (Eq a) => a -> [a] -> [a]
   , (\\)              -- :: (Eq a) => [a] -> [a] -> [a]
Don Stewart's avatar
Don Stewart committed
166

ross's avatar
ross committed
167
168
169
170
171
172
173
174
175
176
177
178
   , union             -- :: (Eq a) => [a] -> [a] -> [a]
   , intersect         -- :: (Eq a) => [a] -> [a] -> [a]

   -- ** Ordered lists
   , sort              -- :: (Ord a) => [a] -> [a]
   , insert            -- :: (Ord a) => a -> [a] -> [a]

   -- * Generalized functions

   -- ** The \"@By@\" operations
   -- | By convention, overloaded functions have a non-overloaded
   -- counterpart whose name is suffixed with \`@By@\'.
179
180
181
182
   --
   -- It is often convenient to use these functions together with
   -- 'Data.Function.on', for instance @'sortBy' ('compare'
   -- \`on\` 'fst')@.
ross's avatar
ross committed
183
184
185
186
187
188
189
190
191
192
193
194
195
196

   -- *** User-supplied equality (replacing an @Eq@ context)
   -- | The predicate is assumed to define an equivalence.
   , nubBy             -- :: (a -> a -> Bool) -> [a] -> [a]
   , deleteBy          -- :: (a -> a -> Bool) -> a -> [a] -> [a]
   , deleteFirstsBy    -- :: (a -> a -> Bool) -> [a] -> [a] -> [a]
   , unionBy           -- :: (a -> a -> Bool) -> [a] -> [a] -> [a]
   , intersectBy       -- :: (a -> a -> Bool) -> [a] -> [a] -> [a]
   , groupBy           -- :: (a -> a -> Bool) -> [a] -> [[a]]

   -- *** User-supplied comparison (replacing an @Ord@ context)
   -- | The function is assumed to define a total ordering.
   , sortBy            -- :: (a -> a -> Ordering) -> [a] -> [a]
   , insertBy          -- :: (a -> a -> Ordering) -> a -> [a] -> [a]
Don Stewart's avatar
Don Stewart committed
197
   , maximumBy         -- :: (a -> a -> Ordering) -> [a] -> a
ross's avatar
ross committed
198
199
200
201
202
203
204
205
206
207
208
209
   , minimumBy         -- :: (a -> a -> Ordering) -> [a] -> a

   -- ** The \"@generic@\" operations
   -- | The prefix \`@generic@\' indicates an overloaded function that
   -- is a generalized version of a "Prelude" function.

   , genericLength     -- :: (Integral a) => [b] -> a
   , genericTake       -- :: (Integral a) => a -> [b] -> [b]
   , genericDrop       -- :: (Integral a) => a -> [b] -> [b]
   , genericSplitAt    -- :: (Integral a) => a -> [b] -> ([b], [b])
   , genericIndex      -- :: (Integral a) => [b] -> a -> b
   , genericReplicate  -- :: (Integral a) => a -> b -> [b]
210
211
212

   ) where

213
#ifdef __NHC__
214
import Prelude
215
216
#endif

217
import Data.Maybe
Don Stewart's avatar
Don Stewart committed
218
import Data.Char        ( isSpace )
219
220
221
222
223
224
225
226

#ifdef __GLASGOW_HASKELL__
import GHC.Num
import GHC.Real
import GHC.List
import GHC.Base
#endif

227
infix 5 \\ -- comment to fool cpp
228
229
230
231

-- -----------------------------------------------------------------------------
-- List functions

232
233
234
235
236
237
238
239
240
241
-- | The 'dropWhileEnd' function drops the largest suffix of a list
-- in which the given predicate holds for all elements.  For example:
--
-- > dropWhileEnd isSpace "foo\n" == "foo"
-- > dropWhileEnd isSpace "foo bar" == "foo bar"
-- > dropWhileEnd isSpace ("foo\n" ++ undefined) == "foo" ++ undefined

dropWhileEnd :: (a -> Bool) -> [a] -> [a]
dropWhileEnd p = foldr (\x xs -> if p x && null xs then [] else x : xs) []

242
243
244
245
-- | The 'stripPrefix' function drops the given prefix from a list.
-- It returns 'Nothing' if the list did not start with the prefix
-- given, or 'Just' the list after the prefix, if it does.
--
246
247
248
249
-- > stripPrefix "foo" "foobar" == Just "bar"
-- > stripPrefix "foo" "foo" == Just ""
-- > stripPrefix "foo" "barfoo" == Nothing
-- > stripPrefix "foo" "barfoobaz" == Nothing
250
251
252
253
254
255
stripPrefix :: Eq a => [a] -> [a] -> Maybe [a]
stripPrefix [] ys = Just ys
stripPrefix (x:xs) (y:ys)
 | x == y = stripPrefix xs ys
stripPrefix _ _ = Nothing

ross's avatar
ross committed
256
257
258
-- | The 'elemIndex' function returns the index of the first element
-- in the given list which is equal (by '==') to the query element,
-- or 'Nothing' if there is no such element.
Don Stewart's avatar
Don Stewart committed
259
elemIndex       :: Eq a => a -> [a] -> Maybe Int
260
261
elemIndex x     = findIndex (x==)

ross's avatar
ross committed
262
263
-- | The 'elemIndices' function extends 'elemIndex', by returning the
-- indices of all elements equal to the query element, in ascending order.
264
265
266
elemIndices     :: Eq a => a -> [a] -> [Int]
elemIndices x   = findIndices (x==)

267
-- | The 'find' function takes a predicate and a list and returns the
ross's avatar
ross committed
268
269
-- first element in the list matching the predicate, or 'Nothing' if
-- there is no such element.
Don Stewart's avatar
Don Stewart committed
270
find            :: (a -> Bool) -> [a] -> Maybe a
271
272
find p          = listToMaybe . filter p

273
-- | The 'findIndex' function takes a predicate and a list and returns
ross's avatar
ross committed
274
275
-- the index of the first element in the list satisfying the predicate,
-- or 'Nothing' if there is no such element.
276
277
278
findIndex       :: (a -> Bool) -> [a] -> Maybe Int
findIndex p     = listToMaybe . findIndices p

ross's avatar
ross committed
279
280
-- | The 'findIndices' function extends 'findIndex', by returning the
-- indices of all elements satisfying the predicate, in ascending order.
281
282
findIndices      :: (a -> Bool) -> [a] -> [Int]

ross's avatar
ross committed
283
#if defined(USE_REPORT_PRELUDE) || !defined(__GLASGOW_HASKELL__)
284
285
286
287
findIndices p xs = [ i | (x,i) <- zip xs [0..], p x]
#else
-- Efficient definition
findIndices p ls = loop 0# ls
Don Stewart's avatar
Don Stewart committed
288
289
290
291
                 where
                   loop _ [] = []
                   loop n (x:xs) | p x       = I# n : loop (n +# 1#) xs
                                 | otherwise = loop (n +# 1#) xs
292
293
#endif  /* USE_REPORT_PRELUDE */

ross's avatar
ross committed
294
-- | The 'isPrefixOf' function takes two lists and returns 'True'
295
-- iff the first list is a prefix of the second.
296
297
298
299
300
isPrefixOf              :: (Eq a) => [a] -> [a] -> Bool
isPrefixOf [] _         =  True
isPrefixOf _  []        =  False
isPrefixOf (x:xs) (y:ys)=  x == y && isPrefixOf xs ys

ross's avatar
ross committed
301
302
303
-- | The 'isSuffixOf' function takes two lists and returns 'True'
-- iff the first list is a suffix of the second.
-- Both lists must be finite.
304
305
306
isSuffixOf              :: (Eq a) => [a] -> [a] -> Bool
isSuffixOf x y          =  reverse x `isPrefixOf` reverse y

307
308
309
310
311
312
-- | The 'isInfixOf' function takes two lists and returns 'True'
-- iff the first list is contained, wholly and intact,
-- anywhere within the second.
--
-- Example:
--
313
314
-- >isInfixOf "Haskell" "I really like Haskell." == True
-- >isInfixOf "Ial" "I really like Haskell." == False
315
isInfixOf               :: (Eq a) => [a] -> [a] -> Bool
316
isInfixOf needle haystack = any (isPrefixOf needle) (tails haystack)
317

318
-- | /O(n^2)/. The 'nub' function removes duplicate elements from a list.
ross's avatar
ross committed
319
320
321
322
-- In particular, it keeps only the first occurrence of each element.
-- (The name 'nub' means \`essence\'.)
-- It is a special case of 'nubBy', which allows the programmer to supply
-- their own equality test.
323
324
325
326
327
nub                     :: (Eq a) => [a] -> [a]
#ifdef USE_REPORT_PRELUDE
nub                     =  nubBy (==)
#else
-- stolen from HBC
Don Stewart's avatar
Don Stewart committed
328
nub l                   = nub' l []             -- '
329
  where
Don Stewart's avatar
Don Stewart committed
330
331
332
333
    nub' [] _           = []                    -- '
    nub' (x:xs) ls                              -- '
        | x `elem` ls   = nub' xs ls            -- '
        | otherwise     = x : nub' xs (x:ls)    -- '
334
335
#endif

336
-- | The 'nubBy' function behaves just like 'nub', except it uses a
ross's avatar
ross committed
337
-- user-supplied equality predicate instead of the overloaded '=='
338
-- function.
Don Stewart's avatar
Don Stewart committed
339
nubBy                   :: (a -> a -> Bool) -> [a] -> [a]
340
341
342
343
344
345
#ifdef USE_REPORT_PRELUDE
nubBy eq []             =  []
nubBy eq (x:xs)         =  x : nubBy eq (filter (\ y -> not (eq x y)) xs)
#else
nubBy eq l              = nubBy' l []
  where
Don Stewart's avatar
Don Stewart committed
346
    nubBy' [] _         = []
347
    nubBy' (y:ys) xs
Don Stewart's avatar
Don Stewart committed
348
349
       | elem_by eq y xs = nubBy' ys xs
       | otherwise       = y : nubBy' ys (y:xs)
350
351
352
353
354
355
356

-- Not exported:
-- Note that we keep the call to `eq` with arguments in the
-- same order as in the reference implementation
-- 'xs' is the list of things we've seen so far, 
-- 'y' is the potential new element
elem_by :: (a -> a -> Bool) -> a -> [a] -> Bool
Don Stewart's avatar
Don Stewart committed
357
elem_by _  _ []         =  False
358
elem_by eq y (x:xs)     =  y `eq` x || elem_by eq y xs
359
360
361
#endif


ross's avatar
ross committed
362
363
364
365
366
367
368
369
-- | 'delete' @x@ removes the first occurrence of @x@ from its list argument.
-- For example,
--
-- > delete 'a' "banana" == "bnana"
--
-- It is a special case of 'deleteBy', which allows the programmer to
-- supply their own equality test.

370
371
372
delete                  :: (Eq a) => a -> [a] -> [a]
delete                  =  deleteBy (==)

373
374
-- | The 'deleteBy' function behaves like 'delete', but takes a
-- user-supplied equality predicate.
375
376
377
378
deleteBy                :: (a -> a -> Bool) -> a -> [a] -> [a]
deleteBy _  _ []        = []
deleteBy eq x (y:ys)    = if x `eq` y then ys else y : deleteBy eq x ys

379
-- | The '\\' function is list difference (non-associative).
ross's avatar
ross committed
380
381
382
383
384
385
386
387
-- In the result of @xs@ '\\' @ys@, the first occurrence of each element of
-- @ys@ in turn (if any) has been removed from @xs@.  Thus
--
-- > (xs ++ ys) \\ xs == ys.
--
-- It is a special case of 'deleteFirstsBy', which allows the programmer
-- to supply their own equality test.

Don Stewart's avatar
Don Stewart committed
388
389
(\\)                    :: (Eq a) => [a] -> [a] -> [a]
(\\)                    =  foldl (flip delete)
390

391
-- | The 'union' function returns the list union of the two lists.
ross's avatar
ross committed
392
393
394
395
396
397
398
399
400
401
-- For example,
--
-- > "dog" `union` "cow" == "dogcw"
--
-- Duplicates, and elements of the first list, are removed from the
-- the second list, but if the first list contains duplicates, so will
-- the result.
-- It is a special case of 'unionBy', which allows the programmer to supply
-- their own equality test.

Don Stewart's avatar
Don Stewart committed
402
403
union                   :: (Eq a) => [a] -> [a] -> [a]
union                   = unionBy (==)
404

405
-- | The 'unionBy' function is the non-overloaded version of 'union'.
406
407
408
unionBy                 :: (a -> a -> Bool) -> [a] -> [a] -> [a]
unionBy eq xs ys        =  xs ++ foldl (flip (deleteBy eq)) (nubBy eq ys) xs

409
-- | The 'intersect' function takes the list intersection of two lists.
ross's avatar
ross committed
410
411
412
413
-- For example,
--
-- > [1,2,3,4] `intersect` [2,4,6,8] == [2,4]
--
414
-- If the first list contains duplicates, so will the result.
415
416
417
--
-- > [1,2,2,3,4] `intersect` [6,4,4,2] == [2,2,4]
--
ross's avatar
ross committed
418
-- It is a special case of 'intersectBy', which allows the programmer to
419
420
-- supply their own equality test. If the element is found in both the first
-- and the second list, the element from the first list will be used.
ross's avatar
ross committed
421

422
423
424
intersect               :: (Eq a) => [a] -> [a] -> [a]
intersect               =  intersectBy (==)

425
-- | The 'intersectBy' function is the non-overloaded version of 'intersect'.
426
intersectBy             :: (a -> a -> Bool) -> [a] -> [a] -> [a]
Daniel Fischer's avatar
Daniel Fischer committed
427
428
intersectBy _  [] _     =  []
intersectBy _  _  []    =  []
429
430
intersectBy eq xs ys    =  [x | x <- xs, any (eq x) ys]

ross's avatar
ross committed
431
432
433
434
435
436
-- | The 'intersperse' function takes an element and a list and
-- \`intersperses\' that element between the elements of the list.
-- For example,
--
-- > intersperse ',' "abcde" == "a,b,c,d,e"

Don Stewart's avatar
Don Stewart committed
437
intersperse             :: a -> [a] -> [a]
438
intersperse _   []      = []
Daniel Fischer's avatar
Daniel Fischer committed
439
440
441
442
443
444
445
446
447
448
intersperse sep (x:xs)  = x : prependToAll sep xs


-- Not exported:
-- We want to make every element in the 'intersperse'd list available
-- as soon as possible to avoid space leaks. Experiments suggested that
-- a separate top-level helper is more efficient than a local worker.
prependToAll            :: a -> [a] -> [a]
prependToAll _   []     = []
prependToAll sep (x:xs) = sep : x : prependToAll sep xs
449

450
451
452
453
454
455
-- | 'intercalate' @xs xss@ is equivalent to @('concat' ('intersperse' xs xss))@.
-- It inserts the list @xs@ in between the lists in @xss@ and concatenates the
-- result.
intercalate :: [a] -> [[a]] -> [a]
intercalate xs xss = concat (intersperse xs xss)

ross's avatar
ross committed
456
457
458
459
460
-- | The 'transpose' function transposes the rows and columns of its argument.
-- For example,
--
-- > transpose [[1,2,3],[4,5,6]] == [[1,4],[2,5],[3,6]]

Don Stewart's avatar
Don Stewart committed
461
462
463
transpose               :: [[a]] -> [[a]]
transpose []             = []
transpose ([]   : xss)   = transpose xss
Ian Lynagh's avatar
Ian Lynagh committed
464
transpose ((x:xs) : xss) = (x : [h | (h:_) <- xss]) : transpose (xs : [ t | (_:t) <- xss])
465
466


467
468
-- | The 'partition' function takes a predicate a list and returns
-- the pair of lists of elements which do and do not satisfy the
ross's avatar
ross committed
469
470
471
472
-- predicate, respectively; i.e.,
--
-- > partition p xs == (filter p xs, filter (not . p) xs)

Don Stewart's avatar
Don Stewart committed
473
partition               :: (a -> Bool) -> [a] -> ([a],[a])
474
475
476
{-# INLINE partition #-}
partition p xs = foldr (select p) ([],[]) xs

Ian Lynagh's avatar
Ian Lynagh committed
477
select :: (a -> Bool) -> a -> ([a], [a]) -> ([a], [a])
478
479
select p x ~(ts,fs) | p x       = (x:ts,fs)
                    | otherwise = (ts, x:fs)
480

481
-- | The 'mapAccumL' function behaves like a combination of 'map' and
ross's avatar
ross committed
482
483
484
-- 'foldl'; it applies a function to each element of a list, passing
-- an accumulating parameter from left to right, and returning a final
-- value of this accumulator together with the new list.
485
mapAccumL :: (acc -> x -> (acc, y)) -- Function of elt of input list
Don Stewart's avatar
Don Stewart committed
486
487
488
489
490
491
492
493
494
                                    -- and accumulator, returning new
                                    -- accumulator and elt of result list
          -> acc            -- Initial accumulator 
          -> [x]            -- Input list
          -> (acc, [y])     -- Final accumulator and result list
mapAccumL _ s []        =  (s, [])
mapAccumL f s (x:xs)    =  (s'',y:ys)
                           where (s', y ) = f s x
                                 (s'',ys) = mapAccumL f s' xs
495

496
-- | The 'mapAccumR' function behaves like a combination of 'map' and
ross's avatar
ross committed
497
498
499
-- 'foldr'; it applies a function to each element of a list, passing
-- an accumulating parameter from right to left, and returning a final
-- value of this accumulator together with the new list.
Don Stewart's avatar
Don Stewart committed
500
501
502
503
504
505
506
507
508
509
mapAccumR :: (acc -> x -> (acc, y))     -- Function of elt of input list
                                        -- and accumulator, returning new
                                        -- accumulator and elt of result list
            -> acc              -- Initial accumulator
            -> [x]              -- Input list
            -> (acc, [y])               -- Final accumulator and result list
mapAccumR _ s []        =  (s, [])
mapAccumR f s (x:xs)    =  (s'', y:ys)
                           where (s'',y ) = f s' x
                                 (s', ys) = mapAccumR f s xs
510

511
512
513
514
-- | The 'insert' function takes an element and a list and inserts the
-- element into the list at the last position where it is still less
-- than or equal to the next element.  In particular, if the list
-- is sorted before the call, the result will also be sorted.
ross's avatar
ross committed
515
516
-- It is a special case of 'insertBy', which allows the programmer to
-- supply their own comparison function.
517
518
519
insert :: Ord a => a -> [a] -> [a]
insert e ls = insertBy (compare) e ls

520
-- | The non-overloaded version of 'insert'.
521
522
523
524
525
526
527
insertBy :: (a -> a -> Ordering) -> a -> [a] -> [a]
insertBy _   x [] = [x]
insertBy cmp x ys@(y:ys')
 = case cmp x y of
     GT -> y : insertBy cmp x ys'
     _  -> x : ys

ross's avatar
ross committed
528
529
#ifdef __GLASGOW_HASKELL__

530
531
532
533
534
-- | 'maximum' returns the maximum value from a list,
-- which must be non-empty, finite, and of an ordered type.
-- It is a special case of 'Data.List.maximumBy', which allows the
-- programmer to supply their own comparison function.
maximum                 :: (Ord a) => [a] -> a
535
{-# NOINLINE [1] maximum #-}
536
537
538
maximum []              =  errorEmptyList "maximum"
maximum xs              =  foldl1 max xs

Don Stewart's avatar
Don Stewart committed
539
{-# RULES
540
541
542
  "maximumInt"     maximum = (strictMaximum :: [Int]     -> Int);
  "maximumInteger" maximum = (strictMaximum :: [Integer] -> Integer)
 #-}
543
544
545
546

-- We can't make the overloaded version of maximum strict without
-- changing its semantics (max might not be strict), but we can for
-- the version specialised to 'Int'.
Don Stewart's avatar
Don Stewart committed
547
strictMaximum           :: (Ord a) => [a] -> a
548
549
strictMaximum []        =  errorEmptyList "maximum"
strictMaximum xs        =  foldl1' max xs
550
551
552
553
554
555

-- | 'minimum' returns the minimum value from a list,
-- which must be non-empty, finite, and of an ordered type.
-- It is a special case of 'Data.List.minimumBy', which allows the
-- programmer to supply their own comparison function.
minimum                 :: (Ord a) => [a] -> a
556
{-# NOINLINE [1] minimum #-}
557
558
559
minimum []              =  errorEmptyList "minimum"
minimum xs              =  foldl1 min xs

560
561
562
563
{-# RULES
  "minimumInt"     minimum = (strictMinimum :: [Int]     -> Int);
  "minimumInteger" minimum = (strictMinimum :: [Integer] -> Integer)
 #-}
564

Don Stewart's avatar
Don Stewart committed
565
strictMinimum           :: (Ord a) => [a] -> a
566
567
strictMinimum []        =  errorEmptyList "minimum"
strictMinimum xs        =  foldl1' min xs
568

ross's avatar
ross committed
569
570
#endif /* __GLASGOW_HASKELL__ */

571
572
-- | The 'maximumBy' function takes a comparison function and a list
-- and returns the greatest element of the list by the comparison function.
ross's avatar
ross committed
573
-- The list must be finite and non-empty.
Don Stewart's avatar
Don Stewart committed
574
575
maximumBy               :: (a -> a -> Ordering) -> [a] -> a
maximumBy _ []          =  error "List.maximumBy: empty list"
Ian Lynagh's avatar
Ian Lynagh committed
576
maximumBy cmp xs        =  foldl1 maxBy xs
Don Stewart's avatar
Don Stewart committed
577
                        where
Ian Lynagh's avatar
Ian Lynagh committed
578
579
580
                           maxBy x y = case cmp x y of
                                       GT -> x
                                       _  -> y
581

582
583
-- | The 'minimumBy' function takes a comparison function and a list
-- and returns the least element of the list by the comparison function.
ross's avatar
ross committed
584
-- The list must be finite and non-empty.
Don Stewart's avatar
Don Stewart committed
585
586
minimumBy               :: (a -> a -> Ordering) -> [a] -> a
minimumBy _ []          =  error "List.minimumBy: empty list"
Ian Lynagh's avatar
Ian Lynagh committed
587
minimumBy cmp xs        =  foldl1 minBy xs
Don Stewart's avatar
Don Stewart committed
588
                        where
Ian Lynagh's avatar
Ian Lynagh committed
589
590
591
                           minBy x y = case cmp x y of
                                       GT -> y
                                       _  -> x
592

593
-- | The 'genericLength' function is an overloaded version of 'length'.  In
ross's avatar
ross committed
594
595
-- particular, instead of returning an 'Int', it returns any type which is
-- an instance of 'Num'.  It is, however, less efficient than 'length'.
596
genericLength           :: (Num i) => [b] -> i
597
{-# NOINLINE [1] genericLength #-}
598
599
600
genericLength []        =  0
genericLength (_:l)     =  1 + genericLength l

601
602
603
604
605
606
607
608
609
610
611
{-# RULES
  "genericLengthInt"     genericLength = (strictGenericLength :: [a] -> Int);
  "genericLengthInteger" genericLength = (strictGenericLength :: [a] -> Integer);
 #-}

strictGenericLength     :: (Num i) => [b] -> i
strictGenericLength l   =  gl l 0
                        where
                           gl [] a     = a
                           gl (_:xs) a = let a' = a + 1 in a' `seq` gl xs a'

612
-- | The 'genericTake' function is an overloaded version of 'take', which
ross's avatar
ross committed
613
-- accepts any 'Integral' value as the number of elements to take.
Don Stewart's avatar
Don Stewart committed
614
genericTake             :: (Integral i) => i -> [a] -> [a]
615
genericTake n _ | n <= 0 = []
616
genericTake _ []        =  []
617
genericTake n (x:xs)    =  x : genericTake (n-1) xs
618

619
-- | The 'genericDrop' function is an overloaded version of 'drop', which
ross's avatar
ross committed
620
-- accepts any 'Integral' value as the number of elements to drop.
Don Stewart's avatar
Don Stewart committed
621
genericDrop             :: (Integral i) => i -> [a] -> [a]
622
genericDrop n xs | n <= 0 = xs
623
genericDrop _ []        =  []
624
625
genericDrop n (_:xs)    =  genericDrop (n-1) xs

626

627
-- | The 'genericSplitAt' function is an overloaded version of 'splitAt', which
ross's avatar
ross committed
628
-- accepts any 'Integral' value as the position at which to split.
629
genericSplitAt          :: (Integral i) => i -> [b] -> ([b],[b])
630
genericSplitAt n xs | n <= 0 =  ([],xs)
631
genericSplitAt _ []     =  ([],[])
632
633
genericSplitAt n (x:xs) =  (x:xs',xs'') where
    (xs',xs'') = genericSplitAt (n-1) xs
634

ross's avatar
ross committed
635
636
-- | The 'genericIndex' function is an overloaded version of '!!', which
-- accepts any 'Integral' value as the index.
637
638
genericIndex :: (Integral a) => [b] -> a -> b
genericIndex (x:_)  0 = x
Don Stewart's avatar
Don Stewart committed
639
genericIndex (_:xs) n
640
641
642
643
 | n > 0     = genericIndex xs (n-1)
 | otherwise = error "List.genericIndex: negative argument."
genericIndex _ _      = error "List.genericIndex: index too large."

ross's avatar
ross committed
644
645
-- | The 'genericReplicate' function is an overloaded version of 'replicate',
-- which accepts any 'Integral' value as the number of repetitions to make.
Don Stewart's avatar
Don Stewart committed
646
647
genericReplicate        :: (Integral i) => i -> a -> [a]
genericReplicate n x    =  genericTake n (repeat x)
648

ross's avatar
ross committed
649
650
-- | The 'zip4' function takes four lists and returns a list of
-- quadruples, analogous to 'zip'.
Don Stewart's avatar
Don Stewart committed
651
652
zip4                    :: [a] -> [b] -> [c] -> [d] -> [(a,b,c,d)]
zip4                    =  zipWith4 (,,,)
653

ross's avatar
ross committed
654
655
-- | The 'zip5' function takes five lists and returns a list of
-- five-tuples, analogous to 'zip'.
Don Stewart's avatar
Don Stewart committed
656
657
zip5                    :: [a] -> [b] -> [c] -> [d] -> [e] -> [(a,b,c,d,e)]
zip5                    =  zipWith5 (,,,,)
658

ross's avatar
ross committed
659
660
-- | The 'zip6' function takes six lists and returns a list of six-tuples,
-- analogous to 'zip'.
Don Stewart's avatar
Don Stewart committed
661
zip6                    :: [a] -> [b] -> [c] -> [d] -> [e] -> [f] ->
662
                              [(a,b,c,d,e,f)]
Don Stewart's avatar
Don Stewart committed
663
zip6                    =  zipWith6 (,,,,,)
664

ross's avatar
ross committed
665
666
-- | The 'zip7' function takes seven lists and returns a list of
-- seven-tuples, analogous to 'zip'.
Don Stewart's avatar
Don Stewart committed
667
zip7                    :: [a] -> [b] -> [c] -> [d] -> [e] -> [f] ->
668
                              [g] -> [(a,b,c,d,e,f,g)]
Don Stewart's avatar
Don Stewart committed
669
zip7                    =  zipWith7 (,,,,,,)
670

ross's avatar
ross committed
671
672
673
-- | The 'zipWith4' function takes a function which combines four
-- elements, as well as four lists and returns a list of their point-wise
-- combination, analogous to 'zipWith'.
Don Stewart's avatar
Don Stewart committed
674
zipWith4                :: (a->b->c->d->e) -> [a]->[b]->[c]->[d]->[e]
675
zipWith4 z (a:as) (b:bs) (c:cs) (d:ds)
Don Stewart's avatar
Don Stewart committed
676
677
                        =  z a b c d : zipWith4 z as bs cs ds
zipWith4 _ _ _ _ _      =  []
678

ross's avatar
ross committed
679
680
681
-- | The 'zipWith5' function takes a function which combines five
-- elements, as well as five lists and returns a list of their point-wise
-- combination, analogous to 'zipWith'.
Don Stewart's avatar
Don Stewart committed
682
zipWith5                :: (a->b->c->d->e->f) ->
683
684
                           [a]->[b]->[c]->[d]->[e]->[f]
zipWith5 z (a:as) (b:bs) (c:cs) (d:ds) (e:es)
Don Stewart's avatar
Don Stewart committed
685
686
                        =  z a b c d e : zipWith5 z as bs cs ds es
zipWith5 _ _ _ _ _ _    = []
687

ross's avatar
ross committed
688
689
690
-- | The 'zipWith6' function takes a function which combines six
-- elements, as well as six lists and returns a list of their point-wise
-- combination, analogous to 'zipWith'.
Don Stewart's avatar
Don Stewart committed
691
zipWith6                :: (a->b->c->d->e->f->g) ->
692
693
                           [a]->[b]->[c]->[d]->[e]->[f]->[g]
zipWith6 z (a:as) (b:bs) (c:cs) (d:ds) (e:es) (f:fs)
Don Stewart's avatar
Don Stewart committed
694
695
                        =  z a b c d e f : zipWith6 z as bs cs ds es fs
zipWith6 _ _ _ _ _ _ _  = []
696

ross's avatar
ross committed
697
698
699
-- | The 'zipWith7' function takes a function which combines seven
-- elements, as well as seven lists and returns a list of their point-wise
-- combination, analogous to 'zipWith'.
Don Stewart's avatar
Don Stewart committed
700
zipWith7                :: (a->b->c->d->e->f->g->h) ->
701
702
                           [a]->[b]->[c]->[d]->[e]->[f]->[g]->[h]
zipWith7 z (a:as) (b:bs) (c:cs) (d:ds) (e:es) (f:fs) (g:gs)
Don Stewart's avatar
Don Stewart committed
703
                   =  z a b c d e f g : zipWith7 z as bs cs ds es fs gs
704
705
zipWith7 _ _ _ _ _ _ _ _ = []

ross's avatar
ross committed
706
707
-- | The 'unzip4' function takes a list of quadruples and returns four
-- lists, analogous to 'unzip'.
Don Stewart's avatar
Don Stewart committed
708
709
710
711
unzip4                  :: [(a,b,c,d)] -> ([a],[b],[c],[d])
unzip4                  =  foldr (\(a,b,c,d) ~(as,bs,cs,ds) ->
                                        (a:as,b:bs,c:cs,d:ds))
                                 ([],[],[],[])
712

ross's avatar
ross committed
713
714
-- | The 'unzip5' function takes a list of five-tuples and returns five
-- lists, analogous to 'unzip'.
Don Stewart's avatar
Don Stewart committed
715
716
717
718
unzip5                  :: [(a,b,c,d,e)] -> ([a],[b],[c],[d],[e])
unzip5                  =  foldr (\(a,b,c,d,e) ~(as,bs,cs,ds,es) ->
                                        (a:as,b:bs,c:cs,d:ds,e:es))
                                 ([],[],[],[],[])
719

ross's avatar
ross committed
720
721
-- | The 'unzip6' function takes a list of six-tuples and returns six
-- lists, analogous to 'unzip'.
Don Stewart's avatar
Don Stewart committed
722
723
724
725
unzip6                  :: [(a,b,c,d,e,f)] -> ([a],[b],[c],[d],[e],[f])
unzip6                  =  foldr (\(a,b,c,d,e,f) ~(as,bs,cs,ds,es,fs) ->
                                        (a:as,b:bs,c:cs,d:ds,e:es,f:fs))
                                 ([],[],[],[],[],[])
726

ross's avatar
ross committed
727
728
-- | The 'unzip7' function takes a list of seven-tuples and returns
-- seven lists, analogous to 'unzip'.
Don Stewart's avatar
Don Stewart committed
729
730
731
732
unzip7          :: [(a,b,c,d,e,f,g)] -> ([a],[b],[c],[d],[e],[f],[g])
unzip7          =  foldr (\(a,b,c,d,e,f,g) ~(as,bs,cs,ds,es,fs,gs) ->
                                (a:as,b:bs,c:cs,d:ds,e:es,f:fs,g:gs))
                         ([],[],[],[],[],[],[])
733
734


ross's avatar
ross committed
735
736
737
-- | The 'deleteFirstsBy' function takes a predicate and two lists and
-- returns the first list with the first occurrence of each element of
-- the second list removed.
738
739
740
deleteFirstsBy          :: (a -> a -> Bool) -> [a] -> [a] -> [a]
deleteFirstsBy eq       =  foldl (flip (deleteBy eq))

741
742
743
-- | The 'group' function takes a list and returns a list of lists such
-- that the concatenation of the result is equal to the argument.  Moreover,
-- each sublist in the result contains only equal elements.  For example,
ross's avatar
ross committed
744
745
746
747
748
--
-- > group "Mississippi" = ["M","i","ss","i","ss","i","pp","i"]
--
-- It is a special case of 'groupBy', which allows the programmer to supply
-- their own equality test.
Don Stewart's avatar
Don Stewart committed
749
group                   :: Eq a => [a] -> [[a]]
750
751
group                   =  groupBy (==)

752
-- | The 'groupBy' function is the non-overloaded version of 'group'.
Don Stewart's avatar
Don Stewart committed
753
754
755
groupBy                 :: (a -> a -> Bool) -> [a] -> [[a]]
groupBy _  []           =  []
groupBy eq (x:xs)       =  (x:ys) : groupBy eq zs
756
757
                           where (ys,zs) = span (eq x) xs

ross's avatar
ross committed
758
759
760
761
762
-- | The 'inits' function returns all initial segments of the argument,
-- shortest first.  For example,
--
-- > inits "abc" == ["","a","ab","abc"]
--
Ian Lynagh's avatar
Ian Lynagh committed
763
764
-- Note that 'inits' has the following strictness property:
-- @inits _|_ = [] : _|_@
Don Stewart's avatar
Don Stewart committed
765
inits                   :: [a] -> [[a]]
Ian Lynagh's avatar
Ian Lynagh committed
766
767
768
inits xs                =  [] : case xs of
                                  []      -> []
                                  x : xs' -> map (x :) (inits xs')
769

ross's avatar
ross committed
770
771
772
773
774
-- | The 'tails' function returns all final segments of the argument,
-- longest first.  For example,
--
-- > tails "abc" == ["abc", "bc", "c",""]
--
Ian Lynagh's avatar
Ian Lynagh committed
775
776
-- Note that 'tails' has the following strictness property:
-- @tails _|_ = _|_ : _|_@
Don Stewart's avatar
Don Stewart committed
777
tails                   :: [a] -> [[a]]
Ian Lynagh's avatar
Ian Lynagh committed
778
779
780
tails xs                =  xs : case xs of
                                  []      -> []
                                  _ : xs' -> tails xs'
781

782
783
-- | The 'subsequences' function returns the list of all subsequences of the argument.
--
784
-- > subsequences "abc" == ["","a","b","ab","c","ac","bc","abc"]
785
subsequences            :: [a] -> [[a]]
786
787
788
789
790
791
792
793
794
795
796
subsequences xs         =  [] : nonEmptySubsequences xs

-- | The 'nonEmptySubsequences' function returns the list of all subsequences of the argument,
--   except for the empty list.
--
-- > nonEmptySubsequences "abc" == ["a","b","ab","c","ac","bc","abc"]
nonEmptySubsequences         :: [a] -> [[a]]
nonEmptySubsequences []      =  []
nonEmptySubsequences (x:xs)  =  [x] : foldr f [] (nonEmptySubsequences xs)
  where f ys r = ys : (x : ys) : r

797
798
799

-- | The 'permutations' function returns the list of all permutations of the argument.
--
800
-- > permutations "abc" == ["abc","bac","cba","bca","cab","acb"]
801
permutations            :: [a] -> [[a]]
Ian Lynagh's avatar
Ian Lynagh committed
802
permutations xs0        =  xs0 : perms xs0 []
803
  where
Ian Lynagh's avatar
Ian Lynagh committed
804
    perms []     _  = []
805
806
    perms (t:ts) is = foldr interleave (perms ts (t:is)) (permutations is)
      where interleave    xs     r = let (_,zs) = interleave' id xs r in zs
Ian Lynagh's avatar
Ian Lynagh committed
807
            interleave' _ []     r = (ts, r)
808
809
            interleave' f (y:ys) r = let (us,zs) = interleave' (f . (y:)) ys r
                                     in  (y:us, f (t:y:us) : zs)
810
811


812
813
814
------------------------------------------------------------------------------
-- Quick Sort algorithm taken from HBC's QSort library.

ross's avatar
ross committed
815
816
817
-- | The 'sort' function implements a stable sorting algorithm.
-- It is a special case of 'sortBy', which allows the programmer to supply
-- their own comparison function.
818
sort :: (Ord a) => [a] -> [a]
ross's avatar
ross committed
819

820
-- | The 'sortBy' function is the non-overloaded version of 'sort'.
821
822
823
824
825
826
827
sortBy :: (a -> a -> Ordering) -> [a] -> [a]

#ifdef USE_REPORT_PRELUDE
sort = sortBy compare
sortBy cmp = foldr (insertBy cmp) []
#else

828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
{-
GHC's mergesort replaced by a better implementation, 24/12/2009.
This code originally contributed to the nhc12 compiler by Thomas Nordin
in 2002.  Rumoured to have been based on code by Lennart Augustsson, e.g.
    http://www.mail-archive.com/haskell@haskell.org/msg01822.html
and possibly to bear similarities to a 1982 paper by Richard O'Keefe:
"A smooth applicative merge sort".

Benchmarks show it to be often 2x the speed of the previous implementation.
Fixes ticket http://hackage.haskell.org/trac/ghc/ticket/2143
-}

sort = sortBy compare
sortBy cmp = mergeAll . sequences
  where
    sequences (a:b:xs)
      | a `cmp` b == GT = descending b [a]  xs
      | otherwise       = ascending  b (a:) xs
    sequences xs = [xs]

    descending a as (b:bs)
      | a `cmp` b == GT = descending b (a:as) bs
    descending a as bs  = (a:as): sequences bs

    ascending a as (b:bs)
      | a `cmp` b /= GT = ascending b (\ys -> as (a:ys)) bs
    ascending a as bs   = as [a]: sequences bs

    mergeAll [x] = x
    mergeAll xs  = mergeAll (mergePairs xs)

    mergePairs (a:b:xs) = merge a b: mergePairs xs
    mergePairs xs       = xs

    merge as@(a:as') bs@(b:bs')
      | a `cmp` b == GT = b:merge as  bs'
      | otherwise       = a:merge as' bs
    merge [] bs         = bs
    merge as []         = as

{-
869
870
sortBy cmp l = mergesort cmp l
sort l = mergesort compare l
871

872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
Quicksort replaced by mergesort, 14/5/2002.

From: Ian Lynagh <igloo@earth.li>

I am curious as to why the List.sort implementation in GHC is a
quicksort algorithm rather than an algorithm that guarantees n log n
time in the worst case? I have attached a mergesort implementation along
with a few scripts to time it's performance, the results of which are
shown below (* means it didn't finish successfully - in all cases this
was due to a stack overflow).

If I heap profile the random_list case with only 10000 then I see
random_list peaks at using about 2.5M of memory, whereas in the same
program using List.sort it uses only 100k.

Input style     Input length     Sort data     Sort alg    User time
stdin           10000            random_list   sort        2.82
stdin           10000            random_list   mergesort   2.96
stdin           10000            sorted        sort        31.37
stdin           10000            sorted        mergesort   1.90
stdin           10000            revsorted     sort        31.21
stdin           10000            revsorted     mergesort   1.88
stdin           100000           random_list   sort        *
stdin           100000           random_list   mergesort   *
stdin           100000           sorted        sort        *
stdin           100000           sorted        mergesort   *
stdin           100000           revsorted     sort        *
stdin           100000           revsorted     mergesort   *
func            10000            random_list   sort        0.31
func            10000            random_list   mergesort   0.91
func            10000            sorted        sort        19.09
func            10000            sorted        mergesort   0.15
func            10000            revsorted     sort        19.17
func            10000            revsorted     mergesort   0.16
func            100000           random_list   sort        3.85
func            100000           random_list   mergesort   *
func            100000           sorted        sort        5831.47
func            100000           sorted        mergesort   2.23
func            100000           revsorted     sort        5872.34
func            100000           revsorted     mergesort   2.24

mergesort :: (a -> a -> Ordering) -> [a] -> [a]
mergesort cmp = mergesort' cmp . map wrap

mergesort' :: (a -> a -> Ordering) -> [[a]] -> [a]
Ian Lynagh's avatar
Ian Lynagh committed
917
918
mergesort' _   [] = []
mergesort' _   [xs] = xs
919
920
921
mergesort' cmp xss = mergesort' cmp (merge_pairs cmp xss)

merge_pairs :: (a -> a -> Ordering) -> [[a]] -> [[a]]
Ian Lynagh's avatar
Ian Lynagh committed
922
923
merge_pairs _   [] = []
merge_pairs _   [xs] = [xs]
924
925
926
merge_pairs cmp (xs:ys:xss) = merge cmp xs ys : merge_pairs cmp xss

merge :: (a -> a -> Ordering) -> [a] -> [a] -> [a]
Ian Lynagh's avatar
Ian Lynagh committed
927
928
merge _   [] ys = ys
merge _   xs [] = xs
929
930
merge cmp (x:xs) (y:ys)
 = case x `cmp` y of
931
932
        GT -> y : merge cmp (x:xs)   ys
        _  -> x : merge cmp    xs (y:ys)
933
934
935
936

wrap :: a -> [a]
wrap x = [x]

937
938
939


OLDER: qsort version
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954

-- qsort is stable and does not concatenate.
qsort :: (a -> a -> Ordering) -> [a] -> [a] -> [a]
qsort _   []     r = r
qsort _   [x]    r = x:r
qsort cmp (x:xs) r = qpart cmp x xs [] [] r

-- qpart partitions and sorts the sublists
qpart :: (a -> a -> Ordering) -> a -> [a] -> [a] -> [a] -> [a] -> [a]
qpart cmp x [] rlt rge r =
    -- rlt and rge are in reverse order and must be sorted with an
    -- anti-stable sorting
    rqsort cmp rlt (x:rqsort cmp rge r)
qpart cmp x (y:ys) rlt rge r =
    case cmp x y of
Don Stewart's avatar
Don Stewart committed
955
        GT -> qpart cmp x ys (y:rlt) rge r
956
957
958
959
960
961
962
963
964
965
966
967
968
        _  -> qpart cmp x ys rlt (y:rge) r

-- rqsort is as qsort but anti-stable, i.e. reverses equal elements
rqsort :: (a -> a -> Ordering) -> [a] -> [a] -> [a]
rqsort _   []     r = r
rqsort _   [x]    r = x:r
rqsort cmp (x:xs) r = rqpart cmp x xs [] [] r

rqpart :: (a -> a -> Ordering) -> a -> [a] -> [a] -> [a] -> [a] -> [a]
rqpart cmp x [] rle rgt r =
    qsort cmp rle (x:qsort cmp rgt r)
rqpart cmp x (y:ys) rle rgt r =
    case cmp y x of
Don Stewart's avatar
Don Stewart committed
969
970
        GT -> rqpart cmp x ys rle (y:rgt) r
        _  -> rqpart cmp x ys (y:rle) rgt r
971
-}
972
973
974

#endif /* USE_REPORT_PRELUDE */

ross's avatar
ross committed
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
-- | The 'unfoldr' function is a \`dual\' to 'foldr': while 'foldr'
-- reduces a list to a summary value, 'unfoldr' builds a list from
-- a seed value.  The function takes the element and returns 'Nothing'
-- if it is done producing the list or returns 'Just' @(a,b)@, in which
-- case, @a@ is a prepended to the list and @b@ is used as the next
-- element in a recursive call.  For example,
--
-- > iterate f == unfoldr (\x -> Just (x, f x))
--
-- In some cases, 'unfoldr' can undo a 'foldr' operation:
--
-- > unfoldr f' (foldr f z xs) == xs
--
-- if the following holds:
--
-- > f' (f x y) = Just (x,y)
-- > f' z       = Nothing
992
993
994
995
996
997
--
-- A simple use of unfoldr:
--
-- > unfoldr (\b -> if b == 0 then Nothing else Just (b, b-1)) 10
-- >  [10,9,8,7,6,5,4,3,2,1]
--
998
999
1000
1001
1002
1003
unfoldr      :: (b -> Maybe (a, b)) -> b -> [a]
unfoldr f b  =
  case f b of
   Just (a,new_b) -> a : unfoldr f new_b
   Nothing        -> []

1004
1005
-- -----------------------------------------------------------------------------

ross's avatar
ross committed
1006
-- | A strict version of 'foldl'.
1007
foldl'           :: (b -> a -> b) -> b -> [a] -> b
1008
#ifdef __GLASGOW_HASKELL__
Ian Lynagh's avatar
Ian Lynagh committed
1009
foldl' f z0 xs0 = lgo z0 xs0
1010
1011
1012
    where lgo z []     = z
          lgo z (x:xs) = let z' = f z x in z' `seq` lgo z' xs
#else
1013
1014
foldl' f a []     = a
foldl' f a (x:xs) = let a' = f a x in a' `seq` foldl' f a' xs
1015
#endif
1016

ross's avatar
ross committed
1017
#ifdef __GLASGOW_HASKELL__
1018
1019
1020
1021
1022
-- | 'foldl1' is a variant of 'foldl' that has no starting value argument,
-- and thus must be applied to non-empty lists.
foldl1                  :: (a -> a -> a) -> [a] -> a
foldl1 f (x:xs)         =  foldl f x xs
foldl1 _ []             =  errorEmptyList "foldl1"
ross's avatar
ross committed
1023
#endif /* __GLASGOW_HASKELL__ */
1024
1025
1026
1027
1028
1029

-- | A strict version of 'foldl1'
foldl1'                  :: (a -> a -> a) -> [a] -> a
foldl1' f (x:xs)         =  foldl' f x xs
foldl1' _ []             =  errorEmptyList "foldl1'"

1030
#ifdef __GLASGOW_HASKELL__
1031
1032
1033
1034
1035
1036
1037
-- -----------------------------------------------------------------------------
-- List sum and product

{-# SPECIALISE sum     :: [Int] -> Int #-}
{-# SPECIALISE sum     :: [Integer] -> Integer #-}
{-# SPECIALISE product :: [Int] -> Int #-}
{-# SPECIALISE product :: [Integer] -> Integer #-}
ross's avatar
ross committed
1038
1039
1040
1041
-- | The 'sum' function computes the sum of a finite list of numbers.
sum                     :: (Num a) => [a] -> a
-- | The 'product' function computes the product of a finite list of numbers.
product                 :: (Num a) => [a] -> a
1042
#ifdef USE_REPORT_PRELUDE
Don Stewart's avatar
Don Stewart committed
1043
sum                     =  foldl (+) 0
1044
1045
product                 =  foldl (*) 1
#else
Don Stewart's avatar
Don Stewart committed
1046
sum     l       = sum' l 0
1047
1048
1049
  where
    sum' []     a = a
    sum' (x:xs) a = sum' xs (a+x)
Don Stewart's avatar
Don Stewart committed
1050
product l       = prod l 1
1051
1052
1053
1054
  where
    prod []     a = a
    prod (x:xs) a = prod xs (a*x)
#endif
1055
1056
1057
1058

-- -----------------------------------------------------------------------------
-- Functions on strings

ross's avatar
ross committed
1059
1060
-- | 'lines' breaks a string up into a list of strings at newline
-- characters.  The resulting strings do not contain newlines.
Don Stewart's avatar
Don Stewart committed
1061
1062
lines                   :: String -> [String]
lines ""                =  []
Daniel Fischer's avatar
Daniel Fischer committed
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
#ifdef __GLASGOW_HASKELL__
-- Somehow GHC doesn't detect the selector thunks in the below code,
-- so s' keeps a reference to the first line via the pair and we have
-- a space leak (cf. #4334).
-- So we need to make GHC see the selector thunks with a trick.
lines s                 =  cons (case break (== '\n') s of
                                    (l, s') -> (l, case s' of
                                                    []      -> []
                                                    _:s''   -> lines s''))
  where
    cons ~(h, t)        =  h : t
#else
Don Stewart's avatar
Don Stewart committed
1075
1076
1077
1078
lines s                 =  let (l, s') = break (== '\n') s
                           in  l : case s' of
                                        []      -> []
                                        (_:s'') -> lines s''
Daniel Fischer's avatar
Daniel Fischer committed
1079
#endif
1080

ross's avatar
ross committed
1081
1082
-- | 'unlines' is an inverse operation to 'lines'.
-- It joins lines, after appending a terminating newline to each.
Don Stewart's avatar
Don Stewart committed
1083
unlines                 :: [String] -> String
1084
#ifdef USE_REPORT_PRELUDE
Don Stewart's avatar
Don Stewart committed
1085
unlines                 =  concatMap (++ "\n")
1086
1087
1088
1089
1090
1091
1092
#else
-- HBC version (stolen)
-- here's a more efficient version
unlines [] = []
unlines (l:ls) = l ++ '\n' : unlines ls
#endif

ross's avatar
ross committed
1093
1094
-- | 'words' breaks a string up into a list of words, which were delimited
-- by white space.
Don Stewart's avatar
Don Stewart committed
1095
1096
1097
1098
1099
words                   :: String -> [String]
words s                 =  case dropWhile {-partain:Char.-}isSpace s of
                                "" -> []
                                s' -> w : words s''
                                      where (w, s'') =
1100
1101
                                             break {-partain:Char.-}isSpace s'

ross's avatar
ross committed
1102
1103
-- | 'unwords' is an inverse operation to 'words'.
-- It joins words with separating spaces.
Don Stewart's avatar
Don Stewart committed
1104
unwords                 :: [String] -> String
1105
#ifdef USE_REPORT_PRELUDE
Don Stewart's avatar
Don Stewart committed
1106
1107
unwords []              =  ""
unwords ws              =  foldr1 (\w s -> w ++ ' ':s) ws
1108
1109
1110
#else
-- HBC version (stolen)
-- here's a more efficient version
Don Stewart's avatar
Don Stewart committed
1111
1112
1113
unwords []              =  ""
unwords [w]             = w
unwords (w:ws)          = w ++ ' ' : unwords ws
1114
#endif
ross's avatar
ross committed
1115
1116
1117
1118
1119
1120
1121
1122

#else  /* !__GLASGOW_HASKELL__ */

errorEmptyList :: String -> a
errorEmptyList fun =
  error ("Prelude." ++ fun ++ ": empty list")

#endif /* !__GLASGOW_HASKELL__ */
dterei's avatar
dterei committed
1123