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