{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE CPP
           , GHCForeignImportPrim
           , NoImplicitPrelude
           , MagicHash
           , UnboxedTuples
           , UnliftedFFITypes
  #-}
{-# LANGUAGE CApiFFI #-}
-- We believe we could deorphan this module, by moving lots of things
-- around, but we haven't got there yet:
{-# OPTIONS_GHC -Wno-orphans #-}
{-# OPTIONS_HADDOCK not-home #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  GHC.Float
-- Copyright   :  (c) The University of Glasgow 1994-2002
--                Portions obtained from hbc (c) Lennart Augusstson
-- License     :  see libraries/base/LICENSE
--
-- Maintainer  :  cvs-ghc@haskell.org
-- Stability   :  internal
-- Portability :  non-portable (GHC Extensions)
--
-- The types 'Float' and 'Double', the classes 'Floating' and 'RealFloat' and
-- casting between Word32 and Float and Word64 and Double.
--
-----------------------------------------------------------------------------

#include "ieee-flpt.h"
#include "MachDeps.h"

module GHC.Float
   ( module GHC.Float
   , Float(..), Double(..), Float#, Double#
   , double2Int, int2Double, float2Int, int2Float

    -- * Monomorphic equality operators
    -- | See GHC.Classes#matching_overloaded_methods_in_rules
   , eqFloat, eqDouble
   ) where

import Data.Maybe

import Data.Bits
import GHC.Base
import GHC.List
import GHC.Enum
import GHC.Show
import GHC.Num
import GHC.Real
import GHC.Word
import GHC.Arr
import GHC.Float.RealFracMethods
import GHC.Float.ConversionUtils
import GHC.Integer.Logarithms ( integerLogBase# )
import GHC.Integer.Logarithms.Internals

infixr 8  **

------------------------------------------------------------------------
-- Standard numeric classes
------------------------------------------------------------------------

-- | Trigonometric and hyperbolic functions and related functions.
--
-- The Haskell Report defines no laws for 'Floating'. However, @('+')@, @('*')@
-- and 'exp' are customarily expected to define an exponential field and have
-- the following properties:
--
-- * @exp (a + b)@ = @exp a * exp b@
-- * @exp (fromInteger 0)@ = @fromInteger 1@
--
class  (Fractional a) => Floating a  where
    pi                  :: a
    exp, log, sqrt      :: a -> a
    (**), logBase       :: a -> a -> a
    sin, cos, tan       :: a -> a
    asin, acos, atan    :: a -> a
    sinh, cosh, tanh    :: a -> a
    asinh, acosh, atanh :: a -> a

    -- | @'log1p' x@ computes @'log' (1 + x)@, but provides more precise
    -- results for small (absolute) values of @x@ if possible.
    --
    -- @since 4.9.0.0
    log1p               :: a -> a

    -- | @'expm1' x@ computes @'exp' x - 1@, but provides more precise
    -- results for small (absolute) values of @x@ if possible.
    --
    -- @since 4.9.0.0
    expm1               :: a -> a

    -- | @'log1pexp' x@ computes @'log' (1 + 'exp' x)@, but provides more
    -- precise results if possible.
    --
    -- Examples:
    --
    -- * if @x@ is a large negative number, @'log' (1 + 'exp' x)@ will be
    --   imprecise for the reasons given in 'log1p'.
    --
    -- * if @'exp' x@ is close to @-1@, @'log' (1 + 'exp' x)@ will be
    --   imprecise for the reasons given in 'expm1'.
    --
    -- @since 4.9.0.0
    log1pexp            :: a -> a

    -- | @'log1mexp' x@ computes @'log' (1 - 'exp' x)@, but provides more
    -- precise results if possible.
    --
    -- Examples:
    --
    -- * if @x@ is a large negative number, @'log' (1 - 'exp' x)@ will be
    --   imprecise for the reasons given in 'log1p'.
    --
    -- * if @'exp' x@ is close to @1@, @'log' (1 - 'exp' x)@ will be
    --   imprecise for the reasons given in 'expm1'.
    --
    -- @since 4.9.0.0
    log1mexp            :: a -> a

    {-# INLINE (**) #-}
    {-# INLINE logBase #-}
    {-# INLINE sqrt #-}
    {-# INLINE tan #-}
    {-# INLINE tanh #-}
    x :: a
x ** y :: a
y              =  a -> a
forall a. Floating a => a -> a
exp (a -> a
forall a. Floating a => a -> a
log a
x a -> a -> a
forall a. Num a => a -> a -> a
* a
y)
    logBase x :: a
x y :: a
y         =  a -> a
forall a. Floating a => a -> a
log a
y a -> a -> a
forall a. Fractional a => a -> a -> a
/ a -> a
forall a. Floating a => a -> a
log a
x
    sqrt x :: a
x              =  a
x a -> a -> a
forall a. Floating a => a -> a -> a
** 0.5
    tan  x :: a
x              =  a -> a
forall a. Floating a => a -> a
sin  a
x a -> a -> a
forall a. Fractional a => a -> a -> a
/ a -> a
forall a. Floating a => a -> a
cos  a
x
    tanh x :: a
x              =  a -> a
forall a. Floating a => a -> a
sinh a
x a -> a -> a
forall a. Fractional a => a -> a -> a
/ a -> a
forall a. Floating a => a -> a
cosh a
x

    {-# INLINE log1p #-}
    {-# INLINE expm1 #-}
    {-# INLINE log1pexp #-}
    {-# INLINE log1mexp #-}
    log1p x :: a
x = a -> a
forall a. Floating a => a -> a
log (1 a -> a -> a
forall a. Num a => a -> a -> a
+ a
x)
    expm1 x :: a
x = a -> a
forall a. Floating a => a -> a
exp a
x a -> a -> a
forall a. Num a => a -> a -> a
- 1
    log1pexp x :: a
x = a -> a
forall a. Floating a => a -> a
log1p (a -> a
forall a. Floating a => a -> a
exp a
x)
    log1mexp x :: a
x = a -> a
forall a. Floating a => a -> a
log1p (a -> a
forall a. Num a => a -> a
negate (a -> a
forall a. Floating a => a -> a
exp a
x))

-- | Efficient, machine-independent access to the components of a
-- floating-point number.
class  (RealFrac a, Floating a) => RealFloat a  where
    -- | a constant function, returning the radix of the representation
    -- (often @2@)
    floatRadix          :: a -> Integer
    -- | a constant function, returning the number of digits of
    -- 'floatRadix' in the significand
    floatDigits         :: a -> Int
    -- | a constant function, returning the lowest and highest values
    -- the exponent may assume
    floatRange          :: a -> (Int,Int)
    -- | The function 'decodeFloat' applied to a real floating-point
    -- number returns the significand expressed as an 'Integer' and an
    -- appropriately scaled exponent (an 'Int').  If @'decodeFloat' x@
    -- yields @(m,n)@, then @x@ is equal in value to @m*b^^n@, where @b@
    -- is the floating-point radix, and furthermore, either @m@ and @n@
    -- are both zero or else @b^(d-1) <= 'abs' m < b^d@, where @d@ is
    -- the value of @'floatDigits' x@.
    -- In particular, @'decodeFloat' 0 = (0,0)@. If the type
    -- contains a negative zero, also @'decodeFloat' (-0.0) = (0,0)@.
    -- /The result of/ @'decodeFloat' x@ /is unspecified if either of/
    -- @'isNaN' x@ /or/ @'isInfinite' x@ /is/ 'True'.
    decodeFloat         :: a -> (Integer,Int)
    -- | 'encodeFloat' performs the inverse of 'decodeFloat' in the
    -- sense that for finite @x@ with the exception of @-0.0@,
    -- @'Prelude.uncurry' 'encodeFloat' ('decodeFloat' x) = x@.
    -- @'encodeFloat' m n@ is one of the two closest representable
    -- floating-point numbers to @m*b^^n@ (or @&#177;Infinity@ if overflow
    -- occurs); usually the closer, but if @m@ contains too many bits,
    -- the result may be rounded in the wrong direction.
    encodeFloat         :: Integer -> Int -> a
    -- | 'exponent' corresponds to the second component of 'decodeFloat'.
    -- @'exponent' 0 = 0@ and for finite nonzero @x@,
    -- @'exponent' x = snd ('decodeFloat' x) + 'floatDigits' x@.
    -- If @x@ is a finite floating-point number, it is equal in value to
    -- @'significand' x * b ^^ 'exponent' x@, where @b@ is the
    -- floating-point radix.
    -- The behaviour is unspecified on infinite or @NaN@ values.
    exponent            :: a -> Int
    -- | The first component of 'decodeFloat', scaled to lie in the open
    -- interval (@-1@,@1@), either @0.0@ or of absolute value @>= 1\/b@,
    -- where @b@ is the floating-point radix.
    -- The behaviour is unspecified on infinite or @NaN@ values.
    significand         :: a -> a
    -- | multiplies a floating-point number by an integer power of the radix
    scaleFloat          :: Int -> a -> a
    -- | 'True' if the argument is an IEEE \"not-a-number\" (NaN) value
    isNaN               :: a -> Bool
    -- | 'True' if the argument is an IEEE infinity or negative infinity
    isInfinite          :: a -> Bool
    -- | 'True' if the argument is too small to be represented in
    -- normalized format
    isDenormalized      :: a -> Bool
    -- | 'True' if the argument is an IEEE negative zero
    isNegativeZero      :: a -> Bool
    -- | 'True' if the argument is an IEEE floating point number
    isIEEE              :: a -> Bool
    -- | a version of arctangent taking two real floating-point arguments.
    -- For real floating @x@ and @y@, @'atan2' y x@ computes the angle
    -- (from the positive x-axis) of the vector from the origin to the
    -- point @(x,y)@.  @'atan2' y x@ returns a value in the range [@-pi@,
    -- @pi@].  It follows the Common Lisp semantics for the origin when
    -- signed zeroes are supported.  @'atan2' y 1@, with @y@ in a type
    -- that is 'RealFloat', should return the same value as @'atan' y@.
    -- A default definition of 'atan2' is provided, but implementors
    -- can provide a more accurate implementation.
    atan2               :: a -> a -> a


    exponent x :: a
x          =  if Integer
m Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== 0 then 0 else Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ a -> Int
forall a. RealFloat a => a -> Int
floatDigits a
x
                           where (m :: Integer
m,n :: Int
n) = a -> (Integer, Int)
forall a. RealFloat a => a -> (Integer, Int)
decodeFloat a
x

    significand x :: a
x       =  Integer -> Int -> a
forall a. RealFloat a => Integer -> Int -> a
encodeFloat Integer
m (Int -> Int
forall a. Num a => a -> a
negate (a -> Int
forall a. RealFloat a => a -> Int
floatDigits a
x))
                           where (m :: Integer
m,_) = a -> (Integer, Int)
forall a. RealFloat a => a -> (Integer, Int)
decodeFloat a
x

    scaleFloat 0 x :: a
x      =  a
x
    scaleFloat k :: Int
k x :: a
x
      | Bool
isFix           =  a
x
      | Bool
otherwise       =  Integer -> Int -> a
forall a. RealFloat a => Integer -> Int -> a
encodeFloat Integer
m (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int -> Int
clamp Int
b Int
k)
                           where (m :: Integer
m,n :: Int
n) = a -> (Integer, Int)
forall a. RealFloat a => a -> (Integer, Int)
decodeFloat a
x
                                 (l :: Int
l,h :: Int
h) = a -> (Int, Int)
forall a. RealFloat a => a -> (Int, Int)
floatRange a
x
                                 d :: Int
d     = a -> Int
forall a. RealFloat a => a -> Int
floatDigits a
x
                                 b :: Int
b     = Int
h Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 4Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
d
                                 -- n+k may overflow, which would lead
                                 -- to wrong results, hence we clamp the
                                 -- scaling parameter.
                                 -- If n + k would be larger than h,
                                 -- n + clamp b k must be too, simliar
                                 -- for smaller than l - d.
                                 -- Add a little extra to keep clear
                                 -- from the boundary cases.
                                 isFix :: Bool
isFix = a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== 0 Bool -> Bool -> Bool
|| a -> Bool
forall a. RealFloat a => a -> Bool
isNaN a
x Bool -> Bool -> Bool
|| a -> Bool
forall a. RealFloat a => a -> Bool
isInfinite a
x

    atan2 y :: a
y x :: a
x
      | a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> 0            =  a -> a
forall a. Floating a => a -> a
atan (a
ya -> a -> a
forall a. Fractional a => a -> a -> a
/a
x)
      | a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== 0 Bool -> Bool -> Bool
&& a
y a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> 0  =  a
forall a. Floating a => a
pia -> a -> a
forall a. Fractional a => a -> a -> a
/2
      | a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<  0 Bool -> Bool -> Bool
&& a
y a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> 0  =  a
forall a. Floating a => a
pi a -> a -> a
forall a. Num a => a -> a -> a
+ a -> a
forall a. Floating a => a -> a
atan (a
ya -> a -> a
forall a. Fractional a => a -> a -> a
/a
x)
      |(a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= 0 Bool -> Bool -> Bool
&& a
y a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< 0)            Bool -> Bool -> Bool
||
       (a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<  0 Bool -> Bool -> Bool
&& a -> Bool
forall a. RealFloat a => a -> Bool
isNegativeZero a
y) Bool -> Bool -> Bool
||
       (a -> Bool
forall a. RealFloat a => a -> Bool
isNegativeZero a
x Bool -> Bool -> Bool
&& a -> Bool
forall a. RealFloat a => a -> Bool
isNegativeZero a
y)
                         = -a -> a -> a
forall a. RealFloat a => a -> a -> a
atan2 (-a
y) a
x
      | a
y a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== 0 Bool -> Bool -> Bool
&& (a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< 0 Bool -> Bool -> Bool
|| a -> Bool
forall a. RealFloat a => a -> Bool
isNegativeZero a
x)
                          =  a
forall a. Floating a => a
pi    -- must be after the previous test on zero y
      | a
xa -> a -> Bool
forall a. Eq a => a -> a -> Bool
==0 Bool -> Bool -> Bool
&& a
ya -> a -> Bool
forall a. Eq a => a -> a -> Bool
==0      =  a
y     -- must be after the other double zero tests
      | Bool
otherwise         =  a
x a -> a -> a
forall a. Num a => a -> a -> a
+ a
y -- x or y is a NaN, return a NaN (via +)

------------------------------------------------------------------------
-- Float
------------------------------------------------------------------------

-- | @since 2.01
-- Note that due to the presence of @NaN@, not all elements of 'Float' have an
-- additive inverse.
--
-- >>> 0/0 + (negate 0/0 :: Float)
-- NaN
--
-- Also note that due to the presence of -0, `Float`'s 'Num' instance doesn't
-- have an additive identity
--
-- >>> 0 + (-0 :: Float)
-- 0.0
instance Num Float where
    + :: Float -> Float -> Float
(+)         x :: Float
x y :: Float
y     =  Float -> Float -> Float
plusFloat Float
x Float
y
    (-)         x :: Float
x y :: Float
y     =  Float -> Float -> Float
minusFloat Float
x Float
y
    negate :: Float -> Float
negate      x :: Float
x       =  Float -> Float
negateFloat Float
x
    * :: Float -> Float -> Float
(*)         x :: Float
x y :: Float
y     =  Float -> Float -> Float
timesFloat Float
x Float
y
    abs :: Float -> Float
abs         x :: Float
x       =  Float -> Float
fabsFloat Float
x
    signum :: Float -> Float
signum x :: Float
x | Float
x Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
> 0     = 1
             | Float
x Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
< 0     = Float -> Float
negateFloat 1
             | Bool
otherwise = Float
x -- handles 0.0, (-0.0), and NaN

    {-# INLINE fromInteger #-}
    fromInteger :: Integer -> Float
fromInteger i :: Integer
i = Float# -> Float
F# (Integer -> Float#
floatFromInteger Integer
i)

-- | @since 2.01
instance  Real Float  where
    toRational :: Float -> Rational
toRational (F# x# :: Float#
x#)  =
        case Float# -> (# Int#, Int# #)
decodeFloat_Int# Float#
x# of
          (# m# :: Int#
m#, e# :: Int#
e# #)
            | Int# -> Bool
isTrue# (Int#
e# Int# -> Int# -> Int#
>=# 0#)                               ->
                    (Int# -> Integer
smallInteger Int#
m# Integer -> Int# -> Integer
`shiftLInteger` Int#
e#) Integer -> Integer -> Rational
forall a. a -> a -> Ratio a
:% 1
            | Int# -> Bool
isTrue# ((Int# -> Word#
int2Word# Int#
m# Word# -> Word# -> Word#
`and#` 1##) Word# -> Word# -> Int#
`eqWord#` 0##) ->
                    case Int# -> Int# -> (# Integer, Int# #)
elimZerosInt# Int#
m# (Int# -> Int#
negateInt# Int#
e#) of
                      (# n :: Integer
n, d# :: Int#
d# #) -> Integer
n Integer -> Integer -> Rational
forall a. a -> a -> Ratio a
:% Integer -> Int# -> Integer
shiftLInteger 1 Int#
d#
            | Bool
otherwise                                         ->
                    Int# -> Integer
smallInteger Int#
m# Integer -> Integer -> Rational
forall a. a -> a -> Ratio a
:% Integer -> Int# -> Integer
shiftLInteger 1 (Int# -> Int#
negateInt# Int#
e#)

-- | @since 2.01
-- Note that due to the presence of @NaN@, not all elements of 'Float' have an
-- multiplicative inverse.
--
-- >>> 0/0 * (recip 0/0 :: Float)
-- NaN
instance  Fractional Float  where
    / :: Float -> Float -> Float
(/) x :: Float
x y :: Float
y             =  Float -> Float -> Float
divideFloat Float
x Float
y
    {-# INLINE fromRational #-}
    fromRational :: Rational -> Float
fromRational (n :: Integer
n:%d :: Integer
d) = Integer -> Integer -> Float
rationalToFloat Integer
n Integer
d
    recip :: Float -> Float
recip x :: Float
x             =  1.0 Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
x

rationalToFloat :: Integer -> Integer -> Float
{-# NOINLINE [1] rationalToFloat #-}
rationalToFloat :: Integer -> Integer -> Float
rationalToFloat n :: Integer
n 0
    | Integer
n Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== 0        = 0Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/0
    | Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< 0         = (-1)Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/0
    | Bool
otherwise     = 1Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/0
rationalToFloat n :: Integer
n d :: Integer
d
    | Integer
n Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== 0        = Integer -> Int -> Float
forall a. RealFloat a => Integer -> Int -> a
encodeFloat 0 0
    | Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< 0         = -(Int -> Int -> Integer -> Integer -> Float
forall a. RealFloat a => Int -> Int -> Integer -> Integer -> a
fromRat'' Int
minEx Int
mantDigs (-Integer
n) Integer
d)
    | Bool
otherwise     = Int -> Int -> Integer -> Integer -> Float
forall a. RealFloat a => Int -> Int -> Integer -> Integer -> a
fromRat'' Int
minEx Int
mantDigs Integer
n Integer
d
      where
        minEx :: Int
minEx       = FLT_MIN_EXP
        mantDigs :: Int
mantDigs    = FLT_MANT_DIG

-- RULES for Integer and Int
{-# RULES
"properFraction/Float->Integer"     properFraction = properFractionFloatInteger
"truncate/Float->Integer"           truncate = truncateFloatInteger
"floor/Float->Integer"              floor = floorFloatInteger
"ceiling/Float->Integer"            ceiling = ceilingFloatInteger
"round/Float->Integer"              round = roundFloatInteger
"properFraction/Float->Int"         properFraction = properFractionFloatInt
"truncate/Float->Int"               truncate = float2Int
"floor/Float->Int"                  floor = floorFloatInt
"ceiling/Float->Int"                ceiling = ceilingFloatInt
"round/Float->Int"                  round = roundFloatInt
  #-}
-- | @since 2.01
instance  RealFrac Float  where

        -- ceiling, floor, and truncate are all small
    {-# INLINE [1] ceiling #-}
    {-# INLINE [1] floor #-}
    {-# INLINE [1] truncate #-}

-- We assume that FLT_RADIX is 2 so that we can use more efficient code
#if FLT_RADIX != 2
#error FLT_RADIX must be 2
#endif
    properFraction :: Float -> (b, Float)
properFraction (F# x# :: Float#
x#)
      = case Float# -> (# Int#, Int# #)
decodeFloat_Int# Float#
x# of
        (# m# :: Int#
m#, n# :: Int#
n# #) ->
            let m :: Int
m = Int# -> Int
I# Int#
m#
                n :: Int
n = Int# -> Int
I# Int#
n#
            in
            if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 0
            then (Int -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
m b -> b -> b
forall a. Num a => a -> a -> a
* (2 b -> Int -> b
forall a b. (Num a, Integral b) => a -> b -> a
^ Int
n), 0.0)
            else let i :: Int
i = if Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 0 then                Int
m Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int -> Int
forall a. Num a => a -> a
negate Int
n
                                   else Int -> Int
forall a. Num a => a -> a
negate (Int -> Int
forall a. Num a => a -> a
negate Int
m Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int -> Int
forall a. Num a => a -> a
negate Int
n)
                     f :: Int
f = Int
m Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Int
i Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` Int -> Int
forall a. Num a => a -> a
negate Int
n)
                 in (Int -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i, Integer -> Int -> Float
forall a. RealFloat a => Integer -> Int -> a
encodeFloat (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
f) Int
n)

    truncate :: Float -> b
truncate x :: Float
x  = case Float -> (b, Float)
forall a b. (RealFrac a, Integral b) => a -> (b, a)
properFraction Float
x of
                     (n :: b
n,_) -> b
n

    round :: Float -> b
round x :: Float
x     = case Float -> (b, Float)
forall a b. (RealFrac a, Integral b) => a -> (b, a)
properFraction Float
x of
                     (n :: b
n,r :: Float
r) -> let
                                m :: b
m         = if Float
r Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
< 0.0 then b
n b -> b -> b
forall a. Num a => a -> a -> a
- 1 else b
n b -> b -> b
forall a. Num a => a -> a -> a
+ 1
                                half_down :: Float
half_down = Float -> Float
forall a. Num a => a -> a
abs Float
r Float -> Float -> Float
forall a. Num a => a -> a -> a
- 0.5
                              in
                              case (Float -> Float -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Float
half_down 0.0) of
                                LT -> b
n
                                EQ -> if b -> Bool
forall a. Integral a => a -> Bool
even b
n then b
n else b
m
                                GT -> b
m

    ceiling :: Float -> b
ceiling x :: Float
x   = case Float -> (b, Float)
forall a b. (RealFrac a, Integral b) => a -> (b, a)
properFraction Float
x of
                    (n :: b
n,r :: Float
r) -> if Float
r Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
> 0.0 then b
n b -> b -> b
forall a. Num a => a -> a -> a
+ 1 else b
n

    floor :: Float -> b
floor x :: Float
x     = case Float -> (b, Float)
forall a b. (RealFrac a, Integral b) => a -> (b, a)
properFraction Float
x of
                    (n :: b
n,r :: Float
r) -> if Float
r Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
< 0.0 then b
n b -> b -> b
forall a. Num a => a -> a -> a
- 1 else b
n

-- | @since 2.01
instance  Floating Float  where
    pi :: Float
pi                  =  3.141592653589793238
    exp :: Float -> Float
exp x :: Float
x               =  Float -> Float
expFloat Float
x
    log :: Float -> Float
log x :: Float
x               =  Float -> Float
logFloat Float
x
    sqrt :: Float -> Float
sqrt x :: Float
x              =  Float -> Float
sqrtFloat Float
x
    sin :: Float -> Float
sin x :: Float
x               =  Float -> Float
sinFloat Float
x
    cos :: Float -> Float
cos x :: Float
x               =  Float -> Float
cosFloat Float
x
    tan :: Float -> Float
tan x :: Float
x               =  Float -> Float
tanFloat Float
x
    asin :: Float -> Float
asin x :: Float
x              =  Float -> Float
asinFloat Float
x
    acos :: Float -> Float
acos x :: Float
x              =  Float -> Float
acosFloat Float
x
    atan :: Float -> Float
atan x :: Float
x              =  Float -> Float
atanFloat Float
x
    sinh :: Float -> Float
sinh x :: Float
x              =  Float -> Float
sinhFloat Float
x
    cosh :: Float -> Float
cosh x :: Float
x              =  Float -> Float
coshFloat Float
x
    tanh :: Float -> Float
tanh x :: Float
x              =  Float -> Float
tanhFloat Float
x
    ** :: Float -> Float -> Float
(**) x :: Float
x y :: Float
y            =  Float -> Float -> Float
powerFloat Float
x Float
y
    logBase :: Float -> Float -> Float
logBase x :: Float
x y :: Float
y         =  Float -> Float
forall a. Floating a => a -> a
log Float
y Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float -> Float
forall a. Floating a => a -> a
log Float
x

    asinh :: Float -> Float
asinh x :: Float
x             =  Float -> Float
asinhFloat Float
x
    acosh :: Float -> Float
acosh x :: Float
x             =  Float -> Float
acoshFloat Float
x
    atanh :: Float -> Float
atanh x :: Float
x             =  Float -> Float
atanhFloat Float
x

    log1p :: Float -> Float
log1p = Float -> Float
log1pFloat
    expm1 :: Float -> Float
expm1 = Float -> Float
expm1Float

    log1mexp :: Float -> Float
log1mexp a :: Float
a
      | Float
a Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
<= Float -> Float
forall a. Floating a => a -> a
log 2 = Float -> Float
forall a. Floating a => a -> a
log (Float -> Float
forall a. Num a => a -> a
negate (Float -> Float
expm1Float Float
a))
      | Bool
otherwise  = Float -> Float
log1pFloat (Float -> Float
forall a. Num a => a -> a
negate (Float -> Float
forall a. Floating a => a -> a
exp Float
a))
    {-# INLINE log1mexp #-}
    log1pexp :: Float -> Float
log1pexp a :: Float
a
      | Float
a Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
<= 18   = Float -> Float
log1pFloat (Float -> Float
forall a. Floating a => a -> a
exp Float
a)
      | Float
a Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
<= 100  = Float
a Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float -> Float
forall a. Floating a => a -> a
exp (Float -> Float
forall a. Num a => a -> a
negate Float
a)
      | Bool
otherwise = Float
a
    {-# INLINE log1pexp #-}

-- | @since 2.01
instance  RealFloat Float  where
    floatRadix :: Float -> Integer
floatRadix _        =  FLT_RADIX        -- from float.h
    floatDigits :: Float -> Int
floatDigits _       =  FLT_MANT_DIG     -- ditto
    floatRange :: Float -> (Int, Int)
floatRange _        =  (FLT_MIN_EXP, FLT_MAX_EXP) -- ditto

    decodeFloat :: Float -> (Integer, Int)
decodeFloat (F# f# :: Float#
f#) = case Float# -> (# Int#, Int# #)
decodeFloat_Int# Float#
f# of
                          (# i :: Int#
i, e :: Int#
e #) -> (Int# -> Integer
smallInteger Int#
i, Int# -> Int
I# Int#
e)

    encodeFloat :: Integer -> Int -> Float
encodeFloat i :: Integer
i (I# e :: Int#
e) = Float# -> Float
F# (Integer -> Int# -> Float#
encodeFloatInteger Integer
i Int#
e)

    exponent :: Float -> Int
exponent x :: Float
x          = case Float -> (Integer, Int)
forall a. RealFloat a => a -> (Integer, Int)
decodeFloat Float
x of
                            (m :: Integer
m,n :: Int
n) -> if Integer
m Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== 0 then 0 else Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Float -> Int
forall a. RealFloat a => a -> Int
floatDigits Float
x

    significand :: Float -> Float
significand x :: Float
x       = case Float -> (Integer, Int)
forall a. RealFloat a => a -> (Integer, Int)
decodeFloat Float
x of
                            (m :: Integer
m,_) -> Integer -> Int -> Float
forall a. RealFloat a => Integer -> Int -> a
encodeFloat Integer
m (Int -> Int
forall a. Num a => a -> a
negate (Float -> Int
forall a. RealFloat a => a -> Int
floatDigits Float
x))

    scaleFloat :: Int -> Float -> Float
scaleFloat 0 x :: Float
x      = Float
x
    scaleFloat k :: Int
k x :: Float
x
      | Bool
isFix           = Float
x
      | Bool
otherwise       = case Float -> (Integer, Int)
forall a. RealFloat a => a -> (Integer, Int)
decodeFloat Float
x of
                            (m :: Integer
m,n :: Int
n) -> Integer -> Int -> Float
forall a. RealFloat a => Integer -> Int -> a
encodeFloat Integer
m (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int -> Int
clamp Int
bf Int
k)
                        where bf :: Int
bf = FLT_MAX_EXP - (FLT_MIN_EXP) + 4*FLT_MANT_DIG
                              isFix :: Bool
isFix = Float
x Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
== 0 Bool -> Bool -> Bool
|| Float -> Int
isFloatFinite Float
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0

    isNaN :: Float -> Bool
isNaN x :: Float
x          = 0 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Float -> Int
isFloatNaN Float
x
    isInfinite :: Float -> Bool
isInfinite x :: Float
x     = 0 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Float -> Int
isFloatInfinite Float
x
    isDenormalized :: Float -> Bool
isDenormalized x :: Float
x = 0 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Float -> Int
isFloatDenormalized Float
x
    isNegativeZero :: Float -> Bool
isNegativeZero x :: Float
x = 0 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Float -> Int
isFloatNegativeZero Float
x
    isIEEE :: Float -> Bool
isIEEE _         = Bool
True

-- | @since 2.01
instance  Show Float  where
    showsPrec :: Int -> Float -> ShowS
showsPrec   x :: Int
x = (Float -> ShowS) -> Int -> Float -> ShowS
forall a. RealFloat a => (a -> ShowS) -> Int -> a -> ShowS
showSignedFloat Float -> ShowS
forall a. RealFloat a => a -> ShowS
showFloat Int
x
    showList :: [Float] -> ShowS
showList = (Float -> ShowS) -> [Float] -> ShowS
forall a. (a -> ShowS) -> [a] -> ShowS
showList__ (Int -> Float -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec 0)

------------------------------------------------------------------------
-- Double
------------------------------------------------------------------------

-- | @since 2.01
-- Note that due to the presence of @NaN@, not all elements of 'Double' have an
-- additive inverse.
--
-- >>> 0/0 + (negate 0/0 :: Double)
-- NaN
--
-- Also note that due to the presence of -0, `Double`'s 'Num' instance doesn't
-- have an additive identity
--
-- >>> 0 + (-0 :: Double)
-- 0.0
instance  Num Double  where
    + :: Double -> Double -> Double
(+)         x :: Double
x y :: Double
y     =  Double -> Double -> Double
plusDouble Double
x Double
y
    (-)         x :: Double
x y :: Double
y     =  Double -> Double -> Double
minusDouble Double
x Double
y
    negate :: Double -> Double
negate      x :: Double
x       =  Double -> Double
negateDouble Double
x
    * :: Double -> Double -> Double
(*)         x :: Double
x y :: Double
y     =  Double -> Double -> Double
timesDouble Double
x Double
y
    abs :: Double -> Double
abs         x :: Double
x       =  Double -> Double
fabsDouble Double
x
    signum :: Double -> Double
signum x :: Double
x | Double
x Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> 0     = 1
             | Double
x Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< 0     = Double -> Double
negateDouble 1
             | Bool
otherwise = Double
x -- handles 0.0, (-0.0), and NaN


    {-# INLINE fromInteger #-}
    fromInteger :: Integer -> Double
fromInteger i :: Integer
i = Double# -> Double
D# (Integer -> Double#
doubleFromInteger Integer
i)


-- | @since 2.01
instance  Real Double  where
    toRational :: Double -> Rational
toRational (D# x# :: Double#
x#)  =
        case Double# -> (# Integer, Int# #)
decodeDoubleInteger Double#
x# of
          (# m :: Integer
m, e# :: Int#
e# #)
            | Int# -> Bool
isTrue# (Int#
e# Int# -> Int# -> Int#
>=# 0#)                                  ->
                Integer -> Int# -> Integer
shiftLInteger Integer
m Int#
e# Integer -> Integer -> Rational
forall a. a -> a -> Ratio a
:% 1
            | Int# -> Bool
isTrue# ((Integer -> Word#
integerToWord Integer
m Word# -> Word# -> Word#
`and#` 1##) Word# -> Word# -> Int#
`eqWord#` 0##) ->
                case Integer -> Int# -> (# Integer, Int# #)
elimZerosInteger Integer
m (Int# -> Int#
negateInt# Int#
e#) of
                    (# n :: Integer
n, d# :: Int#
d# #) ->  Integer
n Integer -> Integer -> Rational
forall a. a -> a -> Ratio a
:% Integer -> Int# -> Integer
shiftLInteger 1 Int#
d#
            | Bool
otherwise                                            ->
                Integer
m Integer -> Integer -> Rational
forall a. a -> a -> Ratio a
:% Integer -> Int# -> Integer
shiftLInteger 1 (Int# -> Int#
negateInt# Int#
e#)

-- | @since 2.01
-- Note that due to the presence of @NaN@, not all elements of 'Double' have an
-- multiplicative inverse.
--
-- >>> 0/0 * (recip 0/0 :: Double)
-- NaN
instance  Fractional Double  where
    / :: Double -> Double -> Double
(/) x :: Double
x y :: Double
y             =  Double -> Double -> Double
divideDouble Double
x Double
y
    {-# INLINE fromRational #-}
    fromRational :: Rational -> Double
fromRational (n :: Integer
n:%d :: Integer
d) = Integer -> Integer -> Double
rationalToDouble Integer
n Integer
d
    recip :: Double -> Double
recip x :: Double
x             =  1.0 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
x

rationalToDouble :: Integer -> Integer -> Double
{-# NOINLINE [1] rationalToDouble #-}
rationalToDouble :: Integer -> Integer -> Double
rationalToDouble n :: Integer
n 0
    | Integer
n Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== 0        = 0Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/0
    | Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< 0         = (-1)Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/0
    | Bool
otherwise     = 1Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/0
rationalToDouble n :: Integer
n d :: Integer
d
    | Integer
n Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== 0        = Integer -> Int -> Double
forall a. RealFloat a => Integer -> Int -> a
encodeFloat 0 0
    | Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< 0         = -(Int -> Int -> Integer -> Integer -> Double
forall a. RealFloat a => Int -> Int -> Integer -> Integer -> a
fromRat'' Int
minEx Int
mantDigs (-Integer
n) Integer
d)
    | Bool
otherwise     = Int -> Int -> Integer -> Integer -> Double
forall a. RealFloat a => Int -> Int -> Integer -> Integer -> a
fromRat'' Int
minEx Int
mantDigs Integer
n Integer
d
      where
        minEx :: Int
minEx       = DBL_MIN_EXP
        mantDigs :: Int
mantDigs    = DBL_MANT_DIG

-- | @since 2.01
instance  Floating Double  where
    pi :: Double
pi                  =  3.141592653589793238
    exp :: Double -> Double
exp x :: Double
x               =  Double -> Double
expDouble Double
x
    log :: Double -> Double
log x :: Double
x               =  Double -> Double
logDouble Double
x
    sqrt :: Double -> Double
sqrt x :: Double
x              =  Double -> Double
sqrtDouble Double
x
    sin :: Double -> Double
sin  x :: Double
x              =  Double -> Double
sinDouble Double
x
    cos :: Double -> Double
cos  x :: Double
x              =  Double -> Double
cosDouble Double
x
    tan :: Double -> Double
tan  x :: Double
x              =  Double -> Double
tanDouble Double
x
    asin :: Double -> Double
asin x :: Double
x              =  Double -> Double
asinDouble Double
x
    acos :: Double -> Double
acos x :: Double
x              =  Double -> Double
acosDouble Double
x
    atan :: Double -> Double
atan x :: Double
x              =  Double -> Double
atanDouble Double
x
    sinh :: Double -> Double
sinh x :: Double
x              =  Double -> Double
sinhDouble Double
x
    cosh :: Double -> Double
cosh x :: Double
x              =  Double -> Double
coshDouble Double
x
    tanh :: Double -> Double
tanh x :: Double
x              =  Double -> Double
tanhDouble Double
x
    ** :: Double -> Double -> Double
(**) x :: Double
x y :: Double
y            =  Double -> Double -> Double
powerDouble Double
x Double
y
    logBase :: Double -> Double -> Double
logBase x :: Double
x y :: Double
y         =  Double -> Double
forall a. Floating a => a -> a
log Double
y Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double -> Double
forall a. Floating a => a -> a
log Double
x

    asinh :: Double -> Double
asinh x :: Double
x             =  Double -> Double
asinhDouble Double
x
    acosh :: Double -> Double
acosh x :: Double
x             =  Double -> Double
acoshDouble Double
x
    atanh :: Double -> Double
atanh x :: Double
x             =  Double -> Double
atanhDouble Double
x

    log1p :: Double -> Double
log1p = Double -> Double
log1pDouble
    expm1 :: Double -> Double
expm1 = Double -> Double
expm1Double

    log1mexp :: Double -> Double
log1mexp a :: Double
a
      | Double
a Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double -> Double
forall a. Floating a => a -> a
log 2 = Double -> Double
forall a. Floating a => a -> a
log (Double -> Double
forall a. Num a => a -> a
negate (Double -> Double
expm1Double Double
a))
      | Bool
otherwise  = Double -> Double
log1pDouble (Double -> Double
forall a. Num a => a -> a
negate (Double -> Double
forall a. Floating a => a -> a
exp Double
a))
    {-# INLINE log1mexp #-}
    log1pexp :: Double -> Double
log1pexp a :: Double
a
      | Double
a Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= 18   = Double -> Double
log1pDouble (Double -> Double
forall a. Floating a => a -> a
exp Double
a)
      | Double
a Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= 100  = Double
a Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double -> Double
forall a. Floating a => a -> a
exp (Double -> Double
forall a. Num a => a -> a
negate Double
a)
      | Bool
otherwise = Double
a
    {-# INLINE log1pexp #-}

-- RULES for Integer and Int
{-# RULES
"properFraction/Double->Integer"    properFraction = properFractionDoubleInteger
"truncate/Double->Integer"          truncate = truncateDoubleInteger
"floor/Double->Integer"             floor = floorDoubleInteger
"ceiling/Double->Integer"           ceiling = ceilingDoubleInteger
"round/Double->Integer"             round = roundDoubleInteger
"properFraction/Double->Int"        properFraction = properFractionDoubleInt
"truncate/Double->Int"              truncate = double2Int
"floor/Double->Int"                 floor = floorDoubleInt
"ceiling/Double->Int"               ceiling = ceilingDoubleInt
"round/Double->Int"                 round = roundDoubleInt
  #-}
-- | @since 2.01
instance  RealFrac Double  where

        -- ceiling, floor, and truncate are all small
    {-# INLINE [1] ceiling #-}
    {-# INLINE [1] floor #-}
    {-# INLINE [1] truncate #-}

    properFraction :: Double -> (b, Double)
properFraction x :: Double
x
      = case (Double -> (Integer, Int)
forall a. RealFloat a => a -> (Integer, Int)
decodeFloat Double
x)      of { (m :: Integer
m,n :: Int
n) ->
        if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 0 then
            (Integer -> b
forall a. Num a => Integer -> a
fromInteger Integer
m b -> b -> b
forall a. Num a => a -> a -> a
* 2 b -> Int -> b
forall a b. (Num a, Integral b) => a -> b -> a
^ Int
n, 0.0)
        else
            case (Integer -> Integer -> (Integer, Integer)
forall a. Integral a => a -> a -> (a, a)
quotRem Integer
m (2Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^(Int -> Int
forall a. Num a => a -> a
negate Int
n))) of { (w :: Integer
w,r :: Integer
r) ->
            (Integer -> b
forall a. Num a => Integer -> a
fromInteger Integer
w, Integer -> Int -> Double
forall a. RealFloat a => Integer -> Int -> a
encodeFloat Integer
r Int
n)
            }
        }

    truncate :: Double -> b
truncate x :: Double
x  = case Double -> (b, Double)
forall a b. (RealFrac a, Integral b) => a -> (b, a)
properFraction Double
x of
                     (n :: b
n,_) -> b
n

    round :: Double -> b
round x :: Double
x     = case Double -> (b, Double)
forall a b. (RealFrac a, Integral b) => a -> (b, a)
properFraction Double
x of
                     (n :: b
n,r :: Double
r) -> let
                                m :: b
m         = if Double
r Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< 0.0 then b
n b -> b -> b
forall a. Num a => a -> a -> a
- 1 else b
n b -> b -> b
forall a. Num a => a -> a -> a
+ 1
                                half_down :: Double
half_down = Double -> Double
forall a. Num a => a -> a
abs Double
r Double -> Double -> Double
forall a. Num a => a -> a -> a
- 0.5
                              in
                              case (Double -> Double -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Double
half_down 0.0) of
                                LT -> b
n
                                EQ -> if b -> Bool
forall a. Integral a => a -> Bool
even b
n then b
n else b
m
                                GT -> b
m

    ceiling :: Double -> b
ceiling x :: Double
x   = case Double -> (b, Double)
forall a b. (RealFrac a, Integral b) => a -> (b, a)
properFraction Double
x of
                    (n :: b
n,r :: Double
r) -> if Double
r Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> 0.0 then b
n b -> b -> b
forall a. Num a => a -> a -> a
+ 1 else b
n

    floor :: Double -> b
floor x :: Double
x     = case Double -> (b, Double)
forall a b. (RealFrac a, Integral b) => a -> (b, a)
properFraction Double
x of
                    (n :: b
n,r :: Double
r) -> if Double
r Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< 0.0 then b
n b -> b -> b
forall a. Num a => a -> a -> a
- 1 else b
n

-- | @since 2.01
instance  RealFloat Double  where
    floatRadix :: Double -> Integer
floatRadix _        =  FLT_RADIX        -- from float.h
    floatDigits :: Double -> Int
floatDigits _       =  DBL_MANT_DIG     -- ditto
    floatRange :: Double -> (Int, Int)
floatRange _        =  (DBL_MIN_EXP, DBL_MAX_EXP) -- ditto

    decodeFloat :: Double -> (Integer, Int)
decodeFloat (D# x# :: Double#
x#)
      = case Double# -> (# Integer, Int# #)
decodeDoubleInteger Double#
x#   of
          (# i :: Integer
i, j :: Int#
j #) -> (Integer
i, Int# -> Int
I# Int#
j)

    encodeFloat :: Integer -> Int -> Double
encodeFloat i :: Integer
i (I# j :: Int#
j) = Double# -> Double
D# (Integer -> Int# -> Double#
encodeDoubleInteger Integer
i Int#
j)

    exponent :: Double -> Int
exponent x :: Double
x          = case Double -> (Integer, Int)
forall a. RealFloat a => a -> (Integer, Int)
decodeFloat Double
x of
                            (m :: Integer
m,n :: Int
n) -> if Integer
m Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== 0 then 0 else Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Double -> Int
forall a. RealFloat a => a -> Int
floatDigits Double
x

    significand :: Double -> Double
significand x :: Double
x       = case Double -> (Integer, Int)
forall a. RealFloat a => a -> (Integer, Int)
decodeFloat Double
x of
                            (m :: Integer
m,_) -> Integer -> Int -> Double
forall a. RealFloat a => Integer -> Int -> a
encodeFloat Integer
m (Int -> Int
forall a. Num a => a -> a
negate (Double -> Int
forall a. RealFloat a => a -> Int
floatDigits Double
x))

    scaleFloat :: Int -> Double -> Double
scaleFloat 0 x :: Double
x      = Double
x
    scaleFloat k :: Int
k x :: Double
x
      | Bool
isFix           = Double
x
      | Bool
otherwise       = case Double -> (Integer, Int)
forall a. RealFloat a => a -> (Integer, Int)
decodeFloat Double
x of
                            (m :: Integer
m,n :: Int
n) -> Integer -> Int -> Double
forall a. RealFloat a => Integer -> Int -> a
encodeFloat Integer
m (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int -> Int
clamp Int
bd Int
k)
                        where bd :: Int
bd = DBL_MAX_EXP - (DBL_MIN_EXP) + 4*DBL_MANT_DIG
                              isFix :: Bool
isFix = Double
x Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== 0 Bool -> Bool -> Bool
|| Double -> Int
isDoubleFinite Double
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0

    isNaN :: Double -> Bool
isNaN x :: Double
x             = 0 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Double -> Int
isDoubleNaN Double
x
    isInfinite :: Double -> Bool
isInfinite x :: Double
x        = 0 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Double -> Int
isDoubleInfinite Double
x
    isDenormalized :: Double -> Bool
isDenormalized x :: Double
x    = 0 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Double -> Int
isDoubleDenormalized Double
x
    isNegativeZero :: Double -> Bool
isNegativeZero x :: Double
x    = 0 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Double -> Int
isDoubleNegativeZero Double
x
    isIEEE :: Double -> Bool
isIEEE _            = Bool
True

-- | @since 2.01
instance  Show Double  where
    showsPrec :: Int -> Double -> ShowS
showsPrec   x :: Int
x = (Double -> ShowS) -> Int -> Double -> ShowS
forall a. RealFloat a => (a -> ShowS) -> Int -> a -> ShowS
showSignedFloat Double -> ShowS
forall a. RealFloat a => a -> ShowS
showFloat Int
x
    showList :: [Double] -> ShowS
showList = (Double -> ShowS) -> [Double] -> ShowS
forall a. (a -> ShowS) -> [a] -> ShowS
showList__ (Int -> Double -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec 0)


------------------------------------------------------------------------
-- Enum instances
------------------------------------------------------------------------

{-
The @Enum@ instances for Floats and Doubles are slightly unusual.
The @toEnum@ function truncates numbers to Int.  The definitions
of @enumFrom@ and @enumFromThen@ allow floats to be used in arithmetic
series: [0,0.1 .. 1.0].  However, roundoff errors make these somewhat
dubious.  This example may have either 10 or 11 elements, depending on
how 0.1 is represented.

NOTE: The instances for Float and Double do not make use of the default
methods for @enumFromTo@ and @enumFromThenTo@, as these rely on there being
a `non-lossy' conversion to and from Ints. Instead we make use of the
1.2 default methods (back in the days when Enum had Ord as a superclass)
for these (@numericEnumFromTo@ and @numericEnumFromThenTo@ below.)
-}

-- | @since 2.01
instance  Enum Float  where
    succ :: Float -> Float
succ x :: Float
x         = Float
x Float -> Float -> Float
forall a. Num a => a -> a -> a
+ 1
    pred :: Float -> Float
pred x :: Float
x         = Float
x Float -> Float -> Float
forall a. Num a => a -> a -> a
- 1
    toEnum :: Int -> Float
toEnum         = Int -> Float
int2Float
    fromEnum :: Float -> Int
fromEnum       = Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Integer -> Int) -> (Float -> Integer) -> Float -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
truncate   -- may overflow
    enumFrom :: Float -> [Float]
enumFrom       = Float -> [Float]
forall a. Fractional a => a -> [a]
numericEnumFrom
    enumFromTo :: Float -> Float -> [Float]
enumFromTo     = Float -> Float -> [Float]
forall a. (Ord a, Fractional a) => a -> a -> [a]
numericEnumFromTo
    enumFromThen :: Float -> Float -> [Float]
enumFromThen   = Float -> Float -> [Float]
forall a. Fractional a => a -> a -> [a]
numericEnumFromThen
    enumFromThenTo :: Float -> Float -> Float -> [Float]
enumFromThenTo = Float -> Float -> Float -> [Float]
forall a. (Ord a, Fractional a) => a -> a -> a -> [a]
numericEnumFromThenTo

-- | @since 2.01
instance  Enum Double  where
    succ :: Double -> Double
succ x :: Double
x         = Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
+ 1
    pred :: Double -> Double
pred x :: Double
x         = Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
- 1
    toEnum :: Int -> Double
toEnum         =  Int -> Double
int2Double
    fromEnum :: Double -> Int
fromEnum       =  Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Integer -> Int) -> (Double -> Integer) -> Double -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
truncate   -- may overflow
    enumFrom :: Double -> [Double]
enumFrom       =  Double -> [Double]
forall a. Fractional a => a -> [a]
numericEnumFrom
    enumFromTo :: Double -> Double -> [Double]
enumFromTo     =  Double -> Double -> [Double]
forall a. (Ord a, Fractional a) => a -> a -> [a]
numericEnumFromTo
    enumFromThen :: Double -> Double -> [Double]
enumFromThen   =  Double -> Double -> [Double]
forall a. Fractional a => a -> a -> [a]
numericEnumFromThen
    enumFromThenTo :: Double -> Double -> Double -> [Double]
enumFromThenTo =  Double -> Double -> Double -> [Double]
forall a. (Ord a, Fractional a) => a -> a -> a -> [a]
numericEnumFromThenTo

------------------------------------------------------------------------
-- Printing floating point
------------------------------------------------------------------------

-- | Show a signed 'RealFloat' value to full precision
-- using standard decimal notation for arguments whose absolute value lies
-- between @0.1@ and @9,999,999@, and scientific notation otherwise.
showFloat :: (RealFloat a) => a -> ShowS
showFloat :: a -> ShowS
showFloat x :: a
x  =  String -> ShowS
showString (FFFormat -> Maybe Int -> a -> String
forall a. RealFloat a => FFFormat -> Maybe Int -> a -> String
formatRealFloat FFFormat
FFGeneric Maybe Int
forall a. Maybe a
Nothing a
x)

-- These are the format types.  This type is not exported.

data FFFormat = FFExponent | FFFixed | FFGeneric

-- This is just a compatibility stub, as the "alt" argument formerly
-- didn't exist.
formatRealFloat :: (RealFloat a) => FFFormat -> Maybe Int -> a -> String
formatRealFloat :: FFFormat -> Maybe Int -> a -> String
formatRealFloat fmt :: FFFormat
fmt decs :: Maybe Int
decs x :: a
x = FFFormat -> Maybe Int -> Bool -> a -> String
forall a.
RealFloat a =>
FFFormat -> Maybe Int -> Bool -> a -> String
formatRealFloatAlt FFFormat
fmt Maybe Int
decs Bool
False a
x

formatRealFloatAlt :: (RealFloat a) => FFFormat -> Maybe Int -> Bool -> a
                 -> String
formatRealFloatAlt :: FFFormat -> Maybe Int -> Bool -> a -> String
formatRealFloatAlt fmt :: FFFormat
fmt decs :: Maybe Int
decs alt :: Bool
alt x :: a
x
   | a -> Bool
forall a. RealFloat a => a -> Bool
isNaN a
x                   = "NaN"
   | a -> Bool
forall a. RealFloat a => a -> Bool
isInfinite a
x              = if a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< 0 then "-Infinity" else "Infinity"
   | a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< 0 Bool -> Bool -> Bool
|| a -> Bool
forall a. RealFloat a => a -> Bool
isNegativeZero a
x = '-'Char -> ShowS
forall a. a -> [a] -> [a]
:FFFormat -> ([Int], Int) -> String
doFmt FFFormat
fmt (Integer -> a -> ([Int], Int)
forall a. RealFloat a => Integer -> a -> ([Int], Int)
floatToDigits (Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
base) (-a
x))
   | Bool
otherwise                 = FFFormat -> ([Int], Int) -> String
doFmt FFFormat
fmt (Integer -> a -> ([Int], Int)
forall a. RealFloat a => Integer -> a -> ([Int], Int)
floatToDigits (Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
base) a
x)
 where
  base :: Int
base = 10

  doFmt :: FFFormat -> ([Int], Int) -> String
doFmt format :: FFFormat
format (is :: [Int]
is, e :: Int
e) =
    let ds :: String
ds = (Int -> Char) -> [Int] -> String
forall a b. (a -> b) -> [a] -> [b]
map Int -> Char
intToDigit [Int]
is in
    case FFFormat
format of
     FFGeneric ->
      FFFormat -> ([Int], Int) -> String
doFmt (if Int
e Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 0 Bool -> Bool -> Bool
|| Int
e Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 7 then FFFormat
FFExponent else FFFormat
FFFixed)
            ([Int]
is,Int
e)
     FFExponent ->
      case Maybe Int
decs of
       Nothing ->
        let show_e' :: String
show_e' = Int -> String
forall a. Show a => a -> String
show (Int
eInt -> Int -> Int
forall a. Num a => a -> a -> a
-1) in
        case String
ds of
          "0"     -> "0.0e0"
          [d :: Char
d]     -> Char
d Char -> ShowS
forall a. a -> [a] -> [a]
: ".0e" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
show_e'
          (d :: Char
d:ds' :: String
ds') -> Char
d Char -> ShowS
forall a. a -> [a] -> [a]
: '.' Char -> ShowS
forall a. a -> [a] -> [a]
: String
ds' String -> ShowS
forall a. [a] -> [a] -> [a]
++ "e" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
show_e'
          []      -> ShowS
forall a. String -> a
errorWithoutStackTrace "formatRealFloat/doFmt/FFExponent: []"
       Just d :: Int
d | Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 0 ->
        -- handle this case specifically since we need to omit the
        -- decimal point as well (#15115).
        -- Note that this handles negative precisions as well for consistency
        -- (see #15509).
        case [Int]
is of
          [0] -> "0e0"
          _ ->
           let
             (ei :: Int
ei,is' :: [Int]
is') = Int -> Int -> [Int] -> (Int, [Int])
roundTo Int
base 1 [Int]
is
             n :: Char
n:_ = (Int -> Char) -> [Int] -> String
forall a b. (a -> b) -> [a] -> [b]
map Int -> Char
intToDigit (if Int
ei Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0 then [Int] -> [Int]
forall a. [a] -> [a]
init [Int]
is' else [Int]
is')
           in Char
n Char -> ShowS
forall a. a -> [a] -> [a]
: 'e' Char -> ShowS
forall a. a -> [a] -> [a]
: Int -> String
forall a. Show a => a -> String
show (Int
eInt -> Int -> Int
forall a. Num a => a -> a -> a
-1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
ei)
       Just dec :: Int
dec ->
        let dec' :: Int
dec' = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
dec 1 in
        case [Int]
is of
         [0] -> '0' Char -> ShowS
forall a. a -> [a] -> [a]
:'.' Char -> ShowS
forall a. a -> [a] -> [a]
: Int -> ShowS
forall a. Int -> [a] -> [a]
take Int
dec' (Char -> String
forall a. a -> [a]
repeat '0') String -> ShowS
forall a. [a] -> [a] -> [a]
++ "e0"
         _ ->
          let
           (ei :: Int
ei,is' :: [Int]
is') = Int -> Int -> [Int] -> (Int, [Int])
roundTo Int
base (Int
dec'Int -> Int -> Int
forall a. Num a => a -> a -> a
+1) [Int]
is
           (d :: Char
d:ds' :: String
ds') = (Int -> Char) -> [Int] -> String
forall a b. (a -> b) -> [a] -> [b]
map Int -> Char
intToDigit (if Int
ei Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0 then [Int] -> [Int]
forall a. [a] -> [a]
init [Int]
is' else [Int]
is')
          in
          Char
dChar -> ShowS
forall a. a -> [a] -> [a]
:'.'Char -> ShowS
forall a. a -> [a] -> [a]
:String
ds' String -> ShowS
forall a. [a] -> [a] -> [a]
++ 'e'Char -> ShowS
forall a. a -> [a] -> [a]
:Int -> String
forall a. Show a => a -> String
show (Int
eInt -> Int -> Int
forall a. Num a => a -> a -> a
-1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
ei)
     FFFixed ->
      let
       mk0 :: ShowS
mk0 ls :: String
ls = case String
ls of { "" -> "0" ; _ -> String
ls}
      in
      case Maybe Int
decs of
       Nothing
          | Int
e Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 0    -> "0." String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> Char -> String
forall a. Int -> a -> [a]
replicate (-Int
e) '0' String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
ds
          | Bool
otherwise ->
             let
                f :: a -> String -> ShowS
f 0 s :: String
s    rs :: String
rs  = ShowS
mk0 (ShowS
forall a. [a] -> [a]
reverse String
s) String -> ShowS
forall a. [a] -> [a] -> [a]
++ '.'Char -> ShowS
forall a. a -> [a] -> [a]
:ShowS
mk0 String
rs
                f n :: a
n s :: String
s    ""  = a -> String -> ShowS
f (a
na -> a -> a
forall a. Num a => a -> a -> a
-1) ('0'Char -> ShowS
forall a. a -> [a] -> [a]
:String
s) ""
                f n :: a
n s :: String
s (r :: Char
r:rs :: String
rs) = a -> String -> ShowS
f (a
na -> a -> a
forall a. Num a => a -> a -> a
-1) (Char
rChar -> ShowS
forall a. a -> [a] -> [a]
:String
s) String
rs
             in
                Int -> String -> ShowS
forall a. (Eq a, Num a) => a -> String -> ShowS
f Int
e "" String
ds
       Just dec :: Int
dec ->
        let dec' :: Int
dec' = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
dec 0 in
        if Int
e Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 0 then
         let
          (ei :: Int
ei,is' :: [Int]
is') = Int -> Int -> [Int] -> (Int, [Int])
roundTo Int
base (Int
dec' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
e) [Int]
is
          (ls :: String
ls,rs :: String
rs)  = Int -> String -> (String, String)
forall a. Int -> [a] -> ([a], [a])
splitAt (Int
eInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
ei) ((Int -> Char) -> [Int] -> String
forall a b. (a -> b) -> [a] -> [b]
map Int -> Char
intToDigit [Int]
is')
         in
         ShowS
mk0 String
ls String -> ShowS
forall a. [a] -> [a] -> [a]
++ (if String -> Bool
forall a. [a] -> Bool
null String
rs Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
alt then "" else '.'Char -> ShowS
forall a. a -> [a] -> [a]
:String
rs)
        else
         let
          (ei :: Int
ei,is' :: [Int]
is') = Int -> Int -> [Int] -> (Int, [Int])
roundTo Int
base Int
dec' (Int -> Int -> [Int]
forall a. Int -> a -> [a]
replicate (-Int
e) 0 [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int]
is)
          d :: Char
d:ds' :: String
ds' = (Int -> Char) -> [Int] -> String
forall a b. (a -> b) -> [a] -> [b]
map Int -> Char
intToDigit (if Int
ei Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0 then [Int]
is' else 0Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:[Int]
is')
         in
         Char
d Char -> ShowS
forall a. a -> [a] -> [a]
: (if String -> Bool
forall a. [a] -> Bool
null String
ds' Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
alt then "" else '.'Char -> ShowS
forall a. a -> [a] -> [a]
:String
ds')


roundTo :: Int -> Int -> [Int] -> (Int,[Int])
roundTo :: Int -> Int -> [Int] -> (Int, [Int])
roundTo base :: Int
base d :: Int
d is :: [Int]
is =
  case Int -> Bool -> [Int] -> (Int, [Int])
f Int
d Bool
True [Int]
is of
    x :: (Int, [Int])
x@(0,_) -> (Int, [Int])
x
    (1,xs :: [Int]
xs)  -> (1, 1Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:[Int]
xs)
    _       -> String -> (Int, [Int])
forall a. String -> a
errorWithoutStackTrace "roundTo: bad Value"
 where
  b2 :: Int
b2 = Int
base Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` 2

  f :: Int -> Bool -> [Int] -> (Int, [Int])
f n :: Int
n _ []     = (0, Int -> Int -> [Int]
forall a. Int -> a -> [a]
replicate Int
n 0)
  f 0 e :: Bool
e (x :: Int
x:xs :: [Int]
xs) | Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
b2 Bool -> Bool -> Bool
&& Bool
e Bool -> Bool -> Bool
&& (Int -> Bool) -> [Int] -> Bool
forall a. (a -> Bool) -> [a] -> Bool
all (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0) [Int]
xs = (0, [])   -- Round to even when at exactly half the base
               | Bool
otherwise = (if Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
b2 then 1 else 0, [])
  f n :: Int
n _ (i :: Int
i:xs :: [Int]
xs)
     | Int
i' Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
base = (1,0Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:[Int]
ds)
     | Bool
otherwise  = (0,Int
i'Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:[Int]
ds)
      where
       (c :: Int
c,ds :: [Int]
ds) = Int -> Bool -> [Int] -> (Int, [Int])
f (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-1) (Int -> Bool
forall a. Integral a => a -> Bool
even Int
i) [Int]
xs
       i' :: Int
i'     = Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i

-- Based on "Printing Floating-Point Numbers Quickly and Accurately"
-- by R.G. Burger and R.K. Dybvig in PLDI 96.
-- This version uses a much slower logarithm estimator. It should be improved.

-- | 'floatToDigits' takes a base and a non-negative 'RealFloat' number,
-- and returns a list of digits and an exponent.
-- In particular, if @x>=0@, and
--
-- > floatToDigits base x = ([d1,d2,...,dn], e)
--
-- then
--
--      (1) @n >= 1@
--
--      (2) @x = 0.d1d2...dn * (base**e)@
--
--      (3) @0 <= di <= base-1@

floatToDigits :: (RealFloat a) => Integer -> a -> ([Int], Int)
floatToDigits :: Integer -> a -> ([Int], Int)
floatToDigits _ 0 = ([0], 0)
floatToDigits base :: Integer
base x :: a
x =
 let
  (f0 :: Integer
f0, e0 :: Int
e0) = a -> (Integer, Int)
forall a. RealFloat a => a -> (Integer, Int)
decodeFloat a
x
  (minExp0 :: Int
minExp0, _) = a -> (Int, Int)
forall a. RealFloat a => a -> (Int, Int)
floatRange a
x
  p :: Int
p = a -> Int
forall a. RealFloat a => a -> Int
floatDigits a
x
  b :: Integer
b = a -> Integer
forall a. RealFloat a => a -> Integer
floatRadix a
x
  minExp :: Int
minExp = Int
minExp0 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
p -- the real minimum exponent
  -- Haskell requires that f be adjusted so denormalized numbers
  -- will have an impossibly low exponent.  Adjust for this.
  (f :: Integer
f, e :: Int
e) =
   let n :: Int
n = Int
minExp Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
e0 in
   if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0 then (Integer
f0 Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`quot` (Integer -> Int -> Integer
expt Integer
b Int
n), Int
e0Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
n) else (Integer
f0, Int
e0)
  (r :: Integer
r, s :: Integer
s, mUp :: Integer
mUp, mDn :: Integer
mDn) =
   if Int
e Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 0 then
    let be :: Integer
be = Integer -> Int -> Integer
expt Integer
b Int
e in
    if Integer
f Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer -> Int -> Integer
expt Integer
b (Int
pInt -> Int -> Int
forall a. Num a => a -> a -> a
-1) then
      (Integer
fInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
beInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
bInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
*2, 2Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
b, Integer
beInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
b, Integer
be)     -- according to Burger and Dybvig
    else
      (Integer
fInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
beInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
*2, 2, Integer
be, Integer
be)
   else
    if Int
e Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
minExp Bool -> Bool -> Bool
&& Integer
f Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer -> Int -> Integer
expt Integer
b (Int
pInt -> Int -> Int
forall a. Num a => a -> a -> a
-1) then
      (Integer
fInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
bInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
*2, Integer -> Int -> Integer
expt Integer
b (-Int
eInt -> Int -> Int
forall a. Num a => a -> a -> a
+1)Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
*2, Integer
b, 1)
    else
      (Integer
fInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
*2, Integer -> Int -> Integer
expt Integer
b (-Int
e)Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
*2, 1, 1)
  k :: Int
  k :: Int
k =
   let
    k0 :: Int
    k0 :: Int
k0 =
     if Integer
b Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== 2 Bool -> Bool -> Bool
&& Integer
base Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== 10 then
        -- logBase 10 2 is very slightly larger than 8651/28738
        -- (about 5.3558e-10), so if log x >= 0, the approximation
        -- k1 is too small, hence we add one and need one fixup step less.
        -- If log x < 0, the approximation errs rather on the high side.
        -- That is usually more than compensated for by ignoring the
        -- fractional part of logBase 2 x, but when x is a power of 1/2
        -- or slightly larger and the exponent is a multiple of the
        -- denominator of the rational approximation to logBase 10 2,
        -- k1 is larger than logBase 10 x. If k1 > 1 + logBase 10 x,
        -- we get a leading zero-digit we don't want.
        -- With the approximation 3/10, this happened for
        -- 0.5^1030, 0.5^1040, ..., 0.5^1070 and values close above.
        -- The approximation 8651/28738 guarantees k1 < 1 + logBase 10 x
        -- for IEEE-ish floating point types with exponent fields
        -- <= 17 bits and mantissae of several thousand bits, earlier
        -- convergents to logBase 10 2 would fail for long double.
        -- Using quot instead of div is a little faster and requires
        -- fewer fixup steps for negative lx.
        let lx :: Int
lx = Int
p Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
e0
            k1 :: Int
k1 = (Int
lx Int -> Int -> Int
forall a. Num a => a -> a -> a
* 8651) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` 28738
        in if Int
lx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 0 then Int
k1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1 else Int
k1
     else
        -- f :: Integer, log :: Float -> Float,
        --               ceiling :: Float -> Int
        Float -> Int
forall a b. (RealFrac a, Integral b) => a -> b
ceiling ((Float -> Float
forall a. Floating a => a -> a
log (Integer -> Float
forall a. Num a => Integer -> a
fromInteger (Integer
fInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
+1) :: Float) Float -> Float -> Float
forall a. Num a => a -> a -> a
+
                 Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
e Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float -> Float
forall a. Floating a => a -> a
log (Integer -> Float
forall a. Num a => Integer -> a
fromInteger Integer
b)) Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/
                   Float -> Float
forall a. Floating a => a -> a
log (Integer -> Float
forall a. Num a => Integer -> a
fromInteger Integer
base))
--WAS:            fromInt e * log (fromInteger b))

    fixup :: Int -> Int
fixup n :: Int
n =
      if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 0 then
        if Integer
r Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
mUp Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer -> Int -> Integer
expt Integer
base Int
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
s then Int
n else Int -> Int
fixup (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+1)
      else
        if Integer -> Int -> Integer
expt Integer
base (-Int
n) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* (Integer
r Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
mUp) Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
s then Int
n else Int -> Int
fixup (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+1)
   in
   Int -> Int
fixup Int
k0

  gen :: [Integer] -> Integer -> Integer -> Integer -> Integer -> [Integer]
gen ds :: [Integer]
ds rn :: Integer
rn sN :: Integer
sN mUpN :: Integer
mUpN mDnN :: Integer
mDnN =
   let
    (dn :: Integer
dn, rn' :: Integer
rn') = (Integer
rn Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
base) Integer -> Integer -> (Integer, Integer)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Integer
sN
    mUpN' :: Integer
mUpN' = Integer
mUpN Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
base
    mDnN' :: Integer
mDnN' = Integer
mDnN Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
base
   in
   case (Integer
rn' Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
mDnN', Integer
rn' Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
mUpN' Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
sN) of
    (True,  False) -> Integer
dn Integer -> [Integer] -> [Integer]
forall a. a -> [a] -> [a]
: [Integer]
ds
    (False, True)  -> Integer
dnInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
+1 Integer -> [Integer] -> [Integer]
forall a. a -> [a] -> [a]
: [Integer]
ds
    (True,  True)  -> if Integer
rn' Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* 2 Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
sN then Integer
dn Integer -> [Integer] -> [Integer]
forall a. a -> [a] -> [a]
: [Integer]
ds else Integer
dnInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
+1 Integer -> [Integer] -> [Integer]
forall a. a -> [a] -> [a]
: [Integer]
ds
    (False, False) -> [Integer] -> Integer -> Integer -> Integer -> Integer -> [Integer]
gen (Integer
dnInteger -> [Integer] -> [Integer]
forall a. a -> [a] -> [a]
:[Integer]
ds) Integer
rn' Integer
sN Integer
mUpN' Integer
mDnN'

  rds :: [Integer]
rds =
   if Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 0 then
      [Integer] -> Integer -> Integer -> Integer -> Integer -> [Integer]
gen [] Integer
r (Integer
s Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer -> Int -> Integer
expt Integer
base Int
k) Integer
mUp Integer
mDn
   else
     let bk :: Integer
bk = Integer -> Int -> Integer
expt Integer
base (-Int
k) in
     [Integer] -> Integer -> Integer -> Integer -> Integer -> [Integer]
gen [] (Integer
r Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
bk) Integer
s (Integer
mUp Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
bk) (Integer
mDn Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
bk)
 in
 ((Integer -> Int) -> [Integer] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([Integer] -> [Integer]
forall a. [a] -> [a]
reverse [Integer]
rds), Int
k)

------------------------------------------------------------------------
-- Converting from a Rational to a RealFloa
------------------------------------------------------------------------

{-
[In response to a request for documentation of how fromRational works,
Joe Fasel writes:] A quite reasonable request!  This code was added to
the Prelude just before the 1.2 release, when Lennart, working with an
early version of hbi, noticed that (read . show) was not the identity
for floating-point numbers.  (There was a one-bit error about half the
time.)  The original version of the conversion function was in fact
simply a floating-point divide, as you suggest above. The new version
is, I grant you, somewhat denser.

Unfortunately, Joe's code doesn't work!  Here's an example:

main = putStr (shows (1.82173691287639817263897126389712638972163e-300::Double) "\n")

This program prints
        0.0000000000000000
instead of
        1.8217369128763981e-300

Here's Joe's code:

\begin{pseudocode}
fromRat :: (RealFloat a) => Rational -> a
fromRat x = x'
        where x' = f e

--              If the exponent of the nearest floating-point number to x
--              is e, then the significand is the integer nearest xb^(-e),
--              where b is the floating-point radix.  We start with a good
--              guess for e, and if it is correct, the exponent of the
--              floating-point number we construct will again be e.  If
--              not, one more iteration is needed.

              f e   = if e' == e then y else f e'
                      where y      = encodeFloat (round (x * (1 % b)^^e)) e
                            (_,e') = decodeFloat y
              b     = floatRadix x'

--              We obtain a trial exponent by doing a floating-point
--              division of x's numerator by its denominator.  The
--              result of this division may not itself be the ultimate
--              result, because of an accumulation of three rounding
--              errors.

              (s,e) = decodeFloat (fromInteger (numerator x) `asTypeOf` x'
                                        / fromInteger (denominator x))
\end{pseudocode}

Now, here's Lennart's code (which works):
-}

-- | Converts a 'Rational' value into any type in class 'RealFloat'.
{-# RULES
"fromRat/Float"     fromRat = (fromRational :: Rational -> Float)
"fromRat/Double"    fromRat = (fromRational :: Rational -> Double)
  #-}

{-# NOINLINE [1] fromRat #-}
fromRat :: (RealFloat a) => Rational -> a

-- Deal with special cases first, delegating the real work to fromRat'
fromRat :: Rational -> a
fromRat (n :: Integer
n :% 0) | Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> 0     =  1a -> a -> a
forall a. Fractional a => a -> a -> a
/0        -- +Infinity
                 | Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< 0     = -1a -> a -> a
forall a. Fractional a => a -> a -> a
/0        -- -Infinity
                 | Bool
otherwise =  0a -> a -> a
forall a. Fractional a => a -> a -> a
/0        -- NaN

fromRat (n :: Integer
n :% d :: Integer
d) | Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> 0     = Rational -> a
forall a. RealFloat a => Rational -> a
fromRat' (Integer
n Integer -> Integer -> Rational
forall a. a -> a -> Ratio a
:% Integer
d)
                 | Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< 0     = - Rational -> a
forall a. RealFloat a => Rational -> a
fromRat' ((-Integer
n) Integer -> Integer -> Rational
forall a. a -> a -> Ratio a
:% Integer
d)
                 | Bool
otherwise = Integer -> Int -> a
forall a. RealFloat a => Integer -> Int -> a
encodeFloat 0 0             -- Zero

-- Conversion process:
-- Scale the rational number by the RealFloat base until
-- it lies in the range of the mantissa (as used by decodeFloat/encodeFloat).
-- Then round the rational to an Integer and encode it with the exponent
-- that we got from the scaling.
-- To speed up the scaling process we compute the log2 of the number to get
-- a first guess of the exponent.

fromRat' :: (RealFloat a) => Rational -> a
-- Invariant: argument is strictly positive
fromRat' :: Rational -> a
fromRat' x :: Rational
x = a
r
  where b :: Integer
b = a -> Integer
forall a. RealFloat a => a -> Integer
floatRadix a
r
        p :: Int
p = a -> Int
forall a. RealFloat a => a -> Int
floatDigits a
r
        (minExp0 :: Int
minExp0, _) = a -> (Int, Int)
forall a. RealFloat a => a -> (Int, Int)
floatRange a
r
        minExp :: Int
minExp = Int
minExp0 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
p            -- the real minimum exponent
        xMax :: Rational
xMax   = Integer -> Rational
forall a. Real a => a -> Rational
toRational (Integer -> Int -> Integer
expt Integer
b Int
p)
        p0 :: Int
p0 = (Integer -> Integer -> Int
integerLogBase Integer
b (Rational -> Integer
forall a. Ratio a -> a
numerator Rational
x) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Integer -> Integer -> Int
integerLogBase Integer
b (Rational -> Integer
forall a. Ratio a -> a
denominator Rational
x) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
p) Int -> Int -> Int
forall a. Ord a => a -> a -> a
`max` Int
minExp
        -- if x = n/d and ln = integerLogBase b n, ld = integerLogBase b d,
        -- then b^(ln-ld-1) < x < b^(ln-ld+1)
        f :: Rational
f = if Int
p0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 0 then 1 Integer -> Integer -> Rational
forall a. a -> a -> Ratio a
:% Integer -> Int -> Integer
expt Integer
b (-Int
p0) else Integer -> Int -> Integer
expt Integer
b Int
p0 Integer -> Integer -> Rational
forall a. a -> a -> Ratio a
:% 1
        x0 :: Rational
x0 = Rational
x Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Rational
f
        -- if ln - ld >= minExp0, then b^(p-1) < x0 < b^(p+1), so there's at most
        -- one scaling step needed, otherwise, x0 < b^p and no scaling is needed
        (x' :: Rational
x', p' :: Int
p') = if Rational
x0 Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
>= Rational
xMax then (Rational
x0 Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Integer -> Rational
forall a. Real a => a -> Rational
toRational Integer
b, Int
p0Int -> Int -> Int
forall a. Num a => a -> a -> a
+1) else (Rational
x0, Int
p0)
        r :: a
r = Integer -> Int -> a
forall a. RealFloat a => Integer -> Int -> a
encodeFloat (Rational -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
round Rational
x') Int
p'

-- Exponentiation with a cache for the most common numbers.
minExpt, maxExpt :: Int
minExpt :: Int
minExpt = 0
maxExpt :: Int
maxExpt = 1100

expt :: Integer -> Int -> Integer
expt :: Integer -> Int -> Integer
expt base :: Integer
base n :: Int
n =
    if Integer
base Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== 2 Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
minExpt Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
maxExpt then
        Array Int Integer
exptsArray Int Integer -> Int -> Integer
forall i e. Ix i => Array i e -> i -> e
!Int
n
    else
        if Integer
base Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== 10 Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
maxExpt10 then
            Array Int Integer
expts10Array Int Integer -> Int -> Integer
forall i e. Ix i => Array i e -> i -> e
!Int
n
        else
            Integer
baseInteger -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^Int
n

expts :: Array Int Integer
expts :: Array Int Integer
expts = (Int, Int) -> [(Int, Integer)] -> Array Int Integer
forall i e. Ix i => (i, i) -> [(i, e)] -> Array i e
array (Int
minExpt,Int
maxExpt) [(Int
n,2Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^Int
n) | Int
n <- [Int
minExpt .. Int
maxExpt]]

maxExpt10 :: Int
maxExpt10 :: Int
maxExpt10 = 324

expts10 :: Array Int Integer
expts10 :: Array Int Integer
expts10 = (Int, Int) -> [(Int, Integer)] -> Array Int Integer
forall i e. Ix i => (i, i) -> [(i, e)] -> Array i e
array (Int
minExpt,Int
maxExpt10) [(Int
n,10Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^Int
n) | Int
n <- [Int
minExpt .. Int
maxExpt10]]

-- Compute the (floor of the) log of i in base b.
-- Simplest way would be just divide i by b until it's smaller then b, but that would
-- be very slow!  We are just slightly more clever, except for base 2, where
-- we take advantage of the representation of Integers.
-- The general case could be improved by a lookup table for
-- approximating the result by integerLog2 i / integerLog2 b.
integerLogBase :: Integer -> Integer -> Int
integerLogBase :: Integer -> Integer -> Int
integerLogBase b :: Integer
b i :: Integer
i
   | Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
b     = 0
   | Integer
b Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== 2    = Int# -> Int
I# (Integer -> Int#
integerLog2# Integer
i)
   | Bool
otherwise = Int# -> Int
I# (Integer -> Integer -> Int#
integerLogBase# Integer
b Integer
i)

{-
Unfortunately, the old conversion code was awfully slow due to
a) a slow integer logarithm
b) repeated calculation of gcd's

For the case of Rational's coming from a Float or Double via toRational,
we can exploit the fact that the denominator is a power of two, which for
these brings a huge speedup since we need only shift and add instead
of division.

The below is an adaption of fromRat' for the conversion to
Float or Double exploiting the known floatRadix and avoiding
divisions as much as possible.
-}

{-# SPECIALISE fromRat'' :: Int -> Int -> Integer -> Integer -> Float,
                            Int -> Int -> Integer -> Integer -> Double #-}
fromRat'' :: RealFloat a => Int -> Int -> Integer -> Integer -> a
-- Invariant: n and d strictly positive
fromRat'' :: Int -> Int -> Integer -> Integer -> a
fromRat'' minEx :: Int
minEx@(I# me# :: Int#
me#) mantDigs :: Int
mantDigs@(I# md# :: Int#
md#) n :: Integer
n d :: Integer
d =
    case Integer -> (# Int#, Int# #)
integerLog2IsPowerOf2# Integer
d of
      (# ld# :: Int#
ld#, pw# :: Int#
pw# #)
        | Int# -> Bool
isTrue# (Int#
pw# Int# -> Int# -> Int#
==# 0#) ->
          case Integer -> Int#
integerLog2# Integer
n of
            ln# :: Int#
ln# | Int# -> Bool
isTrue# (Int#
ln# Int# -> Int# -> Int#
>=# (Int#
ld# Int# -> Int# -> Int#
+# Int#
me# Int# -> Int# -> Int#
-# 1#)) ->
                  -- this means n/d >= 2^(minEx-1), i.e. we are guaranteed to get
                  -- a normalised number, round to mantDigs bits
                  if Int# -> Bool
isTrue# (Int#
ln# Int# -> Int# -> Int#
<# Int#
md#)
                    then Integer -> Int -> a
forall a. RealFloat a => Integer -> Int -> a
encodeFloat Integer
n (Int# -> Int
I# (Int# -> Int#
negateInt# Int#
ld#))
                    else let n' :: Integer
n'  = Integer
n Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftR` (Int# -> Int
I# (Int#
ln# Int# -> Int# -> Int#
+# 1# Int# -> Int# -> Int#
-# Int#
md#))
                             n'' :: Integer
n'' = case Integer -> Int# -> Int#
roundingMode# Integer
n (Int#
ln# Int# -> Int# -> Int#
-# Int#
md#) of
                                    0# -> Integer
n'
                                    2# -> Integer
n' Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ 1
                                    _  -> case Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
n' Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. (1 :: Int) of
                                            0 -> Integer
n'
                                            _ -> Integer
n' Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ 1
                         in Integer -> Int -> a
forall a. RealFloat a => Integer -> Int -> a
encodeFloat Integer
n'' (Int# -> Int
I# (Int#
ln# Int# -> Int# -> Int#
-# Int#
ld# Int# -> Int# -> Int#
+# 1# Int# -> Int# -> Int#
-# Int#
md#))
                | Bool
otherwise ->
                  -- n/d < 2^(minEx-1), a denorm or rounded to 2^(minEx-1)
                  -- the exponent for encoding is always minEx-mantDigs
                  -- so we must shift right by (minEx-mantDigs) - (-ld)
                  case Int#
ld# Int# -> Int# -> Int#
+# (Int#
me# Int# -> Int# -> Int#
-# Int#
md#) of
                    ld'# :: Int#
ld'# | Int# -> Bool
isTrue# (Int#
ld'# Int# -> Int# -> Int#
<=# 0#) -> -- we would shift left, so we don't shift
                           Integer -> Int -> a
forall a. RealFloat a => Integer -> Int -> a
encodeFloat Integer
n (Int# -> Int
I# ((Int#
me# Int# -> Int# -> Int#
-# Int#
md#) Int# -> Int# -> Int#
-# Int#
ld'#))
                         | Int# -> Bool
isTrue# (Int#
ld'# Int# -> Int# -> Int#
<=# Int#
ln#) ->
                           let n' :: Integer
n' = Integer
n Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftR` (Int# -> Int
I# Int#
ld'#)
                           in case Integer -> Int# -> Int#
roundingMode# Integer
n (Int#
ld'# Int# -> Int# -> Int#
-# 1#) of
                                0# -> Integer -> Int -> a
forall a. RealFloat a => Integer -> Int -> a
encodeFloat Integer
n' (Int
minEx Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
mantDigs)
                                1# -> if Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
n' Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. (1 :: Int) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0
                                        then Integer -> Int -> a
forall a. RealFloat a => Integer -> Int -> a
encodeFloat Integer
n' (Int
minExInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
mantDigs)
                                        else Integer -> Int -> a
forall a. RealFloat a => Integer -> Int -> a
encodeFloat (Integer
n' Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ 1) (Int
minExInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
mantDigs)
                                _  -> Integer -> Int -> a
forall a. RealFloat a => Integer -> Int -> a
encodeFloat (Integer
n' Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ 1) (Int
minExInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
mantDigs)
                         | Int# -> Bool
isTrue# (Int#
ld'# Int# -> Int# -> Int#
># (Int#
ln# Int# -> Int# -> Int#
+# 1#)) -> Integer -> Int -> a
forall a. RealFloat a => Integer -> Int -> a
encodeFloat 0 0 -- result of shift < 0.5
                         | Bool
otherwise ->  -- first bit of n shifted to 0.5 place
                           case Integer -> (# Int#, Int# #)
integerLog2IsPowerOf2# Integer
n of
                            (# _, 0# #) -> Integer -> Int -> a
forall a. RealFloat a => Integer -> Int -> a
encodeFloat 0 0  -- round to even
                            (# _, _ #)  -> Integer -> Int -> a
forall a. RealFloat a => Integer -> Int -> a
encodeFloat 1 (Int
minEx Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
mantDigs)
        | Bool
otherwise ->
          let ln :: Int
ln = Int# -> Int
I# (Integer -> Int#
integerLog2# Integer
n)
              ld :: Int
ld = Int# -> Int
I# Int#
ld#
              -- 2^(ln-ld-1) < n/d < 2^(ln-ld+1)
              p0 :: Int
p0 = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
minEx (Int
ln Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
ld)
              (n' :: Integer
n', d' :: Integer
d')
                | Int
p0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
mantDigs = (Integer
n Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftL` (Int
mantDigs Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
p0), Integer
d)
                | Int
p0 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
mantDigs = (Integer
n, Integer
d)
                | Bool
otherwise     = (Integer
n, Integer
d Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftL` (Int
p0 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
mantDigs))
              -- if ln-ld < minEx, then n'/d' < 2^mantDigs, else
              -- 2^(mantDigs-1) < n'/d' < 2^(mantDigs+1) and we
              -- may need one scaling step
              scale :: a -> c -> c -> (a, c, c)
scale p :: a
p a :: c
a b :: c
b
                | (c
b c -> Int -> c
forall a. Bits a => a -> Int -> a
`shiftL` Int
mantDigs) c -> c -> Bool
forall a. Ord a => a -> a -> Bool
<= c
a = (a
pa -> a -> a
forall a. Num a => a -> a -> a
+1, c
a, c
b c -> Int -> c
forall a. Bits a => a -> Int -> a
`shiftL` 1)
                | Bool
otherwise = (a
p, c
a, c
b)
              (p' :: Int
p', n'' :: Integer
n'', d'' :: Integer
d'') = Int -> Integer -> Integer -> (Int, Integer, Integer)
forall c a. (Ord c, Bits c, Num a) => a -> c -> c -> (a, c, c)
scale (Int
p0Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
mantDigs) Integer
n' Integer
d'
              -- n''/d'' < 2^mantDigs and p' == minEx-mantDigs or n''/d'' >= 2^(mantDigs-1)
              rdq :: Integer
rdq = case Integer
n'' Integer -> Integer -> (Integer, Integer)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Integer
d'' of
                     (q :: Integer
q,r :: Integer
r) -> case Integer -> Integer -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Integer
r Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftL` 1) Integer
d'' of
                                LT -> Integer
q
                                EQ -> if Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
q Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. (1 :: Int) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0
                                        then Integer
q else Integer
qInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
+1
                                GT -> Integer
qInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
+1
          in  Integer -> Int -> a
forall a. RealFloat a => Integer -> Int -> a
encodeFloat Integer
rdq Int
p'

------------------------------------------------------------------------
-- Floating point numeric primops
------------------------------------------------------------------------

-- Definitions of the boxed PrimOps; these will be
-- used in the case of partial applications, etc.

plusFloat, minusFloat, timesFloat, divideFloat :: Float -> Float -> Float
plusFloat :: Float -> Float -> Float
plusFloat   (F# x :: Float#
x) (F# y :: Float#
y) = Float# -> Float
F# (Float# -> Float# -> Float#
plusFloat# Float#
x Float#
y)
minusFloat :: Float -> Float -> Float
minusFloat  (F# x :: Float#
x) (F# y :: Float#
y) = Float# -> Float
F# (Float# -> Float# -> Float#
minusFloat# Float#
x Float#
y)
timesFloat :: Float -> Float -> Float
timesFloat  (F# x :: Float#
x) (F# y :: Float#
y) = Float# -> Float
F# (Float# -> Float# -> Float#
timesFloat# Float#
x Float#
y)
divideFloat :: Float -> Float -> Float
divideFloat (F# x :: Float#
x) (F# y :: Float#
y) = Float# -> Float
F# (Float# -> Float# -> Float#
divideFloat# Float#
x Float#
y)

negateFloat :: Float -> Float
negateFloat :: Float -> Float
negateFloat (F# x :: Float#
x)        = Float# -> Float
F# (Float# -> Float#
negateFloat# Float#
x)

gtFloat, geFloat, ltFloat, leFloat :: Float -> Float -> Bool
gtFloat :: Float -> Float -> Bool
gtFloat     (F# x :: Float#
x) (F# y :: Float#
y) = Int# -> Bool
isTrue# (Float# -> Float# -> Int#
gtFloat# Float#
x Float#
y)
geFloat :: Float -> Float -> Bool
geFloat     (F# x :: Float#
x) (F# y :: Float#
y) = Int# -> Bool
isTrue# (Float# -> Float# -> Int#
geFloat# Float#
x Float#
y)
ltFloat :: Float -> Float -> Bool
ltFloat     (F# x :: Float#
x) (F# y :: Float#
y) = Int# -> Bool
isTrue# (Float# -> Float# -> Int#
ltFloat# Float#
x Float#
y)
leFloat :: Float -> Float -> Bool
leFloat     (F# x :: Float#
x) (F# y :: Float#
y) = Int# -> Bool
isTrue# (Float# -> Float# -> Int#
leFloat# Float#
x Float#
y)

expFloat, logFloat, sqrtFloat, fabsFloat :: Float -> Float
sinFloat, cosFloat, tanFloat  :: Float -> Float
asinFloat, acosFloat, atanFloat  :: Float -> Float
sinhFloat, coshFloat, tanhFloat  :: Float -> Float
asinhFloat, acoshFloat, atanhFloat  :: Float -> Float
expFloat :: Float -> Float
expFloat    (F# x :: Float#
x) = Float# -> Float
F# (Float# -> Float#
expFloat# Float#
x)
logFloat :: Float -> Float
logFloat    (F# x :: Float#
x) = Float# -> Float
F# (Float# -> Float#
logFloat# Float#
x)
sqrtFloat :: Float -> Float
sqrtFloat   (F# x :: Float#
x) = Float# -> Float
F# (Float# -> Float#
sqrtFloat# Float#
x)
fabsFloat :: Float -> Float
fabsFloat   (F# x :: Float#
x) = Float# -> Float
F# (Float# -> Float#
fabsFloat# Float#
x)
sinFloat :: Float -> Float
sinFloat    (F# x :: Float#
x) = Float# -> Float
F# (Float# -> Float#
sinFloat# Float#
x)
cosFloat :: Float -> Float
cosFloat    (F# x :: Float#
x) = Float# -> Float
F# (Float# -> Float#
cosFloat# Float#
x)
tanFloat :: Float -> Float
tanFloat    (F# x :: Float#
x) = Float# -> Float
F# (Float# -> Float#
tanFloat# Float#
x)
asinFloat :: Float -> Float
asinFloat   (F# x :: Float#
x) = Float# -> Float
F# (Float# -> Float#
asinFloat# Float#
x)
acosFloat :: Float -> Float
acosFloat   (F# x :: Float#
x) = Float# -> Float
F# (Float# -> Float#
acosFloat# Float#
x)
atanFloat :: Float -> Float
atanFloat   (F# x :: Float#
x) = Float# -> Float
F# (Float# -> Float#
atanFloat# Float#
x)
sinhFloat :: Float -> Float
sinhFloat   (F# x :: Float#
x) = Float# -> Float
F# (Float# -> Float#
sinhFloat# Float#
x)
coshFloat :: Float -> Float
coshFloat   (F# x :: Float#
x) = Float# -> Float
F# (Float# -> Float#
coshFloat# Float#
x)
tanhFloat :: Float -> Float
tanhFloat   (F# x :: Float#
x) = Float# -> Float
F# (Float# -> Float#
tanhFloat# Float#
x)
asinhFloat :: Float -> Float
asinhFloat  (F# x :: Float#
x) = Float# -> Float
F# (Float# -> Float#
asinhFloat# Float#
x)
acoshFloat :: Float -> Float
acoshFloat  (F# x :: Float#
x) = Float# -> Float
F# (Float# -> Float#
acoshFloat# Float#
x)
atanhFloat :: Float -> Float
atanhFloat  (F# x :: Float#
x) = Float# -> Float
F# (Float# -> Float#
atanhFloat# Float#
x)

powerFloat :: Float -> Float -> Float
powerFloat :: Float -> Float -> Float
powerFloat  (F# x :: Float#
x) (F# y :: Float#
y) = Float# -> Float
F# (Float# -> Float# -> Float#
powerFloat# Float#
x Float#
y)

-- definitions of the boxed PrimOps; these will be
-- used in the case of partial applications, etc.

plusDouble, minusDouble, timesDouble, divideDouble :: Double -> Double -> Double
plusDouble :: Double -> Double -> Double
plusDouble   (D# x :: Double#
x) (D# y :: Double#
y) = Double# -> Double
D# (Double#
x Double# -> Double# -> Double#
+## Double#
y)
minusDouble :: Double -> Double -> Double
minusDouble  (D# x :: Double#
x) (D# y :: Double#
y) = Double# -> Double
D# (Double#
x Double# -> Double# -> Double#
-## Double#
y)
timesDouble :: Double -> Double -> Double
timesDouble  (D# x :: Double#
x) (D# y :: Double#
y) = Double# -> Double
D# (Double#
x Double# -> Double# -> Double#
*## Double#
y)
divideDouble :: Double -> Double -> Double
divideDouble (D# x :: Double#
x) (D# y :: Double#
y) = Double# -> Double
D# (Double#
x Double# -> Double# -> Double#
/## Double#
y)

negateDouble :: Double -> Double
negateDouble :: Double -> Double
negateDouble (D# x :: Double#
x)        = Double# -> Double
D# (Double# -> Double#
negateDouble# Double#
x)

gtDouble, geDouble, leDouble, ltDouble :: Double -> Double -> Bool
gtDouble :: Double -> Double -> Bool
gtDouble    (D# x :: Double#
x) (D# y :: Double#
y) = Int# -> Bool
isTrue# (Double#
x Double# -> Double# -> Int#
>##  Double#
y)
geDouble :: Double -> Double -> Bool
geDouble    (D# x :: Double#
x) (D# y :: Double#
y) = Int# -> Bool
isTrue# (Double#
x Double# -> Double# -> Int#
>=## Double#
y)
ltDouble :: Double -> Double -> Bool
ltDouble    (D# x :: Double#
x) (D# y :: Double#
y) = Int# -> Bool
isTrue# (Double#
x Double# -> Double# -> Int#
<##  Double#
y)
leDouble :: Double -> Double -> Bool
leDouble    (D# x :: Double#
x) (D# y :: Double#
y) = Int# -> Bool
isTrue# (Double#
x Double# -> Double# -> Int#
<=## Double#
y)

double2Float :: Double -> Float
double2Float :: Double -> Float
double2Float (D# x :: Double#
x) = Float# -> Float
F# (Double# -> Float#
double2Float# Double#
x)

float2Double :: Float -> Double
float2Double :: Float -> Double
float2Double (F# x :: Float#
x) = Double# -> Double
D# (Float# -> Double#
float2Double# Float#
x)

expDouble, logDouble, sqrtDouble, fabsDouble :: Double -> Double
sinDouble, cosDouble, tanDouble  :: Double -> Double
asinDouble, acosDouble, atanDouble  :: Double -> Double
sinhDouble, coshDouble, tanhDouble  :: Double -> Double
asinhDouble, acoshDouble, atanhDouble  :: Double -> Double
expDouble :: Double -> Double
expDouble    (D# x :: Double#
x) = Double# -> Double
D# (Double# -> Double#
expDouble# Double#
x)
logDouble :: Double -> Double
logDouble    (D# x :: Double#
x) = Double# -> Double
D# (Double# -> Double#
logDouble# Double#
x)
sqrtDouble :: Double -> Double
sqrtDouble   (D# x :: Double#
x) = Double# -> Double
D# (Double# -> Double#
sqrtDouble# Double#
x)
fabsDouble :: Double -> Double
fabsDouble   (D# x :: Double#
x) = Double# -> Double
D# (Double# -> Double#
fabsDouble# Double#
x)
sinDouble :: Double -> Double
sinDouble    (D# x :: Double#
x) = Double# -> Double
D# (Double# -> Double#
sinDouble# Double#
x)
cosDouble :: Double -> Double
cosDouble    (D# x :: Double#
x) = Double# -> Double
D# (Double# -> Double#
cosDouble# Double#
x)
tanDouble :: Double -> Double
tanDouble    (D# x :: Double#
x) = Double# -> Double
D# (Double# -> Double#
tanDouble# Double#
x)
asinDouble :: Double -> Double
asinDouble   (D# x :: Double#
x) = Double# -> Double
D# (Double# -> Double#
asinDouble# Double#
x)
acosDouble :: Double -> Double
acosDouble   (D# x :: Double#
x) = Double# -> Double
D# (Double# -> Double#
acosDouble# Double#
x)
atanDouble :: Double -> Double
atanDouble   (D# x :: Double#
x) = Double# -> Double
D# (Double# -> Double#
atanDouble# Double#
x)
sinhDouble :: Double -> Double
sinhDouble   (D# x :: Double#
x) = Double# -> Double
D# (Double# -> Double#
sinhDouble# Double#
x)
coshDouble :: Double -> Double
coshDouble   (D# x :: Double#
x) = Double# -> Double
D# (Double# -> Double#
coshDouble# Double#
x)
tanhDouble :: Double -> Double
tanhDouble   (D# x :: Double#
x) = Double# -> Double
D# (Double# -> Double#
tanhDouble# Double#
x)
asinhDouble :: Double -> Double
asinhDouble  (D# x :: Double#
x) = Double# -> Double
D# (Double# -> Double#
asinhDouble# Double#
x)
acoshDouble :: Double -> Double
acoshDouble  (D# x :: Double#
x) = Double# -> Double
D# (Double# -> Double#
acoshDouble# Double#
x)
atanhDouble :: Double -> Double
atanhDouble  (D# x :: Double#
x) = Double# -> Double
D# (Double# -> Double#
atanhDouble# Double#
x)

