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