Use explicit language extensions & remove extension fields from base.cabal
[packages/base.git] / Data / List.hs
1 {-# LANGUAGE CPP, NoImplicitPrelude, MagicHash #-}
2
3 -----------------------------------------------------------------------------
4 -- |
5 -- Module : Data.List
6 -- Copyright : (c) The University of Glasgow 2001
7 -- License : BSD-style (see the file libraries/base/LICENSE)
8 --
9 -- Maintainer : libraries@haskell.org
10 -- Stability : stable
11 -- Portability : portable
12 --
13 -- Operations on lists.
14 --
15 -----------------------------------------------------------------------------
16
17 module Data.List
18 (
19 #ifdef __NHC__
20 [] (..)
21 ,
22 #endif
23
24 -- * Basic functions
25
26 (++) -- :: [a] -> [a] -> [a]
27 , head -- :: [a] -> a
28 , last -- :: [a] -> a
29 , tail -- :: [a] -> [a]
30 , init -- :: [a] -> [a]
31 , null -- :: [a] -> Bool
32 , length -- :: [a] -> Int
33
34 -- * List transformations
35 , map -- :: (a -> b) -> [a] -> [b]
36 , reverse -- :: [a] -> [a]
37
38 , intersperse -- :: a -> [a] -> [a]
39 , intercalate -- :: [a] -> [[a]] -> [a]
40 , transpose -- :: [[a]] -> [[a]]
41
42 , subsequences -- :: [a] -> [[a]]
43 , permutations -- :: [a] -> [[a]]
44
45 -- * Reducing lists (folds)
46
47 , foldl -- :: (a -> b -> a) -> a -> [b] -> a
48 , foldl' -- :: (a -> b -> a) -> a -> [b] -> a
49 , foldl1 -- :: (a -> a -> a) -> [a] -> a
50 , foldl1' -- :: (a -> a -> a) -> [a] -> a
51 , foldr -- :: (a -> b -> b) -> b -> [a] -> b
52 , foldr1 -- :: (a -> a -> a) -> [a] -> a
53
54 -- ** Special folds
55
56 , concat -- :: [[a]] -> [a]
57 , concatMap -- :: (a -> [b]) -> [a] -> [b]
58 , and -- :: [Bool] -> Bool
59 , or -- :: [Bool] -> Bool
60 , any -- :: (a -> Bool) -> [a] -> Bool
61 , all -- :: (a -> Bool) -> [a] -> Bool
62 , sum -- :: (Num a) => [a] -> a
63 , product -- :: (Num a) => [a] -> a
64 , maximum -- :: (Ord a) => [a] -> a
65 , minimum -- :: (Ord a) => [a] -> a
66
67 -- * Building lists
68
69 -- ** Scans
70 , scanl -- :: (a -> b -> a) -> a -> [b] -> [a]
71 , scanl1 -- :: (a -> a -> a) -> [a] -> [a]
72 , scanr -- :: (a -> b -> b) -> b -> [a] -> [b]
73 , scanr1 -- :: (a -> a -> a) -> [a] -> [a]
74
75 -- ** Accumulating maps
76 , mapAccumL -- :: (a -> b -> (a,c)) -> a -> [b] -> (a,[c])
77 , mapAccumR -- :: (a -> b -> (a,c)) -> a -> [b] -> (a,[c])
78
79 -- ** Infinite lists
80 , iterate -- :: (a -> a) -> a -> [a]
81 , repeat -- :: a -> [a]
82 , replicate -- :: Int -> a -> [a]
83 , cycle -- :: [a] -> [a]
84
85 -- ** Unfolding
86 , unfoldr -- :: (b -> Maybe (a, b)) -> b -> [a]
87
88 -- * Sublists
89
90 -- ** Extracting sublists
91 , take -- :: Int -> [a] -> [a]
92 , drop -- :: Int -> [a] -> [a]
93 , splitAt -- :: Int -> [a] -> ([a], [a])
94
95 , takeWhile -- :: (a -> Bool) -> [a] -> [a]
96 , dropWhile -- :: (a -> Bool) -> [a] -> [a]
97 , span -- :: (a -> Bool) -> [a] -> ([a], [a])
98 , break -- :: (a -> Bool) -> [a] -> ([a], [a])
99
100 , stripPrefix -- :: Eq a => [a] -> [a] -> Maybe [a]
101
102 , group -- :: Eq a => [a] -> [[a]]
103
104 , inits -- :: [a] -> [[a]]
105 , tails -- :: [a] -> [[a]]
106
107 -- ** Predicates
108 , isPrefixOf -- :: (Eq a) => [a] -> [a] -> Bool
109 , isSuffixOf -- :: (Eq a) => [a] -> [a] -> Bool
110 , isInfixOf -- :: (Eq a) => [a] -> [a] -> Bool
111
112 -- * Searching lists
113
114 -- ** Searching by equality
115 , elem -- :: a -> [a] -> Bool
116 , notElem -- :: a -> [a] -> Bool
117 , lookup -- :: (Eq a) => a -> [(a,b)] -> Maybe b
118
119 -- ** Searching with a predicate
120 , find -- :: (a -> Bool) -> [a] -> Maybe a
121 , filter -- :: (a -> Bool) -> [a] -> [a]
122 , partition -- :: (a -> Bool) -> [a] -> ([a], [a])
123
124 -- * Indexing lists
125 -- | These functions treat a list @xs@ as a indexed collection,
126 -- with indices ranging from 0 to @'length' xs - 1@.
127
128 , (!!) -- :: [a] -> Int -> a
129
130 , elemIndex -- :: (Eq a) => a -> [a] -> Maybe Int
131 , elemIndices -- :: (Eq a) => a -> [a] -> [Int]
132
133 , findIndex -- :: (a -> Bool) -> [a] -> Maybe Int
134 , findIndices -- :: (a -> Bool) -> [a] -> [Int]
135
136 -- * Zipping and unzipping lists
137
138 , zip -- :: [a] -> [b] -> [(a,b)]
139 , zip3
140 , zip4, zip5, zip6, zip7
141
142 , zipWith -- :: (a -> b -> c) -> [a] -> [b] -> [c]
143 , zipWith3
144 , zipWith4, zipWith5, zipWith6, zipWith7
145
146 , unzip -- :: [(a,b)] -> ([a],[b])
147 , unzip3
148 , unzip4, unzip5, unzip6, unzip7
149
150 -- * Special lists
151
152 -- ** Functions on strings
153 , lines -- :: String -> [String]
154 , words -- :: String -> [String]
155 , unlines -- :: [String] -> String
156 , unwords -- :: [String] -> String
157
158 -- ** \"Set\" operations
159
160 , nub -- :: (Eq a) => [a] -> [a]
161
162 , delete -- :: (Eq a) => a -> [a] -> [a]
163 , (\\) -- :: (Eq a) => [a] -> [a] -> [a]
164
165 , union -- :: (Eq a) => [a] -> [a] -> [a]
166 , intersect -- :: (Eq a) => [a] -> [a] -> [a]
167
168 -- ** Ordered lists
169 , sort -- :: (Ord a) => [a] -> [a]
170 , insert -- :: (Ord a) => a -> [a] -> [a]
171
172 -- * Generalized functions
173
174 -- ** The \"@By@\" operations
175 -- | By convention, overloaded functions have a non-overloaded
176 -- counterpart whose name is suffixed with \`@By@\'.
177 --
178 -- It is often convenient to use these functions together with
179 -- 'Data.Function.on', for instance @'sortBy' ('compare'
180 -- \`on\` 'fst')@.
181
182 -- *** User-supplied equality (replacing an @Eq@ context)
183 -- | The predicate is assumed to define an equivalence.
184 , nubBy -- :: (a -> a -> Bool) -> [a] -> [a]
185 , deleteBy -- :: (a -> a -> Bool) -> a -> [a] -> [a]
186 , deleteFirstsBy -- :: (a -> a -> Bool) -> [a] -> [a] -> [a]
187 , unionBy -- :: (a -> a -> Bool) -> [a] -> [a] -> [a]
188 , intersectBy -- :: (a -> a -> Bool) -> [a] -> [a] -> [a]
189 , groupBy -- :: (a -> a -> Bool) -> [a] -> [[a]]
190
191 -- *** User-supplied comparison (replacing an @Ord@ context)
192 -- | The function is assumed to define a total ordering.
193 , sortBy -- :: (a -> a -> Ordering) -> [a] -> [a]
194 , insertBy -- :: (a -> a -> Ordering) -> a -> [a] -> [a]
195 , maximumBy -- :: (a -> a -> Ordering) -> [a] -> a
196 , minimumBy -- :: (a -> a -> Ordering) -> [a] -> a
197
198 -- ** The \"@generic@\" operations
199 -- | The prefix \`@generic@\' indicates an overloaded function that
200 -- is a generalized version of a "Prelude" function.
201
202 , genericLength -- :: (Integral a) => [b] -> a
203 , genericTake -- :: (Integral a) => a -> [b] -> [b]
204 , genericDrop -- :: (Integral a) => a -> [b] -> [b]
205 , genericSplitAt -- :: (Integral a) => a -> [b] -> ([b], [b])
206 , genericIndex -- :: (Integral a) => [b] -> a -> b
207 , genericReplicate -- :: (Integral a) => a -> b -> [b]
208
209 ) where
210
211 #ifdef __NHC__
212 import Prelude
213 #endif
214
215 import Data.Maybe
216 import Data.Char ( isSpace )
217
218 #ifdef __GLASGOW_HASKELL__
219 import GHC.Num
220 import GHC.Real
221 import GHC.List
222 import GHC.Base
223 #endif
224
225 infix 5 \\ -- comment to fool cpp
226
227 -- -----------------------------------------------------------------------------
228 -- List functions
229
230 -- | The 'stripPrefix' function drops the given prefix from a list.
231 -- It returns 'Nothing' if the list did not start with the prefix
232 -- given, or 'Just' the list after the prefix, if it does.
233 --
234 -- > stripPrefix "foo" "foobar" == Just "bar"
235 -- > stripPrefix "foo" "foo" == Just ""
236 -- > stripPrefix "foo" "barfoo" == Nothing
237 -- > stripPrefix "foo" "barfoobaz" == Nothing
238 stripPrefix :: Eq a => [a] -> [a] -> Maybe [a]
239 stripPrefix [] ys = Just ys
240 stripPrefix (x:xs) (y:ys)
241 | x == y = stripPrefix xs ys
242 stripPrefix _ _ = Nothing
243
244 -- | The 'elemIndex' function returns the index of the first element
245 -- in the given list which is equal (by '==') to the query element,
246 -- or 'Nothing' if there is no such element.
247 elemIndex :: Eq a => a -> [a] -> Maybe Int
248 elemIndex x = findIndex (x==)
249
250 -- | The 'elemIndices' function extends 'elemIndex', by returning the
251 -- indices of all elements equal to the query element, in ascending order.
252 elemIndices :: Eq a => a -> [a] -> [Int]
253 elemIndices x = findIndices (x==)
254
255 -- | The 'find' function takes a predicate and a list and returns the
256 -- first element in the list matching the predicate, or 'Nothing' if
257 -- there is no such element.
258 find :: (a -> Bool) -> [a] -> Maybe a
259 find p = listToMaybe . filter p
260
261 -- | The 'findIndex' function takes a predicate and a list and returns
262 -- the index of the first element in the list satisfying the predicate,
263 -- or 'Nothing' if there is no such element.
264 findIndex :: (a -> Bool) -> [a] -> Maybe Int
265 findIndex p = listToMaybe . findIndices p
266
267 -- | The 'findIndices' function extends 'findIndex', by returning the
268 -- indices of all elements satisfying the predicate, in ascending order.
269 findIndices :: (a -> Bool) -> [a] -> [Int]
270
271 #if defined(USE_REPORT_PRELUDE) || !defined(__GLASGOW_HASKELL__)
272 findIndices p xs = [ i | (x,i) <- zip xs [0..], p x]
273 #else
274 -- Efficient definition
275 findIndices p ls = loop 0# ls
276 where
277 loop _ [] = []
278 loop n (x:xs) | p x = I# n : loop (n +# 1#) xs
279 | otherwise = loop (n +# 1#) xs
280 #endif /* USE_REPORT_PRELUDE */
281
282 -- | The 'isPrefixOf' function takes two lists and returns 'True'
283 -- iff the first list is a prefix of the second.
284 isPrefixOf :: (Eq a) => [a] -> [a] -> Bool
285 isPrefixOf [] _ = True
286 isPrefixOf _ [] = False
287 isPrefixOf (x:xs) (y:ys)= x == y && isPrefixOf xs ys
288
289 -- | The 'isSuffixOf' function takes two lists and returns 'True'
290 -- iff the first list is a suffix of the second.
291 -- Both lists must be finite.
292 isSuffixOf :: (Eq a) => [a] -> [a] -> Bool
293 isSuffixOf x y = reverse x `isPrefixOf` reverse y
294
295 -- | The 'isInfixOf' function takes two lists and returns 'True'
296 -- iff the first list is contained, wholly and intact,
297 -- anywhere within the second.
298 --
299 -- Example:
300 --
301 -- >isInfixOf "Haskell" "I really like Haskell." == True
302 -- >isInfixOf "Ial" "I really like Haskell." == False
303 isInfixOf :: (Eq a) => [a] -> [a] -> Bool
304 isInfixOf needle haystack = any (isPrefixOf needle) (tails haystack)
305
306 -- | /O(n^2)/. The 'nub' function removes duplicate elements from a list.
307 -- In particular, it keeps only the first occurrence of each element.
308 -- (The name 'nub' means \`essence\'.)
309 -- It is a special case of 'nubBy', which allows the programmer to supply
310 -- their own equality test.
311 nub :: (Eq a) => [a] -> [a]
312 #ifdef USE_REPORT_PRELUDE
313 nub = nubBy (==)
314 #else
315 -- stolen from HBC
316 nub l = nub' l [] -- '
317 where
318 nub' [] _ = [] -- '
319 nub' (x:xs) ls -- '
320 | x `elem` ls = nub' xs ls -- '
321 | otherwise = x : nub' xs (x:ls) -- '
322 #endif
323
324 -- | The 'nubBy' function behaves just like 'nub', except it uses a
325 -- user-supplied equality predicate instead of the overloaded '=='
326 -- function.
327 nubBy :: (a -> a -> Bool) -> [a] -> [a]
328 #ifdef USE_REPORT_PRELUDE
329 nubBy eq [] = []
330 nubBy eq (x:xs) = x : nubBy eq (filter (\ y -> not (eq x y)) xs)
331 #else
332 nubBy eq l = nubBy' l []
333 where
334 nubBy' [] _ = []
335 nubBy' (y:ys) xs
336 | elem_by eq y xs = nubBy' ys xs
337 | otherwise = y : nubBy' ys (y:xs)
338
339 -- Not exported:
340 -- Note that we keep the call to `eq` with arguments in the
341 -- same order as in the reference implementation
342 -- 'xs' is the list of things we've seen so far,
343 -- 'y' is the potential new element
344 elem_by :: (a -> a -> Bool) -> a -> [a] -> Bool
345 elem_by _ _ [] = False
346 elem_by eq y (x:xs) = y `eq` x || elem_by eq y xs
347 #endif
348
349
350 -- | 'delete' @x@ removes the first occurrence of @x@ from its list argument.
351 -- For example,
352 --
353 -- > delete 'a' "banana" == "bnana"
354 --
355 -- It is a special case of 'deleteBy', which allows the programmer to
356 -- supply their own equality test.
357
358 delete :: (Eq a) => a -> [a] -> [a]
359 delete = deleteBy (==)
360
361 -- | The 'deleteBy' function behaves like 'delete', but takes a
362 -- user-supplied equality predicate.
363 deleteBy :: (a -> a -> Bool) -> a -> [a] -> [a]
364 deleteBy _ _ [] = []
365 deleteBy eq x (y:ys) = if x `eq` y then ys else y : deleteBy eq x ys
366
367 -- | The '\\' function is list difference ((non-associative).
368 -- In the result of @xs@ '\\' @ys@, the first occurrence of each element of
369 -- @ys@ in turn (if any) has been removed from @xs@. Thus
370 --
371 -- > (xs ++ ys) \\ xs == ys.
372 --
373 -- It is a special case of 'deleteFirstsBy', which allows the programmer
374 -- to supply their own equality test.
375
376 (\\) :: (Eq a) => [a] -> [a] -> [a]
377 (\\) = foldl (flip delete)
378
379 -- | The 'union' function returns the list union of the two lists.
380 -- For example,
381 --
382 -- > "dog" `union` "cow" == "dogcw"
383 --
384 -- Duplicates, and elements of the first list, are removed from the
385 -- the second list, but if the first list contains duplicates, so will
386 -- the result.
387 -- It is a special case of 'unionBy', which allows the programmer to supply
388 -- their own equality test.
389
390 union :: (Eq a) => [a] -> [a] -> [a]
391 union = unionBy (==)
392
393 -- | The 'unionBy' function is the non-overloaded version of 'union'.
394 unionBy :: (a -> a -> Bool) -> [a] -> [a] -> [a]
395 unionBy eq xs ys = xs ++ foldl (flip (deleteBy eq)) (nubBy eq ys) xs
396
397 -- | The 'intersect' function takes the list intersection of two lists.
398 -- For example,
399 --
400 -- > [1,2,3,4] `intersect` [2,4,6,8] == [2,4]
401 --
402 -- If the first list contains duplicates, so will the result.
403 --
404 -- > [1,2,2,3,4] `intersect` [6,4,4,2] == [2,2,4]
405 --
406 -- It is a special case of 'intersectBy', which allows the programmer to
407 -- supply their own equality test.
408
409 intersect :: (Eq a) => [a] -> [a] -> [a]
410 intersect = intersectBy (==)
411
412 -- | The 'intersectBy' function is the non-overloaded version of 'intersect'.
413 intersectBy :: (a -> a -> Bool) -> [a] -> [a] -> [a]
414 intersectBy _ [] _ = []
415 intersectBy _ _ [] = []
416 intersectBy eq xs ys = [x | x <- xs, any (eq x) ys]
417
418 -- | The 'intersperse' function takes an element and a list and
419 -- \`intersperses\' that element between the elements of the list.
420 -- For example,
421 --
422 -- > intersperse ',' "abcde" == "a,b,c,d,e"
423
424 intersperse :: a -> [a] -> [a]
425 intersperse _ [] = []
426 intersperse sep (x:xs) = x : prependToAll sep xs
427
428
429 -- Not exported:
430 -- We want to make every element in the 'intersperse'd list available
431 -- as soon as possible to avoid space leaks. Experiments suggested that
432 -- a separate top-level helper is more efficient than a local worker.
433 prependToAll :: a -> [a] -> [a]
434 prependToAll _ [] = []
435 prependToAll sep (x:xs) = sep : x : prependToAll sep xs
436
437 -- | 'intercalate' @xs xss@ is equivalent to @('concat' ('intersperse' xs xss))@.
438 -- It inserts the list @xs@ in between the lists in @xss@ and concatenates the
439 -- result.
440 intercalate :: [a] -> [[a]] -> [a]
441 intercalate xs xss = concat (intersperse xs xss)
442
443 -- | The 'transpose' function transposes the rows and columns of its argument.
444 -- For example,
445 --
446 -- > transpose [[1,2,3],[4,5,6]] == [[1,4],[2,5],[3,6]]
447
448 transpose :: [[a]] -> [[a]]
449 transpose [] = []
450 transpose ([] : xss) = transpose xss
451 transpose ((x:xs) : xss) = (x : [h | (h:_) <- xss]) : transpose (xs : [ t | (_:t) <- xss])
452
453
454 -- | The 'partition' function takes a predicate a list and returns
455 -- the pair of lists of elements which do and do not satisfy the
456 -- predicate, respectively; i.e.,
457 --
458 -- > partition p xs == (filter p xs, filter (not . p) xs)
459
460 partition :: (a -> Bool) -> [a] -> ([a],[a])
461 {-# INLINE partition #-}
462 partition p xs = foldr (select p) ([],[]) xs
463
464 select :: (a -> Bool) -> a -> ([a], [a]) -> ([a], [a])
465 select p x ~(ts,fs) | p x = (x:ts,fs)
466 | otherwise = (ts, x:fs)
467
468 -- | The 'mapAccumL' function behaves like a combination of 'map' and
469 -- 'foldl'; it applies a function to each element of a list, passing
470 -- an accumulating parameter from left to right, and returning a final
471 -- value of this accumulator together with the new list.
472 mapAccumL :: (acc -> x -> (acc, y)) -- Function of elt of input list
473 -- and accumulator, returning new
474 -- accumulator and elt of result list
475 -> acc -- Initial accumulator
476 -> [x] -- Input list
477 -> (acc, [y]) -- Final accumulator and result list
478 mapAccumL _ s [] = (s, [])
479 mapAccumL f s (x:xs) = (s'',y:ys)
480 where (s', y ) = f s x
481 (s'',ys) = mapAccumL f s' xs
482
483 -- | The 'mapAccumR' function behaves like a combination of 'map' and
484 -- 'foldr'; it applies a function to each element of a list, passing
485 -- an accumulating parameter from right to left, and returning a final
486 -- value of this accumulator together with the new list.
487 mapAccumR :: (acc -> x -> (acc, y)) -- Function of elt of input list
488 -- and accumulator, returning new
489 -- accumulator and elt of result list
490 -> acc -- Initial accumulator
491 -> [x] -- Input list
492 -> (acc, [y]) -- Final accumulator and result list
493 mapAccumR _ s [] = (s, [])
494 mapAccumR f s (x:xs) = (s'', y:ys)
495 where (s'',y ) = f s' x
496 (s', ys) = mapAccumR f s xs
497
498 -- | The 'insert' function takes an element and a list and inserts the
499 -- element into the list at the last position where it is still less
500 -- than or equal to the next element. In particular, if the list
501 -- is sorted before the call, the result will also be sorted.
502 -- It is a special case of 'insertBy', which allows the programmer to
503 -- supply their own comparison function.
504 insert :: Ord a => a -> [a] -> [a]
505 insert e ls = insertBy (compare) e ls
506
507 -- | The non-overloaded version of 'insert'.
508 insertBy :: (a -> a -> Ordering) -> a -> [a] -> [a]
509 insertBy _ x [] = [x]
510 insertBy cmp x ys@(y:ys')
511 = case cmp x y of
512 GT -> y : insertBy cmp x ys'
513 _ -> x : ys
514
515 #ifdef __GLASGOW_HASKELL__
516
517 -- | 'maximum' returns the maximum value from a list,
518 -- which must be non-empty, finite, and of an ordered type.
519 -- It is a special case of 'Data.List.maximumBy', which allows the
520 -- programmer to supply their own comparison function.
521 maximum :: (Ord a) => [a] -> a
522 maximum [] = errorEmptyList "maximum"
523 maximum xs = foldl1 max xs
524
525 {-# RULES
526 "maximumInt" maximum = (strictMaximum :: [Int] -> Int);
527 "maximumInteger" maximum = (strictMaximum :: [Integer] -> Integer)
528 #-}
529
530 -- We can't make the overloaded version of maximum strict without
531 -- changing its semantics (max might not be strict), but we can for
532 -- the version specialised to 'Int'.
533 strictMaximum :: (Ord a) => [a] -> a
534 strictMaximum [] = errorEmptyList "maximum"
535 strictMaximum xs = foldl1' max xs
536
537 -- | 'minimum' returns the minimum value from a list,
538 -- which must be non-empty, finite, and of an ordered type.
539 -- It is a special case of 'Data.List.minimumBy', which allows the
540 -- programmer to supply their own comparison function.
541 minimum :: (Ord a) => [a] -> a
542 minimum [] = errorEmptyList "minimum"
543 minimum xs = foldl1 min xs
544
545 {-# RULES
546 "minimumInt" minimum = (strictMinimum :: [Int] -> Int);
547 "minimumInteger" minimum = (strictMinimum :: [Integer] -> Integer)
548 #-}
549
550 strictMinimum :: (Ord a) => [a] -> a
551 strictMinimum [] = errorEmptyList "minimum"
552 strictMinimum xs = foldl1' min xs
553
554 #endif /* __GLASGOW_HASKELL__ */
555
556 -- | The 'maximumBy' function takes a comparison function and a list
557 -- and returns the greatest element of the list by the comparison function.
558 -- The list must be finite and non-empty.
559 maximumBy :: (a -> a -> Ordering) -> [a] -> a
560 maximumBy _ [] = error "List.maximumBy: empty list"
561 maximumBy cmp xs = foldl1 maxBy xs
562 where
563 maxBy x y = case cmp x y of
564 GT -> x
565 _ -> y
566
567 -- | The 'minimumBy' function takes a comparison function and a list
568 -- and returns the least element of the list by the comparison function.
569 -- The list must be finite and non-empty.
570 minimumBy :: (a -> a -> Ordering) -> [a] -> a
571 minimumBy _ [] = error "List.minimumBy: empty list"
572 minimumBy cmp xs = foldl1 minBy xs
573 where
574 minBy x y = case cmp x y of
575 GT -> y
576 _ -> x
577
578 -- | The 'genericLength' function is an overloaded version of 'length'. In
579 -- particular, instead of returning an 'Int', it returns any type which is
580 -- an instance of 'Num'. It is, however, less efficient than 'length'.
581 genericLength :: (Num i) => [b] -> i
582 genericLength [] = 0
583 genericLength (_:l) = 1 + genericLength l
584
585 {-# RULES
586 "genericLengthInt" genericLength = (strictGenericLength :: [a] -> Int);
587 "genericLengthInteger" genericLength = (strictGenericLength :: [a] -> Integer);
588 #-}
589
590 strictGenericLength :: (Num i) => [b] -> i
591 strictGenericLength l = gl l 0
592 where
593 gl [] a = a
594 gl (_:xs) a = let a' = a + 1 in a' `seq` gl xs a'
595
596 -- | The 'genericTake' function is an overloaded version of 'take', which
597 -- accepts any 'Integral' value as the number of elements to take.
598 genericTake :: (Integral i) => i -> [a] -> [a]
599 genericTake n _ | n <= 0 = []
600 genericTake _ [] = []
601 genericTake n (x:xs) = x : genericTake (n-1) xs
602
603 -- | The 'genericDrop' function is an overloaded version of 'drop', which
604 -- accepts any 'Integral' value as the number of elements to drop.
605 genericDrop :: (Integral i) => i -> [a] -> [a]
606 genericDrop n xs | n <= 0 = xs
607 genericDrop _ [] = []
608 genericDrop n (_:xs) = genericDrop (n-1) xs
609
610
611 -- | The 'genericSplitAt' function is an overloaded version of 'splitAt', which
612 -- accepts any 'Integral' value as the position at which to split.
613 genericSplitAt :: (Integral i) => i -> [b] -> ([b],[b])
614 genericSplitAt n xs | n <= 0 = ([],xs)
615 genericSplitAt _ [] = ([],[])
616 genericSplitAt n (x:xs) = (x:xs',xs'') where
617 (xs',xs'') = genericSplitAt (n-1) xs
618
619 -- | The 'genericIndex' function is an overloaded version of '!!', which
620 -- accepts any 'Integral' value as the index.
621 genericIndex :: (Integral a) => [b] -> a -> b
622 genericIndex (x:_) 0 = x
623 genericIndex (_:xs) n
624 | n > 0 = genericIndex xs (n-1)
625 | otherwise = error "List.genericIndex: negative argument."
626 genericIndex _ _ = error "List.genericIndex: index too large."
627
628 -- | The 'genericReplicate' function is an overloaded version of 'replicate',
629 -- which accepts any 'Integral' value as the number of repetitions to make.
630 genericReplicate :: (Integral i) => i -> a -> [a]
631 genericReplicate n x = genericTake n (repeat x)
632
633 -- | The 'zip4' function takes four lists and returns a list of
634 -- quadruples, analogous to 'zip'.
635 zip4 :: [a] -> [b] -> [c] -> [d] -> [(a,b,c,d)]
636 zip4 = zipWith4 (,,,)
637
638 -- | The 'zip5' function takes five lists and returns a list of
639 -- five-tuples, analogous to 'zip'.
640 zip5 :: [a] -> [b] -> [c] -> [d] -> [e] -> [(a,b,c,d,e)]
641 zip5 = zipWith5 (,,,,)
642
643 -- | The 'zip6' function takes six lists and returns a list of six-tuples,
644 -- analogous to 'zip'.
645 zip6 :: [a] -> [b] -> [c] -> [d] -> [e] -> [f] ->
646 [(a,b,c,d,e,f)]
647 zip6 = zipWith6 (,,,,,)
648
649 -- | The 'zip7' function takes seven lists and returns a list of
650 -- seven-tuples, analogous to 'zip'.
651 zip7 :: [a] -> [b] -> [c] -> [d] -> [e] -> [f] ->
652 [g] -> [(a,b,c,d,e,f,g)]
653 zip7 = zipWith7 (,,,,,,)
654
655 -- | The 'zipWith4' function takes a function which combines four
656 -- elements, as well as four lists and returns a list of their point-wise
657 -- combination, analogous to 'zipWith'.
658 zipWith4 :: (a->b->c->d->e) -> [a]->[b]->[c]->[d]->[e]
659 zipWith4 z (a:as) (b:bs) (c:cs) (d:ds)
660 = z a b c d : zipWith4 z as bs cs ds
661 zipWith4 _ _ _ _ _ = []
662
663 -- | The 'zipWith5' function takes a function which combines five
664 -- elements, as well as five lists and returns a list of their point-wise
665 -- combination, analogous to 'zipWith'.
666 zipWith5 :: (a->b->c->d->e->f) ->
667 [a]->[b]->[c]->[d]->[e]->[f]
668 zipWith5 z (a:as) (b:bs) (c:cs) (d:ds) (e:es)
669 = z a b c d e : zipWith5 z as bs cs ds es
670 zipWith5 _ _ _ _ _ _ = []
671
672 -- | The 'zipWith6' function takes a function which combines six
673 -- elements, as well as six lists and returns a list of their point-wise
674 -- combination, analogous to 'zipWith'.
675 zipWith6 :: (a->b->c->d->e->f->g) ->
676 [a]->[b]->[c]->[d]->[e]->[f]->[g]
677 zipWith6 z (a:as) (b:bs) (c:cs) (d:ds) (e:es) (f:fs)
678 = z a b c d e f : zipWith6 z as bs cs ds es fs
679 zipWith6 _ _ _ _ _ _ _ = []
680
681 -- | The 'zipWith7' function takes a function which combines seven
682 -- elements, as well as seven lists and returns a list of their point-wise
683 -- combination, analogous to 'zipWith'.
684 zipWith7 :: (a->b->c->d->e->f->g->h) ->
685 [a]->[b]->[c]->[d]->[e]->[f]->[g]->[h]
686 zipWith7 z (a:as) (b:bs) (c:cs) (d:ds) (e:es) (f:fs) (g:gs)
687 = z a b c d e f g : zipWith7 z as bs cs ds es fs gs
688 zipWith7 _ _ _ _ _ _ _ _ = []
689
690 -- | The 'unzip4' function takes a list of quadruples and returns four
691 -- lists, analogous to 'unzip'.
692 unzip4 :: [(a,b,c,d)] -> ([a],[b],[c],[d])
693 unzip4 = foldr (\(a,b,c,d) ~(as,bs,cs,ds) ->
694 (a:as,b:bs,c:cs,d:ds))
695 ([],[],[],[])
696
697 -- | The 'unzip5' function takes a list of five-tuples and returns five
698 -- lists, analogous to 'unzip'.
699 unzip5 :: [(a,b,c,d,e)] -> ([a],[b],[c],[d],[e])
700 unzip5 = foldr (\(a,b,c,d,e) ~(as,bs,cs,ds,es) ->
701 (a:as,b:bs,c:cs,d:ds,e:es))
702 ([],[],[],[],[])
703
704 -- | The 'unzip6' function takes a list of six-tuples and returns six
705 -- lists, analogous to 'unzip'.
706 unzip6 :: [(a,b,c,d,e,f)] -> ([a],[b],[c],[d],[e],[f])
707 unzip6 = foldr (\(a,b,c,d,e,f) ~(as,bs,cs,ds,es,fs) ->
708 (a:as,b:bs,c:cs,d:ds,e:es,f:fs))
709 ([],[],[],[],[],[])
710
711 -- | The 'unzip7' function takes a list of seven-tuples and returns
712 -- seven lists, analogous to 'unzip'.
713 unzip7 :: [(a,b,c,d,e,f,g)] -> ([a],[b],[c],[d],[e],[f],[g])
714 unzip7 = foldr (\(a,b,c,d,e,f,g) ~(as,bs,cs,ds,es,fs,gs) ->
715 (a:as,b:bs,c:cs,d:ds,e:es,f:fs,g:gs))
716 ([],[],[],[],[],[],[])
717
718
719 -- | The 'deleteFirstsBy' function takes a predicate and two lists and
720 -- returns the first list with the first occurrence of each element of
721 -- the second list removed.
722 deleteFirstsBy :: (a -> a -> Bool) -> [a] -> [a] -> [a]
723 deleteFirstsBy eq = foldl (flip (deleteBy eq))
724
725 -- | The 'group' function takes a list and returns a list of lists such
726 -- that the concatenation of the result is equal to the argument. Moreover,
727 -- each sublist in the result contains only equal elements. For example,
728 --
729 -- > group "Mississippi" = ["M","i","ss","i","ss","i","pp","i"]
730 --
731 -- It is a special case of 'groupBy', which allows the programmer to supply
732 -- their own equality test.
733 group :: Eq a => [a] -> [[a]]
734 group = groupBy (==)
735
736 -- | The 'groupBy' function is the non-overloaded version of 'group'.
737 groupBy :: (a -> a -> Bool) -> [a] -> [[a]]
738 groupBy _ [] = []
739 groupBy eq (x:xs) = (x:ys) : groupBy eq zs
740 where (ys,zs) = span (eq x) xs
741
742 -- | The 'inits' function returns all initial segments of the argument,
743 -- shortest first. For example,
744 --
745 -- > inits "abc" == ["","a","ab","abc"]
746 --
747 inits :: [a] -> [[a]]
748 inits [] = [[]]
749 inits (x:xs) = [[]] ++ map (x:) (inits xs)
750
751 -- | The 'tails' function returns all final segments of the argument,
752 -- longest first. For example,
753 --
754 -- > tails "abc" == ["abc", "bc", "c",""]
755 --
756 tails :: [a] -> [[a]]
757 tails [] = [[]]
758 tails xxs@(_:xs) = xxs : tails xs
759
760
761 -- | The 'subsequences' function returns the list of all subsequences of the argument.
762 --
763 -- > subsequences "abc" == ["","a","b","ab","c","ac","bc","abc"]
764 subsequences :: [a] -> [[a]]
765 subsequences xs = [] : nonEmptySubsequences xs
766
767 -- | The 'nonEmptySubsequences' function returns the list of all subsequences of the argument,
768 -- except for the empty list.
769 --
770 -- > nonEmptySubsequences "abc" == ["a","b","ab","c","ac","bc","abc"]
771 nonEmptySubsequences :: [a] -> [[a]]
772 nonEmptySubsequences [] = []
773 nonEmptySubsequences (x:xs) = [x] : foldr f [] (nonEmptySubsequences xs)
774 where f ys r = ys : (x : ys) : r
775
776
777 -- | The 'permutations' function returns the list of all permutations of the argument.
778 --
779 -- > permutations "abc" == ["abc","bac","cba","bca","cab","acb"]
780 permutations :: [a] -> [[a]]
781 permutations xs0 = xs0 : perms xs0 []
782 where
783 perms [] _ = []
784 perms (t:ts) is = foldr interleave (perms ts (t:is)) (permutations is)
785 where interleave xs r = let (_,zs) = interleave' id xs r in zs
786 interleave' _ [] r = (ts, r)
787 interleave' f (y:ys) r = let (us,zs) = interleave' (f . (y:)) ys r
788 in (y:us, f (t:y:us) : zs)
789
790
791 ------------------------------------------------------------------------------
792 -- Quick Sort algorithm taken from HBC's QSort library.
793
794 -- | The 'sort' function implements a stable sorting algorithm.
795 -- It is a special case of 'sortBy', which allows the programmer to supply
796 -- their own comparison function.
797 sort :: (Ord a) => [a] -> [a]
798
799 -- | The 'sortBy' function is the non-overloaded version of 'sort'.
800 sortBy :: (a -> a -> Ordering) -> [a] -> [a]
801
802 #ifdef USE_REPORT_PRELUDE
803 sort = sortBy compare
804 sortBy cmp = foldr (insertBy cmp) []
805 #else
806
807 {-
808 GHC's mergesort replaced by a better implementation, 24/12/2009.
809 This code originally contributed to the nhc12 compiler by Thomas Nordin
810 in 2002. Rumoured to have been based on code by Lennart Augustsson, e.g.
811 http://www.mail-archive.com/haskell@haskell.org/msg01822.html
812 and possibly to bear similarities to a 1982 paper by Richard O'Keefe:
813 "A smooth applicative merge sort".
814
815 Benchmarks show it to be often 2x the speed of the previous implementation.
816 Fixes ticket http://hackage.haskell.org/trac/ghc/ticket/2143
817 -}
818
819 sort = sortBy compare
820 sortBy cmp = mergeAll . sequences
821 where
822 sequences (a:b:xs)
823 | a `cmp` b == GT = descending b [a] xs
824 | otherwise = ascending b (a:) xs
825 sequences xs = [xs]
826
827 descending a as (b:bs)
828 | a `cmp` b == GT = descending b (a:as) bs
829 descending a as bs = (a:as): sequences bs
830
831 ascending a as (b:bs)
832 | a `cmp` b /= GT = ascending b (\ys -> as (a:ys)) bs
833 ascending a as bs = as [a]: sequences bs
834
835 mergeAll [x] = x
836 mergeAll xs = mergeAll (mergePairs xs)
837
838 mergePairs (a:b:xs) = merge a b: mergePairs xs
839 mergePairs xs = xs
840
841 merge as@(a:as') bs@(b:bs')
842 | a `cmp` b == GT = b:merge as bs'
843 | otherwise = a:merge as' bs
844 merge [] bs = bs
845 merge as [] = as
846
847 {-
848 sortBy cmp l = mergesort cmp l
849 sort l = mergesort compare l
850
851 Quicksort replaced by mergesort, 14/5/2002.
852
853 From: Ian Lynagh <igloo@earth.li>
854
855 I am curious as to why the List.sort implementation in GHC is a
856 quicksort algorithm rather than an algorithm that guarantees n log n
857 time in the worst case? I have attached a mergesort implementation along
858 with a few scripts to time it's performance, the results of which are
859 shown below (* means it didn't finish successfully - in all cases this
860 was due to a stack overflow).
861
862 If I heap profile the random_list case with only 10000 then I see
863 random_list peaks at using about 2.5M of memory, whereas in the same
864 program using List.sort it uses only 100k.
865
866 Input style Input length Sort data Sort alg User time
867 stdin 10000 random_list sort 2.82
868 stdin 10000 random_list mergesort 2.96
869 stdin 10000 sorted sort 31.37
870 stdin 10000 sorted mergesort 1.90
871 stdin 10000 revsorted sort 31.21
872 stdin 10000 revsorted mergesort 1.88
873 stdin 100000 random_list sort *
874 stdin 100000 random_list mergesort *
875 stdin 100000 sorted sort *
876 stdin 100000 sorted mergesort *
877 stdin 100000 revsorted sort *
878 stdin 100000 revsorted mergesort *
879 func 10000 random_list sort 0.31
880 func 10000 random_list mergesort 0.91
881 func 10000 sorted sort 19.09
882 func 10000 sorted mergesort 0.15
883 func 10000 revsorted sort 19.17
884 func 10000 revsorted mergesort 0.16
885 func 100000 random_list sort 3.85
886 func 100000 random_list mergesort *
887 func 100000 sorted sort 5831.47
888 func 100000 sorted mergesort 2.23
889 func 100000 revsorted sort 5872.34
890 func 100000 revsorted mergesort 2.24
891
892 mergesort :: (a -> a -> Ordering) -> [a] -> [a]
893 mergesort cmp = mergesort' cmp . map wrap
894
895 mergesort' :: (a -> a -> Ordering) -> [[a]] -> [a]
896 mergesort' _ [] = []
897 mergesort' _ [xs] = xs
898 mergesort' cmp xss = mergesort' cmp (merge_pairs cmp xss)
899
900 merge_pairs :: (a -> a -> Ordering) -> [[a]] -> [[a]]
901 merge_pairs _ [] = []
902 merge_pairs _ [xs] = [xs]
903 merge_pairs cmp (xs:ys:xss) = merge cmp xs ys : merge_pairs cmp xss
904
905 merge :: (a -> a -> Ordering) -> [a] -> [a] -> [a]
906 merge _ [] ys = ys
907 merge _ xs [] = xs
908 merge cmp (x:xs) (y:ys)
909 = case x `cmp` y of
910 GT -> y : merge cmp (x:xs) ys
911 _ -> x : merge cmp xs (y:ys)
912
913 wrap :: a -> [a]
914 wrap x = [x]
915
916
917
918 OLDER: qsort version
919
920 -- qsort is stable and does not concatenate.
921 qsort :: (a -> a -> Ordering) -> [a] -> [a] -> [a]
922 qsort _ [] r = r
923 qsort _ [x] r = x:r
924 qsort cmp (x:xs) r = qpart cmp x xs [] [] r
925
926 -- qpart partitions and sorts the sublists
927 qpart :: (a -> a -> Ordering) -> a -> [a] -> [a] -> [a] -> [a] -> [a]
928 qpart cmp x [] rlt rge r =
929 -- rlt and rge are in reverse order and must be sorted with an
930 -- anti-stable sorting
931 rqsort cmp rlt (x:rqsort cmp rge r)
932 qpart cmp x (y:ys) rlt rge r =
933 case cmp x y of
934 GT -> qpart cmp x ys (y:rlt) rge r
935 _ -> qpart cmp x ys rlt (y:rge) r
936
937 -- rqsort is as qsort but anti-stable, i.e. reverses equal elements
938 rqsort :: (a -> a -> Ordering) -> [a] -> [a] -> [a]
939 rqsort _ [] r = r
940 rqsort _ [x] r = x:r
941 rqsort cmp (x:xs) r = rqpart cmp x xs [] [] r
942
943 rqpart :: (a -> a -> Ordering) -> a -> [a] -> [a] -> [a] -> [a] -> [a]
944 rqpart cmp x [] rle rgt r =
945 qsort cmp rle (x:qsort cmp rgt r)
946 rqpart cmp x (y:ys) rle rgt r =
947 case cmp y x of
948 GT -> rqpart cmp x ys rle (y:rgt) r
949 _ -> rqpart cmp x ys (y:rle) rgt r
950 -}
951
952 #endif /* USE_REPORT_PRELUDE */
953
954 -- | The 'unfoldr' function is a \`dual\' to 'foldr': while 'foldr'
955 -- reduces a list to a summary value, 'unfoldr' builds a list from
956 -- a seed value. The function takes the element and returns 'Nothing'
957 -- if it is done producing the list or returns 'Just' @(a,b)@, in which
958 -- case, @a@ is a prepended to the list and @b@ is used as the next
959 -- element in a recursive call. For example,
960 --
961 -- > iterate f == unfoldr (\x -> Just (x, f x))
962 --
963 -- In some cases, 'unfoldr' can undo a 'foldr' operation:
964 --
965 -- > unfoldr f' (foldr f z xs) == xs
966 --
967 -- if the following holds:
968 --
969 -- > f' (f x y) = Just (x,y)
970 -- > f' z = Nothing
971 --
972 -- A simple use of unfoldr:
973 --
974 -- > unfoldr (\b -> if b == 0 then Nothing else Just (b, b-1)) 10
975 -- > [10,9,8,7,6,5,4,3,2,1]
976 --
977 unfoldr :: (b -> Maybe (a, b)) -> b -> [a]
978 unfoldr f b =
979 case f b of
980 Just (a,new_b) -> a : unfoldr f new_b
981 Nothing -> []
982
983 -- -----------------------------------------------------------------------------
984
985 -- | A strict version of 'foldl'.
986 foldl' :: (a -> b -> a) -> a -> [b] -> a
987 #ifdef __GLASGOW_HASKELL__
988 foldl' f z0 xs0 = lgo z0 xs0
989 where lgo z [] = z
990 lgo z (x:xs) = let z' = f z x in z' `seq` lgo z' xs
991 #else
992 foldl' f a [] = a
993 foldl' f a (x:xs) = let a' = f a x in a' `seq` foldl' f a' xs
994 #endif
995
996 #ifdef __GLASGOW_HASKELL__
997 -- | 'foldl1' is a variant of 'foldl' that has no starting value argument,
998 -- and thus must be applied to non-empty lists.
999 foldl1 :: (a -> a -> a) -> [a] -> a
1000 foldl1 f (x:xs) = foldl f x xs
1001 foldl1 _ [] = errorEmptyList "foldl1"
1002 #endif /* __GLASGOW_HASKELL__ */
1003
1004 -- | A strict version of 'foldl1'
1005 foldl1' :: (a -> a -> a) -> [a] -> a
1006 foldl1' f (x:xs) = foldl' f x xs
1007 foldl1' _ [] = errorEmptyList "foldl1'"
1008
1009 #ifdef __GLASGOW_HASKELL__
1010 -- -----------------------------------------------------------------------------
1011 -- List sum and product
1012
1013 {-# SPECIALISE sum :: [Int] -> Int #-}
1014 {-# SPECIALISE sum :: [Integer] -> Integer #-}
1015 {-# SPECIALISE product :: [Int] -> Int #-}
1016 {-# SPECIALISE product :: [Integer] -> Integer #-}
1017 -- | The 'sum' function computes the sum of a finite list of numbers.
1018 sum :: (Num a) => [a] -> a
1019 -- | The 'product' function computes the product of a finite list of numbers.
1020 product :: (Num a) => [a] -> a
1021 #ifdef USE_REPORT_PRELUDE
1022 sum = foldl (+) 0
1023 product = foldl (*) 1
1024 #else
1025 sum l = sum' l 0
1026 where
1027 sum' [] a = a
1028 sum' (x:xs) a = sum' xs (a+x)
1029 product l = prod l 1
1030 where
1031 prod [] a = a
1032 prod (x:xs) a = prod xs (a*x)
1033 #endif
1034
1035 -- -----------------------------------------------------------------------------
1036 -- Functions on strings
1037
1038 -- | 'lines' breaks a string up into a list of strings at newline
1039 -- characters. The resulting strings do not contain newlines.
1040 lines :: String -> [String]
1041 lines "" = []
1042 #ifdef __GLASGOW_HASKELL__
1043 -- Somehow GHC doesn't detect the selector thunks in the below code,
1044 -- so s' keeps a reference to the first line via the pair and we have
1045 -- a space leak (cf. #4334).
1046 -- So we need to make GHC see the selector thunks with a trick.
1047 lines s = cons (case break (== '\n') s of
1048 (l, s') -> (l, case s' of
1049 [] -> []
1050 _:s'' -> lines s''))
1051 where
1052 cons ~(h, t) = h : t
1053 #else
1054 lines s = let (l, s') = break (== '\n') s
1055 in l : case s' of
1056 [] -> []
1057 (_:s'') -> lines s''
1058 #endif
1059
1060 -- | 'unlines' is an inverse operation to 'lines'.
1061 -- It joins lines, after appending a terminating newline to each.
1062 unlines :: [String] -> String
1063 #ifdef USE_REPORT_PRELUDE
1064 unlines = concatMap (++ "\n")
1065 #else
1066 -- HBC version (stolen)
1067 -- here's a more efficient version
1068 unlines [] = []
1069 unlines (l:ls) = l ++ '\n' : unlines ls
1070 #endif
1071
1072 -- | 'words' breaks a string up into a list of words, which were delimited
1073 -- by white space.
1074 words :: String -> [String]
1075 words s = case dropWhile {-partain:Char.-}isSpace s of
1076 "" -> []
1077 s' -> w : words s''
1078 where (w, s'') =
1079 break {-partain:Char.-}isSpace s'
1080
1081 -- | 'unwords' is an inverse operation to 'words'.
1082 -- It joins words with separating spaces.
1083 unwords :: [String] -> String
1084 #ifdef USE_REPORT_PRELUDE
1085 unwords [] = ""
1086 unwords ws = foldr1 (\w s -> w ++ ' ':s) ws
1087 #else
1088 -- HBC version (stolen)
1089 -- here's a more efficient version
1090 unwords [] = ""
1091 unwords [w] = w
1092 unwords (w:ws) = w ++ ' ' : unwords ws
1093 #endif
1094
1095 #else /* !__GLASGOW_HASKELL__ */
1096
1097 errorEmptyList :: String -> a
1098 errorEmptyList fun =
1099 error ("Prelude." ++ fun ++ ": empty list")
1100
1101 #endif /* !__GLASGOW_HASKELL__ */