powerDouble :: Double -> Double -> Double
powerDouble :: Double -> Double -> Double
powerDouble  (D# x :: Double#
x) (D# y :: Double#
y) = Double# -> Double
D# (Double#
x Double# -> Double# -> Double#
**## Double#
y)

foreign import ccall unsafe "isFloatNaN" isFloatNaN :: Float -> Int
foreign import ccall unsafe "isFloatInfinite" isFloatInfinite :: Float -> Int
foreign import ccall unsafe "isFloatDenormalized" isFloatDenormalized :: Float -> Int
foreign import ccall unsafe "isFloatNegativeZero" isFloatNegativeZero :: Float -> Int
foreign import ccall unsafe "isFloatFinite" isFloatFinite :: Float -> Int

foreign import ccall unsafe "isDoubleNaN" isDoubleNaN :: Double -> Int
foreign import ccall unsafe "isDoubleInfinite" isDoubleInfinite :: Double -> Int
foreign import ccall unsafe "isDoubleDenormalized" isDoubleDenormalized :: Double -> Int
foreign import ccall unsafe "isDoubleNegativeZero" isDoubleNegativeZero :: Double -> Int
foreign import ccall unsafe "isDoubleFinite" isDoubleFinite :: Double -> Int


------------------------------------------------------------------------
-- libm imports for extended floating
------------------------------------------------------------------------
foreign import capi unsafe "math.h log1p" log1pDouble :: Double -> Double
foreign import capi unsafe "math.h expm1" expm1Double :: Double -> Double
foreign import capi unsafe "math.h log1pf" log1pFloat :: Float -> Float
foreign import capi unsafe "math.h expm1f" expm1Float :: Float -> Float


