GHC/Base.lhs

   1 \section[GHC.Base]{Module @GHC.Base@}
   2
   3 The overall structure of the GHC Prelude is a bit tricky.
   4
   5   a) We want to avoid "orphan modules", i.e. ones with instance
   6         decls that don't belong either to a tycon or a class
   7         defined in the same module
   8
   9   b) We want to avoid giant modules
  10
  11 So the rough structure is as follows, in (linearised) dependency order
  12
  13
  14 GHC.Prim                Has no implementation.  It defines built-in things, and
  15                 by importing it you bring them into scope.
  16                 The source file is GHC.Prim.hi-boot, which is just
  17                 copied to make GHC.Prim.hi
  18
  19                 Classes: CCallable, CReturnable
  20
  21 GHC.Base        Classes: Eq, Ord, Functor, Monad
  22                 Types:   list, (), Int, Bool, Ordering, Char, String
  23
  24 Data.Tup        Types: tuples, plus instances for GHC.Base classes
  25
  26 GHC.Show        Class: Show, plus instances for GHC.Base/GHC.Tup types
  27
  28 GHC.Enum        Class: Enum,  plus instances for GHC.Base/GHC.Tup types
  29
  30 Data.Maybe      Type: Maybe, plus instances for GHC.Base classes
  31
  32 GHC.Num         Class: Num, plus instances for Int
  33                 Type:  Integer, plus instances for all classes so far (Eq, Ord, Num, Show)
  34
  35                 Integer is needed here because it is mentioned in the signature
  36                 of 'fromInteger' in class Num
  37
  38 GHC.Real        Classes: Real, Integral, Fractional, RealFrac
  39                          plus instances for Int, Integer
  40                 Types:  Ratio, Rational
  41                         plus intances for classes so far
  42
  43                 Rational is needed here because it is mentioned in the signature
  44                 of 'toRational' in class Real
  45
  46 Ix              Classes: Ix, plus instances for Int, Bool, Char, Integer, Ordering, tuples
  47
  48 GHC.Arr         Types: Array, MutableArray, MutableVar
  49
  50                 Does *not* contain any ByteArray stuff (see GHC.ByteArr)
  51                 Arrays are used by a function in GHC.Float
  52
  53 GHC.Float       Classes: Floating, RealFloat
  54                 Types:   Float, Double, plus instances of all classes so far
  55
  56                 This module contains everything to do with floating point.
  57                 It is a big module (900 lines)
  58                 With a bit of luck, many modules can be compiled without ever reading GHC.Float.hi
  59
  60 GHC.ByteArr     Types: ByteArray, MutableByteArray
  61
  62                 We want this one to be after GHC.Float, because it defines arrays
  63                 of unboxed floats.
  64
  65
  66 Other Prelude modules are much easier with fewer complex dependencies.
  67
  68 \begin{code}
  69 {-# OPTIONS -fno-implicit-prelude #-}
  70 -----------------------------------------------------------------------------
  71 -- |
  72 -- Module      :  GHC.Base
  73 -- Copyright   :  (c) The University of Glasgow, 1992-2002
  74 -- License     :  see libraries/base/LICENSE
  75 --
  76 -- Maintainer  :  cvs-ghc@haskell.org
  77 -- Stability   :  internal
  78 -- Portability :  non-portable (GHC extensions)
  79 --
  80 -- Basic data types and classes.
  81 --
  82 -----------------------------------------------------------------------------
  83
  84 #include "MachDeps.h"
  85
  86 module GHC.Base
  87         (
  88         module GHC.Base,
  89         module GHC.Prim,                -- Re-export GHC.Prim and GHC.Err, to avoid lots
  90         module GHC.Err          -- of people having to import it explicitly
  91   )
  92         where
  93
  94 import GHC.Prim
  95 import {-# SOURCE #-} GHC.Err
  96
  97 infixr 9  .
  98 infixr 5  ++, :
  99 infix  4  ==, /=, <, <=, >=, >
 100 infixr 3  &&
 101 infixr 2  ||
 102 infixl 1  >>, >>=
 103 infixr 0  $
 104
 105 default ()              -- Double isn't available yet
 106 \end{code}
 107
 108
 109 %*********************************************************
 110 %*                                                      *
 111 \subsection{DEBUGGING STUFF}
 112 %*  (for use when compiling GHC.Base itself doesn't work)
 113 %*                                                      *
 114 %*********************************************************
 115
 116 \begin{code}
 117 {-
 118 data  Bool  =  False | True
 119 data Ordering = LT | EQ | GT
 120 data Char = C# Char#
 121 type  String = [Char]
 122 data Int = I# Int#
 123 data  ()  =  ()
 124 data [] a = MkNil
 125
 126 not True = False
 127 (&&) True True = True
 128 otherwise = True
 129
 130 build = error "urk"
 131 foldr = error "urk"
 132
 133 unpackCString# :: Addr# -> [Char]
 134 unpackFoldrCString# :: Addr# -> (Char  -> a -> a) -> a -> a
 135 unpackAppendCString# :: Addr# -> [Char] -> [Char]
 136 unpackCStringUtf8# :: Addr# -> [Char]
 137 unpackCString# a = error "urk"
 138 unpackFoldrCString# a = error "urk"
 139 unpackAppendCString# a = error "urk"
 140 unpackCStringUtf8# a = error "urk"
 141 -}
 142 \end{code}
 143
 144
 145 %*********************************************************
 146 %*                                                      *
 147 \subsection{Standard classes @Eq@, @Ord@}
 148 %*                                                      *
 149 %*********************************************************
 150
 151 \begin{code}
 152 class  Eq a  where
 153     (==), (/=)           :: a -> a -> Bool
 154
 155     x /= y               = not (x == y)
 156     x == y               = not (x /= y)
 157
 158 class  (Eq a) => Ord a  where
 159     compare              :: a -> a -> Ordering
 160     (<), (<=), (>), (>=) :: a -> a -> Bool
 161     max, min             :: a -> a -> a
 162
 163     -- An instance of Ord should define either 'compare' or '<='.
 164     -- Using 'compare' can be more efficient for complex types.
 165
 166     compare x y
 167         | x == y    = EQ
 168         | x <= y    = LT        -- NB: must be '<=' not '<' to validate the
 169                                 -- above claim about the minimal things that
 170                                 -- can be defined for an instance of Ord
 171         | otherwise = GT
 172
 173     x <  y = case compare x y of { LT -> True;  _other -> False }
 174     x <= y = case compare x y of { GT -> False; _other -> True }
 175     x >  y = case compare x y of { GT -> True;  _other -> False }
 176     x >= y = case compare x y of { LT -> False; _other -> True }
 177
 178         -- These two default methods use '<=' rather than 'compare'
 179         -- because the latter is often more expensive
 180     max x y = if x <= y then y else x
 181     min x y = if x <= y then x else y
 182 \end{code}
 183
 184 %*********************************************************
 185 %*                                                      *
 186 \subsection{Monadic classes @Functor@, @Monad@ }
 187 %*                                                      *
 188 %*********************************************************
 189
 190 \begin{code}
 191 class  Functor f  where
 192     fmap        :: (a -> b) -> f a -> f b
 193
 194 class  Monad m  where
 195     (>>=)       :: m a -> (a -> m b) -> m b
 196     (>>)        :: m a -> m b -> m b
 197     return      :: a -> m a
 198     fail        :: String -> m a
 199
 200     m >> k      = m >>= \_ -> k
 201     fail s      = error s
 202 \end{code}
 203
 204
 205 %*********************************************************
 206 %*                                                      *
 207 \subsection{The list type}
 208 %*                                                      *
 209 %*********************************************************
 210
 211 \begin{code}
 212 data [] a = [] | a : [a]  -- do explicitly: deriving (Eq, Ord)
 213                           -- to avoid weird names like con2tag_[]#
 214
 215
 216 instance (Eq a) => Eq [a] where
 217     {-# SPECIALISE instance Eq [Char] #-}
 218     []     == []     = True
 219     (x:xs) == (y:ys) = x == y && xs == ys
 220     _xs    == _ys    = False
 221
 222 instance (Ord a) => Ord [a] where
 223     {-# SPECIALISE instance Ord [Char] #-}
 224     compare []     []     = EQ
 225     compare []     (_:_)  = LT
 226     compare (_:_)  []     = GT
 227     compare (x:xs) (y:ys) = case compare x y of
 228                                 EQ    -> compare xs ys
 229                                 other -> other
 230
 231 instance Functor [] where
 232     fmap = map
 233
 234 instance  Monad []  where
 235     m >>= k             = foldr ((++) . k) [] m
 236     m >> k              = foldr ((++) . (\ _ -> k)) [] m
 237     return x            = [x]
 238     fail _              = []
 239 \end{code}
 240
 241 A few list functions that appear here because they are used here.
 242 The rest of the prelude list functions are in GHC.List.
 243
 244 ----------------------------------------------
 245 --      foldr/build/augment
 246 ----------------------------------------------
 247
 248 \begin{code}
 249 foldr            :: (a -> b -> b) -> b -> [a] -> b
 250 -- foldr _ z []     =  z
 251 -- foldr f z (x:xs) =  f x (foldr f z xs)
 252 {-# INLINE [0] foldr #-}
 253 -- Inline only in the final stage, after the foldr/cons rule has had a chance
 254 foldr k z xs = go xs
 255              where
 256                go []     = z
 257                go (y:ys) = y `k` go ys
 258
 259 build   :: forall a. (forall b. (a -> b -> b) -> b -> b) -> [a]
 260 {-# INLINE [1] build #-}
 261         -- The INLINE is important, even though build is tiny,
 262         -- because it prevents [] getting inlined in the version that
 263         -- appears in the interface file.  If [] *is* inlined, it
 264         -- won't match with [] appearing in rules in an importing module.
 265         --
 266         -- The "1" says to inline in phase 1
 267
 268 build g = g (:) []
 269
 270 augment :: forall a. (forall b. (a->b->b) -> b -> b) -> [a] -> [a]
 271 {-# INLINE [1] augment #-}
 272 augment g xs = g (:) xs
 273
 274 {-# RULES
 275 "fold/build"    forall k z (g::forall b. (a->b->b) -> b -> b) .
 276                 foldr k z (build g) = g k z
 277
 278 "foldr/augment" forall k z xs (g::forall b. (a->b->b) -> b -> b) .
 279                 foldr k z (augment g xs) = g k (foldr k z xs)
 280
 281 "foldr/id"                        foldr (:) [] = \x->x
 282 "foldr/app"     [1] forall xs ys. foldr (:) ys xs = xs ++ ys
 283         -- Only activate this from phase 1, because that's
 284         -- when we disable the rule that expands (++) into foldr
 285
 286 -- The foldr/cons rule looks nice, but it can give disastrously
 287 -- bloated code when commpiling
 288 --      array (a,b) [(1,2), (2,2), (3,2), ...very long list... ]
 289 -- i.e. when there are very very long literal lists
 290 -- So I've disabled it for now. We could have special cases
 291 -- for short lists, I suppose.
 292 -- "foldr/cons" forall k z x xs. foldr k z (x:xs) = k x (foldr k z xs)
 293
 294 "foldr/single"  forall k z x. foldr k z [x] = k x z
 295 "foldr/nil"     forall k z.   foldr k z []  = z
 296
 297 "augment/build" forall (g::forall b. (a->b->b) -> b -> b)
 298                        (h::forall b. (a->b->b) -> b -> b) .
 299                        augment g (build h) = build (\c n -> g c (h c n))
 300 "augment/nil"   forall (g::forall b. (a->b->b) -> b -> b) .
 301                         augment g [] = build g
 302  #-}
 303
 304 -- This rule is true, but not (I think) useful:
 305 --      augment g (augment h t) = augment (\cn -> g c (h c n)) t
 306 \end{code}
 307
 308
 309 ----------------------------------------------
 310 --              map
 311 ----------------------------------------------
 312
 313 \begin{code}
 314 map :: (a -> b) -> [a] -> [b]
 315 map _ []     = []
 316 map f (x:xs) = f x : map f xs
 317
 318 -- Note eta expanded
 319 mapFB ::  (elt -> lst -> lst) -> (a -> elt) -> a -> lst -> lst
 320 {-# INLINE [0] mapFB #-}
 321 mapFB c f x ys = c (f x) ys
 322
 323 -- The rules for map work like this.
 324 --
 325 -- Up to (but not including) phase 1, we use the "map" rule to
 326 -- rewrite all saturated applications of map with its build/fold
 327 -- form, hoping for fusion to happen.
 328 -- In phase 1 and 0, we switch off that rule, inline build, and
 329 -- switch on the "mapList" rule, which rewrites the foldr/mapFB
 330 -- thing back into plain map.
 331 --
 332 -- It's important that these two rules aren't both active at once
 333 -- (along with build's unfolding) else we'd get an infinite loop
 334 -- in the rules.  Hence the activation control below.
 335 --
 336 -- The "mapFB" rule optimises compositions of map.
 337 --
 338 -- This same pattern is followed by many other functions:
 339 -- e.g. append, filter, iterate, repeat, etc.
 340
 341 {-# RULES
 342 "map"       [~1] forall f xs.   map f xs                = build (\c n -> foldr (mapFB c f) n xs)
 343 "mapList"   [1]  forall f.      foldr (mapFB (:) f) []  = map f
 344 "mapFB"     forall c f g.       mapFB (mapFB c f) g     = mapFB c (f.g)
 345   #-}
 346 \end{code}
 347
 348
 349 ----------------------------------------------
 350 --              append
 351 ----------------------------------------------
 352 \begin{code}
 353 (++) :: [a] -> [a] -> [a]
 354 (++) []     ys = ys
 355 (++) (x:xs) ys = x : xs ++ ys
 356
 357 {-# RULES
 358 "++"    [~1] forall xs ys. xs ++ ys = augment (\c n -> foldr c n xs) ys
 359   #-}
 360
 361 \end{code}
 362
 363
 364 %*********************************************************
 365 %*                                                      *
 366 \subsection{Type @Bool@}
 367 %*                                                      *
 368 %*********************************************************
 369
 370 \begin{code}
 371 data  Bool  =  False | True  deriving (Eq, Ord)
 372         -- Read in GHC.Read, Show in GHC.Show
 373
 374 -- Boolean functions
 375
 376 (&&), (||)              :: Bool -> Bool -> Bool
 377 True  && x              =  x
 378 False && _              =  False
 379 True  || _              =  True
 380 False || x              =  x
 381
 382 not                     :: Bool -> Bool
 383 not True                =  False
 384 not False               =  True
 385
 386 otherwise               :: Bool
 387 otherwise               =  True
 388 \end{code}
 389
 390
 391 %*********************************************************
 392 %*                                                      *
 393 \subsection{The @()@ type}
 394 %*                                                      *
 395 %*********************************************************
 396
 397 The Unit type is here because virtually any program needs it (whereas
 398 some programs may get away without consulting GHC.Tup).  Furthermore,
 399 the renamer currently *always* asks for () to be in scope, so that
 400 ccalls can use () as their default type; so when compiling GHC.Base we
 401 need ().  (We could arrange suck in () only if -fglasgow-exts, but putting
 402 it here seems more direct.)
 403
 404 \begin{code}
 405 data () = ()
 406
 407 instance Eq () where
 408     () == () = True
 409     () /= () = False
 410
 411 instance Ord () where
 412     () <= () = True
 413     () <  () = False
 414     () >= () = True
 415     () >  () = False
 416     max () () = ()
 417     min () () = ()
 418     compare () () = EQ
 419 \end{code}
 420
 421
 422 %*********************************************************
 423 %*                                                      *
 424 \subsection{Type @Ordering@}
 425 %*                                                      *
 426 %*********************************************************
 427
 428 \begin{code}
 429 data Ordering = LT | EQ | GT deriving (Eq, Ord)
 430         -- Read in GHC.Read, Show in GHC.Show
 431 \end{code}
 432
 433
 434 %*********************************************************
 435 %*                                                      *
 436 \subsection{Type @Char@ and @String@}
 437 %*                                                      *
 438 %*********************************************************
 439
 440 \begin{code}
 441 type String = [Char]
 442
 443 data Char = C# Char#
 444
 445 -- We don't use deriving for Eq and Ord, because for Ord the derived
 446 -- instance defines only compare, which takes two primops.  Then
 447 -- '>' uses compare, and therefore takes two primops instead of one.
 448
 449 instance Eq Char where
 450     (C# c1) == (C# c2) = c1 `eqChar#` c2
 451     (C# c1) /= (C# c2) = c1 `neChar#` c2
 452
 453 instance Ord Char where
 454     (C# c1) >  (C# c2) = c1 `gtChar#` c2
 455     (C# c1) >= (C# c2) = c1 `geChar#` c2
 456     (C# c1) <= (C# c2) = c1 `leChar#` c2
 457     (C# c1) <  (C# c2) = c1 `ltChar#` c2
 458
 459 {-# RULES
 460 "x# `eqChar#` x#" forall x#. x# `eqChar#` x# = True
 461 "x# `neChar#` x#" forall x#. x# `neChar#` x# = False
 462 "x# `gtChar#` x#" forall x#. x# `gtChar#` x# = False
 463 "x# `geChar#` x#" forall x#. x# `geChar#` x# = True
 464 "x# `leChar#` x#" forall x#. x# `leChar#` x# = True
 465 "x# `ltChar#` x#" forall x#. x# `ltChar#` x# = False
 466   #-}
 467
 468 chr :: Int -> Char
 469 chr (I# i#) | int2Word# i# `leWord#` int2Word# 0x10FFFF# = C# (chr# i#)
 470             | otherwise                                  = error "Prelude.chr: bad argument"
 471
 472 unsafeChr :: Int -> Char
 473 unsafeChr (I# i#) = C# (chr# i#)
 474
 475 ord :: Char -> Int
 476 ord (C# c#) = I# (ord# c#)
 477 \end{code}
 478
 479 String equality is used when desugaring pattern-matches against strings.
 480
 481 \begin{code}
 482 eqString :: String -> String -> Bool
 483 eqString []       []       = True
 484 eqString (c1:cs1) (c2:cs2) = c1 == c2 && cs1 `eqString` cs2
 485 eqString cs1      cs2      = False
 486
 487 {-# RULES "eqString" (==) = eqString #-}
 488 \end{code}
 489
 490
 491 %*********************************************************
 492 %*                                                      *
 493 \subsection{Type @Int@}
 494 %*                                                      *
 495 %*********************************************************
 496
 497 \begin{code}
 498 data Int = I# Int#
 499
 500 zeroInt, oneInt, twoInt, maxInt, minInt :: Int
 501 zeroInt = I# 0#
 502 oneInt  = I# 1#
 503 twoInt  = I# 2#
 504
 505 {- Seems clumsy. Should perhaps put minInt and MaxInt directly into MachDeps.h -}
 506 #if WORD_SIZE_IN_BITS == 31
 507 minInt  = I# (-0x40000000#)
 508 maxInt  = I# 0x3FFFFFFF#
 509 #elif WORD_SIZE_IN_BITS == 32
 510 minInt  = I# (-0x80000000#)
 511 maxInt  = I# 0x7FFFFFFF#
 512 #else
 513 minInt  = I# (-0x8000000000000000#)
 514 maxInt  = I# 0x7FFFFFFFFFFFFFFF#
 515 #endif
 516
 517 instance Eq Int where
 518     (==) = eqInt
 519     (/=) = neInt
 520
 521 instance Ord Int where
 522     compare = compareInt
 523     (<)     = ltInt
 524     (<=)    = leInt
 525     (>=)    = geInt
 526     (>)     = gtInt
 527
 528 compareInt :: Int -> Int -> Ordering
 529 (I# x#) `compareInt` (I# y#) = compareInt# x# y#
 530
 531 compareInt# :: Int# -> Int# -> Ordering
 532 compareInt# x# y#
 533     | x# <#  y# = LT
 534     | x# ==# y# = EQ
 535     | otherwise = GT
 536 \end{code}
 537
 538
 539 %*********************************************************
 540 %*                                                      *
 541 \subsection{The function type}
 542 %*                                                      *
 543 %*********************************************************
 544
 545 \begin{code}
 546 -- identity function
 547 id                      :: a -> a
 548 id x                    =  x
 549
 550 -- constant function
 551 const                   :: a -> b -> a
 552 const x _               =  x
 553
 554 -- function composition
 555 {-# INLINE (.) #-}
 556 (.)       :: (b -> c) -> (a -> b) -> a -> c
 557 (.) f g x = f (g x)
 558
 559 -- flip f  takes its (first) two arguments in the reverse order of f.
 560 flip                    :: (a -> b -> c) -> b -> a -> c
 561 flip f x y              =  f y x
 562
 563 -- right-associating infix application operator (useful in continuation-
 564 -- passing style)
 565 {-# INLINE ($) #-}
 566 ($)                     :: (a -> b) -> a -> b
 567 f $ x                   =  f x
 568
 569 -- until p f  yields the result of applying f until p holds.
 570 until                   :: (a -> Bool) -> (a -> a) -> a -> a
 571 until p f x | p x       =  x
 572             | otherwise =  until p f (f x)
 573
 574 -- asTypeOf is a type-restricted version of const.  It is usually used
 575 -- as an infix operator, and its typing forces its first argument
 576 -- (which is usually overloaded) to have the same type as the second.
 577 asTypeOf                :: a -> a -> a
 578 asTypeOf                =  const
 579 \end{code}
 580
 581 %*********************************************************
 582 %*                                                      *
 583 \subsection{CCallable instances}
 584 %*                                                      *
 585 %*********************************************************
 586
 587 Defined here to avoid orphans
 588
 589 \begin{code}
 590 instance CCallable Char
 591 instance CReturnable Char
 592
 593 instance CCallable   Int
 594 instance CReturnable Int
 595
 596 instance CReturnable () -- Why, exactly?
 597 \end{code}
 598
 599
 600 %*********************************************************
 601 %*                                                      *
 602 \subsection{Generics}
 603 %*                                                      *
 604 %*********************************************************
 605
 606 \begin{code}
 607 data Unit = Unit
 608 #ifndef __HADDOCK__
 609 data (:+:) a b = Inl a | Inr b
 610 data (:*:) a b = a :*: b
 611 #endif
 612 \end{code}
 613
 614
 615 %*********************************************************
 616 %*                                                      *
 617 \subsection{Numeric primops}
 618 %*                                                      *
 619 %*********************************************************
 620
 621 \begin{code}
 622 divInt#, modInt# :: Int# -> Int# -> Int#
 623 x# `divInt#` y#
 624     | (x# ># 0#) && (y# <# 0#) = ((x# -# y#) -# 1#) `quotInt#` y#
 625     | (x# <# 0#) && (y# ># 0#) = ((x# -# y#) +# 1#) `quotInt#` y#
 626     | otherwise                = x# `quotInt#` y#
 627 x# `modInt#` y#
 628     | (x# ># 0#) && (y# <# 0#) ||
 629       (x# <# 0#) && (y# ># 0#)    = if r# /=# 0# then r# +# y# else 0#
 630     | otherwise                   = r#
 631     where
 632     r# = x# `remInt#` y#
 633 \end{code}
 634
 635 Definitions of the boxed PrimOps; these will be
 636 used in the case of partial applications, etc.
 637
 638 \begin{code}
 639 {-# INLINE eqInt #-}
 640 {-# INLINE neInt #-}
 641 {-# INLINE gtInt #-}
 642 {-# INLINE geInt #-}
 643 {-# INLINE ltInt #-}
 644 {-# INLINE leInt #-}
 645 {-# INLINE plusInt #-}
 646 {-# INLINE minusInt #-}
 647 {-# INLINE timesInt #-}
 648 {-# INLINE quotInt #-}
 649 {-# INLINE remInt #-}
 650 {-# INLINE negateInt #-}
 651
 652 plusInt, minusInt, timesInt, quotInt, remInt, divInt, modInt, gcdInt :: Int -> Int -> Int
 653 (I# x) `plusInt`  (I# y) = I# (x +# y)
 654 (I# x) `minusInt` (I# y) = I# (x -# y)
 655 (I# x) `timesInt` (I# y) = I# (x *# y)
 656 (I# x) `quotInt`  (I# y) = I# (x `quotInt#` y)
 657 (I# x) `remInt`   (I# y) = I# (x `remInt#`  y)
 658 (I# x) `divInt`   (I# y) = I# (x `divInt#`  y)
 659 (I# x) `modInt`   (I# y) = I# (x `modInt#`  y)
 660
 661 {-# RULES
 662 "x# +# 0#" forall x#. x# +# 0# = x#
 663 "0# +# x#" forall x#. 0# +# x# = x#
 664 "x# -# 0#" forall x#. x# -# 0# = x#
 665 "x# -# x#" forall x#. x# -# x# = 0#
 666 "x# *# 0#" forall x#. x# *# 0# = 0#
 667 "0# *# x#" forall x#. 0# *# x# = 0#
 668 "x# *# 1#" forall x#. x# *# 1# = x#
 669 "1# *# x#" forall x#. 1# *# x# = x#
 670   #-}
 671
 672 gcdInt (I# a) (I# b) = g a b
 673    where g 0# 0# = error "GHC.Base.gcdInt: gcd 0 0 is undefined"
 674          g 0# _  = I# absB
 675          g _  0# = I# absA
 676          g _  _  = I# (gcdInt# absA absB)
 677
 678          absInt x = if x <# 0# then negateInt# x else x
 679
 680          absA     = absInt a
 681          absB     = absInt b
 682
 683 negateInt :: Int -> Int
 684 negateInt (I# x) = I# (negateInt# x)
 685
 686 gtInt, geInt, eqInt, neInt, ltInt, leInt :: Int -> Int -> Bool
 687 (I# x) `gtInt` (I# y) = x >#  y
 688 (I# x) `geInt` (I# y) = x >=# y
 689 (I# x) `eqInt` (I# y) = x ==# y
 690 (I# x) `neInt` (I# y) = x /=# y
 691 (I# x) `ltInt` (I# y) = x <#  y
 692 (I# x) `leInt` (I# y) = x <=# y
 693
 694 {-# RULES
 695 "x# ># x#"  forall x#. x# >#  x# = False
 696 "x# >=# x#" forall x#. x# >=# x# = True
 697 "x# ==# x#" forall x#. x# ==# x# = True
 698 "x# /=# x#" forall x#. x# /=# x# = False
 699 "x# <# x#"  forall x#. x# <#  x# = False
 700 "x# <=# x#" forall x#. x# <=# x# = True
 701   #-}
 702
 703 {-# RULES
 704 "plusFloat x 0.0"   forall x#. plusFloat#  x#   0.0# = x#
 705 "plusFloat 0.0 x"   forall x#. plusFloat#  0.0# x#   = x#
 706 "minusFloat x 0.0"  forall x#. minusFloat# x#   0.0# = x#
 707 "minusFloat x x"    forall x#. minusFloat# x#   x#   = 0.0#
 708 "timesFloat x 0.0"  forall x#. timesFloat# x#   0.0# = 0.0#
 709 "timesFloat0.0 x"   forall x#. timesFloat# 0.0# x#   = 0.0#
 710 "timesFloat x 1.0"  forall x#. timesFloat# x#   1.0# = x#
 711 "timesFloat 1.0 x"  forall x#. timesFloat# 1.0# x#   = x#
 712 "divideFloat x 1.0" forall x#. divideFloat# x#  1.0# = x#
 713   #-}
 714
 715 {-# RULES
 716 "plusDouble x 0.0"   forall x#. (+##) x#    0.0## = x#
 717 "plusDouble 0.0 x"   forall x#. (+##) 0.0## x#    = x#
 718 "minusDouble x 0.0"  forall x#. (-##) x#    0.0## = x#
 719 "minusDouble x x"    forall x#. (-##) x#    x#    = 0.0##
 720 "timesDouble x 0.0"  forall x#. (*##) x#    0.0## = 0.0##
 721 "timesDouble 0.0 x"  forall x#. (*##) 0.0## x#    = 0.0##
 722 "timesDouble x 1.0"  forall x#. (*##) x#    1.0## = x#
 723 "timesDouble 1.0 x"  forall x#. (*##) 1.0## x#    = x#
 724 "divideDouble x 1.0" forall x#. (/##) x#    1.0## = x#
 725   #-}
 726
 727 -- Wrappers for the shift operations.  The uncheckedShift# family are
 728 -- undefined when the amount being shifted by is greater than the size
 729 -- in bits of Int#, so these wrappers perform a check and return
 730 -- either zero or -1 appropriately.
 731 --
 732 -- Note that these wrappers still produce undefined results when the
 733 -- second argument (the shift amount) is negative.
 734
 735 shiftL#, shiftRL# :: Word# -> Int# -> Word#
 736
 737 a `shiftL#` b   | b >=# WORD_SIZE_IN_BITS# = int2Word# 0#
 738                 | otherwise                = a `uncheckedShiftL#` b
 739
 740 a `shiftRL#` b  | b >=# WORD_SIZE_IN_BITS# = int2Word# 0#
 741                 | otherwise                = a `uncheckedShiftRL#` b
 742
 743 iShiftL#, iShiftRA#, iShiftRL# :: Int# -> Int# -> Int#
 744
 745 a `iShiftL#` b  | b >=# WORD_SIZE_IN_BITS# = 0#
 746                 | otherwise                = a `uncheckedIShiftL#` b
 747
 748 a `iShiftRA#` b | b >=# WORD_SIZE_IN_BITS# = if a <# 0# then (-1#) else 0#
 749                 | otherwise                = a `uncheckedIShiftRA#` b
 750
 751 a `iShiftRL#` b | b >=# WORD_SIZE_IN_BITS# = 0#
 752                 | otherwise                = a `uncheckedIShiftRL#` b
 753
 754 #if WORD_SIZE_IN_BITS == 32
 755 {-# RULES
 756 "narrow32Int#"  forall x#. narrow32Int#   x# = x#
 757 "narrow32Word#" forall x#. narrow32Word#   x# = x#
 758    #-}
 759 #endif
 760
 761 {-# RULES
 762 "int2Word2Int"  forall x#. int2Word# (word2Int# x#) = x#
 763 "word2Int2Word" forall x#. word2Int# (int2Word# x#) = x#
 764   #-}
 765 \end{code}
 766
 767
 768 %********************************************************
 769 %*                                                      *
 770 \subsection{Unpacking C strings}
 771 %*                                                      *
 772 %********************************************************
 773
 774 This code is needed for virtually all programs, since it's used for
 775 unpacking the strings of error messages.
 776
 777 \begin{code}
 778 unpackCString# :: Addr# -> [Char]
 779 {-# NOINLINE [1] unpackCString# #-}
 780 unpackCString# a = unpackCStringList# a
 781
 782 unpackCStringList# :: Addr# -> [Char]
 783 unpackCStringList# addr
 784   = unpack 0#
 785   where
 786     unpack nh
 787       | ch `eqChar#` '\0'# = []
 788       | otherwise          = C# ch : unpack (nh +# 1#)
 789       where
 790         ch = indexCharOffAddr# addr nh
 791
 792 unpackAppendCString# :: Addr# -> [Char] -> [Char]
 793 unpackAppendCString# addr rest
 794   = unpack 0#
 795   where
 796     unpack nh
 797       | ch `eqChar#` '\0'# = rest
 798       | otherwise          = C# ch : unpack (nh +# 1#)
 799       where
 800         ch = indexCharOffAddr# addr nh
 801
 802 unpackFoldrCString# :: Addr# -> (Char  -> a -> a) -> a -> a
 803 {-# NOINLINE [0] unpackFoldrCString# #-}
 804 -- Don't inline till right at the end;
 805 -- usually the unpack-list rule turns it into unpackCStringList
 806 unpackFoldrCString# addr f z
 807   = unpack 0#
 808   where
 809     unpack nh
 810       | ch `eqChar#` '\0'# = z
 811       | otherwise          = C# ch `f` unpack (nh +# 1#)
 812       where
 813         ch = indexCharOffAddr# addr nh
 814
 815 unpackCStringUtf8# :: Addr# -> [Char]
 816 unpackCStringUtf8# addr
 817   = unpack 0#
 818   where
 819     unpack nh
 820       | ch `eqChar#` '\0'#   = []
 821       | ch `leChar#` '\x7F'# = C# ch : unpack (nh +# 1#)
 822       | ch `leChar#` '\xDF'# =
 823           C# (chr# ((ord# ch                                  -# 0xC0#) `uncheckedIShiftL#`  6# +#
 824                     (ord# (indexCharOffAddr# addr (nh +# 1#)) -# 0x80#))) :
 825           unpack (nh +# 2#)
 826       | ch `leChar#` '\xEF'# =
 827           C# (chr# ((ord# ch                                  -# 0xE0#) `uncheckedIShiftL#` 12# +#
 828                     (ord# (indexCharOffAddr# addr (nh +# 1#)) -# 0x80#) `uncheckedIShiftL#`  6# +#
 829                     (ord# (indexCharOffAddr# addr (nh +# 2#)) -# 0x80#))) :
 830           unpack (nh +# 3#)
 831       | otherwise            =
 832           C# (chr# ((ord# ch                                  -# 0xF0#) `uncheckedIShiftL#` 18# +#
 833                     (ord# (indexCharOffAddr# addr (nh +# 1#)) -# 0x80#) `uncheckedIShiftL#` 12# +#
 834                     (ord# (indexCharOffAddr# addr (nh +# 2#)) -# 0x80#) `uncheckedIShiftL#`  6# +#
 835                     (ord# (indexCharOffAddr# addr (nh +# 3#)) -# 0x80#))) :
 836           unpack (nh +# 4#)
 837       where
 838         ch = indexCharOffAddr# addr nh
 839
 840 unpackNBytes# :: Addr# -> Int# -> [Char]
 841 unpackNBytes# _addr 0#   = []
 842 unpackNBytes#  addr len# = unpack [] (len# -# 1#)
 843     where
 844      unpack acc i#
 845       | i# <# 0#  = acc
 846       | otherwise =
 847          case indexCharOffAddr# addr i# of
 848             ch -> unpack (C# ch : acc) (i# -# 1#)
 849
 850 {-# RULES
 851 "unpack"       [~1] forall a   . unpackCString# a                  = build (unpackFoldrCString# a)
 852 "unpack-list"  [1]  forall a   . unpackFoldrCString# a (:) [] = unpackCStringList# a
 853 "unpack-append"     forall a n . unpackFoldrCString# a (:) n  = unpackAppendCString# a n
 854
 855 -- There's a built-in rule (in GHC.Rules.lhs) for
 856 --      unpackFoldr "foo" c (unpackFoldr "baz" c n)  =  unpackFoldr "foobaz" c n
 857
 858   #-}
 859 \end{code}