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