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