ghc/lib/std/PrelList.lhs

   1 %
   2 % (c) The AQUA Project, Glasgow University, 1994-1996
   3 %
   4
   5 \section[PrelList]{Module @PrelList@}
   6
   7 The List data type and its operations
   8
   9 \begin{code}
  10 {-# OPTIONS -fno-implicit-prelude #-}
  11
  12 module PrelList (
  13    [] (..),
  14
  15    map, (++), filter, concat,
  16    head, last, tail, init, null, length, (!!),
  17    foldl, foldl1, scanl, scanl1, foldr, foldr1, scanr, scanr1,
  18    iterate, repeat, replicate, cycle,
  19    take, drop, splitAt, takeWhile, dropWhile, span, break,
  20    lines, words, unlines, unwords, reverse, and, or,
  21    any, all, elem, notElem, lookup,
  22    sum, product, maximum, minimum, concatMap,
  23    zip, zip3, zipWith, zipWith3, unzip, unzip3,
  24
  25    -- non-standard, but hidden when creating the Prelude
  26    -- export list.
  27    takeUInt_append
  28
  29  ) where
  30
  31 import {-# SOURCE #-} PrelErr ( error )
  32 import PrelTup
  33 import PrelMaybe
  34 import PrelBase
  35
  36 infix  4 `elem`, `notElem`
  37 \end{code}
  38
  39 %*********************************************************
  40 %*                                                      *
  41 \subsection{List-manipulation functions}
  42 %*                                                      *
  43 %*********************************************************
  44
  45 \begin{code}
  46 -- head and tail extract the first element and remaining elements,
  47 -- respectively, of a list, which must be non-empty.  last and init
  48 -- are the dual functions working from the end of a finite list,
  49 -- rather than the beginning.
  50
  51 head                    :: [a] -> a
  52 head (x:_)              =  x
  53 head []                 =  errorEmptyList "head"
  54
  55 tail                    :: [a] -> [a]
  56 tail (_:xs)             =  xs
  57 tail []                 =  errorEmptyList "tail"
  58
  59 last                    :: [a] -> a
  60 #ifdef USE_REPORT_PRELUDE
  61 last [x]                =  x
  62 last (_:xs)             =  last xs
  63 last []                 =  errorEmptyList "last"
  64 #else
  65 -- eliminate repeated cases
  66 last []                 =  errorEmptyList "last"
  67 last (x:xs)             =  last' x xs
  68   where last' y []     = y
  69         last' _ (y:ys) = last' y ys
  70 #endif
  71
  72 init                    :: [a] -> [a]
  73 #ifdef USE_REPORT_PRELUDE
  74 init [x]                =  []
  75 init (x:xs)             =  x : init xs
  76 init []                 =  errorEmptyList "init"
  77 #else
  78 -- eliminate repeated cases
  79 init []                 =  errorEmptyList "init"
  80 init (x:xs)             =  init' x xs
  81   where init' _ []     = []
  82         init' y (z:zs) = y : init' z zs
  83 #endif
  84
  85 null                    :: [a] -> Bool
  86 null []                 =  True
  87 null (_:_)              =  False
  88
  89 -- length returns the length of a finite list as an Int; it is an instance
  90 -- of the more general genericLength, the result type of which may be
  91 -- any kind of number.
  92 length                  :: [a] -> Int
  93 #ifdef USE_REPORT_PRELUDE
  94 length []               =  0
  95 length (_:l)            =  1 + length l
  96 #else
  97 length l                =  len l 0#
  98   where
  99     len :: [a] -> Int# -> Int
 100     len []     a# = I# a#
 101     len (_:xs) a# = len xs (a# +# 1#)
 102 #endif
 103
 104 -- filter, applied to a predicate and a list, returns the list of those
 105 -- elements that satisfy the predicate; i.e.,
 106 -- filter p xs = [ x | x <- xs, p x]
 107 filter :: (a -> Bool) -> [a] -> [a]
 108 filter _pred []    = []
 109 filter pred (x:xs)
 110   | pred x         = x : filter pred xs
 111   | otherwise      = filter pred xs
 112
 113
 114 -- foldl, applied to a binary operator, a starting value (typically the
 115 -- left-identity of the operator), and a list, reduces the list using
 116 -- the binary operator, from left to right:
 117 --  foldl f z [x1, x2, ..., xn] == (...((z `f` x1) `f` x2) `f`...) `f` xn
 118 -- foldl1 is a variant that has no starting value argument, and  thus must
 119 -- be applied to non-empty lists.  scanl is similar to foldl, but returns
 120 -- a list of successive reduced values from the left:
 121 --      scanl f z [x1, x2, ...] == [z, z `f` x1, (z `f` x1) `f` x2, ...]
 122 -- Note that  last (scanl f z xs) == foldl f z xs.
 123 -- scanl1 is similar, again without the starting element:
 124 --      scanl1 f [x1, x2, ...] == [x1, x1 `f` x2, ...]
 125
 126 foldl                   :: (a -> b -> a) -> a -> [b] -> a
 127 foldl _ z []            =  z
 128 foldl f z (x:xs)        =  foldl f (f z x) xs
 129
 130 foldl1                  :: (a -> a -> a) -> [a] -> a
 131 foldl1 f (x:xs)         =  foldl f x xs
 132 foldl1 _ []             =  errorEmptyList "foldl1"
 133
 134 scanl                   :: (a -> b -> a) -> a -> [b] -> [a]
 135 scanl f q ls            =  q : (case ls of
 136                                 []   -> []
 137                                 x:xs -> scanl f (f q x) xs)
 138
 139 scanl1                  :: (a -> a -> a) -> [a] -> [a]
 140 scanl1 f (x:xs)         =  scanl f x xs
 141 scanl1 _ []             =  errorEmptyList "scanl1"
 142
 143 -- foldr, foldr1, scanr, and scanr1 are the right-to-left duals of the
 144 -- above functions.
 145
 146 foldr1                  :: (a -> a -> a) -> [a] -> a
 147 foldr1 _ [x]            =  x
 148 foldr1 f (x:xs)         =  f x (foldr1 f xs)
 149 foldr1 _ []             =  errorEmptyList "foldr1"
 150
 151 scanr                   :: (a -> b -> b) -> b -> [a] -> [b]
 152 scanr _ q0 []           =  [q0]
 153 scanr f q0 (x:xs)       =  f x q : qs
 154                            where qs@(q:_) = scanr f q0 xs
 155
 156 scanr1                  :: (a -> a -> a) -> [a] -> [a]
 157 scanr1 _  [x]           =  [x]
 158 scanr1 f  (x:xs)        =  f x q : qs
 159                            where qs@(q:_) = scanr1 f xs
 160 scanr1 _ []             =  errorEmptyList "scanr1"
 161
 162 -- iterate f x returns an infinite list of repeated applications of f to x:
 163 -- iterate f x == [x, f x, f (f x), ...]
 164 iterate                 :: (a -> a) -> a -> [a]
 165 iterate f x             =  x : iterate f (f x)
 166
 167 -- repeat x is an infinite list, with x the value of every element.
 168 repeat                  :: a -> [a]
 169 repeat x                =  xs where xs = x:xs
 170
 171 -- replicate n x is a list of length n with x the value of every element
 172 replicate               :: Int -> a -> [a]
 173 replicate n x           =  take n (repeat x)
 174
 175 -- cycle ties a finite list into a circular one, or equivalently,
 176 -- the infinite repetition of the original list.  It is the identity
 177 -- on infinite lists.
 178
 179 cycle                   :: [a] -> [a]
 180 cycle []                = error "Prelude.cycle: empty list"
 181 cycle xs                = xs' where xs' = xs ++ xs'
 182
 183 -- take n, applied to a list xs, returns the prefix of xs of length n,
 184 -- or xs itself if n > length xs.  drop n xs returns the suffix of xs
 185 -- after the first n elements, or [] if n > length xs.  splitAt n xs
 186 -- is equivalent to (take n xs, drop n xs).
 187 #ifdef USE_REPORT_PRELUDE
 188 take                   :: Int -> [a] -> [a]
 189 take 0 _               =  []
 190 take _ []              =  []
 191 take n (x:xs) | n > 0  =  x : take (n-1) xs
 192 take _     _           =  errorNegativeIdx "take"
 193
 194 drop                   :: Int -> [a] -> [a]
 195 drop 0 xs              =  xs
 196 drop _ []              =  []
 197 drop n (_:xs) | n > 0  =  drop (n-1) xs
 198 drop _     _           =  errorNegativeIdx "drop"
 199
 200 splitAt                   :: Int -> [a] -> ([a],[a])
 201 splitAt 0 xs              =  ([],xs)
 202 splitAt _ []              =  ([],[])
 203 splitAt n (x:xs) | n > 0  =  (x:xs',xs'') where (xs',xs'') = splitAt (n-1) xs
 204 splitAt _     _           =  errorNegativeIdx "splitAt"
 205
 206 #else /* hack away */
 207 take    :: Int -> [b] -> [b]
 208 take (I# n#) xs = takeUInt n# xs
 209
 210 -- The general code for take, below, checks n <= maxInt
 211 -- No need to check for maxInt overflow when specialised
 212 -- at type Int or Int# since the Int must be <= maxInt
 213
 214 takeUInt :: Int# -> [b] -> [b]
 215 takeUInt n xs
 216   | n >=# 0#  =  take_unsafe_UInt n xs
 217   | otherwise =  errorNegativeIdx "take"
 218
 219 take_unsafe_UInt :: Int# -> [b] -> [b]
 220 take_unsafe_UInt 0#  _  = []
 221 take_unsafe_UInt m   ls =
 222   case ls of
 223     []     -> []
 224     (x:xs) -> x : take_unsafe_UInt (m -# 1#) xs
 225
 226 takeUInt_append :: Int# -> [b] -> [b] -> [b]
 227 takeUInt_append n xs rs
 228   | n >=# 0#  =  take_unsafe_UInt_append n xs rs
 229   | otherwise =  errorNegativeIdx "take"
 230
 231 take_unsafe_UInt_append :: Int# -> [b] -> [b] -> [b]
 232 take_unsafe_UInt_append 0#  _ rs  = rs
 233 take_unsafe_UInt_append m  ls rs  =
 234   case ls of
 235     []     -> rs
 236     (x:xs) -> x : take_unsafe_UInt_append (m -# 1#) xs rs
 237
 238 drop            :: Int -> [b] -> [b]
 239 drop (I# n#) ls
 240   | n# <# 0#    = errorNegativeIdx "drop"
 241   | otherwise   = drop# n# ls
 242     where
 243         drop# :: Int# -> [a] -> [a]
 244         drop# 0# xs      = xs
 245         drop# _  xs@[]   = xs
 246         drop# m# (_:xs)  = drop# (m# -# 1#) xs
 247
 248 splitAt :: Int -> [b] -> ([b], [b])
 249 splitAt (I# n#) ls
 250   | n# <# 0#    = errorNegativeIdx "splitAt"
 251   | otherwise   = splitAt# n# ls
 252     where
 253         splitAt# :: Int# -> [a] -> ([a], [a])
 254         splitAt# 0# xs     = ([], xs)
 255         splitAt# _  xs@[]  = (xs, xs)
 256         splitAt# m# (x:xs) = (x:xs', xs'')
 257           where
 258             (xs', xs'') = splitAt# (m# -# 1#) xs
 259
 260 #endif /* USE_REPORT_PRELUDE */
 261
 262 span, break             :: (a -> Bool) -> [a] -> ([a],[a])
 263 span _ xs@[]            =  (xs, xs)
 264 span p xs@(x:xs')
 265          | p x          =  let (ys,zs) = span p xs' in (x:ys,zs)
 266          | otherwise    =  ([],xs)
 267
 268 #ifdef USE_REPORT_PRELUDE
 269 break p                 =  span (not . p)
 270 #else
 271 -- HBC version (stolen)
 272 break _ xs@[]           =  (xs, xs)
 273 break p xs@(x:xs')
 274            | p x        =  ([],xs)
 275            | otherwise  =  let (ys,zs) = break p xs' in (x:ys,zs)
 276 #endif
 277
 278 -- reverse xs returns the elements of xs in reverse order.  xs must be finite.
 279 reverse                 :: [a] -> [a]
 280 #ifdef USE_REPORT_PRELUDE
 281 reverse                 =  foldl (flip (:)) []
 282 #else
 283 reverse l =  rev l []
 284   where
 285     rev []     a = a
 286     rev (x:xs) a = rev xs (x:a)
 287 #endif
 288
 289 -- and returns the conjunction of a Boolean list.  For the result to be
 290 -- True, the list must be finite; False, however, results from a False
 291 -- value at a finite index of a finite or infinite list.  or is the
 292 -- disjunctive dual of and.
 293 and, or                 :: [Bool] -> Bool
 294 #ifdef USE_REPORT_PRELUDE
 295 and                     =  foldr (&&) True
 296 or                      =  foldr (||) False
 297 #else
 298 and []          =  True
 299 and (x:xs)      =  x && and xs
 300 or []           =  False
 301 or (x:xs)       =  x || or xs
 302 #endif
 303
 304 -- Applied to a predicate and a list, any determines if any element
 305 -- of the list satisfies the predicate.  Similarly, for all.
 306 any, all                :: (a -> Bool) -> [a] -> Bool
 307 #ifdef USE_REPORT_PRELUDE
 308 any p                   =  or . map p
 309 all p                   =  and . map p
 310 #else
 311 any _ []        = False
 312 any p (x:xs)    = p x || any p xs
 313
 314 all _ []        =  True
 315 all p (x:xs)    =  p x && all p xs
 316 #endif
 317
 318 -- elem is the list membership predicate, usually written in infix form,
 319 -- e.g., x `elem` xs.  notElem is the negation.
 320 elem, notElem           :: (Eq a) => a -> [a] -> Bool
 321 #ifdef USE_REPORT_PRELUDE
 322 elem x                  =  any (== x)
 323 notElem x               =  all (/= x)
 324 #else
 325 elem _ []       = False
 326 elem x (y:ys)   = x==y || elem x ys
 327
 328 notElem _ []    =  True
 329 notElem x (y:ys)=  x /= y && notElem x ys
 330 #endif
 331
 332 -- lookup key assocs looks up a key in an association list.
 333 lookup                  :: (Eq a) => a -> [(a,b)] -> Maybe b
 334 lookup _key []          =  Nothing
 335 lookup  key ((x,y):xys)
 336     | key == x          =  Just y
 337     | otherwise         =  lookup key xys
 338
 339 -- sum and product compute the sum or product of a finite list of numbers.
 340 {-# SPECIALISE sum     :: [Int] -> Int #-}
 341 {-# SPECIALISE product :: [Int] -> Int #-}
 342 sum, product            :: (Num a) => [a] -> a
 343 #ifdef USE_REPORT_PRELUDE
 344 sum                     =  foldl (+) 0
 345 product                 =  foldl (*) 1
 346 #else
 347 sum     l       = sum' l 0
 348   where
 349     sum' []     a = a
 350     sum' (x:xs) a = sum' xs (a+x)
 351 product l       = prod l 1
 352   where
 353     prod []     a = a
 354     prod (x:xs) a = prod xs (a*x)
 355 #endif
 356
 357 -- maximum and minimum return the maximum or minimum value from a list,
 358 -- which must be non-empty, finite, and of an ordered type.
 359 {-# SPECIALISE maximum :: [Int] -> Int #-}
 360 {-# SPECIALISE minimum :: [Int] -> Int #-}
 361 maximum, minimum        :: (Ord a) => [a] -> a
 362 maximum []              =  errorEmptyList "maximum"
 363 maximum xs              =  foldl1 max xs
 364
 365 minimum []              =  errorEmptyList "minimum"
 366 minimum xs              =  foldl1 min xs
 367
 368 concatMap               :: (a -> [b]) -> [a] -> [b]
 369 concatMap f             =  foldr ((++) . f) []
 370
 371 concat :: [[a]] -> [a]
 372 concat []           = []
 373 concat ([]:xss)     = concat xss
 374 concat ((y:ys):xss) = y: (ys ++ concat xss)
 375 \end{code}
 376
 377
 378 %*********************************************************
 379 %*                                                      *
 380 \subsection{The zip family}
 381 %*                                                      *
 382 %*********************************************************
 383
 384 zip takes two lists and returns a list of corresponding pairs.  If one
 385 input list is short, excess elements of the longer list are discarded.
 386 zip3 takes three lists and returns a list of triples.  Zips for larger
 387 tuples are in the List library
 388
 389 \begin{code}
 390 zip                     :: [a] -> [b] -> [(a,b)]
 391 -- Specification
 392 -- zip =  zipWith (,)
 393 zip (a:as) (b:bs) = (a,b) : zip as bs
 394 zip _      _      = []
 395
 396 zip3                    :: [a] -> [b] -> [c] -> [(a,b,c)]
 397 -- Specification
 398 -- zip3 =  zipWith3 (,,)
 399 zip3 (a:as) (b:bs) (c:cs) = (a,b,c) : zip3 as bs cs
 400 zip3 _      _      _      = []
 401
 402 -- The zipWith family generalises the zip family by zipping with the
 403 -- function given as the first argument, instead of a tupling function.
 404 -- For example, zipWith (+) is applied to two lists to produce the list
 405 -- of corresponding sums.
 406
 407 zipWith                 :: (a->b->c) -> [a]->[b]->[c]
 408 zipWith z (a:as) (b:bs) =  z a b : zipWith z as bs
 409 zipWith _ _ _           =  []
 410
 411 zipWith3                :: (a->b->c->d) -> [a]->[b]->[c]->[d]
 412 zipWith3 z (a:as) (b:bs) (c:cs)
 413                         =  z a b c : zipWith3 z as bs cs
 414 zipWith3 _ _ _ _        =  []
 415
 416
 417 -- unzip transforms a list of pairs into a pair of lists.
 418
 419 unzip                   :: [(a,b)] -> ([a],[b])
 420 unzip                   =  foldr (\(a,b) ~(as,bs) -> (a:as,b:bs)) ([],[])
 421
 422 unzip3                  :: [(a,b,c)] -> ([a],[b],[c])
 423 unzip3                  =  foldr (\(a,b,c) ~(as,bs,cs) -> (a:as,b:bs,c:cs))
 424                                  ([],[],[])
 425 \end{code}
 426
 427 %*********************************************************
 428 %*                                                      *
 429 \subsection{Functions on strings}
 430 %*                                                      *
 431 %*********************************************************
 432
 433 lines breaks a string up into a list of strings at newline characters.
 434 The resulting strings do not contain newlines.  Similary, words
 435 breaks a string up into a list of words, which were delimited by
 436 white space.  unlines and unwords are the inverse operations.
 437 unlines joins lines with terminating newlines, and unwords joins
 438 words with separating spaces.
 439
 440 \begin{code}
 441 lines                   :: String -> [String]
 442 lines ""                =  []
 443 lines s                 =  let (l, s') = break (== '\n') s
 444                            in  l : case s' of
 445                                         []      -> []
 446                                         (_:s'') -> lines s''
 447
 448 words                   :: String -> [String]
 449 words s                 =  case dropWhile {-partain:Char.-}isSpace s of
 450                                 "" -> []
 451                                 s' -> w : words s''
 452                                       where (w, s'') =
 453                                              break {-partain:Char.-}isSpace s'
 454
 455 unlines                 :: [String] -> String
 456 #ifdef USE_REPORT_PRELUDE
 457 unlines                 =  concatMap (++ "\n")
 458 #else
 459 -- HBC version (stolen)
 460 -- here's a more efficient version
 461 unlines [] = []
 462 unlines (l:ls) = l ++ '\n' : unlines ls
 463 #endif
 464
 465 unwords                 :: [String] -> String
 466 #ifdef USE_REPORT_PRELUDE
 467 unwords []              =  ""
 468 unwords ws              =  foldr1 (\w s -> w ++ ' ':s) ws
 469 #else
 470 -- HBC version (stolen)
 471 -- here's a more efficient version
 472 unwords []              =  ""
 473 unwords [w]             = w
 474 unwords (w:ws)          = w ++ ' ' : unwords ws
 475 #endif
 476
 477 \end{code}
 478
 479 Common up near identical calls to `error' to reduce the number
 480 constant strings created when compiled:
 481
 482 \begin{code}
 483 errorEmptyList :: String -> a
 484 errorEmptyList fun =
 485   error (prel_list_str ++ fun ++ ": empty list")
 486
 487 errorNegativeIdx :: String -> a
 488 errorNegativeIdx fun =
 489  error (prel_list_str ++ fun ++ ": negative index")
 490
 491 prel_list_str :: String
 492 prel_list_str = "Prelude."
 493 \end{code}