[project @ 2003-05-27 08:46:38 by malcolm]
[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 : 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
145 #ifdef __GLASGOW_HASKELL__
146 import GHC.Num
147 import GHC.Real
148 import GHC.List
149 import GHC.Show ( lines, words, unlines, unwords )
150 import GHC.Base
151 #endif
152
153 infix 5 \\
154
155 -- -----------------------------------------------------------------------------
156 -- List functions
157
158 elemIndex :: Eq a => a -> [a] -> Maybe Int
159 elemIndex x = findIndex (x==)
160
161 elemIndices :: Eq a => a -> [a] -> [Int]
162 elemIndices x = findIndices (x==)
163
164 find :: (a -> Bool) -> [a] -> Maybe a
165 find p = listToMaybe . filter p
166
167 findIndex :: (a -> Bool) -> [a] -> Maybe Int
168 findIndex p = listToMaybe . findIndices p
169
170 findIndices :: (a -> Bool) -> [a] -> [Int]
171
172 #if defined(USE_REPORT_PRELUDE) || !defined(__GLASGOW_HASKELL__)
173 findIndices p xs = [ i | (x,i) <- zip xs [0..], p x]
174 #else
175 -- Efficient definition
176 findIndices p ls = loop 0# ls
177 where
178 loop _ [] = []
179 loop n (x:xs) | p x = I# n : loop (n +# 1#) xs
180 | otherwise = loop (n +# 1#) xs
181 #endif /* USE_REPORT_PRELUDE */
182
183 isPrefixOf :: (Eq a) => [a] -> [a] -> Bool
184 isPrefixOf [] _ = True
185 isPrefixOf _ [] = False
186 isPrefixOf (x:xs) (y:ys)= x == y && isPrefixOf xs ys
187
188 isSuffixOf :: (Eq a) => [a] -> [a] -> Bool
189 isSuffixOf x y = reverse x `isPrefixOf` reverse y
190
191 -- nub (meaning "essence") remove duplicate elements from its list argument.
192 nub :: (Eq a) => [a] -> [a]
193 #ifdef USE_REPORT_PRELUDE
194 nub = nubBy (==)
195 #else
196 -- stolen from HBC
197 nub l = nub' l [] -- '
198 where
199 nub' [] _ = [] -- '
200 nub' (x:xs) ls -- '
201 | x `elem` ls = nub' xs ls -- '
202 | otherwise = x : nub' xs (x:ls) -- '
203 #endif
204
205 nubBy :: (a -> a -> Bool) -> [a] -> [a]
206 #ifdef USE_REPORT_PRELUDE
207 nubBy eq [] = []
208 nubBy eq (x:xs) = x : nubBy eq (filter (\ y -> not (eq x y)) xs)
209 #else
210 nubBy eq l = nubBy' l []
211 where
212 nubBy' [] _ = []
213 nubBy' (y:ys) xs
214 | elem_by eq y xs = nubBy' ys xs
215 | otherwise = y : nubBy' ys (y:xs)
216
217 -- Not exported:
218 -- Note that we keep the call to `eq` with arguments in the
219 -- same order as in the reference implementation
220 -- 'xs' is the list of things we've seen so far,
221 -- 'y' is the potential new element
222 elem_by :: (a -> a -> Bool) -> a -> [a] -> Bool
223 elem_by _ _ [] = False
224 elem_by eq y (x:xs) = x `eq` y || elem_by eq y xs
225 #endif
226
227
228 -- delete x removes the first occurrence of x from its list argument.
229 delete :: (Eq a) => a -> [a] -> [a]
230 delete = deleteBy (==)
231
232 deleteBy :: (a -> a -> Bool) -> a -> [a] -> [a]
233 deleteBy _ _ [] = []
234 deleteBy eq x (y:ys) = if x `eq` y then ys else y : deleteBy eq x ys
235
236 -- list difference (non-associative). In the result of xs \\ ys,
237 -- the first occurrence of each element of ys in turn (if any)
238 -- has been removed from xs. Thus, (xs ++ ys) \\ xs == ys.
239 (\\) :: (Eq a) => [a] -> [a] -> [a]
240 (\\) = foldl (flip delete)
241
242 -- List union, remove the elements of first list from second.
243 union :: (Eq a) => [a] -> [a] -> [a]
244 union = unionBy (==)
245
246 unionBy :: (a -> a -> Bool) -> [a] -> [a] -> [a]
247 unionBy eq xs ys = xs ++ foldl (flip (deleteBy eq)) (nubBy eq ys) xs
248
249 intersect :: (Eq a) => [a] -> [a] -> [a]
250 intersect = intersectBy (==)
251
252 intersectBy :: (a -> a -> Bool) -> [a] -> [a] -> [a]
253 intersectBy eq xs ys = [x | x <- xs, any (eq x) ys]
254
255 -- intersperse sep inserts sep between the elements of its list argument.
256 -- e.g. intersperse ',' "abcde" == "a,b,c,d,e"
257 intersperse :: a -> [a] -> [a]
258 intersperse _ [] = []
259 intersperse _ [x] = [x]
260 intersperse sep (x:xs) = x : sep : intersperse sep xs
261
262 transpose :: [[a]] -> [[a]]
263 transpose [] = []
264 transpose ([] : xss) = transpose xss
265 transpose ((x:xs) : xss) = (x : [h | (h:t) <- xss]) : transpose (xs : [ t | (h:t) <- xss])
266
267
268 -- partition takes a predicate and a list and returns a pair of lists:
269 -- those elements of the argument list that do and do not satisfy the
270 -- predicate, respectively; i,e,,
271 -- partition p xs == (filter p xs, filter (not . p) xs).
272 partition :: (a -> Bool) -> [a] -> ([a],[a])
273 {-# INLINE partition #-}
274 partition p xs = foldr (select p) ([],[]) xs
275
276 select p x (ts,fs) | p x = (x:ts,fs)
277 | otherwise = (ts, x:fs)
278
279 -- @mapAccumL@ behaves like a combination
280 -- of @map@ and @foldl@;
281 -- it applies a function to each element of a list, passing an accumulating
282 -- parameter from left to right, and returning a final value of this
283 -- accumulator together with the new list.
284
285 mapAccumL :: (acc -> x -> (acc, y)) -- Function of elt of input list
286 -- and accumulator, returning new
287 -- accumulator and elt of result list
288 -> acc -- Initial accumulator
289 -> [x] -- Input list
290 -> (acc, [y]) -- Final accumulator and result list
291 mapAccumL _ s [] = (s, [])
292 mapAccumL f s (x:xs) = (s'',y:ys)
293 where (s', y ) = f s x
294 (s'',ys) = mapAccumL f s' xs
295
296 -- @mapAccumR@ does the same, but working from right to left instead.
297 -- Its type is the same as @mapAccumL@, though.
298
299 mapAccumR :: (acc -> x -> (acc, y)) -- Function of elt of input list
300 -- and accumulator, returning new
301 -- accumulator and elt of result list
302 -> acc -- Initial accumulator
303 -> [x] -- Input list
304 -> (acc, [y]) -- Final accumulator and result list
305 mapAccumR _ s [] = (s, [])
306 mapAccumR f s (x:xs) = (s'', y:ys)
307 where (s'',y ) = f s' x
308 (s', ys) = mapAccumR f s xs
309
310
311 insert :: Ord a => a -> [a] -> [a]
312 insert e ls = insertBy (compare) e ls
313
314 insertBy :: (a -> a -> Ordering) -> a -> [a] -> [a]
315 insertBy _ x [] = [x]
316 insertBy cmp x ys@(y:ys')
317 = case cmp x y of
318 GT -> y : insertBy cmp x ys'
319 _ -> x : ys
320
321 maximumBy :: (a -> a -> Ordering) -> [a] -> a
322 maximumBy _ [] = error "List.maximumBy: empty list"
323 maximumBy cmp xs = foldl1 max xs
324 where
325 max x y = case cmp x y of
326 GT -> x
327 _ -> y
328
329 minimumBy :: (a -> a -> Ordering) -> [a] -> a
330 minimumBy _ [] = error "List.minimumBy: empty list"
331 minimumBy cmp xs = foldl1 min xs
332 where
333 min x y = case cmp x y of
334 GT -> y
335 _ -> x
336
337 genericLength :: (Num i) => [b] -> i
338 genericLength [] = 0
339 genericLength (_:l) = 1 + genericLength l
340
341 genericTake :: (Integral i) => i -> [a] -> [a]
342 genericTake 0 _ = []
343 genericTake _ [] = []
344 genericTake n (x:xs) | n > 0 = x : genericTake (n-1) xs
345 genericTake _ _ = error "List.genericTake: negative argument"
346
347 genericDrop :: (Integral i) => i -> [a] -> [a]
348 genericDrop 0 xs = xs
349 genericDrop _ [] = []
350 genericDrop n (_:xs) | n > 0 = genericDrop (n-1) xs
351 genericDrop _ _ = error "List.genericDrop: negative argument"
352
353 genericSplitAt :: (Integral i) => i -> [b] -> ([b],[b])
354 genericSplitAt 0 xs = ([],xs)
355 genericSplitAt _ [] = ([],[])
356 genericSplitAt n (x:xs) | n > 0 = (x:xs',xs'') where
357 (xs',xs'') = genericSplitAt (n-1) xs
358 genericSplitAt _ _ = error "List.genericSplitAt: negative argument"
359
360
361 genericIndex :: (Integral a) => [b] -> a -> b
362 genericIndex (x:_) 0 = x
363 genericIndex (_:xs) n
364 | n > 0 = genericIndex xs (n-1)
365 | otherwise = error "List.genericIndex: negative argument."
366 genericIndex _ _ = error "List.genericIndex: index too large."
367
368 genericReplicate :: (Integral i) => i -> a -> [a]
369 genericReplicate n x = genericTake n (repeat x)
370
371
372 zip4 :: [a] -> [b] -> [c] -> [d] -> [(a,b,c,d)]
373 zip4 = zipWith4 (,,,)
374
375 zip5 :: [a] -> [b] -> [c] -> [d] -> [e] -> [(a,b,c,d,e)]
376 zip5 = zipWith5 (,,,,)
377
378 zip6 :: [a] -> [b] -> [c] -> [d] -> [e] -> [f] ->
379 [(a,b,c,d,e,f)]
380 zip6 = zipWith6 (,,,,,)
381
382 zip7 :: [a] -> [b] -> [c] -> [d] -> [e] -> [f] ->
383 [g] -> [(a,b,c,d,e,f,g)]
384 zip7 = zipWith7 (,,,,,,)
385
386 zipWith4 :: (a->b->c->d->e) -> [a]->[b]->[c]->[d]->[e]
387 zipWith4 z (a:as) (b:bs) (c:cs) (d:ds)
388 = z a b c d : zipWith4 z as bs cs ds
389 zipWith4 _ _ _ _ _ = []
390
391 zipWith5 :: (a->b->c->d->e->f) ->
392 [a]->[b]->[c]->[d]->[e]->[f]
393 zipWith5 z (a:as) (b:bs) (c:cs) (d:ds) (e:es)
394 = z a b c d e : zipWith5 z as bs cs ds es
395 zipWith5 _ _ _ _ _ _ = []
396
397 zipWith6 :: (a->b->c->d->e->f->g) ->
398 [a]->[b]->[c]->[d]->[e]->[f]->[g]
399 zipWith6 z (a:as) (b:bs) (c:cs) (d:ds) (e:es) (f:fs)
400 = z a b c d e f : zipWith6 z as bs cs ds es fs
401 zipWith6 _ _ _ _ _ _ _ = []
402
403 zipWith7 :: (a->b->c->d->e->f->g->h) ->
404 [a]->[b]->[c]->[d]->[e]->[f]->[g]->[h]
405 zipWith7 z (a:as) (b:bs) (c:cs) (d:ds) (e:es) (f:fs) (g:gs)
406 = z a b c d e f g : zipWith7 z as bs cs ds es fs gs
407 zipWith7 _ _ _ _ _ _ _ _ = []
408
409 unzip4 :: [(a,b,c,d)] -> ([a],[b],[c],[d])
410 unzip4 = foldr (\(a,b,c,d) ~(as,bs,cs,ds) ->
411 (a:as,b:bs,c:cs,d:ds))
412 ([],[],[],[])
413
414 unzip5 :: [(a,b,c,d,e)] -> ([a],[b],[c],[d],[e])
415 unzip5 = foldr (\(a,b,c,d,e) ~(as,bs,cs,ds,es) ->
416 (a:as,b:bs,c:cs,d:ds,e:es))
417 ([],[],[],[],[])
418
419 unzip6 :: [(a,b,c,d,e,f)] -> ([a],[b],[c],[d],[e],[f])
420 unzip6 = foldr (\(a,b,c,d,e,f) ~(as,bs,cs,ds,es,fs) ->
421 (a:as,b:bs,c:cs,d:ds,e:es,f:fs))
422 ([],[],[],[],[],[])
423
424 unzip7 :: [(a,b,c,d,e,f,g)] -> ([a],[b],[c],[d],[e],[f],[g])
425 unzip7 = foldr (\(a,b,c,d,e,f,g) ~(as,bs,cs,ds,es,fs,gs) ->
426 (a:as,b:bs,c:cs,d:ds,e:es,f:fs,g:gs))
427 ([],[],[],[],[],[],[])
428
429
430
431 deleteFirstsBy :: (a -> a -> Bool) -> [a] -> [a] -> [a]
432 deleteFirstsBy eq = foldl (flip (deleteBy eq))
433
434
435 -- group splits its list argument into a list of lists of equal, adjacent
436 -- elements. e.g.,
437 -- group "Mississippi" == ["M","i","ss","i","ss","i","pp","i"]
438 group :: (Eq a) => [a] -> [[a]]
439 group = groupBy (==)
440
441 groupBy :: (a -> a -> Bool) -> [a] -> [[a]]
442 groupBy _ [] = []
443 groupBy eq (x:xs) = (x:ys) : groupBy eq zs
444 where (ys,zs) = span (eq x) xs
445
446 -- inits xs returns the list of initial segments of xs, shortest first.
447 -- e.g., inits "abc" == ["","a","ab","abc"]
448 inits :: [a] -> [[a]]
449 inits [] = [[]]
450 inits (x:xs) = [[]] ++ map (x:) (inits xs)
451
452 -- tails xs returns the list of all final segments of xs, longest first.
453 -- e.g., tails "abc" == ["abc", "bc", "c",""]
454 tails :: [a] -> [[a]]
455 tails [] = [[]]
456 tails xxs@(_:xs) = xxs : tails xs
457
458
459 ------------------------------------------------------------------------------
460 -- Quick Sort algorithm taken from HBC's QSort library.
461
462 sort :: (Ord a) => [a] -> [a]
463 sortBy :: (a -> a -> Ordering) -> [a] -> [a]
464
465 #ifdef USE_REPORT_PRELUDE
466 sort = sortBy compare
467 sortBy cmp = foldr (insertBy cmp) []
468 #else
469
470 sortBy cmp l = mergesort cmp l
471 sort l = mergesort compare l
472
473 {-
474 Quicksort replaced by mergesort, 14/5/2002.
475
476 From: Ian Lynagh <igloo@earth.li>
477
478 I am curious as to why the List.sort implementation in GHC is a
479 quicksort algorithm rather than an algorithm that guarantees n log n
480 time in the worst case? I have attached a mergesort implementation along
481 with a few scripts to time it's performance, the results of which are
482 shown below (* means it didn't finish successfully - in all cases this
483 was due to a stack overflow).
484
485 If I heap profile the random_list case with only 10000 then I see
486 random_list peaks at using about 2.5M of memory, whereas in the same
487 program using List.sort it uses only 100k.
488
489 Input style Input length Sort data Sort alg User time
490 stdin 10000 random_list sort 2.82
491 stdin 10000 random_list mergesort 2.96
492 stdin 10000 sorted sort 31.37
493 stdin 10000 sorted mergesort 1.90
494 stdin 10000 revsorted sort 31.21
495 stdin 10000 revsorted mergesort 1.88
496 stdin 100000 random_list sort *
497 stdin 100000 random_list mergesort *
498 stdin 100000 sorted sort *
499 stdin 100000 sorted mergesort *
500 stdin 100000 revsorted sort *
501 stdin 100000 revsorted mergesort *
502 func 10000 random_list sort 0.31
503 func 10000 random_list mergesort 0.91
504 func 10000 sorted sort 19.09
505 func 10000 sorted mergesort 0.15
506 func 10000 revsorted sort 19.17
507 func 10000 revsorted mergesort 0.16
508 func 100000 random_list sort 3.85
509 func 100000 random_list mergesort *
510 func 100000 sorted sort 5831.47
511 func 100000 sorted mergesort 2.23
512 func 100000 revsorted sort 5872.34
513 func 100000 revsorted mergesort 2.24
514 -}
515
516 mergesort :: (a -> a -> Ordering) -> [a] -> [a]
517 mergesort cmp = mergesort' cmp . map wrap
518
519 mergesort' :: (a -> a -> Ordering) -> [[a]] -> [a]
520 mergesort' cmp [] = []
521 mergesort' cmp [xs] = xs
522 mergesort' cmp xss = mergesort' cmp (merge_pairs cmp xss)
523
524 merge_pairs :: (a -> a -> Ordering) -> [[a]] -> [[a]]
525 merge_pairs cmp [] = []
526 merge_pairs cmp [xs] = [xs]
527 merge_pairs cmp (xs:ys:xss) = merge cmp xs ys : merge_pairs cmp xss
528
529 merge :: (a -> a -> Ordering) -> [a] -> [a] -> [a]
530 merge cmp xs [] = xs
531 merge cmp [] ys = ys
532 merge cmp (x:xs) (y:ys)
533 = case x `cmp` y of
534 GT -> y : merge cmp (x:xs) ys
535 _ -> x : merge cmp xs (y:ys)
536
537 wrap :: a -> [a]
538 wrap x = [x]
539
540 {-
541 OLD: qsort version
542
543 -- qsort is stable and does not concatenate.
544 qsort :: (a -> a -> Ordering) -> [a] -> [a] -> [a]
545 qsort _ [] r = r
546 qsort _ [x] r = x:r
547 qsort cmp (x:xs) r = qpart cmp x xs [] [] r
548
549 -- qpart partitions and sorts the sublists
550 qpart :: (a -> a -> Ordering) -> a -> [a] -> [a] -> [a] -> [a] -> [a]
551 qpart cmp x [] rlt rge r =
552 -- rlt and rge are in reverse order and must be sorted with an
553 -- anti-stable sorting
554 rqsort cmp rlt (x:rqsort cmp rge r)
555 qpart cmp x (y:ys) rlt rge r =
556 case cmp x y of
557 GT -> qpart cmp x ys (y:rlt) rge r
558 _ -> qpart cmp x ys rlt (y:rge) r
559
560 -- rqsort is as qsort but anti-stable, i.e. reverses equal elements
561 rqsort :: (a -> a -> Ordering) -> [a] -> [a] -> [a]
562 rqsort _ [] r = r
563 rqsort _ [x] r = x:r
564 rqsort cmp (x:xs) r = rqpart cmp x xs [] [] r
565
566 rqpart :: (a -> a -> Ordering) -> a -> [a] -> [a] -> [a] -> [a] -> [a]
567 rqpart cmp x [] rle rgt r =
568 qsort cmp rle (x:qsort cmp rgt r)
569 rqpart cmp x (y:ys) rle rgt r =
570 case cmp y x of
571 GT -> rqpart cmp x ys rle (y:rgt) r
572 _ -> rqpart cmp x ys (y:rle) rgt r
573 -}
574
575 #endif /* USE_REPORT_PRELUDE */
576
577 {-
578 \begin{verbatim}
579 unfoldr f' (foldr f z xs) == (z,xs)
580
581 if the following holds:
582
583 f' (f x y) = Just (x,y)
584 f' z = Nothing
585 \end{verbatim}
586 -}
587
588 unfoldr :: (b -> Maybe (a, b)) -> b -> [a]
589 unfoldr f b =
590 case f b of
591 Just (a,new_b) -> a : unfoldr f new_b
592 Nothing -> []
593
594
595 -- -----------------------------------------------------------------------------
596 -- strict version of foldl
597
598 foldl' :: (a -> b -> a) -> a -> [b] -> a
599 foldl' f a [] = a
600 foldl' f a (x:xs) = let a' = f a x in a' `seq` foldl' f a' xs
601
602 #ifdef __GLASGOW_HASKELL__
603 -- -----------------------------------------------------------------------------
604 -- List sum and product
605
606 -- sum and product compute the sum or product of a finite list of numbers.
607 {-# SPECIALISE sum :: [Int] -> Int #-}
608 {-# SPECIALISE sum :: [Integer] -> Integer #-}
609 {-# SPECIALISE product :: [Int] -> Int #-}
610 {-# SPECIALISE product :: [Integer] -> Integer #-}
611 sum, product :: (Num a) => [a] -> a
612 #ifdef USE_REPORT_PRELUDE
613 sum = foldl (+) 0
614 product = foldl (*) 1
615 #else
616 sum l = sum' l 0
617 where
618 sum' [] a = a
619 sum' (x:xs) a = sum' xs (a+x)
620 product l = prod l 1
621 where
622 prod [] a = a
623 prod (x:xs) a = prod xs (a*x)
624 #endif
625 #endif /* __GLASGOW_HASKELL__ */