List.lhs 17.4 KB
 simonmar committed Jun 30, 2000 1 % -----------------------------------------------------------------------------  simonmar committed Aug 29, 2001 2 % $Id: List.lhs,v 1.13 2001/08/29 10:12:34 simonmar Exp$  simonpj committed Dec 19, 1996 3 %  simonmar committed Jun 30, 2000 4 % (c) The University of Glasgow, 1994-2000  simonpj committed Dec 19, 1996 5 6 %  qrczak committed Aug 18, 2000 7 \section[List]{Module @List@}  simonpj committed Dec 19, 1996 8 9  \begin{code}  sof committed Jan 14, 1999 10 11 module List (  andy committed Oct 29, 1999 12 #ifndef __HUGS__  sof committed Jan 14, 1999 13  []((:), [])  andy committed Oct 29, 1999 14 15  , #endif  sof committed Jan 14, 1999 16   andy committed Oct 29, 1999 17  elemIndex -- :: (Eq a) => a -> [a] -> Maybe Int  sof committed Jan 14, 1999 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]  panne committed Jun 25, 2000 70  , unfoldr -- :: (b -> Maybe (a, b)) -> b -> [a]  sof committed Jan 14, 1999 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  simonpj committed Dec 19, 1996 133   simonpj committed Jan 18, 1997 134 import Prelude  simonm committed Feb 02, 1998 135 import Maybe ( listToMaybe )  andy committed Oct 29, 1999 136 137 138  #ifndef __HUGS__ import PrelShow ( lines, words, unlines, unwords )  sof committed Jan 14, 1999 139 import PrelBase ( Int(..), map, (++) )  simonm committed Feb 02, 1998 140 import PrelGHC ( (+#) )  andy committed Oct 29, 1999 141 #endif  sof committed Mar 14, 1997 142   andy committed Oct 29, 1999 143 infix 5 \\  simonpj committed Dec 19, 1996 144 \end{code}  partain committed Jun 27, 1996 145   simonpj committed Dec 19, 1996 146 147 148 149 150 151 152 %********************************************************* %* * \subsection{List functions} %* * %********************************************************* \begin{code}  sof committed Mar 14, 1997 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]  simonm committed Jan 08, 1998 166   simonm committed Feb 02, 1998 167 168 169 #ifdef USE_REPORT_PRELUDE findIndices p xs = [ i | (x,i) <- zip xs [0..], p x] #else  andy committed Apr 10, 2000 170 171 172 #ifdef __HUGS__ findIndices p xs = [ i | (x,i) <- zip xs [0..], p x] #else  simonm committed Jan 08, 1998 173 -- Efficient definition  sof committed Jan 14, 1999 174 findIndices p ls = loop 0# ls  simonm committed Jan 08, 1998 175  where  sof committed Jan 14, 1999 176 177 178  loop _ [] = [] loop n (x:xs) | p x = I# n : loop (n +# 1#) xs | otherwise = loop (n +# 1#) xs  andy committed Apr 10, 2000 179 180 #endif /* __HUGS__ */ #endif /* USE_REPORT_PRELUDE */  sof committed Mar 14, 1997 181   sof committed May 18, 1997 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 committed Mar 14, 1997 190 191 -- nub (meaning "essence") remove duplicate elements from its list argument. nub :: (Eq a) => [a] -> [a]  sof committed May 18, 1997 192 #ifdef USE_REPORT_PRELUDE  sof committed Mar 14, 1997 193 nub = nubBy (==)  sof committed May 18, 1997 194 195 #else -- stolen from HBC  andy committed Oct 29, 1999 196 nub l = nub' l [] -- '  sof committed May 18, 1997 197  where  andy committed Oct 29, 1999 198 199 200 201  nub' [] _ = [] -- ' nub' (x:xs) ls -- ' | x elem ls = nub' xs ls -- ' | otherwise = x : nub' xs (x:ls) -- '  sof committed May 18, 1997 202 #endif  sof committed Mar 14, 1997 203 204  nubBy :: (a -> a -> Bool) -> [a] -> [a]  sof committed May 18, 1997 205 #ifdef USE_REPORT_PRELUDE  sof committed Mar 14, 1997 206 207 nubBy eq [] = [] nubBy eq (x:xs) = x : nubBy eq (filter (\ y -> not (eq x y)) xs)  sof committed May 18, 1997 208 209 210 211 #else nubBy eq l = nubBy' l [] where nubBy' [] _ = []  simonpj committed Jun 25, 2001 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 committed May 18, 1997 224 #endif  sof committed Mar 14, 1997 225   sof committed Aug 25, 1997 226   partain committed Jun 27, 1996 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 committed Jan 14, 1999 232 deleteBy _ _ [] = []  partain committed Jul 25, 1996 233 deleteBy eq x (y:ys) = if x eq y then ys else y : deleteBy eq x ys  partain committed Jun 27, 1996 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)  partain committed Jul 25, 1996 237 -- has been removed from xs. Thus, (xs ++ ys) \\ xs == ys.  partain committed Jun 27, 1996 238 239 240 (\\) :: (Eq a) => [a] -> [a] -> [a] (\\) = foldl (flip delete)  sof committed Mar 14, 1997 241 -- List union, remove the elements of first list from second.  sof committed May 18, 1997 242 243 union :: (Eq a) => [a] -> [a] -> [a] union = unionBy (==)  partain committed Jun 27, 1996 244   sof committed May 18, 1997 245 unionBy :: (a -> a -> Bool) -> [a] -> [a] -> [a]  sof committed Oct 21, 1997 246 unionBy eq xs ys = xs ++ foldl (flip (deleteBy eq)) (nubBy eq ys) xs  sof committed May 18, 1997 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]  partain committed Jun 27, 1996 253   sof committed Mar 14, 1997 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 committed Jan 14, 1999 257 258 intersperse _ [] = [] intersperse _ [x] = [x]  sof committed Mar 14, 1997 259 intersperse sep (x:xs) = x : sep : intersperse sep xs  partain committed Jun 27, 1996 260   sof committed Mar 14, 1997 261 transpose :: [[a]] -> [[a]]  sof committed Jan 14, 1999 262 263 264 transpose [] = [] transpose ([] : xss) = transpose xss transpose ((x:xs) : xss) = (x : [h | (h:t) <- xss]) : transpose (xs : [ t | (h:t) <- xss])  partain committed Jun 27, 1996 265   sof committed Mar 14, 1997 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])  simonpj committed Jul 06, 1999 272 273 274 {-# INLINE partition #-} partition p xs = foldr (select p) ([],[]) xs  simonmar committed Jun 19, 2000 275 276 select p x (ts,fs) | p x = (x:ts,fs) | otherwise = (ts, x:fs)  sof committed Aug 25, 1997 277 \end{code}  sof committed Mar 14, 1997 278   sof committed Aug 25, 1997 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 committed Mar 14, 1997 284   sof committed Aug 25, 1997 285 \begin{code}  sof committed Mar 14, 1997 286   sof committed Aug 25, 1997 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 committed Jan 14, 1999 293 mapAccumL _ s [] = (s, [])  sof committed Mar 14, 1997 294 295 296 mapAccumL f s (x:xs) = (s'',y:ys) where (s', y ) = f s x (s'',ys) = mapAccumL f s' xs  sof committed Aug 25, 1997 297 \end{code}  sof committed Mar 14, 1997 298   sof committed Aug 25, 1997 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 committed Jan 14, 1999 309 mapAccumR _ s [] = (s, [])  sof committed Mar 14, 1997 310 311 312 mapAccumR f s (x:xs) = (s'', y:ys) where (s'',y ) = f s' x (s', ys) = mapAccumR f s xs  sof committed Aug 25, 1997 313 314 315 \end{code} \begin{code}  sof committed Jan 14, 1999 316 317 318 insert :: Ord a => a -> [a] -> [a] insert e ls = insertBy (compare) e ls  sof committed Mar 14, 1997 319 insertBy :: (a -> a -> Ordering) -> a -> [a] -> [a]  sof committed Jan 14, 1999 320 insertBy _ x [] = [x]  sof committed Mar 14, 1997 321 322 323 324 insertBy cmp x ys@(y:ys') = case cmp x y of GT -> y : insertBy cmp x ys' _ -> x : ys  partain committed Jun 27, 1996 325   simonmar committed Aug 29, 2001 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  partain committed Jun 27, 1996 341   sof committed Mar 14, 1997 342 343 344 genericLength :: (Num i) => [b] -> i genericLength [] = 0 genericLength (_:l) = 1 + genericLength l  partain committed Jun 27, 1996 345   sof committed Mar 14, 1997 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"  partain committed Jun 27, 1996 351   sof committed Mar 14, 1997 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"  partain committed Jun 27, 1996 357   sof committed Mar 14, 1997 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"  partain committed Jun 27, 1996 364   sof committed Mar 14, 1997 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."  partain committed Jun 27, 1996 372   sof committed Aug 25, 1997 373 374 375 376 genericReplicate :: (Integral i) => i -> a -> [a] genericReplicate n x = genericTake n (repeat x)  partain committed Jun 27, 1996 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 committed Mar 14, 1997 436 437 deleteFirstsBy :: (a -> a -> Bool) -> [a] -> [a] -> [a] deleteFirstsBy eq = foldl (flip (deleteBy eq))  partain committed Jun 27, 1996 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 committed Jan 14, 1999 447 groupBy _ [] = []  partain committed Jun 27, 1996 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  simonpj committed Dec 19, 1996 463 \end{code}  simonm committed Feb 02, 1998 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 committed Jan 14, 1999 483 484 485 qsort :: (a -> a -> Ordering) -> [a] -> [a] -> [a] qsort _ [] r = r qsort _ [x] r = x:r  simonm committed Feb 02, 1998 486 487 488 qsort cmp (x:xs) r = qpart cmp x xs [] [] r -- qpart partitions and sorts the sublists  sof committed Jan 14, 1999 489 qpart :: (a -> a -> Ordering) -> a -> [a] -> [a] -> [a] -> [a] -> [a]  simonm committed Feb 02, 1998 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 committed Jan 14, 1999 500 501 502 rqsort :: (a -> a -> Ordering) -> [a] -> [a] -> [a] rqsort _ [] r = r rqsort _ [x] r = x:r  simonm committed Feb 02, 1998 503 504 rqsort cmp (x:xs) r = rqpart cmp x xs [] [] r  sof committed Jan 14, 1999 505 rqpart :: (a -> a -> Ordering) -> a -> [a] -> [a] -> [a] -> [a] -> [a]  simonm committed Feb 02, 1998 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 committed Jan 14, 1999 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}