ffc3b065a78e9389eca0cd864eecdc36eab09a2f
[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 -- |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
513 zeroInt, oneInt, twoInt, maxInt, minInt :: Int
514 zeroInt = I# 0#
515 oneInt  = I# 1#
516 twoInt  = I# 2#
517
518 {- Seems clumsy. Should perhaps put minInt and MaxInt directly into MachDeps.h -}
519 #if WORD_SIZE_IN_BITS == 31
520 minInt  = I# (-0x40000000#)
521 maxInt  = I# 0x3FFFFFFF#
522 #elif WORD_SIZE_IN_BITS == 32
523 minInt  = I# (-0x80000000#)
524 maxInt  = I# 0x7FFFFFFF#
525 #else 
526 minInt  = I# (-0x8000000000000000#)
527 maxInt  = I# 0x7FFFFFFFFFFFFFFF#
528 #endif
529
530 instance Eq Int where
531     (==) = eqInt
532     (/=) = neInt
533
534 instance Ord Int where
535     compare = compareInt
536     (<)     = ltInt
537     (<=)    = leInt
538     (>=)    = geInt
539     (>)     = gtInt
540
541 compareInt :: Int -> Int -> Ordering
542 (I# x#) `compareInt` (I# y#) = compareInt# x# y#
543
544 compareInt# :: Int# -> Int# -> Ordering
545 compareInt# x# y#
546     | x# <#  y# = LT
547     | x# ==# y# = EQ
548     | otherwise = GT
549 \end{code}
550
551
552 %*********************************************************
553 %*                                                      *
554 \subsection{The function type}
555 %*                                                      *
556 %*********************************************************
557
558 \begin{code}
559 -- identity function
560 id                      :: a -> a
561 id x                    =  x
562
563 -- constant function
564 const                   :: a -> b -> a
565 const x _               =  x
566
567 -- function composition
568 {-# INLINE (.) #-}
569 (.)       :: (b -> c) -> (a -> b) -> a -> c
570 (.) f g x = f (g x)
571
572 -- flip f  takes its (first) two arguments in the reverse order of f.
573 flip                    :: (a -> b -> c) -> b -> a -> c
574 flip f x y              =  f y x
575
576 -- right-associating infix application operator (useful in continuation-
577 -- passing style)
578 {-# INLINE ($) #-}
579 ($)                     :: (a -> b) -> a -> b
580 f $ x                   =  f x
581
582 -- until p f  yields the result of applying f until p holds.
583 until                   :: (a -> Bool) -> (a -> a) -> a -> a
584 until p f x | p x       =  x
585             | otherwise =  until p f (f x)
586
587 -- asTypeOf is a type-restricted version of const.  It is usually used
588 -- as an infix operator, and its typing forces its first argument
589 -- (which is usually overloaded) to have the same type as the second.
590 asTypeOf                :: a -> a -> a
591 asTypeOf                =  const
592 \end{code}
593
594 %*********************************************************
595 %*                                                      *
596 \subsection{CCallable instances}
597 %*                                                      *
598 %*********************************************************
599
600 Defined here to avoid orphans
601
602 \begin{code}
603 instance CCallable Char
604 instance CReturnable Char
605
606 instance CCallable   Int
607 instance CReturnable Int
608
609 instance CReturnable () -- Why, exactly?
610 \end{code}
611
612
613 %*********************************************************
614 %*                                                      *
615 \subsection{Generics}
616 %*                                                      *
617 %*********************************************************
618
619 \begin{code}
620 data Unit = Unit
621 #ifndef __HADDOCK__
622 data (:+:) a b = Inl a | Inr b
623 data (:*:) a b = a :*: b
624 #endif
625 \end{code}
626
627
628 %*********************************************************
629 %*                                                      *
630 \subsection{Numeric primops}
631 %*                                                      *
632 %*********************************************************
633
634 \begin{code}
635 divInt#, modInt# :: Int# -> Int# -> Int#
636 x# `divInt#` y#
637     | (x# ># 0#) && (y# <# 0#) = ((x# -# y#) -# 1#) `quotInt#` y#
638     | (x# <# 0#) && (y# ># 0#) = ((x# -# y#) +# 1#) `quotInt#` y#
639     | otherwise                = x# `quotInt#` y#
640 x# `modInt#` y#
641     | (x# ># 0#) && (y# <# 0#) ||
642       (x# <# 0#) && (y# ># 0#)    = if r# /=# 0# then r# +# y# else 0#
643     | otherwise                   = r#
644     where
645     r# = x# `remInt#` y#
646 \end{code}
647
648 Definitions of the boxed PrimOps; these will be
649 used in the case of partial applications, etc.
650
651 \begin{code}
652 {-# INLINE eqInt #-}
653 {-# INLINE neInt #-}
654 {-# INLINE gtInt #-}
655 {-# INLINE geInt #-}
656 {-# INLINE ltInt #-}
657 {-# INLINE leInt #-}
658 {-# INLINE plusInt #-}
659 {-# INLINE minusInt #-}
660 {-# INLINE timesInt #-}
661 {-# INLINE quotInt #-}
662 {-# INLINE remInt #-}
663 {-# INLINE negateInt #-}
664
665 plusInt, minusInt, timesInt, quotInt, remInt, divInt, modInt, gcdInt :: Int -> Int -> Int
666 (I# x) `plusInt`  (I# y) = I# (x +# y)
667 (I# x) `minusInt` (I# y) = I# (x -# y)
668 (I# x) `timesInt` (I# y) = I# (x *# y)
669 (I# x) `quotInt`  (I# y) = I# (x `quotInt#` y)
670 (I# x) `remInt`   (I# y) = I# (x `remInt#`  y)
671 (I# x) `divInt`   (I# y) = I# (x `divInt#`  y)
672 (I# x) `modInt`   (I# y) = I# (x `modInt#`  y)
673
674 {-# RULES
675 "x# +# 0#" forall x#. x# +# 0# = x#
676 "0# +# x#" forall x#. 0# +# x# = x#
677 "x# -# 0#" forall x#. x# -# 0# = x#
678 "x# -# x#" forall x#. x# -# x# = 0#
679 "x# *# 0#" forall x#. x# *# 0# = 0#
680 "0# *# x#" forall x#. 0# *# x# = 0#
681 "x# *# 1#" forall x#. x# *# 1# = x#
682 "1# *# x#" forall x#. 1# *# x# = x#
683   #-}
684
685 gcdInt (I# a) (I# b) = g a b
686    where g 0# 0# = error "GHC.Base.gcdInt: gcd 0 0 is undefined"
687          g 0# _  = I# absB
688          g _  0# = I# absA
689          g _  _  = I# (gcdInt# absA absB)
690
691          absInt x = if x <# 0# then negateInt# x else x
692
693          absA     = absInt a
694          absB     = absInt b
695
696 negateInt :: Int -> Int
697 negateInt (I# x) = I# (negateInt# x)
698
699 gtInt, geInt, eqInt, neInt, ltInt, leInt :: Int -> Int -> Bool
700 (I# x) `gtInt` (I# y) = x >#  y
701 (I# x) `geInt` (I# y) = x >=# y
702 (I# x) `eqInt` (I# y) = x ==# y
703 (I# x) `neInt` (I# y) = x /=# y
704 (I# x) `ltInt` (I# y) = x <#  y
705 (I# x) `leInt` (I# y) = x <=# y
706
707 {-# RULES
708 "x# ># x#"  forall x#. x# >#  x# = False
709 "x# >=# x#" forall x#. x# >=# x# = True
710 "x# ==# x#" forall x#. x# ==# x# = True
711 "x# /=# x#" forall x#. x# /=# x# = False
712 "x# <# x#"  forall x#. x# <#  x# = False
713 "x# <=# x#" forall x#. x# <=# x# = True
714   #-}
715
716 {-# RULES
717 "plusFloat x 0.0"   forall x#. plusFloat#  x#   0.0# = x#
718 "plusFloat 0.0 x"   forall x#. plusFloat#  0.0# x#   = x#
719 "minusFloat x 0.0"  forall x#. minusFloat# x#   0.0# = x#
720 "minusFloat x x"    forall x#. minusFloat# x#   x#   = 0.0#
721 "timesFloat x 0.0"  forall x#. timesFloat# x#   0.0# = 0.0#
722 "timesFloat0.0 x"   forall x#. timesFloat# 0.0# x#   = 0.0#
723 "timesFloat x 1.0"  forall x#. timesFloat# x#   1.0# = x#
724 "timesFloat 1.0 x"  forall x#. timesFloat# 1.0# x#   = x#
725 "divideFloat x 1.0" forall x#. divideFloat# x#  1.0# = x#
726   #-}
727
728 {-# RULES
729 "plusDouble x 0.0"   forall x#. (+##) x#    0.0## = x#
730 "plusDouble 0.0 x"   forall x#. (+##) 0.0## x#    = x#
731 "minusDouble x 0.0"  forall x#. (-##) x#    0.0## = x#
732 "minusDouble x x"    forall x#. (-##) x#    x#    = 0.0##
733 "timesDouble x 0.0"  forall x#. (*##) x#    0.0## = 0.0##
734 "timesDouble 0.0 x"  forall x#. (*##) 0.0## x#    = 0.0##
735 "timesDouble x 1.0"  forall x#. (*##) x#    1.0## = x#
736 "timesDouble 1.0 x"  forall x#. (*##) 1.0## x#    = x#
737 "divideDouble x 1.0" forall x#. (/##) x#    1.0## = x#
738   #-}
739
740 -- Wrappers for the shift operations.  The uncheckedShift# family are
741 -- undefined when the amount being shifted by is greater than the size
742 -- in bits of Int#, so these wrappers perform a check and return
743 -- either zero or -1 appropriately.
744 --
745 -- Note that these wrappers still produce undefined results when the
746 -- second argument (the shift amount) is negative.
747
748 shiftL#, shiftRL# :: Word# -> Int# -> Word#
749
750 a `shiftL#` b   | b >=# WORD_SIZE_IN_BITS# = int2Word# 0#
751                 | otherwise                = a `uncheckedShiftL#` b
752
753 a `shiftRL#` b  | b >=# WORD_SIZE_IN_BITS# = int2Word# 0#
754                 | otherwise                = a `uncheckedShiftRL#` b
755
756 iShiftL#, iShiftRA#, iShiftRL# :: Int# -> Int# -> Int#
757
758 a `iShiftL#` b  | b >=# WORD_SIZE_IN_BITS# = 0#
759                 | otherwise                = a `uncheckedIShiftL#` b
760
761 a `iShiftRA#` b | b >=# WORD_SIZE_IN_BITS# = if a <# 0# then (-1#) else 0#
762                 | otherwise                = a `uncheckedIShiftRA#` b
763
764 a `iShiftRL#` b | b >=# WORD_SIZE_IN_BITS# = 0#
765                 | otherwise                = a `uncheckedIShiftRL#` b
766
767 #if WORD_SIZE_IN_BITS == 32
768 {-# RULES
769 "narrow32Int#"  forall x#. narrow32Int#   x# = x#
770 "narrow32Word#" forall x#. narrow32Word#   x# = x#
771    #-}
772 #endif
773
774 {-# RULES
775 "int2Word2Int"  forall x#. int2Word# (word2Int# x#) = x#
776 "word2Int2Word" forall x#. word2Int# (int2Word# x#) = x#
777   #-}
778 \end{code}
779
780
781 %********************************************************
782 %*                                                      *
783 \subsection{Unpacking C strings}
784 %*                                                      *
785 %********************************************************
786
787 This code is needed for virtually all programs, since it's used for
788 unpacking the strings of error messages.
789
790 \begin{code}
791 unpackCString# :: Addr# -> [Char]
792 {-# NOINLINE [1] unpackCString# #-}
793 unpackCString# addr 
794   = unpack 0#
795   where
796     unpack nh
797       | ch `eqChar#` '\0'# = []
798       | otherwise          = C# ch : unpack (nh +# 1#)
799       where
800         ch = indexCharOffAddr# addr nh
801
802 unpackAppendCString# :: Addr# -> [Char] -> [Char]
803 unpackAppendCString# addr rest
804   = unpack 0#
805   where
806     unpack nh
807       | ch `eqChar#` '\0'# = rest
808       | otherwise          = C# ch : unpack (nh +# 1#)
809       where
810         ch = indexCharOffAddr# addr nh
811
812 unpackFoldrCString# :: Addr# -> (Char  -> a -> a) -> a -> a 
813 {-# NOINLINE [0] unpackFoldrCString# #-}
814 -- Don't inline till right at the end;
815 -- usually the unpack-list rule turns it into unpackCStringList
816 unpackFoldrCString# addr f z 
817   = unpack 0#
818   where
819     unpack nh
820       | ch `eqChar#` '\0'# = z
821       | otherwise          = C# ch `f` unpack (nh +# 1#)
822       where
823         ch = indexCharOffAddr# addr nh
824
825 unpackCStringUtf8# :: Addr# -> [Char]
826 unpackCStringUtf8# addr 
827   = unpack 0#
828   where
829     unpack nh
830       | ch `eqChar#` '\0'#   = []
831       | ch `leChar#` '\x7F'# = C# ch : unpack (nh +# 1#)
832       | ch `leChar#` '\xDF'# =
833           C# (chr# ((ord# ch                                  -# 0xC0#) `uncheckedIShiftL#`  6# +#
834                     (ord# (indexCharOffAddr# addr (nh +# 1#)) -# 0x80#))) :
835           unpack (nh +# 2#)
836       | ch `leChar#` '\xEF'# =
837           C# (chr# ((ord# ch                                  -# 0xE0#) `uncheckedIShiftL#` 12# +#
838                     (ord# (indexCharOffAddr# addr (nh +# 1#)) -# 0x80#) `uncheckedIShiftL#`  6# +#
839                     (ord# (indexCharOffAddr# addr (nh +# 2#)) -# 0x80#))) :
840           unpack (nh +# 3#)
841       | otherwise            =
842           C# (chr# ((ord# ch                                  -# 0xF0#) `uncheckedIShiftL#` 18# +#
843                     (ord# (indexCharOffAddr# addr (nh +# 1#)) -# 0x80#) `uncheckedIShiftL#` 12# +#
844                     (ord# (indexCharOffAddr# addr (nh +# 2#)) -# 0x80#) `uncheckedIShiftL#`  6# +#
845                     (ord# (indexCharOffAddr# addr (nh +# 3#)) -# 0x80#))) :
846           unpack (nh +# 4#)
847       where
848         ch = indexCharOffAddr# addr nh
849
850 unpackNBytes# :: Addr# -> Int# -> [Char]
851 unpackNBytes# _addr 0#   = []
852 unpackNBytes#  addr len# = unpack [] (len# -# 1#)
853     where
854      unpack acc i#
855       | i# <# 0#  = acc
856       | otherwise = 
857          case indexCharOffAddr# addr i# of
858             ch -> unpack (C# ch : acc) (i# -# 1#)
859
860 {-# RULES
861 "unpack"       [~1] forall a   . unpackCString# a                  = build (unpackFoldrCString# a)
862 "unpack-list"  [1]  forall a   . unpackFoldrCString# a (:) [] = unpackCString# a
863 "unpack-append"     forall a n . unpackFoldrCString# a (:) n  = unpackAppendCString# a n
864
865 -- There's a built-in rule (in PrelRules.lhs) for
866 --      unpackFoldr "foo" c (unpackFoldr "baz" c n)  =  unpackFoldr "foobaz" c n
867
868   #-}
869 \end{code}