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