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 GHC.Base        Classes: Eq, Ord, Functor, Monad
  20                 Types:   list, (), Int, Bool, Ordering, Char, String
  21
  22 Data.Tuple      Types: tuples, plus instances for GHC.Base classes
  23
  24 GHC.Show        Class: Show, plus instances for GHC.Base/GHC.Tup types
  25
  26 GHC.Enum        Class: Enum,  plus instances for GHC.Base/GHC.Tup types
  27
  28 Data.Maybe      Type: Maybe, plus instances for GHC.Base classes
  29
  30 GHC.List        List functions
  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 GHC.ST  The ST monad, instances and a few helper functions
  47
  48 Ix              Classes: Ix, plus instances for Int, Bool, Char, Integer, Ordering, tuples
  49
  50 GHC.Arr         Types: Array, MutableArray, MutableVar
  51
  52                 Arrays are used by a function in GHC.Float
  53
  54 GHC.Float       Classes: Floating, RealFloat
  55                 Types:   Float, Double, plus instances of all classes so far
  56
  57                 This module contains everything to do with floating point.
  58                 It is a big module (900 lines)
  59                 With a bit of luck, many modules can be compiled without ever reading GHC.Float.hi
  60
  61
  62 Other Prelude modules are much easier with fewer complex dependencies.
  63
  64 \begin{code}
  65 {-# LANGUAGE BangPatterns #-}
  66 {-# OPTIONS_GHC -XNoImplicitPrelude #-}
  67 -- -fno-warn-orphans is needed for things like:
  68 -- Orphan rule: "x# -# x#" ALWAYS forall x# :: Int# -# x# x# = 0
  69 {-# OPTIONS_GHC -fno-warn-orphans #-}
  70 {-# OPTIONS_HADDOCK hide #-}
  71 -----------------------------------------------------------------------------
  72 -- |
  73 -- Module      :  GHC.Base
  74 -- Copyright   :  (c) The University of Glasgow, 1992-2002
  75 -- License     :  see libraries/base/LICENSE
  76 --
  77 -- Maintainer  :  cvs-ghc@haskell.org
  78 -- Stability   :  internal
  79 -- Portability :  non-portable (GHC extensions)
  80 --
  81 -- Basic data types and classes.
  82 --
  83 -----------------------------------------------------------------------------
  84
  85 #include "MachDeps.h"
  86
  87 -- #hide
  88 module GHC.Base
  89         (
  90         module GHC.Base,
  91         module GHC.Classes,
  92         module GHC.Generics,
  93         module GHC.Ordering,
  94         module GHC.Types,
  95         module GHC.Prim,        -- Re-export GHC.Prim and GHC.Err, to avoid lots
  96         module GHC.Err          -- of people having to import it explicitly
  97   )
  98         where
  99
 100 import GHC.Types
 101 import GHC.Classes
 102 import GHC.Generics
 103 import GHC.Ordering
 104 import GHC.Prim
 105 import {-# SOURCE #-} GHC.Show
 106 import {-# SOURCE #-} GHC.Err
 107 import {-# SOURCE #-} GHC.IO (failIO)
 108
 109 -- These two are not strictly speaking required by this module, but they are
 110 -- implicit dependencies whenever () or tuples are mentioned, so adding them
 111 -- as imports here helps to get the dependencies right in the new build system.
 112 import GHC.Tuple ()
 113 import GHC.Unit ()
 114
 115 infixr 9  .
 116 infixr 5  ++
 117 infixl 4  <$
 118 infixl 1  >>, >>=
 119 infixr 0  $
 120
 121 default ()              -- Double isn't available yet
 122 \end{code}
 123
 124
 125 %*********************************************************
 126 %*                                                      *
 127 \subsection{DEBUGGING STUFF}
 128 %*  (for use when compiling GHC.Base itself doesn't work)
 129 %*                                                      *
 130 %*********************************************************
 131
 132 \begin{code}
 133 {-
 134 data  Bool  =  False | True
 135 data Ordering = LT | EQ | GT
 136 data Char = C# Char#
 137 type  String = [Char]
 138 data Int = I# Int#
 139 data  ()  =  ()
 140 data [] a = MkNil
 141
 142 not True = False
 143 (&&) True True = True
 144 otherwise = True
 145
 146 build = error "urk"
 147 foldr = error "urk"
 148
 149 unpackCString# :: Addr# -> [Char]
 150 unpackFoldrCString# :: Addr# -> (Char  -> a -> a) -> a -> a
 151 unpackAppendCString# :: Addr# -> [Char] -> [Char]
 152 unpackCStringUtf8# :: Addr# -> [Char]
 153 unpackCString# a = error "urk"
 154 unpackFoldrCString# a = error "urk"
 155 unpackAppendCString# a = error "urk"
 156 unpackCStringUtf8# a = error "urk"
 157 -}
 158 \end{code}
 159
 160
 161 %*********************************************************
 162 %*                                                      *
 163 \subsection{Monadic classes @Functor@, @Monad@ }
 164 %*                                                      *
 165 %*********************************************************
 166
 167 \begin{code}
 168 {- | The 'Functor' class is used for types that can be mapped over.
 169 Instances of 'Functor' should satisfy the following laws:
 170
 171 > fmap id  ==  id
 172 > fmap (f . g)  ==  fmap f . fmap g
 173
 174 The instances of 'Functor' for lists, 'Data.Maybe.Maybe' and 'System.IO.IO'
 175 satisfy these laws.
 176 -}
 177
 178 class  Functor f  where
 179     fmap        :: (a -> b) -> f a -> f b
 180
 181     -- | Replace all locations in the input with the same value.
 182     -- The default definition is @'fmap' . 'const'@, but this may be
 183     -- overridden with a more efficient version.
 184     (<$)        :: a -> f b -> f a
 185     (<$)        =  fmap . const
 186
 187 {- | The 'Monad' class defines the basic operations over a /monad/,
 188 a concept from a branch of mathematics known as /category theory/.
 189 From the perspective of a Haskell programmer, however, it is best to
 190 think of a monad as an /abstract datatype/ of actions.
 191 Haskell's @do@ expressions provide a convenient syntax for writing
 192 monadic expressions.
 193
 194 Minimal complete definition: '>>=' and 'return'.
 195
 196 Instances of 'Monad' should satisfy the following laws:
 197
 198 > return a >>= k  ==  k a
 199 > m >>= return  ==  m
 200 > m >>= (\x -> k x >>= h)  ==  (m >>= k) >>= h
 201
 202 Instances of both 'Monad' and 'Functor' should additionally satisfy the law:
 203
 204 > fmap f xs  ==  xs >>= return . f
 205
 206 The instances of 'Monad' for lists, 'Data.Maybe.Maybe' and 'System.IO.IO'
 207 defined in the "Prelude" satisfy these laws.
 208 -}
 209
 210 class  Monad m  where
 211     -- | Sequentially compose two actions, passing any value produced
 212     -- by the first as an argument to the second.
 213     (>>=)       :: forall a b. m a -> (a -> m b) -> m b
 214     -- | Sequentially compose two actions, discarding any value produced
 215     -- by the first, like sequencing operators (such as the semicolon)
 216     -- in imperative languages.
 217     (>>)        :: forall a b. m a -> m b -> m b
 218         -- Explicit for-alls so that we know what order to
 219         -- give type arguments when desugaring
 220
 221     -- | Inject a value into the monadic type.
 222     return      :: a -> m a
 223     -- | Fail with a message.  This operation is not part of the
 224     -- mathematical definition of a monad, but is invoked on pattern-match
 225     -- failure in a @do@ expression.
 226     fail        :: String -> m a
 227
 228     {-# INLINE (>>) #-}
 229     m >> k      = m >>= \_ -> k
 230     fail s      = error s
 231 \end{code}
 232
 233
 234 %*********************************************************
 235 %*                                                      *
 236 \subsection{The list type}
 237 %*                                                      *
 238 %*********************************************************
 239
 240 \begin{code}
 241 instance Functor [] where
 242     fmap = map
 243
 244 instance  Monad []  where
 245     m >>= k             = foldr ((++) . k) [] m
 246     m >> k              = foldr ((++) . (\ _ -> k)) [] m
 247     return x            = [x]
 248     fail _              = []
 249 \end{code}
 250
 251 A few list functions that appear here because they are used here.
 252 The rest of the prelude list functions are in GHC.List.
 253
 254 ----------------------------------------------
 255 --      foldr/build/augment
 256 ----------------------------------------------
 257
 258 \begin{code}
 259 -- | 'foldr', applied to a binary operator, a starting value (typically
 260 -- the right-identity of the operator), and a list, reduces the list
 261 -- using the binary operator, from right to left:
 262 --
 263 -- > foldr f z [x1, x2, ..., xn] == x1 `f` (x2 `f` ... (xn `f` z)...)
 264
 265 foldr            :: (a -> b -> b) -> b -> [a] -> b
 266 -- foldr _ z []     =  z
 267 -- foldr f z (x:xs) =  f x (foldr f z xs)
 268 {-# INLINE [0] foldr #-}
 269 -- Inline only in the final stage, after the foldr/cons rule has had a chance
 270 -- Also note that we inline it when it has *two* parameters, which are the
 271 -- ones we are keen about specialising!
 272 foldr k z = go
 273           where
 274             go []     = z
 275             go (y:ys) = y `k` go ys
 276
 277 -- | A list producer that can be fused with 'foldr'.
 278 -- This function is merely
 279 --
 280 -- >    build g = g (:) []
 281 --
 282 -- but GHC's simplifier will transform an expression of the form
 283 -- @'foldr' k z ('build' g)@, which may arise after inlining, to @g k z@,
 284 -- which avoids producing an intermediate list.
 285
 286 build   :: forall a. (forall b. (a -> b -> b) -> b -> b) -> [a]
 287 {-# INLINE [1] build #-}
 288         -- The INLINE is important, even though build is tiny,
 289         -- because it prevents [] getting inlined in the version that
 290         -- appears in the interface file.  If [] *is* inlined, it
 291         -- won't match with [] appearing in rules in an importing module.
 292         --
 293         -- The "1" says to inline in phase 1
 294
 295 build g = g (:) []
 296
 297 -- | A list producer that can be fused with 'foldr'.
 298 -- This function is merely
 299 --
 300 -- >    augment g xs = g (:) xs
 301 --
 302 -- but GHC's simplifier will transform an expression of the form
 303 -- @'foldr' k z ('augment' g xs)@, which may arise after inlining, to
 304 -- @g k ('foldr' k z xs)@, which avoids producing an intermediate list.
 305
 306 augment :: forall a. (forall b. (a->b->b) -> b -> b) -> [a] -> [a]
 307 {-# INLINE [1] augment #-}
 308 augment g xs = g (:) xs
 309
 310 {-# RULES
 311 "fold/build"    forall k z (g::forall b. (a->b->b) -> b -> b) .
 312                 foldr k z (build g) = g k z
 313
 314 "foldr/augment" forall k z xs (g::forall b. (a->b->b) -> b -> b) .
 315                 foldr k z (augment g xs) = g k (foldr k z xs)
 316
 317 "foldr/id"                        foldr (:) [] = \x  -> x
 318 "foldr/app"     [1] forall ys. foldr (:) ys = \xs -> xs ++ ys
 319         -- Only activate this from phase 1, because that's
 320         -- when we disable the rule that expands (++) into foldr
 321
 322 -- The foldr/cons rule looks nice, but it can give disastrously
 323 -- bloated code when commpiling
 324 --      array (a,b) [(1,2), (2,2), (3,2), ...very long list... ]
 325 -- i.e. when there are very very long literal lists
 326 -- So I've disabled it for now. We could have special cases
 327 -- for short lists, I suppose.
 328 -- "foldr/cons" forall k z x xs. foldr k z (x:xs) = k x (foldr k z xs)
 329
 330 "foldr/single"  forall k z x. foldr k z [x] = k x z
 331 "foldr/nil"     forall k z.   foldr k z []  = z
 332
 333 "augment/build" forall (g::forall b. (a->b->b) -> b -> b)
 334                        (h::forall b. (a->b->b) -> b -> b) .
 335                        augment g (build h) = build (\c n -> g c (h c n))
 336 "augment/nil"   forall (g::forall b. (a->b->b) -> b -> b) .
 337                         augment g [] = build g
 338  #-}
 339
 340 -- This rule is true, but not (I think) useful:
 341 --      augment g (augment h t) = augment (\cn -> g c (h c n)) t
 342 \end{code}
 343
 344
 345 ----------------------------------------------
 346 --              map
 347 ----------------------------------------------
 348
 349 \begin{code}
 350 -- | 'map' @f xs@ is the list obtained by applying @f@ to each element
 351 -- of @xs@, i.e.,
 352 --
 353 -- > map f [x1, x2, ..., xn] == [f x1, f x2, ..., f xn]
 354 -- > map f [x1, x2, ...] == [f x1, f x2, ...]
 355
 356 map :: (a -> b) -> [a] -> [b]
 357 map _ []     = []
 358 map f (x:xs) = f x : map f xs
 359
 360 -- Note eta expanded
 361 mapFB ::  (elt -> lst -> lst) -> (a -> elt) -> a -> lst -> lst
 362 {-# INLINE [0] mapFB #-}
 363 mapFB c f = \x ys -> c (f x) ys
 364
 365 -- The rules for map work like this.
 366 --
 367 -- Up to (but not including) phase 1, we use the "map" rule to
 368 -- rewrite all saturated applications of map with its build/fold
 369 -- form, hoping for fusion to happen.
 370 -- In phase 1 and 0, we switch off that rule, inline build, and
 371 -- switch on the "mapList" rule, which rewrites the foldr/mapFB
 372 -- thing back into plain map.
 373 --
 374 -- It's important that these two rules aren't both active at once
 375 -- (along with build's unfolding) else we'd get an infinite loop
 376 -- in the rules.  Hence the activation control below.
 377 --
 378 -- The "mapFB" rule optimises compositions of map.
 379 --
 380 -- This same pattern is followed by many other functions:
 381 -- e.g. append, filter, iterate, repeat, etc.
 382
 383 {-# RULES
 384 "map"       [~1] forall f xs.   map f xs                = build (\c n -> foldr (mapFB c f) n xs)
 385 "mapList"   [1]  forall f.      foldr (mapFB (:) f) []  = map f
 386 "mapFB"     forall c f g.       mapFB (mapFB c f) g     = mapFB c (f.g)
 387   #-}
 388 \end{code}
 389
 390
 391 ----------------------------------------------
 392 --              append
 393 ----------------------------------------------
 394 \begin{code}
 395 -- | Append two lists, i.e.,
 396 --
 397 -- > [x1, ..., xm] ++ [y1, ..., yn] == [x1, ..., xm, y1, ..., yn]
 398 -- > [x1, ..., xm] ++ [y1, ...] == [x1, ..., xm, y1, ...]
 399 --
 400 -- If the first list is not finite, the result is the first list.
 401
 402 (++) :: [a] -> [a] -> [a]
 403 (++) []     ys = ys
 404 (++) (x:xs) ys = x : xs ++ ys
 405
 406 {-# RULES
 407 "++"    [~1] forall xs ys. xs ++ ys = augment (\c n -> foldr c n xs) ys
 408   #-}
 409
 410 \end{code}
 411
 412
 413 %*********************************************************
 414 %*                                                      *
 415 \subsection{Type @Bool@}
 416 %*                                                      *
 417 %*********************************************************
 418
 419 \begin{code}
 420 -- |'otherwise' is defined as the value 'True'.  It helps to make
 421 -- guards more readable.  eg.
 422 --
 423 -- >  f x | x < 0     = ...
 424 -- >      | otherwise = ...
 425 otherwise               :: Bool
 426 otherwise               =  True
 427 \end{code}
 428
 429 %*********************************************************
 430 %*                                                      *
 431 \subsection{Type @Char@ and @String@}
 432 %*                                                      *
 433 %*********************************************************
 434
 435 \begin{code}
 436 -- | A 'String' is a list of characters.  String constants in Haskell are values
 437 -- of type 'String'.
 438 --
 439 type String = [Char]
 440
 441 {-# RULES
 442 "x# `eqChar#` x#" forall x#. x# `eqChar#` x# = True
 443 "x# `neChar#` x#" forall x#. x# `neChar#` x# = False
 444 "x# `gtChar#` x#" forall x#. x# `gtChar#` x# = False
 445 "x# `geChar#` x#" forall x#. x# `geChar#` x# = True
 446 "x# `leChar#` x#" forall x#. x# `leChar#` x# = True
 447 "x# `ltChar#` x#" forall x#. x# `ltChar#` x# = False
 448   #-}
 449
 450 -- | The 'Prelude.toEnum' method restricted to the type 'Data.Char.Char'.
 451 chr :: Int -> Char
 452 chr i@(I# i#)
 453  | int2Word# i# `leWord#` int2Word# 0x10FFFF# = C# (chr# i#)
 454  | otherwise
 455     = error ("Prelude.chr: bad argument: " ++ showSignedInt (I# 9#) i "")
 456
 457 unsafeChr :: Int -> Char
 458 unsafeChr (I# i#) = C# (chr# i#)
 459
 460 -- | The 'Prelude.fromEnum' method restricted to the type 'Data.Char.Char'.
 461 ord :: Char -> Int
 462 ord (C# c#) = I# (ord# c#)
 463 \end{code}
 464
 465 String equality is used when desugaring pattern-matches against strings.
 466
 467 \begin{code}
 468 eqString :: String -> String -> Bool
 469 eqString []       []       = True
 470 eqString (c1:cs1) (c2:cs2) = c1 == c2 && cs1 `eqString` cs2
 471 eqString _        _        = False
 472
 473 {-# RULES "eqString" (==) = eqString #-}
 474 -- eqString also has a BuiltInRule in PrelRules.lhs:
 475 --      eqString (unpackCString# (Lit s1)) (unpackCString# (Lit s2) = s1==s2
 476 \end{code}
 477
 478
 479 %*********************************************************
 480 %*                                                      *
 481 \subsection{Type @Int@}
 482 %*                                                      *
 483 %*********************************************************
 484
 485 \begin{code}
 486 zeroInt, oneInt, twoInt, maxInt, minInt :: Int
 487 zeroInt = I# 0#
 488 oneInt  = I# 1#
 489 twoInt  = I# 2#
 490
 491 {- Seems clumsy. Should perhaps put minInt and MaxInt directly into MachDeps.h -}
 492 #if WORD_SIZE_IN_BITS == 31
 493 minInt  = I# (-0x40000000#)
 494 maxInt  = I# 0x3FFFFFFF#
 495 #elif WORD_SIZE_IN_BITS == 32
 496 minInt  = I# (-0x80000000#)
 497 maxInt  = I# 0x7FFFFFFF#
 498 #else
 499 minInt  = I# (-0x8000000000000000#)
 500 maxInt  = I# 0x7FFFFFFFFFFFFFFF#
 501 #endif
 502
 503 instance Eq Int where
 504     (==) = eqInt
 505     (/=) = neInt
 506
 507 instance Ord Int where
 508     compare = compareInt
 509     (<)     = ltInt
 510     (<=)    = leInt
 511     (>=)    = geInt
 512     (>)     = gtInt
 513
 514 compareInt :: Int -> Int -> Ordering
 515 (I# x#) `compareInt` (I# y#) = compareInt# x# y#
 516
 517 compareInt# :: Int# -> Int# -> Ordering
 518 compareInt# x# y#
 519     | x# <#  y# = LT
 520     | x# ==# y# = EQ
 521     | otherwise = GT
 522 \end{code}
 523
 524
 525 %*********************************************************
 526 %*                                                      *
 527 \subsection{The function type}
 528 %*                                                      *
 529 %*********************************************************
 530
 531 \begin{code}
 532 -- | Identity function.
 533 id                      :: a -> a
 534 id x                    =  x
 535
 536 -- | The call '(lazy e)' means the same as 'e', but 'lazy' has a
 537 -- magical strictness property: it is lazy in its first argument,
 538 -- even though its semantics is strict.
 539 lazy :: a -> a
 540 lazy x = x
 541 -- Implementation note: its strictness and unfolding are over-ridden
 542 -- by the definition in MkId.lhs; in both cases to nothing at all.
 543 -- That way, 'lazy' does not get inlined, and the strictness analyser
 544 -- sees it as lazy.  Then the worker/wrapper phase inlines it.
 545 -- Result: happiness
 546
 547 -- Assertion function.  This simply ignores its boolean argument.
 548 -- The compiler may rewrite it to @('assertError' line)@.
 549
 550 -- | If the first argument evaluates to 'True', then the result is the
 551 -- second argument.  Otherwise an 'AssertionFailed' exception is raised,
 552 -- containing a 'String' with the source file and line number of the
 553 -- call to 'assert'.
 554 --
 555 -- Assertions can normally be turned on or off with a compiler flag
 556 -- (for GHC, assertions are normally on unless optimisation is turned on
 557 -- with @-O@ or the @-fignore-asserts@
 558 -- option is given).  When assertions are turned off, the first
 559 -- argument to 'assert' is ignored, and the second argument is
 560 -- returned as the result.
 561
 562 --      SLPJ: in 5.04 etc 'assert' is in GHC.Prim,
 563 --      but from Template Haskell onwards it's simply
 564 --      defined here in Base.lhs
 565 assert :: Bool -> a -> a
 566 assert _pred r = r
 567
 568 breakpoint :: a -> a
 569 breakpoint r = r
 570
 571 breakpointCond :: Bool -> a -> a
 572 breakpointCond _ r = r
 573
 574 data Opaque = forall a. O a
 575
 576 -- | Constant function.
 577 const                   :: a -> b -> a
 578 const x _               =  x
 579
 580 -- | Function composition.
 581 {-# INLINE (.) #-}
 582 -- Make sure it has TWO args only on the left, so that it inlines
 583 -- when applied to two functions, even if there is no final argument
 584 (.)    :: (b -> c) -> (a -> b) -> a -> c
 585 (.) f g = \x -> f (g x)
 586
 587 -- | @'flip' f@ takes its (first) two arguments in the reverse order of @f@.
 588 flip                    :: (a -> b -> c) -> b -> a -> c
 589 flip f x y              =  f y x
 590
 591 -- | Application operator.  This operator is redundant, since ordinary
 592 -- application @(f x)@ means the same as @(f '$' x)@. However, '$' has
 593 -- low, right-associative binding precedence, so it sometimes allows
 594 -- parentheses to be omitted; for example:
 595 --
 596 -- >     f $ g $ h x  =  f (g (h x))
 597 --
 598 -- It is also useful in higher-order situations, such as @'map' ('$' 0) xs@,
 599 -- or @'Data.List.zipWith' ('$') fs xs@.
 600 {-# INLINE ($) #-}
 601 ($)                     :: (a -> b) -> a -> b
 602 f $ x                   =  f x
 603
 604 -- | @'until' p f@ yields the result of applying @f@ until @p@ holds.
 605 until                   :: (a -> Bool) -> (a -> a) -> a -> a
 606 until p f x | p x       =  x
 607             | otherwise =  until p f (f x)
 608
 609 -- | 'asTypeOf' is a type-restricted version of 'const'.  It is usually
 610 -- used as an infix operator, and its typing forces its first argument
 611 -- (which is usually overloaded) to have the same type as the second.
 612 asTypeOf                :: a -> a -> a
 613 asTypeOf                =  const
 614 \end{code}
 615
 616 %*********************************************************
 617 %*                                                      *
 618 \subsection{@Functor@ and @Monad@ instances for @IO@}
 619 %*                                                      *
 620 %*********************************************************
 621
 622 \begin{code}
 623 instance  Functor IO where
 624    fmap f x = x >>= (return . f)
 625
 626 instance  Monad IO  where
 627     {-# INLINE return #-}
 628     {-# INLINE (>>)   #-}
 629     {-# INLINE (>>=)  #-}
 630     m >> k    = m >>= \ _ -> k
 631     return    = returnIO
 632     (>>=)     = bindIO
 633     fail s    = GHC.IO.failIO s
 634
 635 returnIO :: a -> IO a
 636 returnIO x = IO $ \ s -> (# s, x #)
 637
 638 bindIO :: IO a -> (a -> IO b) -> IO b
 639 bindIO (IO m) k = IO $ \ s -> case m s of (# new_s, a #) -> unIO (k a) new_s
 640
 641 thenIO :: IO a -> IO b -> IO b
 642 thenIO (IO m) k = IO $ \ s -> case m s of (# new_s, _ #) -> unIO k new_s
 643
 644 unIO :: IO a -> (State# RealWorld -> (# State# RealWorld, a #))
 645 unIO (IO a) = a
 646 \end{code}
 647
 648 %*********************************************************
 649 %*                                                      *
 650 \subsection{@getTag@}
 651 %*                                                      *
 652 %*********************************************************
 653
 654 Returns the 'tag' of a constructor application; this function is used
 655 by the deriving code for Eq, Ord and Enum.
 656
 657 The primitive dataToTag# requires an evaluated constructor application
 658 as its argument, so we provide getTag as a wrapper that performs the
 659 evaluation before calling dataToTag#.  We could have dataToTag#
 660 evaluate its argument, but we prefer to do it this way because (a)
 661 dataToTag# can be an inline primop if it doesn't need to do any
 662 evaluation, and (b) we want to expose the evaluation to the
 663 simplifier, because it might be possible to eliminate the evaluation
 664 in the case when the argument is already known to be evaluated.
 665
 666 \begin{code}
 667 {-# INLINE getTag #-}
 668 getTag :: a -> Int#
 669 getTag x = x `seq` dataToTag# x
 670 \end{code}
 671
 672 %*********************************************************
 673 %*                                                      *
 674 \subsection{Numeric primops}
 675 %*                                                      *
 676 %*********************************************************
 677
 678 \begin{code}
 679 divInt# :: Int# -> Int# -> Int#
 680 x# `divInt#` y#
 681         -- Be careful NOT to overflow if we do any additional arithmetic
 682         -- on the arguments...  the following  previous version of this
 683         -- code has problems with overflow:
 684 --    | (x# ># 0#) && (y# <# 0#) = ((x# -# y#) -# 1#) `quotInt#` y#
 685 --    | (x# <# 0#) && (y# ># 0#) = ((x# -# y#) +# 1#) `quotInt#` y#
 686     | (x# ># 0#) && (y# <# 0#) = ((x# -# 1#) `quotInt#` y#) -# 1#
 687     | (x# <# 0#) && (y# ># 0#) = ((x# +# 1#) `quotInt#` y#) -# 1#
 688     | otherwise                = x# `quotInt#` y#
 689
 690 modInt# :: Int# -> Int# -> Int#
 691 x# `modInt#` y#
 692     | (x# ># 0#) && (y# <# 0#) ||
 693       (x# <# 0#) && (y# ># 0#)    = if r# /=# 0# then r# +# y# else 0#
 694     | otherwise                   = r#
 695     where
 696     !r# = x# `remInt#` y#
 697 \end{code}
 698
 699 Definitions of the boxed PrimOps; these will be
 700 used in the case of partial applications, etc.
 701
 702 \begin{code}
 703 {-# INLINE eqInt #-}
 704 {-# INLINE neInt #-}
 705 {-# INLINE gtInt #-}
 706 {-# INLINE geInt #-}
 707 {-# INLINE ltInt #-}
 708 {-# INLINE leInt #-}
 709 {-# INLINE plusInt #-}
 710 {-# INLINE minusInt #-}
 711 {-# INLINE timesInt #-}
 712 {-# INLINE quotInt #-}
 713 {-# INLINE remInt #-}
 714 {-# INLINE negateInt #-}
 715
 716 plusInt, minusInt, timesInt, quotInt, remInt, divInt, modInt :: Int -> Int -> Int
 717 (I# x) `plusInt`  (I# y) = I# (x +# y)
 718 (I# x) `minusInt` (I# y) = I# (x -# y)
 719 (I# x) `timesInt` (I# y) = I# (x *# y)
 720 (I# x) `quotInt`  (I# y) = I# (x `quotInt#` y)
 721 (I# x) `remInt`   (I# y) = I# (x `remInt#`  y)
 722 (I# x) `divInt`   (I# y) = I# (x `divInt#`  y)
 723 (I# x) `modInt`   (I# y) = I# (x `modInt#`  y)
 724
 725 {-# RULES
 726 "x# +# 0#" forall x#. x# +# 0# = x#
 727 "0# +# x#" forall x#. 0# +# x# = x#
 728 "x# -# 0#" forall x#. x# -# 0# = x#
 729 "x# -# x#" forall x#. x# -# x# = 0#
 730 "x# *# 0#" forall x#. x# *# 0# = 0#
 731 "0# *# x#" forall x#. 0# *# x# = 0#
 732 "x# *# 1#" forall x#. x# *# 1# = x#
 733 "1# *# x#" forall x#. 1# *# x# = x#
 734   #-}
 735
 736 negateInt :: Int -> Int
 737 negateInt (I# x) = I# (negateInt# x)
 738
 739 gtInt, geInt, eqInt, neInt, ltInt, leInt :: Int -> Int -> Bool
 740 (I# x) `gtInt` (I# y) = x >#  y
 741 (I# x) `geInt` (I# y) = x >=# y
 742 (I# x) `eqInt` (I# y) = x ==# y
 743 (I# x) `neInt` (I# y) = x /=# y
 744 (I# x) `ltInt` (I# y) = x <#  y
 745 (I# x) `leInt` (I# y) = x <=# y
 746
 747 {-# RULES
 748 "x# ># x#"  forall x#. x# >#  x# = False
 749 "x# >=# x#" forall x#. x# >=# x# = True
 750 "x# ==# x#" forall x#. x# ==# x# = True
 751 "x# /=# x#" forall x#. x# /=# x# = False
 752 "x# <# x#"  forall x#. x# <#  x# = False
 753 "x# <=# x#" forall x#. x# <=# x# = True
 754   #-}
 755
 756 {-# RULES
 757 "plusFloat x 0.0"   forall x#. plusFloat#  x#   0.0# = x#
 758 "plusFloat 0.0 x"   forall x#. plusFloat#  0.0# x#   = x#
 759 "minusFloat x 0.0"  forall x#. minusFloat# x#   0.0# = x#
 760 "minusFloat x x"    forall x#. minusFloat# x#   x#   = 0.0#
 761 "timesFloat x 0.0"  forall x#. timesFloat# x#   0.0# = 0.0#
 762 "timesFloat0.0 x"   forall x#. timesFloat# 0.0# x#   = 0.0#
 763 "timesFloat x 1.0"  forall x#. timesFloat# x#   1.0# = x#
 764 "timesFloat 1.0 x"  forall x#. timesFloat# 1.0# x#   = x#
 765 "divideFloat x 1.0" forall x#. divideFloat# x#  1.0# = x#
 766   #-}
 767
 768 {-# RULES
 769 "plusDouble x 0.0"   forall x#. (+##) x#    0.0## = x#
 770 "plusDouble 0.0 x"   forall x#. (+##) 0.0## x#    = x#
 771 "minusDouble x 0.0"  forall x#. (-##) x#    0.0## = x#
 772 "timesDouble x 1.0"  forall x#. (*##) x#    1.0## = x#
 773 "timesDouble 1.0 x"  forall x#. (*##) 1.0## x#    = x#
 774 "divideDouble x 1.0" forall x#. (/##) x#    1.0## = x#
 775   #-}
 776
 777 {-
 778 We'd like to have more rules, but for example:
 779
 780 This gives wrong answer (0) for NaN - NaN (should be NaN):
 781     "minusDouble x x"    forall x#. (-##) x#    x#    = 0.0##
 782
 783 This gives wrong answer (0) for 0 * NaN (should be NaN):
 784     "timesDouble 0.0 x"  forall x#. (*##) 0.0## x#    = 0.0##
 785
 786 This gives wrong answer (0) for NaN * 0 (should be NaN):
 787     "timesDouble x 0.0"  forall x#. (*##) x#    0.0## = 0.0##
 788
 789 These are tested by num014.
 790 -}
 791
 792 -- Wrappers for the shift operations.  The uncheckedShift# family are
 793 -- undefined when the amount being shifted by is greater than the size
 794 -- in bits of Int#, so these wrappers perform a check and return
 795 -- either zero or -1 appropriately.
 796 --
 797 -- Note that these wrappers still produce undefined results when the
 798 -- second argument (the shift amount) is negative.
 799
 800 -- | Shift the argument left by the specified number of bits
 801 -- (which must be non-negative).
 802 shiftL# :: Word# -> Int# -> Word#
 803 a `shiftL#` b   | b >=# WORD_SIZE_IN_BITS# = int2Word# 0#
 804                 | otherwise                = a `uncheckedShiftL#` b
 805
 806 -- | Shift the argument right by the specified number of bits
 807 -- (which must be non-negative).
 808 shiftRL# :: Word# -> Int# -> Word#
 809 a `shiftRL#` b  | b >=# WORD_SIZE_IN_BITS# = int2Word# 0#
 810                 | otherwise                = a `uncheckedShiftRL#` b
 811
 812 -- | Shift the argument left by the specified number of bits
 813 -- (which must be non-negative).
 814 iShiftL# :: Int# -> Int# -> Int#
 815 a `iShiftL#` b  | b >=# WORD_SIZE_IN_BITS# = 0#
 816                 | otherwise                = a `uncheckedIShiftL#` b
 817
 818 -- | Shift the argument right (signed) by the specified number of bits
 819 -- (which must be non-negative).
 820 iShiftRA# :: Int# -> Int# -> Int#
 821 a `iShiftRA#` b | b >=# WORD_SIZE_IN_BITS# = if a <# 0# then (-1#) else 0#
 822                 | otherwise                = a `uncheckedIShiftRA#` b
 823
 824 -- | Shift the argument right (unsigned) by the specified number of bits
 825 -- (which must be non-negative).
 826 iShiftRL# :: Int# -> Int# -> Int#
 827 a `iShiftRL#` b | b >=# WORD_SIZE_IN_BITS# = 0#
 828                 | otherwise                = a `uncheckedIShiftRL#` b
 829
 830 #if WORD_SIZE_IN_BITS == 32
 831 {-# RULES
 832 "narrow32Int#"  forall x#. narrow32Int#   x# = x#
 833 "narrow32Word#" forall x#. narrow32Word#   x# = x#
 834    #-}
 835 #endif
 836
 837 {-# RULES
 838 "int2Word2Int"  forall x#. int2Word# (word2Int# x#) = x#
 839 "word2Int2Word" forall x#. word2Int# (int2Word# x#) = x#
 840   #-}
 841 \end{code}
 842
 843
 844 %********************************************************
 845 %*                                                      *
 846 \subsection{Unpacking C strings}
 847 %*                                                      *
 848 %********************************************************
 849
 850 This code is needed for virtually all programs, since it's used for
 851 unpacking the strings of error messages.
 852
 853 \begin{code}
 854 unpackCString# :: Addr# -> [Char]
 855 {-# NOINLINE unpackCString# #-}
 856     -- There's really no point in inlining this, ever, cos
 857     -- the loop doesn't specialise in an interesting
 858     -- But it's pretty small, so there's a danger that
 859     -- it'll be inlined at every literal, which is a waste
 860 unpackCString# addr
 861   = unpack 0#
 862   where
 863     unpack nh
 864       | ch `eqChar#` '\0'# = []
 865       | otherwise          = C# ch : unpack (nh +# 1#)
 866       where
 867         !ch = indexCharOffAddr# addr nh
 868
 869 unpackAppendCString# :: Addr# -> [Char] -> [Char]
 870 {-# NOINLINE unpackAppendCString# #-}
 871      -- See the NOINLINE note on unpackCString#
 872 unpackAppendCString# addr rest
 873   = unpack 0#
 874   where
 875     unpack nh
 876       | ch `eqChar#` '\0'# = rest
 877       | otherwise          = C# ch : unpack (nh +# 1#)
 878       where
 879         !ch = indexCharOffAddr# addr nh
 880
 881 unpackFoldrCString# :: Addr# -> (Char  -> a -> a) -> a -> a
 882
 883 -- Usually the unpack-list rule turns unpackFoldrCString# into unpackCString#
 884
 885 -- It also has a BuiltInRule in PrelRules.lhs:
 886 --      unpackFoldrCString# "foo" c (unpackFoldrCString# "baz" c n)
 887 --        =  unpackFoldrCString# "foobaz" c n
 888
 889 {-# NOINLINE unpackFoldrCString# #-}
 890 -- At one stage I had NOINLINE [0] on the grounds that, unlike
 891 -- unpackCString#, there *is* some point in inlining
 892 -- unpackFoldrCString#, because we get better code for the
 893 -- higher-order function call.  BUT there may be a lot of
 894 -- literal strings, and making a separate 'unpack' loop for
 895 -- each is highly gratuitous.  See nofib/real/anna/PrettyPrint.
 896
 897 unpackFoldrCString# addr f z
 898   = unpack 0#
 899   where
 900     unpack nh
 901       | ch `eqChar#` '\0'# = z
 902       | otherwise          = C# ch `f` unpack (nh +# 1#)
 903       where
 904         !ch = indexCharOffAddr# addr nh
 905
 906 unpackCStringUtf8# :: Addr# -> [Char]
 907 unpackCStringUtf8# addr
 908   = unpack 0#
 909   where
 910     unpack nh
 911       | ch `eqChar#` '\0'#   = []
 912       | ch `leChar#` '\x7F'# = C# ch : unpack (nh +# 1#)
 913       | ch `leChar#` '\xDF'# =
 914           C# (chr# (((ord# ch                                  -# 0xC0#) `uncheckedIShiftL#`  6#) +#
 915                      (ord# (indexCharOffAddr# addr (nh +# 1#)) -# 0x80#))) :
 916           unpack (nh +# 2#)
 917       | ch `leChar#` '\xEF'# =
 918           C# (chr# (((ord# ch                                  -# 0xE0#) `uncheckedIShiftL#` 12#) +#
 919                     ((ord# (indexCharOffAddr# addr (nh +# 1#)) -# 0x80#) `uncheckedIShiftL#`  6#) +#
 920                      (ord# (indexCharOffAddr# addr (nh +# 2#)) -# 0x80#))) :
 921           unpack (nh +# 3#)
 922       | otherwise            =
 923           C# (chr# (((ord# ch                                  -# 0xF0#) `uncheckedIShiftL#` 18#) +#
 924                     ((ord# (indexCharOffAddr# addr (nh +# 1#)) -# 0x80#) `uncheckedIShiftL#` 12#) +#
 925                     ((ord# (indexCharOffAddr# addr (nh +# 2#)) -# 0x80#) `uncheckedIShiftL#`  6#) +#
 926                      (ord# (indexCharOffAddr# addr (nh +# 3#)) -# 0x80#))) :
 927           unpack (nh +# 4#)
 928       where
 929         !ch = indexCharOffAddr# addr nh
 930
 931 unpackNBytes# :: Addr# -> Int# -> [Char]
 932 unpackNBytes# _addr 0#   = []
 933 unpackNBytes#  addr len# = unpack [] (len# -# 1#)
 934     where
 935      unpack acc i#
 936       | i# <# 0#  = acc
 937       | otherwise =
 938          case indexCharOffAddr# addr i# of
 939             ch -> unpack (C# ch : acc) (i# -# 1#)
 940
 941 {-# RULES
 942 "unpack"       [~1] forall a   . unpackCString# a             = build (unpackFoldrCString# a)
 943 "unpack-list"  [1]  forall a   . unpackFoldrCString# a (:) [] = unpackCString# a
 944 "unpack-append"     forall a n . unpackFoldrCString# a (:) n  = unpackAppendCString# a n
 945
 946 -- There's a built-in rule (in PrelRules.lhs) for
 947 --      unpackFoldr "foo" c (unpackFoldr "baz" c n)  =  unpackFoldr "foobaz" c n
 948
 949   #-}
 950 \end{code}
 951
 952 #ifdef __HADDOCK__
 953 \begin{code}
 954 -- | A special argument for the 'Control.Monad.ST.ST' type constructor,
 955 -- indexing a state embedded in the 'Prelude.IO' monad by
 956 -- 'Control.Monad.ST.stToIO'.
 957 data RealWorld
 958 \end{code}
 959 #endif