[project @ 2002-05-10 16:18:28 by simonmar]
[ghc-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 -- |The 'Bool' type is an enumeration.  It is defined with 'False'
372 -- first so that the corresponding 'Enum' instance will give @'fromEnum'
373 -- False@ the value zero, and @'fromEnum' True@ the value 1.
374 data  Bool  =  False | True  deriving (Eq, Ord)
375         -- Read in GHC.Read, Show in GHC.Show
376
377 -- Boolean functions
378
379 -- | Boolean \"and\"
380 (&&)                    :: Bool -> Bool -> Bool
381 True  && x              =  x
382 False && _              =  False
383
384 -- | Boolean \"or\"
385 (||)                    :: Bool -> Bool -> Bool
386 True  || _              =  True
387 False || x              =  x
388
389 -- | Boolean \"not\"
390 not                     :: Bool -> Bool
391 not True                =  False
392 not False               =  True
393
394 -- |'otherwise' is defined as the value 'True'; it helps to make
395 -- guards more readable.  eg.
396 --
397 -- >  f x | x \< 0     = ...
398 -- >      | otherwise = ...
399 otherwise               :: Bool
400 otherwise               =  True
401 \end{code}
402
403
404 %*********************************************************
405 %*                                                      *
406 \subsection{The @()@ type}
407 %*                                                      *
408 %*********************************************************
409
410 The Unit type is here because virtually any program needs it (whereas
411 some programs may get away without consulting GHC.Tup).  Furthermore,
412 the renamer currently *always* asks for () to be in scope, so that
413 ccalls can use () as their default type; so when compiling GHC.Base we
414 need ().  (We could arrange suck in () only if -fglasgow-exts, but putting
415 it here seems more direct.)
416
417 \begin{code}
418 data () = ()
419
420 instance Eq () where
421     () == () = True
422     () /= () = False
423
424 instance Ord () where
425     () <= () = True
426     () <  () = False
427     () >= () = True
428     () >  () = False
429     max () () = ()
430     min () () = ()
431     compare () () = EQ
432 \end{code}
433
434
435 %*********************************************************
436 %*                                                      *
437 \subsection{Type @Ordering@}
438 %*                                                      *
439 %*********************************************************
440
441 \begin{code}
442 data Ordering = LT | EQ | GT deriving (Eq, Ord)
443         -- Read in GHC.Read, Show in GHC.Show
444 \end{code}
445
446
447 %*********************************************************
448 %*                                                      *
449 \subsection{Type @Char@ and @String@}
450 %*                                                      *
451 %*********************************************************
452
453 \begin{code}
454 type String = [Char]
455
456 data Char = C# Char#
457
458 -- We don't use deriving for Eq and Ord, because for Ord the derived
459 -- instance defines only compare, which takes two primops.  Then
460 -- '>' uses compare, and therefore takes two primops instead of one.
461
462 instance Eq Char where
463     (C# c1) == (C# c2) = c1 `eqChar#` c2
464     (C# c1) /= (C# c2) = c1 `neChar#` c2
465
466 instance Ord Char where
467     (C# c1) >  (C# c2) = c1 `gtChar#` c2
468     (C# c1) >= (C# c2) = c1 `geChar#` c2
469     (C# c1) <= (C# c2) = c1 `leChar#` c2
470     (C# c1) <  (C# c2) = c1 `ltChar#` c2
471
472 {-# RULES
473 "x# `eqChar#` x#" forall x#. x# `eqChar#` x# = True
474 "x# `neChar#` x#" forall x#. x# `neChar#` x# = False
475 "x# `gtChar#` x#" forall x#. x# `gtChar#` x# = False
476 "x# `geChar#` x#" forall x#. x# `geChar#` x# = True
477 "x# `leChar#` x#" forall x#. x# `leChar#` x# = True
478 "x# `ltChar#` x#" forall x#. x# `ltChar#` x# = False
479   #-}
480
481 chr :: Int -> Char
482 chr (I# i#) | int2Word# i# `leWord#` int2Word# 0x10FFFF# = C# (chr# i#)
483             | otherwise                                  = error "Prelude.chr: bad argument"
484
485 unsafeChr :: Int -> Char
486 unsafeChr (I# i#) = C# (chr# i#)
487
488 ord :: Char -> Int
489 ord (C# c#) = I# (ord# c#)
490 \end{code}
491
492 String equality is used when desugaring pattern-matches against strings.
493
494 \begin{code}
495 eqString :: String -> String -> Bool
496 eqString []       []       = True
497 eqString (c1:cs1) (c2:cs2) = c1 == c2 && cs1 `eqString` cs2
498 eqString cs1      cs2      = False
499
500 {-# RULES "eqString" (==) = eqString #-}
501 \end{code}
502
503
504 %*********************************************************
505 %*                                                      *
506 \subsection{Type @Int@}
507 %*                                                      *
508 %*********************************************************
509
510 \begin{code}
511 data Int = I# Int#
512 -- ^A fixed-precision integer type with at least the range @[-2^29
513 -- .. 2^29-1]@.  The exact range for a given implementation can be
514 -- determined by using 'minBound' and 'maxBound' from the 'Bounded'
515 -- class.
516
517 zeroInt, oneInt, twoInt, maxInt, minInt :: Int
518 zeroInt = I# 0#
519 oneInt  = I# 1#
520 twoInt  = I# 2#
521
522 {- Seems clumsy. Should perhaps put minInt and MaxInt directly into MachDeps.h -}
523 #if WORD_SIZE_IN_BITS == 31
524 minInt  = I# (-0x40000000#)
525 maxInt  = I# 0x3FFFFFFF#
526 #elif WORD_SIZE_IN_BITS == 32
527 minInt  = I# (-0x80000000#)
528 maxInt  = I# 0x7FFFFFFF#
529 #else 
530 minInt  = I# (-0x8000000000000000#)
531 maxInt  = I# 0x7FFFFFFFFFFFFFFF#
532 #endif
533
534 instance Eq Int where
535     (==) = eqInt
536     (/=) = neInt
537
538 instance Ord Int where
539     compare = compareInt
540     (<)     = ltInt
541     (<=)    = leInt
542     (>=)    = geInt
543     (>)     = gtInt
544
545 compareInt :: Int -> Int -> Ordering
546 (I# x#) `compareInt` (I# y#) = compareInt# x# y#
547
548 compareInt# :: Int# -> Int# -> Ordering
549 compareInt# x# y#
550     | x# <#  y# = LT
551     | x# ==# y# = EQ
552     | otherwise = GT
553 \end{code}
554
555
556 %*********************************************************
557 %*                                                      *
558 \subsection{The function type}
559 %*                                                      *
560 %*********************************************************
561
562 \begin{code}
563 -- identity function
564 id                      :: a -> a
565 id x                    =  x
566
567 -- constant function
568 const                   :: a -> b -> a
569 const x _               =  x
570
571 -- function composition
572 {-# INLINE (.) #-}
573 (.)       :: (b -> c) -> (a -> b) -> a -> c
574 (.) f g x = f (g x)
575
576 -- flip f  takes its (first) two arguments in the reverse order of f.
577 flip                    :: (a -> b -> c) -> b -> a -> c
578 flip f x y              =  f y x
579
580 -- right-associating infix application operator (useful in continuation-
581 -- passing style)
582 {-# INLINE ($) #-}
583 ($)                     :: (a -> b) -> a -> b
584 f $ x                   =  f x
585
586 -- until p f  yields the result of applying f until p holds.
587 until                   :: (a -> Bool) -> (a -> a) -> a -> a
588 until p f x | p x       =  x
589             | otherwise =  until p f (f x)
590
591 -- asTypeOf is a type-restricted version of const.  It is usually used
592 -- as an infix operator, and its typing forces its first argument
593 -- (which is usually overloaded) to have the same type as the second.
594 asTypeOf                :: a -> a -> a
595 asTypeOf                =  const
596 \end{code}
597
598 %*********************************************************
599 %*                                                      *
600 \subsection{CCallable instances}
601 %*                                                      *
602 %*********************************************************
603
604 Defined here to avoid orphans
605
606 \begin{code}
607 instance CCallable Char
608 instance CReturnable Char
609
610 instance CCallable   Int
611 instance CReturnable Int
612
613 instance CReturnable () -- Why, exactly?
614 \end{code}
615
616
617 %*********************************************************
618 %*                                                      *
619 \subsection{Generics}
620 %*                                                      *
621 %*********************************************************
622
623 \begin{code}
624 data Unit = Unit
625 #ifndef __HADDOCK__
626 data (:+:) a b = Inl a | Inr b
627 data (:*:) a b = a :*: b
628 #endif
629 \end{code}
630
631
632 %*********************************************************
633 %*                                                      *
634 \subsection{Numeric primops}
635 %*                                                      *
636 %*********************************************************
637
638 \begin{code}
639 divInt#, modInt# :: Int# -> Int# -> Int#
640 x# `divInt#` y#
641     | (x# ># 0#) && (y# <# 0#) = ((x# -# y#) -# 1#) `quotInt#` y#
642     | (x# <# 0#) && (y# ># 0#) = ((x# -# y#) +# 1#) `quotInt#` y#
643     | otherwise                = x# `quotInt#` y#
644 x# `modInt#` y#
645     | (x# ># 0#) && (y# <# 0#) ||
646       (x# <# 0#) && (y# ># 0#)    = if r# /=# 0# then r# +# y# else 0#
647     | otherwise                   = r#
648     where
649     r# = x# `remInt#` y#
650 \end{code}
651
652 Definitions of the boxed PrimOps; these will be
653 used in the case of partial applications, etc.
654
655 \begin{code}
656 {-# INLINE eqInt #-}
657 {-# INLINE neInt #-}
658 {-# INLINE gtInt #-}
659 {-# INLINE geInt #-}
660 {-# INLINE ltInt #-}
661 {-# INLINE leInt #-}
662 {-# INLINE plusInt #-}
663 {-# INLINE minusInt #-}
664 {-# INLINE timesInt #-}
665 {-# INLINE quotInt #-}
666 {-# INLINE remInt #-}
667 {-# INLINE negateInt #-}
668
669 plusInt, minusInt, timesInt, quotInt, remInt, divInt, modInt, gcdInt :: Int -> Int -> Int
670 (I# x) `plusInt`  (I# y) = I# (x +# y)
671 (I# x) `minusInt` (I# y) = I# (x -# y)
672 (I# x) `timesInt` (I# y) = I# (x *# y)
673 (I# x) `quotInt`  (I# y) = I# (x `quotInt#` y)
674 (I# x) `remInt`   (I# y) = I# (x `remInt#`  y)
675 (I# x) `divInt`   (I# y) = I# (x `divInt#`  y)
676 (I# x) `modInt`   (I# y) = I# (x `modInt#`  y)
677
678 {-# RULES
679 "x# +# 0#" forall x#. x# +# 0# = x#
680 "0# +# x#" forall x#. 0# +# x# = x#
681 "x# -# 0#" forall x#. x# -# 0# = x#
682 "x# -# x#" forall x#. x# -# x# = 0#
683 "x# *# 0#" forall x#. x# *# 0# = 0#
684 "0# *# x#" forall x#. 0# *# x# = 0#
685 "x# *# 1#" forall x#. x# *# 1# = x#
686 "1# *# x#" forall x#. 1# *# x# = x#
687   #-}
688
689 gcdInt (I# a) (I# b) = g a b
690    where g 0# 0# = error "GHC.Base.gcdInt: gcd 0 0 is undefined"
691          g 0# _  = I# absB
692          g _  0# = I# absA
693          g _  _  = I# (gcdInt# absA absB)
694
695          absInt x = if x <# 0# then negateInt# x else x
696
697          absA     = absInt a
698          absB     = absInt b
699
700 negateInt :: Int -> Int
701 negateInt (I# x) = I# (negateInt# x)
702
703 gtInt, geInt, eqInt, neInt, ltInt, leInt :: Int -> Int -> Bool
704 (I# x) `gtInt` (I# y) = x >#  y
705 (I# x) `geInt` (I# y) = x >=# y
706 (I# x) `eqInt` (I# y) = x ==# y
707 (I# x) `neInt` (I# y) = x /=# y
708 (I# x) `ltInt` (I# y) = x <#  y
709 (I# x) `leInt` (I# y) = x <=# y
710
711 {-# RULES
712 "x# ># x#"  forall x#. x# >#  x# = False
713 "x# >=# x#" forall x#. x# >=# x# = True
714 "x# ==# x#" forall x#. x# ==# x# = True
715 "x# /=# x#" forall x#. x# /=# x# = False
716 "x# <# x#"  forall x#. x# <#  x# = False
717 "x# <=# x#" forall x#. x# <=# x# = True
718   #-}
719
720 {-# RULES
721 "plusFloat x 0.0"   forall x#. plusFloat#  x#   0.0# = x#
722 "plusFloat 0.0 x"   forall x#. plusFloat#  0.0# x#   = x#
723 "minusFloat x 0.0"  forall x#. minusFloat# x#   0.0# = x#
724 "minusFloat x x"    forall x#. minusFloat# x#   x#   = 0.0#
725 "timesFloat x 0.0"  forall x#. timesFloat# x#   0.0# = 0.0#
726 "timesFloat0.0 x"   forall x#. timesFloat# 0.0# x#   = 0.0#
727 "timesFloat x 1.0"  forall x#. timesFloat# x#   1.0# = x#
728 "timesFloat 1.0 x"  forall x#. timesFloat# 1.0# x#   = x#
729 "divideFloat x 1.0" forall x#. divideFloat# x#  1.0# = x#
730   #-}
731
732 {-# RULES
733 "plusDouble x 0.0"   forall x#. (+##) x#    0.0## = x#
734 "plusDouble 0.0 x"   forall x#. (+##) 0.0## x#    = x#
735 "minusDouble x 0.0"  forall x#. (-##) x#    0.0## = x#
736 "minusDouble x x"    forall x#. (-##) x#    x#    = 0.0##
737 "timesDouble x 0.0"  forall x#. (*##) x#    0.0## = 0.0##
738 "timesDouble 0.0 x"  forall x#. (*##) 0.0## x#    = 0.0##
739 "timesDouble x 1.0"  forall x#. (*##) x#    1.0## = x#
740 "timesDouble 1.0 x"  forall x#. (*##) 1.0## x#    = x#
741 "divideDouble x 1.0" forall x#. (/##) x#    1.0## = x#
742   #-}
743
744 -- Wrappers for the shift operations.  The uncheckedShift# family are
745 -- undefined when the amount being shifted by is greater than the size
746 -- in bits of Int#, so these wrappers perform a check and return
747 -- either zero or -1 appropriately.
748 --
749 -- Note that these wrappers still produce undefined results when the
750 -- second argument (the shift amount) is negative.
751
752 shiftL#, shiftRL# :: Word# -> Int# -> Word#
753
754 a `shiftL#` b   | b >=# WORD_SIZE_IN_BITS# = int2Word# 0#
755                 | otherwise                = a `uncheckedShiftL#` b
756
757 a `shiftRL#` b  | b >=# WORD_SIZE_IN_BITS# = int2Word# 0#
758                 | otherwise                = a `uncheckedShiftRL#` b
759
760 iShiftL#, iShiftRA#, iShiftRL# :: Int# -> Int# -> Int#
761
762 a `iShiftL#` b  | b >=# WORD_SIZE_IN_BITS# = 0#
763                 | otherwise                = a `uncheckedIShiftL#` b
764
765 a `iShiftRA#` b | b >=# WORD_SIZE_IN_BITS# = if a <# 0# then (-1#) else 0#
766                 | otherwise                = a `uncheckedIShiftRA#` b
767
768 a `iShiftRL#` b | b >=# WORD_SIZE_IN_BITS# = 0#
769                 | otherwise                = a `uncheckedIShiftRL#` b
770
771 #if WORD_SIZE_IN_BITS == 32
772 {-# RULES
773 "narrow32Int#"  forall x#. narrow32Int#   x# = x#
774 "narrow32Word#" forall x#. narrow32Word#   x# = x#
775    #-}
776 #endif
777
778 {-# RULES
779 "int2Word2Int"  forall x#. int2Word# (word2Int# x#) = x#
780 "word2Int2Word" forall x#. word2Int# (int2Word# x#) = x#
781   #-}
782 \end{code}
783
784
785 %********************************************************
786 %*                                                      *
787 \subsection{Unpacking C strings}
788 %*                                                      *
789 %********************************************************
790
791 This code is needed for virtually all programs, since it's used for
792 unpacking the strings of error messages.
793
794 \begin{code}
795 unpackCString# :: Addr# -> [Char]
796 {-# NOINLINE [1] unpackCString# #-}
797 unpackCString# addr 
798   = unpack 0#
799   where
800     unpack nh
801       | ch `eqChar#` '\0'# = []
802       | otherwise          = C# ch : unpack (nh +# 1#)
803       where
804         ch = indexCharOffAddr# addr nh
805
806 unpackAppendCString# :: Addr# -> [Char] -> [Char]
807 unpackAppendCString# addr rest
808   = unpack 0#
809   where
810     unpack nh
811       | ch `eqChar#` '\0'# = rest
812       | otherwise          = C# ch : unpack (nh +# 1#)
813       where
814         ch = indexCharOffAddr# addr nh
815
816 unpackFoldrCString# :: Addr# -> (Char  -> a -> a) -> a -> a 
817 {-# NOINLINE [0] unpackFoldrCString# #-}
818 -- Don't inline till right at the end;
819 -- usually the unpack-list rule turns it into unpackCStringList
820 unpackFoldrCString# addr f z 
821   = unpack 0#
822   where
823     unpack nh
824       | ch `eqChar#` '\0'# = z
825       | otherwise          = C# ch `f` unpack (nh +# 1#)
826       where
827         ch = indexCharOffAddr# addr nh
828
829 unpackCStringUtf8# :: Addr# -> [Char]
830 unpackCStringUtf8# addr 
831   = unpack 0#
832   where
833     unpack nh
834       | ch `eqChar#` '\0'#   = []
835       | ch `leChar#` '\x7F'# = C# ch : unpack (nh +# 1#)
836       | ch `leChar#` '\xDF'# =
837           C# (chr# ((ord# ch                                  -# 0xC0#) `uncheckedIShiftL#`  6# +#
838                     (ord# (indexCharOffAddr# addr (nh +# 1#)) -# 0x80#))) :
839           unpack (nh +# 2#)
840       | ch `leChar#` '\xEF'# =
841           C# (chr# ((ord# ch                                  -# 0xE0#) `uncheckedIShiftL#` 12# +#
842                     (ord# (indexCharOffAddr# addr (nh +# 1#)) -# 0x80#) `uncheckedIShiftL#`  6# +#
843                     (ord# (indexCharOffAddr# addr (nh +# 2#)) -# 0x80#))) :
844           unpack (nh +# 3#)
845       | otherwise            =
846           C# (chr# ((ord# ch                                  -# 0xF0#) `uncheckedIShiftL#` 18# +#
847                     (ord# (indexCharOffAddr# addr (nh +# 1#)) -# 0x80#) `uncheckedIShiftL#` 12# +#
848                     (ord# (indexCharOffAddr# addr (nh +# 2#)) -# 0x80#) `uncheckedIShiftL#`  6# +#
849                     (ord# (indexCharOffAddr# addr (nh +# 3#)) -# 0x80#))) :
850           unpack (nh +# 4#)
851       where
852         ch = indexCharOffAddr# addr nh
853
854 unpackNBytes# :: Addr# -> Int# -> [Char]
855 unpackNBytes# _addr 0#   = []
856 unpackNBytes#  addr len# = unpack [] (len# -# 1#)
857     where
858      unpack acc i#
859       | i# <# 0#  = acc
860       | otherwise = 
861          case indexCharOffAddr# addr i# of
862             ch -> unpack (C# ch : acc) (i# -# 1#)
863
864 {-# RULES
865 "unpack"       [~1] forall a   . unpackCString# a                  = build (unpackFoldrCString# a)
866 "unpack-list"  [1]  forall a   . unpackFoldrCString# a (:) [] = unpackCString# a
867 "unpack-append"     forall a n . unpackFoldrCString# a (:) n  = unpackAppendCString# a n
868
869 -- There's a built-in rule (in PrelRules.lhs) for
870 --      unpackFoldr "foo" c (unpackFoldr "baz" c n)  =  unpackFoldr "foobaz" c n
871
872   #-}
873 \end{code}