List.lhs 17.4 KB
Newer Older
1
% -----------------------------------------------------------------------------
2
% $Id: List.lhs,v 1.13 2001/08/29 10:12:34 simonmar Exp $
3
%
4
% (c) The University of Glasgow, 1994-2000
5
6
%

7
\section[List]{Module @List@}
8
9

\begin{code}
sof's avatar
sof committed
10
11
module List 
   ( 
andy's avatar
andy committed
12
#ifndef __HUGS__
sof's avatar
sof committed
13
     []((:), [])
andy's avatar
andy committed
14
15
   , 
#endif
sof's avatar
sof committed
16

andy's avatar
andy committed
17
      elemIndex	       -- :: (Eq a) => a -> [a] -> Maybe Int
sof's avatar
sof committed
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
   , elemIndices       -- :: (Eq a) => a -> [a] -> [Int]

   , find	       -- :: (a -> Bool) -> [a] -> Maybe a
   , findIndex	       -- :: (a -> Bool) -> [a] -> Maybe Int
   , findIndices       -- :: (a -> Bool) -> [a] -> [Int]
   
   , nub               -- :: (Eq a) => [a] -> [a]
   , nubBy             -- :: (a -> a -> Bool) -> [a] -> [a]

   , delete            -- :: (Eq a) => a -> [a] -> [a]
   , deleteBy          -- :: (a -> a -> Bool) -> a -> [a] -> [a]
   , (\\)              -- :: (Eq a) => [a] -> [a] -> [a]
   , deleteFirstsBy    -- :: (a -> a -> Bool) -> [a] -> [a] -> [a]
   
   , union             -- :: (Eq a) => [a] -> [a] -> [a]
   , unionBy           -- :: (a -> a -> Bool) -> [a] -> [a] -> [a]

   , intersect         -- :: (Eq a) => [a] -> [a] -> [a]
   , intersectBy       -- :: (a -> a -> Bool) -> [a] -> [a] -> [a]

   , intersperse       -- :: a -> [a] -> [a]
   , transpose         -- :: [[a]] -> [[a]]
   , partition         -- :: (a -> Bool) -> [a] -> ([a], [a])

   , group             -- :: Eq a => [a] -> [[a]]
   , groupBy           -- :: (a -> a -> Bool) -> [a] -> [[a]]

   , inits             -- :: [a] -> [[a]]
   , tails             -- :: [a] -> [[a]]

   , isPrefixOf        -- :: (Eq a) => [a] -> [a] -> Bool
   , isSuffixOf        -- :: (Eq a) => [a] -> [a] -> Bool
   
   , mapAccumL         -- :: (a -> b -> (a,c)) -> a -> [b] -> (a,[c])
   , mapAccumR         -- :: (a -> b -> (a,c)) -> a -> [b] -> (a,[c])
   
   , sort              -- :: (Ord a) => [a] -> [a]
   , sortBy            -- :: (a -> a -> Ordering) -> [a] -> [a]
   
   , insert            -- :: (Ord a) => a -> [a] -> [a]
   , insertBy          -- :: (a -> a -> Ordering) -> a -> [a] -> [a]
   
   , maximumBy	       -- :: (a -> a -> Ordering) -> [a] -> a
   , minimumBy         -- :: (a -> a -> Ordering) -> [a] -> a
   
   , genericLength     -- :: (Integral a) => [b] -> a
   , genericTake       -- :: (Integral a) => a -> [b] -> [b]
   , genericDrop       -- :: (Integral a) => a -> [b] -> [b]
   , genericSplitAt    -- :: (Integral a) => a -> [b] -> ([b], [b])
   , genericIndex      -- :: (Integral a) => [b] -> a -> b
   , genericReplicate  -- :: (Integral a) => a -> b -> [b]
   
70
   , unfoldr		-- :: (b -> Maybe (a, b)) -> b -> [a]
sof's avatar
sof committed
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132

   , zip4, zip5, zip6, zip7
   , zipWith4, zipWith5, zipWith6, zipWith7
   , unzip4, unzip5, unzip6, unzip7

   , map               -- :: ( a -> b ) -> [a] -> [b]
   , (++)	       -- :: [a] -> [a] -> [a]
   , concat            -- :: [[a]] -> [a]
   , filter	       -- :: (a -> Bool) -> [a] -> [a]
   , head	       -- :: [a] -> a
   , last	       -- :: [a] -> a
   , tail	       -- :: [a] -> [a]
   , init              -- :: [a] -> [a]
   , null	       -- :: [a] -> Bool
   , length	       -- :: [a] -> Int
   , (!!)	       -- :: [a] -> Int -> a
   , foldl	       -- :: (a -> b -> a) -> a -> [b] -> a
   , foldl1	       -- :: (a -> a -> a) -> [a] -> a
   , scanl             -- :: (a -> b -> a) -> a -> [b] -> [a]
   , scanl1            -- :: (a -> a -> a) -> [a] -> [a]
   , foldr             -- :: (a -> b -> b) -> b -> [a] -> b
   , foldr1            -- :: (a -> a -> a) -> [a] -> a
   , scanr             -- :: (a -> b -> b) -> b -> [a] -> [b]
   , scanr1            -- :: (a -> a -> a) -> [a] -> [a]
   , iterate           -- :: (a -> a) -> a -> [a]
   , repeat            -- :: a -> [a]
   , replicate         -- :: Int -> a -> [a]
   , cycle             -- :: [a] -> [a]
   , take              -- :: Int -> [a] -> [a]
   , drop              -- :: Int -> [a] -> [a]
   , splitAt           -- :: Int -> [a] -> ([a], [a])
   , takeWhile         -- :: (a -> Bool) -> [a] -> [a]
   , dropWhile         -- :: (a -> Bool) -> [a] -> [a]
   , span              -- :: (a -> Bool) -> [a] -> ([a], [a])
   , break             -- :: (a -> Bool) -> [a] -> ([a], [a])

   , lines	       -- :: String   -> [String]
   , words	       -- :: String   -> [String]
   , unlines           -- :: [String] -> String
   , unwords           -- :: [String] -> String
   , reverse           -- :: [a] -> [a]
   , and	       -- :: [Bool] -> Bool
   , or                -- :: [Bool] -> Bool
   , any               -- :: (a -> Bool) -> [a] -> Bool
   , all               -- :: (a -> Bool) -> [a] -> Bool
   , elem              -- :: a -> [a] -> Bool
   , notElem           -- :: a -> [a] -> Bool
   , lookup            -- :: (Eq a) => a -> [(a,b)] -> Maybe b
   , sum               -- :: (Num a) => [a] -> a
   , product           -- :: (Num a) => [a] -> a
   , maximum           -- :: (Ord a) => [a] -> a
   , minimum           -- :: (Ord a) => [a] -> a
   , concatMap         -- :: (a -> [b]) -> [a] -> [b]
   , zip               -- :: [a] -> [b] -> [(a,b)]
   , zip3  
   , zipWith           -- :: (a -> b -> c) -> [a] -> [b] -> [c]
   , zipWith3
   , unzip             -- :: [(a,b)] -> ([a],[b])
   , unzip3

     -- Implementation checked wrt. Haskell 98 lib report, 1/99.
   ) where