------------------------------------------------------------------------
-- Coercion rules
------------------------------------------------------------------------

word2Double :: Word -> Double
word2Double :: Word -> Double
word2Double (W# w :: Word#
w) = Double# -> Double
D# (Word# -> Double#
word2Double# Word#
w)

word2Float :: Word -> Float
word2Float :: Word -> Float
word2Float (W# w :: Word#
w) = Float# -> Float
F# (Word# -> Float#
word2Float# Word#
w)

{-# RULES
"fromIntegral/Int->Float"   fromIntegral = int2Float
"fromIntegral/Int->Double"  fromIntegral = int2Double
"fromIntegral/Word->Float"  fromIntegral = word2Float
"fromIntegral/Word->Double" fromIntegral = word2Double
"realToFrac/Float->Float"   realToFrac   = id :: Float -> Float
"realToFrac/Float->Double"  realToFrac   = float2Double
"realToFrac/Double->Float"  realToFrac   = double2Float
"realToFrac/Double->Double" realToFrac   = id :: Double -> Double
"realToFrac/Int->Double"    realToFrac   = int2Double   -- See Note [realToFrac int-to-float]
"realToFrac/Int->Float"     realToFrac   = int2Float    --      ..ditto
    #-}

{-
Note [realToFrac int-to-float]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Don found that the RULES for realToFrac/Int->Double and simliarly
Float made a huge difference to some stream-fusion programs.  Here's
an example

      import Data.Array.Vector

      n = 40000000

      main = do
            let c = replicateU n (2::Double)
                a = mapU realToFrac (enumFromToU 0 (n-1) ) :: UArr Double
            print (sumU (zipWithU (*) c a))

Without the RULE we get this loop body:

      case $wtoRational sc_sY4 of ww_aM7 { (# ww1_aM9, ww2_aMa #) ->
      case $wfromRat ww1_aM9 ww2_aMa of tpl_X1P { D# ipv_sW3 ->
      Main.$s$wfold
        (+# sc_sY4 1)
        (+# wild_X1i 1)
        (+## sc2_sY6 (*## 2.0 ipv_sW3))

And with the rule:

     Main.$s$wfold
        (+# sc_sXT 1)
        (+# wild_X1h 1)
        (+## sc2_sXV (*## 2.0 (int2Double# sc_sXT)))

The running time of the program goes from 120 seconds to 0.198 seconds
with the native backend, and 0.143 seconds with the C backend.

A few more details in Trac #2251, and the patch message
"Add RULES for realToFrac from Int".
-}

-- Utils

showSignedFloat :: (RealFloat a)
  => (a -> ShowS)       -- ^ a function that can show unsigned values
  -> Int                -- ^ the precedence of the enclosing context
  -> a                  -- ^ the value to show
  -> ShowS
showSignedFloat :: (a -> ShowS) -> Int -> a -> ShowS
showSignedFloat showPos :: a -> ShowS
showPos p :: Int
p x :: a
x
   | a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< 0 Bool -> Bool -> Bool
|| a -> Bool
forall a. RealFloat a => a -> Bool
isNegativeZero a
x
       = Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 6) (Char -> ShowS
showChar '-' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ShowS
showPos (-a
x))
   | Bool
otherwise = a -> ShowS
showPos a
x

{-
We need to prevent over/underflow of the exponent in encodeFloat when
called from scaleFloat, hence we clamp the scaling parameter.
We must have a large enough range to cover the maximum difference of
exponents returned by decodeFloat.
-}
clamp :: Int -> Int -> Int
clamp :: Int -> Int -> Int
clamp bd :: Int
bd k :: Int
k = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max (-Int
bd) (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
bd Int
k)


{-
Note [Casting from integral to floating point types]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
To implement something like `reinterpret_cast` from C++ to go from a
floating-point type to an integral type one might niavely think that the
following should work:

      cast :: Float -> Word32
      cast (F# f#) = W32# (unsafeCoerce# f#)

Unfortunately that is not the case, because all the `unsafeCoerce#` does is tell
the compiler that the types have changed. When one does the above cast and
tries to operate on the resulting `Word32` the code generator will generate code
that performs an integer/word operation on a floating-point register, which
results in a compile error.

The correct way of implementing `reinterpret_cast` to implement a primpop, but
that requires a unique implementation for all supported archetectures. The next
best solution is to write the value from the source register to memory and then
read it from memory into the destination register and the best way to do that
is using CMM.
-}

-- | @'castWord32ToFloat' w@ does a bit-for-bit copy from an integral value
-- to a floating-point value.
--
-- @since 4.10.0.0

{-# INLINE castWord32ToFloat #-}
castWord32ToFloat :: Word32 -> Float
castWord32ToFloat :: Word32 -> Float
castWord32ToFloat (W32# w# :: Word#
w#) = Float# -> Float
F# (Word# -> Float#
stgWord32ToFloat Word#
w#)

foreign import prim "stg_word32ToFloatzh"
    stgWord32ToFloat :: Word# -> Float#


-- | @'castFloatToWord32' f@ does a bit-for-bit copy from a floating-point value
-- to an integral value.
--
-- @since 4.10.0.0

{-# INLINE castFloatToWord32 #-}
castFloatToWord32 :: Float -> Word32
castFloatToWord32 :: Float -> Word32
castFloatToWord32 (F# f# :: Float#
f#) = Word# -> Word32
W32# (Float# -> Word#
stgFloatToWord32 Float#
f#)

foreign import prim "stg_floatToWord32zh"
    stgFloatToWord32 :: Float# -> Word#



-- | @'castWord64ToDouble' w@ does a bit-for-bit copy from an integral value
-- to a floating-point value.
--
-- @since 4.10.0.0

{-# INLINE castWord64ToDouble #-}
castWord64ToDouble :: Word64 -> Double
castWord64ToDouble :: Word64 -> Double
castWord64ToDouble (W64# w :: Word#
w) = Double# -> Double
D# (Word# -> Double#
stgWord64ToDouble Word#
w)

foreign import prim "stg_word64ToDoublezh"
#if WORD_SIZE_IN_BITS == 64
    stgWord64ToDouble :: Word# -> Double#
#else
    stgWord64ToDouble :: Word64# -> Double#
#endif


-- | @'castFloatToWord32' f@ does a bit-for-bit copy from a floating-point value
-- to an integral value.
--
-- @since 4.10.0.0

{-# INLINE castDoubleToWord64 #-}
castDoubleToWord64 :: Double -> Word64
castDoubleToWord64 :: Double -> Word64
castDoubleToWord64 (D# d# :: Double#
d#) = Word# -> Word64
W64# (Double# -> Word#
stgDoubleToWord64 Double#
d#)

foreign import prim "stg_doubleToWord64zh"
#if WORD_SIZE_IN_BITS == 64
    stgDoubleToWord64 :: Double# -> Word#
#else
    stgDoubleToWord64 :: Double# -> Word64#
#endif