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