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