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