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