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