[project @ 2002-04-26 12:48:16 by simonmar]
[packages/base.git] / 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                 Classes: CCallable, CReturnable
20
21 GHC.Base        Classes: Eq, Ord, Functor, Monad
22                 Types:   list, (), Int, Bool, Ordering, Char, String
23
24 Data.Tup        Types: tuples, plus instances for GHC.Base classes
25
26 GHC.Show        Class: Show, plus instances for GHC.Base/GHC.Tup types
27
28 GHC.Enum        Class: Enum,  plus instances for GHC.Base/GHC.Tup types
29
30 Data.Maybe      Type: Maybe, plus instances for GHC.Base classes
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 Ix              Classes: Ix, plus instances for Int, Bool, Char, Integer, Ordering, tuples
47
48 GHC.Arr         Types: Array, MutableArray, MutableVar
49
50                 Does *not* contain any ByteArray stuff (see GHC.ByteArr)
51                 Arrays are used by a function in GHC.Float
52
53 GHC.Float       Classes: Floating, RealFloat
54                 Types:   Float, Double, plus instances of all classes so far
55
56                 This module contains everything to do with floating point.
57                 It is a big module (900 lines)
58                 With a bit of luck, many modules can be compiled without ever reading GHC.Float.hi
59
60 GHC.ByteArr     Types: ByteArray, MutableByteArray
61                 
62                 We want this one to be after GHC.Float, because it defines arrays
63                 of unboxed floats.
64
65
66 Other Prelude modules are much easier with fewer complex dependencies.
67
68 \begin{code}
69 {-# OPTIONS -fno-implicit-prelude #-}
70 -----------------------------------------------------------------------------
71 -- |
72 -- Module      :  GHC.Base
73 -- Copyright   :  (c) The University of Glasgow, 1992-2002
74 -- License     :  see libraries/base/LICENSE
75 -- 
76 -- Maintainer  :  cvs-ghc@haskell.org
77 -- Stability   :  internal
78 -- Portability :  non-portable (GHC extensions)
79 --
80 -- Basic data types and classes.
81 -- 
82 -----------------------------------------------------------------------------
83
84 #include "MachDeps.h"
85
86 module GHC.Base
87         (
88         module GHC.Base,
89         module GHC.Prim,                -- Re-export GHC.Prim and GHC.Err, to avoid lots
90         module GHC.Err          -- of people having to import it explicitly
91   ) 
92         where
93
94 import GHC.Prim
95 import {-# SOURCE #-} GHC.Err
96
97 infixr 9  .
98 infixr 5  ++, :
99 infix  4  ==, /=, <, <=, >=, >
100 infixr 3  &&
101 infixr 2  ||
102 infixl 1  >>, >>=
103 infixr 0  $
104
105 default ()              -- Double isn't available yet
106 \end{code}
107
108
109 %*********************************************************
110 %*                                                      *
111 \subsection{DEBUGGING STUFF}
112 %*  (for use when compiling GHC.Base itself doesn't work)
113 %*                                                      *
114 %*********************************************************
115
116 \begin{code}
117 {-
118 data  Bool  =  False | True
119 data Ordering = LT | EQ | GT 
120 data Char = C# Char#
121 type  String = [Char]
122 data Int = I# Int#
123 data  ()  =  ()
124 data [] a = MkNil
125
126 not True = False
127 (&&) True True = True
128 otherwise = True
129
130 build = error "urk"
131 foldr = error "urk"
132
133 unpackCString# :: Addr# -> [Char]
134 unpackFoldrCString# :: Addr# -> (Char  -> a -> a) -> a -> a 
135 unpackAppendCString# :: Addr# -> [Char] -> [Char]
136 unpackCStringUtf8# :: Addr# -> [Char]
137 unpackCString# a = error "urk"
138 unpackFoldrCString# a = error "urk"
139 unpackAppendCString# a = error "urk"
140 unpackCStringUtf8# a = error "urk"
141 -}
142 \end{code}
143
144
145 %*********************************************************
146 %*                                                      *
147 \subsection{Standard classes @Eq@, @Ord@}
148 %*                                                      *
149 %*********************************************************
150
151 \begin{code}
152 class  Eq a  where
153     (==), (/=)           :: a -> a -> Bool
154
155     x /= y               = not (x == y)
156     x == y               = not (x /= y)
157
158 class  (Eq a) => Ord a  where
159     compare              :: a -> a -> Ordering
160     (<), (<=), (>), (>=) :: a -> a -> Bool
161     max, min             :: a -> a -> a
162
163     -- An instance of Ord should define either 'compare' or '<='.
164     -- Using 'compare' can be more efficient for complex types.
165
166     compare x y
167         | x == y    = EQ
168         | x <= y    = LT        -- NB: must be '<=' not '<' to validate the
169                                 -- above claim about the minimal things that
170                                 -- can be defined for an instance of Ord
171         | otherwise = GT
172
173     x <  y = case compare x y of { LT -> True;  _other -> False }
174     x <= y = case compare x y of { GT -> False; _other -> True }
175     x >  y = case compare x y of { GT -> True;  _other -> False }
176     x >= y = case compare x y of { LT -> False; _other -> True }
177
178         -- These two default methods use '<=' rather than 'compare'
179         -- because the latter is often more expensive
180     max x y = if x <= y then y else x
181     min x y = if x <= y then x else y
182 \end{code}
183
184 %*********************************************************
185 %*                                                      *
186 \subsection{Monadic classes @Functor@, @Monad@ }
187 %*                                                      *
188 %*********************************************************
189
190 \begin{code}
191 class  Functor f  where
192     fmap        :: (a -> b) -> f a -> f b
193
194 class  Monad m  where
195     (>>=)       :: m a -> (a -> m b) -> m b
196     (>>)        :: m a -> m b -> m b
197     return      :: a -> m a
198     fail        :: String -> m a
199
200     m >> k      = m >>= \_ -> k
201     fail s      = error s
202 \end{code}
203
204
205 %*********************************************************
206 %*                                                      *
207 \subsection{The list type}
208 %*                                                      *
209 %*********************************************************
210
211 \begin{code}
212 data [] a = [] | a : [a]  -- do explicitly: deriving (Eq, Ord)
213                           -- to avoid weird names like con2tag_[]#
214
215
216 instance (Eq a) => Eq [a] where
217     {-# SPECIALISE instance Eq [Char] #-}
218     []     == []     = True
219     (x:xs) == (y:ys) = x == y && xs == ys
220     _xs    == _ys    = False
221
222 instance (Ord a) => Ord [a] where
223     {-# SPECIALISE instance Ord [Char] #-}
224     compare []     []     = EQ
225     compare []     (_:_)  = LT
226     compare (_:_)  []     = GT
227     compare (x:xs) (y:ys) = case compare x y of
228                                 EQ    -> compare xs ys
229                                 other -> other
230
231 instance Functor [] where
232     fmap = map
233
234 instance  Monad []  where
235     m >>= k             = foldr ((++) . k) [] m
236     m >> k              = foldr ((++) . (\ _ -> k)) [] m
237     return x            = [x]
238     fail _              = []
239 \end{code}
240
241 A few list functions that appear here because they are used here.
242 The rest of the prelude list functions are in GHC.List.
243
244 ----------------------------------------------
245 --      foldr/build/augment
246 ----------------------------------------------
247   
248 \begin{code}
249 foldr            :: (a -> b -> b) -> b -> [a] -> b
250 -- foldr _ z []     =  z
251 -- foldr f z (x:xs) =  f x (foldr f z xs)
252 {-# INLINE [0] foldr #-}
253 -- Inline only in the final stage, after the foldr/cons rule has had a chance
254 foldr k z xs = go xs
255              where
256                go []     = z
257                go (y:ys) = y `k` go ys
258
259 build   :: forall a. (forall b. (a -> b -> b) -> b -> b) -> [a]
260 {-# INLINE [1] build #-}
261         -- The INLINE is important, even though build is tiny,
262         -- because it prevents [] getting inlined in the version that
263         -- appears in the interface file.  If [] *is* inlined, it
264         -- won't match with [] appearing in rules in an importing module.
265         --
266         -- The "1" says to inline in phase 1
267
268 build g = g (:) []
269
270 augment :: forall a. (forall b. (a->b->b) -> b -> b) -> [a] -> [a]
271 {-# INLINE [1] augment #-}
272 augment g xs = g (:) xs
273
274 {-# RULES
275 "fold/build"    forall k z (g::forall b. (a->b->b) -> b -> b) . 
276                 foldr k z (build g) = g k z
277
278 "foldr/augment" forall k z xs (g::forall b. (a->b->b) -> b -> b) . 
279                 foldr k z (augment g xs) = g k (foldr k z xs)
280
281 "foldr/id"                        foldr (:) [] = \x->x
282 "foldr/app"     [1] forall xs ys. foldr (:) ys xs = xs ++ ys
283         -- Only activate this from phase 1, because that's
284         -- when we disable the rule that expands (++) into foldr
285
286 -- The foldr/cons rule looks nice, but it can give disastrously
287 -- bloated code when commpiling
288 --      array (a,b) [(1,2), (2,2), (3,2), ...very long list... ]
289 -- i.e. when there are very very long literal lists
290 -- So I've disabled it for now. We could have special cases
291 -- for short lists, I suppose.
292 -- "foldr/cons" forall k z x xs. foldr k z (x:xs) = k x (foldr k z xs)
293
294 "foldr/single"  forall k z x. foldr k z [x] = k x z
295 "foldr/nil"     forall k z.   foldr k z []  = z 
296
297 "augment/build" forall (g::forall b. (a->b->b) -> b -> b)
298                        (h::forall b. (a->b->b) -> b -> b) .
299                        augment g (build h) = build (\c n -> g c (h c n))
300 "augment/nil"   forall (g::forall b. (a->b->b) -> b -> b) .
301                         augment g [] = build g
302  #-}
303
304 -- This rule is true, but not (I think) useful:
305 --      augment g (augment h t) = augment (\cn -> g c (h c n)) t
306 \end{code}
307
308
309 ----------------------------------------------
310 --              map     
311 ----------------------------------------------
312
313 \begin{code}
314 map :: (a -> b) -> [a] -> [b]
315 map _ []     = []
316 map f (x:xs) = f x : map f xs
317
318 -- Note eta expanded
319 mapFB ::  (elt -> lst -> lst) -> (a -> elt) -> a -> lst -> lst
320 {-# INLINE [0] mapFB #-}
321 mapFB c f x ys = c (f x) ys
322
323 -- The rules for map work like this.
324 -- 
325 -- Up to (but not including) phase 1, we use the "map" rule to
326 -- rewrite all saturated applications of map with its build/fold 
327 -- form, hoping for fusion to happen.
328 -- In phase 1 and 0, we switch off that rule, inline build, and
329 -- switch on the "mapList" rule, which rewrites the foldr/mapFB
330 -- thing back into plain map.  
331 --
332 -- It's important that these two rules aren't both active at once 
333 -- (along with build's unfolding) else we'd get an infinite loop 
334 -- in the rules.  Hence the activation control below.
335 --
336 -- The "mapFB" rule optimises compositions of map.
337 --
338 -- This same pattern is followed by many other functions: 
339 -- e.g. append, filter, iterate, repeat, etc.
340
341 {-# RULES
342 "map"       [~1] forall f xs.   map f xs                = build (\c n -> foldr (mapFB c f) n xs)
343 "mapList"   [1]  forall f.      foldr (mapFB (:) f) []  = map f
344 "mapFB"     forall c f g.       mapFB (mapFB c f) g     = mapFB c (f.g) 
345   #-}
346 \end{code}
347
348
349 ----------------------------------------------
350 --              append  
351 ----------------------------------------------
352 \begin{code}
353 (++) :: [a] -> [a] -> [a]
354 (++) []     ys = ys
355 (++) (x:xs) ys = x : xs ++ ys
356
357 {-# RULES
358 "++"    [~1] forall xs ys. xs ++ ys = augment (\c n -> foldr c n xs) ys
359   #-}
360
361 \end{code}
362
363
364 %*********************************************************
365 %*                                                      *
366 \subsection{Type @Bool@}
367 %*                                                      *
368 %*********************************************************
369
370 \begin{code}
371 data  Bool  =  False | True  deriving (Eq, Ord)
372         -- Read in GHC.Read, Show in GHC.Show
373
374 -- Boolean functions
375
376 (&&), (||)              :: Bool -> Bool -> Bool
377 True  && x              =  x
378 False && _              =  False
379 True  || _              =  True
380 False || x              =  x
381
382 not                     :: Bool -> Bool
383 not True                =  False
384 not False               =  True
385
386 otherwise               :: Bool
387 otherwise               =  True
388 \end{code}
389
390
391 %*********************************************************
392 %*                                                      *
393 \subsection{The @()@ type}
394 %*                                                      *
395 %*********************************************************
396
397 The Unit type is here because virtually any program needs it (whereas
398 some programs may get away without consulting GHC.Tup).  Furthermore,
399 the renamer currently *always* asks for () to be in scope, so that
400 ccalls can use () as their default type; so when compiling GHC.Base we
401 need ().  (We could arrange suck in () only if -fglasgow-exts, but putting
402 it here seems more direct.)
403
404 \begin{code}
405 data () = ()
406
407 instance Eq () where
408     () == () = True
409     () /= () = False
410
411 instance Ord () where
412     () <= () = True
413     () <  () = False
414     () >= () = True
415     () >  () = False
416     max () () = ()
417     min () () = ()
418     compare () () = EQ
419 \end{code}
420
421
422 %*********************************************************
423 %*                                                      *
424 \subsection{Type @Ordering@}
425 %*                                                      *
426 %*********************************************************
427
428 \begin{code}
429 data Ordering = LT | EQ | GT deriving (Eq, Ord)
430         -- Read in GHC.Read, Show in GHC.Show
431 \end{code}
432
433
434 %*********************************************************
435 %*                                                      *
436 \subsection{Type @Char@ and @String@}
437 %*                                                      *
438 %*********************************************************
439
440 \begin{code}
441 type String = [Char]
442
443 data Char = C# Char#
444
445 -- We don't use deriving for Eq and Ord, because for Ord the derived
446 -- instance defines only compare, which takes two primops.  Then
447 -- '>' uses compare, and therefore takes two primops instead of one.
448
449 instance Eq Char where
450     (C# c1) == (C# c2) = c1 `eqChar#` c2
451     (C# c1) /= (C# c2) = c1 `neChar#` c2
452
453 instance Ord Char where
454     (C# c1) >  (C# c2) = c1 `gtChar#` c2
455     (C# c1) >= (C# c2) = c1 `geChar#` c2
456     (C# c1) <= (C# c2) = c1 `leChar#` c2
457     (C# c1) <  (C# c2) = c1 `ltChar#` c2
458
459 {-# RULES
460 "x# `eqChar#` x#" forall x#. x# `eqChar#` x# = True
461 "x# `neChar#` x#" forall x#. x# `neChar#` x# = False
462 "x# `gtChar#` x#" forall x#. x# `gtChar#` x# = False
463 "x# `geChar#` x#" forall x#. x# `geChar#` x# = True
464 "x# `leChar#` x#" forall x#. x# `leChar#` x# = True
465 "x# `ltChar#` x#" forall x#. x# `ltChar#` x# = False
466   #-}
467
468 chr :: Int -> Char
469 chr (I# i#) | int2Word# i# `leWord#` int2Word# 0x10FFFF# = C# (chr# i#)
470             | otherwise                                  = error "Prelude.chr: bad argument"
471
472 unsafeChr :: Int -> Char
473 unsafeChr (I# i#) = C# (chr# i#)
474
475 ord :: Char -> Int
476 ord (C# c#) = I# (ord# c#)
477 \end{code}
478
479 String equality is used when desugaring pattern-matches against strings.
480
481 \begin{code}
482 eqString :: String -> String -> Bool
483 eqString []       []       = True
484 eqString (c1:cs1) (c2:cs2) = c1 == c2 && cs1 `eqString` cs2
485 eqString cs1      cs2      = False
486
487 {-# RULES "eqString" (==) = eqString #-}
488 \end{code}
489
490
491 %*********************************************************
492 %*                                                      *
493 \subsection{Type @Int@}
494 %*                                                      *
495 %*********************************************************
496
497 \begin{code}
498 data Int = I# Int#
499
500 zeroInt, oneInt, twoInt, maxInt, minInt :: Int
501 zeroInt = I# 0#
502 oneInt  = I# 1#
503 twoInt  = I# 2#
504
505 {- Seems clumsy. Should perhaps put minInt and MaxInt directly into MachDeps.h -}
506 #if WORD_SIZE_IN_BITS == 31
507 minInt  = I# (-0x40000000#)
508 maxInt  = I# 0x3FFFFFFF#
509 #elif WORD_SIZE_IN_BITS == 32
510 minInt  = I# (-0x80000000#)
511 maxInt  = I# 0x7FFFFFFF#
512 #else 
513 minInt  = I# (-0x8000000000000000#)
514 maxInt  = I# 0x7FFFFFFFFFFFFFFF#
515 #endif
516
517 instance Eq Int where
518     (==) = eqInt
519     (/=) = neInt
520
521 instance Ord Int where
522     compare = compareInt
523     (<)     = ltInt
524     (<=)    = leInt
525     (>=)    = geInt
526     (>)     = gtInt
527
528 compareInt :: Int -> Int -> Ordering
529 (I# x#) `compareInt` (I# y#) = compareInt# x# y#
530
531 compareInt# :: Int# -> Int# -> Ordering
532 compareInt# x# y#
533     | x# <#  y# = LT
534     | x# ==# y# = EQ
535     | otherwise = GT
536 \end{code}
537
538
539 %*********************************************************
540 %*                                                      *
541 \subsection{The function type}
542 %*                                                      *
543 %*********************************************************
544
545 \begin{code}
546 -- identity function
547 id                      :: a -> a
548 id x                    =  x
549
550 -- constant function
551 const                   :: a -> b -> a
552 const x _               =  x
553
554 -- function composition
555 {-# INLINE (.) #-}
556 (.)       :: (b -> c) -> (a -> b) -> a -> c
557 (.) f g x = f (g x)
558
559 -- flip f  takes its (first) two arguments in the reverse order of f.
560 flip                    :: (a -> b -> c) -> b -> a -> c
561 flip f x y              =  f y x
562
563 -- right-associating infix application operator (useful in continuation-
564 -- passing style)
565 {-# INLINE ($) #-}
566 ($)                     :: (a -> b) -> a -> b
567 f $ x                   =  f x
568
569 -- until p f  yields the result of applying f until p holds.
570 until                   :: (a -> Bool) -> (a -> a) -> a -> a
571 until p f x | p x       =  x
572             | otherwise =  until p f (f x)
573
574 -- asTypeOf is a type-restricted version of const.  It is usually used
575 -- as an infix operator, and its typing forces its first argument
576 -- (which is usually overloaded) to have the same type as the second.
577 asTypeOf                :: a -> a -> a
578 asTypeOf                =  const
579 \end{code}
580
581 %*********************************************************
582 %*                                                      *
583 \subsection{CCallable instances}
584 %*                                                      *
585 %*********************************************************
586
587 Defined here to avoid orphans
588
589 \begin{code}
590 instance CCallable Char
591 instance CReturnable Char
592
593 instance CCallable   Int
594 instance CReturnable Int
595
596 instance CReturnable () -- Why, exactly?
597 \end{code}
598
599
600 %*********************************************************
601 %*                                                      *
602 \subsection{Generics}
603 %*                                                      *
604 %*********************************************************
605
606 \begin{code}
607 data Unit = Unit
608 #ifndef __HADDOCK__
609 data (:+:) a b = Inl a | Inr b
610 data (:*:) a b = a :*: b
611 #endif
612 \end{code}
613
614
615 %*********************************************************
616 %*                                                      *
617 \subsection{Numeric primops}
618 %*                                                      *
619 %*********************************************************
620
621 \begin{code}
622 divInt#, modInt# :: Int# -> Int# -> Int#
623 x# `divInt#` y#
624     | (x# ># 0#) && (y# <# 0#) = ((x# -# y#) -# 1#) `quotInt#` y#
625     | (x# <# 0#) && (y# ># 0#) = ((x# -# y#) +# 1#) `quotInt#` y#
626     | otherwise                = x# `quotInt#` y#
627 x# `modInt#` y#
628     | (x# ># 0#) && (y# <# 0#) ||
629       (x# <# 0#) && (y# ># 0#)    = if r# /=# 0# then r# +# y# else 0#
630     | otherwise                   = r#
631     where
632     r# = x# `remInt#` y#
633 \end{code}
634
635 Definitions of the boxed PrimOps; these will be
636 used in the case of partial applications, etc.
637
638 \begin{code}
639 {-# INLINE eqInt #-}
640 {-# INLINE neInt #-}
641 {-# INLINE gtInt #-}
642 {-# INLINE geInt #-}
643 {-# INLINE ltInt #-}
644 {-# INLINE leInt #-}
645 {-# INLINE plusInt #-}
646 {-# INLINE minusInt #-}
647 {-# INLINE timesInt #-}
648 {-# INLINE quotInt #-}
649 {-# INLINE remInt #-}
650 {-# INLINE negateInt #-}
651
652 plusInt, minusInt, timesInt, quotInt, remInt, divInt, modInt, gcdInt :: Int -> Int -> Int
653 (I# x) `plusInt`  (I# y) = I# (x +# y)
654 (I# x) `minusInt` (I# y) = I# (x -# y)
655 (I# x) `timesInt` (I# y) = I# (x *# y)
656 (I# x) `quotInt`  (I# y) = I# (x `quotInt#` y)
657 (I# x) `remInt`   (I# y) = I# (x `remInt#`  y)
658 (I# x) `divInt`   (I# y) = I# (x `divInt#`  y)
659 (I# x) `modInt`   (I# y) = I# (x `modInt#`  y)
660
661 {-# RULES
662 "x# +# 0#" forall x#. x# +# 0# = x#
663 "0# +# x#" forall x#. 0# +# x# = x#
664 "x# -# 0#" forall x#. x# -# 0# = x#
665 "x# -# x#" forall x#. x# -# x# = 0#
666 "x# *# 0#" forall x#. x# *# 0# = 0#
667 "0# *# x#" forall x#. 0# *# x# = 0#
668 "x# *# 1#" forall x#. x# *# 1# = x#
669 "1# *# x#" forall x#. 1# *# x# = x#
670   #-}
671
672 gcdInt (I# a) (I# b) = g a b
673    where g 0# 0# = error "GHC.Base.gcdInt: gcd 0 0 is undefined"
674          g 0# _  = I# absB
675          g _  0# = I# absA
676          g _  _  = I# (gcdInt# absA absB)
677
678          absInt x = if x <# 0# then negateInt# x else x
679
680          absA     = absInt a
681          absB     = absInt b
682
683 negateInt :: Int -> Int
684 negateInt (I# x) = I# (negateInt# x)
685
686 gtInt, geInt, eqInt, neInt, ltInt, leInt :: Int -> Int -> Bool
687 (I# x) `gtInt` (I# y) = x >#  y
688 (I# x) `geInt` (I# y) = x >=# y
689 (I# x) `eqInt` (I# y) = x ==# y
690 (I# x) `neInt` (I# y) = x /=# y
691 (I# x) `ltInt` (I# y) = x <#  y
692 (I# x) `leInt` (I# y) = x <=# y
693
694 {-# RULES
695 "x# ># x#"  forall x#. x# >#  x# = False
696 "x# >=# x#" forall x#. x# >=# x# = True
697 "x# ==# x#" forall x#. x# ==# x# = True
698 "x# /=# x#" forall x#. x# /=# x# = False
699 "x# <# x#"  forall x#. x# <#  x# = False
700 "x# <=# x#" forall x#. x# <=# x# = True
701   #-}
702
703 {-# RULES
704 "plusFloat x 0.0"   forall x#. plusFloat#  x#   0.0# = x#
705 "plusFloat 0.0 x"   forall x#. plusFloat#  0.0# x#   = x#
706 "minusFloat x 0.0"  forall x#. minusFloat# x#   0.0# = x#
707 "minusFloat x x"    forall x#. minusFloat# x#   x#   = 0.0#
708 "timesFloat x 0.0"  forall x#. timesFloat# x#   0.0# = 0.0#
709 "timesFloat0.0 x"   forall x#. timesFloat# 0.0# x#   = 0.0#
710 "timesFloat x 1.0"  forall x#. timesFloat# x#   1.0# = x#
711 "timesFloat 1.0 x"  forall x#. timesFloat# 1.0# x#   = x#
712 "divideFloat x 1.0" forall x#. divideFloat# x#  1.0# = x#
713   #-}
714
715 {-# RULES
716 "plusDouble x 0.0"   forall x#. (+##) x#    0.0## = x#
717 "plusDouble 0.0 x"   forall x#. (+##) 0.0## x#    = x#
718 "minusDouble x 0.0"  forall x#. (-##) x#    0.0## = x#
719 "minusDouble x x"    forall x#. (-##) x#    x#    = 0.0##
720 "timesDouble x 0.0"  forall x#. (*##) x#    0.0## = 0.0##
721 "timesDouble 0.0 x"  forall x#. (*##) 0.0## x#    = 0.0##
722 "timesDouble x 1.0"  forall x#. (*##) x#    1.0## = x#
723 "timesDouble 1.0 x"  forall x#. (*##) 1.0## x#    = x#
724 "divideDouble x 1.0" forall x#. (/##) x#    1.0## = x#
725   #-}
726
727 -- Wrappers for the shift operations.  The uncheckedShift# family are
728 -- undefined when the amount being shifted by is greater than the size
729 -- in bits of Int#, so these wrappers perform a check and return
730 -- either zero or -1 appropriately.
731 --
732 -- Note that these wrappers still produce undefined results when the
733 -- second argument (the shift amount) is negative.
734
735 shiftL#, shiftRL# :: Word# -> Int# -> Word#
736
737 a `shiftL#` b   | b >=# WORD_SIZE_IN_BITS# = int2Word# 0#
738                 | otherwise                = a `uncheckedShiftL#` b
739
740 a `shiftRL#` b  | b >=# WORD_SIZE_IN_BITS# = int2Word# 0#
741                 | otherwise                = a `uncheckedShiftRL#` b
742
743 iShiftL#, iShiftRA#, iShiftRL# :: Int# -> Int# -> Int#
744
745 a `iShiftL#` b  | b >=# WORD_SIZE_IN_BITS# = 0#
746                 | otherwise                = a `uncheckedIShiftL#` b
747
748 a `iShiftRA#` b | b >=# WORD_SIZE_IN_BITS# = if a <# 0# then (-1#) else 0#
749                 | otherwise                = a `uncheckedIShiftRA#` b
750
751 a `iShiftRL#` b | b >=# WORD_SIZE_IN_BITS# = 0#
752                 | otherwise                = a `uncheckedIShiftRL#` b
753
754 #if WORD_SIZE_IN_BITS == 32
755 {-# RULES
756 "narrow32Int#"  forall x#. narrow32Int#   x# = x#
757 "narrow32Word#" forall x#. narrow32Word#   x# = x#
758    #-}
759 #endif
760
761 {-# RULES
762 "int2Word2Int"  forall x#. int2Word# (word2Int# x#) = x#
763 "word2Int2Word" forall x#. word2Int# (int2Word# x#) = x#
764   #-}
765 \end{code}
766
767
768 %********************************************************
769 %*                                                      *
770 \subsection{Unpacking C strings}
771 %*                                                      *
772 %********************************************************
773
774 This code is needed for virtually all programs, since it's used for
775 unpacking the strings of error messages.
776
777 \begin{code}
778 unpackCString# :: Addr# -> [Char]
779 {-# NOINLINE [1] unpackCString# #-}
780 unpackCString# a = unpackCStringList# a
781
782 unpackCStringList# :: Addr# -> [Char]
783 unpackCStringList# addr 
784   = unpack 0#
785   where
786     unpack nh
787       | ch `eqChar#` '\0'# = []
788       | otherwise          = C# ch : unpack (nh +# 1#)
789       where
790         ch = indexCharOffAddr# addr nh
791
792 unpackAppendCString# :: Addr# -> [Char] -> [Char]
793 unpackAppendCString# addr rest
794   = unpack 0#
795   where
796     unpack nh
797       | ch `eqChar#` '\0'# = rest
798       | otherwise          = C# ch : unpack (nh +# 1#)
799       where
800         ch = indexCharOffAddr# addr nh
801
802 unpackFoldrCString# :: Addr# -> (Char  -> a -> a) -> a -> a 
803 {-# NOINLINE [0] unpackFoldrCString# #-}
804 -- Don't inline till right at the end;
805 -- usually the unpack-list rule turns it into unpackCStringList
806 unpackFoldrCString# addr f z 
807   = unpack 0#
808   where
809     unpack nh
810       | ch `eqChar#` '\0'# = z
811       | otherwise          = C# ch `f` unpack (nh +# 1#)
812       where
813         ch = indexCharOffAddr# addr nh
814
815 unpackCStringUtf8# :: Addr# -> [Char]
816 unpackCStringUtf8# addr 
817   = unpack 0#
818   where
819     unpack nh
820       | ch `eqChar#` '\0'#   = []
821       | ch `leChar#` '\x7F'# = C# ch : unpack (nh +# 1#)
822       | ch `leChar#` '\xDF'# =
823           C# (chr# ((ord# ch                                  -# 0xC0#) `uncheckedIShiftL#`  6# +#
824                     (ord# (indexCharOffAddr# addr (nh +# 1#)) -# 0x80#))) :
825           unpack (nh +# 2#)
826       | ch `leChar#` '\xEF'# =
827           C# (chr# ((ord# ch                                  -# 0xE0#) `uncheckedIShiftL#` 12# +#
828                     (ord# (indexCharOffAddr# addr (nh +# 1#)) -# 0x80#) `uncheckedIShiftL#`  6# +#
829                     (ord# (indexCharOffAddr# addr (nh +# 2#)) -# 0x80#))) :
830           unpack (nh +# 3#)
831       | otherwise            =
832           C# (chr# ((ord# ch                                  -# 0xF0#) `uncheckedIShiftL#` 18# +#
833                     (ord# (indexCharOffAddr# addr (nh +# 1#)) -# 0x80#) `uncheckedIShiftL#` 12# +#
834                     (ord# (indexCharOffAddr# addr (nh +# 2#)) -# 0x80#) `uncheckedIShiftL#`  6# +#
835                     (ord# (indexCharOffAddr# addr (nh +# 3#)) -# 0x80#))) :
836           unpack (nh +# 4#)
837       where
838         ch = indexCharOffAddr# addr nh
839
840 unpackNBytes# :: Addr# -> Int# -> [Char]
841 unpackNBytes# _addr 0#   = []
842 unpackNBytes#  addr len# = unpack [] (len# -# 1#)
843     where
844      unpack acc i#
845       | i# <# 0#  = acc
846       | otherwise = 
847          case indexCharOffAddr# addr i# of
848             ch -> unpack (C# ch : acc) (i# -# 1#)
849
850 {-# RULES
851 "unpack"       [~1] forall a   . unpackCString# a                  = build (unpackFoldrCString# a)
852 "unpack-list"  [1]  forall a   . unpackFoldrCString# a (:) [] = unpackCStringList# a
853 "unpack-append"     forall a n . unpackFoldrCString# a (:) n  = unpackAppendCString# a n
854
855 -- There's a built-in rule (in GHC.Rules.lhs) for
856 --      unpackFoldr "foo" c (unpackFoldr "baz" c n)  =  unpackFoldr "foobaz" c n
857
858   #-}
859 \end{code}