ghc/interpreter/prelude/Prelude.hs

   1 #include "options.h"
   2
   3 #if BIGNUM_IS_INT64
   4 #define primToBignum(t)   prim/**/t/**/ToInt64
   5 #define primFromBignum(t) primInt64To/**/t
   6 #define primInt64ToInt64 id
   7 #define primEncodeFloat primEncodeFloatz
   8 #define primDecodeFloat primDecodeFloatz
   9 #define primEncodeDouble primEncodeDoublez
  10 #define primDecodeDouble primDecodeDoublez
  11 #elif BIGNUM_IS_INTEGER
  12 #define primToBignum(t)   prim/**/t/**/ToInteger
  13 #define primFromBignum(t) primIntegerTo/**/t
  14 #define primIntegerToInteger id
  15 #define primEncodeFloat primEncodeFloatZ
  16 #define primDecodeFloat primDecodeFloatZ
  17 #define primEncodeDouble primEncodeDoubleZ
  18 #define primDecodeDouble primDecodeDoubleZ
  19 #else
  20 #warning No BIGNUM type
  21 #endif
  22
  23 #ifdef HEAD
  24 module Prelude (
  25     module PreludeList, module PreludeText, module PreludeIO,
  26     Bool(False, True),
  27     Maybe(Nothing, Just),
  28     Either(Left, Right),
  29     Ordering(LT, EQ, GT),
  30     Char, String, Int,
  31 #ifdef PROVIDE_INTEGER
  32     Integer,
  33 #endif
  34     Float, Double, IO,
  35 #if STD_PRELUDE
  36 #else
  37     Void,
  38 #endif
  39     Ratio, Rational,
  40 #if STD_PRELUDE
  41 --  List type: []((:), [])
  42 #else
  43     (:),
  44 #endif
  45 --  Tuple types: (,), (,,), etc.
  46 --  Trivial type: ()
  47 --  Functions: (->)
  48     Eq((==), (/=)),
  49     Ord(compare, (<), (<=), (>=), (>), max, min),
  50     Enum(toEnum, fromEnum, enumFrom, enumFromThen,
  51          enumFromTo, enumFromThenTo),
  52     Bounded(minBound, maxBound),
  53 #if EVAL_INSTANCES
  54     Eval(seq, strict),
  55 #else
  56     seq, strict,
  57 #endif
  58     Num((+), (-), (*), negate, abs, signum, fromInteger),
  59     Real(toRational),
  60     Integral(quot, rem, div, mod, quotRem, divMod, toInteger),
  61     Fractional((/), recip, fromRational),
  62     Floating(pi, exp, log, sqrt, (**), logBase, sin, cos, tan,
  63              asin, acos, atan, sinh, cosh, tanh, asinh, acosh, atanh),
  64     RealFrac(properFraction, truncate, round, ceiling, floor),
  65     RealFloat(floatRadix, floatDigits, floatRange, decodeFloat,
  66               encodeFloat, exponent, significand, scaleFloat, isNaN,
  67               isInfinite, isDenormalized, isIEEE, isNegativeZero),
  68     Monad((>>=), (>>), return),
  69     MonadZero(zero),
  70     MonadPlus((++)),
  71     Functor(map),
  72     succ, pred,
  73     mapM, mapM_, guard, accumulate, sequence, filter, concat, applyM,
  74     maybe, either,
  75     (&&), (||), not, otherwise,
  76     subtract, even, odd, gcd, lcm, (^), (^^),
  77     fromIntegral, fromRealFrac, atan2,
  78     fst, snd, curry, uncurry, id, const, (.), flip, ($), until,
  79     asTypeOf, error, undefined ) where
  80
  81 import PreludeBuiltin  -- Contains all `prim' values
  82 import PreludeList
  83 import PreludeText
  84 import PreludeIO
  85 import Ratio(Ratio, Rational, (%), numerator, denominator)
  86
  87 #endif /* HEAD */
  88 #ifdef BODY
  89 module PreludeBuiltin
  90         ( module PreludeBuiltin
  91         ) where
  92
  93 #if STD_PRELUDE
  94 import PreludeBuiltin  -- Contains all `prim' values
  95 import PreludeList
  96 import PreludeText
  97 import PreludeIO
  98 import Ratio(Ratio, Rational, (%), numerator, denominator)
  99 #endif
 100
 101 infixr 9  .
 102 infixr 8  ^, ^^, **
 103 infixl 7  *, /, `quot`, `rem`, `div`, `mod`
 104 infixl 6  +, -
 105 infixr 5  :, ++
 106 infix  4  ==, /=, <, <=, >=, >
 107 infixr 3  &&
 108 infixr 2  ||
 109 infixl 1  >>, >>=
 110 infixr 0  $, `seq`
 111
 112 #if STD_PRELUDE
 113 #else
 114 -- Fixities from List
 115 infix  5  \\
 116 -- Fixities from PreludeList
 117 infixl 9  !!
 118 infix  4 `elem`, `notElem`
 119 -- Fixities from Ratio (why do I have the :% fixity??)
 120 infixl 7  %, :%
 121 -- Fixities from Array
 122 infixl 9  !, //
 123
 124 #include "PreludeList.hs"
 125 #include "PreludeText.hs"
 126 #include "PreludeIO.hs"
 127 #include "Ratio.hs"
 128 #include "Ix.hs"
 129 #include "Char.hs"
 130 #include "Numeric.hs"
 131 #include "Array.hs"
 132 #include "List.hs"
 133 #include "Maybe.hs"
 134 #include "UnicodePrims.hs"
 135 #include "PreludePackString.hs"
 136 #include "PrelConc.hs"
 137
 138 -- The following bits of GHC are too good to pass up!
 139 #include "PrelIOBase.unlit"
 140 #include "PrelHandle.unlit"
 141 #include "PrelException.unlit"
 142 #include "PrelDynamic.unlit"
 143 #include "IO.unlit"
 144 #endif
 145
 146 -- Standard types, classes, instances and related functions
 147
 148 -- Equality and Ordered classes
 149
 150 class  Eq a  where
 151     (==), (/=)       :: a -> a -> Bool
 152
 153     x /= y           =  not (x == y)
 154     x == y           =  not (x /= y)
 155
 156 class  (Eq a) => Ord a  where
 157     compare          :: a -> a -> Ordering
 158     (<), (<=),
 159      (>=), (>)       :: a -> a -> Bool
 160     max, min         :: a -> a -> a
 161
 162 -- An instance of Ord should define either compare or <=
 163 -- Using compare can be more efficient for complex types.
 164     compare x y
 165          | x == y    =  EQ
 166          | x <= y    =  LT
 167          | otherwise =  GT
 168
 169     x <= y           =  compare x y /= GT
 170     x <  y           =  compare x y == LT
 171     x >= y           =  compare x y /= LT
 172     x >  y           =  compare x y == GT
 173
 174 -- note that (min x y, max x y) = (x,y) or (y,x)
 175     max x y
 176          | x >= y    =  x
 177          | otherwise =  y
 178     min x y
 179          | x <  y    =  x
 180          | otherwise =  y
 181
 182 -- Enumeration and Bounded classes
 183
 184 class  Enum a  where
 185     toEnum           :: Int -> a
 186     fromEnum         :: a -> Int
 187     enumFrom         :: a -> [a]             -- [n..]
 188     enumFromThen     :: a -> a -> [a]        -- [n,n'..]
 189     enumFromTo       :: a -> a -> [a]        -- [n..m]
 190     enumFromThenTo   :: a -> a -> a -> [a]   -- [n,n'..m]
 191
 192     enumFromTo x y   =  map toEnum [fromEnum x .. fromEnum y]
 193     enumFromThenTo x y z =
 194                         map toEnum [fromEnum x, fromEnum y .. fromEnum z]
 195
 196 succ, pred           :: Enum a => a -> a
 197 succ                 =  toEnum . (+1) . fromEnum
 198 pred                 =  toEnum . (subtract 1) . fromEnum
 199
 200 class  Bounded a  where
 201     minBound         :: a
 202     maxBound         :: a
 203
 204 -- Numeric classes
 205
 206 #if EVAL_INSTANCES
 207 class  (Eq a, Show a, Eval a) => Num a  where
 208 #else
 209 class  (Eq a, Show a) => Num a  where
 210 #endif
 211     (+), (-), (*)    :: a -> a -> a
 212     negate           :: a -> a
 213     abs, signum      :: a -> a
 214     fromInteger      :: BIGNUMTYPE -> a
 215 #if STD_PRELUDE
 216 #else
 217     fromInt          :: Int -> a
 218     fromInt          =  fromInteger . primToBignum(Int)
 219 #endif
 220
 221     x - y            =  x + negate y
 222
 223 class  (Num a, Ord a) => Real a  where
 224     toRational       :: a -> Rational
 225 #if STD_PRELUDE
 226 #else
 227     toDouble         :: a -> Double
 228     toDouble         =  rationalToRealFloat . toRational
 229 #endif
 230
 231 class  (Real a, Enum a) => Integral a  where
 232     quot, rem        :: a -> a -> a
 233     div, mod         :: a -> a -> a
 234     quotRem, divMod  :: a -> a -> (a,a)
 235     toInteger        :: a -> BIGNUMTYPE
 236 #if STD_PRELUDE
 237 #else
 238     toInt            :: a -> Int
 239     toInt            =  fromInteger . toInteger
 240 #endif
 241
 242     n `quot` d       =  q  where (q,r) = quotRem n d
 243     n `rem` d        =  r  where (q,r) = quotRem n d
 244     n `div` d        =  q  where (q,r) = divMod n d
 245     n `mod` d        =  r  where (q,r) = divMod n d
 246     divMod n d       =  if signum r == - signum d then (q-1, r+d) else qr
 247                         where qr@(q,r) = quotRem n d
 248
 249 class  (Num a) => Fractional a  where
 250     (/)              :: a -> a -> a
 251     recip            :: a -> a
 252     fromRational     :: Rational -> a
 253 #if STD_PRELUDE
 254 #else
 255     fromDouble       :: Double -> a
 256     fromDouble       =  fromRational . realFloatToRational
 257 #endif
 258
 259     recip x          =  1 / x
 260
 261 class  (Fractional a) => Floating a  where
 262     pi               :: a
 263     exp, log, sqrt   :: a -> a
 264     (**), logBase    :: a -> a -> a
 265     sin, cos, tan    :: a -> a
 266     asin, acos, atan :: a -> a
 267     sinh, cosh, tanh :: a -> a
 268     asinh, acosh, atanh :: a -> a
 269
 270     x ** y           =  exp (log x * y)
 271     logBase x y      =  log y / log x
 272     sqrt x           =  x ** 0.5
 273     tan  x           =  sin  x / cos  x
 274     tanh x           =  sinh x / cosh x
 275
 276 class  (Real a, Fractional a) => RealFrac a  where
 277     properFraction   :: (Integral b) => a -> (b,a)
 278     truncate, round  :: (Integral b) => a -> b
 279     ceiling, floor   :: (Integral b) => a -> b
 280
 281     truncate x       =  m  where (m,_) = properFraction x
 282
 283     round x          =  let (n,r) = properFraction x
 284                             m     = if r < 0 then n - 1 else n + 1
 285                           in case signum (abs r - 0.5) of
 286                                 -1 -> n
 287                                 0  -> if even n then n else m
 288                                 1  -> m
 289
 290     ceiling x        =  if r > 0 then n + 1 else n
 291                         where (n,r) = properFraction x
 292
 293     floor x          =  if r < 0 then n - 1 else n
 294                         where (n,r) = properFraction x
 295
 296 class  (RealFrac a, Floating a) => RealFloat a  where
 297     floatRadix       :: a -> BIGNUMTYPE
 298     floatDigits      :: a -> Int
 299     floatRange       :: a -> (Int,Int)
 300     decodeFloat      :: a -> (BIGNUMTYPE,Int)
 301     encodeFloat      :: BIGNUMTYPE -> Int -> a
 302     exponent         :: a -> Int
 303     significand      :: a -> a
 304     scaleFloat       :: Int -> a -> a
 305     isNaN, isInfinite, isDenormalized, isNegativeZero, isIEEE
 306                      :: a -> Bool
 307
 308     exponent x       =  if m == 0 then 0 else n + floatDigits x
 309                         where (m,n) = decodeFloat x
 310
 311     significand x    =  encodeFloat m (- floatDigits x)
 312                         where (m,_) = decodeFloat x
 313
 314     scaleFloat k x   =  encodeFloat m (n+k)
 315                         where (m,n) = decodeFloat x
 316
 317 -- Numeric functions
 318
 319 subtract         :: (Num a) => a -> a -> a
 320 subtract         =  flip (-)
 321
 322 even, odd        :: (Integral a) => a -> Bool
 323 even n           =  n `rem` 2 == 0
 324 odd              =  not . even
 325
 326 gcd              :: (Integral a) => a -> a -> a
 327 gcd 0 0          =  error "Prelude.gcd: gcd 0 0 is undefined"
 328 gcd x y          =  gcd' (abs x) (abs y)
 329                     where gcd' x 0  =  x
 330                           gcd' x y  =  gcd' y (x `rem` y)
 331
 332 lcm              :: (Integral a) => a -> a -> a
 333 lcm _ 0          =  0
 334 lcm 0 _          =  0
 335 lcm x y          =  abs ((x `quot` (gcd x y)) * y)
 336
 337 (^)              :: (Num a, Integral b) => a -> b -> a
 338 x ^ 0            =  1
 339 x ^ n | n > 0    =  f x (n-1) x
 340                     where f _ 0 y = y
 341                           f x n y = g x n  where
 342                                     g x n | even n  = g (x*x) (n `quot` 2)
 343                                           | otherwise = f x (n-1) (x*y)
 344 _ ^ _            = error "Prelude.^: negative exponent"
 345
 346 (^^)             :: (Fractional a, Integral b) => a -> b -> a
 347 x ^^ n           =  if n >= 0 then x^n else recip (x^(-n))
 348
 349 fromIntegral     :: (Integral a, Num b) => a -> b
 350 fromIntegral     =  fromInteger . toInteger
 351
 352 fromRealFrac     :: (RealFrac a, Fractional b) => a -> b
 353 fromRealFrac     =  fromRational . toRational
 354
 355 atan2            :: (RealFloat a) => a -> a -> a
 356 atan2 y x        =  case (signum y, signum x) of
 357                          ( 0, 1) ->  0
 358                          ( 1, 0) ->  pi/2
 359                          ( 0,-1) ->  pi
 360                          (-1, 0) -> -pi/2
 361                          ( _, 1) ->  atan (y/x)
 362                          ( _,-1) ->  atan (y/x) + pi
 363                          ( 0, 0) ->  error "Prelude.atan2: atan2 of origin"
 364
 365
 366 -- Monadic classes
 367
 368 class  Functor f  where
 369     map              :: (a -> b) -> f a -> f b
 370
 371 class  Monad m  where
 372     (>>=)            :: m a -> (a -> m b) -> m b
 373     (>>)             :: m a -> m b -> m b
 374     return           :: a -> m a
 375
 376     m >> k           =  m >>= \_ -> k
 377
 378 class  (Monad m) => MonadZero m  where
 379     zero             :: m a
 380
 381 class  (MonadZero m) => MonadPlus m  where
 382     (++)             :: m a -> m a -> m a
 383
 384 accumulate       :: Monad m => [m a] -> m [a]
 385 accumulate       =  foldr mcons (return [])
 386                     where mcons p q = p >>= \x -> q >>= \y -> return (x:y)
 387
 388 sequence         :: Monad m => [m a] -> m ()
 389 sequence         =  foldr (>>) (return ())
 390
 391 mapM             :: Monad m => (a -> m b) -> [a] -> m [b]
 392 mapM f as        =  accumulate (map f as)
 393
 394 mapM_            :: Monad m => (a -> m b) -> [a] -> m ()
 395 mapM_ f as       =  sequence (map f as)
 396
 397 guard            :: MonadZero m => Bool -> m ()
 398 guard p          =  if p then return () else zero
 399
 400 -- This subsumes the list-based filter function.
 401
 402 filter           :: MonadZero m => (a -> Bool) -> m a -> m a
 403 filter p         =  applyM (\x -> if p x then return x else zero)
 404
 405 -- This subsumes the list-based concat function.
 406
 407 concat           :: MonadPlus m => [m a] -> m a
 408 concat           =  foldr (++) zero
 409
 410 applyM           :: Monad m => (a -> m b) -> m a -> m b
 411 applyM f x       =  x >>= f
 412
 413 #if EVAL_INSTANCES
 414 -- Eval Class
 415
 416 class  Eval a  where
 417     seq              :: a -> b -> b
 418     strict           :: (a -> b) -> a -> b
 419
 420     seq x y          =  case primForce x of () -> y
 421     strict f x       =  case primForce x of () -> f x
 422
 423 #else
 424
 425 seq              :: a -> b -> b
 426 strict           :: (a -> b) -> a -> b
 427
 428 seq x y          =  case primForce x of () -> y
 429 strict f x       =  case primForce x of () -> f x
 430
 431 #endif
 432
 433 -- Trivial type
 434
 435 #if STD_PRELUDE
 436 data  ()  =  ()  deriving (Eq, Ord, Enum, Bounded)
 437 #else
 438 data  () => ()  =  ()  deriving (Eq, Ord, Enum, Bounded)
 439 #endif
 440
 441 -- Function type
 442
 443 #if STD_PRELUDE
 444 data a -> b  -- No constructor for functions is exported.
 445 #endif
 446
 447 -- identity function
 448 id               :: a -> a
 449 id x             =  x
 450
 451 -- constant function
 452 const            :: a -> b -> a
 453 const x _        =  x
 454
 455 -- function composition
 456 (.)              :: (b -> c) -> (a -> b) -> a -> c
 457 f . g            =  \ x -> f (g x)
 458
 459 -- flip f  takes its (first) two arguments in the reverse order of f.
 460 flip             :: (a -> b -> c) -> b -> a -> c
 461 flip f x y       =  f y x
 462
 463 -- right-associating infix application operator (useful in continuation-
 464 -- passing style)
 465 ($)              :: (a -> b) -> a -> b
 466 f $ x            =  f x
 467
 468 #if STD_PRELUDE
 469 #else
 470 -- Empty type
 471
 472 data Void      -- No constructor for Void is exported.  Import/Export
 473                -- lists must use Void instead of Void(..) or Void()
 474 #endif
 475
 476 -- Boolean type
 477
 478 data  Bool  =  False | True     deriving (Eq, Ord, Enum, Read, Show, Bounded)
 479
 480 -- Boolean functions
 481
 482 (&&), (||)       :: Bool -> Bool -> Bool
 483 True  && x       =  x
 484 False && _       =  False
 485 True  || _       =  True
 486 False || x       =  x
 487
 488 not              :: Bool -> Bool
 489 not True         =  False
 490 not False        =  True
 491
 492 otherwise        :: Bool
 493 otherwise        =  True
 494
 495
 496 -- Character type
 497
 498 #if STD_PRELUDE
 499 data Char = ... 'a' | 'b' ... -- 2^16 unicode values
 500 #else
 501 data Char
 502 #endif
 503
 504 instance  Eq Char  where
 505     c == c'          =  fromEnum c == fromEnum c'
 506 #if STD_PRELUDE
 507 #else
 508 --#warning "Could use primEqChar and primNeChar"
 509 #endif
 510
 511 instance  Ord Char  where
 512     c <= c'          =  fromEnum c <= fromEnum c'
 513 #if STD_PRELUDE
 514 #else
 515 --#warning "Could use primLeChar and friends"
 516 #endif
 517
 518 instance  Enum Char  where
 519     toEnum           =  primIntToChar
 520     fromEnum         =  primCharToInt
 521     enumFrom c       =  map toEnum [fromEnum c .. fromEnum (maxBound::Char)]
 522     enumFromThen c c' =  map toEnum [fromEnum c,
 523                                      fromEnum c' .. fromEnum lastChar]
 524                          where lastChar :: Char
 525                                lastChar | c' < c    = minBound
 526                                         | otherwise = maxBound
 527
 528 instance  Bounded Char  where
 529     minBound            =  '\0'
 530 #if STD_PRELUDE
 531     maxBound            =  '\xffff'
 532 #else
 533 --#warning "literal char constants too small"
 534     maxBound            =  '\xff'
 535 #endif
 536
 537 type  String = [Char]
 538
 539
 540 -- Maybe type
 541
 542 data  Maybe a  =  Nothing | Just a      deriving (Eq, Ord, Read, Show)
 543
 544 maybe              :: b -> (a -> b) -> Maybe a -> b
 545 maybe n f Nothing  =  n
 546 maybe n f (Just x) =  f x
 547
 548 instance  Functor Maybe  where
 549     map f Nothing    =  Nothing
 550     map f (Just x)   =  Just (f x)
 551
 552 instance  Monad Maybe  where
 553     (Just x) >>= k   =  k x
 554     Nothing  >>= k   =  Nothing
 555     return           =  Just
 556
 557 instance  MonadZero Maybe  where
 558     zero             = Nothing
 559
 560 instance  MonadPlus Maybe  where
 561     Nothing ++ ys    =  ys
 562     xs      ++ ys    =  xs
 563
 564 -- Either type
 565
 566 data  Either a b  =  Left a | Right b   deriving (Eq, Ord, Read, Show)
 567
 568 either               :: (a -> c) -> (b -> c) -> Either a b -> c
 569 either f g (Left x)  =  f x
 570 either f g (Right y) =  g y
 571
 572 -- IO type
 573
 574 #if STD_PRELUDE
 575 data  IO a  -- abstract
 576
 577 instance  Functor IO where
 578    map f x           =  x >>= (return . f)
 579
 580 instance  Monad IO  where ...
 581 #else
 582 newtype ST s a = ST (s -> (a,s))
 583
 584 runST :: (forall s. ST s a) -> a
 585 runST m = fst (unST m theWorld)
 586  where
 587   theWorld :: RealWorld
 588   theWorld = error "runST: entered the world"
 589
 590 unST (ST a) = a
 591
 592 instance  Functor (ST s) where
 593    map f x = x >>= (return . f)
 594
 595 instance  Monad (ST s) where
 596     m >> k      =  m >>= \ _ -> k
 597     return x    =  ST $ \ s -> (x,s)
 598     m >>= k = ST $ \s -> case unST m s of { (a,s') -> unST (k a) s' }
 599
 600 fixST :: (a -> ST s a) -> ST s a
 601 fixST k = ST $ \ s ->
 602     let
 603         result = unST (k (fst result)) s
 604     in
 605     result
 606
 607 unsafeInterleaveST :: ST s a -> ST s a
 608 unsafeInterleaveST m = ST (\ s -> (fst (unST m s), s))
 609
 610 fixIO :: (a -> IO a) -> IO a
 611 fixIO = fixST
 612
 613 unsafePerformIO :: IO a -> a
 614 unsafePerformIO m = fst (unST m realWorld)
 615  where
 616   realWorld :: RealWorld
 617   realWorld = error "panic: Hugs shouldnae enter the real world"
 618
 619 unsafeInterleaveIO :: IO a -> IO a
 620 unsafeInterleaveIO = unsafeInterleaveST
 621
 622 -- This is one of the main uses of unsafeInterleaveIO
 623 mkLazyList :: IO (Maybe a) -> IO [a]
 624 mkLazyList m = unsafeInterleaveIO $ do
 625              mx  <- m
 626              case mx of
 627              Nothing -> return []
 628              Just x  -> do
 629                xs <- mkLazyList m
 630                return (x:xs)
 631
 632 -- used in desugaring Foreign functions
 633 primMkIO :: (RealWorld -> (a,RealWorld)) -> IO a
 634 primMkIO = ST
 635
 636 -- used when Hugs invokes top level function
 637 primRunIO :: IO () -> ()
 638 primRunIO m = fst (unST (protect 5 m) realWorld)
 639  where
 640   realWorld :: RealWorld
 641   realWorld = error "panic: Hugs shouldnae enter the real world"
 642
 643   -- make sure there's always an error handler on the stack
 644   protect :: Int -> IO () -> IO ()
 645   protect 0     m = putStr "\nProgram error: too many nested errors\n"
 646   protect (n+1) m = m `catchException` \ e -> protect n (putStr "\nProgram error: " >> print e)
 647
 648 data RealWorld -- no constructors
 649 type IO a = ST RealWorld a
 650 #endif
 651
 652 -- Ordering type
 653
 654 data  Ordering  =  LT | EQ | GT
 655           deriving (Eq, Ord, Enum, Read, Show, Bounded)
 656
 657
 658 -- Standard numeric types.  The data declarations for these types cannot
 659 -- be expressed directly in Haskell since the constructor lists would be
 660 -- far too large.
 661
 662 #if STD_PRELUDE
 663 data  Int  =  minBound ... -1 | 0 | 1 ... maxBound
 664 instance  Eq       Int  where ...
 665 instance  Ord      Int  where ...
 666 instance  Num      Int  where ...
 667 instance  Real     Int  where ...
 668 instance  Integral Int  where ...
 669 instance  Enum     Int  where ...
 670 instance  Bounded  Int  where ...
 671 #else
 672 data  Int
 673
 674 instance Eq  Int     where
 675     (==)          = primEqInt
 676     (/=)          = primNeInt
 677
 678 instance Ord Int     where
 679     (<)           = primLtInt
 680     (<=)          = primLeInt
 681     (>=)          = primGeInt
 682     (>)           = primGtInt
 683
 684 instance Num Int where
 685     (+)           = primPlusInt
 686     (-)           = primMinusInt
 687     negate        = primNegateInt
 688     (*)           = primTimesInt
 689     abs           = absReal
 690     signum        = signumReal
 691     fromInteger   = primFromBignum(Int)
 692     fromInt       = id
 693
 694 instance Real Int where
 695     toRational x  = toInteger x % 1
 696
 697 instance Integral Int where
 698     quotRem       = primQuotRemInt
 699     toInteger     = primToBignum(Int)
 700     toInt x       = x
 701
 702 instance Enum Int where
 703     toEnum        = id
 704     fromEnum      = id
 705     enumFrom      = numericEnumFrom
 706     enumFromThen  = numericEnumFromThen
 707     enumFromTo    = numericEnumFromTo
 708     enumFromThenTo= numericEnumFromThenTo
 709
 710 instance Bounded Int where
 711     minBound      = primMinInt
 712     maxBound      = primMaxInt
 713 #endif
 714
 715 #ifdef PROVIDE_WORD
 716 data  Word
 717
 718 instance Eq  Word     where
 719   (==)            = primEqWord
 720   (/=)            = primNeWord
 721
 722 instance Ord Word     where
 723   (<)             = primLtWord
 724   (<=)            = primLeWord
 725   (>=)            = primGeWord
 726   (>)             = primGtWord
 727
 728 --and     = primAndWord
 729 --or      = primOrWord
 730 --not     = primNotWord
 731 --shiftL  = primShiftL
 732 --shiftRA = primShiftRA
 733 --shiftRL = primShiftRL
 734 --toInt   = primWord2Int
 735 --fromInt = primInt2Word
 736 #endif
 737
 738 #ifdef PROVIDE_ADDR
 739 data  Addr
 740
 741 nullAddr = primIntToAddr 0
 742
 743 instance Eq  Addr     where
 744   (==)            = primEqAddr
 745   (/=)            = primNeAddr
 746
 747 instance Ord Addr     where
 748   (<)             = primLtAddr
 749   (<=)            = primLeAddr
 750   (>=)            = primGeAddr
 751   (>)             = primGtAddr
 752
 753 --toInt   = addr2Int
 754 --fromInt = int2Addr
 755 #endif
 756
 757 #if STD_PRELUDE
 758 data  Integer  =  ... -1 | 0 | 1 ...
 759 instance  Eq       Integer  where ...
 760 instance  Ord      Integer  where ...
 761 instance  Num      Integer  where ...
 762 instance  Real     Integer  where ...
 763 instance  Integral Integer  where ...
 764 instance  Enum     Integer  where ...
 765 #else
 766 #ifdef PROVIDE_INTEGER
 767 data  Integer
 768
 769 instance Eq  Integer     where
 770     (==) x y      = primCompareInteger x y == 0
 771
 772 instance Ord Integer     where
 773     compare x y   = case primCompareInteger x y of
 774                     -1 -> LT
 775                     0  -> EQ
 776                     1  -> GT
 777
 778 instance Num Integer where
 779     (+)           = primPlusInteger
 780     (-)           = primMinusInteger
 781     negate        = primNegateInteger
 782     (*)           = primTimesInteger
 783     abs           = absReal
 784     signum        = signumReal
 785     fromInteger   = primFromBignum(Integer)
 786     fromInt       = primIntToInteger
 787
 788 instance Real Integer where
 789     toRational x  = toInteger x % 1
 790
 791 instance Integral Integer where
 792     quotRem       = primQuotRemInteger
 793     divMod        = primDivModInteger
 794     toInteger     = primToBignum(Integer)
 795     toInt         = primIntegerToInt
 796
 797 instance Enum Integer where
 798     toEnum        = primIntToInteger
 799     fromEnum      = primIntegerToInt
 800     enumFrom      = numericEnumFrom
 801     enumFromThen  = numericEnumFromThen
 802     enumFromTo    = numericEnumFromTo
 803     enumFromThenTo= numericEnumFromThenTo
 804 #endif /* PROVIDE_INTEGER */
 805 #endif
 806
 807 #ifdef PROVIDE_INT64
 808 data  Int64
 809
 810 instance Eq  Int64     where
 811     (==)          = primEqInt64
 812     (/=)          = primNeInt64
 813
 814 instance Ord Int64     where
 815     (<)           = primLtInt64
 816     (<=)          = primLeInt64
 817     (>=)          = primGeInt64
 818     (>)           = primGtInt64
 819     compare x y
 820       | x `primLtInt64` y = LT
 821       | x `primEqInt64` y = EQ
 822       | otherwise         = GT
 823
 824 instance Num Int64 where
 825     (+)           = primPlusInt64
 826     (-)           = primMinusInt64
 827     negate        = primNegateInt64
 828     (*)           = primTimesInt64
 829     abs           = absReal
 830     signum        = signumReal
 831     fromInteger   = primFromBignum(Int64)
 832     fromInt       = primIntToInt64
 833
 834 instance Real Int64 where
 835     toRational x  = toInteger x % 1
 836
 837 instance Integral Int64 where
 838     quotRem       = primQuotRemInt64
 839     toInteger     = primToBignum(Int64)
 840     toInt         = primInt64ToInt
 841
 842 instance Enum Int64 where
 843     toEnum        = primIntToInt64
 844     fromEnum      = primInt64ToInt
 845     enumFrom      = numericEnumFrom
 846     enumFromThen  = numericEnumFromThen
 847     enumFromTo    = numericEnumFromTo
 848     enumFromThenTo= numericEnumFromThenTo
 849 #endif /* PROVIDE_INT64 */
 850
 851 #if STD_PRELUDE
 852 #else
 853 absReal x    | x >= 0    = x
 854              | otherwise = -x
 855
 856 signumReal x | x == 0    =  0
 857              | x > 0     =  1
 858              | otherwise = -1
 859 #endif
 860
 861 #if STD_PRELUDE
 862 data  Float
 863 instance  Eq         Float  where ...
 864 instance  Ord        Float  where ...
 865 instance  Num        Float  where ...
 866 instance  Real       Float  where ...
 867 instance  Fractional Float  where ...
 868 instance  Floating   Float  where ...
 869 instance  RealFrac   Float  where ...
 870 instance  RealFloat  Float  where ...
 871 #else
 872 data  Float
 873
 874 instance Eq  Float  where
 875     (==)          = primEqFloat
 876     (/=)          = primNeFloat
 877
 878 instance Ord Float  where
 879     (<)           = primLtFloat
 880     (<=)          = primLeFloat
 881     (>=)          = primGeFloat
 882     (>)           = primGtFloat
 883
 884 instance Num Float where
 885     (+)           = primPlusFloat
 886     (-)           = primMinusFloat
 887     negate        = primNegateFloat
 888     (*)           = primTimesFloat
 889     abs           = absReal
 890     signum        = signumReal
 891     fromInteger   = primFromBignum(Float)
 892     fromInt       = primIntToFloat
 893
 894 instance Bounded Float where
 895     minBound      = primMinFloat
 896     maxBound      = primMaxFloat
 897
 898 instance Real Float where
 899     toRational    = realFloatToRational
 900
 901 instance Fractional Float where
 902     (/)           = primDivideFloat
 903     fromRational  = rationalToRealFloat
 904     fromDouble    = primDoubleToFloat
 905
 906 instance Floating Float where
 907     pi            = 3.14159265358979323846
 908     exp           = primExpFloat
 909     log           = primLogFloat
 910     sqrt          = primSqrtFloat
 911     sin           = primSinFloat
 912     cos           = primCosFloat
 913     tan           = primTanFloat
 914     asin          = primAsinFloat
 915     acos          = primAcosFloat
 916     atan          = primAtanFloat
 917
 918 instance RealFrac Float where
 919     properFraction = floatProperFraction
 920
 921 instance RealFloat Float where
 922     floatRadix  _ = toInteger primRadixFloat
 923     floatDigits _ = primDigitsFloat
 924     floatRange  _ = (primMinExpFloat,primMaxExpFloat)
 925     encodeFloat   = primEncodeFloat
 926     decodeFloat   = primDecodeFloat
 927     isNaN         = primIsNaNFloat
 928     isInfinite    = primIsInfiniteFloat
 929     isDenormalized= primIsDenormalizedFloat
 930     isNegativeZero= primIsNegativeZeroFloat
 931     isIEEE        = const primIsIEEEFloat
 932 #endif
 933
 934 #if STD_PRELUDE
 935 data  Double
 936 instance  Eq         Double  where ...
 937 instance  Ord        Double  where ...
 938 instance  Num        Double  where ...
 939 instance  Real       Double  where ...
 940 instance  Fractional Double  where ...
 941 instance  Floating   Double  where ...
 942 instance  RealFrac   Double  where ...
 943 instance  RealFloat  Double  where ...
 944 #else
 945 data  Double
 946
 947 instance Eq  Double  where
 948     (==)         = primEqDouble
 949     (/=)         = primNeDouble
 950
 951 instance Ord Double  where
 952     (<)          = primLtDouble
 953     (<=)         = primLeDouble
 954     (>=)         = primGeDouble
 955     (>)          = primGtDouble
 956
 957 instance Num Double where
 958     (+)          = primPlusDouble
 959     (-)          = primMinusDouble
 960     negate       = primNegateDouble
 961     (*)          = primTimesDouble
 962     abs          = absReal
 963     signum       = signumReal
 964     fromInteger  = primFromBignum(Double)
 965     fromInt      = primIntToDouble
 966
 967 instance Bounded Double where
 968     minBound     = primMinDouble
 969     maxBound     = primMaxDouble
 970
 971 instance Real Double where
 972     toRational   = realFloatToRational
 973
 974 realFloatToRational x = (m%1)*(b%1)^^n
 975                           where (m,n) = decodeFloat x
 976                                 b     = floatRadix x
 977
 978 instance Fractional Double where
 979     (/)          = primDivideDouble
 980     fromRational = rationalToRealFloat
 981     fromDouble x = x
 982
 983 rationalToRealFloat x = x'
 984    where x'    = f e
 985          f e   = if e' == e then y else f e'
 986                  where y      = encodeFloat (round (x * (1%b)^^e)) e
 987                        (_,e') = decodeFloat y
 988          (_,e) = decodeFloat (fromInteger (numerator x) `asTypeOf` x'
 989                                / fromInteger (denominator x))
 990          b     = floatRadix x'
 991
 992 instance Floating Double where
 993     pi    = 3.14159265358979323846
 994     exp   = primExpDouble
 995     log   = primLogDouble
 996     sqrt  = primSqrtDouble
 997     sin   = primSinDouble
 998     cos   = primCosDouble
 999     tan   = primTanDouble
1000     asin  = primAsinDouble
1001     acos  = primAcosDouble
1002     atan  = primAtanDouble
1003
1004 instance RealFrac Double where
1005     properFraction = floatProperFraction
1006
1007 floatProperFraction x
1008    | n >= 0      = (fromInteger m * fromInteger b ^ n, 0)
1009    | otherwise   = (fromInteger w, encodeFloat r n)
1010                      where (m,n) = decodeFloat x
1011                            b     = floatRadix x
1012                            (w,r) = quotRem m (b^(-n))
1013
1014 instance RealFloat Double where
1015     floatRadix  _ = toInteger primRadixDouble
1016     floatDigits _ = primDigitsDouble
1017     floatRange  _ = (primMinExpDouble,primMaxExpDouble)
1018     encodeFloat   = primEncodeDouble
1019     decodeFloat   = primDecodeDouble
1020     isNaN         = primIsNaNDouble
1021     isInfinite    = primIsInfiniteDouble
1022     isDenormalized= primIsDenormalizedDouble
1023     isNegativeZero= primIsNegativeZeroDouble
1024     isIEEE        = const primIsIEEEDouble
1025 #endif
1026
1027 -- The Enum instances for Floats and Doubles are slightly unusual.
1028 -- The `toEnum' function truncates numbers to Int.  The definitions
1029 -- of enumFrom and enumFromThen allow floats to be used in arithmetic
1030 -- series: [0,0.1 .. 1.0].  However, roundoff errors make these somewhat
1031 -- dubious.  This example may have either 10 or 11 elements, depending on
1032 -- how 0.1 is represented.
1033
1034 instance  Enum Float  where
1035     toEnum           =  fromIntegral
1036     fromEnum         =  fromInteger . truncate   -- may overflow
1037     enumFrom         =  numericEnumFrom
1038     enumFromThen     =  numericEnumFromThen
1039     enumFromTo       =  numericEnumFromTo
1040     enumFromThenTo   =  numericEnumFromThenTo
1041
1042 instance  Enum Double  where
1043     toEnum           =  fromIntegral
1044     fromEnum         =  fromInteger . truncate   -- may overflow
1045     enumFrom         =  numericEnumFrom
1046     enumFromThen     =  numericEnumFromThen
1047     enumFromTo       =  numericEnumFromTo
1048     enumFromThenTo   =  numericEnumFromThenTo
1049
1050 numericEnumFrom         :: (Real a) => a -> [a]
1051 numericEnumFromThen     :: (Real a) => a -> a -> [a]
1052 numericEnumFromTo       :: (Real a) => a -> a -> [a]
1053 numericEnumFromThenTo   :: (Real a) => a -> a -> a -> [a]
1054 numericEnumFrom         =  iterate (+1)
1055 numericEnumFromThen n m =  iterate (+(m-n)) n
1056 numericEnumFromTo n m   =  takeWhile (<= m) (numericEnumFrom n)
1057 numericEnumFromThenTo n n' m
1058                         =  takeWhile (if n' >= n then (<= m) else (>= m))
1059                                      (numericEnumFromThen n n')
1060
1061
1062 -- Lists
1063
1064 #if STD_PRELUDE
1065 data  [a]  =  [] | a : [a]  deriving (Eq, Ord)
1066 #else
1067 data  () => [a]  =  [] | a : [a]  deriving (Eq, Ord)
1068 #endif
1069
1070 instance Functor [] where
1071     map f []         =  []
1072     map f (x:xs)     =  f x : map f xs
1073
1074 instance  Monad []  where
1075     m >>= k          =  concat (map k m)
1076     return x         =  [x]
1077
1078 instance  MonadZero []  where
1079     zero             =  []
1080
1081 instance  MonadPlus []  where
1082     xs ++ ys         =  foldr (:) ys xs
1083
1084 -- Tuples
1085
1086 #if STD_PRELUDE
1087 data  (a,b)   =  (a,b)    deriving (Eq, Ord, Bounded)
1088 data  (a,b,c) =  (a,b,c)  deriving (Eq, Ord, Bounded)
1089 #endif
1090
1091
1092 -- component projections for pairs:
1093 -- (NB: not provided for triples, quadruples, etc.)
1094 fst              :: (a,b) -> a
1095 fst (x,y)        =  x
1096
1097 snd              :: (a,b) -> b
1098 snd (x,y)        =  y
1099
1100 -- curry converts an uncurried function to a curried function;
1101 -- uncurry converts a curried function to a function on pairs.
1102 curry            :: ((a, b) -> c) -> a -> b -> c
1103 curry f x y      =  f (x, y)
1104
1105 uncurry          :: (a -> b -> c) -> ((a, b) -> c)
1106 uncurry f p      =  f (fst p) (snd p)
1107
1108 -- Misc functions
1109
1110 -- until p f  yields the result of applying f until p holds.
1111 until            :: (a -> Bool) -> (a -> a) -> a -> a
1112 until p f x
1113      | p x       =  x
1114      | otherwise =  until p f (f x)
1115
1116 -- asTypeOf is a type-restricted version of const.  It is usually used
1117 -- as an infix operator, and its typing forces its first argument
1118 -- (which is usually overloaded) to have the same type as the second.
1119 asTypeOf         :: a -> a -> a
1120 asTypeOf         =  const
1121
1122 -- error stops execution and displays an error message
1123
1124 #if STD_PRELUDE
1125 error            :: String -> a
1126 error            =  primError
1127 #else
1128 error            :: String -> a
1129 error msg        =  primRaise (IOException (userError msg))
1130 #endif
1131
1132 -- It is expected that compilers will recognize this and insert error
1133 -- messages that are more appropriate to the context in which undefined
1134 -- appears.
1135
1136 undefined        :: a
1137 undefined        =  error "Prelude.undefined"
1138
1139 #if STD_PRELUDE
1140 #else
1141 --Missing primOps and magic funs
1142
1143 -- Used for pattern match failure.
1144 -- ToDo: make the message more informative.
1145 primPmFail :: a
1146 primPmFail = error "Pattern Match Failure"
1147
1148 -- used in derived compare functions, must be exported from Prelude
1149 primCompAux      :: Ord a => a -> a -> Ordering -> Ordering
1150 primCompAux x y o = case compare x y of EQ -> o; LT -> LT; GT -> GT
1151
1152 -- used in derived show functions, must be exported from Prelude
1153 primShowField    :: Show a => String -> a -> ShowS
1154 primShowField m v = showString m . showChar '=' . shows v
1155
1156 -- used in derived read functions, must be exported from Prelude
1157 primReadField    :: Read a => String -> ReadS a
1158 primReadField m s0 = [ r | (t,  s1) <- lex s0, t == m,
1159                            ("=",s2) <- lex s1,
1160                            r        <- readsPrec 10 s2 ]
1161
1162 -- These 4 primitives are used in pattern matching.
1163 primPmInt :: Num a => Int -> a -> Bool
1164 primPmInt x y = fromInt x == y
1165
1166 primPmInteger :: Num a => BIGNUMTYPE -> a -> Bool
1167 primPmInteger x y = fromInteger x == y
1168
1169 primPmDouble :: Fractional a => Double -> a -> Bool
1170 primPmDouble x y = fromDouble x == y
1171
1172 -- The following primitives are only needed if (n+k) patterns are enabled
1173 -- The first two look trivial but they're selecting a method from a
1174 -- superclass of their argument...
1175 primPmLe        :: Integral a => a -> a -> Bool
1176 primPmLe x y     = x <= y
1177
1178 primPmSubtract   :: Integral a => a -> a -> a
1179 primPmSubtract x y = x - y
1180
1181 primPmFromInteger :: Integral a => BIGNUMTYPE -> a
1182 primPmFromInteger = fromInteger
1183
1184 primPmSub        :: Integral a => Int -> a -> a
1185 primPmSub n x     = x - fromInt n
1186
1187 #ifdef PROVIDE_STABLE
1188 data StablePtr a
1189 #endif
1190 #ifdef PROVIDE_FOREIGN
1191 data ForeignObj
1192
1193 makeForeignObj :: Addr -> IO ForeignObj
1194 makeForeignObj = primMakeForeignObj
1195
1196 #endif
1197 #ifdef PROVIDE_WEAK
1198 data Weak a
1199
1200 mkWeak  :: k                            -- key
1201         -> v                            -- value
1202         -> IO ()                        -- finaliser
1203         -> IO (Weak v)                  -- weak pointer
1204
1205 mkWeak k v f = primMakeWeak k v (unsafePerformIO f)
1206
1207 deRefWeak :: Weak v -> IO (Maybe v)
1208 deRefWeak w = do
1209   { (stillThere,v) <- primDeRefWeak w
1210   -- Warning: you'd better ignore v unless stillThere is 1
1211   ; return (if stillThere == 0 then Nothing else Just v)
1212   }
1213
1214 mkWeakPtr :: k -> IO () -> IO (Weak k)
1215 mkWeakPtr key finaliser = mkWeak key key finaliser
1216
1217 mkWeakPair :: k -> v -> IO () -> IO (Weak (k,v))
1218 mkWeakPair key val finaliser = mkWeak key (key,val) finaliser
1219
1220 addFinaliser :: key -> IO () -> IO ()
1221 addFinaliser key finaliser = do
1222    mkWeakPtr key finaliser              -- throw it away
1223    return ()
1224
1225 addForeignFinaliser :: ForeignObj -> IO () -> IO ()
1226 addForeignFinaliser fo finaliser = addFinaliser fo finaliser
1227
1228 {-
1229 finalise :: Weak v -> IO ()
1230 finalise (Weak w) = finaliseWeak# w
1231
1232 instance Eq (Weak v) where
1233   (Weak w1) == (Weak w2) = w1 `sameWeak#` w2
1234 -}
1235
1236 #endif
1237
1238 #endif
1239 #endif /* BODY */