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