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