ghc/lib/std/PrelBase.lhs

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