133

134
import Prelude
135
import Maybe	( listToMaybe )
andy's avatar
andy committed
136
137
138

#ifndef __HUGS__
import PrelShow	( lines, words, unlines, unwords )
sof's avatar
sof committed
139
import PrelBase	( Int(..), map, (++) )
140
import PrelGHC	( (+#) )
andy's avatar
andy committed
141
#endif
sof's avatar
sof committed
142

andy's avatar
andy committed
143
infix 5 \\ 
144
\end{code}
145

146
147
148
149
150
151
152
%*********************************************************
%*							*
\subsection{List functions}
%*							*
%*********************************************************

\begin{code}
sof's avatar
sof committed
153
154
155
156
157
158
159
160
161
162
163
164
165
elemIndex	:: Eq a => a -> [a] -> Maybe Int
elemIndex x     = findIndex (x==)

elemIndices     :: Eq a => a -> [a] -> [Int]
elemIndices x   = findIndices (x==)

find		:: (a -> Bool) -> [a] -> Maybe a
find p          = listToMaybe . filter p

findIndex       :: (a -> Bool) -> [a] -> Maybe Int
findIndex p     = listToMaybe . findIndices p

findIndices      :: (a -> Bool) -> [a] -> [Int]
166

167
168
169
#ifdef USE_REPORT_PRELUDE
findIndices p xs = [ i | (x,i) <- zip xs [0..], p x]
#else
andy's avatar
andy committed
170
171
172
#ifdef __HUGS__
findIndices p xs = [ i | (x,i) <- zip xs [0..], p x]
#else 
173
-- Efficient definition
sof's avatar
sof committed
174
findIndices p ls = loop 0# ls
175
		 where
sof's avatar
sof committed
176
177
178
	 	   loop _ [] = []
		   loop n (x:xs) | p x       = I# n : loop (n +# 1#) xs
				 | otherwise = loop (n +# 1#) xs
andy's avatar
andy committed
179
180
#endif  /* __HUGS__ */
#endif  /* USE_REPORT_PRELUDE */
sof's avatar
sof committed
181

sof's avatar
sof committed
182
183
184
185
186
187
188
189
isPrefixOf              :: (Eq a) => [a] -> [a] -> Bool
isPrefixOf [] _         =  True
isPrefixOf _  []        =  False
isPrefixOf (x:xs) (y:ys)=  x == y && isPrefixOf xs ys

isSuffixOf              :: (Eq a) => [a] -> [a] -> Bool
isSuffixOf x y          =  reverse x `isPrefixOf` reverse y

sof's avatar
sof committed
190
191
-- nub (meaning "essence") remove duplicate elements from its list argument.
nub                     :: (Eq a) => [a] -> [a]
sof's avatar
sof committed
192
#ifdef USE_REPORT_PRELUDE
sof's avatar
sof committed
193
nub                     =  nubBy (==)
sof's avatar
sof committed
194
195
#else
-- stolen from HBC
andy's avatar
andy committed
196
nub l                   = nub' l []		-- '
sof's avatar
sof committed
197
  where
andy's avatar
andy committed
198
199
200
201
    nub' [] _		= []			-- '
    nub' (x:xs) ls				-- '
	| x `elem` ls   = nub' xs ls		-- '
	| otherwise     = x : nub' xs (x:ls)	-- '
sof's avatar
sof committed
202
#endif
sof's avatar
sof committed
203
204

nubBy			:: (a -> a -> Bool) -> [a] -> [a]
sof's avatar
sof committed
205
#ifdef USE_REPORT_PRELUDE
sof's avatar
sof committed
206
207
nubBy eq []             =  []
nubBy eq (x:xs)         =  x : nubBy eq (filter (\ y -> not (eq x y)) xs)
sof's avatar
sof committed
208
209
210
211
#else
nubBy eq l              = nubBy' l []
  where
    nubBy' [] _		= []
212
213
214
215
216
217
218
219
220
221
222
223
    nubBy' (y:ys) xs
       | elem_by eq y xs = nubBy' ys xs 
       | otherwise	 = y : nubBy' ys (y:xs)

-- Not exported:
-- Note that we keep the call to `eq` with arguments in the
-- same order as in the reference implementation
-- 'xs' is the list of things we've seen so far, 
-- 'y' is the potential new element
elem_by :: (a -> a -> Bool) -> a -> [a] -> Bool
elem_by _  _ []		=  False
elem_by eq y (x:xs)	=  x `eq` y || elem_by eq y xs
sof's avatar
sof committed
224
#endif
sof's avatar
sof committed
225

sof's avatar
sof committed
226

227
228
229
230
231
-- delete x removes the first occurrence of x from its list argument.
delete                  :: (Eq a) => a -> [a] -> [a]
delete                  =  deleteBy (==)

deleteBy                :: (a -> a -> Bool) -> a -> [a] -> [a]
sof's avatar
sof committed
232
deleteBy _  _ []        = []
233
deleteBy eq x (y:ys)    = if x `eq` y then ys else y : deleteBy eq x ys
234
235
236

-- list difference (non-associative).  In the result of xs \\ ys,
-- the first occurrence of each element of ys in turn (if any)
237
-- has been removed from xs.  Thus, (xs ++ ys) \\ xs == ys.
238
239
240
(\\)			:: (Eq a) => [a] -> [a] -> [a]
(\\)		        =  foldl (flip delete)

sof's avatar
sof committed
241
-- List union, remove the elements of first list from second.
sof's avatar
sof committed
242
243
union			:: (Eq a) => [a] -> [a] -> [a]
union 			= unionBy (==)
244

sof's avatar
sof committed
245
unionBy                 :: (a -> a -> Bool) -> [a] -> [a] -> [a]
sof's avatar
sof committed
246
unionBy eq xs ys        =  xs ++ foldl (flip (deleteBy eq)) (nubBy eq ys) xs
sof's avatar
sof committed
247
248
249
250
251
252

intersect               :: (Eq a) => [a] -> [a] -> [a]
intersect               =  intersectBy (==)

intersectBy             :: (a -> a -> Bool) -> [a] -> [a] -> [a]
intersectBy eq xs ys    =  [x | x <- xs, any (eq x) ys]
253

sof's avatar
sof committed
254
255
256
-- intersperse sep inserts sep between the elements of its list argument.
-- e.g. intersperse ',' "abcde" == "a,b,c,d,e"
intersperse		:: a -> [a] -> [a]
sof's avatar
sof committed
257
258
intersperse _   []      = []
intersperse _   [x]     = [x]
sof's avatar
sof committed
259
intersperse sep (x:xs)  = x : sep : intersperse sep xs
260

sof's avatar
sof committed
261
transpose		:: [[a]] -> [[a]]
sof's avatar
sof committed
262
263
264
transpose []		 = []
transpose ([]	: xss)   = transpose xss
transpose ((x:xs) : xss) = (x : [h | (h:t) <- xss]) : transpose (xs : [ t | (h:t) <- xss])
265

sof's avatar
sof committed
266
267
268
269
270
271

-- partition takes a predicate and a list and returns a pair of lists:
-- those elements of the argument list that do and do not satisfy the
-- predicate, respectively; i,e,,
-- partition p xs == (filter p xs, filter (not . p) xs).
partition		:: (a -> Bool) -> [a] -> ([a],[a])
272
273
274
{-# INLINE partition #-}
partition p xs = foldr (select p) ([],[]) xs

275
276
select p x (ts,fs) | p x       = (x:ts,fs)
                   | otherwise = (ts, x:fs)
sof's avatar
sof committed
277
\end{code}
sof's avatar
sof committed
278

sof's avatar
sof committed
279
280
281
282
283
@mapAccumL@ behaves like a combination
of  @map@ and @foldl@;
it applies a function to each element of a list, passing an accumulating
parameter from left to right, and returning a final value of this
accumulator together with the new list.
sof's avatar
sof committed
284

sof's avatar
sof committed
285
\begin{code}
sof's avatar
sof committed
286

sof's avatar
sof committed
287
288
289
290
291
292
mapAccumL :: (acc -> x -> (acc, y)) -- Function of elt of input list
				    -- and accumulator, returning new
				    -- accumulator and elt of result list
   	  -> acc	    -- Initial accumulator 
	  -> [x]	    -- Input list
	  -> (acc, [y])	    -- Final accumulator and result list
sof's avatar
sof committed
293
mapAccumL _ s []     	=  (s, [])
sof's avatar
sof committed
294
295
296
mapAccumL f s (x:xs) 	=  (s'',y:ys)
		           where (s', y ) = f s x
			         (s'',ys) = mapAccumL f s' xs
sof's avatar
sof committed
297
\end{code}
sof's avatar
sof committed
298

sof's avatar
sof committed
299
300
301
302
303
304
305
306
307
308
@mapAccumR@ does the same, but working from right to left instead.  Its type is
the same as @mapAccumL@, though.

\begin{code}
mapAccumR :: (acc -> x -> (acc, y)) 	-- Function of elt of input list
					-- and accumulator, returning new
					-- accumulator and elt of result list
	    -> acc 		-- Initial accumulator
	    -> [x] 		-- Input list
	    -> (acc, [y])		-- Final accumulator and result list
sof's avatar
sof committed
309
mapAccumR _ s []     	=  (s, [])
sof's avatar
sof committed
310
311
312
mapAccumR f s (x:xs)	=  (s'', y:ys)
		           where (s'',y ) = f s' x
			         (s', ys) = mapAccumR f s xs
sof's avatar
sof committed
313
314
315
\end{code}

\begin{code}
sof's avatar
sof committed
316
317
318
insert :: Ord a => a -> [a] -> [a]
insert e ls = insertBy (compare) e ls

sof's avatar
sof committed
319
insertBy :: (a -> a -> Ordering) -> a -> [a] -> [a]
sof's avatar
sof committed
320
insertBy _   x [] = [x]
sof's avatar
sof committed
321
322
323
324
insertBy cmp x ys@(y:ys')
 = case cmp x y of
     GT -> y : insertBy cmp x ys'
     _  -> x : ys
325

326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
maximumBy		:: (a -> a -> Ordering) -> [a] -> a
maximumBy _ []		=  error "List.maximumBy: empty list"
maximumBy cmp xs	=  foldl1 max xs
			where
			   max x y = case cmp x y of
					GT -> x
					_  -> y

minimumBy		:: (a -> a -> Ordering) -> [a] -> a
minimumBy _ []		=  error "List.minimumBy: empty list"
minimumBy cmp xs	=  foldl1 min xs
			where
			   min x y = case cmp x y of
					GT -> y
					_  -> x
341

sof's avatar
sof committed
342
343
344
genericLength           :: (Num i) => [b] -> i
genericLength []        =  0
genericLength (_:l)     =  1 + genericLength l
345

sof's avatar
sof committed
346
347
348
349
350
genericTake		:: (Integral i) => i -> [a] -> [a]
genericTake 0 _         =  []
genericTake _ []        =  []
genericTake n (x:xs) | n > 0  =  x : genericTake (n-1) xs
genericTake _  _        =  error "List.genericTake: negative argument"
351

sof's avatar
sof committed
352
353
354
355
356
genericDrop		:: (Integral i) => i -> [a] -> [a]
genericDrop 0 xs        =  xs
genericDrop _ []        =  []
genericDrop n (_:xs) | n > 0  =  genericDrop (n-1) xs
genericDrop _ _		=  error "List.genericDrop: negative argument"
357

sof's avatar
sof committed
358
359
360
361
362
363
genericSplitAt          :: (Integral i) => i -> [b] -> ([b],[b])
genericSplitAt 0 xs     =  ([],xs)
genericSplitAt _ []     =  ([],[])
genericSplitAt n (x:xs) | n > 0  =  (x:xs',xs'') where
                               (xs',xs'') = genericSplitAt (n-1) xs
genericSplitAt _ _      =  error "List.genericSplitAt: negative argument"
364

sof's avatar
sof committed
365
366
367
368
369
370
371

genericIndex :: (Integral a) => [b] -> a -> b
genericIndex (x:_)  0 = x
genericIndex (_:xs) n 
 | n > 0     = genericIndex xs (n-1)
 | otherwise = error "List.genericIndex: negative argument."
genericIndex _ _      = error "List.genericIndex: index too large."
372

sof's avatar
sof committed
373
374
375
376
genericReplicate	:: (Integral i) => i -> a -> [a]
genericReplicate n x	=  genericTake n (repeat x)


377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
zip4			:: [a] -> [b] -> [c] -> [d] -> [(a,b,c,d)]
zip4			=  zipWith4 (,,,)

zip5			:: [a] -> [b] -> [c] -> [d] -> [e] -> [(a,b,c,d,e)]
zip5			=  zipWith5 (,,,,)

zip6			:: [a] -> [b] -> [c] -> [d] -> [e] -> [f] -> 
                              [(a,b,c,d,e,f)]
zip6			=  zipWith6 (,,,,,)

zip7			:: [a] -> [b] -> [c] -> [d] -> [e] -> [f] ->
                              [g] -> [(a,b,c,d,e,f,g)]
zip7			=  zipWith7 (,,,,,,)

zipWith4		:: (a->b->c->d->e) -> [a]->[b]->[c]->[d]->[e]
zipWith4 z (a:as) (b:bs) (c:cs) (d:ds)
			=  z a b c d : zipWith4 z as bs cs ds
zipWith4 _ _ _ _ _	=  []

zipWith5		:: (a->b->c->d->e->f) -> 
                           [a]->[b]->[c]->[d]->[e]->[f]
zipWith5 z (a:as) (b:bs) (c:cs) (d:ds) (e:es)
			=  z a b c d e : zipWith5 z as bs cs ds es
zipWith5 _ _ _ _ _ _	= []

zipWith6		:: (a->b->c->d->e->f->g) ->
                           [a]->[b]->[c]->[d]->[e]->[f]->[g]
zipWith6 z (a:as) (b:bs) (c:cs) (d:ds) (e:es) (f:fs)
			=  z a b c d e f : zipWith6 z as bs cs ds es fs
zipWith6 _ _ _ _ _ _ _	= []

zipWith7		:: (a->b->c->d->e->f->g->h) ->
                           [a]->[b]->[c]->[d]->[e]->[f]->[g]->[h]
zipWith7 z (a:as) (b:bs) (c:cs) (d:ds) (e:es) (f:fs) (g:gs)
		   =  z a b c d e f g : zipWith7 z as bs cs ds es fs gs
zipWith7 _ _ _ _ _ _ _ _ = []

unzip4			:: [(a,b,c,d)] -> ([a],[b],[c],[d])
unzip4			=  foldr (\(a,b,c,d) ~(as,bs,cs,ds) ->
					(a:as,b:bs,c:cs,d:ds))
				 ([],[],[],[])

unzip5			:: [(a,b,c,d,e)] -> ([a],[b],[c],[d],[e])
unzip5			=  foldr (\(a,b,c,d,e) ~(as,bs,cs,ds,es) ->
					(a:as,b:bs,c:cs,d:ds,e:es))
				 ([],[],[],[],[])

unzip6			:: [(a,b,c,d,e,f)] -> ([a],[b],[c],[d],[e],[f])
unzip6			=  foldr (\(a,b,c,d,e,f) ~(as,bs,cs,ds,es,fs) ->
					(a:as,b:bs,c:cs,d:ds,e:es,f:fs))
				 ([],[],[],[],[],[])

unzip7		:: [(a,b,c,d,e,f,g)] -> ([a],[b],[c],[d],[e],[f],[g])
unzip7		=  foldr (\(a,b,c,d,e,f,g) ~(as,bs,cs,ds,es,fs,gs) ->
				(a:as,b:bs,c:cs,d:ds,e:es,f:fs,g:gs))
			 ([],[],[],[],[],[],[])



sof's avatar
sof committed
436
437
deleteFirstsBy          :: (a -> a -> Bool) -> [a] -> [a] -> [a]
deleteFirstsBy eq       =  foldl (flip (deleteBy eq))
438
439
440
441
442
443
444
445
446


-- group splits its list argument into a list of lists of equal, adjacent
-- elements.  e.g.,
-- group "Mississippi" == ["M","i","ss","i","ss","i","pp","i"]
group                   :: (Eq a) => [a] -> [[a]]
group                   =  groupBy (==)

groupBy 		:: (a -> a -> Bool) -> [a] -> [[a]]
sof's avatar
sof committed
447
groupBy _  []		=  []
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
groupBy eq (x:xs)	=  (x:ys) : groupBy eq zs
                           where (ys,zs) = span (eq x) xs

-- inits xs returns the list of initial segments of xs, shortest first.
-- e.g., inits "abc" == ["","a","ab","abc"]
inits 			:: [a] -> [[a]]
inits []		=  [[]]
inits (x:xs) 		=  [[]] ++ map (x:) (inits xs)

-- tails xs returns the list of all final segments of xs, longest first.
-- e.g., tails "abc" == ["abc", "bc", "c",""]
tails 			:: [a] -> [[a]]
tails []	        =  [[]]
tails xxs@(_:xs) 	=  xxs : tails xs

463
\end{code}
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482

%-----------------------------------------------------------------------------
Quick Sort algorithm taken from HBC's QSort library.

\begin{code}
sort :: (Ord a) => [a] -> [a]
sortBy :: (a -> a -> Ordering) -> [a] -> [a]

#ifdef USE_REPORT_PRELUDE
sort = sortBy compare
sortBy cmp = foldr (insertBy cmp) []
#else

sortBy cmp l = qsort cmp l []
sort l = qsort compare l []

-- rest is not exported:

-- qsort is stable and does not concatenate.
sof's avatar
sof committed
483
484
485
qsort :: (a -> a -> Ordering) -> [a] -> [a] -> [a]
qsort _   []     r = r
qsort _   [x]    r = x:r
486
487
488
qsort cmp (x:xs) r = qpart cmp x xs [] [] r

-- qpart partitions and sorts the sublists
sof's avatar
sof committed
489
qpart :: (a -> a -> Ordering) -> a -> [a] -> [a] -> [a] -> [a] -> [a]
490
491
492
493
494
495
496
497
498
499
qpart cmp x [] rlt rge r =
    -- rlt and rge are in reverse order and must be sorted with an
    -- anti-stable sorting
    rqsort cmp rlt (x:rqsort cmp rge r)
qpart cmp x (y:ys) rlt rge r =
    case cmp x y of
	GT -> qpart cmp x ys (y:rlt) rge r
        _  -> qpart cmp x ys rlt (y:rge) r

-- rqsort is as qsort but anti-stable, i.e. reverses equal elements
sof's avatar
sof committed
500
501
502
rqsort :: (a -> a -> Ordering) -> [a] -> [a] -> [a]
rqsort _   []     r = r
rqsort _   [x]    r = x:r
503
504
rqsort cmp (x:xs) r = rqpart cmp x xs [] [] r

sof's avatar
sof committed
505
rqpart :: (a -> a -> Ordering) -> a -> [a] -> [a] -> [a] -> [a] -> [a]
506
507
508
509
510
511
512
513
514
rqpart cmp x [] rle rgt r =
    qsort cmp rle (x:qsort cmp rgt r)
rqpart cmp x (y:ys) rle rgt r =
    case cmp y x of
	GT -> rqpart cmp x ys rle (y:rgt) r
    	_  -> rqpart cmp x ys (y:rle) rgt r

#endif /* USE_REPORT_PRELUDE */
\end{code}
sof's avatar
sof committed
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531

\begin{verbatim}
  unfoldr f' (foldr f z xs) == (z,xs)

 if the following holds:

   f' (f x y) = Just (x,y)
   f' z       = Nothing
\end{verbatim}

\begin{code}
unfoldr      :: (b -> Maybe (a, b)) -> b -> [a]
unfoldr f b  =
  case f b of
   Just (a,new_b) -> a : unfoldr f new_b
   Nothing        -> []
\end{code}