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