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