ghc/lib/prelude/Prelude.hs

   1 module Prelude (
   2
   3 #include "../includes/ieee-flpt.h"
   4
   5 --partain:    module PreludeList,
   6    head, last, tail, init, null, length, (!!),
   7    foldl, foldl1, scanl, scanl1, foldr, foldr1, scanr, scanr1,
   8    iterate, repeat, replicate, cycle,
   9    take, drop, splitAt, takeWhile, dropWhile, span, break,
  10    lines, words, unlines, unwords, reverse, and, or,
  11    any, all, elem, notElem, lookup,
  12    sum, product, maximum, minimum, concatMap,
  13    zip, zip3, zipWith, zipWith3, unzip, unzip3,
  14
  15 --partain:module PreludeText,
  16         ReadS, ShowS,
  17         Read(readsPrec, readList),
  18         Show(showsPrec, showList),
  19         reads, shows, show, read, lex,
  20         showChar, showString, readParen, showParen,
  21 --partain:module PreludeIO,
  22       FilePath, IOError, fail, userError, catch,
  23       putChar, putStr, putStrLn, print,
  24       getChar, getLine, getContents, interact,
  25       readFile, writeFile, appendFile, readIO, readLn,
  26
  27     Bool(False, True),
  28     Maybe(Nothing, Just),
  29     Either(Left, Right), either,
  30     Ordering(LT, EQ, GT),
  31     Char, String, Int, Integer, Float, Double, IO, Void,
  32     [](..), --  List type
  33     ()(..), --  Trivial type
  34     --  Tuple types: (,), (,,), etc.
  35     (,)(..),
  36     (,,)(..),
  37     (,,,)(..),
  38     (,,,,)(..),
  39     (,,,,,)(..),
  40     (,,,,,,)(..),
  41     (,,,,,,,)(..),
  42     (,,,,,,,,)(..),
  43     (,,,,,,,,,)(..),
  44     (,,,,,,,,,,)(..),
  45     (,,,,,,,,,,,)(..),
  46     (,,,,,,,,,,,,)(..),
  47     (,,,,,,,,,,,,,)(..),
  48     (,,,,,,,,,,,,,,)(..),
  49     (,,,,,,,,,,,,,,,)(..),
  50     (,,,,,,,,,,,,,,,,)(..),
  51     (,,,,,,,,,,,,,,,,,)(..),
  52     (,,,,,,,,,,,,,,,,,,)(..),
  53     (,,,,,,,,,,,,,,,,,,,)(..),
  54     (,,,,,,,,,,,,,,,,,,,,)(..),
  55     (,,,,,,,,,,,,,,,,,,,,,)(..),
  56     (,,,,,,,,,,,,,,,,,,,,,,)(..),
  57     (,,,,,,,,,,,,,,,,,,,,,,,)(..),
  58     (,,,,,,,,,,,,,,,,,,,,,,,,)(..),
  59     (,,,,,,,,,,,,,,,,,,,,,,,,,)(..),
  60     (,,,,,,,,,,,,,,,,,,,,,,,,,,)(..),
  61     (,,,,,,,,,,,,,,,,,,,,,,,,,,,)(..),
  62     (,,,,,,,,,,,,,,,,,,,,,,,,,,,,)(..),
  63     (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)(..),
  64     (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)(..),
  65     (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)(..),
  66     (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)(..),
  67     (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)(..),
  68     (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)(..),
  69     (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)(..),
  70     (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)(..),
  71 --  Functions: (->)
  72     Eq((==), (/=)),
  73     Ord(compare, (<), (<=), (>=), (>), max, min),
  74     Enum(toEnum, fromEnum, enumFrom, enumFromThen,
  75          enumFromTo, enumFromThenTo),
  76     Bounded(minBound, maxBound),
  77     Eval(..{-seq, strict-}), seq, strict, -- NB: glasgow hack
  78     Num((+), (-), (*), negate, abs, signum, fromInteger, fromInt{-partain-}),
  79     Real(toRational),
  80     Integral(quot, rem, div, mod, quotRem, divMod, toInteger, toInt{-partain-}),
  81     Fractional((/), recip, fromRational),
  82     Floating(pi, exp, log, sqrt, (**), logBase, sin, cos, tan,
  83              asin, acos, atan, sinh, cosh, tanh, asinh, acosh, atanh),
  84     RealFrac(properFraction, truncate, round, ceiling, floor),
  85     RealFloat(floatRadix, floatDigits, floatRange, decodeFloat,
  86               encodeFloat, exponent, significand, scaleFloat, isNaN,
  87               isInfinite, isDenormalized, isIEEE, isNegativeZero),
  88     Monad((>>=), (>>), return),
  89     MonadZero(zero),
  90     MonadPlus((++)),
  91     Functor(map),
  92     succ, pred,
  93     mapM, mapM_, guard, accumulate, sequence, filter, concat, applyM,
  94     maybe,
  95     (&&), (||), not, otherwise,
  96     subtract, even, odd, gcd, lcm, (^), (^^),
  97     fromIntegral, fromRealFrac, atan2,
  98     fst, snd, curry, uncurry, id, const, (.), flip, ($), until,
  99     asTypeOf, error, undefined ) where
 100
 101 import GHCbase  -- all the GHC basics
 102 import GHCio    -- I/O basics
 103 import Ratio(Ratio, Rational, (%), numerator, denominator)
 104
 105 --PreludeText:
 106 import Char     ( isSpace )
 107 import IO       ( hPutChar, hPutStr, hGetChar, hGetContents )
 108
 109 infixl 9  !!
 110 infix  4 `elem`, `notElem`
 111 {- :PreludeList -}
 112
 113 infixr 9  .
 114 infixr 8  ^, ^^, **
 115 infixl 7  *, /, `quot`, `rem`, `div`, `mod`
 116 infixl 6  +, -
 117 infixr 5  :, ++
 118 infix  4  ==, /=, <, <=, >=, >
 119 infixr 3  &&
 120 infixr 2  ||
 121 infixr 1  >>, >>=
 122 infixr 0  $
 123
 124 -- Standard types, classes, instances and related functions
 125
 126 -- Equality and Ordered classes
 127
 128 class  Eq a  where
 129     (==), (/=)          :: a -> a -> Bool
 130
 131     x /= y              =  not (x == y)
 132
 133 class  (Eq a) => Ord a  where
 134     compare             :: a -> a -> Ordering
 135     (<), (<=), (>=), (>):: a -> a -> Bool
 136     max, min            :: a -> a -> a
 137
 138 -- An instance of Ord should define either compare or <=
 139 -- Using compare can be more efficient for complex types.
 140     compare x y
 141             | x == y    = EQ
 142             | x <= y    = LT
 143             | otherwise = GT
 144
 145     x <= y  = compare x y /= GT
 146     x <  y  = compare x y == LT
 147     x >= y  = compare x y /= LT
 148     x >  y  = compare x y == GT
 149     max x y = case (compare x y) of { LT -> y ; EQ -> x ; GT -> x }
 150     min x y = case (compare x y) of { LT -> x ; EQ -> x ; GT -> y }
 151
 152 -- Enumeration and Bounded classes
 153
 154 class  (Ord a) => Enum a        where
 155     toEnum              :: Int -> a
 156     fromEnum            :: a -> Int
 157     enumFrom            :: a -> [a]             -- [n..]
 158     enumFromThen        :: a -> a -> [a]        -- [n,n'..]
 159     enumFromTo          :: a -> a -> [a]        -- [n..m]
 160     enumFromThenTo      :: a -> a -> a -> [a]   -- [n,n'..m]
 161
 162     enumFromTo n m      =  takeWhile (<= m) (enumFrom n)
 163     enumFromThenTo n n' m
 164                         =  takeWhile (if n' >= n then (<= m) else (>= m))
 165                                      (enumFromThen n n')
 166
 167 succ, pred              :: Enum a => a -> a
 168 succ                    =  toEnum . (+1) . fromEnum
 169 pred                    =  toEnum . (subtract 1) . fromEnum
 170
 171 class  Bounded a  where
 172     minBound, maxBound :: a
 173
 174 -- Numeric classes
 175
 176 class  (Eq a, Show a, Eval a) => Num a  where
 177     (+), (-), (*)       :: a -> a -> a
 178     negate              :: a -> a
 179     abs, signum         :: a -> a
 180     fromInteger         :: Integer -> a
 181     fromInt             :: Int -> a -- partain: Glasgow extension
 182
 183     x - y               =  x + negate y
 184     fromInt i           = fromInteger (int2Integer i)
 185                         where
 186                           int2Integer (I# i#) = int2Integer# i#
 187                                         -- Go via the standard class-op if the
 188                                         -- non-standard one ain't provided
 189
 190 class  (Num a, Ord a) => Real a  where
 191     toRational          ::  a -> Rational
 192
 193 class  (Real a, Enum a) => Integral a  where
 194     quot, rem, div, mod :: a -> a -> a
 195     quotRem, divMod     :: a -> a -> (a,a)
 196     toInteger           :: a -> Integer
 197     toInt               :: a -> Int -- partain: Glasgow extension
 198
 199     n `quot` d          =  q  where (q,r) = quotRem n d
 200     n `rem` d           =  r  where (q,r) = quotRem n d
 201     n `div` d           =  q  where (q,r) = divMod n d
 202     n `mod` d           =  r  where (q,r) = divMod n d
 203     divMod n d          =  if signum r == negate (signum d) then (q-1, r+d) else qr
 204                            where qr@(q,r) = quotRem n d
 205
 206 class  (Num a) => Fractional a  where
 207     (/)                 :: a -> a -> a
 208     recip               :: a -> a
 209     fromRational        :: Rational -> a
 210
 211     recip x             =  1 / x
 212
 213 class  (Fractional a) => Floating a  where
 214     pi                  :: a
 215     exp, log, sqrt      :: a -> a
 216     (**), logBase       :: a -> a -> a
 217     sin, cos, tan       :: a -> a
 218     asin, acos, atan    :: a -> a
 219     sinh, cosh, tanh    :: a -> a
 220     asinh, acosh, atanh :: a -> a
 221
 222     x ** y              =  exp (log x * y)
 223     logBase x y         =  log y / log x
 224     sqrt x              =  x ** 0.5
 225     tan  x              =  sin  x / cos  x
 226     tanh x              =  sinh x / cosh x
 227
 228 class  (Real a, Fractional a) => RealFrac a  where
 229     properFraction      :: (Integral b) => a -> (b,a)
 230     truncate, round     :: (Integral b) => a -> b
 231     ceiling, floor      :: (Integral b) => a -> b
 232
 233     truncate x          =  m  where (m,_) = properFraction x
 234
 235     round x             =  let (n,r) = properFraction x
 236                                m     = if r < 0 then n - 1 else n + 1
 237                            in case signum (abs r - 0.5) of
 238                                 -1 -> n
 239                                 0  -> if even n then n else m
 240                                 1  -> m
 241
 242     ceiling x           =  if r > 0 then n + 1 else n
 243                            where (n,r) = properFraction x
 244
 245     floor x             =  if r < 0 then n - 1 else n
 246                            where (n,r) = properFraction x
 247
 248 class  (RealFrac a, Floating a) => RealFloat a  where
 249     floatRadix          :: a -> Integer
 250     floatDigits         :: a -> Int
 251     floatRange          :: a -> (Int,Int)
 252     decodeFloat         :: a -> (Integer,Int)
 253     encodeFloat         :: Integer -> Int -> a
 254     exponent            :: a -> Int
 255     significand         :: a -> a
 256     scaleFloat          :: Int -> a -> a
 257     isNaN, isInfinite, isDenormalized, isNegativeZero, isIEEE
 258                         :: a -> Bool
 259
 260     exponent x          =  if m == 0 then 0 else n + floatDigits x
 261                            where (m,n) = decodeFloat x
 262
 263     significand x       =  encodeFloat m (negate (floatDigits x))
 264                            where (m,_) = decodeFloat x
 265
 266     scaleFloat k x      =  encodeFloat m (n+k)
 267                            where (m,n) = decodeFloat x
 268
 269 -- Numeric functions
 270
 271 {-# GENERATE_SPECS subtract a{Int#,Double#,Int,Double,Complex(Double#),Complex(Double)} #-}
 272 subtract        :: (Num a) => a -> a -> a
 273 subtract x y    =  y - x
 274
 275 even, odd       :: (Integral a) => a -> Bool
 276 even n          =  n `rem` 2 == 0
 277 odd             =  not . even
 278
 279 {-# GENERATE_SPECS gcd a{Int#,Int,Integer} #-}
 280 gcd             :: (Integral a) => a -> a -> a
 281 gcd 0 0         =  error "Prelude.gcd: gcd 0 0 is undefined"
 282 gcd x y         =  gcd' (abs x) (abs y)
 283                    where gcd' x 0  =  x
 284                          gcd' x y  =  gcd' y (x `rem` y)
 285
 286 {-# GENERATE_SPECS lcm a{Int#,Int,Integer} #-}
 287 lcm             :: (Integral a) => a -> a -> a
 288 lcm _ 0         =  0
 289 lcm 0 _         =  0
 290 lcm x y         =  abs ((x `quot` (gcd x y)) * y)
 291
 292 (^)             :: (Num a, Integral b) => a -> b -> a
 293 x ^ 0           =  1
 294 x ^ n | n > 0   =  f x (n-1) x
 295                    where f _ 0 y = y
 296                          f x n y = g x n  where
 297                                    g x n | even n  = g (x*x) (n `quot` 2)
 298                                          | otherwise = f x (n-1) (x*y)
 299 _ ^ _           = error "Prelude.^: negative exponent"
 300
 301 (^^)            :: (Fractional a, Integral b) => a -> b -> a
 302 x ^^ n          =  if n >= 0 then x^n else recip (x^(negate n))
 303
 304 fromIntegral    :: (Integral a, Num b) => a -> b
 305 fromIntegral    =  fromInteger . toInteger
 306
 307 fromRealFrac    :: (RealFrac a, Fractional b) => a -> b
 308 fromRealFrac    =  fromRational . toRational
 309
 310 atan2           :: (RealFloat a) => a -> a -> a
 311 atan2 y x       =  case (signum y, signum x) of
 312                         ( 0, 1) ->  0
 313                         ( 1, 0) ->  pi/2
 314                         ( 0,-1) ->  pi
 315                         (-1, 0) ->  (negate pi)/2
 316                         ( _, 1) ->  atan (y/x)
 317                         ( _,-1) ->  atan (y/x) + pi
 318                         ( 0, 0) ->  error "Prelude.atan2: atan2 of origin"
 319
 320
 321 -- Monadic classes
 322
 323 class  Functor f  where
 324     map         :: (a -> b) -> f a -> f b
 325
 326 class  Monad m  where
 327     (>>=)       :: m a -> (a -> m b) -> m b
 328     (>>)        :: m a -> m b -> m b
 329     return      :: a -> m a
 330
 331     m >> k      =  m >>= \_ -> k
 332
 333 class  (Monad m) => MonadZero m  where
 334     zero        :: m a
 335
 336 class  (MonadZero m) => MonadPlus m where
 337    (++)         :: m a -> m a -> m a
 338
 339 accumulate      :: Monad m => [m a] -> m [a]
 340 accumulate []     = return []
 341 accumulate (m:ms) = do { x <- m; xs <- accumulate ms; return (x:xs) }
 342 {- partain: this may be right, but I'm going w/ a more-certainly-right version
 343 accumulate      =  foldr mcons (return [])
 344                    where mcons p q = p >>= \x -> q >>= \y -> return (x:y)
 345 -}
 346 sequence        :: Monad m => [m a] -> m ()
 347 sequence        =  foldr (>>) (return ())
 348
 349 mapM            :: Monad m => (a -> m b) -> [a] -> m [b]
 350 mapM f as       =  accumulate (map f as)
 351
 352 mapM_           :: Monad m => (a -> m b) -> [a] -> m ()
 353 mapM_ f as      =  sequence (map f as)
 354
 355 guard           :: MonadZero m => Bool -> m ()
 356 guard p         =  if p then return () else zero
 357
 358 -- This subsumes the list-based filter function.
 359
 360 filter          :: MonadZero m => (a -> Bool) -> m a -> m a
 361 filter p        =  applyM (\x -> if p x then return x else zero)
 362
 363 -- This subsumes the list-based concat function.
 364
 365 concat          :: MonadPlus m => [m a] -> m a
 366 concat          =  foldr (++) zero
 367
 368 applyM          :: Monad m => (a -> m b) -> m a -> m b
 369 applyM f x      =  x >>= f
 370
 371
 372 -- Eval Class
 373
 374 class Eval a {-not Glasgow: where
 375    seq         :: a -> b -> b
 376    strict      :: (a -> b) -> a -> b
 377    strict f x  =  x `seq` f x -}
 378
 379 -- seq: in GHCbase
 380 strict      :: Eval a => (a -> b) -> a -> b
 381 strict f x  = x `seq` f x
 382
 383 ---------------------------------------------------------------
 384 -- Trivial type
 385
 386 data  ()  =  ()  --easier to do explicitly: deriving (Eq, Ord, Enum, Bounded)
 387                  -- (avoids weird-named functions, e.g., con2tag_()#
 388
 389 instance CReturnable () -- Why, exactly?
 390
 391 instance Eq () where
 392     () == () = True
 393     () /= () = False
 394
 395 instance Ord () where
 396     () <= () = True
 397     () <  () = False
 398     () >= () = True
 399     () >  () = False
 400     max () () = ()
 401     min () () = ()
 402     compare () () = EQ
 403
 404 instance Enum () where
 405     toEnum 0    = ()
 406     toEnum _    = error "Prelude.Enum.().toEnum: argument not 0"
 407     fromEnum () = 0
 408     enumFrom ()         = [()]
 409     enumFromThen () ()  = [()]
 410     enumFromTo () ()    = [()]
 411     enumFromThenTo () () () = [()]
 412
 413 instance Bounded () where
 414     minBound = ()
 415     maxBound = ()
 416
 417 instance  Show ()  where
 418     showsPrec p () = showString "()"
 419
 420 instance Read () where
 421     readsPrec p    = readParen False
 422                             (\r -> [((),t) | ("(",s) <- lex r,
 423                                              (")",t) <- lex s ] )
 424
 425 ---------------------------------------------------------------
 426 -- Function type
 427
 428 --data a -> b  -- No constructor for functions is exported.
 429
 430 instance  Show (a -> b)  where
 431     showsPrec p f  =  showString "<<function>>"
 432     showList       = showList__ (showsPrec 0)
 433
 434 ---------------------------------------------------------------
 435 -- Empty type
 436
 437 --partain:data Void      -- No constructor for Void is exported.  Import/Export
 438                -- lists must use Void instead of Void(..) or Void()
 439
 440 ---------------------------------------------------------------
 441 -- Boolean type
 442
 443 data  Bool  =  False | True     deriving (Eq, Ord, Enum, Read, Show, Bounded)
 444
 445 -- Boolean functions
 446
 447 (&&), (||)              :: Bool -> Bool -> Bool
 448 True  && x              =  x
 449 False && _              =  False
 450 True  || _              =  True
 451 False || x              =  x
 452
 453 not                     :: Bool -> Bool
 454 not True                =  False
 455 not False               =  True
 456
 457 otherwise               :: Bool
 458 otherwise               =  True
 459
 460 ---------------------------------------------------------------
 461 -- Character type
 462
 463 data Char = C# Char# deriving (Eq, Ord)
 464 --partain:data Char = ... 'a' | 'b' ... -- 265 ISO values
 465 instance CCallable Char
 466 instance CReturnable Char
 467
 468 instance  Enum Char  where
 469     toEnum   (I# i) | i >=# 0# && i <=# 255# =  C# (chr# i)
 470                     | otherwise = error "Prelude.Enum.Char.toEnum:out of range"
 471     fromEnum (C# c)     =  I# (ord# c)
 472     enumFrom c          =  map toEnum [fromEnum c .. fromEnum (maxBound::Char)]
 473     enumFromThen c c'   =  map toEnum [fromEnum c,
 474                                        fromEnum c' .. fromEnum lastChar]
 475                            where lastChar :: Char
 476                                  lastChar | c' < c    = minBound
 477                                           | otherwise = maxBound
 478
 479 instance  Bounded Char  where
 480     minBound            =  '\0'
 481     maxBound            =  '\255'
 482
 483 instance  Read Char  where
 484     readsPrec p      = readParen False
 485                             (\r -> [(c,t) | ('\'':s,t)<- lex r,
 486                                             (c,_)     <- readLitChar s])
 487
 488     readList = readParen False (\r -> [(l,t) | ('"':s, t) <- lex r,
 489                                                (l,_)      <- readl s ])
 490                where readl ('"':s)      = [("",s)]
 491                      readl ('\\':'&':s) = readl s
 492                      readl s            = [(c:cs,u) | (c ,t) <- readLitChar s,
 493                                                       (cs,u) <- readl t       ]
 494 instance  Show Char  where
 495     showsPrec p '\'' = showString "'\\''"
 496     showsPrec p c    = showChar '\'' . showLitChar c . showChar '\''
 497
 498     showList cs = showChar '"' . showl cs
 499                  where showl ""       = showChar '"'
 500                        showl ('"':cs) = showString "\\\"" . showl cs
 501                        showl (c:cs)   = showLitChar c . showl cs
 502
 503 type  String = [Char]
 504
 505 ---------------------------------------------------------------
 506 -- Maybe type
 507
 508 data  Maybe a  =  Nothing | Just a      deriving (Eq, Ord, Read, Show)
 509
 510 maybe                   :: b -> (a -> b) -> Maybe a -> b
 511 maybe n f Nothing       =  n
 512 maybe n f (Just x)      =  f x
 513
 514 instance  Functor Maybe  where
 515     map f Nothing       = Nothing
 516     map f (Just a)      = Just (f a)
 517
 518 instance  Monad Maybe  where
 519     (Just x) >>= k      = k x
 520     Nothing  >>= k      = Nothing
 521     return              = Just
 522
 523 instance  MonadZero Maybe  where
 524     zero                = Nothing
 525
 526 instance  MonadPlus Maybe  where
 527     Nothing ++ ys       = ys
 528     xs      ++ ys       = xs
 529
 530 ---------------------------------------------------------------
 531 -- Either type
 532
 533 data  Either a b  =  Left a | Right b   deriving (Eq, Ord, Read, Show)
 534
 535 either                  :: (a -> c) -> (b -> c) -> Either a b -> c
 536 either f g (Left x)     =  f x
 537 either f g (Right y)    =  g y
 538
 539 ---------------------------------------------------------------
 540 -- IO type: moved to GHCbase
 541
 542 --partain: data IO a =  -- abstract
 543
 544 ---------------------------------------------------------------
 545 -- Ordering type
 546
 547 data Ordering = LT | EQ | GT  deriving (Eq, Ord, Enum, Read, Show, Bounded)
 548
 549 ---------------------------------------------------------------
 550 -- Standard numeric types.  The data declarations for these types
 551 -- cannot be expressed directly in (standard) Haskell since the
 552 -- constructor lists would be far too large.
 553
 554 ---------------------------------------------------------------
 555 data Int = I# Int# deriving (Eq,Ord)
 556 --partain:data Int  =  minBound ... -1 | 0 | 1 ... maxBound
 557
 558 instance CCallable   Int
 559 instance CReturnable Int
 560
 561 instance  Bounded Int where
 562     minBound =  negate 2147483647   -- **********************
 563     maxBound =  2147483647          -- **********************
 564
 565 instance  Num Int  where
 566     (+)    x y =  plusInt x y
 567     (-)    x y =  minusInt x y
 568     negate x   =  negateInt x
 569     (*)    x y =  timesInt x y
 570     abs    n   = if n `geInt` 0 then n else (negateInt n)
 571
 572     signum n | n `ltInt` 0 = negateInt 1
 573              | n `eqInt` 0 = 0
 574              | otherwise   = 1
 575
 576     fromInteger (J# a# s# d#)
 577       = case (integer2Int# a# s# d#) of { i# -> I# i# }
 578
 579     fromInt n           = n
 580
 581 instance  Real Int  where
 582     toRational x        =  toInteger x % 1
 583
 584 instance  Integral Int  where
 585     a@(I# _) `quotRem` b@(I# _) = (a `quotInt` b, a `remInt` b)
 586     -- OK, so I made it a little stricter.  Shoot me.  (WDP 94/10)
 587
 588     -- following chks for zero divisor are non-standard (WDP)
 589     a `quot` b          =  if b /= 0
 590                            then a `quotInt` b
 591                            else error "Integral.Int.quot{PreludeCore}: divide by 0\n"
 592     a `rem` b           =  if b /= 0
 593                            then a `remInt` b
 594                            else error "Integral.Int.rem{PreludeCore}: divide by 0\n"
 595
 596     x `div` y = if x > 0 && y < 0       then quotInt (x-y-1) y
 597                 else if x < 0 && y > 0  then quotInt (x-y+1) y
 598                 else quotInt x y
 599     x `mod` y = if x > 0 && y < 0 || x < 0 && y > 0 then
 600                     if r/=0 then r+y else 0
 601                 else
 602                     r
 603               where r = remInt x y
 604
 605     divMod x@(I# _) y@(I# _) = (x `div` y, x `mod` y)
 606     -- Stricter.  Sorry if you don't like it.  (WDP 94/10)
 607
 608 --OLD:   even x = eqInt (x `mod` 2) 0
 609 --OLD:   odd x  = neInt (x `mod` 2) 0
 610
 611     toInteger (I# n#) = int2Integer# n#  -- give back a full-blown Integer
 612     toInt x           = x
 613
 614 instance  Enum Int  where
 615     toEnum   x = x
 616     fromEnum x = x
 617 #ifndef USE_FOLDR_BUILD
 618     enumFrom x           =  x : enumFrom (x `plusInt` 1)
 619     enumFromTo n m       =  takeWhile (<= m) (enumFrom n)
 620 #else
 621     {-# INLINE enumFrom #-}
 622     {-# INLINE enumFromTo #-}
 623     enumFrom x           = build (\ c _ ->
 624         let g x = x `c` g (x `plusInt` 1) in g x)
 625     enumFromTo x y       = build (\ c n ->
 626         let g x = if x <= y then x `c` g (x `plusInt` 1) else n in g x)
 627 #endif
 628     enumFromThen m n     =  en' m (n `minusInt` m)
 629                             where en' m n = m : en' (m `plusInt` n) n
 630     enumFromThenTo n m p =  takeWhile (if m >= n then (<= p) else (>= p))
 631                                       (enumFromThen n m)
 632
 633 instance  Read Int  where
 634     readsPrec p x = readSigned readDec x
 635     readList = readList__ (readsPrec 0)
 636
 637 instance  Show Int  where
 638     showsPrec x   = showSigned showInt x
 639     showList = showList__ (showsPrec 0)
 640
 641 ---------------------------------------------------------------
 642 data Integer = J# Int# Int# ByteArray#
 643 --partain:data Integer = ... -1 | 0 | 1 ...
 644
 645 instance  Eq Integer  where
 646     (J# a1 s1 d1) == (J# a2 s2 d2)
 647       = (cmpInteger# a1 s1 d1 a2 s2 d2) ==# 0#
 648
 649     (J# a1 s1 d1) /= (J# a2 s2 d2)
 650       = (cmpInteger# a1 s1 d1 a2 s2 d2) /=# 0#
 651
 652 instance  Ord Integer  where
 653     (J# a1 s1 d1) <= (J# a2 s2 d2)
 654       = (cmpInteger# a1 s1 d1 a2 s2 d2) <=# 0#
 655
 656     (J# a1 s1 d1) <  (J# a2 s2 d2)
 657       = (cmpInteger# a1 s1 d1 a2 s2 d2) <# 0#
 658
 659     (J# a1 s1 d1) >= (J# a2 s2 d2)
 660       = (cmpInteger# a1 s1 d1 a2 s2 d2) >=# 0#
 661
 662     (J# a1 s1 d1) >  (J# a2 s2 d2)
 663       = (cmpInteger# a1 s1 d1 a2 s2 d2) ># 0#
 664
 665     x@(J# a1 s1 d1) `max` y@(J# a2 s2 d2)
 666       = if ((cmpInteger# a1 s1 d1 a2 s2 d2) ># 0#) then x else y
 667
 668     x@(J# a1 s1 d1) `min` y@(J# a2 s2 d2)
 669       = if ((cmpInteger# a1 s1 d1 a2 s2 d2) <# 0#) then x else y
 670
 671     compare (J# a1 s1 d1) (J# a2 s2 d2)
 672        = case cmpInteger# a1 s1 d1 a2 s2 d2 of { res# ->
 673          if res# <# 0# then LT else
 674          if res# ># 0# then GT else EQ
 675          }
 676
 677 instance  Num Integer  where
 678     (+) (J# a1 s1 d1) (J# a2 s2 d2)
 679       = plusInteger# a1 s1 d1 a2 s2 d2
 680
 681     (-) (J# a1 s1 d1) (J# a2 s2 d2)
 682       = minusInteger# a1 s1 d1 a2 s2 d2
 683
 684     negate (J# a s d) = negateInteger# a s d
 685
 686     (*) (J# a1 s1 d1) (J# a2 s2 d2)
 687       = timesInteger# a1 s1 d1 a2 s2 d2
 688
 689     -- ORIG: abs n = if n >= 0 then n else -n
 690
 691     abs n@(J# a1 s1 d1)
 692       = case 0 of { J# a2 s2 d2 ->
 693         if (cmpInteger# a1 s1 d1 a2 s2 d2) >=# 0#
 694         then n
 695         else negateInteger# a1 s1 d1
 696         }
 697
 698     signum n@(J# a1 s1 d1)
 699       = case 0 of { J# a2 s2 d2 ->
 700         let
 701             cmp = cmpInteger# a1 s1 d1 a2 s2 d2
 702         in
 703         if      cmp >#  0# then 1
 704         else if cmp ==# 0# then 0
 705         else                    (negate 1)
 706         }
 707
 708     fromInteger x       =  x
 709
 710     fromInt (I# n#)     =  int2Integer# n# -- gives back a full-blown Integer
 711
 712 instance  Real Integer  where
 713     toRational x        =  x % 1
 714
 715 instance  Integral Integer where
 716     quotRem (J# a1 s1 d1) (J# a2 s2 d2)
 717       = case (quotRemInteger# a1 s1 d1 a2 s2 d2) of
 718           Return2GMPs a3 s3 d3 a4 s4 d4
 719             -> (J# a3 s3 d3, J# a4 s4 d4)
 720
 721 {- USING THE UNDERLYING "GMP" CODE IS DUBIOUS FOR NOW:
 722
 723     divMod (J# a1 s1 d1) (J# a2 s2 d2)
 724       = case (divModInteger# a1 s1 d1 a2 s2 d2) of
 725           Return2GMPs a3 s3 d3 a4 s4 d4
 726             -> (J# a3 s3 d3, J# a4 s4 d4)
 727 -}
 728     toInteger n      = n
 729     toInt (J# a s d) = case (integer2Int# a s d) of { n# -> I# n# }
 730
 731     -- the rest are identical to the report default methods;
 732     -- you get slightly better code if you let the compiler
 733     -- see them right here:
 734     n `quot` d  =  q  where (q,r) = quotRem n d
 735     n `rem` d   =  r  where (q,r) = quotRem n d
 736     n `div` d   =  q  where (q,r) = divMod n d
 737     n `mod` d   =  r  where (q,r) = divMod n d
 738
 739     divMod n d  =  case (quotRem n d) of { qr@(q,r) ->
 740                    if signum r == negate (signum d) then (q - 1, r+d) else qr }
 741                    -- Case-ified by WDP 94/10
 742
 743 instance  Enum Integer  where
 744     enumFrom n           =  n : enumFrom (n + 1)
 745     enumFromThen m n     =  en' m (n - m)
 746                             where en' m n = m : en' (m + n) n
 747     enumFromTo n m       =  takeWhile (<= m) (enumFrom n)
 748     enumFromThenTo n m p =  takeWhile (if m >= n then (<= p) else (>= p))
 749                                       (enumFromThen n m)
 750
 751 instance  Read Integer  where
 752     readsPrec p x = readSigned readDec x
 753     readList = readList__ (readsPrec 0)
 754
 755 instance  Show Integer  where
 756     showsPrec   x = showSigned showInt x
 757     showList = showList__ (showsPrec 0)
 758
 759 ---------------------------------------------------------------
 760 data Float  = F# Float# deriving (Eq, Ord)
 761 instance CCallable   Float
 762 instance CReturnable Float
 763
 764 ---------------------------------------------------------------
 765
 766 instance  Num Float  where
 767     (+)         x y     =  plusFloat x y
 768     (-)         x y     =  minusFloat x y
 769     negate      x       =  negateFloat x
 770     (*)         x y     =  timesFloat x y
 771     abs x | x >= 0.0    =  x
 772           | otherwise   =  negateFloat x
 773     signum x | x == 0.0  = 0
 774              | x > 0.0   = 1
 775              | otherwise = negate 1
 776     fromInteger n       =  encodeFloat n 0
 777     fromInt i           =  int2Float i
 778
 779 instance  Real Float  where
 780     toRational x        =  (m%1)*(b%1)^^n
 781                            where (m,n) = decodeFloat x
 782                                  b     = floatRadix  x
 783
 784 instance  Fractional Float  where
 785     (/) x y             =  divideFloat x y
 786     fromRational x      =  fromRational__ x
 787     recip x             =  1.0 / x
 788
 789 instance  Floating Float  where
 790     pi                  =  3.141592653589793238
 791     exp x               =  expFloat x
 792     log x               =  logFloat x
 793     sqrt x              =  sqrtFloat x
 794     sin x               =  sinFloat x
 795     cos x               =  cosFloat x
 796     tan x               =  tanFloat x
 797     asin x              =  asinFloat x
 798     acos x              =  acosFloat x
 799     atan x              =  atanFloat x
 800     sinh x              =  sinhFloat x
 801     cosh x              =  coshFloat x
 802     tanh x              =  tanhFloat x
 803     (**) x y            =  powerFloat x y
 804     logBase x y         =  log y / log x
 805
 806     asinh x = log (x + sqrt (1.0+x*x))
 807     acosh x = log (x + (x+1.0) * sqrt ((x-1.0)/(x+1.0)))
 808     atanh x = log ((x+1.0) / sqrt (1.0-x*x))
 809
 810 instance  RealFrac Float  where
 811
 812     {-# SPECIALIZE properFraction :: Float -> (Int, Float) #-}
 813     {-# SPECIALIZE truncate :: Float -> Int #-}
 814     {-# SPECIALIZE round    :: Float -> Int #-}
 815     {-# SPECIALIZE ceiling  :: Float -> Int #-}
 816     {-# SPECIALIZE floor    :: Float -> Int #-}
 817
 818     {-# SPECIALIZE properFraction :: Float -> (Integer, Float) #-}
 819     {-# SPECIALIZE truncate :: Float -> Integer #-}
 820     {-# SPECIALIZE round    :: Float -> Integer #-}
 821     {-# SPECIALIZE ceiling  :: Float -> Integer #-}
 822     {-# SPECIALIZE floor    :: Float -> Integer #-}
 823
 824     properFraction x
 825       = case (decodeFloat x)      of { (m,n) ->
 826         let  b = floatRadix x     in
 827         if n >= 0 then
 828             (fromInteger m * fromInteger b ^ n, 0.0)
 829         else
 830             case (quotRem m (b^(negate n))) of { (w,r) ->
 831             (fromInteger w, encodeFloat r n)
 832             }
 833         }
 834
 835     truncate x  = case properFraction x of
 836                      (n,_) -> n
 837
 838     round x     = case properFraction x of
 839                      (n,r) -> let
 840                                 m         = if r < 0.0 then n - 1 else n + 1
 841                                 half_down = abs r - 0.5
 842                               in
 843                               case (compare half_down 0.0) of
 844                                 LT -> n
 845                                 EQ -> if even n then n else m
 846                                 GT -> m
 847
 848     ceiling x   = case properFraction x of
 849                     (n,r) -> if r > 0.0 then n + 1 else n
 850
 851     floor x     = case properFraction x of
 852                     (n,r) -> if r < 0.0 then n - 1 else n
 853
 854 instance  RealFloat Float  where
 855     floatRadix _        =  FLT_RADIX        -- from float.h
 856     floatDigits _       =  FLT_MANT_DIG     -- ditto
 857     floatRange _        =  (FLT_MIN_EXP, FLT_MAX_EXP) -- ditto
 858
 859     decodeFloat (F# f#)
 860       = case decodeFloat# f#    of
 861           ReturnIntAndGMP exp# a# s# d# ->
 862             (J# a# s# d#, I# exp#)
 863
 864     encodeFloat (J# a# s# d#) (I# e#)
 865       = case encodeFloat# a# s# d# e# of { flt# -> F# flt# }
 866
 867     exponent x          = case decodeFloat x of
 868                             (m,n) -> if m == 0 then 0 else n + floatDigits x
 869
 870     significand x       = case decodeFloat x of
 871                             (m,_) -> encodeFloat m (negate (floatDigits x))
 872
 873     scaleFloat k x      = case decodeFloat x of
 874                             (m,n) -> encodeFloat m (n+k)
 875
 876 instance  Read Float  where
 877     readsPrec p x = readSigned readFloat x
 878     readList = readList__ (readsPrec 0)
 879
 880 instance  Show Float  where
 881     showsPrec   x = showSigned showFloat x
 882     showList = showList__ (showsPrec 0)
 883
 884 ---------------------------------------------------------------
 885 data Double = D# Double# deriving (Eq, Ord)
 886 instance CCallable   Double
 887 instance CReturnable Double
 888
 889 ---------------------------------------------------------------
 890
 891 instance  Num Double  where
 892     (+)         x y     =  plusDouble x y
 893     (-)         x y     =  minusDouble x y
 894     negate      x       =  negateDouble x
 895     (*)         x y     =  timesDouble x y
 896     abs x | x >= 0.0    =  x
 897           | otherwise   =  negateDouble x
 898     signum x | x == 0.0  = 0
 899              | x > 0.0   = 1
 900              | otherwise = negate 1
 901     fromInteger n       =  encodeFloat n 0
 902     fromInt (I# n#)     =  case (int2Double# n#) of { d# -> D# d# }
 903
 904 instance  Real Double  where
 905     toRational x        =  (m%1)*(b%1)^^n
 906                            where (m,n) = decodeFloat x
 907                                  b     = floatRadix  x
 908
 909 instance  Fractional Double  where
 910     (/) x y             =  divideDouble x y
 911     fromRational x      =  fromRational__ x
 912     recip x             =  1.0 / x
 913
 914 instance  Floating Double  where
 915     pi                  =  3.141592653589793238
 916     exp x               =  expDouble x
 917     log x               =  logDouble x
 918     sqrt x              =  sqrtDouble x
 919     sin  x              =  sinDouble x
 920     cos  x              =  cosDouble x
 921     tan  x              =  tanDouble x
 922     asin x              =  asinDouble x
 923     acos x              =  acosDouble x
 924     atan x              =  atanDouble x
 925     sinh x              =  sinhDouble x
 926     cosh x              =  coshDouble x
 927     tanh x              =  tanhDouble x
 928     (**) x y            =  powerDouble x y
 929     logBase x y         =  log y / log x
 930
 931     asinh x = log (x + sqrt (1.0+x*x))
 932     acosh x = log (x + (x+1.0) * sqrt ((x-1.0)/(x+1.0)))
 933     atanh x = log ((x+1.0) / sqrt (1.0-x*x))
 934
 935 instance  RealFrac Double  where
 936
 937     {-# SPECIALIZE properFraction :: Double -> (Int, Double) #-}
 938     {-# SPECIALIZE truncate :: Double -> Int #-}
 939     {-# SPECIALIZE round    :: Double -> Int #-}
 940     {-# SPECIALIZE ceiling  :: Double -> Int #-}
 941     {-# SPECIALIZE floor    :: Double -> Int #-}
 942
 943     {-# SPECIALIZE properFraction :: Double -> (Integer, Double) #-}
 944     {-# SPECIALIZE truncate :: Double -> Integer #-}
 945     {-# SPECIALIZE round    :: Double -> Integer #-}
 946     {-# SPECIALIZE ceiling  :: Double -> Integer #-}
 947     {-# SPECIALIZE floor    :: Double -> Integer #-}
 948
 949 #if defined(__UNBOXED_INSTANCES__)
 950     {-# SPECIALIZE properFraction :: Double -> (Int#, Double) #-}
 951     {-# SPECIALIZE truncate :: Double -> Int# #-}
 952     {-# SPECIALIZE round    :: Double -> Int# #-}
 953     {-# SPECIALIZE ceiling  :: Double -> Int# #-}
 954     {-# SPECIALIZE floor    :: Double -> Int# #-}
 955 #endif
 956
 957     properFraction x
 958       = case (decodeFloat x)      of { (m,n) ->
 959         let  b = floatRadix x     in
 960         if n >= 0 then
 961             (fromInteger m * fromInteger b ^ n, 0.0)
 962         else
 963             case (quotRem m (b^(negate n))) of { (w,r) ->
 964             (fromInteger w, encodeFloat r n)
 965             }
 966         }
 967
 968     truncate x  = case properFraction x of
 969                      (n,_) -> n
 970
 971     round x     = case properFraction x of
 972                      (n,r) -> let
 973                                 m         = if r < 0.0 then n - 1 else n + 1
 974                                 half_down = abs r - 0.5
 975                               in
 976                               case (compare half_down 0.0) of
 977                                 LT -> n
 978                                 EQ -> if even n then n else m
 979                                 GT -> m
 980
 981     ceiling x   = case properFraction x of
 982                     (n,r) -> if r > 0.0 then n + 1 else n
 983
 984     floor x     = case properFraction x of
 985                     (n,r) -> if r < 0.0 then n - 1 else n
 986
 987 instance  RealFloat Double  where
 988     floatRadix _        =  FLT_RADIX        -- from float.h
 989     floatDigits _       =  DBL_MANT_DIG     -- ditto
 990     floatRange _        =  (DBL_MIN_EXP, DBL_MAX_EXP) -- ditto
 991
 992     decodeFloat (D# d#)
 993       = case decodeDouble# d#   of
 994           ReturnIntAndGMP exp# a# s# d# ->
 995             (J# a# s# d#, I# exp#)
 996
 997     encodeFloat (J# a# s# d#) (I# e#)
 998       = case encodeDouble# a# s# d# e#  of { dbl# -> D# dbl# }
 999
1000     exponent x          = case decodeFloat x of
1001                             (m,n) -> if m == 0 then 0 else n + floatDigits x
1002
1003     significand x       = case decodeFloat x of
1004                             (m,_) -> encodeFloat m (negate (floatDigits x))
1005
1006     scaleFloat k x      = case decodeFloat x of
1007                             (m,n) -> encodeFloat m (n+k)
1008
1009 instance  Read Double  where
1010     readsPrec p x = readSigned readFloat x
1011     readList = readList__ (readsPrec 0)
1012
1013 instance  Show Double  where
1014     showsPrec   x = showSigned showFloat x
1015     showList = showList__ (showsPrec 0)
1016
1017 ---------------------------------------------------------------
1018 -- The Enum instances for Floats and Doubles are slightly unusual.
1019 -- The `toEnum' function truncates numbers to Int.  The definitions
1020 -- of enumFrom and enumFromThen allow floats to be used in arithmetic
1021 -- series: [0,0.1 .. 1.0].  However, roundoff errors make these somewhat
1022 -- dubious.  This example may have either 10 or 11 elements, depending on
1023 -- how 0.1 is represented.
1024
1025 instance  Enum Float  where
1026     toEnum              =  fromIntegral
1027     fromEnum            =  fromInteger . truncate   -- may overflow
1028     enumFrom            =  numericEnumFrom
1029     enumFromThen        =  numericEnumFromThen
1030
1031 instance  Enum Double  where
1032     toEnum              =  fromIntegral
1033     fromEnum            =  fromInteger . truncate   -- may overflow
1034     enumFrom            =  numericEnumFrom
1035     enumFromThen        =  numericEnumFromThen
1036
1037 numericEnumFrom         :: (Real a) => a -> [a]
1038 numericEnumFromThen     :: (Real a) => a -> a -> [a]
1039 numericEnumFrom         =  iterate (+1)
1040 numericEnumFromThen n m =  iterate (+(m-n)) n
1041
1042 ---------------------------------------------------------------
1043 -- Lists
1044
1045 data [] a = [] | a : [a]  -- do explicitly: deriving (Eq, Ord)
1046                           -- to avoid weird names like con2tag_[]#
1047
1048 instance CCallable   [Char]
1049 instance CReturnable [Char]
1050
1051 instance (Eq a) => Eq [a]  where
1052     []     == []     = True
1053     (x:xs) == (y:ys) = x == y && xs == ys
1054     []     == ys     = False
1055     xs     == []     = False
1056     xs     /= ys     = if (xs == ys) then False else True
1057
1058 instance (Ord a) => Ord [a] where
1059     a <  b  = case compare a b of { LT -> True;  EQ -> False; GT -> False }
1060     a <= b  = case compare a b of { LT -> True;  EQ -> True;  GT -> False }
1061     a >= b  = case compare a b of { LT -> False; EQ -> True;  GT -> True  }
1062     a >  b  = case compare a b of { LT -> False; EQ -> False; GT -> True  }
1063
1064     max a b = case compare a b of { LT -> b; EQ -> a;  GT -> a }
1065     min a b = case compare a b of { LT -> a; EQ -> a;  GT -> b }
1066
1067     compare []     []     = EQ
1068     compare (x:xs) []     = GT
1069     compare []     (y:ys) = LT
1070     compare (x:xs) (y:ys) = case compare x y of
1071                                  LT -> LT
1072                                  GT -> GT
1073                                  EQ -> compare xs ys
1074
1075 instance Functor [] where
1076     map f []             =  []
1077     map f (x:xs)         =  f x : map f xs
1078
1079 instance  Monad []  where
1080     m >>= k             = concat (map k m)
1081     return x            = [x]
1082
1083 instance  MonadZero []  where
1084     zero                = []
1085
1086 instance  MonadPlus []  where
1087     xs ++ ys            =  foldr (:) ys xs
1088
1089 instance  (Show a) => Show [a]  where
1090     showsPrec p         = showList
1091     showList            = showList__ (showsPrec 0)
1092
1093 instance  (Read a) => Read [a]  where
1094     readsPrec p         = readList
1095     readList            = readList__ (readsPrec 0)
1096
1097 ---------------------------------------------------------------
1098 -- Tuples
1099
1100 data (,) a b = (,) a b   deriving (Eq, Ord, Bounded)
1101 data (,,) a b c = (,,) a b c deriving (Eq, Ord, Bounded)
1102 data (,,,) a b c d = (,,,) a b c d deriving (Eq, Ord, Bounded)
1103 data (,,,,) a b c d e = (,,,,) a b c d e deriving (Eq, Ord, Bounded)
1104 data (,,,,,) a b c d e f = (,,,,,) a b c d e f
1105 data (,,,,,,) a b c d e f g = (,,,,,,) a b c d e f g
1106 data (,,,,,,,) a b c d e f g h = (,,,,,,,) a b c d e f g h
1107 data (,,,,,,,,) a b c d e f g h i = (,,,,,,,,) a b c d e f g h i
1108 data (,,,,,,,,,) a b c d e f g h i j = (,,,,,,,,,) a b c d e f g h i j
1109 data (,,,,,,,,,,) a b c d e f g h i j k = (,,,,,,,,,,) a b c d e f g h i j k
1110 data (,,,,,,,,,,,) a b c d e f g h i j k l = (,,,,,,,,,,,) a b c d e f g h i j k l
1111 data (,,,,,,,,,,,,) a b c d e f g h i j k l m = (,,,,,,,,,,,,) a b c d e f g h i j k l m
1112 data (,,,,,,,,,,,,,) a b c d e f g h i j k l m n = (,,,,,,,,,,,,,) a b c d e f g h i j k l m n
1113 data (,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o = (,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o
1114 data (,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p = (,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p
1115 data (,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q
1116  = (,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q
1117 data (,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r
1118  = (,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r
1119 data (,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s
1120  = (,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s
1121 data (,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t
1122  = (,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t
1123 data (,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u
1124  = (,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u
1125 data (,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v
1126  = (,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v
1127 data (,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w
1128  = (,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w
1129 data (,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x
1130  = (,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x
1131 data (,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y
1132  = (,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y
1133 data (,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z
1134  = (,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z
1135 data (,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_
1136  = (,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_
1137 data (,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_
1138  = (,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_
1139 data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_
1140  = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_
1141 data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_
1142  = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_
1143 data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_
1144  = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_
1145 data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_
1146  = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_
1147 data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_
1148  = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_
1149 data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_
1150  = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_
1151 data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_
1152  = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_
1153 data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_
1154  = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_
1155 data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_
1156  = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_
1157  -- if you add more tuples, you need to change the compiler, too
1158  -- (it has a wired-in number: 37)
1159
1160 instance  (Read a, Read b) => Read (a,b)  where
1161     readsPrec p = readParen False
1162                             (\r -> [((x,y), w) | ("(",s) <- lex r,
1163                                                  (x,t)   <- reads s,
1164                                                  (",",u) <- lex t,
1165                                                  (y,v)   <- reads u,
1166                                                  (")",w) <- lex v ] )
1167     readList    = readList__ (readsPrec 0)
1168
1169 instance (Read a, Read b, Read c) => Read (a, b, c) where
1170     readsPrec p = readParen False
1171                         (\a -> [((x,y,z), h) | ("(",b) <- lex a,
1172                                                (x,c)   <- readsPrec 0 b,
1173                                                (",",d) <- lex c,
1174                                                (y,e)   <- readsPrec 0 d,
1175                                                (",",f) <- lex e,
1176                                                (z,g)   <- readsPrec 0 f,
1177                                                (")",h) <- lex g ] )
1178     readList    = readList__ (readsPrec 0)
1179
1180 instance (Read a, Read b, Read c, Read d) => Read (a, b, c, d) where
1181     readsPrec p = readParen False
1182                     (\a -> [((w,x,y,z), j) | ("(",b) <- lex a,
1183                                              (w,c)   <- readsPrec 0 b,
1184                                              (",",d) <- lex c,
1185                                              (x,e)   <- readsPrec 0 d,
1186                                              (",",f) <- lex e,
1187                                              (y,g)   <- readsPrec 0 f,
1188                                              (",",h) <- lex g,
1189                                              (z,i)   <- readsPrec 0 h,
1190                                              (")",j) <- lex i ] )
1191     readList    = readList__ (readsPrec 0)
1192
1193 instance (Read a, Read b, Read c, Read d, Read e) => Read (a, b, c, d, e) where
1194     readsPrec p = readParen False
1195                     (\a -> [((w,x,y,z,v), l) | ("(",b) <- lex a,
1196                                                (w,c)   <- readsPrec 0 b,
1197                                                (",",d) <- lex c,
1198                                                (x,e)   <- readsPrec 0 d,
1199                                                (",",f) <- lex e,
1200                                                (y,g)   <- readsPrec 0 f,
1201                                                (",",h) <- lex g,
1202                                                (z,i)   <- readsPrec 0 h,
1203                                                (",",j) <- lex i,
1204                                                (v,k)   <- readsPrec 0 j,
1205                                                (")",l) <- lex k ] )
1206     readList    = readList__ (readsPrec 0)
1207
1208 instance  (Show a, Show b) => Show (a,b)  where
1209     showsPrec p (x,y) = showChar '(' . shows x . showString ", " .
1210                                        shows y . showChar ')'
1211     showList    = showList__ (showsPrec 0)
1212
1213 instance (Show a, Show b, Show c) => Show (a, b, c) where
1214     showsPrec p (x,y,z) = showChar '(' . showsPrec 0 x . showString ", " .
1215                                          showsPrec 0 y . showString ", " .
1216                                          showsPrec 0 z . showChar ')'
1217     showList    = showList__ (showsPrec 0)
1218
1219 instance (Show a, Show b, Show c, Show d) => Show (a, b, c, d) where
1220     showsPrec p (w,x,y,z) = showChar '(' . showsPrec 0 w . showString ", " .
1221                                            showsPrec 0 x . showString ", " .
1222                                            showsPrec 0 y . showString ", " .
1223                                            showsPrec 0 z . showChar ')'
1224
1225     showList    = showList__ (showsPrec 0)
1226
1227 instance (Show a, Show b, Show c, Show d, Show e) => Show (a, b, c, d, e) where
1228     showsPrec p (v,w,x,y,z) = showChar '(' . showsPrec 0 v . showString ", " .
1229                                              showsPrec 0 w . showString ", " .
1230                                              showsPrec 0 x . showString ", " .
1231                                              showsPrec 0 y . showString ", " .
1232                                              showsPrec 0 z . showChar ')'
1233     showList    = showList__ (showsPrec 0)
1234
1235 ---------------------------------------------------------------------
1236 -- component projections for pairs:
1237 -- (NB: not provided for triples, quadruples, etc.)
1238 fst                     :: (a,b) -> a
1239 fst (x,y)               =  x
1240
1241 snd                     :: (a,b) -> b
1242 snd (x,y)               =  y
1243
1244 -- curry converts an uncurried function to a curried function;
1245 -- uncurry converts a curried function to a function on pairs.
1246 curry                   :: ((a, b) -> c) -> a -> b -> c
1247 curry f x y             =  f (x, y)
1248
1249 uncurry                 :: (a -> b -> c) -> ((a, b) -> c)
1250 uncurry f p             =  f (fst p) (snd p)
1251
1252 -- Functions
1253
1254 -- Standard value bindings
1255
1256 -- identity function
1257 id                      :: a -> a
1258 id x                    =  x
1259
1260 -- constant function
1261 const                   :: a -> b -> a
1262 const x _               =  x
1263
1264 -- function composition
1265 {-# INLINE (.) #-}
1266 {-# GENERATE_SPECS (.) a b c #-}
1267 (.)                     :: (b -> c) -> (a -> b) -> a -> c
1268 f . g                   =  \ x -> f (g x)
1269
1270 -- flip f  takes its (first) two arguments in the reverse order of f.
1271 flip                    :: (a -> b -> c) -> b -> a -> c
1272 flip f x y              =  f y x
1273
1274 -- right-associating infix application operator (useful in continuation-
1275 -- passing style)
1276 ($)                     :: (a -> b) -> a -> b
1277 f $ x                   =  f x
1278
1279 -- until p f  yields the result of applying f until p holds.
1280 until                   :: (a -> Bool) -> (a -> a) -> a -> a
1281 until p f x | p x       =  x
1282             | otherwise =  until p f (f x)
1283
1284 -- asTypeOf is a type-restricted version of const.  It is usually used
1285 -- as an infix operator, and its typing forces its first argument
1286 -- (which is usually overloaded) to have the same type as the second.
1287 asTypeOf                :: a -> a -> a
1288 asTypeOf                =  const
1289
1290 -- error stops execution and displays an error message
1291
1292 error :: String -> a
1293 error s = error__ ( \ x -> _ccall_ ErrorHdrHook x ) s
1294
1295 -- It is expected that compilers will recognize this and insert error
1296 -- messages which are more appropriate to the context in which undefined
1297 -- appears.
1298
1299 undefined               :: a
1300 undefined               =  error "Prelude.undefined"
1301
1302 -- ============================================================
1303 -- Standard list functions
1304 -- ============================================================
1305
1306 {- module PreludeList -}
1307
1308 -- head and tail extract the first element and remaining elements,
1309 -- respectively, of a list, which must be non-empty.  last and init
1310 -- are the dual functions working from the end of a finite list,
1311 -- rather than the beginning.
1312
1313 head                    :: [a] -> a
1314 head (x:_)              =  x
1315 head []                 =  error "PreludeList.head: empty list"
1316
1317 last                    :: [a] -> a
1318 last [x]                =  x
1319 last (_:xs)             =  last xs
1320 last []                 =  error "PreludeList.last: empty list"
1321
1322 tail                    :: [a] -> [a]
1323 tail (_:xs)             =  xs
1324 tail []                 =  error "PreludeList.tail: empty list"
1325
1326 init                    :: [a] -> [a]
1327 init [x]                =  []
1328 init (x:xs)             =  x : init xs
1329 init []                 =  error "PreludeList.init: empty list"
1330
1331 null                    :: [a] -> Bool
1332 null []                 =  True
1333 null (_:_)              =  False
1334
1335 -- length returns the length of a finite list as an Int; it is an instance
1336 -- of the more general genericLength, the result type of which may be
1337 -- any kind of number.
1338 length                  :: [a] -> Int
1339 length []               =  0
1340 length (_:l)            =  1 + length l
1341
1342 -- List index (subscript) operator, 0-origin
1343 (!!)                    :: [a] -> Int -> a
1344 (x:_)  !! 0             =  x
1345 (_:xs) !! n | n > 0     =  xs !! (n-1)
1346 (_:_)  !! _             =  error "PreludeList.!!: negative index"
1347 []     !! _             =  error "PreludeList.!!: index too large"
1348
1349 -- foldl, applied to a binary operator, a starting value (typically the
1350 -- left-identity of the operator), and a list, reduces the list using
1351 -- the binary operator, from left to right:
1352 --  foldl f z [x1, x2, ..., xn] == (...((z `f` x1) `f` x2) `f`...) `f` xn
1353 -- foldl1 is a variant that has no starting value argument, and  thus must
1354 -- be applied to non-empty lists.  scanl is similar to foldl, but returns
1355 -- a list of successive reduced values from the left:
1356 --      scanl f z [x1, x2, ...] == [z, z `f` x1, (z `f` x1) `f` x2, ...]
1357 -- Note that  last (scanl f z xs) == foldl f z xs.
1358 -- scanl1 is similar, again without the starting element:
1359 --      scanl1 f [x1, x2, ...] == [x1, x1 `f` x2, ...]
1360
1361 foldl                   :: (a -> b -> a) -> a -> [b] -> a
1362 foldl f z []            =  z
1363 foldl f z (x:xs)        =  foldl f (f z x) xs
1364
1365 foldl1                  :: (a -> a -> a) -> [a] -> a
1366 foldl1 f (x:xs)         =  foldl f x xs
1367 foldl1 _ []             =  error "PreludeList.foldl1: empty list"
1368
1369 scanl                   :: (a -> b -> a) -> a -> [b] -> [a]
1370 scanl f q xs            =  q : (case xs of
1371                                 []   -> []
1372                                 x:xs -> scanl f (f q x) xs)
1373
1374 scanl1                  :: (a -> a -> a) -> [a] -> [a]
1375 scanl1 f (x:xs)         =  scanl f x xs
1376 scanl1 _ []             =  error "PreludeList.scanl1: empty list"
1377
1378 -- foldr, foldr1, scanr, and scanr1 are the right-to-left duals of the
1379 -- above functions.
1380
1381 foldr                   :: (a -> b -> b) -> b -> [a] -> b
1382 foldr f z []            =  z
1383 foldr f z (x:xs)        =  f x (foldr f z xs)
1384
1385 foldr1                  :: (a -> a -> a) -> [a] -> a
1386 foldr1 f [x]            =  x
1387 foldr1 f (x:xs)         =  f x (foldr1 f xs)
1388 foldr1 _ []             =  error "PreludeList.foldr1: empty list"
1389
1390 scanr                   :: (a -> b -> b) -> b -> [a] -> [b]
1391 scanr f q0 []           =  [q0]
1392 scanr f q0 (x:xs)       =  f x q : qs
1393                            where qs@(q:_) = scanr f q0 xs
1394
1395 scanr1                  :: (a -> a -> a) -> [a] -> [a]
1396 scanr1 f  [x]           =  [x]
1397 scanr1 f  (x:xs)        =  f x q : qs
1398                            where qs@(q:_) = scanr1 f xs
1399 scanr1 _ []             =  error "PreludeList.scanr1: empty list"
1400
1401 -- iterate f x returns an infinite list of repeated applications of f to x:
1402 -- iterate f x == [x, f x, f (f x), ...]
1403 iterate                 :: (a -> a) -> a -> [a]
1404 iterate f x             =  x : iterate f (f x)
1405
1406 -- repeat x is an infinite list, with x the value of every element.
1407 repeat                  :: a -> [a]
1408 repeat x                =  xs where xs = x:xs
1409
1410 -- replicate n x is a list of length n with x the value of every element
1411 replicate               :: Int -> a -> [a]
1412 replicate n x           =  take n (repeat x)
1413
1414 -- cycle ties a finite list into a circular one, or equivalently,
1415 -- the infinite repetition of the original list.  It is the identity
1416 -- on infinite lists.
1417
1418 cycle                   :: [a] -> [a]
1419 cycle xs                =  xs' where xs' = xs ++ xs'
1420
1421 -- take n, applied to a list xs, returns the prefix of xs of length n,
1422 -- or xs itself if n > length xs.  drop n xs returns the suffix of xs
1423 -- after the first n elements, or [] if n > length xs.  splitAt n xs
1424 -- is equivalent to (take n xs, drop n xs).
1425
1426 take                   :: Int -> [a] -> [a]
1427 take 0 _               =  []
1428 take _ []              =  []
1429 take n (x:xs) | n > 0  =  x : take (n-1) xs
1430 take _     _           =  error "PreludeList.take: negative argument"
1431
1432 drop                   :: Int -> [a] -> [a]
1433 drop 0 xs              =  xs
1434 drop _ []              =  []
1435 drop n (_:xs) | n > 0  =  drop (n-1) xs
1436 drop _     _           =  error "PreludeList.drop: negative argument"
1437
1438 splitAt                   :: Int -> [a] -> ([a],[a])
1439 splitAt 0 xs              =  ([],xs)
1440 splitAt _ []              =  ([],[])
1441 splitAt n (x:xs) | n > 0  =  (x:xs',xs'') where (xs',xs'') = splitAt (n-1) xs
1442 splitAt _     _           =  error "PreludeList.splitAt: negative argument"
1443
1444 -- takeWhile, applied to a predicate p and a list xs, returns the longest
1445 -- prefix (possibly empty) of xs of elements that satisfy p.  dropWhile p xs
1446 -- returns the remaining suffix.  Span p xs is equivalent to
1447 -- (takeWhile p xs, dropWhile p xs), while break p uses the negation of p.
1448
1449 takeWhile               :: (a -> Bool) -> [a] -> [a]
1450 takeWhile p []          =  []
1451 takeWhile p (x:xs)
1452             | p x       =  x : takeWhile p xs
1453             | otherwise =  []
1454
1455 dropWhile               :: (a -> Bool) -> [a] -> [a]
1456 dropWhile p []          =  []
1457 dropWhile p xs@(x:xs')
1458             | p x       =  dropWhile p xs'
1459             | otherwise =  xs
1460
1461 span, break             :: (a -> Bool) -> [a] -> ([a],[a])
1462 span p []               =  ([],[])
1463 span p xs@(x:xs')
1464          | p x          =  let (ys,zs) = span p xs' in (x:ys,zs)
1465          | otherwise    =  ([],xs)
1466 break p                 =  span (not . p)
1467
1468 -- lines breaks a string up into a list of strings at newline characters.
1469 -- The resulting strings do not contain newlines.  Similary, words
1470 -- breaks a string up into a list of words, which were delimited by
1471 -- white space.  unlines and unwords are the inverse operations.
1472 -- unlines joins lines with terminating newlines, and unwords joins
1473 -- words with separating spaces.
1474
1475 lines                   :: String -> [String]
1476 lines ""                =  []
1477 lines s                 =  let (l, s') = break (== '\n') s
1478                            in  l : case s' of
1479                                         []      -> []
1480                                         (_:s'') -> lines s''
1481
1482 words                   :: String -> [String]
1483 words s                 =  case dropWhile {-partain:Char.-}isSpace s of
1484                                 "" -> []
1485                                 s' -> w : words s''
1486                                       where (w, s'') =
1487                                              break {-partain:Char.-}isSpace s'
1488
1489 unlines                 :: [String] -> String
1490 unlines                 =  concatMap (++ "\n")
1491
1492 unwords                 :: [String] -> String
1493 unwords []              =  ""
1494 unwords ws              =  foldr1 (\w s -> w ++ ' ':s) ws
1495
1496 -- reverse xs returns the elements of xs in reverse order.  xs must be finite.
1497 reverse                 :: [a] -> [a]
1498 reverse                 =  foldl (flip (:)) []
1499
1500 -- and returns the conjunction of a Boolean list.  For the result to be
1501 -- True, the list must be finite; False, however, results from a False
1502 -- value at a finite index of a finite or infinite list.  or is the
1503 -- disjunctive dual of and.
1504 and, or                 :: [Bool] -> Bool
1505 and                     =  foldr (&&) True
1506 or                      =  foldr (||) False
1507
1508 -- Applied to a predicate and a list, any determines if any element
1509 -- of the list satisfies the predicate.  Similarly, for all.
1510 any, all                :: (a -> Bool) -> [a] -> Bool
1511 any p                   =  or . map p
1512 all p                   =  and . map p
1513
1514 -- elem is the list membership predicate, usually written in infix form,
1515 -- e.g., x `elem` xs.  notElem is the negation.
1516 elem, notElem           :: (Eq a) => a -> [a] -> Bool
1517 elem x                  =  any (== x)
1518 notElem x               =  all (not . (/= x))
1519
1520 -- lookup key assocs looks up a key in an association list.
1521 lookup                  :: (Eq a) => a -> [(a,b)] -> Maybe b
1522 lookup key []           =  Nothing
1523 lookup key ((x,y):xys)
1524     | key == x          =  Just y
1525     | otherwise         =  lookup key xys
1526
1527 -- sum and product compute the sum or product of a finite list of numbers.
1528 sum, product            :: (Num a) => [a] -> a
1529 sum                     =  foldl (+) 0
1530 product                 =  foldl (*) 1
1531
1532 -- maximum and minimum return the maximum or minimum value from a list,
1533 -- which must be non-empty, finite, and of an ordered type.
1534 maximum, minimum        :: (Ord a) => [a] -> a
1535 maximum []              =  error "PreludeList.maximum: empty list"
1536 maximum xs              =  foldl1 max xs
1537
1538 minimum []              =  error "PreludeList.minimum: empty list"
1539 minimum xs              =  foldl1 min xs
1540
1541 concatMap               :: (a -> [b]) -> [a] -> [b]
1542 concatMap f             =  concat . map f
1543
1544 -- zip takes two lists and returns a list of corresponding pairs.  If one
1545 -- input list is short, excess elements of the longer list are discarded.
1546 -- zip3 takes three lists and returns a list of triples.  Zips for larger
1547 -- tuples are in the List library
1548
1549 zip                     :: [a] -> [b] -> [(a,b)]
1550 zip                     =  zipWith (,)
1551
1552 zip3                    :: [a] -> [b] -> [c] -> [(a,b,c)]
1553 zip3                    =  zipWith3 (,,)
1554
1555 -- The zipWith family generalises the zip family by zipping with the
1556 -- function given as the first argument, instead of a tupling function.
1557 -- For example, zipWith (+) is applied to two lists to produce the list
1558 -- of corresponding sums.
1559
1560 zipWith                 :: (a->b->c) -> [a]->[b]->[c]
1561 zipWith z (a:as) (b:bs) =  z a b : zipWith z as bs
1562 zipWith _ _ _           =  []
1563
1564 zipWith3                :: (a->b->c->d) -> [a]->[b]->[c]->[d]
1565 zipWith3 z (a:as) (b:bs) (c:cs)
1566                         =  z a b c : zipWith3 z as bs cs
1567 zipWith3 _ _ _ _        =  []
1568
1569
1570 -- unzip transforms a list of pairs into a pair of lists.
1571
1572 unzip                   :: [(a,b)] -> ([a],[b])
1573 unzip                   =  foldr (\(a,b) ~(as,bs) -> (a:as,b:bs)) ([],[])
1574
1575 unzip3                  :: [(a,b,c)] -> ([a],[b],[c])
1576 unzip3                  =  foldr (\(a,b,c) ~(as,bs,cs) -> (a:as,b:bs,c:cs))
1577                                  ([],[],[])
1578
1579 {- module  PreludeText -}
1580
1581 type  ReadS a   = String -> [(a,String)]
1582 type  ShowS     = String -> String
1583
1584 class  Read a  where
1585     readsPrec :: Int -> ReadS a
1586     readList  :: ReadS [a]
1587
1588     readList    = readParen False (\r -> [pr | ("[",s)  <- lex r,
1589                                                pr       <- readl s])
1590                   where readl  s = [([],t)   | ("]",t)  <- lex s] ++
1591                                    [(x:xs,u) | (x,t)    <- reads s,
1592                                                (xs,u)   <- readl' t]
1593                         readl' s = [([],t)   | ("]",t)  <- lex s] ++
1594                                    [(x:xs,v) | (",",t)  <- lex s,
1595                                                (x,u)    <- reads t,
1596                                                (xs,v)   <- readl' u]
1597
1598 class  Show a  where
1599     showsPrec :: Int -> a -> ShowS
1600     showList  :: [a] -> ShowS
1601
1602     showList [] = showString "[]"
1603     showList (x:xs)
1604                 = showChar '[' . shows x . showl xs
1605                   where showl []     = showChar ']'
1606                         showl (x:xs) = showString ", " . shows x . showl xs
1607
1608 reads           :: (Read a) => ReadS a
1609 reads           =  readsPrec 0
1610
1611 shows           :: (Show a) => a -> ShowS
1612 shows           =  showsPrec 0
1613
1614 read            :: (Read a) => String -> a
1615 read s          =  case [x | (x,t) <- reads s, ("","") <- lex t] of
1616                         [x] -> x
1617                         []  -> error "PreludeText.read: no parse"
1618                         _   -> error "PreludeText.read: ambiguous parse"
1619
1620 show            :: (Show a) => a -> String
1621 show x          =  shows x ""
1622
1623 showChar        :: Char -> ShowS
1624 showChar        =  (:)
1625
1626 showString      :: String -> ShowS
1627 showString      =  (++)
1628
1629 showParen       :: Bool -> ShowS -> ShowS
1630 showParen b p   =  if b then showChar '(' . p . showChar ')' else p
1631
1632 readParen       :: Bool -> ReadS a -> ReadS a
1633 readParen b g   =  if b then mandatory else optional
1634                    where optional r  = g r ++ mandatory r
1635                          mandatory r = [(x,u) | ("(",s) <- lex r,
1636                                                 (x,t)   <- optional s,
1637                                                 (")",u) <- lex t    ]
1638
1639 -- lex: moved to GHCbase
1640
1641 {- module PreludeIO -}
1642
1643 -- in GHCio: type FilePath   =  String
1644
1645 fail            :: IOError -> IO a
1646 fail err        =  IO $ ST $ \ s -> (Left err, s)
1647
1648 userError       :: String  -> IOError
1649 userError str   =  UserError str
1650
1651 catch           :: IO a    -> (IOError -> IO a) -> IO a
1652 catch (IO (ST m)) k  = IO $ ST $ \ s ->
1653   case (m s) of { (r, new_s) ->
1654   case r of
1655     Right  _ -> (r, new_s)
1656     Left err -> case (k err) of { IO (ST k_err) ->
1657                 (k_err new_s) }}
1658
1659 putChar         :: Char -> IO ()
1660 putChar c       =  hPutChar stdout c
1661
1662 putStr          :: String -> IO ()
1663 putStr s        =  hPutStr stdout s
1664
1665 putStrLn        :: String -> IO ()
1666 putStrLn s      =  do putStr s
1667                       putChar '\n'
1668
1669 print           :: Show a => a -> IO ()
1670 print x         =  putStrLn (show x)
1671
1672 getChar         :: IO Char
1673 getChar         =  hGetChar stdin
1674
1675 getLine         :: IO String
1676 getLine         =  do c <- getChar
1677                       if c == '\n' then return "" else
1678                          do s <- getLine
1679                             return (c:s)
1680
1681 getContents     :: IO String
1682 getContents     =  hGetContents stdin
1683
1684 interact        ::  (String -> String) -> IO ()
1685 interact f      =   do s <- getContents
1686                        putStr (f s)
1687
1688 readFile        :: FilePath -> IO String
1689 readFile name   =  openFile name ReadMode >>= hGetContents
1690
1691 writeFile       :: FilePath -> String -> IO ()
1692 writeFile name str
1693   = openFile name WriteMode >>= \hdl -> hPutStr hdl str >> hClose hdl
1694
1695 appendFile      :: FilePath -> String -> IO ()
1696 appendFile name str
1697   = openFile name AppendMode >>= \hdl -> hPutStr hdl str >> hClose hdl
1698
1699 readIO          :: Read a => String -> IO a
1700   -- raises an exception instead of an error
1701 readIO s        =  case [x | (x,t) <- reads s, ("","") <- lex t] of
1702                         [x] -> return x
1703                         []  -> fail (userError "PreludeIO.readIO: no parse")
1704                         _   -> fail (userError
1705                                       "PreludeIO.readIO: ambiguous parse")
1706
1707 readLn          :: Read a => IO a
1708 readLn          =  do l <- getLine
1709                       r <- readIO l
1710                       return r