Less strict inits and tails
[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 -- Note that 'inits' has the following strictness property:
748 -- @inits _|_ = [] : _|_@
749 inits :: [a] -> [[a]]
750 inits xs = [] : case xs of
751 [] -> []
752 x : xs' -> map (x :) (inits xs')
753
754 -- | The 'tails' function returns all final segments of the argument,
755 -- longest first. For example,
756 --
757 -- > tails "abc" == ["abc", "bc", "c",""]
758 --
759 -- Note that 'tails' has the following strictness property:
760 -- @tails _|_ = _|_ : _|_@
761 tails :: [a] -> [[a]]
762 tails xs = xs : case xs of
763 [] -> []
764 _ : xs' -> tails xs'
765
766 -- | The 'subsequences' function returns the list of all subsequences of the argument.
767 --
768 -- > subsequences "abc" == ["","a","b","ab","c","ac","bc","abc"]
769 subsequences :: [a] -> [[a]]
770 subsequences xs = [] : nonEmptySubsequences xs
771
772 -- | The 'nonEmptySubsequences' function returns the list of all subsequences of the argument,
773 -- except for the empty list.
774 --
775 -- > nonEmptySubsequences "abc" == ["a","b","ab","c","ac","bc","abc"]
776 nonEmptySubsequences :: [a] -> [[a]]
777 nonEmptySubsequences [] = []
778 nonEmptySubsequences (x:xs) = [x] : foldr f [] (nonEmptySubsequences xs)
779 where f ys r = ys : (x : ys) : r
780
781
782 -- | The 'permutations' function returns the list of all permutations of the argument.
783 --
784 -- > permutations "abc" == ["abc","bac","cba","bca","cab","acb"]
785 permutations :: [a] -> [[a]]
786 permutations xs0 = xs0 : perms xs0 []
787 where
788 perms [] _ = []
789 perms (t:ts) is = foldr interleave (perms ts (t:is)) (permutations is)
790 where interleave xs r = let (_,zs) = interleave' id xs r in zs
791 interleave' _ [] r = (ts, r)
792 interleave' f (y:ys) r = let (us,zs) = interleave' (f . (y:)) ys r
793 in (y:us, f (t:y:us) : zs)
794
795
796 ------------------------------------------------------------------------------
797 -- Quick Sort algorithm taken from HBC's QSort library.
798
799 -- | The 'sort' function implements a stable sorting algorithm.
800 -- It is a special case of 'sortBy', which allows the programmer to supply
801 -- their own comparison function.
802 sort :: (Ord a) => [a] -> [a]
803
804 -- | The 'sortBy' function is the non-overloaded version of 'sort'.
805 sortBy :: (a -> a -> Ordering) -> [a] -> [a]
806
807 #ifdef USE_REPORT_PRELUDE
808 sort = sortBy compare
809 sortBy cmp = foldr (insertBy cmp) []
810 #else
811
812 {-
813 GHC's mergesort replaced by a better implementation, 24/12/2009.
814 This code originally contributed to the nhc12 compiler by Thomas Nordin
815 in 2002. Rumoured to have been based on code by Lennart Augustsson, e.g.
816 http://www.mail-archive.com/haskell@haskell.org/msg01822.html
817 and possibly to bear similarities to a 1982 paper by Richard O'Keefe:
818 "A smooth applicative merge sort".
819
820 Benchmarks show it to be often 2x the speed of the previous implementation.
821 Fixes ticket http://hackage.haskell.org/trac/ghc/ticket/2143
822 -}
823
824 sort = sortBy compare
825 sortBy cmp = mergeAll . sequences
826 where
827 sequences (a:b:xs)
828 | a `cmp` b == GT = descending b [a] xs
829 | otherwise = ascending b (a:) xs
830 sequences xs = [xs]
831
832 descending a as (b:bs)
833 | a `cmp` b == GT = descending b (a:as) bs
834 descending a as bs = (a:as): sequences bs
835
836 ascending a as (b:bs)
837 | a `cmp` b /= GT = ascending b (\ys -> as (a:ys)) bs
838 ascending a as bs = as [a]: sequences bs
839
840 mergeAll [x] = x
841 mergeAll xs = mergeAll (mergePairs xs)
842
843 mergePairs (a:b:xs) = merge a b: mergePairs xs
844 mergePairs xs = xs
845
846 merge as@(a:as') bs@(b:bs')
847 | a `cmp` b == GT = b:merge as bs'
848 | otherwise = a:merge as' bs
849 merge [] bs = bs
850 merge as [] = as
851
852 {-
853 sortBy cmp l = mergesort cmp l
854 sort l = mergesort compare l
855
856 Quicksort replaced by mergesort, 14/5/2002.
857
858 From: Ian Lynagh <igloo@earth.li>
859
860 I am curious as to why the List.sort implementation in GHC is a
861 quicksort algorithm rather than an algorithm that guarantees n log n
862 time in the worst case? I have attached a mergesort implementation along
863 with a few scripts to time it's performance, the results of which are
864 shown below (* means it didn't finish successfully - in all cases this
865 was due to a stack overflow).
866
867 If I heap profile the random_list case with only 10000 then I see
868 random_list peaks at using about 2.5M of memory, whereas in the same
869 program using List.sort it uses only 100k.
870
871 Input style Input length Sort data Sort alg User time
872 stdin 10000 random_list sort 2.82
873 stdin 10000 random_list mergesort 2.96
874 stdin 10000 sorted sort 31.37
875 stdin 10000 sorted mergesort 1.90
876 stdin 10000 revsorted sort 31.21
877 stdin 10000 revsorted mergesort 1.88
878 stdin 100000 random_list sort *
879 stdin 100000 random_list mergesort *
880 stdin 100000 sorted sort *
881 stdin 100000 sorted mergesort *
882 stdin 100000 revsorted sort *
883 stdin 100000 revsorted mergesort *
884 func 10000 random_list sort 0.31
885 func 10000 random_list mergesort 0.91
886 func 10000 sorted sort 19.09
887 func 10000 sorted mergesort 0.15
888 func 10000 revsorted sort 19.17
889 func 10000 revsorted mergesort 0.16
890 func 100000 random_list sort 3.85
891 func 100000 random_list mergesort *
892 func 100000 sorted sort 5831.47
893 func 100000 sorted mergesort 2.23
894 func 100000 revsorted sort 5872.34
895 func 100000 revsorted mergesort 2.24
896
897 mergesort :: (a -> a -> Ordering) -> [a] -> [a]
898 mergesort cmp = mergesort' cmp . map wrap
899
900 mergesort' :: (a -> a -> Ordering) -> [[a]] -> [a]
901 mergesort' _ [] = []
902 mergesort' _ [xs] = xs
903 mergesort' cmp xss = mergesort' cmp (merge_pairs cmp xss)
904
905 merge_pairs :: (a -> a -> Ordering) -> [[a]] -> [[a]]
906 merge_pairs _ [] = []
907 merge_pairs _ [xs] = [xs]
908 merge_pairs cmp (xs:ys:xss) = merge cmp xs ys : merge_pairs cmp xss
909
910 merge :: (a -> a -> Ordering) -> [a] -> [a] -> [a]
911 merge _ [] ys = ys
912 merge _ xs [] = xs
913 merge cmp (x:xs) (y:ys)
914 = case x `cmp` y of
915 GT -> y : merge cmp (x:xs) ys
916 _ -> x : merge cmp xs (y:ys)
917
918 wrap :: a -> [a]
919 wrap x = [x]
920
921
922
923 OLDER: qsort version
924
925 -- qsort is stable and does not concatenate.
926 qsort :: (a -> a -> Ordering) -> [a] -> [a] -> [a]
927 qsort _ [] r = r
928 qsort _ [x] r = x:r
929 qsort cmp (x:xs) r = qpart cmp x xs [] [] r
930
931 -- qpart partitions and sorts the sublists
932 qpart :: (a -> a -> Ordering) -> a -> [a] -> [a] -> [a] -> [a] -> [a]
933 qpart cmp x [] rlt rge r =
934 -- rlt and rge are in reverse order and must be sorted with an
935 -- anti-stable sorting
936 rqsort cmp rlt (x:rqsort cmp rge r)
937 qpart cmp x (y:ys) rlt rge r =
938 case cmp x y of
939 GT -> qpart cmp x ys (y:rlt) rge r
940 _ -> qpart cmp x ys rlt (y:rge) r
941
942 -- rqsort is as qsort but anti-stable, i.e. reverses equal elements
943 rqsort :: (a -> a -> Ordering) -> [a] -> [a] -> [a]
944 rqsort _ [] r = r
945 rqsort _ [x] r = x:r
946 rqsort cmp (x:xs) r = rqpart cmp x xs [] [] r
947
948 rqpart :: (a -> a -> Ordering) -> a -> [a] -> [a] -> [a] -> [a] -> [a]
949 rqpart cmp x [] rle rgt r =
950 qsort cmp rle (x:qsort cmp rgt r)
951 rqpart cmp x (y:ys) rle rgt r =
952 case cmp y x of
953 GT -> rqpart cmp x ys rle (y:rgt) r
954 _ -> rqpart cmp x ys (y:rle) rgt r
955 -}
956
957 #endif /* USE_REPORT_PRELUDE */
958
959 -- | The 'unfoldr' function is a \`dual\' to 'foldr': while 'foldr'
960 -- reduces a list to a summary value, 'unfoldr' builds a list from
961 -- a seed value. The function takes the element and returns 'Nothing'
962 -- if it is done producing the list or returns 'Just' @(a,b)@, in which
963 -- case, @a@ is a prepended to the list and @b@ is used as the next
964 -- element in a recursive call. For example,
965 --
966 -- > iterate f == unfoldr (\x -> Just (x, f x))
967 --
968 -- In some cases, 'unfoldr' can undo a 'foldr' operation:
969 --
970 -- > unfoldr f' (foldr f z xs) == xs
971 --
972 -- if the following holds:
973 --
974 -- > f' (f x y) = Just (x,y)
975 -- > f' z = Nothing
976 --
977 -- A simple use of unfoldr:
978 --
979 -- > unfoldr (\b -> if b == 0 then Nothing else Just (b, b-1)) 10
980 -- > [10,9,8,7,6,5,4,3,2,1]
981 --
982 unfoldr :: (b -> Maybe (a, b)) -> b -> [a]
983 unfoldr f b =
984 case f b of
985 Just (a,new_b) -> a : unfoldr f new_b
986 Nothing -> []
987
988 -- -----------------------------------------------------------------------------
989
990 -- | A strict version of 'foldl'.
991 foldl' :: (a -> b -> a) -> a -> [b] -> a
992 #ifdef __GLASGOW_HASKELL__
993 foldl' f z0 xs0 = lgo z0 xs0
994 where lgo z [] = z
995 lgo z (x:xs) = let z' = f z x in z' `seq` lgo z' xs
996 #else
997 foldl' f a [] = a
998 foldl' f a (x:xs) = let a' = f a x in a' `seq` foldl' f a' xs
999 #endif
1000
1001 #ifdef __GLASGOW_HASKELL__
1002 -- | 'foldl1' is a variant of 'foldl' that has no starting value argument,
1003 -- and thus must be applied to non-empty lists.
1004 foldl1 :: (a -> a -> a) -> [a] -> a
1005 foldl1 f (x:xs) = foldl f x xs
1006 foldl1 _ [] = errorEmptyList "foldl1"
1007 #endif /* __GLASGOW_HASKELL__ */
1008
1009 -- | A strict version of 'foldl1'
1010 foldl1' :: (a -> a -> a) -> [a] -> a
1011 foldl1' f (x:xs) = foldl' f x xs
1012 foldl1' _ [] = errorEmptyList "foldl1'"
1013
1014 #ifdef __GLASGOW_HASKELL__
1015 -- -----------------------------------------------------------------------------
1016 -- List sum and product
1017
1018 {-# SPECIALISE sum :: [Int] -> Int #-}
1019 {-# SPECIALISE sum :: [Integer] -> Integer #-}
1020 {-# SPECIALISE product :: [Int] -> Int #-}
1021 {-# SPECIALISE product :: [Integer] -> Integer #-}
1022 -- | The 'sum' function computes the sum of a finite list of numbers.
1023 sum :: (Num a) => [a] -> a
1024 -- | The 'product' function computes the product of a finite list of numbers.
1025 product :: (Num a) => [a] -> a
1026 #ifdef USE_REPORT_PRELUDE
1027 sum = foldl (+) 0
1028 product = foldl (*) 1
1029 #else
1030 sum l = sum' l 0
1031 where
1032 sum' [] a = a
1033 sum' (x:xs) a = sum' xs (a+x)
1034 product l = prod l 1
1035 where
1036 prod [] a = a
1037 prod (x:xs) a = prod xs (a*x)
1038 #endif
1039
1040 -- -----------------------------------------------------------------------------
1041 -- Functions on strings
1042
1043 -- | 'lines' breaks a string up into a list of strings at newline
1044 -- characters. The resulting strings do not contain newlines.
1045 lines :: String -> [String]
1046 lines "" = []
1047 #ifdef __GLASGOW_HASKELL__
1048 -- Somehow GHC doesn't detect the selector thunks in the below code,
1049 -- so s' keeps a reference to the first line via the pair and we have
1050 -- a space leak (cf. #4334).
1051 -- So we need to make GHC see the selector thunks with a trick.
1052 lines s = cons (case break (== '\n') s of
1053 (l, s') -> (l, case s' of
1054 [] -> []
1055 _:s'' -> lines s''))
1056 where
1057 cons ~(h, t) = h : t
1058 #else
1059 lines s = let (l, s') = break (== '\n') s
1060 in l : case s' of
1061 [] -> []
1062 (_:s'') -> lines s''
1063 #endif
1064
1065 -- | 'unlines' is an inverse operation to 'lines'.
1066 -- It joins lines, after appending a terminating newline to each.
1067 unlines :: [String] -> String
1068 #ifdef USE_REPORT_PRELUDE
1069 unlines = concatMap (++ "\n")
1070 #else
1071 -- HBC version (stolen)
1072 -- here's a more efficient version
1073 unlines [] = []
1074 unlines (l:ls) = l ++ '\n' : unlines ls
1075 #endif
1076
1077 -- | 'words' breaks a string up into a list of words, which were delimited
1078 -- by white space.
1079 words :: String -> [String]
1080 words s = case dropWhile {-partain:Char.-}isSpace s of
1081 "" -> []
1082 s' -> w : words s''
1083 where (w, s'') =
1084 break {-partain:Char.-}isSpace s'
1085
1086 -- | 'unwords' is an inverse operation to 'words'.
1087 -- It joins words with separating spaces.
1088 unwords :: [String] -> String
1089 #ifdef USE_REPORT_PRELUDE
1090 unwords [] = ""
1091 unwords ws = foldr1 (\w s -> w ++ ' ':s) ws
1092 #else
1093 -- HBC version (stolen)
1094 -- here's a more efficient version
1095 unwords [] = ""
1096 unwords [w] = w
1097 unwords (w:ws) = w ++ ' ' : unwords ws
1098 #endif
1099
1100 #else /* !__GLASGOW_HASKELL__ */
1101
1102 errorEmptyList :: String -> a
1103 errorEmptyList fun =
1104 error ("Prelude." ++ fun ++ ": empty list")
1105
1106 #endif /* !__GLASGOW_HASKELL__ */