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
  23    -- * Basic functions
  24
  25      (++)              -- :: [a] -> [a] -> [a]
  26    , head              -- :: [a] -> a
  27    , last              -- :: [a] -> a
  28    , tail              -- :: [a] -> [a]
  29    , init              -- :: [a] -> [a]
  30    , null              -- :: [a] -> Bool
  31    , length            -- :: [a] -> Int
  32
  33    -- * List transformations
  34    , map               -- :: (a -> b) -> [a] -> [b]
  35    , reverse           -- :: [a] -> [a]
  36
  37    , intersperse       -- :: a -> [a] -> [a]
  38    , transpose         -- :: [[a]] -> [[a]]
  39
  40    -- * Reducing lists (folds)
  41
  42    , foldl             -- :: (a -> b -> a) -> a -> [b] -> a
  43    , foldl'            -- :: (a -> b -> a) -> a -> [b] -> a
  44    , foldl1            -- :: (a -> a -> a) -> [a] -> a
  45    , foldr             -- :: (a -> b -> b) -> b -> [a] -> b
  46    , foldr1            -- :: (a -> a -> a) -> [a] -> a
  47
  48    -- ** Special folds
  49
  50    , concat            -- :: [[a]] -> [a]
  51    , concatMap         -- :: (a -> [b]) -> [a] -> [b]
  52    , and               -- :: [Bool] -> Bool
  53    , or                -- :: [Bool] -> Bool
  54    , any               -- :: (a -> Bool) -> [a] -> Bool
  55    , all               -- :: (a -> Bool) -> [a] -> Bool
  56    , sum               -- :: (Num a) => [a] -> a
  57    , product           -- :: (Num a) => [a] -> a
  58    , maximum           -- :: (Ord a) => [a] -> a
  59    , minimum           -- :: (Ord a) => [a] -> a
  60
  61    -- * Building lists
  62
  63    -- ** Scans
  64    , scanl             -- :: (a -> b -> a) -> a -> [b] -> [a]
  65    , scanl1            -- :: (a -> a -> a) -> [a] -> [a]
  66    , scanr             -- :: (a -> b -> b) -> b -> [a] -> [b]
  67    , scanr1            -- :: (a -> a -> a) -> [a] -> [a]
  68
  69    -- ** Accumulating maps
  70    , mapAccumL         -- :: (a -> b -> (a,c)) -> a -> [b] -> (a,[c])
  71    , mapAccumR         -- :: (a -> b -> (a,c)) -> a -> [b] -> (a,[c])
  72
  73    -- ** Infinite lists
  74    , iterate           -- :: (a -> a) -> a -> [a]
  75    , repeat            -- :: a -> [a]
  76    , replicate         -- :: Int -> a -> [a]
  77    , cycle             -- :: [a] -> [a]
  78
  79    -- ** Unfolding
  80    , unfoldr           -- :: (b -> Maybe (a, b)) -> b -> [a]
  81
  82    -- * Sublists
  83
  84    -- ** Extracting sublists
  85    , take              -- :: Int -> [a] -> [a]
  86    , drop              -- :: Int -> [a] -> [a]
  87    , splitAt           -- :: Int -> [a] -> ([a], [a])
  88
  89    , takeWhile         -- :: (a -> Bool) -> [a] -> [a]
  90    , dropWhile         -- :: (a -> Bool) -> [a] -> [a]
  91    , span              -- :: (a -> Bool) -> [a] -> ([a], [a])
  92    , break             -- :: (a -> Bool) -> [a] -> ([a], [a])
  93
  94    , group             -- :: Eq a => [a] -> [[a]]
  95
  96    , inits             -- :: [a] -> [[a]]
  97    , tails             -- :: [a] -> [[a]]
  98
  99    -- ** Predicates
 100    , isPrefixOf        -- :: (Eq a) => [a] -> [a] -> Bool
 101    , isSuffixOf        -- :: (Eq a) => [a] -> [a] -> Bool
 102
 103    -- * Searching lists
 104
 105    -- ** Searching by equality
 106    , elem              -- :: a -> [a] -> Bool
 107    , notElem           -- :: a -> [a] -> Bool
 108    , lookup            -- :: (Eq a) => a -> [(a,b)] -> Maybe b
 109
 110    -- ** Searching with a predicate
 111    , find              -- :: (a -> Bool) -> [a] -> Maybe a
 112    , filter            -- :: (a -> Bool) -> [a] -> [a]
 113    , partition         -- :: (a -> Bool) -> [a] -> ([a], [a])
 114
 115    -- * Indexing lists
 116    -- | These functions treat a list @xs@ as a indexed collection,
 117    -- with indices ranging from 0 to @'length' xs - 1@.
 118
 119    , (!!)              -- :: [a] -> Int -> a
 120
 121    , elemIndex         -- :: (Eq a) => a -> [a] -> Maybe Int
 122    , elemIndices       -- :: (Eq a) => a -> [a] -> [Int]
 123
 124    , findIndex         -- :: (a -> Bool) -> [a] -> Maybe Int
 125    , findIndices       -- :: (a -> Bool) -> [a] -> [Int]
 126
 127    -- * Zipping and unzipping lists
 128
 129    , zip               -- :: [a] -> [b] -> [(a,b)]
 130    , zip3
 131    , zip4, zip5, zip6, zip7
 132
 133    , zipWith           -- :: (a -> b -> c) -> [a] -> [b] -> [c]
 134    , zipWith3
 135    , zipWith4, zipWith5, zipWith6, zipWith7
 136
 137    , unzip             -- :: [(a,b)] -> ([a],[b])
 138    , unzip3
 139    , unzip4, unzip5, unzip6, unzip7
 140
 141    -- * Special lists
 142
 143    -- ** Functions on strings
 144    , lines             -- :: String   -> [String]
 145    , words             -- :: String   -> [String]
 146    , unlines           -- :: [String] -> String
 147    , unwords           -- :: [String] -> String
 148
 149    -- ** \"Set\" operations
 150
 151    , nub               -- :: (Eq a) => [a] -> [a]
 152
 153    , delete            -- :: (Eq a) => a -> [a] -> [a]
 154    , (\\)              -- :: (Eq a) => [a] -> [a] -> [a]
 155
 156    , union             -- :: (Eq a) => [a] -> [a] -> [a]
 157    , intersect         -- :: (Eq a) => [a] -> [a] -> [a]
 158
 159    -- ** Ordered lists
 160    , sort              -- :: (Ord a) => [a] -> [a]
 161    , insert            -- :: (Ord a) => a -> [a] -> [a]
 162
 163    -- * Generalized functions
 164
 165    -- ** The \"@By@\" operations
 166    -- | By convention, overloaded functions have a non-overloaded
 167    -- counterpart whose name is suffixed with \`@By@\'.
 168
 169    -- *** User-supplied equality (replacing an @Eq@ context)
 170    -- | The predicate is assumed to define an equivalence.
 171    , nubBy             -- :: (a -> a -> Bool) -> [a] -> [a]
 172    , deleteBy          -- :: (a -> a -> Bool) -> a -> [a] -> [a]
 173    , deleteFirstsBy    -- :: (a -> a -> Bool) -> [a] -> [a] -> [a]
 174    , unionBy           -- :: (a -> a -> Bool) -> [a] -> [a] -> [a]
 175    , intersectBy       -- :: (a -> a -> Bool) -> [a] -> [a] -> [a]
 176    , groupBy           -- :: (a -> a -> Bool) -> [a] -> [[a]]
 177
 178    -- *** User-supplied comparison (replacing an @Ord@ context)
 179    -- | The function is assumed to define a total ordering.
 180    , sortBy            -- :: (a -> a -> Ordering) -> [a] -> [a]
 181    , insertBy          -- :: (a -> a -> Ordering) -> a -> [a] -> [a]
 182    , maximumBy         -- :: (a -> a -> Ordering) -> [a] -> a
 183    , minimumBy         -- :: (a -> a -> Ordering) -> [a] -> a
 184
 185    -- ** The \"@generic@\" operations
 186    -- | The prefix \`@generic@\' indicates an overloaded function that
 187    -- is a generalized version of a "Prelude" function.
 188
 189    , genericLength     -- :: (Integral a) => [b] -> a
 190    , genericTake       -- :: (Integral a) => a -> [b] -> [b]
 191    , genericDrop       -- :: (Integral a) => a -> [b] -> [b]
 192    , genericSplitAt    -- :: (Integral a) => a -> [b] -> ([b], [b])
 193    , genericIndex      -- :: (Integral a) => [b] -> a -> b
 194    , genericReplicate  -- :: (Integral a) => a -> b -> [b]
 195
 196    ) where
 197
 198 #ifdef __NHC__
 199 import Prelude hiding (Maybe(..))
 200 #endif
 201
 202 import Data.Maybe
 203 import Data.Char        ( isSpace )
 204
 205 #ifdef __GLASGOW_HASKELL__
 206 import GHC.Num
 207 import GHC.Real
 208 import GHC.List
 209 import GHC.Base
 210 #endif
 211
 212 infix 5 \\
 213
 214 -- -----------------------------------------------------------------------------
 215 -- List functions
 216
 217 -- | The 'elemIndex' function returns the index of the first element
 218 -- in the given list which is equal (by '==') to the query element,
 219 -- or 'Nothing' if there is no such element.
 220 elemIndex       :: Eq a => a -> [a] -> Maybe Int
 221 elemIndex x     = findIndex (x==)
 222
 223 -- | The 'elemIndices' function extends 'elemIndex', by returning the
 224 -- indices of all elements equal to the query element, in ascending order.
 225 elemIndices     :: Eq a => a -> [a] -> [Int]
 226 elemIndices x   = findIndices (x==)
 227
 228 -- | The 'find' function takes a predicate and a list and returns the
 229 -- first element in the list matching the predicate, or 'Nothing' if
 230 -- there is no such element.
 231 find            :: (a -> Bool) -> [a] -> Maybe a
 232 find p          = listToMaybe . filter p
 233
 234 -- | The 'findIndex' function takes a predicate and a list and returns
 235 -- the index of the first element in the list satisfying the predicate,
 236 -- or 'Nothing' if there is no such element.
 237 findIndex       :: (a -> Bool) -> [a] -> Maybe Int
 238 findIndex p     = listToMaybe . findIndices p
 239
 240 -- | The 'findIndices' function extends 'findIndex', by returning the
 241 -- indices of all elements satisfying the predicate, in ascending order.
 242 findIndices      :: (a -> Bool) -> [a] -> [Int]
 243
 244 #if defined(USE_REPORT_PRELUDE) || !defined(__GLASGOW_HASKELL__)
 245 findIndices p xs = [ i | (x,i) <- zip xs [0..], p x]
 246 #else
 247 -- Efficient definition
 248 findIndices p ls = loop 0# ls
 249                  where
 250                    loop _ [] = []
 251                    loop n (x:xs) | p x       = I# n : loop (n +# 1#) xs
 252                                  | otherwise = loop (n +# 1#) xs
 253 #endif  /* USE_REPORT_PRELUDE */
 254
 255 -- | The 'isPrefixOf' function takes two lists and returns 'True'
 256 -- iff the first list is a prefix of the second.
 257 isPrefixOf              :: (Eq a) => [a] -> [a] -> Bool
 258 isPrefixOf [] _         =  True
 259 isPrefixOf _  []        =  False
 260 isPrefixOf (x:xs) (y:ys)=  x == y && isPrefixOf xs ys
 261
 262 -- | The 'isSuffixOf' function takes two lists and returns 'True'
 263 -- iff the first list is a suffix of the second.
 264 -- Both lists must be finite.
 265 isSuffixOf              :: (Eq a) => [a] -> [a] -> Bool
 266 isSuffixOf x y          =  reverse x `isPrefixOf` reverse y
 267
 268 -- | The 'nub' function removes duplicate elements from a list.
 269 -- In particular, it keeps only the first occurrence of each element.
 270 -- (The name 'nub' means \`essence\'.)
 271 -- It is a special case of 'nubBy', which allows the programmer to supply
 272 -- their own equality test.
 273 nub                     :: (Eq a) => [a] -> [a]
 274 #ifdef USE_REPORT_PRELUDE
 275 nub                     =  nubBy (==)
 276 #else
 277 -- stolen from HBC
 278 nub l                   = nub' l []             -- '
 279   where
 280     nub' [] _           = []                    -- '
 281     nub' (x:xs) ls                              -- '
 282         | x `elem` ls   = nub' xs ls            -- '
 283         | otherwise     = x : nub' xs (x:ls)    -- '
 284 #endif
 285
 286 -- | The 'nubBy' function behaves just like 'nub', except it uses a
 287 -- user-supplied equality predicate instead of the overloaded '=='
 288 -- function.
 289 nubBy                   :: (a -> a -> Bool) -> [a] -> [a]
 290 #ifdef USE_REPORT_PRELUDE
 291 nubBy eq []             =  []
 292 nubBy eq (x:xs)         =  x : nubBy eq (filter (\ y -> not (eq x y)) xs)
 293 #else
 294 nubBy eq l              = nubBy' l []
 295   where
 296     nubBy' [] _         = []
 297     nubBy' (y:ys) xs
 298        | elem_by eq y xs = nubBy' ys xs
 299        | otherwise       = y : nubBy' ys (y:xs)
 300
 301 -- Not exported:
 302 -- Note that we keep the call to `eq` with arguments in the
 303 -- same order as in the reference implementation
 304 -- 'xs' is the list of things we've seen so far,
 305 -- 'y' is the potential new element
 306 elem_by :: (a -> a -> Bool) -> a -> [a] -> Bool
 307 elem_by _  _ []         =  False
 308 elem_by eq y (x:xs)     =  x `eq` y || elem_by eq y xs
 309 #endif
 310
 311
 312 -- | 'delete' @x@ removes the first occurrence of @x@ from its list argument.
 313 -- For example,
 314 --
 315 -- > delete 'a' "banana" == "bnana"
 316 --
 317 -- It is a special case of 'deleteBy', which allows the programmer to
 318 -- supply their own equality test.
 319
 320 delete                  :: (Eq a) => a -> [a] -> [a]
 321 delete                  =  deleteBy (==)
 322
 323 -- | The 'deleteBy' function behaves like 'delete', but takes a
 324 -- user-supplied equality predicate.
 325 deleteBy                :: (a -> a -> Bool) -> a -> [a] -> [a]
 326 deleteBy _  _ []        = []
 327 deleteBy eq x (y:ys)    = if x `eq` y then ys else y : deleteBy eq x ys
 328
 329 -- | The '\\' function is list difference ((non-associative).
 330 -- In the result of @xs@ '\\' @ys@, the first occurrence of each element of
 331 -- @ys@ in turn (if any) has been removed from @xs@.  Thus
 332 --
 333 -- > (xs ++ ys) \\ xs == ys.
 334 --
 335 -- It is a special case of 'deleteFirstsBy', which allows the programmer
 336 -- to supply their own equality test.
 337
 338 (\\)                    :: (Eq a) => [a] -> [a] -> [a]
 339 (\\)                    =  foldl (flip delete)
 340
 341 -- | The 'union' function returns the list union of the two lists.
 342 -- For example,
 343 --
 344 -- > "dog" `union` "cow" == "dogcw"
 345 --
 346 -- Duplicates, and elements of the first list, are removed from the
 347 -- the second list, but if the first list contains duplicates, so will
 348 -- the result.
 349 -- It is a special case of 'unionBy', which allows the programmer to supply
 350 -- their own equality test.
 351
 352 union                   :: (Eq a) => [a] -> [a] -> [a]
 353 union                   = unionBy (==)
 354
 355 -- | The 'unionBy' function is the non-overloaded version of 'union'.
 356 unionBy                 :: (a -> a -> Bool) -> [a] -> [a] -> [a]
 357 unionBy eq xs ys        =  xs ++ foldl (flip (deleteBy eq)) (nubBy eq ys) xs
 358
 359 -- | The 'intersect' function takes the list intersection of two lists.
 360 -- For example,
 361 --
 362 -- > [1,2,3,4] `intersect` [2,4,6,8] == [2,4]
 363 --
 364 -- If the first list contains duplicates, so will the result.
 365 -- It is a special case of 'intersectBy', which allows the programmer to
 366 -- supply their own equality test.
 367
 368 intersect               :: (Eq a) => [a] -> [a] -> [a]
 369 intersect               =  intersectBy (==)
 370
 371 -- | The 'intersectBy' function is the non-overloaded version of 'intersect'.
 372 intersectBy             :: (a -> a -> Bool) -> [a] -> [a] -> [a]
 373 intersectBy eq xs ys    =  [x | x <- xs, any (eq x) ys]
 374
 375 -- | The 'intersperse' function takes an element and a list and
 376 -- \`intersperses\' that element between the elements of the list.
 377 -- For example,
 378 --
 379 -- > intersperse ',' "abcde" == "a,b,c,d,e"
 380
 381 intersperse             :: a -> [a] -> [a]
 382 intersperse _   []      = []
 383 intersperse _   [x]     = [x]
 384 intersperse sep (x:xs)  = x : sep : intersperse sep xs
 385
 386 -- | The 'transpose' function transposes the rows and columns of its argument.
 387 -- For example,
 388 --
 389 -- > transpose [[1,2,3],[4,5,6]] == [[1,4],[2,5],[3,6]]
 390
 391 transpose               :: [[a]] -> [[a]]
 392 transpose []             = []
 393 transpose ([]   : xss)   = transpose xss
 394 transpose ((x:xs) : xss) = (x : [h | (h:t) <- xss]) : transpose (xs : [ t | (h:t) <- xss])
 395
 396
 397 -- | The 'partition' function takes a predicate a list and returns
 398 -- the pair of lists of elements which do and do not satisfy the
 399 -- predicate, respectively; i.e.,
 400 --
 401 -- > partition p xs == (filter p xs, filter (not . p) xs)
 402
 403 partition               :: (a -> Bool) -> [a] -> ([a],[a])
 404 {-# INLINE partition #-}
 405 partition p xs = foldr (select p) ([],[]) xs
 406
 407 select p x (ts,fs) | p x       = (x:ts,fs)
 408                    | otherwise = (ts, x:fs)
 409
 410 -- | The 'mapAccumL' function behaves like a combination of 'map' and
 411 -- 'foldl'; it applies a function to each element of a list, passing
 412 -- an accumulating parameter from left to right, and returning a final
 413 -- value of this accumulator together with the new list.
 414 mapAccumL :: (acc -> x -> (acc, y)) -- Function of elt of input list
 415                                     -- and accumulator, returning new
 416                                     -- accumulator and elt of result list
 417           -> acc            -- Initial accumulator
 418           -> [x]            -- Input list
 419           -> (acc, [y])     -- Final accumulator and result list
 420 mapAccumL _ s []        =  (s, [])
 421 mapAccumL f s (x:xs)    =  (s'',y:ys)
 422                            where (s', y ) = f s x
 423                                  (s'',ys) = mapAccumL f s' xs
 424
 425 -- | The 'mapAccumR' function behaves like a combination of 'map' and
 426 -- 'foldr'; it applies a function to each element of a list, passing
 427 -- an accumulating parameter from right to left, and returning a final
 428 -- value of this accumulator together with the new list.
 429 mapAccumR :: (acc -> x -> (acc, y))     -- Function of elt of input list
 430                                         -- and accumulator, returning new
 431                                         -- accumulator and elt of result list
 432             -> acc              -- Initial accumulator
 433             -> [x]              -- Input list
 434             -> (acc, [y])               -- Final accumulator and result list
 435 mapAccumR _ s []        =  (s, [])
 436 mapAccumR f s (x:xs)    =  (s'', y:ys)
 437                            where (s'',y ) = f s' x
 438                                  (s', ys) = mapAccumR f s xs
 439
 440 -- | The 'insert' function takes an element and a list and inserts the
 441 -- element into the list at the last position where it is still less
 442 -- than or equal to the next element.  In particular, if the list
 443 -- is sorted before the call, the result will also be sorted.
 444 -- It is a special case of 'insertBy', which allows the programmer to
 445 -- supply their own comparison function.
 446 insert :: Ord a => a -> [a] -> [a]
 447 insert e ls = insertBy (compare) e ls
 448
 449 -- | The non-overloaded version of 'insert'.
 450 insertBy :: (a -> a -> Ordering) -> a -> [a] -> [a]
 451 insertBy _   x [] = [x]
 452 insertBy cmp x ys@(y:ys')
 453  = case cmp x y of
 454      GT -> y : insertBy cmp x ys'
 455      _  -> x : ys
 456
 457 -- | The 'maximumBy' function takes a comparison function and a list
 458 -- and returns the greatest element of the list by the comparison function.
 459 -- The list must be finite and non-empty.
 460 maximumBy               :: (a -> a -> Ordering) -> [a] -> a
 461 maximumBy _ []          =  error "List.maximumBy: empty list"
 462 maximumBy cmp xs        =  foldl1 max xs
 463                         where
 464                            max x y = case cmp x y of
 465                                         GT -> x
 466                                         _  -> y
 467
 468 -- | The 'minimumBy' function takes a comparison function and a list
 469 -- and returns the least element of the list by the comparison function.
 470 -- The list must be finite and non-empty.
 471 minimumBy               :: (a -> a -> Ordering) -> [a] -> a
 472 minimumBy _ []          =  error "List.minimumBy: empty list"
 473 minimumBy cmp xs        =  foldl1 min xs
 474                         where
 475                            min x y = case cmp x y of
 476                                         GT -> y
 477                                         _  -> x
 478
 479 -- | The 'genericLength' function is an overloaded version of 'length'.  In
 480 -- particular, instead of returning an 'Int', it returns any type which is
 481 -- an instance of 'Num'.  It is, however, less efficient than 'length'.
 482 genericLength           :: (Num i) => [b] -> i
 483 genericLength []        =  0
 484 genericLength (_:l)     =  1 + genericLength l
 485
 486 -- | The 'genericTake' function is an overloaded version of 'take', which
 487 -- accepts any 'Integral' value as the number of elements to take.
 488 genericTake             :: (Integral i) => i -> [a] -> [a]
 489 genericTake 0 _         =  []
 490 genericTake _ []        =  []
 491 genericTake n (x:xs) | n > 0  =  x : genericTake (n-1) xs
 492 genericTake _  _        =  error "List.genericTake: negative argument"
 493
 494 -- | The 'genericDrop' function is an overloaded version of 'drop', which
 495 -- accepts any 'Integral' value as the number of elements to drop.
 496 genericDrop             :: (Integral i) => i -> [a] -> [a]
 497 genericDrop 0 xs        =  xs
 498 genericDrop _ []        =  []
 499 genericDrop n (_:xs) | n > 0  =  genericDrop (n-1) xs
 500 genericDrop _ _         =  error "List.genericDrop: negative argument"
 501
 502 -- | The 'genericSplitAt' function is an overloaded version of 'splitAt', which
 503 -- accepts any 'Integral' value as the position at which to split.
 504 genericSplitAt          :: (Integral i) => i -> [b] -> ([b],[b])
 505 genericSplitAt 0 xs     =  ([],xs)
 506 genericSplitAt _ []     =  ([],[])
 507 genericSplitAt n (x:xs) | n > 0  =  (x:xs',xs'') where
 508                                (xs',xs'') = genericSplitAt (n-1) xs
 509 genericSplitAt _ _      =  error "List.genericSplitAt: negative argument"
 510
 511 -- | The 'genericIndex' function is an overloaded version of '!!', which
 512 -- accepts any 'Integral' value as the index.
 513 genericIndex :: (Integral a) => [b] -> a -> b
 514 genericIndex (x:_)  0 = x
 515 genericIndex (_:xs) n
 516  | n > 0     = genericIndex xs (n-1)
 517  | otherwise = error "List.genericIndex: negative argument."
 518 genericIndex _ _      = error "List.genericIndex: index too large."
 519
 520 -- | The 'genericReplicate' function is an overloaded version of 'replicate',
 521 -- which accepts any 'Integral' value as the number of repetitions to make.
 522 genericReplicate        :: (Integral i) => i -> a -> [a]
 523 genericReplicate n x    =  genericTake n (repeat x)
 524
 525 -- | The 'zip4' function takes four lists and returns a list of
 526 -- quadruples, analogous to 'zip'.
 527 zip4                    :: [a] -> [b] -> [c] -> [d] -> [(a,b,c,d)]
 528 zip4                    =  zipWith4 (,,,)
 529
 530 -- | The 'zip5' function takes five lists and returns a list of
 531 -- five-tuples, analogous to 'zip'.
 532 zip5                    :: [a] -> [b] -> [c] -> [d] -> [e] -> [(a,b,c,d,e)]
 533 zip5                    =  zipWith5 (,,,,)
 534
 535 -- | The 'zip6' function takes six lists and returns a list of six-tuples,
 536 -- analogous to 'zip'.
 537 zip6                    :: [a] -> [b] -> [c] -> [d] -> [e] -> [f] ->
 538                               [(a,b,c,d,e,f)]
 539 zip6                    =  zipWith6 (,,,,,)
 540
 541 -- | The 'zip7' function takes seven lists and returns a list of
 542 -- seven-tuples, analogous to 'zip'.
 543 zip7                    :: [a] -> [b] -> [c] -> [d] -> [e] -> [f] ->
 544                               [g] -> [(a,b,c,d,e,f,g)]
 545 zip7                    =  zipWith7 (,,,,,,)
 546
 547 -- | The 'zipWith4' function takes a function which combines four
 548 -- elements, as well as four lists and returns a list of their point-wise
 549 -- combination, analogous to 'zipWith'.
 550 zipWith4                :: (a->b->c->d->e) -> [a]->[b]->[c]->[d]->[e]
 551 zipWith4 z (a:as) (b:bs) (c:cs) (d:ds)
 552                         =  z a b c d : zipWith4 z as bs cs ds
 553 zipWith4 _ _ _ _ _      =  []
 554
 555 -- | The 'zipWith5' function takes a function which combines five
 556 -- elements, as well as five lists and returns a list of their point-wise
 557 -- combination, analogous to 'zipWith'.
 558 zipWith5                :: (a->b->c->d->e->f) ->
 559                            [a]->[b]->[c]->[d]->[e]->[f]
 560 zipWith5 z (a:as) (b:bs) (c:cs) (d:ds) (e:es)
 561                         =  z a b c d e : zipWith5 z as bs cs ds es
 562 zipWith5 _ _ _ _ _ _    = []
 563
 564 -- | The 'zipWith6' function takes a function which combines six
 565 -- elements, as well as six lists and returns a list of their point-wise
 566 -- combination, analogous to 'zipWith'.
 567 zipWith6                :: (a->b->c->d->e->f->g) ->
 568                            [a]->[b]->[c]->[d]->[e]->[f]->[g]
 569 zipWith6 z (a:as) (b:bs) (c:cs) (d:ds) (e:es) (f:fs)
 570                         =  z a b c d e f : zipWith6 z as bs cs ds es fs
 571 zipWith6 _ _ _ _ _ _ _  = []
 572
 573 -- | The 'zipWith7' function takes a function which combines seven
 574 -- elements, as well as seven lists and returns a list of their point-wise
 575 -- combination, analogous to 'zipWith'.
 576 zipWith7                :: (a->b->c->d->e->f->g->h) ->
 577                            [a]->[b]->[c]->[d]->[e]->[f]->[g]->[h]
 578 zipWith7 z (a:as) (b:bs) (c:cs) (d:ds) (e:es) (f:fs) (g:gs)
 579                    =  z a b c d e f g : zipWith7 z as bs cs ds es fs gs
 580 zipWith7 _ _ _ _ _ _ _ _ = []
 581
 582 -- | The 'unzip4' function takes a list of quadruples and returns four
 583 -- lists, analogous to 'unzip'.
 584 unzip4                  :: [(a,b,c,d)] -> ([a],[b],[c],[d])
 585 unzip4                  =  foldr (\(a,b,c,d) ~(as,bs,cs,ds) ->
 586                                         (a:as,b:bs,c:cs,d:ds))
 587                                  ([],[],[],[])
 588
 589 -- | The 'unzip5' function takes a list of five-tuples and returns five
 590 -- lists, analogous to 'unzip'.
 591 unzip5                  :: [(a,b,c,d,e)] -> ([a],[b],[c],[d],[e])
 592 unzip5                  =  foldr (\(a,b,c,d,e) ~(as,bs,cs,ds,es) ->
 593                                         (a:as,b:bs,c:cs,d:ds,e:es))
 594                                  ([],[],[],[],[])
 595
 596 -- | The 'unzip6' function takes a list of six-tuples and returns six
 597 -- lists, analogous to 'unzip'.
 598 unzip6                  :: [(a,b,c,d,e,f)] -> ([a],[b],[c],[d],[e],[f])
 599 unzip6                  =  foldr (\(a,b,c,d,e,f) ~(as,bs,cs,ds,es,fs) ->
 600                                         (a:as,b:bs,c:cs,d:ds,e:es,f:fs))
 601                                  ([],[],[],[],[],[])
 602
 603 -- | The 'unzip7' function takes a list of seven-tuples and returns
 604 -- seven lists, analogous to 'unzip'.
 605 unzip7          :: [(a,b,c,d,e,f,g)] -> ([a],[b],[c],[d],[e],[f],[g])
 606 unzip7          =  foldr (\(a,b,c,d,e,f,g) ~(as,bs,cs,ds,es,fs,gs) ->
 607                                 (a:as,b:bs,c:cs,d:ds,e:es,f:fs,g:gs))
 608                          ([],[],[],[],[],[],[])
 609
 610
 611 -- | The 'deleteFirstsBy' function takes a predicate and two lists and
 612 -- returns the first list with the first occurrence of each element of
 613 -- the second list removed.
 614 deleteFirstsBy          :: (a -> a -> Bool) -> [a] -> [a] -> [a]
 615 deleteFirstsBy eq       =  foldl (flip (deleteBy eq))
 616
 617 -- | The 'group' function takes a list and returns a list of lists such
 618 -- that the concatenation of the result is equal to the argument.  Moreover,
 619 -- each sublist in the result contains only equal elements.  For example,
 620 --
 621 -- > group "Mississippi" = ["M","i","ss","i","ss","i","pp","i"]
 622 --
 623 -- It is a special case of 'groupBy', which allows the programmer to supply
 624 -- their own equality test.
 625 group                   :: Eq a => [a] -> [[a]]
 626 group                   =  groupBy (==)
 627
 628 -- | The 'groupBy' function is the non-overloaded version of 'group'.
 629 groupBy                 :: (a -> a -> Bool) -> [a] -> [[a]]
 630 groupBy _  []           =  []
 631 groupBy eq (x:xs)       =  (x:ys) : groupBy eq zs
 632                            where (ys,zs) = span (eq x) xs
 633
 634 -- | The 'inits' function returns all initial segments of the argument,
 635 -- shortest first.  For example,
 636 --
 637 -- > inits "abc" == ["","a","ab","abc"]
 638 --
 639 inits                   :: [a] -> [[a]]
 640 inits []                =  [[]]
 641 inits (x:xs)            =  [[]] ++ map (x:) (inits xs)
 642
 643 -- | The 'tails' function returns all final segments of the argument,
 644 -- longest first.  For example,
 645 --
 646 -- > tails "abc" == ["abc", "bc", "c",""]
 647 --
 648 tails                   :: [a] -> [[a]]
 649 tails []                =  [[]]
 650 tails xxs@(_:xs)        =  xxs : tails xs
 651
 652
 653 ------------------------------------------------------------------------------
 654 -- Quick Sort algorithm taken from HBC's QSort library.
 655
 656 -- | The 'sort' function implements a stable sorting algorithm.
 657 -- It is a special case of 'sortBy', which allows the programmer to supply
 658 -- their own comparison function.
 659 sort :: (Ord a) => [a] -> [a]
 660
 661 -- | The 'sortBy' function is the non-overloaded version of 'sort'.
 662 sortBy :: (a -> a -> Ordering) -> [a] -> [a]
 663
 664 #ifdef USE_REPORT_PRELUDE
 665 sort = sortBy compare
 666 sortBy cmp = foldr (insertBy cmp) []
 667 #else
 668
 669 sortBy cmp l = mergesort cmp l
 670 sort l = mergesort compare l
 671
 672 {-
 673 Quicksort replaced by mergesort, 14/5/2002.
 674
 675 From: Ian Lynagh <igloo@earth.li>
 676
 677 I am curious as to why the List.sort implementation in GHC is a
 678 quicksort algorithm rather than an algorithm that guarantees n log n
 679 time in the worst case? I have attached a mergesort implementation along
 680 with a few scripts to time it's performance, the results of which are
 681 shown below (* means it didn't finish successfully - in all cases this
 682 was due to a stack overflow).
 683
 684 If I heap profile the random_list case with only 10000 then I see
 685 random_list peaks at using about 2.5M of memory, whereas in the same
 686 program using List.sort it uses only 100k.
 687
 688 Input style     Input length     Sort data     Sort alg    User time
 689 stdin           10000            random_list   sort        2.82
 690 stdin           10000            random_list   mergesort   2.96
 691 stdin           10000            sorted        sort        31.37
 692 stdin           10000            sorted        mergesort   1.90
 693 stdin           10000            revsorted     sort        31.21
 694 stdin           10000            revsorted     mergesort   1.88
 695 stdin           100000           random_list   sort        *
 696 stdin           100000           random_list   mergesort   *
 697 stdin           100000           sorted        sort        *
 698 stdin           100000           sorted        mergesort   *
 699 stdin           100000           revsorted     sort        *
 700 stdin           100000           revsorted     mergesort   *
 701 func            10000            random_list   sort        0.31
 702 func            10000            random_list   mergesort   0.91
 703 func            10000            sorted        sort        19.09
 704 func            10000            sorted        mergesort   0.15
 705 func            10000            revsorted     sort        19.17
 706 func            10000            revsorted     mergesort   0.16
 707 func            100000           random_list   sort        3.85
 708 func            100000           random_list   mergesort   *
 709 func            100000           sorted        sort        5831.47
 710 func            100000           sorted        mergesort   2.23
 711 func            100000           revsorted     sort        5872.34
 712 func            100000           revsorted     mergesort   2.24
 713 -}
 714
 715 mergesort :: (a -> a -> Ordering) -> [a] -> [a]
 716 mergesort cmp = mergesort' cmp . map wrap
 717
 718 mergesort' :: (a -> a -> Ordering) -> [[a]] -> [a]
 719 mergesort' cmp [] = []
 720 mergesort' cmp [xs] = xs
 721 mergesort' cmp xss = mergesort' cmp (merge_pairs cmp xss)
 722
 723 merge_pairs :: (a -> a -> Ordering) -> [[a]] -> [[a]]
 724 merge_pairs cmp [] = []
 725 merge_pairs cmp [xs] = [xs]
 726 merge_pairs cmp (xs:ys:xss) = merge cmp xs ys : merge_pairs cmp xss
 727
 728 merge :: (a -> a -> Ordering) -> [a] -> [a] -> [a]
 729 merge cmp xs [] = xs
 730 merge cmp [] ys = ys
 731 merge cmp (x:xs) (y:ys)
 732  = case x `cmp` y of
 733         GT -> y : merge cmp (x:xs)   ys
 734         _  -> x : merge cmp    xs (y:ys)
 735
 736 wrap :: a -> [a]
 737 wrap x = [x]
 738
 739 {-
 740 OLD: qsort version
 741
 742 -- qsort is stable and does not concatenate.
 743 qsort :: (a -> a -> Ordering) -> [a] -> [a] -> [a]
 744 qsort _   []     r = r
 745 qsort _   [x]    r = x:r
 746 qsort cmp (x:xs) r = qpart cmp x xs [] [] r
 747
 748 -- qpart partitions and sorts the sublists
 749 qpart :: (a -> a -> Ordering) -> a -> [a] -> [a] -> [a] -> [a] -> [a]
 750 qpart cmp x [] rlt rge r =
 751     -- rlt and rge are in reverse order and must be sorted with an
 752     -- anti-stable sorting
 753     rqsort cmp rlt (x:rqsort cmp rge r)
 754 qpart cmp x (y:ys) rlt rge r =
 755     case cmp x y of
 756         GT -> qpart cmp x ys (y:rlt) rge r
 757         _  -> qpart cmp x ys rlt (y:rge) r
 758
 759 -- rqsort is as qsort but anti-stable, i.e. reverses equal elements
 760 rqsort :: (a -> a -> Ordering) -> [a] -> [a] -> [a]
 761 rqsort _   []     r = r
 762 rqsort _   [x]    r = x:r
 763 rqsort cmp (x:xs) r = rqpart cmp x xs [] [] r
 764
 765 rqpart :: (a -> a -> Ordering) -> a -> [a] -> [a] -> [a] -> [a] -> [a]
 766 rqpart cmp x [] rle rgt r =
 767     qsort cmp rle (x:qsort cmp rgt r)
 768 rqpart cmp x (y:ys) rle rgt r =
 769     case cmp y x of
 770         GT -> rqpart cmp x ys rle (y:rgt) r
 771         _  -> rqpart cmp x ys (y:rle) rgt r
 772 -}
 773
 774 #endif /* USE_REPORT_PRELUDE */
 775
 776 -- | The 'unfoldr' function is a \`dual\' to 'foldr': while 'foldr'
 777 -- reduces a list to a summary value, 'unfoldr' builds a list from
 778 -- a seed value.  The function takes the element and returns 'Nothing'
 779 -- if it is done producing the list or returns 'Just' @(a,b)@, in which
 780 -- case, @a@ is a prepended to the list and @b@ is used as the next
 781 -- element in a recursive call.  For example,
 782 --
 783 -- > iterate f == unfoldr (\x -> Just (x, f x))
 784 --
 785 -- In some cases, 'unfoldr' can undo a 'foldr' operation:
 786 --
 787 -- > unfoldr f' (foldr f z xs) == xs
 788 --
 789 -- if the following holds:
 790 --
 791 -- > f' (f x y) = Just (x,y)
 792 -- > f' z       = Nothing
 793
 794 unfoldr      :: (b -> Maybe (a, b)) -> b -> [a]
 795 unfoldr f b  =
 796   case f b of
 797    Just (a,new_b) -> a : unfoldr f new_b
 798    Nothing        -> []
 799
 800 -- -----------------------------------------------------------------------------
 801
 802 -- | A strict version of 'foldl'.
 803 foldl'           :: (a -> b -> a) -> a -> [b] -> a
 804 foldl' f a []     = a
 805 foldl' f a (x:xs) = let a' = f a x in a' `seq` foldl' f a' xs
 806
 807 #ifdef __GLASGOW_HASKELL__
 808 -- -----------------------------------------------------------------------------
 809 -- List sum and product
 810
 811 {-# SPECIALISE sum     :: [Int] -> Int #-}
 812 {-# SPECIALISE sum     :: [Integer] -> Integer #-}
 813 {-# SPECIALISE product :: [Int] -> Int #-}
 814 {-# SPECIALISE product :: [Integer] -> Integer #-}
 815 -- | The 'sum' function computes the sum of a finite list of numbers.
 816 sum                     :: (Num a) => [a] -> a
 817 -- | The 'product' function computes the product of a finite list of numbers.
 818 product                 :: (Num a) => [a] -> a
 819 #ifdef USE_REPORT_PRELUDE
 820 sum                     =  foldl (+) 0
 821 product                 =  foldl (*) 1
 822 #else
 823 sum     l       = sum' l 0
 824   where
 825     sum' []     a = a
 826     sum' (x:xs) a = sum' xs (a+x)
 827 product l       = prod l 1
 828   where
 829     prod []     a = a
 830     prod (x:xs) a = prod xs (a*x)
 831 #endif
 832
 833 -- -----------------------------------------------------------------------------
 834 -- Functions on strings
 835
 836 -- | 'lines' breaks a string up into a list of strings at newline
 837 -- characters.  The resulting strings do not contain newlines.
 838 lines                   :: String -> [String]
 839 lines ""                =  []
 840 lines s                 =  let (l, s') = break (== '\n') s
 841                            in  l : case s' of
 842                                         []      -> []
 843                                         (_:s'') -> lines s''
 844
 845 -- | 'unlines' is an inverse operation to 'lines'.
 846 -- It joins lines, after appending a terminating newline to each.
 847 unlines                 :: [String] -> String
 848 #ifdef USE_REPORT_PRELUDE
 849 unlines                 =  concatMap (++ "\n")
 850 #else
 851 -- HBC version (stolen)
 852 -- here's a more efficient version
 853 unlines [] = []
 854 unlines (l:ls) = l ++ '\n' : unlines ls
 855 #endif
 856
 857 -- | 'words' breaks a string up into a list of words, which were delimited
 858 -- by white space.
 859 words                   :: String -> [String]
 860 words s                 =  case dropWhile {-partain:Char.-}isSpace s of
 861                                 "" -> []
 862                                 s' -> w : words s''
 863                                       where (w, s'') =
 864                                              break {-partain:Char.-}isSpace s'
 865
 866 -- | 'unwords' is an inverse operation to 'words'.
 867 -- It joins words with separating spaces.
 868 unwords                 :: [String] -> String
 869 #ifdef USE_REPORT_PRELUDE
 870 unwords []              =  ""
 871 unwords ws              =  foldr1 (\w s -> w ++ ' ':s) ws
 872 #else
 873 -- HBC version (stolen)
 874 -- here's a more efficient version
 875 unwords []              =  ""
 876 unwords [w]             = w
 877 unwords (w:ws)          = w ++ ' ' : unwords ws
 878 #endif
 879 #endif  /* __GLASGOW_HASKELL__ */