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