Have validate take into account stat test failures too.
[ghc.git] / libraries / base / GHC / Float.lhs
1 \begin{code}
2 {-# LANGUAGE Trustworthy #-}
3 {-# LANGUAGE CPP
4            , NoImplicitPrelude
5            , MagicHash
6            , UnboxedTuples
7   #-}
8 -- We believe we could deorphan this module, by moving lots of things
9 -- around, but we haven't got there yet:
10 {-# OPTIONS_GHC -fno-warn-orphans #-}
11 {-# OPTIONS_HADDOCK hide #-}
12
13 -----------------------------------------------------------------------------
14 -- |
15 -- Module      :  GHC.Float
16 -- Copyright   :  (c) The University of Glasgow 1994-2002
17 --                Portions obtained from hbc (c) Lennart Augusstson
18 -- License     :  see libraries/base/LICENSE
19 --
20 -- Maintainer  :  cvs-ghc@haskell.org
21 -- Stability   :  internal
22 -- Portability :  non-portable (GHC Extensions)
23 --
24 -- The types 'Float' and 'Double', and the classes 'Floating' and 'RealFloat'.
25 --
26 -----------------------------------------------------------------------------
27
28 #include "ieee-flpt.h"
29
30 module GHC.Float( module GHC.Float, Float(..), Double(..), Float#, Double#
31                 , double2Int, int2Double, float2Int, int2Float )
32     where
33
34 import Data.Maybe
35
36 import Data.Bits
37 import GHC.Base
38 import GHC.List
39 import GHC.Enum
40 import GHC.Show
41 import GHC.Num
42 import GHC.Real
43 import GHC.Arr
44 import GHC.Float.RealFracMethods
45 import GHC.Float.ConversionUtils
46 import GHC.Integer.Logarithms ( integerLogBase# )
47 import GHC.Integer.Logarithms.Internals
48
49 infixr 8  **
50 \end{code}
51
52 %*********************************************************
53 %*                                                      *
54 \subsection{Standard numeric classes}
55 %*                                                      *
56 %*********************************************************
57
58 \begin{code}
59 -- | Trigonometric and hyperbolic functions and related functions.
60 class  (Fractional a) => Floating a  where
61     pi                  :: a
62     exp, log, sqrt      :: a -> a
63     (**), logBase       :: a -> a -> a
64     sin, cos, tan       :: a -> a
65     asin, acos, atan    :: a -> a
66     sinh, cosh, tanh    :: a -> a
67     asinh, acosh, atanh :: a -> a
68
69     {-# INLINE (**) #-}
70     {-# INLINE logBase #-}
71     {-# INLINE sqrt #-}
72     {-# INLINE tan #-}
73     {-# INLINE tanh #-}
74     x ** y              =  exp (log x * y)
75     logBase x y         =  log y / log x
76     sqrt x              =  x ** 0.5
77     tan  x              =  sin  x / cos  x
78     tanh x              =  sinh x / cosh x
79
80 -- | Efficient, machine-independent access to the components of a
81 -- floating-point number.
82 class  (RealFrac a, Floating a) => RealFloat a  where
83     -- | a constant function, returning the radix of the representation
84     -- (often @2@)
85     floatRadix          :: a -> Integer
86     -- | a constant function, returning the number of digits of
87     -- 'floatRadix' in the significand
88     floatDigits         :: a -> Int
89     -- | a constant function, returning the lowest and highest values
90     -- the exponent may assume
91     floatRange          :: a -> (Int,Int)
92     -- | The function 'decodeFloat' applied to a real floating-point
93     -- number returns the significand expressed as an 'Integer' and an
94     -- appropriately scaled exponent (an 'Int').  If @'decodeFloat' x@
95     -- yields @(m,n)@, then @x@ is equal in value to @m*b^^n@, where @b@
96     -- is the floating-point radix, and furthermore, either @m@ and @n@
97     -- are both zero or else @b^(d-1) <= 'abs' m < b^d@, where @d@ is
98     -- the value of @'floatDigits' x@.
99     -- In particular, @'decodeFloat' 0 = (0,0)@. If the type
100     -- contains a negative zero, also @'decodeFloat' (-0.0) = (0,0)@.
101     -- /The result of/ @'decodeFloat' x@ /is unspecified if either of/
102     -- @'isNaN' x@ /or/ @'isInfinite' x@ /is/ 'True'.
103     decodeFloat         :: a -> (Integer,Int)
104     -- | 'encodeFloat' performs the inverse of 'decodeFloat' in the
105     -- sense that for finite @x@ with the exception of @-0.0@,
106     -- @'uncurry' 'encodeFloat' ('decodeFloat' x) = x@.
107     -- @'encodeFloat' m n@ is one of the two closest representable
108     -- floating-point numbers to @m*b^^n@ (or @&#177;Infinity@ if overflow
109     -- occurs); usually the closer, but if @m@ contains too many bits,
110     -- the result may be rounded in the wrong direction.
111     encodeFloat         :: Integer -> Int -> a
112     -- | 'exponent' corresponds to the second component of 'decodeFloat'.
113     -- @'exponent' 0 = 0@ and for finite nonzero @x@,
114     -- @'exponent' x = snd ('decodeFloat' x) + 'floatDigits' x@.
115     -- If @x@ is a finite floating-point number, it is equal in value to
116     -- @'significand' x * b ^^ 'exponent' x@, where @b@ is the
117     -- floating-point radix.
118     -- The behaviour is unspecified on infinite or @NaN@ values.
119     exponent            :: a -> Int
120     -- | The first component of 'decodeFloat', scaled to lie in the open
121     -- interval (@-1@,@1@), either @0.0@ or of absolute value @>= 1\/b@,
122     -- where @b@ is the floating-point radix.
123     -- The behaviour is unspecified on infinite or @NaN@ values.
124     significand         :: a -> a
125     -- | multiplies a floating-point number by an integer power of the radix
126     scaleFloat          :: Int -> a -> a
127     -- | 'True' if the argument is an IEEE \"not-a-number\" (NaN) value
128     isNaN               :: a -> Bool
129     -- | 'True' if the argument is an IEEE infinity or negative infinity
130     isInfinite          :: a -> Bool
131     -- | 'True' if the argument is too small to be represented in
132     -- normalized format
133     isDenormalized      :: a -> Bool
134     -- | 'True' if the argument is an IEEE negative zero
135     isNegativeZero      :: a -> Bool
136     -- | 'True' if the argument is an IEEE floating point number
137     isIEEE              :: a -> Bool
138     -- | a version of arctangent taking two real floating-point arguments.
139     -- For real floating @x@ and @y@, @'atan2' y x@ computes the angle
140     -- (from the positive x-axis) of the vector from the origin to the
141     -- point @(x,y)@.  @'atan2' y x@ returns a value in the range [@-pi@,
142     -- @pi@].  It follows the Common Lisp semantics for the origin when
143     -- signed zeroes are supported.  @'atan2' y 1@, with @y@ in a type
144     -- that is 'RealFloat', should return the same value as @'atan' y@.
145     -- A default definition of 'atan2' is provided, but implementors
146     -- can provide a more accurate implementation.
147     atan2               :: a -> a -> a
148
149
150     exponent x          =  if m == 0 then 0 else n + floatDigits x
151                            where (m,n) = decodeFloat x
152
153     significand x       =  encodeFloat m (negate (floatDigits x))
154                            where (m,_) = decodeFloat x
155
156     scaleFloat 0 x      =  x
157     scaleFloat k x
158       | isFix           =  x
159       | otherwise       =  encodeFloat m (n + clamp b k)
160                            where (m,n) = decodeFloat x
161                                  (l,h) = floatRange x
162                                  d     = floatDigits x
163                                  b     = h - l + 4*d
164                                  -- n+k may overflow, which would lead
165                                  -- to wrong results, hence we clamp the
166                                  -- scaling parameter.
167                                  -- If n + k would be larger than h,
168                                  -- n + clamp b k must be too, simliar
169                                  -- for smaller than l - d.
170                                  -- Add a little extra to keep clear
171                                  -- from the boundary cases.
172                                  isFix = x == 0 || isNaN x || isInfinite x
173
174     atan2 y x
175       | x > 0            =  atan (y/x)
176       | x == 0 && y > 0  =  pi/2
177       | x <  0 && y > 0  =  pi + atan (y/x)
178       |(x <= 0 && y < 0)            ||
179        (x <  0 && isNegativeZero y) ||
180        (isNegativeZero x && isNegativeZero y)
181                          = -atan2 (-y) x
182       | y == 0 && (x < 0 || isNegativeZero x)
183                           =  pi    -- must be after the previous test on zero y
184       | x==0 && y==0      =  y     -- must be after the other double zero tests
185       | otherwise         =  x + y -- x or y is a NaN, return a NaN (via +)
186 \end{code}
187
188
189 %*********************************************************
190 %*                                                      *
191 \subsection{Type @Float@}
192 %*                                                      *
193 %*********************************************************
194
195 \begin{code}
196 instance  Num Float  where
197     (+)         x y     =  plusFloat x y
198     (-)         x y     =  minusFloat x y
199     negate      x       =  negateFloat x
200     (*)         x y     =  timesFloat x y
201     abs x    | x == 0    = 0 -- handles (-0.0)
202              | x >  0    = x
203              | otherwise = negateFloat x
204     signum x | x > 0     = 1
205              | x < 0     = negateFloat 1
206              | otherwise = x -- handles 0.0, (-0.0), and NaN
207
208     {-# INLINE fromInteger #-}
209     fromInteger i = F# (floatFromInteger i)
210
211 instance  Real Float  where
212     toRational (F# x#)  =
213         case decodeFloat_Int# x# of
214           (# m#, e# #)
215             | isTrue# (e# >=# 0#)                               ->
216                     (smallInteger m# `shiftLInteger` e#) :% 1
217             | isTrue# ((int2Word# m# `and#` 1##) `eqWord#` 0##) ->
218                     case elimZerosInt# m# (negateInt# e#) of
219                       (# n, d# #) -> n :% shiftLInteger 1 d#
220             | otherwise                                         ->
221                     smallInteger m# :% shiftLInteger 1 (negateInt# e#)
222
223 instance  Fractional Float  where
224     (/) x y             =  divideFloat x y
225     {-# INLINE fromRational #-}
226     fromRational (n:%d) = rationalToFloat n d
227     recip x             =  1.0 / x
228
229 rationalToFloat :: Integer -> Integer -> Float
230 {-# NOINLINE [1] rationalToFloat #-}
231 rationalToFloat n 0
232     | n == 0        = 0/0
233     | n < 0         = (-1)/0
234     | otherwise     = 1/0
235 rationalToFloat n d
236     | n == 0        = encodeFloat 0 0
237     | n < 0         = -(fromRat'' minEx mantDigs (-n) d)
238     | otherwise     = fromRat'' minEx mantDigs n d
239       where
240         minEx       = FLT_MIN_EXP
241         mantDigs    = FLT_MANT_DIG
242
243 -- RULES for Integer and Int
244 {-# RULES
245 "properFraction/Float->Integer"     properFraction = properFractionFloatInteger
246 "truncate/Float->Integer"           truncate = truncateFloatInteger
247 "floor/Float->Integer"              floor = floorFloatInteger
248 "ceiling/Float->Integer"            ceiling = ceilingFloatInteger
249 "round/Float->Integer"              round = roundFloatInteger
250 "properFraction/Float->Int"         properFraction = properFractionFloatInt
251 "truncate/Float->Int"               truncate = float2Int
252 "floor/Float->Int"                  floor = floorFloatInt
253 "ceiling/Float->Int"                ceiling = ceilingFloatInt
254 "round/Float->Int"                  round = roundFloatInt
255   #-}
256 instance  RealFrac Float  where
257
258         -- ceiling, floor, and truncate are all small
259     {-# INLINE [1] ceiling #-}
260     {-# INLINE [1] floor #-}
261     {-# INLINE [1] truncate #-}
262
263 -- We assume that FLT_RADIX is 2 so that we can use more efficient code
264 #if FLT_RADIX != 2
265 #error FLT_RADIX must be 2
266 #endif
267     properFraction (F# x#)
268       = case decodeFloat_Int# x# of
269         (# m#, n# #) ->
270             let m = I# m#
271                 n = I# n#
272             in
273             if n >= 0
274             then (fromIntegral m * (2 ^ n), 0.0)
275             else let i = if m >= 0 then                m `shiftR` negate n
276                                    else negate (negate m `shiftR` negate n)
277                      f = m - (i `shiftL` negate n)
278                  in (fromIntegral i, encodeFloat (fromIntegral f) n)
279
280     truncate x  = case properFraction x of
281                      (n,_) -> n
282
283     round x     = case properFraction x of
284                      (n,r) -> let
285                                 m         = if r < 0.0 then n - 1 else n + 1
286                                 half_down = abs r - 0.5
287                               in
288                               case (compare half_down 0.0) of
289                                 LT -> n
290                                 EQ -> if even n then n else m
291                                 GT -> m
292
293     ceiling x   = case properFraction x of
294                     (n,r) -> if r > 0.0 then n + 1 else n
295
296     floor x     = case properFraction x of
297                     (n,r) -> if r < 0.0 then n - 1 else n
298
299 instance  Floating Float  where
300     pi                  =  3.141592653589793238
301     exp x               =  expFloat x
302     log x               =  logFloat x
303     sqrt x              =  sqrtFloat x
304     sin x               =  sinFloat x
305     cos x               =  cosFloat x
306     tan x               =  tanFloat x
307     asin x              =  asinFloat x
308     acos x              =  acosFloat x
309     atan x              =  atanFloat x
310     sinh x              =  sinhFloat x
311     cosh x              =  coshFloat x
312     tanh x              =  tanhFloat x
313     (**) x y            =  powerFloat x y
314     logBase x y         =  log y / log x
315
316     asinh x = log (x + sqrt (1.0+x*x))
317     acosh x = log (x + (x+1.0) * sqrt ((x-1.0)/(x+1.0)))
318     atanh x = 0.5 * log ((1.0+x) / (1.0-x))
319
320 instance  RealFloat Float  where
321     floatRadix _        =  FLT_RADIX        -- from float.h
322     floatDigits _       =  FLT_MANT_DIG     -- ditto
323     floatRange _        =  (FLT_MIN_EXP, FLT_MAX_EXP) -- ditto
324
325     decodeFloat (F# f#) = case decodeFloat_Int# f# of
326                           (# i, e #) -> (smallInteger i, I# e)
327
328     encodeFloat i (I# e) = F# (encodeFloatInteger i e)
329
330     exponent x          = case decodeFloat x of
331                             (m,n) -> if m == 0 then 0 else n + floatDigits x
332
333     significand x       = case decodeFloat x of
334                             (m,_) -> encodeFloat m (negate (floatDigits x))
335
336     scaleFloat 0 x      = x
337     scaleFloat k x
338       | isFix           = x
339       | otherwise       = case decodeFloat x of
340                             (m,n) -> encodeFloat m (n + clamp bf k)
341                         where bf = FLT_MAX_EXP - (FLT_MIN_EXP) + 4*FLT_MANT_DIG
342                               isFix = x == 0 || isFloatFinite x == 0
343
344     isNaN x          = 0 /= isFloatNaN x
345     isInfinite x     = 0 /= isFloatInfinite x
346     isDenormalized x = 0 /= isFloatDenormalized x
347     isNegativeZero x = 0 /= isFloatNegativeZero x
348     isIEEE _         = True
349
350 instance  Show Float  where
351     showsPrec   x = showSignedFloat showFloat x
352     showList = showList__ (showsPrec 0)
353 \end{code}
354
355 %*********************************************************
356 %*                                                      *
357 \subsection{Type @Double@}
358 %*                                                      *
359 %*********************************************************
360
361 \begin{code}
362 instance  Num Double  where
363     (+)         x y     =  plusDouble x y
364     (-)         x y     =  minusDouble x y
365     negate      x       =  negateDouble x
366     (*)         x y     =  timesDouble x y
367     abs x    | x == 0    = 0 -- handles (-0.0)
368              | x >  0    = x
369              | otherwise = negateDouble x
370     signum x | x > 0     = 1
371              | x < 0     = negateDouble 1
372              | otherwise = x -- handles 0.0, (-0.0), and NaN
373
374
375     {-# INLINE fromInteger #-}
376     fromInteger i = D# (doubleFromInteger i)
377
378
379 instance  Real Double  where
380     toRational (D# x#)  =
381         case decodeDoubleInteger x# of
382           (# m, e# #)
383             | isTrue# (e# >=# 0#)                                  ->
384                 shiftLInteger m e# :% 1
385             | isTrue# ((integerToWord m `and#` 1##) `eqWord#` 0##) ->
386                 case elimZerosInteger m (negateInt# e#) of
387                     (# n, d# #) ->  n :% shiftLInteger 1 d#
388             | otherwise                                            ->
389                 m :% shiftLInteger 1 (negateInt# e#)
390
391 instance  Fractional Double  where
392     (/) x y             =  divideDouble x y
393     {-# INLINE fromRational #-}
394     fromRational (n:%d) = rationalToDouble n d
395     recip x             =  1.0 / x
396
397 rationalToDouble :: Integer -> Integer -> Double
398 {-# NOINLINE [1] rationalToDouble #-}
399 rationalToDouble n 0
400     | n == 0        = 0/0
401     | n < 0         = (-1)/0
402     | otherwise     = 1/0
403 rationalToDouble n d
404     | n == 0        = encodeFloat 0 0
405     | n < 0         = -(fromRat'' minEx mantDigs (-n) d)
406     | otherwise     = fromRat'' minEx mantDigs n d
407       where
408         minEx       = DBL_MIN_EXP
409         mantDigs    = DBL_MANT_DIG
410
411 instance  Floating Double  where
412     pi                  =  3.141592653589793238
413     exp x               =  expDouble x
414     log x               =  logDouble x
415     sqrt x              =  sqrtDouble x
416     sin  x              =  sinDouble x
417     cos  x              =  cosDouble x
418     tan  x              =  tanDouble x
419     asin x              =  asinDouble x
420     acos x              =  acosDouble x
421     atan x              =  atanDouble x
422     sinh x              =  sinhDouble x
423     cosh x              =  coshDouble x
424     tanh x              =  tanhDouble x
425     (**) x y            =  powerDouble x y
426     logBase x y         =  log y / log x
427
428     asinh x = log (x + sqrt (1.0+x*x))
429     acosh x = log (x + (x+1.0) * sqrt ((x-1.0)/(x+1.0)))
430     atanh x = 0.5 * log ((1.0+x) / (1.0-x))
431
432 -- RULES for Integer and Int
433 {-# RULES
434 "properFraction/Double->Integer"    properFraction = properFractionDoubleInteger
435 "truncate/Double->Integer"          truncate = truncateDoubleInteger
436 "floor/Double->Integer"             floor = floorDoubleInteger
437 "ceiling/Double->Integer"           ceiling = ceilingDoubleInteger
438 "round/Double->Integer"             round = roundDoubleInteger
439 "properFraction/Double->Int"        properFraction = properFractionDoubleInt
440 "truncate/Double->Int"              truncate = double2Int
441 "floor/Double->Int"                 floor = floorDoubleInt
442 "ceiling/Double->Int"               ceiling = ceilingDoubleInt
443 "round/Double->Int"                 round = roundDoubleInt
444   #-}
445 instance  RealFrac Double  where
446
447         -- ceiling, floor, and truncate are all small
448     {-# INLINE [1] ceiling #-}
449     {-# INLINE [1] floor #-}
450     {-# INLINE [1] truncate #-}
451
452     properFraction x
453       = case (decodeFloat x)      of { (m,n) ->
454         if n >= 0 then
455             (fromInteger m * 2 ^ n, 0.0)
456         else
457             case (quotRem m (2^(negate n))) of { (w,r) ->
458             (fromInteger w, encodeFloat r n)
459             }
460         }
461
462     truncate x  = case properFraction x of
463                      (n,_) -> n
464
465     round x     = case properFraction x of
466                      (n,r) -> let
467                                 m         = if r < 0.0 then n - 1 else n + 1
468                                 half_down = abs r - 0.5
469                               in
470                               case (compare half_down 0.0) of
471                                 LT -> n
472                                 EQ -> if even n then n else m
473                                 GT -> m
474
475     ceiling x   = case properFraction x of
476                     (n,r) -> if r > 0.0 then n + 1 else n
477
478     floor x     = case properFraction x of
479                     (n,r) -> if r < 0.0 then n - 1 else n
480
481 instance  RealFloat Double  where
482     floatRadix _        =  FLT_RADIX        -- from float.h
483     floatDigits _       =  DBL_MANT_DIG     -- ditto
484     floatRange _        =  (DBL_MIN_EXP, DBL_MAX_EXP) -- ditto
485
486     decodeFloat (D# x#)
487       = case decodeDoubleInteger x#   of
488           (# i, j #) -> (i, I# j)
489
490     encodeFloat i (I# j) = D# (encodeDoubleInteger i j)
491
492     exponent x          = case decodeFloat x of
493                             (m,n) -> if m == 0 then 0 else n + floatDigits x
494
495     significand x       = case decodeFloat x of
496                             (m,_) -> encodeFloat m (negate (floatDigits x))
497
498     scaleFloat 0 x      = x
499     scaleFloat k x
500       | isFix           = x
501       | otherwise       = case decodeFloat x of
502                             (m,n) -> encodeFloat m (n + clamp bd k)
503                         where bd = DBL_MAX_EXP - (DBL_MIN_EXP) + 4*DBL_MANT_DIG
504                               isFix = x == 0 || isDoubleFinite x == 0
505
506     isNaN x             = 0 /= isDoubleNaN x
507     isInfinite x        = 0 /= isDoubleInfinite x
508     isDenormalized x    = 0 /= isDoubleDenormalized x
509     isNegativeZero x    = 0 /= isDoubleNegativeZero x
510     isIEEE _            = True
511
512 instance  Show Double  where
513     showsPrec   x = showSignedFloat showFloat x
514     showList = showList__ (showsPrec 0)
515 \end{code}
516
517 %*********************************************************
518 %*                                                      *
519 \subsection{@Enum@ instances}
520 %*                                                      *
521 %*********************************************************
522
523 The @Enum@ instances for Floats and Doubles are slightly unusual.
524 The @toEnum@ function truncates numbers to Int.  The definitions
525 of @enumFrom@ and @enumFromThen@ allow floats to be used in arithmetic
526 series: [0,0.1 .. 1.0].  However, roundoff errors make these somewhat
527 dubious.  This example may have either 10 or 11 elements, depending on
528 how 0.1 is represented.
529
530 NOTE: The instances for Float and Double do not make use of the default
531 methods for @enumFromTo@ and @enumFromThenTo@, as these rely on there being
532 a `non-lossy' conversion to and from Ints. Instead we make use of the
533 1.2 default methods (back in the days when Enum had Ord as a superclass)
534 for these (@numericEnumFromTo@ and @numericEnumFromThenTo@ below.)
535
536 \begin{code}
537 instance  Enum Float  where
538     succ x         = x + 1
539     pred x         = x - 1
540     toEnum         = int2Float
541     fromEnum       = fromInteger . truncate   -- may overflow
542     enumFrom       = numericEnumFrom
543     enumFromTo     = numericEnumFromTo
544     enumFromThen   = numericEnumFromThen
545     enumFromThenTo = numericEnumFromThenTo
546
547 instance  Enum Double  where
548     succ x         = x + 1
549     pred x         = x - 1
550     toEnum         =  int2Double
551     fromEnum       =  fromInteger . truncate   -- may overflow
552     enumFrom       =  numericEnumFrom
553     enumFromTo     =  numericEnumFromTo
554     enumFromThen   =  numericEnumFromThen
555     enumFromThenTo =  numericEnumFromThenTo
556 \end{code}
557
558
559 %*********************************************************
560 %*                                                      *
561 \subsection{Printing floating point}
562 %*                                                      *
563 %*********************************************************
564
565
566 \begin{code}
567 -- | Show a signed 'RealFloat' value to full precision
568 -- using standard decimal notation for arguments whose absolute value lies
569 -- between @0.1@ and @9,999,999@, and scientific notation otherwise.
570 showFloat :: (RealFloat a) => a -> ShowS
571 showFloat x  =  showString (formatRealFloat FFGeneric Nothing x)
572
573 -- These are the format types.  This type is not exported.
574
575 data FFFormat = FFExponent | FFFixed | FFGeneric
576
577 -- This is just a compatibility stub, as the "alt" argument formerly
578 -- didn't exist.
579 formatRealFloat :: (RealFloat a) => FFFormat -> Maybe Int -> a -> String
580 formatRealFloat fmt decs x = formatRealFloatAlt fmt decs False x
581
582 formatRealFloatAlt :: (RealFloat a) => FFFormat -> Maybe Int -> Bool -> a
583                  -> String
584 formatRealFloatAlt fmt decs alt x
585    | isNaN x                   = "NaN"
586    | isInfinite x              = if x < 0 then "-Infinity" else "Infinity"
587    | x < 0 || isNegativeZero x = '-':doFmt fmt (floatToDigits (toInteger base) (-x))
588    | otherwise                 = doFmt fmt (floatToDigits (toInteger base) x)
589  where
590   base = 10
591
592   doFmt format (is, e) =
593     let ds = map intToDigit is in
594     case format of
595      FFGeneric ->
596       doFmt (if e < 0 || e > 7 then FFExponent else FFFixed)
597             (is,e)
598      FFExponent ->
599       case decs of
600        Nothing ->
601         let show_e' = show (e-1) in
602         case ds of
603           "0"     -> "0.0e0"
604           [d]     -> d : ".0e" ++ show_e'
605           (d:ds') -> d : '.' : ds' ++ "e" ++ show_e'
606           []      -> error "formatRealFloat/doFmt/FFExponent: []"
607        Just dec ->
608         let dec' = max dec 1 in
609         case is of
610          [0] -> '0' :'.' : take dec' (repeat '0') ++ "e0"
611          _ ->
612           let
613            (ei,is') = roundTo base (dec'+1) is
614            (d:ds') = map intToDigit (if ei > 0 then init is' else is')
615           in
616           d:'.':ds' ++ 'e':show (e-1+ei)
617      FFFixed ->
618       let
619        mk0 ls = case ls of { "" -> "0" ; _ -> ls}
620       in
621       case decs of
622        Nothing
623           | e <= 0    -> "0." ++ replicate (-e) '0' ++ ds
624           | otherwise ->
625              let
626                 f 0 s    rs  = mk0 (reverse s) ++ '.':mk0 rs
627                 f n s    ""  = f (n-1) ('0':s) ""
628                 f n s (r:rs) = f (n-1) (r:s) rs
629              in
630                 f e "" ds
631        Just dec ->
632         let dec' = max dec 0 in
633         if e >= 0 then
634          let
635           (ei,is') = roundTo base (dec' + e) is
636           (ls,rs)  = splitAt (e+ei) (map intToDigit is')
637          in
638          mk0 ls ++ (if null rs && not alt then "" else '.':rs)
639         else
640          let
641           (ei,is') = roundTo base dec' (replicate (-e) 0 ++ is)
642           d:ds' = map intToDigit (if ei > 0 then is' else 0:is')
643          in
644          d : (if null ds' && not alt then "" else '.':ds')
645
646
647 roundTo :: Int -> Int -> [Int] -> (Int,[Int])
648 roundTo base d is =
649   case f d True is of
650     x@(0,_) -> x
651     (1,xs)  -> (1, 1:xs)
652     _       -> error "roundTo: bad Value"
653  where
654   b2 = base `quot` 2
655
656   f n _ []     = (0, replicate n 0)
657   f 0 e (x:xs) | x == b2 && e && all (== 0) xs = (0, [])   -- Round to even when at exactly half the base
658                | otherwise = (if x >= b2 then 1 else 0, [])
659   f n _ (i:xs)
660      | i' == base = (1,0:ds)
661      | otherwise  = (0,i':ds)
662       where
663        (c,ds) = f (n-1) (even i) xs
664        i'     = c + i
665
666 -- Based on "Printing Floating-Point Numbers Quickly and Accurately"
667 -- by R.G. Burger and R.K. Dybvig in PLDI 96.
668 -- This version uses a much slower logarithm estimator. It should be improved.
669
670 -- | 'floatToDigits' takes a base and a non-negative 'RealFloat' number,
671 -- and returns a list of digits and an exponent.
672 -- In particular, if @x>=0@, and
673 --
674 -- > floatToDigits base x = ([d1,d2,...,dn], e)
675 --
676 -- then
677 --
678 --      (1) @n >= 1@
679 --
680 --      (2) @x = 0.d1d2...dn * (base**e)@
681 --
682 --      (3) @0 <= di <= base-1@
683
684 floatToDigits :: (RealFloat a) => Integer -> a -> ([Int], Int)
685 floatToDigits _ 0 = ([0], 0)
686 floatToDigits base x =
687  let
688   (f0, e0) = decodeFloat x
689   (minExp0, _) = floatRange x
690   p = floatDigits x
691   b = floatRadix x
692   minExp = minExp0 - p -- the real minimum exponent
693   -- Haskell requires that f be adjusted so denormalized numbers
694   -- will have an impossibly low exponent.  Adjust for this.
695   (f, e) =
696    let n = minExp - e0 in
697    if n > 0 then (f0 `quot` (expt b n), e0+n) else (f0, e0)
698   (r, s, mUp, mDn) =
699    if e >= 0 then
700     let be = expt b e in
701     if f == expt b (p-1) then
702       (f*be*b*2, 2*b, be*b, be)     -- according to Burger and Dybvig
703     else
704       (f*be*2, 2, be, be)
705    else
706     if e > minExp && f == expt b (p-1) then
707       (f*b*2, expt b (-e+1)*2, b, 1)
708     else
709       (f*2, expt b (-e)*2, 1, 1)
710   k :: Int
711   k =
712    let
713     k0 :: Int
714     k0 =
715      if b == 2 && base == 10 then
716         -- logBase 10 2 is very slightly larger than 8651/28738
717         -- (about 5.3558e-10), so if log x >= 0, the approximation
718         -- k1 is too small, hence we add one and need one fixup step less.
719         -- If log x < 0, the approximation errs rather on the high side.
720         -- That is usually more than compensated for by ignoring the
721         -- fractional part of logBase 2 x, but when x is a power of 1/2
722         -- or slightly larger and the exponent is a multiple of the
723         -- denominator of the rational approximation to logBase 10 2,
724         -- k1 is larger than logBase 10 x. If k1 > 1 + logBase 10 x,
725         -- we get a leading zero-digit we don't want.
726         -- With the approximation 3/10, this happened for
727         -- 0.5^1030, 0.5^1040, ..., 0.5^1070 and values close above.
728         -- The approximation 8651/28738 guarantees k1 < 1 + logBase 10 x
729         -- for IEEE-ish floating point types with exponent fields
730         -- <= 17 bits and mantissae of several thousand bits, earlier
731         -- convergents to logBase 10 2 would fail for long double.
732         -- Using quot instead of div is a little faster and requires
733         -- fewer fixup steps for negative lx.
734         let lx = p - 1 + e0
735             k1 = (lx * 8651) `quot` 28738
736         in if lx >= 0 then k1 + 1 else k1
737      else
738         -- f :: Integer, log :: Float -> Float,
739         --               ceiling :: Float -> Int
740         ceiling ((log (fromInteger (f+1) :: Float) +
741                  fromIntegral e * log (fromInteger b)) /
742                    log (fromInteger base))
743 --WAS:            fromInt e * log (fromInteger b))
744
745     fixup n =
746       if n >= 0 then
747         if r + mUp <= expt base n * s then n else fixup (n+1)
748       else
749         if expt base (-n) * (r + mUp) <= s then n else fixup (n+1)
750    in
751    fixup k0
752
753   gen ds rn sN mUpN mDnN =
754    let
755     (dn, rn') = (rn * base) `quotRem` sN
756     mUpN' = mUpN * base
757     mDnN' = mDnN * base
758    in
759    case (rn' < mDnN', rn' + mUpN' > sN) of
760     (True,  False) -> dn : ds
761     (False, True)  -> dn+1 : ds
762     (True,  True)  -> if rn' * 2 < sN then dn : ds else dn+1 : ds
763     (False, False) -> gen (dn:ds) rn' sN mUpN' mDnN'
764
765   rds =
766    if k >= 0 then
767       gen [] r (s * expt base k) mUp mDn
768    else
769      let bk = expt base (-k) in
770      gen [] (r * bk) s (mUp * bk) (mDn * bk)
771  in
772  (map fromIntegral (reverse rds), k)
773
774 \end{code}
775
776
777 %*********************************************************
778 %*                                                      *
779 \subsection{Converting from a Rational to a RealFloat
780 %*                                                      *
781 %*********************************************************
782
783 [In response to a request for documentation of how fromRational works,
784 Joe Fasel writes:] A quite reasonable request!  This code was added to
785 the Prelude just before the 1.2 release, when Lennart, working with an
786 early version of hbi, noticed that (read . show) was not the identity
787 for floating-point numbers.  (There was a one-bit error about half the
788 time.)  The original version of the conversion function was in fact
789 simply a floating-point divide, as you suggest above. The new version
790 is, I grant you, somewhat denser.
791
792 Unfortunately, Joe's code doesn't work!  Here's an example:
793
794 main = putStr (shows (1.82173691287639817263897126389712638972163e-300::Double) "\n")
795
796 This program prints
797         0.0000000000000000
798 instead of
799         1.8217369128763981e-300
800
801 Here's Joe's code:
802
803 \begin{pseudocode}
804 fromRat :: (RealFloat a) => Rational -> a
805 fromRat x = x'
806         where x' = f e
807
808 --              If the exponent of the nearest floating-point number to x
809 --              is e, then the significand is the integer nearest xb^(-e),
810 --              where b is the floating-point radix.  We start with a good
811 --              guess for e, and if it is correct, the exponent of the
812 --              floating-point number we construct will again be e.  If
813 --              not, one more iteration is needed.
814
815               f e   = if e' == e then y else f e'
816                       where y      = encodeFloat (round (x * (1 % b)^^e)) e
817                             (_,e') = decodeFloat y
818               b     = floatRadix x'
819
820 --              We obtain a trial exponent by doing a floating-point
821 --              division of x's numerator by its denominator.  The
822 --              result of this division may not itself be the ultimate
823 --              result, because of an accumulation of three rounding
824 --              errors.
825
826               (s,e) = decodeFloat (fromInteger (numerator x) `asTypeOf` x'
827                                         / fromInteger (denominator x))
828 \end{pseudocode}
829
830 Now, here's Lennart's code (which works)
831
832 \begin{code}
833 -- | Converts a 'Rational' value into any type in class 'RealFloat'.
834 {-# RULES
835 "fromRat/Float"     fromRat = (fromRational :: Rational -> Float)
836 "fromRat/Double"    fromRat = (fromRational :: Rational -> Double)
837   #-}
838
839 {-# NOINLINE [1] fromRat #-}
840 fromRat :: (RealFloat a) => Rational -> a
841
842 -- Deal with special cases first, delegating the real work to fromRat'
843 fromRat (n :% 0) | n > 0     =  1/0        -- +Infinity
844                  | n < 0     = -1/0        -- -Infinity
845                  | otherwise =  0/0        -- NaN
846
847 fromRat (n :% d) | n > 0     = fromRat' (n :% d)
848                  | n < 0     = - fromRat' ((-n) :% d)
849                  | otherwise = encodeFloat 0 0             -- Zero
850
851 -- Conversion process:
852 -- Scale the rational number by the RealFloat base until
853 -- it lies in the range of the mantissa (as used by decodeFloat/encodeFloat).
854 -- Then round the rational to an Integer and encode it with the exponent
855 -- that we got from the scaling.
856 -- To speed up the scaling process we compute the log2 of the number to get
857 -- a first guess of the exponent.
858
859 fromRat' :: (RealFloat a) => Rational -> a
860 -- Invariant: argument is strictly positive
861 fromRat' x = r
862   where b = floatRadix r
863         p = floatDigits r
864         (minExp0, _) = floatRange r
865         minExp = minExp0 - p            -- the real minimum exponent
866         xMax   = toRational (expt b p)
867         p0 = (integerLogBase b (numerator x) - integerLogBase b (denominator x) - p) `max` minExp
868         -- if x = n/d and ln = integerLogBase b n, ld = integerLogBase b d,
869         -- then b^(ln-ld-1) < x < b^(ln-ld+1)
870         f = if p0 < 0 then 1 :% expt b (-p0) else expt b p0 :% 1
871         x0 = x / f
872         -- if ln - ld >= minExp0, then b^(p-1) < x0 < b^(p+1), so there's at most
873         -- one scaling step needed, otherwise, x0 < b^p and no scaling is needed
874         (x', p') = if x0 >= xMax then (x0 / toRational b, p0+1) else (x0, p0)
875         r = encodeFloat (round x') p'
876
877 -- Exponentiation with a cache for the most common numbers.
878 minExpt, maxExpt :: Int
879 minExpt = 0
880 maxExpt = 1100
881
882 expt :: Integer -> Int -> Integer
883 expt base n =
884     if base == 2 && n >= minExpt && n <= maxExpt then
885         expts!n
886     else
887         if base == 10 && n <= maxExpt10 then
888             expts10!n
889         else
890             base^n
891
892 expts :: Array Int Integer
893 expts = array (minExpt,maxExpt) [(n,2^n) | n <- [minExpt .. maxExpt]]
894
895 maxExpt10 :: Int
896 maxExpt10 = 324
897
898 expts10 :: Array Int Integer
899 expts10 = array (minExpt,maxExpt10) [(n,10^n) | n <- [minExpt .. maxExpt10]]
900
901 -- Compute the (floor of the) log of i in base b.
902 -- Simplest way would be just divide i by b until it's smaller then b, but that would
903 -- be very slow!  We are just slightly more clever, except for base 2, where
904 -- we take advantage of the representation of Integers.
905 -- The general case could be improved by a lookup table for
906 -- approximating the result by integerLog2 i / integerLog2 b.
907 integerLogBase :: Integer -> Integer -> Int
908 integerLogBase b i
909    | i < b     = 0
910    | b == 2    = I# (integerLog2# i)
911    | otherwise = I# (integerLogBase# b i)
912
913 \end{code}
914
915 Unfortunately, the old conversion code was awfully slow due to
916 a) a slow integer logarithm
917 b) repeated calculation of gcd's
918
919 For the case of Rational's coming from a Float or Double via toRational,
920 we can exploit the fact that the denominator is a power of two, which for
921 these brings a huge speedup since we need only shift and add instead
922 of division.
923
924 The below is an adaption of fromRat' for the conversion to
925 Float or Double exploiting the known floatRadix and avoiding
926 divisions as much as possible.
927
928 \begin{code}
929 {-# SPECIALISE fromRat'' :: Int -> Int -> Integer -> Integer -> Float,
930                             Int -> Int -> Integer -> Integer -> Double #-}
931 fromRat'' :: RealFloat a => Int -> Int -> Integer -> Integer -> a
932 -- Invariant: n and d strictly positive
933 fromRat'' minEx@(I# me#) mantDigs@(I# md#) n d =
934     case integerLog2IsPowerOf2# d of
935       (# ld#, pw# #)
936         | isTrue# (pw# ==# 0#) ->
937           case integerLog2# n of
938             ln# | isTrue# (ln# >=# (ld# +# me# -# 1#)) ->
939                   -- this means n/d >= 2^(minEx-1), i.e. we are guaranteed to get
940                   -- a normalised number, round to mantDigs bits
941                   if isTrue# (ln# <# md#)
942                     then encodeFloat n (I# (negateInt# ld#))
943                     else let n'  = n `shiftR` (I# (ln# +# 1# -# md#))
944                              n'' = case roundingMode# n (ln# -# md#) of
945                                     0# -> n'
946                                     2# -> n' + 1
947                                     _  -> case fromInteger n' .&. (1 :: Int) of
948                                             0 -> n'
949                                             _ -> n' + 1
950                          in encodeFloat n'' (I# (ln# -# ld# +# 1# -# md#))
951                 | otherwise ->
952                   -- n/d < 2^(minEx-1), a denorm or rounded to 2^(minEx-1)
953                   -- the exponent for encoding is always minEx-mantDigs
954                   -- so we must shift right by (minEx-mantDigs) - (-ld)
955                   case ld# +# (me# -# md#) of
956                     ld'# | isTrue# (ld'# <=# 0#) -> -- we would shift left, so we don't shift
957                            encodeFloat n (I# ((me# -# md#) -# ld'#))
958                          | isTrue# (ld'# <=# ln#) ->
959                            let n' = n `shiftR` (I# ld'#)
960                            in case roundingMode# n (ld'# -# 1#) of
961                                 0# -> encodeFloat n' (minEx - mantDigs)
962                                 1# -> if fromInteger n' .&. (1 :: Int) == 0
963                                         then encodeFloat n' (minEx-mantDigs)
964                                         else encodeFloat (n' + 1) (minEx-mantDigs)
965                                 _  -> encodeFloat (n' + 1) (minEx-mantDigs)
966                          | isTrue# (ld'# ># (ln# +# 1#)) -> encodeFloat 0 0 -- result of shift < 0.5
967                          | otherwise ->  -- first bit of n shifted to 0.5 place
968                            case integerLog2IsPowerOf2# n of
969                             (# _, 0# #) -> encodeFloat 0 0  -- round to even
970                             (# _, _ #)  -> encodeFloat 1 (minEx - mantDigs)
971         | otherwise ->
972           let ln = I# (integerLog2# n)
973               ld = I# ld#
974               -- 2^(ln-ld-1) < n/d < 2^(ln-ld+1)
975               p0 = max minEx (ln - ld)
976               (n', d')
977                 | p0 < mantDigs = (n `shiftL` (mantDigs - p0), d)
978                 | p0 == mantDigs = (n, d)
979                 | otherwise     = (n, d `shiftL` (p0 - mantDigs))
980               -- if ln-ld < minEx, then n'/d' < 2^mantDigs, else
981               -- 2^(mantDigs-1) < n'/d' < 2^(mantDigs+1) and we
982               -- may need one scaling step
983               scale p a b
984                 | (b `shiftL` mantDigs) <= a = (p+1, a, b `shiftL` 1)
985                 | otherwise = (p, a, b)
986               (p', n'', d'') = scale (p0-mantDigs) n' d'
987               -- n''/d'' < 2^mantDigs and p' == minEx-mantDigs or n''/d'' >= 2^(mantDigs-1)
988               rdq = case n'' `quotRem` d'' of
989                      (q,r) -> case compare (r `shiftL` 1) d'' of
990                                 LT -> q
991                                 EQ -> if fromInteger q .&. (1 :: Int) == 0
992                                         then q else q+1
993                                 GT -> q+1
994           in  encodeFloat rdq p'
995 \end{code}
996
997
998 %*********************************************************
999 %*                                                      *
1000 \subsection{Floating point numeric primops}
1001 %*                                                      *
1002 %*********************************************************
1003
1004 Definitions of the boxed PrimOps; these will be
1005 used in the case of partial applications, etc.
1006
1007 \begin{code}
1008 plusFloat, minusFloat, timesFloat, divideFloat :: Float -> Float -> Float
1009 plusFloat   (F# x) (F# y) = F# (plusFloat# x y)
1010 minusFloat  (F# x) (F# y) = F# (minusFloat# x y)
1011 timesFloat  (F# x) (F# y) = F# (timesFloat# x y)
1012 divideFloat (F# x) (F# y) = F# (divideFloat# x y)
1013
1014 negateFloat :: Float -> Float
1015 negateFloat (F# x)        = F# (negateFloat# x)
1016
1017 gtFloat, geFloat, eqFloat, neFloat, ltFloat, leFloat :: Float -> Float -> Bool
1018 gtFloat     (F# x) (F# y) = isTrue# (gtFloat# x y)
1019 geFloat     (F# x) (F# y) = isTrue# (geFloat# x y)
1020 eqFloat     (F# x) (F# y) = isTrue# (eqFloat# x y)
1021 neFloat     (F# x) (F# y) = isTrue# (neFloat# x y)
1022 ltFloat     (F# x) (F# y) = isTrue# (ltFloat# x y)
1023 leFloat     (F# x) (F# y) = isTrue# (leFloat# x y)
1024
1025 expFloat, logFloat, sqrtFloat :: Float -> Float
1026 sinFloat, cosFloat, tanFloat  :: Float -> Float
1027 asinFloat, acosFloat, atanFloat  :: Float -> Float
1028 sinhFloat, coshFloat, tanhFloat  :: Float -> Float
1029 expFloat    (F# x) = F# (expFloat# x)
1030 logFloat    (F# x) = F# (logFloat# x)
1031 sqrtFloat   (F# x) = F# (sqrtFloat# x)
1032 sinFloat    (F# x) = F# (sinFloat# x)
1033 cosFloat    (F# x) = F# (cosFloat# x)
1034 tanFloat    (F# x) = F# (tanFloat# x)
1035 asinFloat   (F# x) = F# (asinFloat# x)
1036 acosFloat   (F# x) = F# (acosFloat# x)
1037 atanFloat   (F# x) = F# (atanFloat# x)
1038 sinhFloat   (F# x) = F# (sinhFloat# x)
1039 coshFloat   (F# x) = F# (coshFloat# x)
1040 tanhFloat   (F# x) = F# (tanhFloat# x)
1041
1042 powerFloat :: Float -> Float -> Float
1043 powerFloat  (F# x) (F# y) = F# (powerFloat# x y)
1044
1045 -- definitions of the boxed PrimOps; these will be
1046 -- used in the case of partial applications, etc.
1047
1048 plusDouble, minusDouble, timesDouble, divideDouble :: Double -> Double -> Double
1049 plusDouble   (D# x) (D# y) = D# (x +## y)
1050 minusDouble  (D# x) (D# y) = D# (x -## y)
1051 timesDouble  (D# x) (D# y) = D# (x *## y)
1052 divideDouble (D# x) (D# y) = D# (x /## y)
1053
1054 negateDouble :: Double -> Double
1055 negateDouble (D# x)        = D# (negateDouble# x)
1056
1057 gtDouble, geDouble, eqDouble, neDouble, leDouble, ltDouble :: Double -> Double -> Bool
1058 gtDouble    (D# x) (D# y) = isTrue# (x >##  y)
1059 geDouble    (D# x) (D# y) = isTrue# (x >=## y)
1060 eqDouble    (D# x) (D# y) = isTrue# (x ==## y)
1061 neDouble    (D# x) (D# y) = isTrue# (x /=## y)
1062 ltDouble    (D# x) (D# y) = isTrue# (x <##  y)
1063 leDouble    (D# x) (D# y) = isTrue# (x <=## y)
1064
1065 double2Float :: Double -> Float
1066 double2Float (D# x) = F# (double2Float# x)
1067
1068 float2Double :: Float -> Double
1069 float2Double (F# x) = D# (float2Double# x)
1070
1071 expDouble, logDouble, sqrtDouble :: Double -> Double
1072 sinDouble, cosDouble, tanDouble  :: Double -> Double
1073 asinDouble, acosDouble, atanDouble  :: Double -> Double
1074 sinhDouble, coshDouble, tanhDouble  :: Double -> Double
1075 expDouble    (D# x) = D# (expDouble# x)
1076 logDouble    (D# x) = D# (logDouble# x)
1077 sqrtDouble   (D# x) = D# (sqrtDouble# x)
1078 sinDouble    (D# x) = D# (sinDouble# x)
1079 cosDouble    (D# x) = D# (cosDouble# x)
1080 tanDouble    (D# x) = D# (tanDouble# x)
1081 asinDouble   (D# x) = D# (asinDouble# x)
1082 acosDouble   (D# x) = D# (acosDouble# x)
1083 atanDouble   (D# x) = D# (atanDouble# x)
1084 sinhDouble   (D# x) = D# (sinhDouble# x)
1085 coshDouble   (D# x) = D# (coshDouble# x)
1086 tanhDouble   (D# x) = D# (tanhDouble# x)
1087
1088 powerDouble :: Double -> Double -> Double
1089 powerDouble  (D# x) (D# y) = D# (x **## y)
1090 \end{code}
1091
1092 \begin{code}
1093 foreign import ccall unsafe "isFloatNaN" isFloatNaN :: Float -> Int
1094 foreign import ccall unsafe "isFloatInfinite" isFloatInfinite :: Float -> Int
1095 foreign import ccall unsafe "isFloatDenormalized" isFloatDenormalized :: Float -> Int
1096 foreign import ccall unsafe "isFloatNegativeZero" isFloatNegativeZero :: Float -> Int
1097 foreign import ccall unsafe "isFloatFinite" isFloatFinite :: Float -> Int
1098
1099 foreign import ccall unsafe "isDoubleNaN" isDoubleNaN :: Double -> Int
1100 foreign import ccall unsafe "isDoubleInfinite" isDoubleInfinite :: Double -> Int
1101 foreign import ccall unsafe "isDoubleDenormalized" isDoubleDenormalized :: Double -> Int
1102 foreign import ccall unsafe "isDoubleNegativeZero" isDoubleNegativeZero :: Double -> Int
1103 foreign import ccall unsafe "isDoubleFinite" isDoubleFinite :: Double -> Int
1104 \end{code}
1105
1106 %*********************************************************
1107 %*                                                      *
1108 \subsection{Coercion rules}
1109 %*                                                      *
1110 %*********************************************************
1111
1112 \begin{code}
1113
1114 word2Double :: Word -> Double
1115 word2Double (W# w) = D# (word2Double# w)
1116
1117 word2Float :: Word -> Float
1118 word2Float (W# w) = F# (word2Float# w)
1119
1120 {-# RULES
1121 "fromIntegral/Int->Float"   fromIntegral = int2Float
1122 "fromIntegral/Int->Double"  fromIntegral = int2Double
1123 "fromIntegral/Word->Float"  fromIntegral = word2Float
1124 "fromIntegral/Word->Double" fromIntegral = word2Double
1125 "realToFrac/Float->Float"   realToFrac   = id :: Float -> Float
1126 "realToFrac/Float->Double"  realToFrac   = float2Double
1127 "realToFrac/Double->Float"  realToFrac   = double2Float
1128 "realToFrac/Double->Double" realToFrac   = id :: Double -> Double
1129 "realToFrac/Int->Double"    realToFrac   = int2Double   -- See Note [realToFrac int-to-float]
1130 "realToFrac/Int->Float"     realToFrac   = int2Float    --      ..ditto
1131     #-}
1132 \end{code}
1133
1134 Note [realToFrac int-to-float]
1135 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1136 Don found that the RULES for realToFrac/Int->Double and simliarly
1137 Float made a huge difference to some stream-fusion programs.  Here's
1138 an example
1139
1140       import Data.Array.Vector
1141
1142       n = 40000000
1143
1144       main = do
1145             let c = replicateU n (2::Double)
1146                 a = mapU realToFrac (enumFromToU 0 (n-1) ) :: UArr Double
1147             print (sumU (zipWithU (*) c a))
1148
1149 Without the RULE we get this loop body:
1150
1151       case $wtoRational sc_sY4 of ww_aM7 { (# ww1_aM9, ww2_aMa #) ->
1152       case $wfromRat ww1_aM9 ww2_aMa of tpl_X1P { D# ipv_sW3 ->
1153       Main.$s$wfold
1154         (+# sc_sY4 1)
1155         (+# wild_X1i 1)
1156         (+## sc2_sY6 (*## 2.0 ipv_sW3))
1157
1158 And with the rule:
1159
1160      Main.$s$wfold
1161         (+# sc_sXT 1)
1162         (+# wild_X1h 1)
1163         (+## sc2_sXV (*## 2.0 (int2Double# sc_sXT)))
1164
1165 The running time of the program goes from 120 seconds to 0.198 seconds
1166 with the native backend, and 0.143 seconds with the C backend.
1167
1168 A few more details in Trac #2251, and the patch message
1169 "Add RULES for realToFrac from Int".
1170
1171 %*********************************************************
1172 %*                                                      *
1173 \subsection{Utils}
1174 %*                                                      *
1175 %*********************************************************
1176
1177 \begin{code}
1178 showSignedFloat :: (RealFloat a)
1179   => (a -> ShowS)       -- ^ a function that can show unsigned values
1180   -> Int                -- ^ the precedence of the enclosing context
1181   -> a                  -- ^ the value to show
1182   -> ShowS
1183 showSignedFloat showPos p x
1184    | x < 0 || isNegativeZero x
1185        = showParen (p > 6) (showChar '-' . showPos (-x))
1186    | otherwise = showPos x
1187 \end{code}
1188
1189 We need to prevent over/underflow of the exponent in encodeFloat when
1190 called from scaleFloat, hence we clamp the scaling parameter.
1191 We must have a large enough range to cover the maximum difference of
1192 exponents returned by decodeFloat.
1193 \begin{code}
1194 clamp :: Int -> Int -> Int
1195 clamp bd k = max (-bd) (min bd k)
1196 \end{code}