ghc/lib/std/PrelBase.lhs

   1 %
   2 % (c) The GRAP/AQUA Project, Glasgow University, 1992-1996
   3 %
   4 \section[PrelBase]{Module @PrelBase@}
   5
   6
   7 The overall structure of the GHC Prelude is a bit tricky.
   8
   9   a) We want to avoid "orphan modules", i.e. ones with instance
  10         decls that don't belong either to a tycon or a class
  11         defined in the same module
  12
  13   b) We want to avoid giant modules
  14
  15 So the rough structure is as follows, in (linearised) dependency order
  16
  17
  18 PrelGHC         Has no implementation.  It defines built-in things, and
  19                 by importing it you bring them into scope.
  20                 The source file is PrelGHC.hi-boot, which is just
  21                 copied to make PrelGHC.hi
  22
  23                 Classes: CCallable, CReturnable
  24
  25 PrelBase        Classes: Eq, Ord, Functor, Monad
  26                 Types:   list, (), Int, Bool, Ordering, Char, String
  27
  28 PrelTup         Types: tuples, plus instances for PrelBase classes
  29
  30 PrelShow        Class: Show, plus instances for PrelBase/PrelTup types
  31
  32 PrelEnum        Class: Enum,  plus instances for PrelBase/PrelTup types
  33
  34 PrelMaybe       Type: Maybe, plus instances for PrelBase classes
  35
  36 PrelNum         Class: Num, plus instances for Int
  37                 Type:  Integer, plus instances for all classes so far (Eq, Ord, Num, Show)
  38
  39                 Integer is needed here because it is mentioned in the signature
  40                 of 'fromInteger' in class Num
  41
  42 PrelReal        Classes: Real, Integral, Fractional, RealFrac
  43                          plus instances for Int, Integer
  44                 Types:  Ratio, Rational
  45                         plus intances for classes so far
  46
  47                 Rational is needed here because it is mentioned in the signature
  48                 of 'toRational' in class Real
  49
  50 Ix              Classes: Ix, plus instances for Int, Bool, Char, Integer, Ordering, tuples
  51
  52 PrelArr         Types: Array, MutableArray, MutableVar
  53
  54                 Does *not* contain any ByteArray stuff (see PrelByteArr)
  55                 Arrays are used by a function in PrelFloat
  56
  57 PrelFloat       Classes: Floating, RealFloat
  58                 Types:   Float, Double, plus instances of all classes so far
  59
  60                 This module contains everything to do with floating point.
  61                 It is a big module (900 lines)
  62                 With a bit of luck, many modules can be compiled without ever reading PrelFloat.hi
  63
  64 PrelByteArr     Types: ByteArray, MutableByteArray
  65
  66                 We want this one to be after PrelFloat, because it defines arrays
  67                 of unboxed floats.
  68
  69
  70 Other Prelude modules are much easier with fewer complex dependencies.
  71
  72
  73 \begin{code}
  74 {-# OPTIONS -fno-implicit-prelude #-}
  75
  76 module PrelBase
  77         (
  78         module PrelBase,
  79         module PrelGHC          -- Re-export PrelGHC, to avoid lots of people
  80                                 -- having to import it explicitly
  81   )
  82         where
  83
  84 import {-# SOURCE #-} PrelErr ( error )
  85 import PrelGHC
  86
  87 infixr 9  .
  88 infixr 5  ++, :
  89 infix  4  ==, /=, <, <=, >=, >
  90 infixr 3  &&
  91 infixr 2  ||
  92 infixl 1  >>, >>=
  93 infixr 0  $
  94
  95 default ()              -- Double isn't available yet
  96 \end{code}
  97
  98
  99 %*********************************************************
 100 %*                                                      *
 101 \subsection{DEBUGGING STUFF}
 102 %*  (for use when compiling PrelBase itself doesn't work)
 103 %*                                                      *
 104 %*********************************************************
 105
 106 \begin{code}
 107 {-
 108 data  Bool  =  False | True
 109 data Ordering = LT | EQ | GT
 110 data Char = C# Char#
 111 type  String = [Char]
 112 data Int = I# Int#
 113 data  ()  =  ()
 114 -- data [] a = MkNil
 115
 116 not True = False
 117 (&&) True True = True
 118 otherwise = True
 119
 120 build = error "urk"
 121 foldr = error "urk"
 122
 123 unpackCString#  :: Addr# -> [Char]
 124 unpackFoldrCString#  :: Addr# -> (Char  -> a -> a) -> a -> a
 125 unpackAppendCString# :: Addr# -> [Char] -> [Char]
 126 unpackNBytes#      :: Addr# -> Int#   -> [Char]
 127 unpackNBytes# a b = error "urk"
 128 unpackCString# a = error "urk"
 129 unpackFoldrCString# a = error "urk"
 130 unpackAppendCString# a = error "urk"
 131 -}
 132 \end{code}
 133
 134
 135 %*********************************************************
 136 %*                                                      *
 137 \subsection{Standard classes @Eq@, @Ord@}
 138 %*                                                      *
 139 %*********************************************************
 140
 141 \begin{code}
 142 class  Eq a  where
 143     (==), (/=)          :: a -> a -> Bool
 144
 145 --    x /= y            = not (x == y)
 146 --    x == y            = not (x /= y)
 147 --    x /= y            =  True
 148     (/=) x y            = not  ((==) x y)
 149     x == y              =  True
 150
 151 class  (Eq a) => Ord a  where
 152     compare             :: a -> a -> Ordering
 153     (<), (<=), (>=), (>):: a -> a -> Bool
 154     max, min            :: a -> a -> a
 155
 156 -- An instance of Ord should define either compare or <=
 157 -- Using compare can be more efficient for complex types.
 158     compare x y
 159             | x == y    = EQ
 160             | x <= y    = LT    -- NB: must be '<=' not '<' to validate the
 161                                 -- above claim about the minimal things that can
 162                                 -- be defined for an instance of Ord
 163             | otherwise = GT
 164
 165     x <= y  = case compare x y of { GT -> False; _other -> True }
 166     x <  y  = case compare x y of { LT -> True;  _other -> False }
 167     x >= y  = case compare x y of { LT -> False; _other -> True }
 168     x >  y  = case compare x y of { GT -> True;  _other -> False }
 169
 170         -- These two default methods use '>' rather than compare
 171         -- because the latter is often more expensive
 172     max x y = if x > y then x else y
 173     min x y = if x > y then y else x
 174 \end{code}
 175
 176 %*********************************************************
 177 %*                                                      *
 178 \subsection{Monadic classes @Functor@, @Monad@ }
 179 %*                                                      *
 180 %*********************************************************
 181
 182 \begin{code}
 183 class  Functor f  where
 184     fmap         :: (a -> b) -> f a -> f b
 185
 186 class  Monad m  where
 187     (>>=)       :: m a -> (a -> m b) -> m b
 188     (>>)        :: m a -> m b -> m b
 189     return      :: a -> m a
 190     fail        :: String -> m a
 191
 192     m >> k      =  m >>= \_ -> k
 193     fail s      = error s
 194
 195 \end{code}
 196
 197
 198 %*********************************************************
 199 %*                                                      *
 200 \subsection{The list type}
 201 %*                                                      *
 202 %*********************************************************
 203
 204 \begin{code}
 205 data [] a = [] | a : [a]  -- do explicitly: deriving (Eq, Ord)
 206                           -- to avoid weird names like con2tag_[]#
 207
 208
 209 instance (Eq a) => Eq [a]  where
 210 {-
 211     {-# SPECIALISE instance Eq [Char] #-}
 212 -}
 213     []     == []     = True
 214     (x:xs) == (y:ys) = x == y && xs == ys
 215     _xs    == _ys    = False
 216
 217     xs     /= ys     = if (xs == ys) then False else True
 218
 219 instance (Ord a) => Ord [a] where
 220 {-
 221     {-# SPECIALISE instance Ord [Char] #-}
 222 -}
 223     a <  b  = case compare a b of { LT -> True;  EQ -> False; GT -> False }
 224     a <= b  = case compare a b of { LT -> True;  EQ -> True;  GT -> False }
 225     a >= b  = case compare a b of { LT -> False; EQ -> True;  GT -> True  }
 226     a >  b  = case compare a b of { LT -> False; EQ -> False; GT -> True  }
 227
 228     compare []     []     = EQ
 229     compare (_:_)  []     = GT
 230     compare []     (_:_)  = LT
 231     compare (x:xs) (y:ys) = case compare x y of
 232                                  LT -> LT
 233                                  GT -> GT
 234                                  EQ -> compare xs ys
 235
 236 instance Functor [] where
 237     fmap = map
 238
 239 instance  Monad []  where
 240     m >>= k             = foldr ((++) . k) [] m
 241     m >> k              = foldr ((++) . (\ _ -> k)) [] m
 242     return x            = [x]
 243     fail _              = []
 244 \end{code}
 245
 246 A few list functions that appear here because they are used here.
 247 The rest of the prelude list functions are in PrelList.
 248
 249 ----------------------------------------------
 250 --      foldr/build/augment
 251 ----------------------------------------------
 252
 253 \begin{code}
 254 foldr            :: (a -> b -> b) -> b -> [a] -> b
 255 -- foldr _ z []     =  z
 256 -- foldr f z (x:xs) =  f x (foldr f z xs)
 257 {-# INLINE foldr #-}
 258 foldr k z xs = go xs
 259              where
 260                go []     = z
 261                go (x:xs) = x `k` go xs
 262
 263 build   :: forall a. (forall b. (a -> b -> b) -> b -> b) -> [a]
 264 {-# INLINE 2 build #-}
 265         -- The INLINE is important, even though build is tiny,
 266         -- because it prevents [] getting inlined in the version that
 267         -- appears in the interface file.  If [] *is* inlined, it
 268         -- won't match with [] appearing in rules in an importing module.
 269         --
 270         -- The "2" says to inline in phase 2
 271
 272 build g = g (:) []
 273
 274 augment :: forall a. (forall b. (a->b->b) -> b -> b) -> [a] -> [a]
 275 {-# INLINE 2 augment #-}
 276 augment g xs = g (:) xs
 277
 278 {-# RULES
 279 "fold/build"    forall k z (g::forall b. (a->b->b) -> b -> b) .
 280                 foldr k z (build g) = g k z
 281
 282 "foldr/augment" forall k z xs (g::forall b. (a->b->b) -> b -> b) .
 283                 foldr k z (augment g xs) = g k (foldr k z xs)
 284
 285 "foldr/id"      foldr (:) [] = \x->x
 286 "foldr/app"     forall xs ys. foldr (:) ys xs = append xs ys
 287
 288 "foldr/cons"    forall k z x xs. foldr k z (x:xs) = k x (foldr k z xs)
 289 "foldr/nil"     forall k z.      foldr k z []     = z
 290
 291 "augment/build" forall (g::forall b. (a->b->b) -> b -> b)
 292                        (h::forall b. (a->b->b) -> b -> b) .
 293                        augment g (build h) = build (\c n -> g c (h c n))
 294 "augment/nil"   forall (g::forall b. (a->b->b) -> b -> b) .
 295                         augment g [] = build g
 296  #-}
 297
 298 -- This rule is true, but not (I think) useful:
 299 --      augment g (augment h t) = augment (\cn -> g c (h c n)) t
 300 \end{code}
 301
 302
 303 ----------------------------------------------
 304 --              map
 305 ----------------------------------------------
 306
 307 \begin{code}
 308 map :: (a -> b) -> [a] -> [b]
 309 map = mapList
 310
 311 -- Note eta expanded
 312 mapFB c f x ys = c (f x) ys
 313
 314 mapList :: (a -> b) -> [a] -> [b]
 315 mapList _ []     = []
 316 mapList f (x:xs) = f x : mapList f xs
 317
 318 {-# RULES
 319 "map"       forall f xs.        map f xs                = build (\c n -> foldr (mapFB c f) n xs)
 320 "mapFB"     forall c f g.       mapFB (mapFB c f) g     = mapFB c (f.g)
 321 "mapList"   forall f.           foldr (mapFB (:) f) []  = mapList f
 322  #-}
 323 \end{code}
 324
 325
 326 ----------------------------------------------
 327 --              append
 328 ----------------------------------------------
 329 \begin{code}
 330 (++) :: [a] -> [a] -> [a]
 331 (++) = append
 332
 333 {-# RULES
 334   "++"  forall xs ys. (++) xs ys = augment (\c n -> foldr c n xs) ys
 335  #-}
 336
 337 append :: [a] -> [a] -> [a]
 338 append []     ys = ys
 339 append (x:xs) ys = x : append xs ys
 340 \end{code}
 341
 342
 343 %*********************************************************
 344 %*                                                      *
 345 \subsection{Type @Bool@}
 346 %*                                                      *
 347 %*********************************************************
 348
 349 \begin{code}
 350 data  Bool  =  False | True  deriving (Eq, Ord)
 351         -- Read in PrelRead, Show in PrelShow
 352
 353 -- Boolean functions
 354
 355 (&&), (||)              :: Bool -> Bool -> Bool
 356 True  && x              =  x
 357 False && _              =  False
 358 True  || _              =  True
 359 False || x              =  x
 360
 361 not                     :: Bool -> Bool
 362 not True                =  False
 363 not False               =  True
 364
 365 otherwise               :: Bool
 366 otherwise               =  True
 367 \end{code}
 368
 369
 370 %*********************************************************
 371 %*                                                      *
 372 \subsection{The @()@ type}
 373 %*                                                      *
 374 %*********************************************************
 375
 376 The Unit type is here because virtually any program needs it (whereas
 377 some programs may get away without consulting PrelTup).  Furthermore,
 378 the renamer currently *always* asks for () to be in scope, so that
 379 ccalls can use () as their default type; so when compiling PrelBase we
 380 need ().  (We could arrange suck in () only if -fglasgow-exts, but putting
 381 it here seems more direct.)
 382
 383 \begin{code}
 384 data  ()  =  ()
 385
 386 instance Eq () where
 387     () == () = True
 388     () /= () = False
 389
 390 instance Ord () where
 391     () <= () = True
 392     () <  () = False
 393     () >= () = True
 394     () >  () = False
 395     max () () = ()
 396     min () () = ()
 397     compare () () = EQ
 398 \end{code}
 399
 400
 401 %*********************************************************
 402 %*                                                      *
 403 \subsection{Type @Ordering@}
 404 %*                                                      *
 405 %*********************************************************
 406
 407 \begin{code}
 408 data Ordering = LT | EQ | GT deriving (Eq, Ord)
 409         -- Read in PrelRead, Show in PrelShow
 410 \end{code}
 411
 412
 413 %*********************************************************
 414 %*                                                      *
 415 \subsection{Type @Char@ and @String@}
 416 %*                                                      *
 417 %*********************************************************
 418
 419 \begin{code}
 420 type  String = [Char]
 421
 422 data Char = C# Char#
 423
 424 -- We don't use deriving for Eq and Ord, because for Ord the derived
 425 -- instance defines only compare, which takes two primops.  Then
 426 -- '>' uses compare, and therefore takes two primops instead of one.
 427
 428 instance Eq Char where
 429   (C# c1) == (C# c2) = c1 `eqChar#` c2
 430   (C# c1) /= (C# c2) = c1 `neChar#` c2
 431
 432 instance Ord Char where
 433   (C# c1) >  (C# c2) = c1 `gtChar#` c2
 434   (C# c1) >= (C# c2) = c1 `geChar#` c2
 435   (C# c1) <= (C# c2) = c1 `leChar#` c2
 436   (C# c1) <  (C# c2) = c1 `ltChar#` c2
 437
 438 chr :: Int -> Char
 439 chr (I# i) | i >=# 0# && i <=# 255# = C# (chr# i)
 440            | otherwise = error ("Prelude.chr: bad argument")
 441
 442 unsafeChr :: Int -> Char
 443 unsafeChr (I# i) =  C# (chr# i)
 444
 445 ord :: Char -> Int
 446 ord (C# c) =  I# (ord# c)
 447 \end{code}
 448
 449
 450 %*********************************************************
 451 %*                                                      *
 452 \subsection{Type @Int@}
 453 %*                                                      *
 454 %*********************************************************
 455
 456 \begin{code}
 457 data Int = I# Int#
 458
 459 zeroInt, oneInt, twoInt, maxInt, minInt :: Int
 460 zeroInt = I# 0#
 461 oneInt  = I# 1#
 462 twoInt  = I# 2#
 463 minInt  = I# (-2147483648#)     -- GHC <= 2.09 had this at -2147483647
 464 maxInt  = I# 2147483647#
 465
 466 instance Eq Int where
 467     (==) x y = x `eqInt` y
 468     (/=) x y = x `neInt` y
 469
 470 instance Ord Int where
 471     compare x y = compareInt x y
 472
 473     (<)  x y = ltInt x y
 474     (<=) x y = leInt x y
 475     (>=) x y = geInt x y
 476     (>)  x y = gtInt x y
 477
 478 compareInt :: Int -> Int -> Ordering
 479 (I# x) `compareInt` (I# y) | x <# y    = LT
 480                            | x ==# y   = EQ
 481                            | otherwise = GT
 482 \end{code}
 483
 484
 485 %*********************************************************
 486 %*                                                      *
 487 \subsection{The function type}
 488 %*                                                      *
 489 %*********************************************************
 490
 491 \begin{code}
 492 -- identity function
 493 id                      :: a -> a
 494 id x                    =  x
 495
 496 -- constant function
 497 const                   :: a -> b -> a
 498 const x _               =  x
 499
 500 -- function composition
 501 {-# INLINE (.) #-}
 502 (.)       :: (b -> c) -> (a -> b) -> a -> c
 503 (.) f g x = f (g x)
 504
 505 -- flip f  takes its (first) two arguments in the reverse order of f.
 506 flip                    :: (a -> b -> c) -> b -> a -> c
 507 flip f x y              =  f y x
 508
 509 -- right-associating infix application operator (useful in continuation-
 510 -- passing style)
 511 ($)                     :: (a -> b) -> a -> b
 512 f $ x                   =  f x
 513
 514 -- until p f  yields the result of applying f until p holds.
 515 until                   :: (a -> Bool) -> (a -> a) -> a -> a
 516 until p f x | p x       =  x
 517             | otherwise =  until p f (f x)
 518
 519 -- asTypeOf is a type-restricted version of const.  It is usually used
 520 -- as an infix operator, and its typing forces its first argument
 521 -- (which is usually overloaded) to have the same type as the second.
 522 asTypeOf                :: a -> a -> a
 523 asTypeOf                =  const
 524 \end{code}
 525
 526 %*********************************************************
 527 %*                                                      *
 528 \subsection{CCallable instances}
 529 %*                                                      *
 530 %*********************************************************
 531
 532 Defined here to avoid orphans
 533
 534 \begin{code}
 535 instance CCallable Char
 536 instance CReturnable Char
 537
 538 instance CCallable   Int
 539 instance CReturnable Int
 540
 541 -- DsCCall knows how to pass strings...
 542 instance CCallable   [Char]
 543
 544 instance CReturnable () -- Why, exactly?
 545 \end{code}
 546
 547
 548 %*********************************************************
 549 %*                                                      *
 550 \subsection{Numeric primops}
 551 %*                                                      *
 552 %*********************************************************
 553
 554 Definitions of the boxed PrimOps; these will be
 555 used in the case of partial applications, etc.
 556
 557 \begin{code}
 558 {-# INLINE eqInt #-}
 559 {-# INLINE neInt #-}
 560 {-# INLINE gtInt #-}
 561 {-# INLINE geInt #-}
 562 {-# INLINE ltInt #-}
 563 {-# INLINE leInt #-}
 564 {-# INLINE plusInt #-}
 565 {-# INLINE minusInt #-}
 566 {-# INLINE timesInt #-}
 567 {-# INLINE quotInt #-}
 568 {-# INLINE remInt #-}
 569 {-# INLINE negateInt #-}
 570
 571 plusInt, minusInt, timesInt, quotInt, remInt, gcdInt :: Int -> Int -> Int
 572 plusInt (I# x) (I# y) = I# (x +# y)
 573 minusInt(I# x) (I# y) = I# (x -# y)
 574 timesInt(I# x) (I# y) = I# (x *# y)
 575 quotInt (I# x) (I# y) = I# (quotInt# x y)
 576 remInt  (I# x) (I# y) = I# (remInt# x y)
 577 gcdInt (I# a)  (I# b) = I# (gcdInt# a b)
 578
 579 negateInt :: Int -> Int
 580 negateInt (I# x)      = I# (negateInt# x)
 581
 582 divInt, modInt :: Int -> Int -> Int
 583 x `divInt` y
 584   | x > zeroInt && y < zeroInt = quotInt ((x `minusInt` y) `minusInt` oneInt) y
 585   | x < zeroInt && y > zeroInt = quotInt ((x `minusInt` y) `plusInt`  oneInt) y
 586   | otherwise      = quotInt x y
 587
 588 x `modInt` y
 589   | x > zeroInt && y < zeroInt ||
 590     x < zeroInt && y > zeroInt  = if r/=zeroInt then r `plusInt` y else zeroInt
 591   | otherwise                   = r
 592   where
 593     r = remInt x y
 594
 595 gtInt, geInt, eqInt, neInt, ltInt, leInt :: Int -> Int -> Bool
 596 gtInt   (I# x) (I# y) = x ># y
 597 geInt   (I# x) (I# y) = x >=# y
 598 eqInt   (I# x) (I# y) = x ==# y
 599 neInt   (I# x) (I# y) = x /=# y
 600 ltInt   (I# x) (I# y) = x <# y
 601 leInt   (I# x) (I# y) = x <=# y
 602 \end{code}
 603
 604
 605 %********************************************************
 606 %*                                                      *
 607 \subsection{Unpacking C strings}
 608 %*                                                      *
 609 %********************************************************
 610
 611 This code is needed for virtually all programs, since it's used for
 612 unpacking the strings of error messages.
 613
 614 \begin{code}
 615 unpackCString#  :: Addr# -> [Char]
 616 unpackCString# a = unpackCStringList# a
 617
 618 unpackCStringList#  :: Addr# -> [Char]
 619 unpackCStringList# addr
 620   = unpack 0#
 621   where
 622     unpack nh
 623       | ch `eqChar#` '\0'# = []
 624       | otherwise          = C# ch : unpack (nh +# 1#)
 625       where
 626         ch = indexCharOffAddr# addr nh
 627
 628 unpackAppendCString# :: Addr# -> [Char] -> [Char]
 629 unpackAppendCString# addr rest
 630   = unpack 0#
 631   where
 632     unpack nh
 633       | ch `eqChar#` '\0'# = rest
 634       | otherwise          = C# ch : unpack (nh +# 1#)
 635       where
 636         ch = indexCharOffAddr# addr nh
 637
 638 unpackFoldrCString#  :: Addr# -> (Char  -> a -> a) -> a -> a
 639 unpackFoldrCString# addr f z
 640   = unpack 0#
 641   where
 642     unpack nh
 643       | ch `eqChar#` '\0'# = z
 644       | otherwise          = C# ch `f` unpack (nh +# 1#)
 645       where
 646         ch = indexCharOffAddr# addr nh
 647
 648 unpackNBytes#      :: Addr# -> Int#   -> [Char]
 649   -- This one is called by the compiler to unpack literal
 650   -- strings with NULs in them; rare. It's strict!
 651   -- We don't try to do list deforestation for this one
 652
 653 unpackNBytes# _addr 0#   = []
 654 unpackNBytes#  addr len# = unpack [] (len# -# 1#)
 655     where
 656      unpack acc i#
 657       | i# <# 0#  = acc
 658       | otherwise =
 659          case indexCharOffAddr# addr i# of
 660             ch -> unpack (C# ch : acc) (i# -# 1#)
 661
 662 {-# RULES
 663 "unpack"         forall a   . unpackCString# a             = build (unpackFoldrCString# a)
 664 "unpack-list"    forall a   . unpackFoldrCString# a (:) [] = unpackCStringList# a
 665 "unpack-append"  forall a n . unpackFoldrCString# a (:) n  = unpackAppendCString# a n
 666
 667 -- There's a built-in rule (in PrelRules.lhs) for
 668 --      unpackFoldr "foo" c (unpackFoldr "baz" c n)  =  unpackFoldr "foobaz" c n
 669
 670   #-}
 671
 672 \end{code}