ghc/lib/std/PrelBase.lhs

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