GHC/Base.lhs

   1 % -----------------------------------------------------------------------------
   2 % $Id: Base.lhs,v 1.1 2001/06/28 14:15:03 simonmar Exp $
   3 %
   4 % (c) The University of Glasgow, 1992-2000
   5 %
   6 \section[GHC.Base]{Module @GHC.Base@}
   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 GHC.Prim                Has no implementation.  It defines built-in things, and
  21                 by importing it you bring them into scope.
  22                 The source file is GHC.Prim.hi-boot, which is just
  23                 copied to make GHC.Prim.hi
  24
  25                 Classes: CCallable, CReturnable
  26
  27 GHC.Base        Classes: Eq, Ord, Functor, Monad
  28                 Types:   list, (), Int, Bool, Ordering, Char, String
  29
  30 GHC.Tup         Types: tuples, plus instances for GHC.Base classes
  31
  32 GHC.Show        Class: Show, plus instances for GHC.Base/GHC.Tup types
  33
  34 GHC.Enum        Class: Enum,  plus instances for GHC.Base/GHC.Tup types
  35
  36 GHC.Maybe       Type: Maybe, plus instances for GHC.Base classes
  37
  38 GHC.Num         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 GHC.Real        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 GHC.Arr         Types: Array, MutableArray, MutableVar
  55
  56                 Does *not* contain any ByteArray stuff (see GHC.ByteArr)
  57                 Arrays are used by a function in GHC.Float
  58
  59 GHC.Float       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 GHC.Float.hi
  65
  66 GHC.ByteArr     Types: ByteArray, MutableByteArray
  67
  68                 We want this one to be after GHC.Float, 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 GHC.Base
  81         (
  82         module GHC.Base,
  83         module GHC.Prim,                -- Re-export GHC.Prim and GHC.Err, to avoid lots
  84         module GHC.Err          -- of people having to import it explicitly
  85   )
  86         where
  87
  88 import GHC.Prim
  89 import {-# SOURCE #-} GHC.Err
  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 GHC.Base 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 GHC.List.
 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 GHC.Read, Show in GHC.Show
 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 GHC.Tup).  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 GHC.Base 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 GHC.Read, Show in GHC.Show
 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 #if WORD_SIZE_IN_BYTES == 4
 469 minInt  = I# (-0x80000000#)
 470 maxInt  = I# 0x7FFFFFFF#
 471 #else
 472 minInt  = I# (-0x8000000000000000#)
 473 maxInt  = I# 0x7FFFFFFFFFFFFFFF#
 474 #endif
 475
 476 instance Eq Int where
 477     (==) = eqInt
 478     (/=) = neInt
 479
 480 instance Ord Int where
 481     compare = compareInt
 482     (<)     = ltInt
 483     (<=)    = leInt
 484     (>=)    = geInt
 485     (>)     = gtInt
 486
 487 compareInt :: Int -> Int -> Ordering
 488 (I# x#) `compareInt` (I# y#) = compareInt# x# y#
 489
 490 compareInt# :: Int# -> Int# -> Ordering
 491 compareInt# x# y#
 492     | x# <#  y# = LT
 493     | x# ==# y# = EQ
 494     | otherwise = GT
 495 \end{code}
 496
 497
 498 %*********************************************************
 499 %*                                                      *
 500 \subsection{The function type}
 501 %*                                                      *
 502 %*********************************************************
 503
 504 \begin{code}
 505 -- identity function
 506 id                      :: a -> a
 507 id x                    =  x
 508
 509 -- constant function
 510 const                   :: a -> b -> a
 511 const x _               =  x
 512
 513 -- function composition
 514 {-# INLINE (.) #-}
 515 (.)       :: (b -> c) -> (a -> b) -> a -> c
 516 (.) f g x = f (g x)
 517
 518 -- flip f  takes its (first) two arguments in the reverse order of f.
 519 flip                    :: (a -> b -> c) -> b -> a -> c
 520 flip f x y              =  f y x
 521
 522 -- right-associating infix application operator (useful in continuation-
 523 -- passing style)
 524 {-# INLINE ($) #-}
 525 ($)                     :: (a -> b) -> a -> b
 526 f $ x                   =  f x
 527
 528 -- until p f  yields the result of applying f until p holds.
 529 until                   :: (a -> Bool) -> (a -> a) -> a -> a
 530 until p f x | p x       =  x
 531             | otherwise =  until p f (f x)
 532
 533 -- asTypeOf is a type-restricted version of const.  It is usually used
 534 -- as an infix operator, and its typing forces its first argument
 535 -- (which is usually overloaded) to have the same type as the second.
 536 asTypeOf                :: a -> a -> a
 537 asTypeOf                =  const
 538 \end{code}
 539
 540 %*********************************************************
 541 %*                                                      *
 542 \subsection{CCallable instances}
 543 %*                                                      *
 544 %*********************************************************
 545
 546 Defined here to avoid orphans
 547
 548 \begin{code}
 549 instance CCallable Char
 550 instance CReturnable Char
 551
 552 instance CCallable   Int
 553 instance CReturnable Int
 554
 555 instance CReturnable () -- Why, exactly?
 556 \end{code}
 557
 558
 559 %*********************************************************
 560 %*                                                      *
 561 \subsection{Generics}
 562 %*                                                      *
 563 %*********************************************************
 564
 565 \begin{code}
 566 data Unit = Unit
 567 data a :+: b = Inl a | Inr b
 568 data a :*: b = a :*: b
 569 \end{code}
 570
 571
 572 %*********************************************************
 573 %*                                                      *
 574 \subsection{Numeric primops}
 575 %*                                                      *
 576 %*********************************************************
 577
 578 \begin{code}
 579 divInt#, modInt# :: Int# -> Int# -> Int#
 580 x# `divInt#` y#
 581     | (x# ># 0#) && (y# <# 0#) = ((x# -# y#) -# 1#) `quotInt#` y#
 582     | (x# <# 0#) && (y# ># 0#) = ((x# -# y#) +# 1#) `quotInt#` y#
 583     | otherwise                = x# `quotInt#` y#
 584 x# `modInt#` y#
 585     | (x# ># 0#) && (y# <# 0#) ||
 586       (x# <# 0#) && (y# ># 0#)    = if r# /=# 0# then r# +# y# else 0#
 587     | otherwise                   = r#
 588     where
 589     r# = x# `remInt#` y#
 590 \end{code}
 591
 592 Definitions of the boxed PrimOps; these will be
 593 used in the case of partial applications, etc.
 594
 595 \begin{code}
 596 {-# INLINE eqInt #-}
 597 {-# INLINE neInt #-}
 598 {-# INLINE gtInt #-}
 599 {-# INLINE geInt #-}
 600 {-# INLINE ltInt #-}
 601 {-# INLINE leInt #-}
 602 {-# INLINE plusInt #-}
 603 {-# INLINE minusInt #-}
 604 {-# INLINE timesInt #-}
 605 {-# INLINE quotInt #-}
 606 {-# INLINE remInt #-}
 607 {-# INLINE negateInt #-}
 608
 609 plusInt, minusInt, timesInt, quotInt, remInt, divInt, modInt, gcdInt :: Int -> Int -> Int
 610 (I# x) `plusInt`  (I# y) = I# (x +# y)
 611 (I# x) `minusInt` (I# y) = I# (x -# y)
 612 (I# x) `timesInt` (I# y) = I# (x *# y)
 613 (I# x) `quotInt`  (I# y) = I# (x `quotInt#` y)
 614 (I# x) `remInt`   (I# y) = I# (x `remInt#`  y)
 615 (I# x) `divInt`   (I# y) = I# (x `divInt#`  y)
 616 (I# x) `modInt`   (I# y) = I# (x `modInt#`  y)
 617
 618 {-# RULES
 619 "x# +# 0#" forall x#. x# +# 0# = x#
 620 "0# +# x#" forall x#. 0# +# x# = x#
 621 "x# -# 0#" forall x#. x# -# 0# = x#
 622 "x# -# x#" forall x#. x# -# x# = 0#
 623 "x# *# 0#" forall x#. x# *# 0# = 0#
 624 "0# *# x#" forall x#. 0# *# x# = 0#
 625 "x# *# 1#" forall x#. x# *# 1# = x#
 626 "1# *# x#" forall x#. 1# *# x# = x#
 627   #-}
 628
 629 gcdInt (I# a) (I# b) = g a b
 630    where g 0# 0# = error "GHC.Base.gcdInt: gcd 0 0 is undefined"
 631          g 0# _  = I# absB
 632          g _  0# = I# absA
 633          g _  _  = I# (gcdInt# absA absB)
 634
 635          absInt x = if x <# 0# then negateInt# x else x
 636
 637          absA     = absInt a
 638          absB     = absInt b
 639
 640 negateInt :: Int -> Int
 641 negateInt (I# x) = I# (negateInt# x)
 642
 643 gtInt, geInt, eqInt, neInt, ltInt, leInt :: Int -> Int -> Bool
 644 (I# x) `gtInt` (I# y) = x >#  y
 645 (I# x) `geInt` (I# y) = x >=# y
 646 (I# x) `eqInt` (I# y) = x ==# y
 647 (I# x) `neInt` (I# y) = x /=# y
 648 (I# x) `ltInt` (I# y) = x <#  y
 649 (I# x) `leInt` (I# y) = x <=# y
 650
 651 {-# RULES
 652 "x# ># x#"  forall x#. x# >#  x# = False
 653 "x# >=# x#" forall x#. x# >=# x# = True
 654 "x# ==# x#" forall x#. x# ==# x# = True
 655 "x# /=# x#" forall x#. x# /=# x# = False
 656 "x# <# x#"  forall x#. x# <#  x# = False
 657 "x# <=# x#" forall x#. x# <=# x# = True
 658   #-}
 659
 660 #if WORD_SIZE_IN_BYTES == 4
 661 {-# RULES
 662 "intToInt32#"   forall x#. intToInt32#   x# = x#
 663 "wordToWord32#" forall x#. wordToWord32# x# = x#
 664    #-}
 665 #endif
 666
 667 {-# RULES
 668 "int2Word2Int"  forall x#. int2Word# (word2Int# x#) = x#
 669 "word2Int2Word" forall x#. word2Int# (int2Word# x#) = x#
 670   #-}
 671 \end{code}
 672
 673
 674 %********************************************************
 675 %*                                                      *
 676 \subsection{Unpacking C strings}
 677 %*                                                      *
 678 %********************************************************
 679
 680 This code is needed for virtually all programs, since it's used for
 681 unpacking the strings of error messages.
 682
 683 \begin{code}
 684 unpackCString# :: Addr# -> [Char]
 685 unpackCString# a = unpackCStringList# a
 686
 687 unpackCStringList# :: Addr# -> [Char]
 688 unpackCStringList# addr
 689   = unpack 0#
 690   where
 691     unpack nh
 692       | ch `eqChar#` '\0'# = []
 693       | otherwise          = C# ch : unpack (nh +# 1#)
 694       where
 695         ch = indexCharOffAddr# addr nh
 696
 697 unpackAppendCString# :: Addr# -> [Char] -> [Char]
 698 unpackAppendCString# addr rest
 699   = unpack 0#
 700   where
 701     unpack nh
 702       | ch `eqChar#` '\0'# = rest
 703       | otherwise          = C# ch : unpack (nh +# 1#)
 704       where
 705         ch = indexCharOffAddr# addr nh
 706
 707 unpackFoldrCString# :: Addr# -> (Char  -> a -> a) -> a -> a
 708 unpackFoldrCString# addr f z
 709   = unpack 0#
 710   where
 711     unpack nh
 712       | ch `eqChar#` '\0'# = z
 713       | otherwise          = C# ch `f` unpack (nh +# 1#)
 714       where
 715         ch = indexCharOffAddr# addr nh
 716
 717 unpackCStringUtf8# :: Addr# -> [Char]
 718 unpackCStringUtf8# addr
 719   = unpack 0#
 720   where
 721     unpack nh
 722       | ch `eqChar#` '\0'#   = []
 723       | ch `leChar#` '\x7F'# = C# ch : unpack (nh +# 1#)
 724       | ch `leChar#` '\xDF'# =
 725           C# (chr# ((ord# ch                                  -# 0xC0#) `iShiftL#`  6# +#
 726                     (ord# (indexCharOffAddr# addr (nh +# 1#)) -# 0x80#))) :
 727           unpack (nh +# 2#)
 728       | ch `leChar#` '\xEF'# =
 729           C# (chr# ((ord# ch                                  -# 0xE0#) `iShiftL#` 12# +#
 730                     (ord# (indexCharOffAddr# addr (nh +# 1#)) -# 0x80#) `iShiftL#`  6# +#
 731                     (ord# (indexCharOffAddr# addr (nh +# 2#)) -# 0x80#))) :
 732           unpack (nh +# 3#)
 733       | otherwise            =
 734           C# (chr# ((ord# ch                                  -# 0xF0#) `iShiftL#` 18# +#
 735                     (ord# (indexCharOffAddr# addr (nh +# 1#)) -# 0x80#) `iShiftL#` 12# +#
 736                     (ord# (indexCharOffAddr# addr (nh +# 2#)) -# 0x80#) `iShiftL#`  6# +#
 737                     (ord# (indexCharOffAddr# addr (nh +# 3#)) -# 0x80#))) :
 738           unpack (nh +# 4#)
 739       where
 740         ch = indexCharOffAddr# addr nh
 741
 742 unpackNBytes# :: Addr# -> Int# -> [Char]
 743 unpackNBytes# _addr 0#   = []
 744 unpackNBytes#  addr len# = unpack [] (len# -# 1#)
 745     where
 746      unpack acc i#
 747       | i# <# 0#  = acc
 748       | otherwise =
 749          case indexCharOffAddr# addr i# of
 750             ch -> unpack (C# ch : acc) (i# -# 1#)
 751
 752 {-# RULES
 753 "unpack"         forall a   . unpackCString# a             = build (unpackFoldrCString# a)
 754 "unpack-list"    forall a   . unpackFoldrCString# a (:) [] = unpackCStringList# a
 755 "unpack-append"  forall a n . unpackFoldrCString# a (:) n  = unpackAppendCString# a n
 756
 757 -- There's a built-in rule (in GHC.Rules.lhs) for
 758 --      unpackFoldr "foo" c (unpackFoldr "baz" c n)  =  unpackFoldr "foobaz" c n
 759
 760   #-}
 761 \end{code}