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