2 % (c) The AQUA Project, Glasgow University, 1994-1996
5 \section[PrelNum]{Module @PrelNum@}
7 Numeric part of the prelude.
13 #include "../includes/ieee-flpt.h"
17 {-# OPTIONS -fno-implicit-prelude #-}
21 import {-# SOURCE #-} IOBase ( error )
27 infixl 7 %, `quot`, `rem`, `div`, `mod`
31 %*********************************************************
33 \subsection{Standard numeric classes}
35 %*********************************************************
38 class (Num a, Ord a) => Real a where
39 toRational :: a -> Rational
41 class (Real a, Enum a) => Integral a where
42 quot, rem, div, mod :: a -> a -> a
43 quotRem, divMod :: a -> a -> (a,a)
44 toInteger :: a -> Integer
45 toInt :: a -> Int -- partain: Glasgow extension
47 n `quot` d = q where (q,r) = quotRem n d
48 n `rem` d = r where (q,r) = quotRem n d
49 n `div` d = q where (q,r) = divMod n d
50 n `mod` d = r where (q,r) = divMod n d
51 divMod n d = if signum r == negate (signum d) then (q-1, r+d) else qr
52 where qr@(q,r) = quotRem n d
54 class (Num a) => Fractional a where
57 fromRational :: Rational -> a
61 class (Fractional a) => Floating a where
63 exp, log, sqrt :: a -> a
64 (**), logBase :: a -> a -> a
65 sin, cos, tan :: a -> a
66 asin, acos, atan :: a -> a
67 sinh, cosh, tanh :: a -> a
68 asinh, acosh, atanh :: a -> a
70 x ** y = exp (log x * y)
71 logBase x y = log y / log x
74 tanh x = sinh x / cosh x
76 class (Real a, Fractional a) => RealFrac a where
77 properFraction :: (Integral b) => a -> (b,a)
78 truncate, round :: (Integral b) => a -> b
79 ceiling, floor :: (Integral b) => a -> b
81 truncate x = m where (m,_) = properFraction x
83 round x = let (n,r) = properFraction x
84 m = if r < 0 then n - 1 else n + 1
85 in case signum (abs r - 0.5) of
87 0 -> if even n then n else m
90 ceiling x = if r > 0 then n + 1 else n
91 where (n,r) = properFraction x
93 floor x = if r < 0 then n - 1 else n
94 where (n,r) = properFraction x
96 class (RealFrac a, Floating a) => RealFloat a where
97 floatRadix :: a -> Integer
98 floatDigits :: a -> Int
99 floatRange :: a -> (Int,Int)
100 decodeFloat :: a -> (Integer,Int)
101 encodeFloat :: Integer -> Int -> a
103 significand :: a -> a
104 scaleFloat :: Int -> a -> a
105 isNaN, isInfinite, isDenormalized, isNegativeZero, isIEEE
108 exponent x = if m == 0 then 0 else n + floatDigits x
109 where (m,n) = decodeFloat x
111 significand x = encodeFloat m (negate (floatDigits x))
112 where (m,_) = decodeFloat x
114 scaleFloat k x = encodeFloat m (n+k)
115 where (m,n) = decodeFloat x
118 %*********************************************************
120 \subsection{Overloaded numeric functions}
122 %*********************************************************
125 even, odd :: (Integral a) => a -> Bool
126 even n = n `rem` 2 == 0
129 {-# GENERATE_SPECS gcd a{Int#,Int,Integer} #-}
130 gcd :: (Integral a) => a -> a -> a
131 gcd 0 0 = error "Prelude.gcd: gcd 0 0 is undefined"
132 gcd x y = gcd' (abs x) (abs y)
134 gcd' x y = gcd' y (x `rem` y)
136 {-# GENERATE_SPECS lcm a{Int#,Int,Integer} #-}
137 lcm :: (Integral a) => a -> a -> a
140 lcm x y = abs ((x `quot` (gcd x y)) * y)
142 (^) :: (Num a, Integral b) => a -> b -> a
144 x ^ n | n > 0 = f x (n-1) x
146 f x n y = g x n where
147 g x n | even n = g (x*x) (n `quot` 2)
148 | otherwise = f x (n-1) (x*y)
149 _ ^ _ = error "Prelude.^: negative exponent"
151 (^^) :: (Fractional a, Integral b) => a -> b -> a
152 x ^^ n = if n >= 0 then x^n else recip (x^(negate n))
154 fromIntegral :: (Integral a, Num b) => a -> b
155 fromIntegral = fromInteger . toInteger
157 fromRealFrac :: (RealFrac a, Fractional b) => a -> b
158 fromRealFrac = fromRational . toRational
160 atan2 :: (RealFloat a) => a -> a -> a
161 atan2 y x = case (signum y, signum x) of
165 (-1, 0) -> (negate pi)/2
166 ( _, 1) -> atan (y/x)
167 ( _,-1) -> atan (y/x) + pi
168 ( 0, 0) -> error "Prelude.atan2: atan2 of origin"
172 %*********************************************************
174 \subsection{Instances for @Int@}
176 %*********************************************************
179 instance Real Int where
180 toRational x = toInteger x % 1
182 instance Integral Int where
183 a@(I# _) `quotRem` b@(I# _) = (a `quotInt` b, a `remInt` b)
184 -- OK, so I made it a little stricter. Shoot me. (WDP 94/10)
186 -- following chks for zero divisor are non-standard (WDP)
187 a `quot` b = if b /= 0
189 else error "Integral.Int.quot{PreludeCore}: divide by 0\n"
190 a `rem` b = if b /= 0
192 else error "Integral.Int.rem{PreludeCore}: divide by 0\n"
194 x `div` y = if x > 0 && y < 0 then quotInt (x-y-1) y
195 else if x < 0 && y > 0 then quotInt (x-y+1) y
197 x `mod` y = if x > 0 && y < 0 || x < 0 && y > 0 then
198 if r/=0 then r+y else 0
203 divMod x@(I# _) y@(I# _) = (x `div` y, x `mod` y)
204 -- Stricter. Sorry if you don't like it. (WDP 94/10)
206 --OLD: even x = eqInt (x `mod` 2) 0
207 --OLD: odd x = neInt (x `mod` 2) 0
209 toInteger (I# n#) = int2Integer# n# -- give back a full-blown Integer
215 %*********************************************************
217 \subsection{Type @Integer@}
219 %*********************************************************
221 These types are used to return from integer primops
224 data Return2GMPs = Return2GMPs Int# Int# ByteArray# Int# Int# ByteArray#
225 data ReturnIntAndGMP = ReturnIntAndGMP Int# Int# Int# ByteArray#
231 instance Eq Integer where
232 (J# a1 s1 d1) == (J# a2 s2 d2)
233 = (cmpInteger# a1 s1 d1 a2 s2 d2) ==# 0#
235 (J# a1 s1 d1) /= (J# a2 s2 d2)
236 = (cmpInteger# a1 s1 d1 a2 s2 d2) /=# 0#
238 instance Ord Integer where
239 (J# a1 s1 d1) <= (J# a2 s2 d2)
240 = (cmpInteger# a1 s1 d1 a2 s2 d2) <=# 0#
242 (J# a1 s1 d1) < (J# a2 s2 d2)
243 = (cmpInteger# a1 s1 d1 a2 s2 d2) <# 0#
245 (J# a1 s1 d1) >= (J# a2 s2 d2)
246 = (cmpInteger# a1 s1 d1 a2 s2 d2) >=# 0#
248 (J# a1 s1 d1) > (J# a2 s2 d2)
249 = (cmpInteger# a1 s1 d1 a2 s2 d2) ># 0#
251 x@(J# a1 s1 d1) `max` y@(J# a2 s2 d2)
252 = if ((cmpInteger# a1 s1 d1 a2 s2 d2) ># 0#) then x else y
254 x@(J# a1 s1 d1) `min` y@(J# a2 s2 d2)
255 = if ((cmpInteger# a1 s1 d1 a2 s2 d2) <# 0#) then x else y
257 compare (J# a1 s1 d1) (J# a2 s2 d2)
258 = case cmpInteger# a1 s1 d1 a2 s2 d2 of { res# ->
259 if res# <# 0# then LT else
260 if res# ># 0# then GT else EQ
263 instance Num Integer where
264 (+) (J# a1 s1 d1) (J# a2 s2 d2)
265 = plusInteger# a1 s1 d1 a2 s2 d2
267 (-) (J# a1 s1 d1) (J# a2 s2 d2)
268 = minusInteger# a1 s1 d1 a2 s2 d2
270 negate (J# a s d) = negateInteger# a s d
272 (*) (J# a1 s1 d1) (J# a2 s2 d2)
273 = timesInteger# a1 s1 d1 a2 s2 d2
275 -- ORIG: abs n = if n >= 0 then n else -n
278 = case 0 of { J# a2 s2 d2 ->
279 if (cmpInteger# a1 s1 d1 a2 s2 d2) >=# 0#
281 else negateInteger# a1 s1 d1
284 signum n@(J# a1 s1 d1)
285 = case 0 of { J# a2 s2 d2 ->
287 cmp = cmpInteger# a1 s1 d1 a2 s2 d2
290 else if cmp ==# 0# then 0
296 fromInt (I# n#) = int2Integer# n# -- gives back a full-blown Integer
298 instance Real Integer where
301 instance Integral Integer where
302 quotRem (J# a1 s1 d1) (J# a2 s2 d2)
303 = case (quotRemInteger# a1 s1 d1 a2 s2 d2) of
304 Return2GMPs a3 s3 d3 a4 s4 d4
305 -> (J# a3 s3 d3, J# a4 s4 d4)
307 {- USING THE UNDERLYING "GMP" CODE IS DUBIOUS FOR NOW:
309 divMod (J# a1 s1 d1) (J# a2 s2 d2)
310 = case (divModInteger# a1 s1 d1 a2 s2 d2) of
311 Return2GMPs a3 s3 d3 a4 s4 d4
312 -> (J# a3 s3 d3, J# a4 s4 d4)
315 toInt (J# a s d) = case (integer2Int# a s d) of { n# -> I# n# }
317 -- the rest are identical to the report default methods;
318 -- you get slightly better code if you let the compiler
319 -- see them right here:
320 n `quot` d = q where (q,r) = quotRem n d
321 n `rem` d = r where (q,r) = quotRem n d
322 n `div` d = q where (q,r) = divMod n d
323 n `mod` d = r where (q,r) = divMod n d
325 divMod n d = case (quotRem n d) of { qr@(q,r) ->
326 if signum r == negate (signum d) then (q - 1, r+d) else qr }
327 -- Case-ified by WDP 94/10
329 instance Enum Integer where
330 enumFrom n = n : enumFrom (n + 1)
331 enumFromThen m n = en' m (n - m)
332 where en' m n = m : en' (m + n) n
333 enumFromTo n m = takeWhile (<= m) (enumFrom n)
334 enumFromThenTo n m p = takeWhile (if m >= n then (<= p) else (>= p))
337 instance Show Integer where
338 showsPrec x = showSignedInteger x
339 showList = showList__ (showsPrec 0)
341 integer_0, integer_1, integer_2, integer_m1 :: Integer
342 integer_0 = 0; integer_1 = 1; integer_2 = 2; integer_m1 = -1
346 %*********************************************************
348 \subsection{Type @Float@}
350 %*********************************************************
353 instance Eq Float where
354 (F# x) == (F# y) = x `eqFloat#` y
356 instance Ord Float where
357 (F# x) `compare` (F# y) | x `ltFloat#` y = LT
358 | x `eqFloat#` y = EQ
361 (F# x) < (F# y) = x `ltFloat#` y
362 (F# x) <= (F# y) = x `leFloat#` y
363 (F# x) >= (F# y) = x `geFloat#` y
364 (F# x) > (F# y) = x `geFloat#` y
366 instance Num Float where
367 (+) x y = plusFloat x y
368 (-) x y = minusFloat x y
369 negate x = negateFloat x
370 (*) x y = timesFloat x y
372 | otherwise = negateFloat x
373 signum x | x == 0.0 = 0
375 | otherwise = negate 1
376 fromInteger n = encodeFloat n 0
377 fromInt i = int2Float i
379 instance Real Float where
380 toRational x = (m%1)*(b%1)^^n
381 where (m,n) = decodeFloat x
384 instance Fractional Float where
385 (/) x y = divideFloat x y
386 fromRational x = fromRational__ x
389 instance Floating Float where
390 pi = 3.141592653589793238
403 (**) x y = powerFloat x y
404 logBase x y = log y / log x
406 asinh x = log (x + sqrt (1.0+x*x))
407 acosh x = log (x + (x+1.0) * sqrt ((x-1.0)/(x+1.0)))
408 atanh x = log ((x+1.0) / sqrt (1.0-x*x))
410 instance RealFrac Float where
412 {-# SPECIALIZE properFraction :: Float -> (Int, Float) #-}
413 {-# SPECIALIZE truncate :: Float -> Int #-}
414 {-# SPECIALIZE round :: Float -> Int #-}
415 {-# SPECIALIZE ceiling :: Float -> Int #-}
416 {-# SPECIALIZE floor :: Float -> Int #-}
418 {-# SPECIALIZE properFraction :: Float -> (Integer, Float) #-}
419 {-# SPECIALIZE truncate :: Float -> Integer #-}
420 {-# SPECIALIZE round :: Float -> Integer #-}
421 {-# SPECIALIZE ceiling :: Float -> Integer #-}
422 {-# SPECIALIZE floor :: Float -> Integer #-}
425 = case (decodeFloat x) of { (m,n) ->
426 let b = floatRadix x in
428 (fromInteger m * fromInteger b ^ n, 0.0)
430 case (quotRem m (b^(negate n))) of { (w,r) ->
431 (fromInteger w, encodeFloat r n)
435 truncate x = case properFraction x of
438 round x = case properFraction x of
440 m = if r < 0.0 then n - 1 else n + 1
441 half_down = abs r - 0.5
443 case (compare half_down 0.0) of
445 EQ -> if even n then n else m
448 ceiling x = case properFraction x of
449 (n,r) -> if r > 0.0 then n + 1 else n
451 floor x = case properFraction x of
452 (n,r) -> if r < 0.0 then n - 1 else n
454 instance RealFloat Float where
455 floatRadix _ = FLT_RADIX -- from float.h
456 floatDigits _ = FLT_MANT_DIG -- ditto
457 floatRange _ = (FLT_MIN_EXP, FLT_MAX_EXP) -- ditto
460 = case decodeFloat# f# of
461 ReturnIntAndGMP exp# a# s# d# ->
462 (J# a# s# d#, I# exp#)
464 encodeFloat (J# a# s# d#) (I# e#)
465 = case encodeFloat# a# s# d# e# of { flt# -> F# flt# }
467 exponent x = case decodeFloat x of
468 (m,n) -> if m == 0 then 0 else n + floatDigits x
470 significand x = case decodeFloat x of
471 (m,_) -> encodeFloat m (negate (floatDigits x))
473 scaleFloat k x = case decodeFloat x of
474 (m,n) -> encodeFloat m (n+k)
476 instance Show Float where
477 showsPrec x = showSigned showFloat x
478 showList = showList__ (showsPrec 0)
481 %*********************************************************
483 \subsection{Type @Double@}
485 %*********************************************************
488 instance Eq Double where
489 (D# x) == (D# y) = x ==## y
491 instance Ord Double where
492 (D# x) `compare` (D# y) | x <## y = LT
496 (D# x) < (D# y) = x <## y
497 (D# x) <= (D# y) = x <=## y
498 (D# x) >= (D# y) = x >=## y
499 (D# x) > (D# y) = x >## y
501 instance Num Double where
502 (+) x y = plusDouble x y
503 (-) x y = minusDouble x y
504 negate x = negateDouble x
505 (*) x y = timesDouble x y
507 | otherwise = negateDouble x
508 signum x | x == 0.0 = 0
510 | otherwise = negate 1
511 fromInteger n = encodeFloat n 0
512 fromInt (I# n#) = case (int2Double# n#) of { d# -> D# d# }
514 instance Real Double where
515 toRational x = (m%1)*(b%1)^^n
516 where (m,n) = decodeFloat x
519 instance Fractional Double where
520 (/) x y = divideDouble x y
521 fromRational x = fromRational__ x
524 instance Floating Double where
525 pi = 3.141592653589793238
528 sqrt x = sqrtDouble x
532 asin x = asinDouble x
533 acos x = acosDouble x
534 atan x = atanDouble x
535 sinh x = sinhDouble x
536 cosh x = coshDouble x
537 tanh x = tanhDouble x
538 (**) x y = powerDouble x y
539 logBase x y = log y / log x
541 asinh x = log (x + sqrt (1.0+x*x))
542 acosh x = log (x + (x+1.0) * sqrt ((x-1.0)/(x+1.0)))
543 atanh x = log ((x+1.0) / sqrt (1.0-x*x))
545 instance RealFrac Double where
547 {-# SPECIALIZE properFraction :: Double -> (Int, Double) #-}
548 {-# SPECIALIZE truncate :: Double -> Int #-}
549 {-# SPECIALIZE round :: Double -> Int #-}
550 {-# SPECIALIZE ceiling :: Double -> Int #-}
551 {-# SPECIALIZE floor :: Double -> Int #-}
553 {-# SPECIALIZE properFraction :: Double -> (Integer, Double) #-}
554 {-# SPECIALIZE truncate :: Double -> Integer #-}
555 {-# SPECIALIZE round :: Double -> Integer #-}
556 {-# SPECIALIZE ceiling :: Double -> Integer #-}
557 {-# SPECIALIZE floor :: Double -> Integer #-}
559 #if defined(__UNBOXED_INSTANCES__)
560 {-# SPECIALIZE properFraction :: Double -> (Int#, Double) #-}
561 {-# SPECIALIZE truncate :: Double -> Int# #-}
562 {-# SPECIALIZE round :: Double -> Int# #-}
563 {-# SPECIALIZE ceiling :: Double -> Int# #-}
564 {-# SPECIALIZE floor :: Double -> Int# #-}
568 = case (decodeFloat x) of { (m,n) ->
569 let b = floatRadix x in
571 (fromInteger m * fromInteger b ^ n, 0.0)
573 case (quotRem m (b^(negate n))) of { (w,r) ->
574 (fromInteger w, encodeFloat r n)
578 truncate x = case properFraction x of
581 round x = case properFraction x of
583 m = if r < 0.0 then n - 1 else n + 1
584 half_down = abs r - 0.5
586 case (compare half_down 0.0) of
588 EQ -> if even n then n else m
591 ceiling x = case properFraction x of
592 (n,r) -> if r > 0.0 then n + 1 else n
594 floor x = case properFraction x of
595 (n,r) -> if r < 0.0 then n - 1 else n
597 instance RealFloat Double where
598 floatRadix _ = FLT_RADIX -- from float.h
599 floatDigits _ = DBL_MANT_DIG -- ditto
600 floatRange _ = (DBL_MIN_EXP, DBL_MAX_EXP) -- ditto
603 = case decodeDouble# d# of
604 ReturnIntAndGMP exp# a# s# d# ->
605 (J# a# s# d#, I# exp#)
607 encodeFloat (J# a# s# d#) (I# e#)
608 = case encodeDouble# a# s# d# e# of { dbl# -> D# dbl# }
610 exponent x = case decodeFloat x of
611 (m,n) -> if m == 0 then 0 else n + floatDigits x
613 significand x = case decodeFloat x of
614 (m,_) -> encodeFloat m (negate (floatDigits x))
616 scaleFloat k x = case decodeFloat x of
617 (m,n) -> encodeFloat m (n+k)
619 instance Show Double where
620 showsPrec x = showSigned showFloat x
621 showList = showList__ (showsPrec 0)
625 %*********************************************************
627 \subsection{Common code for @Float@ and @Double@}
629 %*********************************************************
631 The Enum instances for Floats and Doubles are slightly unusual.
632 The `toEnum' function truncates numbers to Int. The definitions
633 of enumFrom and enumFromThen allow floats to be used in arithmetic
634 series: [0,0.1 .. 1.0]. However, roundoff errors make these somewhat
635 dubious. This example may have either 10 or 11 elements, depending on
636 how 0.1 is represented.
639 instance Enum Float where
640 toEnum = fromIntegral
641 fromEnum = fromInteger . truncate -- may overflow
642 enumFrom = numericEnumFrom
643 enumFromThen = numericEnumFromThen
645 instance Enum Double where
646 toEnum = fromIntegral
647 fromEnum = fromInteger . truncate -- may overflow
648 enumFrom = numericEnumFrom
649 enumFromThen = numericEnumFromThen
651 numericEnumFrom :: (Real a) => a -> [a]
652 numericEnumFromThen :: (Real a) => a -> a -> [a]
653 numericEnumFrom = iterate (+1)
654 numericEnumFromThen n m = iterate (+(m-n)) n
658 %*********************************************************
660 \subsection{The @Ratio@ and @Rational@ types}
662 %*********************************************************
665 data (Integral a) => Ratio a = a :% a deriving (Eq)
666 type Rational = Ratio Integer
670 (%) :: (Integral a) => a -> a -> Ratio a
671 numerator, denominator :: (Integral a) => Ratio a -> a
672 approxRational :: (RealFrac a) => a -> a -> Rational
675 reduce _ 0 = error "{Ratio.%}: zero denominator"
676 reduce x y = (x `quot` d) :% (y `quot` d)
679 x % y = reduce (x * signum y) (abs y)
683 denominator (x:%y) = y
687 @approxRational@, applied to two real fractional numbers x and epsilon,
688 returns the simplest rational number within epsilon of x. A rational
689 number n%d in reduced form is said to be simpler than another n'%d' if
690 abs n <= abs n' && d <= d'. Any real interval contains a unique
691 simplest rational; here, for simplicity, we assume a closed rational
692 interval. If such an interval includes at least one whole number, then
693 the simplest rational is the absolutely least whole number. Otherwise,
694 the bounds are of the form q%1 + r%d and q%1 + r'%d', where abs r < d
695 and abs r' < d', and the simplest rational is q%1 + the reciprocal of
696 the simplest rational between d'%r' and d%r.
699 approxRational x eps = simplest (x-eps) (x+eps)
700 where simplest x y | y < x = simplest y x
702 | x > 0 = simplest' n d n' d'
703 | y < 0 = - simplest' (-n') d' (-n) d
705 where xr@(n:%d) = toRational x
706 (n':%d') = toRational y
708 simplest' n d n' d' -- assumes 0 < n%d < n'%d'
710 | q /= q' = (q+1) :% 1
711 | otherwise = (q*n''+d'') :% n''
712 where (q,r) = quotRem n d
713 (q',r') = quotRem n' d'
714 (n'':%d'') = simplest' d' r' d r
719 instance (Integral a) => Ord (Ratio a) where
720 (x:%y) <= (x':%y') = x * y' <= x' * y
721 (x:%y) < (x':%y') = x * y' < x' * y
723 instance (Integral a) => Num (Ratio a) where
724 (x:%y) + (x':%y') = reduce (x*y' + x'*y) (y*y')
725 (x:%y) * (x':%y') = reduce (x * x') (y * y')
726 negate (x:%y) = (-x) :% y
727 abs (x:%y) = abs x :% y
728 signum (x:%y) = signum x :% 1
729 fromInteger x = fromInteger x :% 1
731 instance (Integral a) => Real (Ratio a) where
732 toRational (x:%y) = toInteger x :% toInteger y
734 instance (Integral a) => Fractional (Ratio a) where
735 (x:%y) / (x':%y') = (x*y') % (y*x')
736 recip (x:%y) = if x < 0 then (-y) :% (-x) else y :% x
737 fromRational (x:%y) = fromInteger x :% fromInteger y
739 instance (Integral a) => RealFrac (Ratio a) where
740 properFraction (x:%y) = (fromIntegral q, r:%y)
741 where (q,r) = quotRem x y
743 instance (Integral a) => Enum (Ratio a) where
744 enumFrom = iterate ((+)1)
745 enumFromThen n m = iterate ((+)(m-n)) n
746 toEnum n = fromIntegral n :% 1
747 fromEnum = fromInteger . truncate
752 instance (Integral a) => Show (Ratio a) where
753 showsPrec p (x:%y) = showParen (p > ratio_prec)
754 (shows x . showString " % " . shows y)
758 [In response to a request by simonpj, Joe Fasel writes:]
760 A quite reasonable request! This code was added to the Prelude just
761 before the 1.2 release, when Lennart, working with an early version
762 of hbi, noticed that (read . show) was not the identity for
763 floating-point numbers. (There was a one-bit error about half the time.)
764 The original version of the conversion function was in fact simply
765 a floating-point divide, as you suggest above. The new version is,
766 I grant you, somewhat denser.
774 {-# GENERATE_SPECS fromRational__ a{Double#,Double} #-}
775 fromRational__ :: (RealFloat a) => Rational -> a
776 fromRational__ x = x'
779 -- If the exponent of the nearest floating-point number to x
780 -- is e, then the significand is the integer nearest xb^(-e),
781 -- where b is the floating-point radix. We start with a good
782 -- guess for e, and if it is correct, the exponent of the
783 -- floating-point number we construct will again be e. If
784 -- not, one more iteration is needed.
786 f e = if e' == e then y else f e'
787 where y = encodeFloat (round (x * (1 % b)^^e)) e
788 (_,e') = decodeFloat y
791 -- We obtain a trial exponent by doing a floating-point
792 -- division of x's numerator by its denominator. The
793 -- result of this division may not itself be the ultimate
794 -- result, because of an accumulation of three rounding
797 (s,e) = decodeFloat (fromInteger (numerator x) `asTypeOf` x'
798 / fromInteger (denominator x))
802 %*********************************************************
804 \subsection{Showing numbers}
806 %*********************************************************
810 = case quotRem n 10 of { (n', d) ->
811 case (chr (ord_0 + fromIntegral d)) of { C# c# -> -- stricter than necessary
815 if n' == 0 then r' else showInteger n' r'
818 showSigned :: (Real a) => (a -> ShowS) -> Int -> a -> ShowS
819 showSigned showPos p x = if x < 0 then showParen (p > 6)
820 (showChar '-' . showPos (-x))
823 showSignedInteger :: Int -> Integer -> ShowS
824 showSignedInteger p n r
825 = -- from HBC version; support code follows
826 if n < 0 && p > 6 then '(':jtos n++(')':r) else jtos n ++ r
828 jtos :: Integer -> String
835 jtos' :: Integer -> String -> String
838 chr (fromInteger (n + ord_0)) : cs
840 jtos' (n `quot` 10) (chr (fromInteger (n `rem` 10 + ord_0)) : cs)
843 The functions showFloat below uses rational arithmetic
844 to insure correct conversion between the floating-point radix and
845 decimal. It is often possible to use a higher-precision floating-
846 point type to obtain the same results.
849 {-# GENERATE_SPECS showFloat a{Double#,Double} #-}
850 showFloat:: (RealFloat a) => a -> ShowS
852 if x == 0 then showString ("0." ++ take (m-1) zeros)
853 else if e >= m-1 || e < 0 then showSci else showFix
855 showFix = showString whole . showChar '.' . showString frac
856 where (whole,frac) = splitAt (e+1) (show sig)
857 showSci = showChar d . showChar '.' . showString frac
858 . showChar 'e' . shows e
859 where (d:frac) = show sig
860 (m, sig, e) = if b == 10 then (w, s, n+w-1)
863 ((fromInt w * log (fromInteger b)) / log 10 :: Double)
865 (sig', e') = if sig1 >= 10^m' then (round (t/10), e1+1)
866 else if sig1 < 10^(m'-1) then (round (t*10), e1-1)
869 t = s%1 * (b%1)^^n * 10^^(m'-e1-1)
870 e1 = floor (logBase 10 x)
871 (s, n) = decodeFloat x
878 @showRational@ converts a Rational to a string that looks like a
879 floating point number, but without converting to any floating type
880 (because of the possible overflow).
882 From/by Lennart, 94/09/26
885 showRational :: Int -> Rational -> String
890 let (r', e) = normalize r
893 startExpExp = 4 :: Int
895 -- make sure 1 <= r < 10
896 normalize :: Rational -> (Rational, Int)
897 normalize r = if r < 1 then
898 case norm startExpExp (1 / r) 0 of (r', e) -> (10 / r', -e-1)
901 where norm :: Int -> Rational -> Int -> (Rational, Int)
902 -- Invariant: r*10^e == original r
907 in if r >= tn then norm ee (r/tn) (e+n) else norm (ee-1) r e
910 drop0 (c:cs) = c : reverse (dropWhile (=='0') (reverse cs))
912 prR :: Int -> Rational -> Int -> String
913 prR n r e | r < 1 = prR n (r*10) (e-1) -- final adjustment
914 prR n r e | r >= 10 = prR n (r/10) (e+1)
916 let s = show ((round (r * 10^n))::Integer)
918 in if e > 0 && e < 8 then
919 take e s ++ "." ++ drop0 (drop e s)
920 else if e <= 0 && e > -3 then
921 "0." ++ take (-e) (repeat '0') ++ drop0 s
923 head s : "."++ drop0 (tail s) ++ "e" ++ show e0
926 %*********************************************************
928 \subsection{Numeric primops}
930 %*********************************************************
932 Definitions of the boxed PrimOps; these will be
933 used in the case of partial applications, etc.
936 plusFloat (F# x) (F# y) = F# (plusFloat# x y)
937 minusFloat (F# x) (F# y) = F# (minusFloat# x y)
938 timesFloat (F# x) (F# y) = F# (timesFloat# x y)
939 divideFloat (F# x) (F# y) = F# (divideFloat# x y)
940 negateFloat (F# x) = F# (negateFloat# x)
942 gtFloat (F# x) (F# y) = gtFloat# x y
943 geFloat (F# x) (F# y) = geFloat# x y
944 eqFloat (F# x) (F# y) = eqFloat# x y
945 neFloat (F# x) (F# y) = neFloat# x y
946 ltFloat (F# x) (F# y) = ltFloat# x y
947 leFloat (F# x) (F# y) = leFloat# x y
949 float2Int (F# x) = I# (float2Int# x)
950 int2Float (I# x) = F# (int2Float# x)
952 expFloat (F# x) = F# (expFloat# x)
953 logFloat (F# x) = F# (logFloat# x)
954 sqrtFloat (F# x) = F# (sqrtFloat# x)
955 sinFloat (F# x) = F# (sinFloat# x)
956 cosFloat (F# x) = F# (cosFloat# x)
957 tanFloat (F# x) = F# (tanFloat# x)
958 asinFloat (F# x) = F# (asinFloat# x)
959 acosFloat (F# x) = F# (acosFloat# x)
960 atanFloat (F# x) = F# (atanFloat# x)
961 sinhFloat (F# x) = F# (sinhFloat# x)
962 coshFloat (F# x) = F# (coshFloat# x)
963 tanhFloat (F# x) = F# (tanhFloat# x)
965 powerFloat (F# x) (F# y) = F# (powerFloat# x y)
967 -- definitions of the boxed PrimOps; these will be
968 -- used in the case of partial applications, etc.
970 plusDouble (D# x) (D# y) = D# (x +## y)
971 minusDouble (D# x) (D# y) = D# (x -## y)
972 timesDouble (D# x) (D# y) = D# (x *## y)
973 divideDouble (D# x) (D# y) = D# (x /## y)
974 negateDouble (D# x) = D# (negateDouble# x)
976 gtDouble (D# x) (D# y) = x >## y
977 geDouble (D# x) (D# y) = x >=## y
978 eqDouble (D# x) (D# y) = x ==## y
979 neDouble (D# x) (D# y) = x /=## y
980 ltDouble (D# x) (D# y) = x <## y
981 leDouble (D# x) (D# y) = x <=## y
983 double2Int (D# x) = I# (double2Int# x)
984 int2Double (I# x) = D# (int2Double# x)
985 double2Float (D# x) = F# (double2Float# x)
986 float2Double (F# x) = D# (float2Double# x)
988 expDouble (D# x) = D# (expDouble# x)
989 logDouble (D# x) = D# (logDouble# x)
990 sqrtDouble (D# x) = D# (sqrtDouble# x)
991 sinDouble (D# x) = D# (sinDouble# x)
992 cosDouble (D# x) = D# (cosDouble# x)
993 tanDouble (D# x) = D# (tanDouble# x)
994 asinDouble (D# x) = D# (asinDouble# x)
995 acosDouble (D# x) = D# (acosDouble# x)
996 atanDouble (D# x) = D# (atanDouble# x)
997 sinhDouble (D# x) = D# (sinhDouble# x)
998 coshDouble (D# x) = D# (coshDouble# x)
999 tanhDouble (D# x) = D# (tanhDouble# x)
1001 powerDouble (D# x) (D# y) = D# (x **## y)