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
 153 -- | The 'Eq' class defines equality ('==') and inequality ('/=').
 154 -- All the basic datatypes exported by the "Prelude" are instances of 'Eq',
 155 -- and 'Eq' may be derived for any datatype whose constituents are also
 156 -- instances of 'Eq'.
 157 --
 158 -- Minimal complete definition: either '==' or '/='.
 159 --
 160 class  Eq a  where
 161     (==), (/=)           :: a -> a -> Bool
 162
 163     x /= y               = not (x == y)
 164     x == y               = not (x /= y)
 165
 166 class  (Eq a) => Ord a  where
 167     compare              :: a -> a -> Ordering
 168     (<), (<=), (>), (>=) :: a -> a -> Bool
 169     max, min             :: a -> a -> a
 170
 171     -- An instance of Ord should define either 'compare' or '<='.
 172     -- Using 'compare' can be more efficient for complex types.
 173
 174     compare x y
 175         | x == y    = EQ
 176         | x <= y    = LT        -- NB: must be '<=' not '<' to validate the
 177                                 -- above claim about the minimal things that
 178                                 -- can be defined for an instance of Ord
 179         | otherwise = GT
 180
 181     x <  y = case compare x y of { LT -> True;  _other -> False }
 182     x <= y = case compare x y of { GT -> False; _other -> True }
 183     x >  y = case compare x y of { GT -> True;  _other -> False }
 184     x >= y = case compare x y of { LT -> False; _other -> True }
 185
 186         -- These two default methods use '<=' rather than 'compare'
 187         -- because the latter is often more expensive
 188     max x y = if x <= y then y else x
 189     min x y = if x <= y then x else y
 190 \end{code}
 191
 192 %*********************************************************
 193 %*                                                      *
 194 \subsection{Monadic classes @Functor@, @Monad@ }
 195 %*                                                      *
 196 %*********************************************************
 197
 198 \begin{code}
 199 {- | The 'Functor' class is used for types that can be mapped over.
 200 Instances of 'Functor' should satisfy the following laws:
 201
 202 > fmap id  ==  id
 203 > fmap (f . g)  ==  fmap f . fmap g
 204
 205 The instances of 'Functor' for lists, 'Maybe' and 'IO' defined in the "Prelude"
 206 satisfy these laws.
 207 -}
 208
 209 class  Functor f  where
 210     fmap        :: (a -> b) -> f a -> f b
 211
 212 {- | The 'Monad' class defines the basic operations over a /monad/.
 213 Instances of 'Monad' should satisfy the following laws:
 214
 215 > return a >>= k  ==  k a
 216 > m >>= return  ==  m
 217 > m >>= (\x -> k x >>= h)  ==  (m >>= k) >>= h
 218
 219 Instances of both 'Monad' and 'Functor' should additionally satisfy the law:
 220
 221 > fmap f xs  ==  xs >>= return . f
 222
 223 The instances of 'Monad' for lists, 'Maybe' and 'IO' defined in the "Prelude"
 224 satisfy these laws.
 225 -}
 226
 227 class  Monad m  where
 228     (>>=)       :: m a -> (a -> m b) -> m b
 229     (>>)        :: m a -> m b -> m b
 230     return      :: a -> m a
 231     fail        :: String -> m a
 232
 233     m >> k      = m >>= \_ -> k
 234     fail s      = error s
 235 \end{code}
 236
 237
 238 %*********************************************************
 239 %*                                                      *
 240 \subsection{The list type}
 241 %*                                                      *
 242 %*********************************************************
 243
 244 \begin{code}
 245 data [] a = [] | a : [a]  -- do explicitly: deriving (Eq, Ord)
 246                           -- to avoid weird names like con2tag_[]#
 247
 248
 249 instance (Eq a) => Eq [a] where
 250     {-# SPECIALISE instance Eq [Char] #-}
 251     []     == []     = True
 252     (x:xs) == (y:ys) = x == y && xs == ys
 253     _xs    == _ys    = False
 254
 255 instance (Ord a) => Ord [a] where
 256     {-# SPECIALISE instance Ord [Char] #-}
 257     compare []     []     = EQ
 258     compare []     (_:_)  = LT
 259     compare (_:_)  []     = GT
 260     compare (x:xs) (y:ys) = case compare x y of
 261                                 EQ    -> compare xs ys
 262                                 other -> other
 263
 264 instance Functor [] where
 265     fmap = map
 266
 267 instance  Monad []  where
 268     m >>= k             = foldr ((++) . k) [] m
 269     m >> k              = foldr ((++) . (\ _ -> k)) [] m
 270     return x            = [x]
 271     fail _              = []
 272 \end{code}
 273
 274 A few list functions that appear here because they are used here.
 275 The rest of the prelude list functions are in GHC.List.
 276
 277 ----------------------------------------------
 278 --      foldr/build/augment
 279 ----------------------------------------------
 280
 281 \begin{code}
 282 foldr            :: (a -> b -> b) -> b -> [a] -> b
 283 -- foldr _ z []     =  z
 284 -- foldr f z (x:xs) =  f x (foldr f z xs)
 285 {-# INLINE [0] foldr #-}
 286 -- Inline only in the final stage, after the foldr/cons rule has had a chance
 287 foldr k z xs = go xs
 288              where
 289                go []     = z
 290                go (y:ys) = y `k` go ys
 291
 292 build   :: forall a. (forall b. (a -> b -> b) -> b -> b) -> [a]
 293 {-# INLINE [1] build #-}
 294         -- The INLINE is important, even though build is tiny,
 295         -- because it prevents [] getting inlined in the version that
 296         -- appears in the interface file.  If [] *is* inlined, it
 297         -- won't match with [] appearing in rules in an importing module.
 298         --
 299         -- The "1" says to inline in phase 1
 300
 301 build g = g (:) []
 302
 303 augment :: forall a. (forall b. (a->b->b) -> b -> b) -> [a] -> [a]
 304 {-# INLINE [1] augment #-}
 305 augment g xs = g (:) xs
 306
 307 {-# RULES
 308 "fold/build"    forall k z (g::forall b. (a->b->b) -> b -> b) .
 309                 foldr k z (build g) = g k z
 310
 311 "foldr/augment" forall k z xs (g::forall b. (a->b->b) -> b -> b) .
 312                 foldr k z (augment g xs) = g k (foldr k z xs)
 313
 314 "foldr/id"                        foldr (:) [] = \x->x
 315 "foldr/app"     [1] forall xs ys. foldr (:) ys xs = xs ++ ys
 316         -- Only activate this from phase 1, because that's
 317         -- when we disable the rule that expands (++) into foldr
 318
 319 -- The foldr/cons rule looks nice, but it can give disastrously
 320 -- bloated code when commpiling
 321 --      array (a,b) [(1,2), (2,2), (3,2), ...very long list... ]
 322 -- i.e. when there are very very long literal lists
 323 -- So I've disabled it for now. We could have special cases
 324 -- for short lists, I suppose.
 325 -- "foldr/cons" forall k z x xs. foldr k z (x:xs) = k x (foldr k z xs)
 326
 327 "foldr/single"  forall k z x. foldr k z [x] = k x z
 328 "foldr/nil"     forall k z.   foldr k z []  = z
 329
 330 "augment/build" forall (g::forall b. (a->b->b) -> b -> b)
 331                        (h::forall b. (a->b->b) -> b -> b) .
 332                        augment g (build h) = build (\c n -> g c (h c n))
 333 "augment/nil"   forall (g::forall b. (a->b->b) -> b -> b) .
 334                         augment g [] = build g
 335  #-}
 336
 337 -- This rule is true, but not (I think) useful:
 338 --      augment g (augment h t) = augment (\cn -> g c (h c n)) t
 339 \end{code}
 340
 341
 342 ----------------------------------------------
 343 --              map
 344 ----------------------------------------------
 345
 346 \begin{code}
 347 map :: (a -> b) -> [a] -> [b]
 348 map _ []     = []
 349 map f (x:xs) = f x : map f xs
 350
 351 -- Note eta expanded
 352 mapFB ::  (elt -> lst -> lst) -> (a -> elt) -> a -> lst -> lst
 353 {-# INLINE [0] mapFB #-}
 354 mapFB c f x ys = c (f x) ys
 355
 356 -- The rules for map work like this.
 357 --
 358 -- Up to (but not including) phase 1, we use the "map" rule to
 359 -- rewrite all saturated applications of map with its build/fold
 360 -- form, hoping for fusion to happen.
 361 -- In phase 1 and 0, we switch off that rule, inline build, and
 362 -- switch on the "mapList" rule, which rewrites the foldr/mapFB
 363 -- thing back into plain map.
 364 --
 365 -- It's important that these two rules aren't both active at once
 366 -- (along with build's unfolding) else we'd get an infinite loop
 367 -- in the rules.  Hence the activation control below.
 368 --
 369 -- The "mapFB" rule optimises compositions of map.
 370 --
 371 -- This same pattern is followed by many other functions:
 372 -- e.g. append, filter, iterate, repeat, etc.
 373
 374 {-# RULES
 375 "map"       [~1] forall f xs.   map f xs                = build (\c n -> foldr (mapFB c f) n xs)
 376 "mapList"   [1]  forall f.      foldr (mapFB (:) f) []  = map f
 377 "mapFB"     forall c f g.       mapFB (mapFB c f) g     = mapFB c (f.g)
 378   #-}
 379 \end{code}
 380
 381
 382 ----------------------------------------------
 383 --              append
 384 ----------------------------------------------
 385 \begin{code}
 386 (++) :: [a] -> [a] -> [a]
 387 (++) []     ys = ys
 388 (++) (x:xs) ys = x : xs ++ ys
 389
 390 {-# RULES
 391 "++"    [~1] forall xs ys. xs ++ ys = augment (\c n -> foldr c n xs) ys
 392   #-}
 393
 394 \end{code}
 395
 396
 397 %*********************************************************
 398 %*                                                      *
 399 \subsection{Type @Bool@}
 400 %*                                                      *
 401 %*********************************************************
 402
 403 \begin{code}
 404 -- |The 'Bool' type is an enumeration.  It is defined with 'False'
 405 -- first so that the corresponding 'Enum' instance will give @'fromEnum'
 406 -- False@ the value zero, and @'fromEnum' True@ the value 1.
 407 data  Bool  =  False | True  deriving (Eq, Ord)
 408         -- Read in GHC.Read, Show in GHC.Show
 409
 410 -- Boolean functions
 411
 412 -- | Boolean \"and\"
 413 (&&)                    :: Bool -> Bool -> Bool
 414 True  && x              =  x
 415 False && _              =  False
 416
 417 -- | Boolean \"or\"
 418 (||)                    :: Bool -> Bool -> Bool
 419 True  || _              =  True
 420 False || x              =  x
 421
 422 -- | Boolean \"not\"
 423 not                     :: Bool -> Bool
 424 not True                =  False
 425 not False               =  True
 426
 427 -- |'otherwise' is defined as the value 'True'.  It helps to make
 428 -- guards more readable.  eg.
 429 --
 430 -- >  f x | x < 0     = ...
 431 -- >      | otherwise = ...
 432 otherwise               :: Bool
 433 otherwise               =  True
 434 \end{code}
 435
 436
 437 %*********************************************************
 438 %*                                                      *
 439 \subsection{The @()@ type}
 440 %*                                                      *
 441 %*********************************************************
 442
 443 The Unit type is here because virtually any program needs it (whereas
 444 some programs may get away without consulting GHC.Tup).  Furthermore,
 445 the renamer currently *always* asks for () to be in scope, so that
 446 ccalls can use () as their default type; so when compiling GHC.Base we
 447 need ().  (We could arrange suck in () only if -fglasgow-exts, but putting
 448 it here seems more direct.)
 449
 450 \begin{code}
 451 -- | The unit datatype @()@ has one non-undefined member, the nullary
 452 -- constructor @()@.
 453 data () = ()
 454
 455 instance Eq () where
 456     () == () = True
 457     () /= () = False
 458
 459 instance Ord () where
 460     () <= () = True
 461     () <  () = False
 462     () >= () = True
 463     () >  () = False
 464     max () () = ()
 465     min () () = ()
 466     compare () () = EQ
 467 \end{code}
 468
 469
 470 %*********************************************************
 471 %*                                                      *
 472 \subsection{Type @Ordering@}
 473 %*                                                      *
 474 %*********************************************************
 475
 476 \begin{code}
 477 -- | Represents an ordering relationship between two values: less
 478 -- than, equal to, or greater than.  An 'Ordering' is returned by
 479 -- 'compare'.
 480 data Ordering = LT | EQ | GT deriving (Eq, Ord)
 481         -- Read in GHC.Read, Show in GHC.Show
 482 \end{code}
 483
 484
 485 %*********************************************************
 486 %*                                                      *
 487 \subsection{Type @Char@ and @String@}
 488 %*                                                      *
 489 %*********************************************************
 490
 491 \begin{code}
 492 -- | A 'String' is a list of characters.  String constants in Haskell are values
 493 -- of type 'String'.
 494 --
 495 type String = [Char]
 496
 497 {-| The character type 'Char' is an enumeration whose values represent
 498 Unicode characters.  A character literal in Haskell has type 'Char'.
 499
 500 To convert a 'Char' to or from an 'Int', use 'Prelude.toEnum' and
 501 'Prelude.fromEnum' from the 'Enum' class respectively (equivalently
 502 'ord' and 'chr' also do the trick).
 503 -}
 504 data Char = C# Char#
 505
 506 -- We don't use deriving for Eq and Ord, because for Ord the derived
 507 -- instance defines only compare, which takes two primops.  Then
 508 -- '>' uses compare, and therefore takes two primops instead of one.
 509
 510 instance Eq Char where
 511     (C# c1) == (C# c2) = c1 `eqChar#` c2
 512     (C# c1) /= (C# c2) = c1 `neChar#` c2
 513
 514 instance Ord Char where
 515     (C# c1) >  (C# c2) = c1 `gtChar#` c2
 516     (C# c1) >= (C# c2) = c1 `geChar#` c2
 517     (C# c1) <= (C# c2) = c1 `leChar#` c2
 518     (C# c1) <  (C# c2) = c1 `ltChar#` c2
 519
 520 {-# RULES
 521 "x# `eqChar#` x#" forall x#. x# `eqChar#` x# = True
 522 "x# `neChar#` x#" forall x#. x# `neChar#` x# = False
 523 "x# `gtChar#` x#" forall x#. x# `gtChar#` x# = False
 524 "x# `geChar#` x#" forall x#. x# `geChar#` x# = True
 525 "x# `leChar#` x#" forall x#. x# `leChar#` x# = True
 526 "x# `ltChar#` x#" forall x#. x# `ltChar#` x# = False
 527   #-}
 528
 529 chr :: Int -> Char
 530 chr (I# i#) | int2Word# i# `leWord#` int2Word# 0x10FFFF# = C# (chr# i#)
 531             | otherwise                                  = error "Prelude.chr: bad argument"
 532
 533 unsafeChr :: Int -> Char
 534 unsafeChr (I# i#) = C# (chr# i#)
 535
 536 ord :: Char -> Int
 537 ord (C# c#) = I# (ord# c#)
 538 \end{code}
 539
 540 String equality is used when desugaring pattern-matches against strings.
 541
 542 \begin{code}
 543 eqString :: String -> String -> Bool
 544 eqString []       []       = True
 545 eqString (c1:cs1) (c2:cs2) = c1 == c2 && cs1 `eqString` cs2
 546 eqString cs1      cs2      = False
 547
 548 {-# RULES "eqString" (==) = eqString #-}
 549 \end{code}
 550
 551
 552 %*********************************************************
 553 %*                                                      *
 554 \subsection{Type @Int@}
 555 %*                                                      *
 556 %*********************************************************
 557
 558 \begin{code}
 559 data Int = I# Int#
 560 -- ^A fixed-precision integer type with at least the range @[-2^29
 561 -- .. 2^29-1]@.  The exact range for a given implementation can be
 562 -- determined by using 'minBound' and 'maxBound' from the 'Bounded'
 563 -- class.
 564
 565 zeroInt, oneInt, twoInt, maxInt, minInt :: Int
 566 zeroInt = I# 0#
 567 oneInt  = I# 1#
 568 twoInt  = I# 2#
 569
 570 {- Seems clumsy. Should perhaps put minInt and MaxInt directly into MachDeps.h -}
 571 #if WORD_SIZE_IN_BITS == 31
 572 minInt  = I# (-0x40000000#)
 573 maxInt  = I# 0x3FFFFFFF#
 574 #elif WORD_SIZE_IN_BITS == 32
 575 minInt  = I# (-0x80000000#)
 576 maxInt  = I# 0x7FFFFFFF#
 577 #else
 578 minInt  = I# (-0x8000000000000000#)
 579 maxInt  = I# 0x7FFFFFFFFFFFFFFF#
 580 #endif
 581
 582 instance Eq Int where
 583     (==) = eqInt
 584     (/=) = neInt
 585
 586 instance Ord Int where
 587     compare = compareInt
 588     (<)     = ltInt
 589     (<=)    = leInt
 590     (>=)    = geInt
 591     (>)     = gtInt
 592
 593 compareInt :: Int -> Int -> Ordering
 594 (I# x#) `compareInt` (I# y#) = compareInt# x# y#
 595
 596 compareInt# :: Int# -> Int# -> Ordering
 597 compareInt# x# y#
 598     | x# <#  y# = LT
 599     | x# ==# y# = EQ
 600     | otherwise = GT
 601 \end{code}
 602
 603
 604 %*********************************************************
 605 %*                                                      *
 606 \subsection{The function type}
 607 %*                                                      *
 608 %*********************************************************
 609
 610 \begin{code}
 611 -- identity function
 612 id                      :: a -> a
 613 id x                    =  x
 614
 615 -- lazy function; this is just the same as id, but its unfolding
 616 -- and strictness are over-ridden by the definition in MkId.lhs
 617 -- That way, it does not get inlined, and the strictness analyser
 618 -- sees it as lazy.  Then the worker/wrapper phase inlines it.
 619 -- Result: happiness
 620 lazy :: a -> a
 621 lazy x = x
 622
 623 -- Assertion function. This simply ignores its boolean argument.
 624 -- The compiler may rewrite it to (assertError line)
 625 --      SLPJ: in 5.04 etc 'assert' is in GHC.Prim,
 626 --      but from Template Haskell onwards it's simply
 627 --      defined here in Base.lhs
 628 assert :: Bool -> a -> a
 629 assert pred r = r
 630
 631 -- constant function
 632 const                   :: a -> b -> a
 633 const x _               =  x
 634
 635 -- function composition
 636 {-# INLINE (.) #-}
 637 (.)       :: (b -> c) -> (a -> b) -> a -> c
 638 (.) f g x = f (g x)
 639
 640 -- flip f  takes its (first) two arguments in the reverse order of f.
 641 flip                    :: (a -> b -> c) -> b -> a -> c
 642 flip f x y              =  f y x
 643
 644 -- right-associating infix application operator (useful in continuation-
 645 -- passing style)
 646 {-# INLINE ($) #-}
 647 ($)                     :: (a -> b) -> a -> b
 648 f $ x                   =  f x
 649
 650 -- until p f  yields the result of applying f until p holds.
 651 until                   :: (a -> Bool) -> (a -> a) -> a -> a
 652 until p f x | p x       =  x
 653             | otherwise =  until p f (f x)
 654
 655 -- asTypeOf is a type-restricted version of const.  It is usually used
 656 -- as an infix operator, and its typing forces its first argument
 657 -- (which is usually overloaded) to have the same type as the second.
 658 asTypeOf                :: a -> a -> a
 659 asTypeOf                =  const
 660 \end{code}
 661
 662 %*********************************************************
 663 %*                                                      *
 664 \subsection{CCallable instances}
 665 %*                                                      *
 666 %*********************************************************
 667
 668 Defined here to avoid orphans
 669
 670 \begin{code}
 671 instance CCallable Char
 672 instance CReturnable Char
 673
 674 instance CCallable   Int
 675 instance CReturnable Int
 676
 677 instance CReturnable () -- Why, exactly?
 678 \end{code}
 679
 680
 681 %*********************************************************
 682 %*                                                      *
 683 \subsection{Generics}
 684 %*                                                      *
 685 %*********************************************************
 686
 687 \begin{code}
 688 data Unit = Unit
 689 #ifndef __HADDOCK__
 690 data (:+:) a b = Inl a | Inr b
 691 data (:*:) a b = a :*: b
 692 #endif
 693 \end{code}
 694
 695 %*********************************************************
 696 %*                                                      *
 697 \subsection{@getTag@}
 698 %*                                                      *
 699 %*********************************************************
 700
 701 Returns the 'tag' of a constructor application; this function is used
 702 by the deriving code for Eq, Ord and Enum.
 703
 704 The primitive dataToTag# requires an evaluated constructor application
 705 as its argument, so we provide getTag as a wrapper that performs the
 706 evaluation before calling dataToTag#.  We could have dataToTag#
 707 evaluate its argument, but we prefer to do it this way because (a)
 708 dataToTag# can be an inline primop if it doesn't need to do any
 709 evaluation, and (b) we want to expose the evaluation to the
 710 simplifier, because it might be possible to eliminate the evaluation
 711 in the case when the argument is already known to be evaluated.
 712
 713 \begin{code}
 714 {-# INLINE getTag #-}
 715 getTag :: a -> Int#
 716 getTag x = x `seq` dataToTag# x
 717 \end{code}
 718
 719 %*********************************************************
 720 %*                                                      *
 721 \subsection{Numeric primops}
 722 %*                                                      *
 723 %*********************************************************
 724
 725 \begin{code}
 726 divInt# :: Int# -> Int# -> Int#
 727 x# `divInt#` y#
 728         -- Be careful NOT to overflow if we do any additional arithmetic
 729         -- on the arguments...  the following  previous version of this
 730         -- code has problems with overflow:
 731 --    | (x# ># 0#) && (y# <# 0#) = ((x# -# y#) -# 1#) `quotInt#` y#
 732 --    | (x# <# 0#) && (y# ># 0#) = ((x# -# y#) +# 1#) `quotInt#` y#
 733     | (x# ># 0#) && (y# <# 0#) = ((x# -# 1#) `quotInt#` y#) -# 1#
 734     | (x# <# 0#) && (y# ># 0#) = ((x# +# 1#) `quotInt#` y#) -# 1#
 735     | otherwise                = x# `quotInt#` y#
 736
 737 modInt# :: Int# -> Int# -> Int#
 738 x# `modInt#` y#
 739     | (x# ># 0#) && (y# <# 0#) ||
 740       (x# <# 0#) && (y# ># 0#)    = if r# /=# 0# then r# +# y# else 0#
 741     | otherwise                   = r#
 742     where
 743     r# = x# `remInt#` y#
 744 \end{code}
 745
 746 Definitions of the boxed PrimOps; these will be
 747 used in the case of partial applications, etc.
 748
 749 \begin{code}
 750 {-# INLINE eqInt #-}
 751 {-# INLINE neInt #-}
 752 {-# INLINE gtInt #-}
 753 {-# INLINE geInt #-}
 754 {-# INLINE ltInt #-}
 755 {-# INLINE leInt #-}
 756 {-# INLINE plusInt #-}
 757 {-# INLINE minusInt #-}
 758 {-# INLINE timesInt #-}
 759 {-# INLINE quotInt #-}
 760 {-# INLINE remInt #-}
 761 {-# INLINE negateInt #-}
 762
 763 plusInt, minusInt, timesInt, quotInt, remInt, divInt, modInt, gcdInt :: Int -> Int -> Int
 764 (I# x) `plusInt`  (I# y) = I# (x +# y)
 765 (I# x) `minusInt` (I# y) = I# (x -# y)
 766 (I# x) `timesInt` (I# y) = I# (x *# y)
 767 (I# x) `quotInt`  (I# y) = I# (x `quotInt#` y)
 768 (I# x) `remInt`   (I# y) = I# (x `remInt#`  y)
 769 (I# x) `divInt`   (I# y) = I# (x `divInt#`  y)
 770 (I# x) `modInt`   (I# y) = I# (x `modInt#`  y)
 771
 772 {-# RULES
 773 "x# +# 0#" forall x#. x# +# 0# = x#
 774 "0# +# x#" forall x#. 0# +# x# = x#
 775 "x# -# 0#" forall x#. x# -# 0# = x#
 776 "x# -# x#" forall x#. x# -# x# = 0#
 777 "x# *# 0#" forall x#. x# *# 0# = 0#
 778 "0# *# x#" forall x#. 0# *# x# = 0#
 779 "x# *# 1#" forall x#. x# *# 1# = x#
 780 "1# *# x#" forall x#. 1# *# x# = x#
 781   #-}
 782
 783 gcdInt (I# a) (I# b) = g a b
 784    where g 0# 0# = error "GHC.Base.gcdInt: gcd 0 0 is undefined"
 785          g 0# _  = I# absB
 786          g _  0# = I# absA
 787          g _  _  = I# (gcdInt# absA absB)
 788
 789          absInt x = if x <# 0# then negateInt# x else x
 790
 791          absA     = absInt a
 792          absB     = absInt b
 793
 794 negateInt :: Int -> Int
 795 negateInt (I# x) = I# (negateInt# x)
 796
 797 gtInt, geInt, eqInt, neInt, ltInt, leInt :: Int -> Int -> Bool
 798 (I# x) `gtInt` (I# y) = x >#  y
 799 (I# x) `geInt` (I# y) = x >=# y
 800 (I# x) `eqInt` (I# y) = x ==# y
 801 (I# x) `neInt` (I# y) = x /=# y
 802 (I# x) `ltInt` (I# y) = x <#  y
 803 (I# x) `leInt` (I# y) = x <=# y
 804
 805 {-# RULES
 806 "x# ># x#"  forall x#. x# >#  x# = False
 807 "x# >=# x#" forall x#. x# >=# x# = True
 808 "x# ==# x#" forall x#. x# ==# x# = True
 809 "x# /=# x#" forall x#. x# /=# x# = False
 810 "x# <# x#"  forall x#. x# <#  x# = False
 811 "x# <=# x#" forall x#. x# <=# x# = True
 812   #-}
 813
 814 {-# RULES
 815 "plusFloat x 0.0"   forall x#. plusFloat#  x#   0.0# = x#
 816 "plusFloat 0.0 x"   forall x#. plusFloat#  0.0# x#   = x#
 817 "minusFloat x 0.0"  forall x#. minusFloat# x#   0.0# = x#
 818 "minusFloat x x"    forall x#. minusFloat# x#   x#   = 0.0#
 819 "timesFloat x 0.0"  forall x#. timesFloat# x#   0.0# = 0.0#
 820 "timesFloat0.0 x"   forall x#. timesFloat# 0.0# x#   = 0.0#
 821 "timesFloat x 1.0"  forall x#. timesFloat# x#   1.0# = x#
 822 "timesFloat 1.0 x"  forall x#. timesFloat# 1.0# x#   = x#
 823 "divideFloat x 1.0" forall x#. divideFloat# x#  1.0# = x#
 824   #-}
 825
 826 {-# RULES
 827 "plusDouble x 0.0"   forall x#. (+##) x#    0.0## = x#
 828 "plusDouble 0.0 x"   forall x#. (+##) 0.0## x#    = x#
 829 "minusDouble x 0.0"  forall x#. (-##) x#    0.0## = x#
 830 "minusDouble x x"    forall x#. (-##) x#    x#    = 0.0##
 831 "timesDouble x 0.0"  forall x#. (*##) x#    0.0## = 0.0##
 832 "timesDouble 0.0 x"  forall x#. (*##) 0.0## x#    = 0.0##
 833 "timesDouble x 1.0"  forall x#. (*##) x#    1.0## = x#
 834 "timesDouble 1.0 x"  forall x#. (*##) 1.0## x#    = x#
 835 "divideDouble x 1.0" forall x#. (/##) x#    1.0## = x#
 836   #-}
 837
 838 -- Wrappers for the shift operations.  The uncheckedShift# family are
 839 -- undefined when the amount being shifted by is greater than the size
 840 -- in bits of Int#, so these wrappers perform a check and return
 841 -- either zero or -1 appropriately.
 842 --
 843 -- Note that these wrappers still produce undefined results when the
 844 -- second argument (the shift amount) is negative.
 845
 846 shiftL#, shiftRL# :: Word# -> Int# -> Word#
 847
 848 a `shiftL#` b   | b >=# WORD_SIZE_IN_BITS# = int2Word# 0#
 849                 | otherwise                = a `uncheckedShiftL#` b
 850
 851 a `shiftRL#` b  | b >=# WORD_SIZE_IN_BITS# = int2Word# 0#
 852                 | otherwise                = a `uncheckedShiftRL#` b
 853
 854 iShiftL#, iShiftRA#, iShiftRL# :: Int# -> Int# -> Int#
 855
 856 a `iShiftL#` b  | b >=# WORD_SIZE_IN_BITS# = 0#
 857                 | otherwise                = a `uncheckedIShiftL#` b
 858
 859 a `iShiftRA#` b | b >=# WORD_SIZE_IN_BITS# = if a <# 0# then (-1#) else 0#
 860                 | otherwise                = a `uncheckedIShiftRA#` b
 861
 862 a `iShiftRL#` b | b >=# WORD_SIZE_IN_BITS# = 0#
 863                 | otherwise                = a `uncheckedIShiftRL#` b
 864
 865 #if WORD_SIZE_IN_BITS == 32
 866 {-# RULES
 867 "narrow32Int#"  forall x#. narrow32Int#   x# = x#
 868 "narrow32Word#" forall x#. narrow32Word#   x# = x#
 869    #-}
 870 #endif
 871
 872 {-# RULES
 873 "int2Word2Int"  forall x#. int2Word# (word2Int# x#) = x#
 874 "word2Int2Word" forall x#. word2Int# (int2Word# x#) = x#
 875   #-}
 876 \end{code}
 877
 878
 879 %********************************************************
 880 %*                                                      *
 881 \subsection{Unpacking C strings}
 882 %*                                                      *
 883 %********************************************************
 884
 885 This code is needed for virtually all programs, since it's used for
 886 unpacking the strings of error messages.
 887
 888 \begin{code}
 889 unpackCString# :: Addr# -> [Char]
 890 {-# NOINLINE [1] unpackCString# #-}
 891 unpackCString# addr
 892   = unpack 0#
 893   where
 894     unpack nh
 895       | ch `eqChar#` '\0'# = []
 896       | otherwise          = C# ch : unpack (nh +# 1#)
 897       where
 898         ch = indexCharOffAddr# addr nh
 899
 900 unpackAppendCString# :: Addr# -> [Char] -> [Char]
 901 unpackAppendCString# addr rest
 902   = unpack 0#
 903   where
 904     unpack nh
 905       | ch `eqChar#` '\0'# = rest
 906       | otherwise          = C# ch : unpack (nh +# 1#)
 907       where
 908         ch = indexCharOffAddr# addr nh
 909
 910 unpackFoldrCString# :: Addr# -> (Char  -> a -> a) -> a -> a
 911 {-# NOINLINE [0] unpackFoldrCString# #-}
 912 -- Don't inline till right at the end;
 913 -- usually the unpack-list rule turns it into unpackCStringList
 914 unpackFoldrCString# addr f z
 915   = unpack 0#
 916   where
 917     unpack nh
 918       | ch `eqChar#` '\0'# = z
 919       | otherwise          = C# ch `f` unpack (nh +# 1#)
 920       where
 921         ch = indexCharOffAddr# addr nh
 922
 923 unpackCStringUtf8# :: Addr# -> [Char]
 924 unpackCStringUtf8# addr
 925   = unpack 0#
 926   where
 927     unpack nh
 928       | ch `eqChar#` '\0'#   = []
 929       | ch `leChar#` '\x7F'# = C# ch : unpack (nh +# 1#)
 930       | ch `leChar#` '\xDF'# =
 931           C# (chr# (((ord# ch                                  -# 0xC0#) `uncheckedIShiftL#`  6#) +#
 932                      (ord# (indexCharOffAddr# addr (nh +# 1#)) -# 0x80#))) :
 933           unpack (nh +# 2#)
 934       | ch `leChar#` '\xEF'# =
 935           C# (chr# (((ord# ch                                  -# 0xE0#) `uncheckedIShiftL#` 12#) +#
 936                     ((ord# (indexCharOffAddr# addr (nh +# 1#)) -# 0x80#) `uncheckedIShiftL#`  6#) +#
 937                      (ord# (indexCharOffAddr# addr (nh +# 2#)) -# 0x80#))) :
 938           unpack (nh +# 3#)
 939       | otherwise            =
 940           C# (chr# (((ord# ch                                  -# 0xF0#) `uncheckedIShiftL#` 18#) +#
 941                     ((ord# (indexCharOffAddr# addr (nh +# 1#)) -# 0x80#) `uncheckedIShiftL#` 12#) +#
 942                     ((ord# (indexCharOffAddr# addr (nh +# 2#)) -# 0x80#) `uncheckedIShiftL#`  6#) +#
 943                      (ord# (indexCharOffAddr# addr (nh +# 3#)) -# 0x80#))) :
 944           unpack (nh +# 4#)
 945       where
 946         ch = indexCharOffAddr# addr nh
 947
 948 unpackNBytes# :: Addr# -> Int# -> [Char]
 949 unpackNBytes# _addr 0#   = []
 950 unpackNBytes#  addr len# = unpack [] (len# -# 1#)
 951     where
 952      unpack acc i#
 953       | i# <# 0#  = acc
 954       | otherwise =
 955          case indexCharOffAddr# addr i# of
 956             ch -> unpack (C# ch : acc) (i# -# 1#)
 957
 958 {-# RULES
 959 "unpack"       [~1] forall a   . unpackCString# a                  = build (unpackFoldrCString# a)
 960 "unpack-list"  [1]  forall a   . unpackFoldrCString# a (:) [] = unpackCString# a
 961 "unpack-append"     forall a n . unpackFoldrCString# a (:) n  = unpackAppendCString# a n
 962
 963 -- There's a built-in rule (in PrelRules.lhs) for
 964 --      unpackFoldr "foo" c (unpackFoldr "baz" c n)  =  unpackFoldr "foobaz" c n
 965
 966   #-}
 967 \end{code}