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