List.hs 38.7 KB
Newer Older
Ian Lynagh's avatar
Ian Lynagh committed
1
{-# OPTIONS_GHC -XNoImplicitPrelude #-}
2
-----------------------------------------------------------------------------
3
-- |
4
5
-- Module      :  Data.List
-- Copyright   :  (c) The University of Glasgow 2001
6
-- License     :  BSD-style (see the file libraries/base/LICENSE)
7
8
-- 
-- Maintainer  :  libraries@haskell.org
9
-- Stability   :  stable
10
11
12
13
14
15
16
-- Portability :  portable
--
-- Operations on lists.
--
-----------------------------------------------------------------------------

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

ross's avatar
ross committed
23
   -- * Basic functions
24

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

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

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

   -- * Reducing lists (folds)

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

   -- ** Special folds

   , concat            -- :: [[a]] -> [a]
   , concatMap         -- :: (a -> [b]) -> [a] -> [b]
Don Stewart's avatar
Don Stewart committed
57
   , and               -- :: [Bool] -> Bool
ross's avatar
ross committed
58
59
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
   , scanl             -- :: (a -> b -> a) -> a -> [b] -> [a]
   , scanl1            -- :: (a -> a -> a) -> [a] -> [a]
71
72
   , scanr             -- :: (a -> b -> b) -> b -> [a] -> [b]
   , scanr1            -- :: (a -> a -> a) -> [a] -> [a]
ross's avatar
ross committed
73
74
75
76
77
78

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

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

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

   -- * Sublists

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

94
95
96
97
98
   , takeWhile         -- :: (a -> Bool) -> [a] -> [a]
   , dropWhile         -- :: (a -> Bool) -> [a] -> [a]
   , span              -- :: (a -> Bool) -> [a] -> ([a], [a])
   , break             -- :: (a -> Bool) -> [a] -> ([a], [a])

99
100
   , stripPrefix       -- :: Eq a => [a] -> [a] -> Maybe [a]

ross's avatar
ross committed
101
102
103
104
105
106
107
108
   , group             -- :: Eq a => [a] -> [[a]]

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

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

   -- * Searching lists

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

   -- ** Searching with a predicate
Don Stewart's avatar
Don Stewart committed
119
120
   , find              -- :: (a -> Bool) -> [a] -> Maybe a
   , filter            -- :: (a -> Bool) -> [a] -> [a]
ross's avatar
ross committed
121
122
123
124
125
126
   , 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
127
   , (!!)              -- :: [a] -> Int -> a
ross's avatar
ross committed
128

Don Stewart's avatar
Don Stewart committed
129
   , elemIndex         -- :: (Eq a) => a -> [a] -> Maybe Int
ross's avatar
ross committed
130
131
   , elemIndices       -- :: (Eq a) => a -> [a] -> [Int]

Don Stewart's avatar
Don Stewart committed
132
   , findIndex         -- :: (a -> Bool) -> [a] -> Maybe Int
ross's avatar
ross committed
133
134
135
136
   , findIndices       -- :: (a -> Bool) -> [a] -> [Int]

   -- * Zipping and unzipping lists

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

141
142
   , zipWith           -- :: (a -> b -> c) -> [a] -> [b] -> [c]
   , zipWith3
ross's avatar
ross committed
143
144
   , zipWith4, zipWith5, zipWith6, zipWith7

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

   -- * Special lists

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

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

ross's avatar
ross committed
159
160
161
162
   , nub               -- :: (Eq a) => [a] -> [a]

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

ross's avatar
ross committed
164
165
166
167
168
169
170
171
172
173
174
175
   , 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@\'.
176
177
178
179
   --
   -- It is often convenient to use these functions together with
   -- 'Data.Function.on', for instance @'sortBy' ('compare'
   -- \`on\` 'fst')@.
ross's avatar
ross committed
180
181
182
183
184
185
186
187
188
189
190
191
192
193

   -- *** 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
194
   , maximumBy         -- :: (a -> a -> Ordering) -> [a] -> a
ross's avatar
ross committed
195
196
197
198
199
200
201
202
203
204
205
206
   , 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]
207
208
209

   ) where

210
#ifdef __NHC__
211
import Prelude
212
213
#endif

214
import Data.Maybe
Don Stewart's avatar
Don Stewart committed
215
import Data.Char        ( isSpace )
216
217
218
219
220
221
222
223

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

224
infix 5 \\ -- comment to fool cpp
225
226
227
228

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

229
230
231
232
233
234
235
236
237
238
239
240
241
242
-- | 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.
--
-- > stripPrefix "foo" "foobar" -> Just "bar"
-- > stripPrefix "foo" "foo" -> Just ""
-- > stripPrefix "foo" "barfoo" -> Nothing
-- > stripPrefix "foo" "barfoobaz" -> Nothing
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
243
244
245
-- | 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
246
elemIndex       :: Eq a => a -> [a] -> Maybe Int
247
248
elemIndex x     = findIndex (x==)

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

254
-- | The 'find' function takes a predicate and a list and returns the
ross's avatar
ross committed
255
256
-- first element in the list matching the predicate, or 'Nothing' if
-- there is no such element.
Don Stewart's avatar
Don Stewart committed
257
find            :: (a -> Bool) -> [a] -> Maybe a
258
259
find p          = listToMaybe . filter p

260
-- | The 'findIndex' function takes a predicate and a list and returns
ross's avatar
ross committed
261
262
-- the index of the first element in the list satisfying the predicate,
-- or 'Nothing' if there is no such element.
263
264
265
findIndex       :: (a -> Bool) -> [a] -> Maybe Int
findIndex p     = listToMaybe . findIndices p

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

ross's avatar
ross committed
270
#if defined(USE_REPORT_PRELUDE) || !defined(__GLASGOW_HASKELL__)
271
272
273
274
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
275
276
277
278
                 where
                   loop _ [] = []
                   loop n (x:xs) | p x       = I# n : loop (n +# 1#) xs
                                 | otherwise = loop (n +# 1#) xs
279
280
#endif  /* USE_REPORT_PRELUDE */

ross's avatar
ross committed
281
-- | The 'isPrefixOf' function takes two lists and returns 'True'
282
-- iff the first list is a prefix of the second.
283
284
285
286
287
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
288
289
290
-- | The 'isSuffixOf' function takes two lists and returns 'True'
-- iff the first list is a suffix of the second.
-- Both lists must be finite.
291
292
293
isSuffixOf              :: (Eq a) => [a] -> [a] -> Bool
isSuffixOf x y          =  reverse x `isPrefixOf` reverse y

294
295
296
297
298
299
300
301
302
-- | The 'isInfixOf' function takes two lists and returns 'True'
-- iff the first list is contained, wholly and intact,
-- anywhere within the second.
--
-- Example:
--
-- >isInfixOf "Haskell" "I really like Haskell." -> True
-- >isInfixOf "Ial" "I really like Haskell." -> False
isInfixOf               :: (Eq a) => [a] -> [a] -> Bool
303
isInfixOf needle haystack = any (isPrefixOf needle) (tails haystack)
304

ross's avatar
ross committed
305
306
307
308
309
-- | The 'nub' function removes duplicate elements from a list.
-- 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.
310
311
312
313
314
nub                     :: (Eq a) => [a] -> [a]
#ifdef USE_REPORT_PRELUDE
nub                     =  nubBy (==)
#else
-- stolen from HBC
Don Stewart's avatar
Don Stewart committed
315
nub l                   = nub' l []             -- '
316
  where
Don Stewart's avatar
Don Stewart committed
317
318
319
320
    nub' [] _           = []                    -- '
    nub' (x:xs) ls                              -- '
        | x `elem` ls   = nub' xs ls            -- '
        | otherwise     = x : nub' xs (x:ls)    -- '
321
322
#endif

323
-- | The 'nubBy' function behaves just like 'nub', except it uses a
ross's avatar
ross committed
324
-- user-supplied equality predicate instead of the overloaded '=='
325
-- function.
Don Stewart's avatar
Don Stewart committed
326
nubBy                   :: (a -> a -> Bool) -> [a] -> [a]
327
328
329
330
331
332
#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
333
    nubBy' [] _         = []
334
    nubBy' (y:ys) xs
Don Stewart's avatar
Don Stewart committed
335
336
       | elem_by eq y xs = nubBy' ys xs
       | otherwise       = y : nubBy' ys (y:xs)
337
338
339
340
341
342
343

-- 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
344
elem_by _  _ []         =  False
345
elem_by eq y (x:xs)     =  y `eq` x || elem_by eq y xs
346
347
348
#endif


ross's avatar
ross committed
349
350
351
352
353
354
355
356
-- | '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.

357
358
359
delete                  :: (Eq a) => a -> [a] -> [a]
delete                  =  deleteBy (==)

360
361
-- | The 'deleteBy' function behaves like 'delete', but takes a
-- user-supplied equality predicate.
362
363
364
365
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

ross's avatar
ross committed
366
367
368
369
370
371
372
373
374
-- | The '\\' function is list difference ((non-associative).
-- 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
375
376
(\\)                    :: (Eq a) => [a] -> [a] -> [a]
(\\)                    =  foldl (flip delete)
377

378
-- | The 'union' function returns the list union of the two lists.
ross's avatar
ross committed
379
380
381
382
383
384
385
386
387
388
-- 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
389
390
union                   :: (Eq a) => [a] -> [a] -> [a]
union                   = unionBy (==)
391

392
-- | The 'unionBy' function is the non-overloaded version of 'union'.
393
394
395
unionBy                 :: (a -> a -> Bool) -> [a] -> [a] -> [a]
unionBy eq xs ys        =  xs ++ foldl (flip (deleteBy eq)) (nubBy eq ys) xs

396
-- | The 'intersect' function takes the list intersection of two lists.
ross's avatar
ross committed
397
398
399
400
-- For example,
--
-- > [1,2,3,4] `intersect` [2,4,6,8] == [2,4]
--
401
-- If the first list contains duplicates, so will the result.
ross's avatar
ross committed
402
403
404
-- It is a special case of 'intersectBy', which allows the programmer to
-- supply their own equality test.

405
406
407
intersect               :: (Eq a) => [a] -> [a] -> [a]
intersect               =  intersectBy (==)

408
-- | The 'intersectBy' function is the non-overloaded version of 'intersect'.
409
410
411
intersectBy             :: (a -> a -> Bool) -> [a] -> [a] -> [a]
intersectBy eq xs ys    =  [x | x <- xs, any (eq x) ys]

ross's avatar
ross committed
412
413
414
415
416
417
-- | 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
418
intersperse             :: a -> [a] -> [a]
419
420
421
422
intersperse _   []      = []
intersperse _   [x]     = [x]
intersperse sep (x:xs)  = x : sep : intersperse sep xs

423
424
425
426
427
428
-- | '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
429
430
431
432
433
-- | 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
434
435
436
transpose               :: [[a]] -> [[a]]
transpose []             = []
transpose ([]   : xss)   = transpose xss
Ian Lynagh's avatar
Ian Lynagh committed
437
transpose ((x:xs) : xss) = (x : [h | (h:_) <- xss]) : transpose (xs : [ t | (_:t) <- xss])
438
439


440
441
-- | 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
442
443
444
445
-- predicate, respectively; i.e.,
--
-- > partition p xs == (filter p xs, filter (not . p) xs)

Don Stewart's avatar
Don Stewart committed
446
partition               :: (a -> Bool) -> [a] -> ([a],[a])
447
448
449
{-# INLINE partition #-}
partition p xs = foldr (select p) ([],[]) xs

Ian Lynagh's avatar
Ian Lynagh committed
450
select :: (a -> Bool) -> a -> ([a], [a]) -> ([a], [a])
451
452
select p x ~(ts,fs) | p x       = (x:ts,fs)
                    | otherwise = (ts, x:fs)
453

454
-- | The 'mapAccumL' function behaves like a combination of 'map' and
ross's avatar
ross committed
455
456
457
-- '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.
458
mapAccumL :: (acc -> x -> (acc, y)) -- Function of elt of input list
Don Stewart's avatar
Don Stewart committed
459
460
461
462
463
464
465
466
467
                                    -- 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
468

469
-- | The 'mapAccumR' function behaves like a combination of 'map' and
ross's avatar
ross committed
470
471
472
-- '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
473
474
475
476
477
478
479
480
481
482
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
483

484
485
486
487
-- | 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
488
489
-- It is a special case of 'insertBy', which allows the programmer to
-- supply their own comparison function.
490
491
492
insert :: Ord a => a -> [a] -> [a]
insert e ls = insertBy (compare) e ls

493
-- | The non-overloaded version of 'insert'.
494
495
496
497
498
499
500
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
501
502
#ifdef __GLASGOW_HASKELL__

503
504
505
506
507
508
509
510
-- | '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
maximum []              =  errorEmptyList "maximum"
maximum xs              =  foldl1 max xs

Don Stewart's avatar
Don Stewart committed
511
{-# RULES
512
513
514
  "maximumInt"     maximum = (strictMaximum :: [Int]     -> Int);
  "maximumInteger" maximum = (strictMaximum :: [Integer] -> Integer)
 #-}
515
516
517
518

-- 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
519
strictMaximum           :: (Ord a) => [a] -> a
520
521
strictMaximum []        =  errorEmptyList "maximum"
strictMaximum xs        =  foldl1' max xs
522
523
524
525
526
527
528
529
530

-- | '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
minimum []              =  errorEmptyList "minimum"
minimum xs              =  foldl1 min xs

531
532
533
534
{-# RULES
  "minimumInt"     minimum = (strictMinimum :: [Int]     -> Int);
  "minimumInteger" minimum = (strictMinimum :: [Integer] -> Integer)
 #-}
535

Don Stewart's avatar
Don Stewart committed
536
strictMinimum           :: (Ord a) => [a] -> a
537
538
strictMinimum []        =  errorEmptyList "minimum"
strictMinimum xs        =  foldl1' min xs
539

ross's avatar
ross committed
540
541
#endif /* __GLASGOW_HASKELL__ */

542
543
-- | 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
544
-- The list must be finite and non-empty.
Don Stewart's avatar
Don Stewart committed
545
546
maximumBy               :: (a -> a -> Ordering) -> [a] -> a
maximumBy _ []          =  error "List.maximumBy: empty list"
Ian Lynagh's avatar
Ian Lynagh committed
547
maximumBy cmp xs        =  foldl1 maxBy xs
Don Stewart's avatar
Don Stewart committed
548
                        where
Ian Lynagh's avatar
Ian Lynagh committed
549
550
551
                           maxBy x y = case cmp x y of
                                       GT -> x
                                       _  -> y
552

553
554
-- | 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
555
-- The list must be finite and non-empty.
Don Stewart's avatar
Don Stewart committed
556
557
minimumBy               :: (a -> a -> Ordering) -> [a] -> a
minimumBy _ []          =  error "List.minimumBy: empty list"
Ian Lynagh's avatar
Ian Lynagh committed
558
minimumBy cmp xs        =  foldl1 minBy xs
Don Stewart's avatar
Don Stewart committed
559
                        where
Ian Lynagh's avatar
Ian Lynagh committed
560
561
562
                           minBy x y = case cmp x y of
                                       GT -> y
                                       _  -> x
563

564
-- | The 'genericLength' function is an overloaded version of 'length'.  In
ross's avatar
ross committed
565
566
-- particular, instead of returning an 'Int', it returns any type which is
-- an instance of 'Num'.  It is, however, less efficient than 'length'.
567
568
569
570
genericLength           :: (Num i) => [b] -> i
genericLength []        =  0
genericLength (_:l)     =  1 + genericLength l

571
-- | The 'genericTake' function is an overloaded version of 'take', which
ross's avatar
ross committed
572
-- accepts any 'Integral' value as the number of elements to take.
Don Stewart's avatar
Don Stewart committed
573
genericTake             :: (Integral i) => i -> [a] -> [a]
574
575
576
577
578
genericTake 0 _         =  []
genericTake _ []        =  []
genericTake n (x:xs) | n > 0  =  x : genericTake (n-1) xs
genericTake _  _        =  error "List.genericTake: negative argument"

579
-- | The 'genericDrop' function is an overloaded version of 'drop', which
ross's avatar
ross committed
580
-- accepts any 'Integral' value as the number of elements to drop.
Don Stewart's avatar
Don Stewart committed
581
genericDrop             :: (Integral i) => i -> [a] -> [a]
582
583
584
genericDrop 0 xs        =  xs
genericDrop _ []        =  []
genericDrop n (_:xs) | n > 0  =  genericDrop (n-1) xs
Don Stewart's avatar
Don Stewart committed
585
genericDrop _ _         =  error "List.genericDrop: negative argument"
586

587
-- | The 'genericSplitAt' function is an overloaded version of 'splitAt', which
ross's avatar
ross committed
588
-- accepts any 'Integral' value as the position at which to split.
589
590
591
592
593
594
595
genericSplitAt          :: (Integral i) => i -> [b] -> ([b],[b])
genericSplitAt 0 xs     =  ([],xs)
genericSplitAt _ []     =  ([],[])
genericSplitAt n (x:xs) | n > 0  =  (x:xs',xs'') where
                               (xs',xs'') = genericSplitAt (n-1) xs
genericSplitAt _ _      =  error "List.genericSplitAt: negative argument"

ross's avatar
ross committed
596
597
-- | The 'genericIndex' function is an overloaded version of '!!', which
-- accepts any 'Integral' value as the index.
598
599
genericIndex :: (Integral a) => [b] -> a -> b
genericIndex (x:_)  0 = x
Don Stewart's avatar
Don Stewart committed
600
genericIndex (_:xs) n
601
602
603
604
 | n > 0     = genericIndex xs (n-1)
 | otherwise = error "List.genericIndex: negative argument."
genericIndex _ _      = error "List.genericIndex: index too large."

ross's avatar
ross committed
605
606
-- | 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
607
608
genericReplicate        :: (Integral i) => i -> a -> [a]
genericReplicate n x    =  genericTake n (repeat x)
609

ross's avatar
ross committed
610
611
-- | The 'zip4' function takes four lists and returns a list of
-- quadruples, analogous to 'zip'.
Don Stewart's avatar
Don Stewart committed
612
613
zip4                    :: [a] -> [b] -> [c] -> [d] -> [(a,b,c,d)]
zip4                    =  zipWith4 (,,,)
614

ross's avatar
ross committed
615
616
-- | The 'zip5' function takes five lists and returns a list of
-- five-tuples, analogous to 'zip'.
Don Stewart's avatar
Don Stewart committed
617
618
zip5                    :: [a] -> [b] -> [c] -> [d] -> [e] -> [(a,b,c,d,e)]
zip5                    =  zipWith5 (,,,,)
619

ross's avatar
ross committed
620
621
-- | The 'zip6' function takes six lists and returns a list of six-tuples,
-- analogous to 'zip'.
Don Stewart's avatar
Don Stewart committed
622
zip6                    :: [a] -> [b] -> [c] -> [d] -> [e] -> [f] ->
623
                              [(a,b,c,d,e,f)]
Don Stewart's avatar
Don Stewart committed
624
zip6                    =  zipWith6 (,,,,,)
625

ross's avatar
ross committed
626
627
-- | The 'zip7' function takes seven lists and returns a list of
-- seven-tuples, analogous to 'zip'.
Don Stewart's avatar
Don Stewart committed
628
zip7                    :: [a] -> [b] -> [c] -> [d] -> [e] -> [f] ->
629
                              [g] -> [(a,b,c,d,e,f,g)]
Don Stewart's avatar
Don Stewart committed
630
zip7                    =  zipWith7 (,,,,,,)
631

ross's avatar
ross committed
632
633
634
-- | 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
635
zipWith4                :: (a->b->c->d->e) -> [a]->[b]->[c]->[d]->[e]
636
zipWith4 z (a:as) (b:bs) (c:cs) (d:ds)
Don Stewart's avatar
Don Stewart committed
637
638
                        =  z a b c d : zipWith4 z as bs cs ds
zipWith4 _ _ _ _ _      =  []
639

ross's avatar
ross committed
640
641
642
-- | 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
643
zipWith5                :: (a->b->c->d->e->f) ->
644
645
                           [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
646
647
                        =  z a b c d e : zipWith5 z as bs cs ds es
zipWith5 _ _ _ _ _ _    = []
648

ross's avatar
ross committed
649
650
651
-- | 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
652
zipWith6                :: (a->b->c->d->e->f->g) ->
653
654
                           [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
655
656
                        =  z a b c d e f : zipWith6 z as bs cs ds es fs
zipWith6 _ _ _ _ _ _ _  = []
657

ross's avatar
ross committed
658
659
660
-- | 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
661
zipWith7                :: (a->b->c->d->e->f->g->h) ->
662
663
                           [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
664
                   =  z a b c d e f g : zipWith7 z as bs cs ds es fs gs
665
666
zipWith7 _ _ _ _ _ _ _ _ = []

ross's avatar
ross committed
667
668
-- | The 'unzip4' function takes a list of quadruples and returns four
-- lists, analogous to 'unzip'.
Don Stewart's avatar
Don Stewart committed
669
670
671
672
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))
                                 ([],[],[],[])
673

ross's avatar
ross committed
674
675
-- | The 'unzip5' function takes a list of five-tuples and returns five
-- lists, analogous to 'unzip'.
Don Stewart's avatar
Don Stewart committed
676
677
678
679
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))
                                 ([],[],[],[],[])
680

ross's avatar
ross committed
681
682
-- | The 'unzip6' function takes a list of six-tuples and returns six
-- lists, analogous to 'unzip'.
Don Stewart's avatar
Don Stewart committed
683
684
685
686
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))
                                 ([],[],[],[],[],[])
687

ross's avatar
ross committed
688
689
-- | The 'unzip7' function takes a list of seven-tuples and returns
-- seven lists, analogous to 'unzip'.
Don Stewart's avatar
Don Stewart committed
690
691
692
693
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))
                         ([],[],[],[],[],[],[])
694
695


ross's avatar
ross committed
696
697
698
-- | 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.
699
700
701
deleteFirstsBy          :: (a -> a -> Bool) -> [a] -> [a] -> [a]
deleteFirstsBy eq       =  foldl (flip (deleteBy eq))

702
703
704
-- | 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
705
706
707
708
709
--
-- > 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
710
group                   :: Eq a => [a] -> [[a]]
711
712
group                   =  groupBy (==)

713
-- | The 'groupBy' function is the non-overloaded version of 'group'.
Don Stewart's avatar
Don Stewart committed
714
715
716
groupBy                 :: (a -> a -> Bool) -> [a] -> [[a]]
groupBy _  []           =  []
groupBy eq (x:xs)       =  (x:ys) : groupBy eq zs
717
718
                           where (ys,zs) = span (eq x) xs

ross's avatar
ross committed
719
720
721
722
723
-- | The 'inits' function returns all initial segments of the argument,
-- shortest first.  For example,
--
-- > inits "abc" == ["","a","ab","abc"]
--
Don Stewart's avatar
Don Stewart committed
724
725
726
inits                   :: [a] -> [[a]]
inits []                =  [[]]
inits (x:xs)            =  [[]] ++ map (x:) (inits xs)
727

ross's avatar
ross committed
728
729
730
731
732
-- | The 'tails' function returns all final segments of the argument,
-- longest first.  For example,
--
-- > tails "abc" == ["abc", "bc", "c",""]
--
Don Stewart's avatar
Don Stewart committed
733
734
735
tails                   :: [a] -> [[a]]
tails []                =  [[]]
tails xxs@(_:xs)        =  xxs : tails xs
736
737


738
739
-- | The 'subsequences' function returns the list of all subsequences of the argument.
--
740
-- > subsequences "abc" == ["","a","b","ab","c","ac","bc","abc"]
741
subsequences            :: [a] -> [[a]]
742
743
744
745
746
747
748
749
750
751
752
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

753
754
755

-- | The 'permutations' function returns the list of all permutations of the argument.
--
756
-- > permutations "abc" == ["abc","bac","cba","bca","cab","acb"]
757
permutations            :: [a] -> [[a]]
Ian Lynagh's avatar
Ian Lynagh committed
758
permutations xs0        =  xs0 : perms xs0 []
759
  where
Ian Lynagh's avatar
Ian Lynagh committed
760
    perms []     _  = []
761
762
    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
763
            interleave' _ []     r = (ts, r)
764
765
            interleave' f (y:ys) r = let (us,zs) = interleave' (f . (y:)) ys r
                                     in  (y:us, f (t:y:us) : zs)
766
767


768
769
770
------------------------------------------------------------------------------
-- Quick Sort algorithm taken from HBC's QSort library.

ross's avatar
ross committed
771
772
773
-- | 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.
774
sort :: (Ord a) => [a] -> [a]
ross's avatar
ross committed
775

776
-- | The 'sortBy' function is the non-overloaded version of 'sort'.
777
778
779
780
781
782
783
sortBy :: (a -> a -> Ordering) -> [a] -> [a]

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

784
785
sortBy cmp l = mergesort cmp l
sort l = mergesort compare l
786

787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
{-
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
834
835
mergesort' _   [] = []
mergesort' _   [xs] = xs
836
837
838
mergesort' cmp xss = mergesort' cmp (merge_pairs cmp xss)

merge_pairs :: (a -> a -> Ordering) -> [[a]] -> [[a]]
Ian Lynagh's avatar
Ian Lynagh committed
839
840
merge_pairs _   [] = []
merge_pairs _   [xs] = [xs]
841
842
843
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
844
845
merge _   [] ys = ys
merge _   xs [] = xs
846
847
merge cmp (x:xs) (y:ys)
 = case x `cmp` y of
848
849
        GT -> y : merge cmp (x:xs)   ys
        _  -> x : merge cmp    xs (y:ys)
850
851
852
853
854
855

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

{-
OLD: qsort version
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870

-- 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
871
        GT -> qpart cmp x ys (y:rlt) rge r
872
873
874
875
876
877
878
879
880
881
882
883
884
        _  -> 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
885
886
        GT -> rqpart cmp x ys rle (y:rgt) r
        _  -> rqpart cmp x ys (y:rle) rgt r
887
-}
888
889
890

#endif /* USE_REPORT_PRELUDE */

ross's avatar
ross committed
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
-- | 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
908
909
910
911
912
913
--
-- 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]
--
914
915
916
917
918
919
unfoldr      :: (b -> Maybe (a, b)) -> b -> [a]
unfoldr f b  =
  case f b of
   Just (a,new_b) -> a : unfoldr f new_b
   Nothing        -> []

920
921
-- -----------------------------------------------------------------------------

ross's avatar
ross committed
922
-- | A strict version of 'foldl'.
923
foldl'           :: (a -> b -> a) -> a -> [b] -> a
924
#ifdef __GLASGOW_HASKELL__
Ian Lynagh's avatar
Ian Lynagh committed
925
foldl' f z0 xs0 = lgo z0 xs0
926
927
928
    where lgo z []     = z
          lgo z (x:xs) = let z' = f z x in z' `seq` lgo z' xs
#else
929
930
foldl' f a []     = a
foldl' f a (x:xs) = let a' = f a x in a' `seq` foldl' f a' xs
931
#endif
932

ross's avatar
ross committed
933
#ifdef __GLASGOW_HASKELL__
934
935
936
937
938
-- | '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
939
#endif /* __GLASGOW_HASKELL__ */
940
941
942
943
944
945

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

946
#ifdef __GLASGOW_HASKELL__
947
948
949
950
951
952
953
-- -----------------------------------------------------------------------------
-- 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
954
955
956
957
-- | 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
958
#ifdef USE_REPORT_PRELUDE
Don Stewart's avatar
Don Stewart committed
959
sum                     =  foldl (+) 0
960
961
product                 =  foldl (*) 1
#else
Don Stewart's avatar
Don Stewart committed
962
sum     l       = sum' l 0
963
964
965
  where
    sum' []     a = a
    sum' (x:xs) a = sum' xs (a+x)
Don Stewart's avatar
Don Stewart committed
966
product l       = prod l 1
967
968
969
970
  where
    prod []     a = a
    prod (x:xs) a = prod xs (a*x)
#endif
971
972
973
974

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

ross's avatar
ross committed
975
976
-- | '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
977
978
979
980
981
982
lines                   :: String -> [String]
lines ""                =  []
lines s                 =  let (l, s') = break (== '\n') s
                           in  l : case s' of
                                        []      -> []
                                        (_:s'') -> lines s''
983

ross's avatar
ross committed
984
985
-- | 'unlines' is an inverse operation to 'lines'.
-- It joins lines, after appending a terminating newline to each.
Don Stewart's avatar
Don Stewart committed
986
unlines                 :: [String] -> String
987
#ifdef USE_REPORT_PRELUDE
Don Stewart's avatar
Don Stewart committed
988
unlines                 =  concatMap (++ "\n")
989
990
991
992
993
994
995
#else
-- HBC version (stolen)
-- here's a more efficient version
unlines [] = []
unlines (l:ls) = l ++ '\n' : unlines ls
#endif

ross's avatar
ross committed
996
997
-- | 'words' breaks a string up into a list of words, which were delimited
-- by white space.
Don Stewart's avatar
Don Stewart committed
998
999
1000
1001
1002
words                   :: String -> [String]
words s                 =  case dropWhile {-partain:Char.-}isSpace s of
                                "" -> []
                                s' -> w : words s''
                                      where (w, s'') =
1003
1004
                                             break {-partain:Char.-}isSpace s'

ross's avatar
ross committed
1005
1006
-- | 'unwords' is an inverse operation to 'words'.
-- It joins words with separating spaces.
Don Stewart's avatar
Don Stewart committed
1007
unwords                 :: [String] -> String
1008
#ifdef USE_REPORT_PRELUDE
Don Stewart's avatar
Don Stewart committed
1009
1010
unwords []              =  ""
unwords ws              =  foldr1 (\w s -> w ++ ' ':s) ws
1011
1012
1013
#else
-- HBC version (stolen)
-- here's a more efficient version
Don Stewart's avatar
Don Stewart committed
1014
1015
1016
unwords []              =  ""
unwords [w]             = w
unwords (w:ws)          = w ++ ' ' : unwords ws
1017
#endif
ross's avatar
ross committed
1018
1019
1020
1021
1022
1023
1024
1025

#else  /* !__GLASGOW_HASKELL__ */

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

#endif /* !__GLASGOW_HASKELL__ */