ghc/lib/prelude/List.hs

   1 module PreludeList (
   2         (!!), (++), (\\), all, and, any, break, concat, cycle, drop,
   3         dropWhile, elem, filter, foldl, foldl1, foldr, foldr1, genericLength,
   4         head, init, iterate, last, length, lines, map, maximum,
   5         minimum, notElem, nub, null, or, partition, product, products,
   6         repeat, reverse, scanl, scanl1, scanr, scanr1, span, splitAt,
   7         sum, sums, tail, take, takeWhile, transpose, unlines, unwords,
   8         unzip, unzip3, unzip4, unzip5, unzip6, unzip7, words, zip,
   9         zip3, zip4, zip5, zip6, zip7, zipWith, zipWith3, zipWith4,
  10         zipWith5, zipWith6, zipWith7,
  11
  12         _build
  13     ) where
  14
  15 import Cls
  16 import Core
  17 import IChar            -- instances
  18 import IComplex
  19 import IDouble
  20 import IFloat
  21 import IInt
  22 import IInteger
  23 import IList
  24 import Prel             ( otherwise, isSpace, (&&), (||), atan2, (.), flip, (^) )
  25 import PS               ( _PackedString, _unpackPS )
  26 import Text
  27 import TyComplex
  28
  29 --infixl 9  !!
  30 --infix  5  \\
  31 --infixr 5  ++
  32 --infix  4 `elem`, `notElem`
  33
  34 -- head and tail extract the first element and remaining elements,
  35 -- respectively, of a list, which must be non-empty.  last and init
  36 -- are the dual functions working from the end of a finite list,
  37 -- rather than the beginning.
  38
  39 --{-# GENERATE_SPECS head a #-}
  40 head                    :: [a] -> a
  41 #ifndef USE_FOLDR_BUILD
  42 head (x:_)              =  x
  43 head []                 =  error "head{PreludeList}: head []\n"
  44 #else
  45 {-# INLINE head #-}
  46 head                    =  foldr (\ x _ -> x)
  47                                  (error "head{PreludeList}: head []\n")
  48 #endif
  49
  50 --{-# GENERATE_SPECS last a #-}
  51 last                    :: [a] -> a
  52 last []                 =  error "last{PreludeList}: last []\n"
  53 last [x]                =  x
  54 last (_:xs)             =  last xs
  55
  56 --{-# GENERATE_SPECS tail a #-}
  57 tail                    :: [a] -> [a]
  58 tail (_:xs)             =  xs
  59 tail []                 =  error "tail{PreludeList}: tail []\n"
  60
  61 --{-# GENERATE_SPECS init a #-}
  62 init                    :: [a] -> [a]
  63 init []                 =  error "init{PreludeList}: init []\n"
  64 init [x]                =  []
  65 init (x:xs)             =  x : init xs
  66
  67 -- null determines if a list is empty.
  68 --{-# GENERATE_SPECS null a #-}
  69 null                    :: [a] -> Bool
  70 #ifndef USE_FOLDR_BUILD
  71 null []                 = True
  72 null (_:_)              = False
  73 #else
  74 {-# INLINE null #-}
  75 null x                  = foldr (\ _ _ -> False) True x
  76 #endif
  77
  78 -- list concatenation (right-associative)
  79 --{-# GENERATE_SPECS (++) a #-}
  80 (++)                    :: [a] -> [a] -> [a]
  81
  82 #ifdef USE_REPORT_PRELUDE
  83 xs ++ ys                =  foldr (:) ys xs
  84 #else
  85 # ifndef USE_FOLDR_BUILD
  86 [] ++ ys                =  ys
  87 (x:xs) ++ ys            =  x : (xs ++ ys)
  88 # else
  89 --#ANDY?#{-# INLINE (++) #-}
  90 xs ++ ys                = foldr (:) ys xs
  91 # endif /* USE_FOLDR_BUILD */
  92 #endif /* ! USE_REPORT_PRELUDE */
  93
  94 -- list difference (non-associative).  In the result of xs \\ ys,
  95 -- the first occurrence of each element of ys in turn (if any)
  96 -- has been removed from xs.  Thus, (xs ++ ys) \\ xs == ys.
  97 --{-# GENERATE_SPECS (\\) a{+,Int} #-}
  98 (\\)                    :: (Eq a) => [a] -> [a] -> [a]
  99 (\\) xs ys              =  foldl del xs ys
 100                            where [] `del` _         = []
 101                                  (x:xs) `del` y
 102                                         | x == y    = xs
 103                                         | otherwise = x : xs `del` y
 104
 105 -- length returns the length of a finite list as an Int; it is an instance
 106 -- of the more general genericLength, the result type of which may be
 107 -- any kind of number.
 108
 109 --{-# GENERATE_SPECS genericLength a{~,Int#,Double#,Int} b #-}
 110 genericLength           :: (Num a) => [b] -> a
 111 genericLength xs        =  foldl (\n _ -> n+1) 0 xs
 112
 113 --{-# GENERATE_SPECS length a #-}
 114 length                  :: [a] -> Int
 115 #ifdef USE_REPORT_PRELUDE
 116 length                  =  genericLength
 117 #else
 118 #if 1
 119 --#ANDY?## ifndef USE_FOLDR_BUILD
 120 -- stolen from HBC, then unboxified
 121 length l                =  len l 0#
 122   where
 123     len :: [a] -> Int# -> Int
 124     len []     a# = I# a#
 125     len (_:xs) a# = len xs (a# +# 1#)
 126 # else
 127 --#ANDY?#{-# INLINE length #-}
 128 length l = foldl (\ n _ -> n+I# 1#) (I# 0#) l
 129 # endif /* USE_FOLDR_BUILD */
 130 #endif /* ! USE_REPORT_PRELUDE */
 131
 132 -- List index (subscript) operator, 0-origin
 133
 134 {-# SPECIALIZE (!!) :: [b] -> Int -> b, [b] -> Integer -> b #-}
 135 --{-# GENERATE_SPECS (!!) a{~,Int#,Int,Integer} b #-}
 136 (!!)                    :: (Integral a) => [b] -> a -> b
 137 #ifdef USE_REPORT_PRELUDE
 138 (x:_)  !! 0             =  x
 139 (_:xs) !! (n+1)         =  xs !! n
 140 (_:_)  !! _             =  error "(!!){PreludeList}: negative index"
 141 []     !! (m+1)         =  error "(!!){PreludeList}: index too large"
 142 #else
 143 -- HBC version (stolen), then unboxified
 144 -- The semantics is not quite the same for error conditions
 145 -- in the more efficient version.
 146 -- (Not to mention if "n" won't fit in an Int :-)
 147
 148 _      !! n | n < 0     =  error "(!!){PreludeList}: negative index\n"
 149 xs     !! n             =  sub xs (case (toInt n) of { I# n# -> n# })
 150                            where sub :: [a] -> Int# -> a
 151                                  sub []     _ = error "(!!){PreludeList}: index too large\n"
 152                                  sub (x:xs) n# = if n# ==# 0#
 153                                                  then x
 154                                                  else sub xs (n# `minusInt#` 1#)
 155 #endif /* ! USE_REPORT_PRELUDE */
 156
 157 -- map f xs applies f to each element of xs; i.e., map f xs == [f x | x <- xs].
 158 --{-# GENERATE_SPECS map a b #-}
 159 map                     :: (a -> b) -> [a] -> [b]
 160 #ifndef USE_FOLDR_BUILD
 161 map f []                =  []
 162 map f (x:xs)            =  f x : map f xs
 163 #else
 164 {-# INLINE map #-}
 165 map f xs                = _build (\ c n -> foldr (c.f) n xs)
 166 #endif /* USE_FOLDR_BUILD */
 167
 168 -- filter, applied to a predicate and a list, returns the list of those
 169 -- elements that satisfy the predicate; i.e.,
 170 -- filter p xs == [x | x <- xs, p x].
 171 --{-# GENERATE_SPECS filter a #-}
 172 filter                  :: (a -> Bool) -> [a] -> [a]
 173 #ifdef USE_REPORT_PRELUDE
 174 filter p                =  foldr (\x xs -> if p x then x:xs else xs) []
 175 #else
 176 # ifndef USE_FOLDR_BUILD
 177 -- stolen from HBC
 178 filter p []     = []
 179 filter p (x:xs) = if p x then x:filter p xs else filter p xs
 180 # else
 181 {-# INLINE filter #-}
 182 filter f xs = _build (\ c n -> foldr (\ a b -> if f a then c a b else b) n xs)
 183 # endif /* USE_FOLDR_BUILD */
 184 #endif /* ! USE_REPORT_PRELUDE */
 185
 186 -- partition takes a predicate and a list and returns a pair of lists:
 187 -- those elements of the argument list that do and do not satisfy the
 188 -- predicate, respectively; i.e.,
 189 -- partition p xs == (filter p xs, filter (not . p) xs).
 190 #ifdef USE_FOLDR_BUILD
 191 {-# INLINE partition #-}
 192 #endif
 193 --{-# GENERATE_SPECS partition a #-}
 194 partition               :: (a -> Bool) -> [a] -> ([a],[a])
 195 partition p xs          =  foldr select ([],[]) xs
 196                            where select x (ts,fs) | p x       = (x:ts,fs)
 197                                                   | otherwise = (ts,x:fs)
 198
 199 -- foldl, applied to a binary operator, a starting value (typically the
 200 -- left-identity of the operator), and a list, reduces the list using
 201 -- the binary operator, from left to right:
 202 --      foldl f z [x1, x2, ..., xn] == (...((z `f` x1) `f` x2) `f`...) `f` xn
 203 -- foldl1 is a variant that has no starting value argument, and  thus must
 204 -- be applied to non-empty lists.  scanl is similar to foldl, but returns
 205 -- a list of successive reduced values from the left:
 206 --      scanl f z [x1, x2, ...] == [z, z `f` x1, (z `f` x1) `f` x2, ...]
 207 -- Note that  last (scanl f z xs) == foldl f z xs.
 208 -- scanl1 is similar, again without the starting element:
 209 --      scanl1 f [x1, x2, ...] == [x1, x1 `f` x2, ...]
 210
 211 --{-# GENERATE_SPECS foldl1 a #-}
 212 foldl1                  :: (a -> a -> a) -> [a] -> a
 213 foldl1 f (x:xs)         =  foldl f x xs
 214 foldl1 _ []             =  error "foldl1{PreludeList}: empty list\n"
 215
 216 --{-# GENERATE_SPECS scanl a b#-}
 217 scanl                   :: (a -> b -> a) -> a -> [b] -> [a]
 218 scanl f q xs            =  q : (case xs of
 219                                 []   -> []
 220                                 x:xs -> scanl f (f q x) xs)
 221
 222 --{-# GENERATE_SPECS scanl1 a #-}
 223 scanl1                  :: (a -> a -> a) -> [a] -> [a]
 224 scanl1 f (x:xs)         =  scanl f x xs
 225 scanl1 _ []             =  error "scanl1{PreludeList}: empty list\n"
 226
 227 -- foldr, foldr1, scanr, and scanr1 are the right-to-left duals of the
 228 -- above functions.
 229
 230 --{-# GENERATE_SPECS foldr1 a #-}
 231 foldr1                  :: (a -> a -> a) -> [a] -> a
 232 foldr1 f [x]            =  x
 233 foldr1 f (x:xs)         =  f x (foldr1 f xs)
 234 foldr1 _ []             =  error "foldr1{PreludeList}: empty list\n"
 235
 236 --{-# GENERATE_SPECS scanr a b #-}
 237 scanr                   :: (a -> b -> b) -> b -> [a] -> [b]
 238 scanr f q0 []           =  [q0]
 239 scanr f q0 (x:xs)       =  f x q : qs
 240                            where qs@(q:_) = scanr f q0 xs
 241
 242 --{-# GENERATE_SPECS scanr1 a #-}
 243 scanr1                  :: (a -> a -> a) -> [a] -> [a]
 244 scanr1 f  [x]           =  [x]
 245 scanr1 f  (x:xs)        =  f x q : qs
 246                            where qs@(q:_) = scanr1 f xs
 247 scanr1 _ []             =  error "scanr1{PreludeList}: empty list\n"
 248
 249 -- iterate f x returns an infinite list of repeated applications of f to x:
 250 -- iterate f x == [x, f x, f (f x), ...]
 251 --{-# GENERATE_SPECS iterate a #-}
 252 iterate                 :: (a -> a) -> a -> [a]
 253 #ifndef USE_FOLDR_BUILD
 254 iterate f x             =  x : iterate f (f x)
 255 #else
 256 {-# INLINE iterate #-}
 257 iterate f x             = _build (\ c n ->
 258         let
 259            _iterate f x = x `c` _iterate f (f x)
 260         in
 261            _iterate f x)
 262 #endif /* USE_FOLDR_BUILD */
 263
 264
 265 -- repeat x is an infinite list, with x the value of every element.
 266 --{-# GENERATE_SPECS repeat a #-}
 267 repeat                  :: a -> [a]
 268 #ifndef USE_FOLDR_BUILD
 269 repeat x                =  xs where xs = x:xs
 270 #else
 271 {-# INLINE repeat #-}
 272 repeat x                =  _build (\ c n ->
 273         let
 274            xs = x `c` xs
 275         in
 276            xs)
 277 #endif /* USE_FOLDR_BUILD */
 278
 279 -- cycle ties a finite list into a circular one, or equivalently,
 280 -- the infinite repetition of the original list.  It is the identity
 281 -- on infinite lists.
 282
 283 --{-# GENERATE_SPECS cycle a #-}
 284 cycle                   :: [a] -> [a]
 285 #ifndef USE_FOLDR_BUILD
 286 cycle xs                =  xs' where xs' = xs ++ xs'
 287 #else
 288 {-# INLINE cycle #-}
 289 cycle xs                =  _build (\ c n ->
 290                                 let
 291                                    fx = foldr c fx xs
 292                                 in
 293                                    fx)
 294 #endif /* USE_FOLDR_BUILD */
 295
 296 -- take n, applied to a list xs, returns the prefix of xs of length n,
 297 -- or xs itself if n > length xs.  drop n xs returns the suffix of xs
 298 -- after the first n elements, or [] if n > length xs.  splitAt n xs
 299 -- is equivalent to (take n xs, drop n xs).
 300
 301 #ifdef USE_REPORT_PRELUDE
 302
 303 take :: (Integral a) => a -> [b] -> [b]
 304 take  0     _           =  []
 305 take  _     []          =  []
 306 take (n+1) (x:xs)       =  x : take n xs
 307
 308 drop :: (Integral a) => a -> [b] -> [b]
 309 drop  0     xs          =  xs
 310 drop  _     []          =  []
 311 drop (n+1) (_:xs)       =  drop n xs
 312
 313 splitAt :: (Integral a) => a -> [b] -> ([b],[b])
 314 splitAt  0     xs       =  ([],xs)
 315 splitAt  _     []       =  ([],[])
 316 splitAt (n+1) (x:xs)    =  (x:xs',xs'') where (xs',xs'') = splitAt n xs
 317
 318 #else /* hack away */
 319
 320 -- ToDo: massive Patrick hack not included yet
 321
 322 take    :: (Integral a) => a -> [b] -> [b]
 323 drop    :: (Integral a) => a -> [b] -> [b]
 324 splitAt :: (Integral a) => a -> [b] -> ([b], [b])
 325
 326 {-# SPECIALIZE take :: Int -> [b] -> [b], Integer -> [b] -> [b] #-}
 327 {-# SPECIALIZE drop :: Int -> [b] -> [b], Integer -> [b] -> [b] #-}
 328 {-# SPECIALIZE splitAt :: Int -> [b] -> ([b], [b]), Integer -> [b] -> ([b], [b]) #-}
 329
 330 take n xs = takeInt (toInt n) xs
 331
 332 takeInt                 :: Int -> [b] -> [b]
 333 takeInt (I# n#) xs
 334   | n# <# 0#    =  error "take{PreludeList}: negative index"
 335   | otherwise   =  takeInt# n# xs
 336     where
 337         takeInt# :: Int# -> [a] -> [a]
 338         takeInt# 0# _       = []
 339         takeInt# _  []      = []
 340         takeInt# m# (x:xs)  = x : takeInt# (m# `minusInt#` 1#) xs
 341
 342 {- NEW, from Kevin Hammond (kh)
 343    ToDo: needs the < 0 checking
 344
 345 take n | n >= 0 =
 346         if n <= fromIntegral maxInt then take' 0 else take'' n
 347         where
 348               take' :: Int -> [a] -> [a]
 349               take' _  []            =  []
 350               take' m   _  | m == n' =  []
 351               take' m (x:xs)         =  x : take' (m+1) xs
 352
 353               take'' :: (Integral a) => a -> [b] -> [b]
 354               tale'' 0   -           =  []
 355               take'' _  []           =  []
 356               take'' n (x:xs)        =  x : take'' (n-1) xs
 357
 358               n' = fromIntegral n
 359
 360 -- Test
 361 -- main = print (head (take (123456789123456789::Integer) [1..]))
 362 -}
 363
 364 -- ToDo: NEW drop and splitAt, too (WDP)
 365
 366 drop n xs = dropInt (toInt n) xs
 367
 368 dropInt                 :: Int -> [b] -> [b]
 369 dropInt (I# n#) xs
 370   | n# <# 0#    = error "drop{PreludeList}: negative index"
 371   | otherwise   = dropInt# n# xs
 372     where
 373         dropInt# :: Int# -> [a] -> [a]
 374         dropInt# 0# xs      = xs
 375         dropInt# _  []      = []
 376         dropInt# m# (_:xs)  = dropInt# (m# `minusInt#` 1#) xs
 377
 378 splitAt  n  xs | n >= 0 = splitAtInt (toInt n) xs
 379
 380 splitAtInt              :: Int -> [b] -> ([b], [b])
 381 splitAtInt (I# n#) xs
 382   | n# <# 0#    = error "splitAt{PreludeList}: negative index"
 383   | otherwise   = splitAtInt# n# xs
 384     where
 385         splitAtInt# :: Int# -> [a] -> ([a], [a])
 386         splitAtInt# 0# xs       = ([], xs)
 387         splitAtInt# _  []       = ([], [])
 388         splitAtInt# m# (x:xs)   = (x:xs', xs'')
 389           where
 390             (xs', xs'') = splitAtInt# (m# `minusInt#` 1#) xs
 391
 392 #endif {- ! USE_REPORT_PRELUDE -}
 393
 394 -- takeWhile, applied to a predicate p and a list xs, returns the longest
 395 -- prefix (possibly empty) of xs of elements that satisfy p.  dropWhile p xs
 396 -- returns the remaining suffix.  Span p xs is equivalent to
 397 -- (takeWhile p xs, dropWhile p xs), while break p uses the negation of p.
 398
 399 --{-# GENERATE_SPECS takeWhile a #-}
 400 takeWhile               :: (a -> Bool) -> [a] -> [a]
 401 #ifndef USE_FOLDR_BUILD
 402 takeWhile p []          =  []
 403 takeWhile p (x:xs)
 404             | p x       =  x : takeWhile p xs
 405             | otherwise =  []
 406 #else
 407 {-# INLINE takeWhile #-}
 408 takeWhile p xs          = _build (\ c n ->
 409     let
 410         fn x r = if  p x
 411                  then x `c` r
 412                  else n
 413     in
 414         foldr fn n xs)
 415 #endif /* USE_FOLDR_BUILD */
 416
 417 --{-# GENERATE_SPECS dropWhile a #-}
 418 dropWhile               :: (a -> Bool) -> [a] -> [a]
 419 dropWhile p []          =  []
 420 dropWhile p xs@(x:xs')
 421             | p x       =  dropWhile p xs'
 422             | otherwise =  xs
 423
 424 --{-# GENERATE_SPECS span a #-}
 425 span                    :: (a -> Bool) -> [a] -> ([a],[a])
 426 span p []               =  ([],[])
 427 span p xs@(x:xs')
 428            | p x        =  let (ys,zs) = span p xs' in (x:ys,zs)
 429            | otherwise  =  ([],xs)
 430
 431 --{-# GENERATE_SPECS break a #-}
 432 break           :: (a -> Bool) -> [a] -> ([a],[a])
 433 #ifdef USE_REPORT_PRELUDE
 434 break p                 = span (not . p)
 435 #else
 436 -- HBC version (stolen)
 437 break p []              =  ([],[])
 438 break p xs@(x:xs')
 439            | p x        =  ([],xs)
 440            | otherwise  =  let (ys,zs) = break p xs' in (x:ys,zs)
 441 #endif
 442
 443 -- lines breaks a string up into a list of strings at newline characters.
 444 -- The resulting strings do not contain newlines.  Similary, words
 445 -- breaks a string up into a list of words, which were delimited by
 446 -- white space.  unlines and unwords are the inverse operations.
 447 -- unlines joins lines with terminating newlines, and unwords joins
 448 -- words with separating spaces.
 449
 450 lines                   :: String -> [String]
 451 lines ""                =  []
 452 lines s                 =  let (l, s') = break (== '\n') s
 453                            in  l : case s' of
 454                                         []      -> []
 455                                         (_:s'') -> lines s''
 456
 457 words                   :: String -> [String]
 458 words s                 =  case dropWhile isSpace s of
 459                                 "" -> []
 460                                 s' -> w : words s''
 461                                       where (w, s'') = break isSpace s'
 462
 463 unlines                 :: [String] -> String
 464 #ifdef USE_REPORT_PRELUDE
 465 unlines                 =  concat . map (++ "\n")
 466 #else
 467 # ifndef USE_FOLDR_BUILD
 468 -- HBC version (stolen)
 469 -- here's a more efficient version
 470 unlines [] = []
 471 unlines (l:ls) = l ++ '\n' : unlines ls
 472 # else
 473 {-# INLINE unlines #-}
 474 unlines xs = foldr (\ l r -> l ++ '\n' : r) [] xs
 475 -- OLD
 476 -- unlines =  concat . map (++ "\n")
 477 # endif /* USE_FOLDR_BUILD */
 478 #endif /* ! USE_REPORT_PRELUDE */
 479
 480 unwords                 :: [String] -> String
 481 #ifdef USE_REPORT_PRELUDE
 482 unwords []              =  ""
 483 unwords ws              =  foldr1 (\w s -> w ++ ' ':s) ws
 484 #else
 485 -- HBC version (stolen)
 486 -- here's a more efficient version
 487 unwords []              =  ""
 488 unwords [w]             = w
 489 unwords (w:ws)          = w ++ ' ' : unwords ws
 490 #endif /* ! USE_REPORT_PRELUDE */
 491
 492 -- nub (meaning "essence") removes duplicate elements from its list argument.
 493 --{-# GENERATE_SPECS nub a{+,Int} #-}
 494 nub                     :: (Eq a) => [a] -> [a]
 495 #ifdef USE_REPORT_PRELUDE
 496 nub []                  =  []
 497 nub (x:xs)              =  x : nub (filter (/= x) xs)
 498 #else
 499 -- stolen from HBC
 500 nub l                   = nub' l []
 501   where
 502     nub' [] _           = []
 503     nub' (x:xs) l       = if x `elem` l then nub' xs l else x : nub' xs (x:l)
 504 #endif /* ! USE_REPORT_PRELUDE */
 505
 506 -- reverse xs returns the elements of xs in reverse order.  xs must be finite.
 507 --{-# GENERATE_SPECS reverse a #-}
 508 reverse                 :: [a] -> [a]
 509 #ifdef USE_REPORT_PRELUDE
 510 reverse                 =  foldl (flip (:)) []
 511 #else
 512 # ifndef USE_FOLDR_BUILD
 513 reverse l =  rev l []
 514   where
 515     rev []     a = a
 516     rev (x:xs) a = rev xs (x:a)
 517 # else
 518 {-# INLINE reverse #-}
 519 reverse xs = _build (\ c n -> foldl (flip c) n xs)
 520 # endif /* USE_FOLDR_BUILD */
 521 #endif /* ! USE_REPORT_PRELUDE */
 522
 523 -- and returns the conjunction of a Boolean list.  For the result to be
 524 -- True, the list must be finite; False, however, results from a False
 525 -- value at a finite index of a finite or infinite list.  or is the
 526 -- disjunctive dual of and.
 527 and, or                 :: [Bool] -> Bool
 528 #ifdef USE_REPORT_PRELUDE
 529 and                     =  foldr (&&) True
 530 or                      =  foldr (||) False
 531 #else
 532 # ifndef USE_FOLDR_BUILD
 533 and []          =  True
 534 and (x:xs)      =  x && and xs
 535 or []           =  False
 536 or (x:xs)       =  x || or xs
 537 # else
 538 {-# INLINE and #-}
 539 {-# INLINE or #-}
 540 and                     =  foldr (&&) True
 541 or                      =  foldr (||) False
 542 # endif /* USE_FOLDR_BUILD */
 543 #endif /* ! USE_REPORT_PRELUDE */
 544
 545 -- Applied to a predicate and a list, any determines if any element
 546 -- of the list satisfies the predicate.  Similarly, for all.
 547 --{-# GENERATE_SPECS any a #-}
 548 any                     :: (a -> Bool) -> [a] -> Bool
 549 --{-# GENERATE_SPECS all a #-}
 550 all                     :: (a -> Bool) -> [a] -> Bool
 551 #ifdef USE_REPORT_PRELUDE
 552 any p                   = or . map p
 553 all p                   = and . map p
 554 #else
 555 # ifndef USE_FOLDR_BUILD
 556 any p []        = False
 557 any p (x:xs)    = p x || any p xs
 558 all p []        =  True
 559 all p (x:xs)    =  p x && all p xs
 560 # else
 561 {-# INLINE any #-}
 562 {-# INLINE all #-}
 563 -- We expand these out, so as the non-deforested versions
 564 -- that use the f/b prelude can get a fair run for comparisons.
 565 any p xs                =  foldr (\ x r -> p x || r) False xs
 566 all p xs                =  foldr (\ x r -> p x && r) True xs
 567 # endif
 568 #endif /* ! USE_REPORT_PRELUDE */
 569
 570 -- elem is the list membership predicate, usually written in infix form,
 571 -- e.g., x `elem` xs.  notElem is the negation.
 572 --{-# GENERATE_SPECS elem a{+,Int,Char,String} #-}
 573 elem                    :: (Eq a) => a -> [a] -> Bool
 574 --{-# GENERATE_SPECS notElem a{+,Int,Char,String} #-}
 575 notElem                 :: (Eq a) => a -> [a] -> Bool
 576
 577 {-# SPECIALIZE elem :: Int -> [Int] -> Bool, Char -> [Char] -> Bool, String -> [String] -> Bool #-}
 578 {-# SPECIALIZE notElem :: Int -> [Int] -> Bool, Char -> [Char] -> Bool, String -> [String] -> Bool #-}
 579
 580 #ifdef USE_REPORT_PRELUDE
 581 elem                    =  any . (==)
 582 notElem                 =  all . (/=)
 583 #else
 584
 585 # ifndef USE_FOLDR_BUILD
 586 elem _ []       = False
 587 elem x (y:ys)   = x==y || elem x ys
 588
 589 notElem x []    =  True
 590 notElem x (y:ys)=  x /= y && notElem x ys
 591
 592 # else
 593 {-# INLINE elem #-}
 594 {-# INLINE notElem #-}
 595 -- We are prepared to lose the partial application to equality,
 596 -- ie (x ==), and replace it with (\ y -> x == y)
 597 elem x ys               =  any (\ y -> x == y) ys
 598 notElem x ys            =  all (\ y -> x /= y) ys
 599 # endif /* USE_FOLDR_BUILD */
 600 #endif /* ! USE_REPORT_PRELUDE */
 601
 602 -- sum and product compute the sum or product of a finite list of numbers.
 603 {-# SPECIALIZE sum :: [Int] -> Int, [Integer] -> Integer, [Double] -> Double, [Complex Double] -> Complex Double #-}
 604 --{-# GENERATE_SPECS sum a{Int#,Double#,Int,Integer,Double} #-}
 605 sum                     :: (Num a) => [a] -> a
 606 {-# SPECIALIZE product :: [Int] -> Int, [Integer] -> Integer, [Double] -> Double #-}
 607 --{-# GENERATE_SPECS product a{Int#,Double#,Int,Integer,Double} #-}
 608 product                 :: (Num a) => [a] -> a
 609
 610 #ifdef USE_REPORT_PRELUDE
 611 sum                     =  foldl (+) 0
 612 product                 =  foldl (*) 1
 613 #else
 614
 615 # ifndef USE_FOLDR_BUILD
 616 sum     l       = sum' l 0
 617   where
 618     sum' []     a = a
 619     sum' (x:xs) a = sum' xs (a+x)
 620 product l       = prod l 1
 621   where
 622     prod []     a = a
 623     prod (x:xs) a = prod xs (a*x)
 624 # else
 625 {-# INLINE sum #-}
 626 {-# INLINE product #-}
 627 sum xs                  =  foldl (+) lit0 xs
 628   where lit0 = 0
 629 product xs              =  foldl (*) lit1 xs
 630   where lit1 = 1
 631 # endif
 632 #endif /* ! USE_REPORT_PRELUDE */
 633
 634 -- sums and products give a list of running sums or products from
 635 -- a list of numbers.  For example,  sums [1,2,3] == [0,1,3,6].
 636 --{-# GENERATE_SPECS sums a{Int#,Double#,Int,Integer,Double} #-}
 637 sums                    :: (Num a) => [a] -> [a]
 638 sums xs                 =  scanl (+) 0 xs
 639 --{-# GENERATE_SPECS products a{Int#,Double#,Int,Integer,Double} #-}
 640 products                :: (Num a) => [a] -> [a]
 641 products xs             =  scanl (*) 1 xs
 642
 643 -- maximum and minimum return the maximum or minimum value from a list,
 644 -- which must be non-empty, finite, and of an ordered type.
 645 --{-# GENERATE_SPECS maximum a{+,Int,Integer,Double} #-}
 646 maximum                 :: (Ord a) => [a] -> a
 647 --{-# GENERATE_SPECS minimum a{+,Int,Integer,Double} #-}
 648 minimum                 :: (Ord a) => [a] -> a
 649 #ifdef USE_REPORT_PRELUDE
 650 maximum                 =  foldl1 max
 651 minimum                 =  foldl1 min
 652 #else
 653 maximum [x]     = x
 654 maximum (x:xs)  = max x (maximum xs)
 655 minimum [x]     = x
 656 minimum (x:xs)  = min x (minimum xs)
 657 #endif /* ! USE_REPORT_PRELUDE */
 658
 659 -- concat, applied to a list of lists, returns their flattened concatenation.
 660 --{-# GENERATE_SPECS concat a #-}
 661 concat                  :: [[a]] -> [a]
 662 #ifdef USE_REPORT_PRELUDE
 663 concat                  =  foldr (++) []
 664 #else
 665 # ifndef USE_FOLDR_BUILD
 666 -- HBC version (stolen)
 667 concat []               = []
 668 concat ([]:xss)         = concat xss                    -- for better stack behaiour!
 669 concat ([x]:xss)        = x : concat xss                -- this should help too ???
 670 concat (xs:xss)         = xs ++ concat xss
 671 # else
 672 {-# INLINE concat #-}
 673 concat xs = _build (\ c n -> foldr (\ x y -> foldr c y x) n xs)
 674 # endif
 675 #endif /* ! USE_REPORT_PRELUDE */
 676
 677 -- transpose, applied to a list of lists, returns that list with the
 678 -- "rows" and "columns" interchanged.  The input need not be rectangular
 679 -- (a list of equal-length lists) to be completely transposable, but can
 680 -- be "triangular":  Each successive component list must be not longer
 681 -- than the previous one; any elements outside of the "triangular"
 682 -- transposable region are lost.  The input can be infinite in either
 683 -- dimension or both.
 684 --{-# GENERATE_SPECS transpose a #-}
 685 transpose               :: [[a]] -> [[a]]
 686 transpose xs            =  foldr
 687                              (\xs xss -> zipWith (:) xs (xss ++ repeat []))
 688                              [] xs
 689
 690 -- zip takes two lists and returns a list of corresponding pairs.  If one
 691 -- input list is short, excess elements of the longer list are discarded.
 692 -- zip3 takes three lists and returns a list of triples, etc.  Versions
 693 -- of zip producing up to septuplets are defined here.
 694
 695 #ifdef USE_FOLDR_BUILD
 696 {-# INLINE zip #-}
 697 #endif
 698 --{-# GENERATE_SPECS zip a b #-}
 699 zip                     :: [a] -> [b] -> [(a,b)]
 700 zip as bs               =  zipWith (\a b -> (a,b)) as bs
 701
 702 zip3                    :: [a] -> [b] -> [c] -> [(a,b,c)]
 703 zip3 as bs cs           =  zipWith3 (\a b c -> (a,b,c)) as bs cs
 704
 705 zip4                    :: [a] -> [b] -> [c] -> [d] -> [(a,b,c,d)]
 706 zip4 as bs cs ds        =  zipWith4 (\a b c d -> (a,b,c,d)) as bs cs ds
 707
 708 zip5                    :: [a] -> [b] -> [c] -> [d] -> [e] -> [(a,b,c,d,e)]
 709 zip5 as bs cs ds es     =  zipWith5 (\a b c d e -> (a,b,c,d,e)) as bs cs ds es
 710
 711 zip6                    :: [a] -> [b] -> [c] -> [d] -> [e] -> [f]
 712                            -> [(a,b,c,d,e,f)]
 713 zip6 as bs cs ds es fs  =  zipWith6 (\a b c d e f -> (a,b,c,d,e,f)) as bs cs ds es fs
 714
 715 zip7                    :: [a] -> [b] -> [c] -> [d] -> [e] -> [f] -> [g]
 716                            -> [(a,b,c,d,e,f,g)]
 717 zip7 as bs cs ds es fs gs =  zipWith7 (\a b c d e f g -> (a,b,c,d,e,f,g)) as bs cs ds es fs gs
 718
 719 -- The zipWith family generalises the zip family by zipping with the
 720 -- function given as the first argument, instead of a tupling function.
 721 -- For example, zipWith (+) is applied to two lists to produce the list
 722 -- of corresponding sums.
 723
 724 --{-# GENERATE_SPECS zipWith a b c #-}
 725 zipWith                 :: (a->b->c) -> [a]->[b]->[c]
 726 #ifndef USE_FOLDR_BUILD
 727 zipWith z (a:as) (b:bs) =  z a b : zipWith z as bs
 728 zipWith _ _ _           =  []
 729 #else
 730 {-# INLINE zipWith #-}
 731 zipWith z xs ys = _build (\ c n ->
 732                 let
 733                    h (a:as) (b:bs) = z a b `c` h as bs
 734                    h _      _      = n
 735                 in
 736                    h xs ys)
 737 #endif
 738
 739
 740
 741 zipWith3                :: (a->b->c->d) -> [a]->[b]->[c]->[d]
 742 zipWith3 z (a:as) (b:bs) (c:cs)
 743                         =  z a b c : zipWith3 z as bs cs
 744 zipWith3 _ _ _ _        =  []
 745
 746 zipWith4                :: (a->b->c->d->e) -> [a]->[b]->[c]->[d]->[e]
 747 zipWith4 z (a:as) (b:bs) (c:cs) (d:ds)
 748                         =  z a b c d : zipWith4 z as bs cs ds
 749 zipWith4 _ _ _ _ _      =  []
 750
 751 zipWith5                :: (a->b->c->d->e->f)
 752                            -> [a]->[b]->[c]->[d]->[e]->[f]
 753 zipWith5 z (a:as) (b:bs) (c:cs) (d:ds) (e:es)
 754                         =  z a b c d e : zipWith5 z as bs cs ds es
 755 zipWith5 _ _ _ _ _ _    =  []
 756
 757 zipWith6                :: (a->b->c->d->e->f->g)
 758                            -> [a]->[b]->[c]->[d]->[e]->[f]->[g]
 759 zipWith6 z (a:as) (b:bs) (c:cs) (d:ds) (e:es) (f:fs)
 760                         =  z a b c d e f : zipWith6 z as bs cs ds es fs
 761 zipWith6 _ _ _ _ _ _ _  =  []
 762
 763 zipWith7                :: (a->b->c->d->e->f->g->h)
 764                            -> [a]->[b]->[c]->[d]->[e]->[f]->[g]->[h]
 765 zipWith7 z (a:as) (b:bs) (c:cs) (d:ds) (e:es) (f:fs) (g:gs)
 766                    =  z a b c d e f g : zipWith7 z as bs cs ds es fs gs
 767 zipWith7 _ _ _ _ _ _ _ _ =  []
 768
 769
 770 -- unzip transforms a list of pairs into a pair of lists.  As with zip,
 771 -- a family of such functions up to septuplets is provided.
 772
 773 --{-# GENERATE_SPECS unzip a b #-}
 774 unzip                   :: [(a,b)] -> ([a],[b])
 775 unzip xs                =  foldr (\(a,b) ~(as,bs) -> (a:as,b:bs)) ([],[]) xs
 776
 777 unzip3                  :: [(a,b,c)] -> ([a],[b],[c])
 778 unzip3 xs               =  foldr (\(a,b,c) ~(as,bs,cs) -> (a:as,b:bs,c:cs))
 779                                  ([],[],[]) xs
 780
 781 unzip4                  :: [(a,b,c,d)] -> ([a],[b],[c],[d])
 782 unzip4 xs               =  foldr (\(a,b,c,d) ~(as,bs,cs,ds) ->
 783                                         (a:as,b:bs,c:cs,d:ds))
 784                                  ([],[],[],[]) xs
 785
 786 unzip5                  :: [(a,b,c,d,e)] -> ([a],[b],[c],[d],[e])
 787 unzip5 xs               =  foldr (\(a,b,c,d,e) ~(as,bs,cs,ds,es) ->
 788                                         (a:as,b:bs,c:cs,d:ds,e:es))
 789                                  ([],[],[],[],[]) xs
 790
 791 unzip6                  :: [(a,b,c,d,e,f)] -> ([a],[b],[c],[d],[e],[f])
 792 unzip6 xs               =  foldr (\(a,b,c,d,e,f) ~(as,bs,cs,ds,es,fs) ->
 793                                         (a:as,b:bs,c:cs,d:ds,e:es,f:fs))
 794                                  ([],[],[],[],[],[]) xs
 795
 796 unzip7                  :: [(a,b,c,d,e,f,g)] -> ([a],[b],[c],[d],[e],[f],[g])
 797 unzip7 xs               =  foldr (\(a,b,c,d,e,f,g) ~(as,bs,cs,ds,es,fs,gs) ->
 798                                         (a:as,b:bs,c:cs,d:ds,e:es,f:fs,g:gs))
 799                                  ([],[],[],[],[],[],[]) xs