[project @ 2001-07-03 11:37:49 by simonmar]
[packages/base.git] / GHC / Base.lhs
1 % -----------------------------------------------------------------------------
2 % $Id: Base.lhs,v 1.2 2001/07/03 11:37:50 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 Data.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}