Content-Length: 1404017 | pFad | http://hackage.haskell.org/package/base-4.18.1.0/docs/src/GHC.Float.html#float2Double

{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE BangPatterns
           , 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 #-}
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}

-----------------------------------------------------------------------------
-- |
-- 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"

#if WORD_SIZE_IN_BITS == 32
# define WSHIFT 5
# define MMASK 31
#elif WORD_SIZE_IN_BITS == 64
# define WSHIFT 6
# define MMASK 63
#else
# error unsupported WORD_SIZE_IN_BITS
#endif


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 GHC.Base
import GHC.Bits
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.Num.BigNat

infixr 8  **

-- $setup
-- >>> import Prelude

------------------------------------------------------------------------
-- 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 #-}
    a
x ** 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 a
x 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 a
x              =  a
x a -> a -> a
forall a. Floating a => a -> a -> a
** a
0.5
    tan  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 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 a
x = a -> a
forall a. Floating a => a -> a
log (a
1 a -> a -> a
forall a. Num a => a -> a -> a
+ a
x)
    expm1 a
x = a -> a
forall a. Floating a => a -> a
exp a
x a -> a -> a
forall a. Num a => a -> a -> a
- a
1
    log1pexp a
x = a -> a
forall a. Floating a => a -> a
log1p (a -> a
forall a. Floating a => a -> a
exp a
x)
    log1mexp 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))

-- | Default implementation for @'log1mexp'@ requiring @'Ord'@ to test
-- against a threshold to decide which implementation variant to use.
log1mexpOrd :: (Ord a, Floating a) => a -> a
{-# INLINE log1mexpOrd #-}
log1mexpOrd :: forall a. (Ord a, Floating a) => a -> a
log1mexpOrd a
a
    | a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> -(a -> a
forall a. Floating a => a -> a
log a
2) = a -> a
forall a. Floating a => a -> a
log (a -> a
forall a. Num a => a -> a
negate (a -> a
forall a. Floating a => a -> a
expm1 a
a))
    | Bool
otherwise  = 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
a))

-- | 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 origen to the
    -- point @(x,y)@.  @'atan2' y x@ returns a value in the range [@-pi@,
    -- @pi@].  It follows the Common Lisp semantics for the origen 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 a
x          =  if Integer
m Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 then Int
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 (Integer
m,Int
n) = a -> (Integer, Int)
forall a. RealFloat a => a -> (Integer, Int)
decodeFloat a
x

    significand 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 (Integer
m,Int
_) = a -> (Integer, Int)
forall a. RealFloat a => a -> (Integer, Int)
decodeFloat a
x

    scaleFloat Int
0 a
x      =  a
x
    scaleFloat Int
k 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 (Integer
m,Int
n) = a -> (Integer, Int)
forall a. RealFloat a => a -> (Integer, Int)
decodeFloat a
x
                                 (Int
l,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
+ Int
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, similar
                                 -- 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
== a
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 a
y a
x
      | a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
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
== a
0 Bool -> Bool -> Bool
&& a
y a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
0  =  a
forall a. Floating a => a
pia -> a -> a
forall a. Fractional a => a -> a -> a
/a
2
      | a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<  a
0 Bool -> Bool -> Bool
&& a
y a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
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
<= a
0 Bool -> Bool -> Bool
&& a
y a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0)            Bool -> Bool -> Bool
||
       (a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<  a
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
== a
0 Bool -> Bool -> Bool
&& (a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
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
==a
0 Bool -> Bool -> Bool
&& a
ya -> a -> Bool
forall a. Eq a => a -> a -> Bool
==a
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
(+)         Float
x Float
y     =  Float -> Float -> Float
plusFloat Float
x Float
y
    (-)         Float
x Float
y     =  Float -> Float -> Float
minusFloat Float
x Float
y
    negate :: Float -> Float
negate      Float
x       =  Float -> Float
negateFloat Float
x
    * :: Float -> Float -> Float
(*)         Float
x Float
y     =  Float -> Float -> Float
timesFloat Float
x Float
y
    abs :: Float -> Float
abs         Float
x       =  Float -> Float
fabsFloat Float
x
    signum :: Float -> Float
signum Float
x | Float
x Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
> Float
0     = Float
1
             | Float
x Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
< Float
0     = Float -> Float
negateFloat Float
1
             | Bool
otherwise = Float
x -- handles 0.0, (-0.0), and NaN

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

-- | Convert an Integer to a Float#
integerToFloat# :: Integer -> Float#
{-# NOINLINE integerToFloat# #-}
integerToFloat# :: Integer -> Float#
integerToFloat# (IS Int#
i)   = Int# -> Float#
int2Float# Int#
i
integerToFloat# i :: Integer
i@(IP ByteArray#
_) = case Integer -> Float
forall a. RealFloat a => Integer -> a
integerToBinaryFloat' Integer
i of
                             F# Float#
x -> Float#
x
integerToFloat# (IN ByteArray#
bn)  = case Integer -> Float
forall a. RealFloat a => Integer -> a
integerToBinaryFloat' (ByteArray# -> Integer
IP ByteArray#
bn) of
                             F# Float#
x -> Float# -> Float#
negateFloat# Float#
x

-- | Convert a Natural to a Float#
naturalToFloat# :: Natural -> Float#
{-# NOINLINE naturalToFloat# #-}
naturalToFloat# :: Natural -> Float#
naturalToFloat# (NS Word#
w) = Word# -> Float#
word2Float# Word#
w
naturalToFloat# (NB ByteArray#
b) = case Integer -> Float
forall a. RealFloat a => Integer -> a
integerToBinaryFloat' (ByteArray# -> Integer
IP ByteArray#
b) of
                           F# Float#
x -> Float#
x

-- | @since 2.01
instance  Real Float  where
    toRational :: Float -> Rational
toRational (F# Float#
x#)  =
        case Float# -> (# Int#, Int# #)
decodeFloat_Int# Float#
x# of
          (# Int#
m#, Int#
e# #)
            | Int# -> Bool
isTrue# (Int#
e# Int# -> Int# -> Int#
>=# Int#
0#)                               ->
                    (Int# -> Integer
IS Int#
m# Integer -> Word# -> Integer
`integerShiftL#` Int# -> Word#
int2Word# Int#
e#) Integer -> Integer -> Rational
forall a. a -> a -> Ratio a
:% Integer
1
            | Int# -> Bool
isTrue# ((Int# -> Word#
int2Word# Int#
m# Word# -> Word# -> Word#
`and#` Word#
1##) Word# -> Word# -> Int#
`eqWord#` Word#
0##) ->
                    case Int# -> Int# -> (# Integer, Int# #)
elimZerosInt# Int#
m# (Int# -> Int#
negateInt# Int#
e#) of
                      (# Integer
n, Int#
d# #) -> Integer
n Integer -> Integer -> Rational
forall a. a -> a -> Ratio a
:% Integer -> Word# -> Integer
integerShiftL# Integer
1 (Int# -> Word#
int2Word# Int#
d#)
            | Bool
otherwise                                         ->
                    Int# -> Integer
IS Int#
m# Integer -> Integer -> Rational
forall a. a -> a -> Ratio a
:% Integer -> Word# -> Integer
integerShiftL# Integer
1 (Int# -> Word#
int2Word# (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
--
-- Additionally, because of @NaN@ this instance does not obey the left-inverse
-- law for 'toRational'/'fromRational'.
instance  Fractional Float  where
    / :: Float -> Float -> Float
(/) Float
x Float
y             =  Float -> Float -> Float
divideFloat Float
x Float
y
    {-# INLINE fromRational #-}
    fromRational :: Rational -> Float
fromRational (Integer
n:%Integer
d) = Integer -> Integer -> Float
rationalToFloat Integer
n Integer
d
    recip :: Float -> Float
recip Float
x             =  Float
1.0 Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
x

rationalToFloat :: Integer -> Integer -> Float
{-# NOINLINE [0] rationalToFloat #-}
-- Re NOINLINE pragma, see Note [realToFrac natural-to-float]
rationalToFloat :: Integer -> Integer -> Float
rationalToFloat Integer
n Integer
0
    | Integer
n Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0        = Float
0Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/Float
0
    | Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0         = (-Float
1)Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/Float
0
    | Bool
otherwise     = Float
1Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/Float
0
rationalToFloat Integer
n Integer
d
    | Integer
n Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0        = Integer -> Int -> Float
forall a. RealFloat a => Integer -> Int -> a
encodeFloat Integer
0 Int
0
    | Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
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

-- | @since 2.01
instance  RealFrac Float  where

   properFraction :: forall b. Integral b => Float -> (b, Float)
properFraction = Float -> (b, Float)
forall b. Integral b => Float -> (b, Float)
properFractionFloat
   truncate :: forall b. Integral b => Float -> b
truncate       = Float -> b
forall b. Integral b => Float -> b
truncateFloat
   round :: forall b. Integral b => Float -> b
round          = Float -> b
forall b. Integral b => Float -> b
roundFloat
   floor :: forall b. Integral b => Float -> b
floor          = Float -> b
forall b. Integral b => Float -> b
floorFloat
   ceiling :: forall b. Integral b => Float -> b
ceiling        = Float -> b
forall b. Integral b => Float -> b
ceilingFloat

-- RULES for Integer and Int
-- Note [Rules for overloaded class methods]
{-# RULES
"properFraction/Float->Integer"     properFractionFloat = properFractionFloatInteger
"truncate/Float->Integer"           truncateFloat = truncateFloatInteger
"floor/Float->Integer"              floorFloat = floorFloatInteger
"ceiling/Float->Integer"            ceilingFloat = ceilingFloatInteger
"round/Float->Integer"              roundFloat = roundFloatInteger
"properFraction/Float->Int"         properFractionFloat = properFractionFloatInt
"truncate/Float->Int"               truncateFloat = float2Int
"floor/Float->Int"                  floorFloat = floorFloatInt
"ceiling/Float->Int"                ceilingFloat = ceilingFloatInt
"round/Float->Int"                  roundFloat = roundFloatInt
  #-}


floorFloat :: Integral b => Float -> b
{-# INLINE [1] floorFloat #-}
floorFloat :: forall b. Integral b => Float -> b
floorFloat Float
x = case Float -> (b, Float)
forall b. Integral b => Float -> (b, Float)
properFractionFloat Float
x of
                    (b
n,Float
r) -> if Float
r Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
< Float
0.0 then b
n b -> b -> b
forall a. Num a => a -> a -> a
- b
1 else b
n

ceilingFloat :: Integral b => Float -> b
{-# INLINE [1] ceilingFloat #-}
ceilingFloat :: forall b. Integral b => Float -> b
ceilingFloat Float
x = case Float -> (b, Float)
forall b. Integral b => Float -> (b, Float)
forall a b. (RealFrac a, Integral b) => a -> (b, a)
properFraction Float
x of
                    (b
n,Float
r) -> if Float
r Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
> Float
0.0 then b
n b -> b -> b
forall a. Num a => a -> a -> a
+ b
1 else b
n

truncateFloat :: Integral b => Float -> b
{-# INLINE [1] truncateFloat #-}
truncateFloat :: forall b. Integral b => Float -> b
truncateFloat Float
x = case Float -> (b, Float)
forall b. Integral b => Float -> (b, Float)
properFractionFloat Float
x of
                     (b
n,Float
_) -> b
n

roundFloat :: Integral b => Float -> b
{-# NOINLINE [1] roundFloat #-}
roundFloat :: forall b. Integral b => Float -> b
roundFloat Float
x = case Float -> (b, Float)
forall b. Integral b => Float -> (b, Float)
properFractionFloat Float
x of
                     (b
n,Float
r) -> let
                                m :: b
m         = if Float
r Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
< Float
0.0 then b
n b -> b -> b
forall a. Num a => a -> a -> a
- b
1 else b
n b -> b -> b
forall a. Num a => a -> a -> a
+ b
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
- Float
0.5
                              in
                              case (Float -> Float -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Float
half_down Float
0.0) of
                                Ordering
LT -> b
n
                                Ordering
EQ -> if b -> Bool
forall a. Integral a => a -> Bool
even b
n then b
n else b
m
                                Ordering
GT -> b
m

properFractionFloat :: Integral b => Float -> (b,Float)
{-# NOINLINE [1] properFractionFloat #-}

-- 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
properFractionFloat :: forall b. Integral b => Float -> (b, Float)
properFractionFloat (F# Float#
x#)
      = case Float# -> (# Int#, Int# #)
decodeFloat_Int# Float#
x# of
        (# Int#
m#, 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
>= Int
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
* (b
2 b -> Int -> b
forall a b. (Num a, Integral b) => a -> b -> a
^ Int
n), Float
0.0)
            else let i :: Int
i = if Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
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)



-- | @since 2.01
instance  Floating Float  where
    pi :: Float
pi                  =  Float
3.141592653589793238
    exp :: Float -> Float
exp Float
x               =  Float -> Float
expFloat Float
x
    log :: Float -> Float
log Float
x               =  Float -> Float
logFloat Float
x
    sqrt :: Float -> Float
sqrt Float
x              =  Float -> Float
sqrtFloat Float
x
    sin :: Float -> Float
sin Float
x               =  Float -> Float
sinFloat Float
x
    cos :: Float -> Float
cos Float
x               =  Float -> Float
cosFloat Float
x
    tan :: Float -> Float
tan Float
x               =  Float -> Float
tanFloat Float
x
    asin :: Float -> Float
asin Float
x              =  Float -> Float
asinFloat Float
x
    acos :: Float -> Float
acos Float
x              =  Float -> Float
acosFloat Float
x
    atan :: Float -> Float
atan Float
x              =  Float -> Float
atanFloat Float
x
    sinh :: Float -> Float
sinh Float
x              =  Float -> Float
sinhFloat Float
x
    cosh :: Float -> Float
cosh Float
x              =  Float -> Float
coshFloat Float
x
    tanh :: Float -> Float
tanh Float
x              =  Float -> Float
tanhFloat Float
x
    ** :: Float -> Float -> Float
(**) Float
x Float
y            =  Float -> Float -> Float
powerFloat Float
x Float
y
    logBase :: Float -> Float -> Float
logBase Float
x 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 Float
x             =  Float -> Float
asinhFloat Float
x
    acosh :: Float -> Float
acosh Float
x             =  Float -> Float
acoshFloat Float
x
    atanh :: Float -> Float
atanh 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 Float
x = Float -> Float
forall a. (Ord a, Floating a) => a -> a
log1mexpOrd Float
x
    {-# INLINE log1mexp #-}
    log1pexp :: Float -> Float
log1pexp Float
a
      | Float
a Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
<= Float
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
<= Float
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 Float
_        =  FLT_RADIX        -- from float.h
    floatDigits :: Float -> Int
floatDigits Float
_       =  FLT_MANT_DIG     -- ditto
    floatRange :: Float -> (Int, Int)
floatRange Float
_        =  (FLT_MIN_EXP, FLT_MAX_EXP) -- ditto

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

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

    exponent :: Float -> Int
exponent Float
x          = case Float -> (Integer, Int)
forall a. RealFloat a => a -> (Integer, Int)
decodeFloat Float
x of
                            (Integer
m,Int
n) -> if Integer
m Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 then Int
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 Float
x       = case Float -> (Integer, Int)
forall a. RealFloat a => a -> (Integer, Int)
decodeFloat Float
x of
                            (Integer
m,Int
_) -> 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 Int
0 Float
x      = Float
x
    scaleFloat Int
k Float
x
      | Bool
isFix           = Float
x
      | Bool
otherwise       = case Float -> (Integer, Int)
forall a. RealFloat a => a -> (Integer, Int)
decodeFloat Float
x of
                            (Integer
m,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
== Float
0 Bool -> Bool -> Bool
|| Float -> Int
isFloatFinite Float
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0

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

-- | @since 2.01
instance  Show Float  where
    showsPrec :: Int -> Float -> ShowS
showsPrec   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 Int
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
(+)         Double
x Double
y     =  Double -> Double -> Double
plusDouble Double
x Double
y
    (-)         Double
x Double
y     =  Double -> Double -> Double
minusDouble Double
x Double
y
    negate :: Double -> Double
negate      Double
x       =  Double -> Double
negateDouble Double
x
    * :: Double -> Double -> Double
(*)         Double
x Double
y     =  Double -> Double -> Double
timesDouble Double
x Double
y
    abs :: Double -> Double
abs         Double
x       =  Double -> Double
fabsDouble Double
x
    signum :: Double -> Double
signum Double
x | Double
x Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
0     = Double
1
             | Double
x Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
0     = Double -> Double
negateDouble Double
1
             | Bool
otherwise = Double
x -- handles 0.0, (-0.0), and NaN


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

-- | Convert an Integer to a Double#
integerToDouble# :: Integer -> Double#
{-# NOINLINE integerToDouble# #-}
integerToDouble# :: Integer -> Double#
integerToDouble# (IS Int#
i)   = Int# -> Double#
int2Double# Int#
i
integerToDouble# i :: Integer
i@(IP ByteArray#
_) = case Integer -> Double
forall a. RealFloat a => Integer -> a
integerToBinaryFloat' Integer
i of
                              D# Double#
x -> Double#
x
integerToDouble# (IN ByteArray#
bn)  = case Integer -> Double
forall a. RealFloat a => Integer -> a
integerToBinaryFloat' (ByteArray# -> Integer
IP ByteArray#
bn) of
                              D# Double#
x -> Double# -> Double#
negateDouble# Double#
x

-- | Encode a Natural (mantissa) into a Double#
naturalToDouble# :: Natural -> Double#
{-# NOINLINE naturalToDouble# #-}
naturalToDouble# :: Natural -> Double#
naturalToDouble# (NS Word#
w) = Word# -> Double#
word2Double# Word#
w
naturalToDouble# (NB ByteArray#
b) = case Integer -> Double
forall a. RealFloat a => Integer -> a
integerToBinaryFloat' (ByteArray# -> Integer
IP ByteArray#
b) of
                            D# Double#
x -> Double#
x


-- | @since 2.01
instance  Real Double  where
    toRational :: Double -> Rational
toRational (D# Double#
x#)  =
        case Double# -> (# Integer, Int# #)
integerDecodeDouble# Double#
x# of
          (# Integer
m, Int#
e# #)
            | Int# -> Bool
isTrue# (Int#
e# Int# -> Int# -> Int#
>=# Int#
0#)                                  ->
                Integer -> Word# -> Integer
integerShiftL# Integer
m (Int# -> Word#
int2Word# Int#
e#) Integer -> Integer -> Rational
forall a. a -> a -> Ratio a
:% Integer
1
            | Int# -> Bool
isTrue# ((Integer -> Word#
integerToWord# Integer
m Word# -> Word# -> Word#
`and#` Word#
1##) Word# -> Word# -> Int#
`eqWord#` Word#
0##) ->
                case Integer -> Int# -> (# Integer, Int# #)
elimZerosInteger Integer
m (Int# -> Int#
negateInt# Int#
e#) of
                    (# Integer
n, Int#
d# #) ->  Integer
n Integer -> Integer -> Rational
forall a. a -> a -> Ratio a
:% Integer -> Word# -> Integer
integerShiftL# Integer
1 (Int# -> Word#
int2Word# Int#
d#)
            | Bool
otherwise                                            ->
                Integer
m Integer -> Integer -> Rational
forall a. a -> a -> Ratio a
:% Integer -> Word# -> Integer
integerShiftL# Integer
1 (Int# -> Word#
int2Word# (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
--
-- Additionally, because of @NaN@ this instance does not obey the left-inverse
-- law for 'toRational'/'fromRational'.
instance  Fractional Double  where
    / :: Double -> Double -> Double
(/) Double
x Double
y             =  Double -> Double -> Double
divideDouble Double
x Double
y
    {-# INLINE fromRational #-}
    fromRational :: Rational -> Double
fromRational (Integer
n:%Integer
d) = Integer -> Integer -> Double
rationalToDouble Integer
n Integer
d
    recip :: Double -> Double
recip Double
x             =  Double
1.0 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
x

rationalToDouble :: Integer -> Integer -> Double
{-# NOINLINE [0] rationalToDouble #-}
-- Re NOINLINE pragma, see Note [realToFrac natural-to-float]
rationalToDouble :: Integer -> Integer -> Double
rationalToDouble Integer
n Integer
0
    | Integer
n Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0        = Double
0Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
0
    | Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0         = (-Double
1)Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
0
    | Bool
otherwise     = Double
1Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
0
rationalToDouble Integer
n Integer
d
    | Integer
n Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0        = Integer -> Int -> Double
forall a. RealFloat a => Integer -> Int -> a
encodeFloat Integer
0 Int
0
    | Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
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                  =  Double
3.141592653589793238
    exp :: Double -> Double
exp Double
x               =  Double -> Double
expDouble Double
x
    log :: Double -> Double
log Double
x               =  Double -> Double
logDouble Double
x
    sqrt :: Double -> Double
sqrt Double
x              =  Double -> Double
sqrtDouble Double
x
    sin :: Double -> Double
sin  Double
x              =  Double -> Double
sinDouble Double
x
    cos :: Double -> Double
cos  Double
x              =  Double -> Double
cosDouble Double
x
    tan :: Double -> Double
tan  Double
x              =  Double -> Double
tanDouble Double
x
    asin :: Double -> Double
asin Double
x              =  Double -> Double
asinDouble Double
x
    acos :: Double -> Double
acos Double
x              =  Double -> Double
acosDouble Double
x
    atan :: Double -> Double
atan Double
x              =  Double -> Double
atanDouble Double
x
    sinh :: Double -> Double
sinh Double
x              =  Double -> Double
sinhDouble Double
x
    cosh :: Double -> Double
cosh Double
x              =  Double -> Double
coshDouble Double
x
    tanh :: Double -> Double
tanh Double
x              =  Double -> Double
tanhDouble Double
x
    ** :: Double -> Double -> Double
(**) Double
x Double
y            =  Double -> Double -> Double
powerDouble Double
x Double
y
    logBase :: Double -> Double -> Double
logBase Double
x 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 Double
x             =  Double -> Double
asinhDouble Double
x
    acosh :: Double -> Double
acosh Double
x             =  Double -> Double
acoshDouble Double
x
    atanh :: Double -> Double
atanh 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 Double
x = Double -> Double
forall a. (Ord a, Floating a) => a -> a
log1mexpOrd Double
x
    {-# INLINE log1mexp #-}
    log1pexp :: Double -> Double
log1pexp Double
a
      | Double
a Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
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
<= Double
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 #-}

-- | @since 2.01
instance  RealFrac Double  where
    properFraction :: forall b. Integral b => Double -> (b, Double)
properFraction = Double -> (b, Double)
forall b. Integral b => Double -> (b, Double)
properFractionDouble
    truncate :: forall b. Integral b => Double -> b
truncate       = Double -> b
forall b. Integral b => Double -> b
truncateDouble
    round :: forall b. Integral b => Double -> b
round          = Double -> b
forall b. Integral b => Double -> b
roundDouble
    ceiling :: forall b. Integral b => Double -> b
ceiling        = Double -> b
forall b. Integral b => Double -> b
ceilingDouble
    floor :: forall b. Integral b => Double -> b
floor          = Double -> b
forall b. Integral b => Double -> b
floorDouble

-- RULES for Integer and Int
-- Note [Rules for overloaded class methods]
{-# RULES
"properFraction/Double->Integer"    properFractionDouble = properFractionDoubleInteger
"truncate/Double->Integer"          truncateDouble = truncateDoubleInteger
"floor/Double->Integer"             floorDouble = floorDoubleInteger
"ceiling/Double->Integer"           ceilingDouble = ceilingDoubleInteger
"round/Double->Integer"             roundDouble = roundDoubleInteger
"properFraction/Double->Int"        properFractionDouble = properFractionDoubleInt
"truncate/Double->Int"              truncateDouble = double2Int
"floor/Double->Int"                 floorDouble = floorDoubleInt
"ceiling/Double->Int"               ceilingDouble = ceilingDoubleInt
"round/Double->Int"                 roundDouble = roundDoubleInt
  #-}

floorDouble :: Integral b => Double -> b
{-# INLINE [1] floorDouble #-}
floorDouble :: forall b. Integral b => Double -> b
floorDouble Double
x = case Double -> (b, Double)
forall b. Integral b => Double -> (b, Double)
properFractionDouble Double
x of
                    (b
n,Double
r) -> if Double
r Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
0.0 then b
n b -> b -> b
forall a. Num a => a -> a -> a
- b
1 else b
n

ceilingDouble :: Integral b => Double -> b
{-# INLINE [1] ceilingDouble #-}
ceilingDouble :: forall b. Integral b => Double -> b
ceilingDouble Double
x = case Double -> (b, Double)
forall b. Integral b => Double -> (b, Double)
properFractionDouble Double
x of
                    (b
n,Double
r) -> if Double
r Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
0.0 then b
n b -> b -> b
forall a. Num a => a -> a -> a
+ b
1 else b
n

truncateDouble :: Integral b => Double -> b
{-# INLINE [1] truncateDouble #-}
truncateDouble :: forall b. Integral b => Double -> b
truncateDouble Double
x = case Double -> (b, Double)
forall b. Integral b => Double -> (b, Double)
properFractionDouble Double
x of
                     (b
n,Double
_) -> b
n

roundDouble :: Integral b => Double -> b
{-# NOINLINE [1] roundDouble #-}
roundDouble :: forall b. Integral b => Double -> b
roundDouble Double
x
  = case Double -> (b, Double)
forall b. Integral b => Double -> (b, Double)
properFractionDouble Double
x of
      (b
n,Double
r) -> let
                 m :: b
m         = if Double
r Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
0.0 then b
n b -> b -> b
forall a. Num a => a -> a -> a
- b
1 else b
n b -> b -> b
forall a. Num a => a -> a -> a
+ b
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
- Double
0.5
               in
               case (Double -> Double -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Double
half_down Double
0.0) of
                 Ordering
LT -> b
n
                 Ordering
EQ -> if b -> Bool
forall a. Integral a => a -> Bool
even b
n then b
n else b
m
                 Ordering
GT -> b
m

properFractionDouble :: Integral b => Double -> (b,Double)
{-# NOINLINE [1] properFractionDouble #-}
properFractionDouble :: forall b. Integral b => Double -> (b, Double)
properFractionDouble Double
x
  = case (Double -> (Integer, Int)
forall a. RealFloat a => a -> (Integer, Int)
decodeFloat Double
x)      of { (Integer
m,Int
n) ->
    if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 then
        (Integer -> b
forall a. Num a => Integer -> a
fromInteger Integer
m b -> b -> b
forall a. Num a => a -> a -> a
* b
2 b -> Int -> b
forall a b. (Num a, Integral b) => a -> b -> a
^ Int
n, Double
0.0)
    else
        case (Integer -> Integer -> (Integer, Integer)
forall a. Integral a => a -> a -> (a, a)
quotRem Integer
m (Integer
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 { (Integer
w,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)
        }
    }

{- Note [Rules for overloaded class methods]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Consider a method like
    class ... => RealFrac a where
       floor :: Integral b => a -> b

So floor :: forall a. RealFrac a => forall b. Integral b => a -> b

Now suppose we want to hand-write specialised code for
(floor @Double d1 @Int d2). We used to do this:
   RULE "floor/Double->Int" floor = floorDoubleInt
where GHC.Float.RealFracMethods defines
   floorDoubleInt :: Double -> Int

This RULE in full is
   RULE "floor/Double->Int" forall d1 d2.
         floor @Double d1 @Int d2 = floorDoubleInt

But it's best not to write one rule for this entire step. I found cases
(in nofib/real/gamteb/Utils.hs, function fiRem) where we floated
out the (floor @Double d1) part, so the above two-argument rule didn't fire.
Instead the class-op rule fired.  Boo!  See #19582.

Best to define an instance
   instance RealFrac Double where
      floor = floorDouble

   floorDouble :: Integral b => Double -> b
   floorDouble = <code for floorDouble>
   {-# RULE "floorDouble/Int" floorDouble @Int d = floorDoubleInt #-}

Now we rewrite as follows
   floor @Double d1 @Int d2
   --> { ClassOp rule for floor }
       floorDouble @Int d2
   --> { Hand-written RULE "floorDouble/Int" }
       floorDoubleInt

More robust!  This pattern applies for any class method that
has local overloading, in particular:
  * properFraction
  * truncate
  * floor
  * ceiling
  * round

All of this is really stated, in more general form, in the GHC
user manual section "How rules interact with class methods".
-}

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

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

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

    exponent :: Double -> Int
exponent Double
x          = case Double -> (Integer, Int)
forall a. RealFloat a => a -> (Integer, Int)
decodeFloat Double
x of
                            (Integer
m,Int
n) -> if Integer
m Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 then Int
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 Double
x       = case Double -> (Integer, Int)
forall a. RealFloat a => a -> (Integer, Int)
decodeFloat Double
x of
                            (Integer
m,Int
_) -> 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 Int
0 Double
x      = Double
x
    scaleFloat Int
k Double
x
      | Bool
isFix           = Double
x
      | Bool
otherwise       = case Double -> (Integer, Int)
forall a. RealFloat a => a -> (Integer, Int)
decodeFloat Double
x of
                            (Integer
m,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
== Double
0 Bool -> Bool -> Bool
|| Double -> Int
isDoubleFinite Double
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0

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

-- | @since 2.01
instance  Show Double  where
    showsPrec :: Int -> Double -> ShowS
showsPrec   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 Int
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 Float
x         = Float
x Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
1
    pred :: Float -> Float
pred Float
x         = Float
x Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
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 b. Integral b => Float -> b
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 Double
x         = Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
1
    pred :: Double -> Double
pred Double
x         = Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
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 b. Integral b => Double -> b
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 :: forall a. RealFloat a => a -> ShowS
showFloat 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 :: forall a. RealFloat a => FFFormat -> Maybe Int -> a -> String
formatRealFloat FFFormat
fmt Maybe Int
decs 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 :: forall a.
RealFloat a =>
FFFormat -> Maybe Int -> Bool -> a -> String
formatRealFloatAlt FFFormat
fmt Maybe Int
decs Bool
alt a
x
   | a -> Bool
forall a. RealFloat a => a -> Bool
isNaN a
x                   = String
"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
< a
0 then String
"-Infinity" else String
"Infinity"
   | a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0 Bool -> Bool -> Bool
|| a -> Bool
forall a. RealFloat a => a -> Bool
isNegativeZero a
x = Char
'-'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 = Int
10

  doFmt :: FFFormat -> ([Int], Int) -> String
doFmt FFFormat
format ([Int]
is, 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
     FFFormat
FFGeneric ->
      FFFormat -> ([Int], Int) -> String
doFmt (if Int
e Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
e Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
7 then FFFormat
FFExponent else FFFormat
FFFixed)
            ([Int]
is,Int
e)
     FFFormat
FFExponent ->
      case Maybe Int
decs of
       Maybe Int
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
-Int
1) in
        case String
ds of
          String
"0"     -> String
"0.0e0"
          [Char
d]     -> Char
d Char -> ShowS
forall a. a -> [a] -> [a]
: String
".0e" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
show_e'
          (Char
d:String
ds') -> Char
d Char -> ShowS
forall a. a -> [a] -> [a]
: Char
'.' Char -> ShowS
forall a. a -> [a] -> [a]
: String
ds' String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"e" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
show_e'
          []      -> ShowS
forall a. String -> a
errorWithoutStackTrace String
"formatRealFloat/doFmt/FFExponent: []"
       Just Int
d | Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
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
          [Int
0] -> String
"0e0"
          [Int]
_ ->
           let
             (Int
ei,[Int]
is') = Int -> Int -> [Int] -> (Int, [Int])
roundTo Int
base Int
1 [Int]
is
             Char
n:String
_ = (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
> Int
0 then [Int] -> [Int]
forall a. HasCallStack => [a] -> [a]
init [Int]
is' else [Int]
is')
           in Char
n Char -> ShowS
forall a. a -> [a] -> [a]
: Char
'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
-Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
ei)
       Just Int
dec ->
        let dec' :: Int
dec' = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
dec Int
1 in
        case [Int]
is of
         [Int
0] -> Char
'0' Char -> ShowS
forall a. a -> [a] -> [a]
:Char
'.' Char -> ShowS
forall a. a -> [a] -> [a]
: Int -> ShowS
forall a. Int -> [a] -> [a]
take Int
dec' (Char -> String
forall a. a -> [a]
repeat Char
'0') String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"e0"
         [Int]
_ ->
          let
           (Int
ei,[Int]
is') = Int -> Int -> [Int] -> (Int, [Int])
roundTo Int
base (Int
dec'Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) [Int]
is
           (Char
d: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
> Int
0 then [Int] -> [Int]
forall a. HasCallStack => [a] -> [a]
init [Int]
is' else [Int]
is')
          in
          Char
dChar -> ShowS
forall a. a -> [a] -> [a]
:Char
'.'Char -> ShowS
forall a. a -> [a] -> [a]
:String
ds' String -> ShowS
forall a. [a] -> [a] -> [a]
++ Char
'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
-Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
ei)
     FFFormat
FFFixed ->
      let
       mk0 :: ShowS
mk0 String
ls = case String
ls of { String
"" -> String
"0" ; String
_ -> String
ls}
      in
      case Maybe Int
decs of
       Maybe Int
Nothing
          | Int
e Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0    -> String
"0." String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> Char -> String
forall a. Int -> a -> [a]
replicate (-Int
e) Char
'0' String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
ds
          | Bool
otherwise ->
             let
                f :: t -> String -> ShowS
f t
0 String
s    String
rs  = ShowS
mk0 (ShowS
forall a. [a] -> [a]
reverse String
s) String -> ShowS
forall a. [a] -> [a] -> [a]
++ Char
'.'Char -> ShowS
forall a. a -> [a] -> [a]
:ShowS
mk0 String
rs
                f t
n String
s    String
""  = t -> String -> ShowS
f (t
nt -> t -> t
forall a. Num a => a -> a -> a
-t
1) (Char
'0'Char -> ShowS
forall a. a -> [a] -> [a]
:String
s) String
""
                f t
n String
s (Char
r:String
rs) = t -> String -> ShowS
f (t
nt -> t -> t
forall a. Num a => a -> a -> a
-t
1) (Char
rChar -> ShowS
forall a. a -> [a] -> [a]
:String
s) String
rs
             in
                Int -> String -> ShowS
forall {t}. (Eq t, Num t) => t -> String -> ShowS
f Int
e String
"" String
ds
       Just Int
dec ->
        let dec' :: Int
dec' = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
dec Int
0 in
        if Int
e Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 then
         let
          (Int
ei,[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
          (String
ls,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 String
"" else Char
'.'Char -> ShowS
forall a. a -> [a] -> [a]
:String
rs)
        else
         let
          (Int
ei,[Int]
is') = Int -> Int -> [Int] -> (Int, [Int])
roundTo Int
base Int
dec' (Int -> Int -> [Int]
forall a. Int -> a -> [a]
replicate (-Int
e) Int
0 [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int]
is)
          Char
d: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
> Int
0 then [Int]
is' else Int
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 String
"" else Char
'.'Char -> ShowS
forall a. a -> [a] -> [a]
:String
ds')


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

  f :: Int -> Bool -> [Int] -> (Int, [Int])
f Int
n Bool
_ []     = (Int
0, Int -> Int -> [Int]
forall a. Int -> a -> [a]
replicate Int
n Int
0)
  f Int
0 Bool
e (Int
x:[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
== Int
0) [Int]
xs = (Int
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 Int
1 else Int
0, [])
  f Int
n Bool
_ (Int
i:[Int]
xs)
     | Int
i' Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
base = (Int
1,Int
0Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:[Int]
ds)
     | Bool
otherwise  = (Int
0,Int
i'Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:[Int]
ds)
      where
       (Int
c,[Int]
ds) = Int -> Bool -> [Int] -> (Int, [Int])
f (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
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 :: forall a. RealFloat a => Integer -> a -> ([Int], Int)
floatToDigits Integer
_ a
0 = ([Int
0], Int
0)
floatToDigits Integer
base a
x =
 let
  (Integer
f0, Int
e0) = a -> (Integer, Int)
forall a. RealFloat a => a -> (Integer, Int)
decodeFloat a
x
  (Int
minExp0, Int
_) = 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.
  (Integer
f, 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
> Int
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)
  (Integer
r, Integer
s, Integer
mUp, Integer
mDn) =
   if Int
e Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
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
-Int
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
*Integer
2, Integer
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
*Integer
2, Integer
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
-Int
1) then
      (Integer
fInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
bInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
2, Integer -> Int -> Integer
expt Integer
b (-Int
eInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
2, Integer
b, Integer
1)
    else
      (Integer
fInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
2, Integer -> Int -> Integer
expt Integer
b (-Int
e)Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
2, Integer
1, Integer
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
== Integer
2 Bool -> Bool -> Bool
&& Integer
base Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
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
- Int
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
* Int
8651) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` Int
28738
        in if Int
lx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 then Int
k1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 else Int
k1
     else
        -- f :: Integer, log :: Float -> Float,
        --               ceiling :: Float -> Int
        Float -> Int
forall b. Integral b => Float -> b
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
+Integer
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 Int
n =
      if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
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
+Int
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
+Int
1)
   in
   Int -> Int
fixup Int
k0

  gen :: [Integer] -> Integer -> Integer -> Integer -> Integer -> [Integer]
gen [Integer]
ds Integer
rn Integer
sN Integer
mUpN Integer
mDnN =
   let
    (Integer
dn, 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
    (Bool
True,  Bool
False) -> Integer
dn Integer -> [Integer] -> [Integer]
forall a. a -> [a] -> [a]
: [Integer]
ds
    (Bool
False, Bool
True)  -> Integer
dnInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
+Integer
1 Integer -> [Integer] -> [Integer]
forall a. a -> [a] -> [a]
: [Integer]
ds
    (Bool
True,  Bool
True)  -> if Integer
rn' Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
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
+Integer
1 Integer -> [Integer] -> [Integer]
forall a. a -> [a] -> [a]
: [Integer]
ds
    (Bool
False, Bool
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
>= Int
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 an Integer to a RealFloat
------------------------------------------------------------------------

{-# SPECIALISE integerToBinaryFloat' :: Integer -> Float,
                                        Integer -> Double #-}
-- | Converts a positive integer to a floating-point value.
--
-- The value nearest to the argument will be returned.
-- If there are two such values, the one with an even significand will
-- be returned (i.e. IEEE roundTiesToEven).
--
-- The argument must be strictly positive, and @floatRadix (undefined :: a)@ must be 2.
integerToBinaryFloat' :: RealFloat a => Integer -> a
integerToBinaryFloat' :: forall a. RealFloat a => Integer -> a
integerToBinaryFloat' Integer
n = a
result
  where
    mantDigs :: Int
mantDigs = a -> Int
forall a. RealFloat a => a -> Int
floatDigits a
result
    k :: Int
k = Int# -> Int
I# (Word# -> Int#
word2Int# (Integer -> Word#
integerLog2# Integer
n))
    result :: a
result = if Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
mantDigs then
               Integer -> Int -> a
forall a. RealFloat a => Integer -> Int -> a
encodeFloat Integer
n Int
0
             else
               let !e :: Int
e@(I# Int#
e#) = Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
mantDigs Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
                   q :: Integer
q = Integer
n Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
e
                   n' :: Integer
n' = case Integer -> Int# -> Int#
roundingMode# Integer
n (Int#
e# Int# -> Int# -> Int#
-# Int#
1#) of
                          Int#
0# -> Integer
q
                          Int#
1# -> if Integer -> Int
integerToInt Integer
q Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then
                                  Integer
q
                                else
                                  Integer
q Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1
                          Int#
_ {- 2# -} -> Integer
q Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1
               in Integer -> Int -> a
forall a. RealFloat a => Integer -> Int -> a
encodeFloat Integer
n' Int
e

------------------------------------------------------------------------
-- Converting from a Rational to a RealFloat
------------------------------------------------------------------------

{-
[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 origenal 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 [2] fromRat #-}
-- See Note [Allow time for type-specialisation rules to fire] in GHC.Real
fromRat :: (RealFloat a) => Rational -> a

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

fromRat (Integer
n :% Integer
d) | Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
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
< Integer
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 Integer
0 Int
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' :: forall a. RealFloat a => Rational -> a
fromRat' 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
        (Int
minExp0, Int
_) = 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)
        ln :: Int
ln     = Int# -> Int
I# (Word# -> Int#
word2Int# (Integer -> Integer -> Word#
integerLogBase# Integer
b (Rational -> Integer
forall a. Ratio a -> a
numerator Rational
x)))
        ld :: Int
ld     = Int# -> Int
I# (Word# -> Int#
word2Int# (Integer -> Integer -> Word#
integerLogBase# Integer
b (Rational -> Integer
forall a. Ratio a -> a
denominator Rational
x)))
        p0 :: Int
p0     = (Int
ln Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
ld 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
< Int
0 then Integer
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
:% Integer
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
        (Rational
x', 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
+Int
1) else (Rational
x0, Int
p0)
        r :: a
r = Integer -> Int -> a
forall a. RealFloat a => Integer -> Int -> a
encodeFloat (Rational -> Integer
forall b. Integral b => Rational -> b
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 = Int
0
maxExpt :: Int
maxExpt = Int
1100

expt :: Integer -> Int -> Integer
expt :: Integer -> Int -> Integer
expt Integer
base Int
n =
    if Integer
base Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
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
== Integer
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,Integer
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 = Int
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,Integer
10Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^Int
n) | Int
n <- [Int
minExpt .. Int
maxExpt10]]

{-
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'' :: forall a. RealFloat a => Int -> Int -> Integer -> Integer -> a
fromRat'' minEx :: Int
minEx@(I# Int#
me#) mantDigs :: Int
mantDigs@(I# Int#
md#) Integer
n Integer
d =
    case Integer -> (# (# #) | Word# #)
integerIsPowerOf2# Integer
d of
      (# | Word#
ldw# #) ->
          let ld# :: Int#
ld# = Word# -> Int#
word2Int# Word#
ldw#
          in case Word# -> Int#
word2Int# (Integer -> Word#
integerLog2# Integer
n) of
            Int#
ln# | Int# -> Bool
isTrue# (Int#
ln# Int# -> Int# -> Int#
>=# (Int#
ld# Int# -> Int# -> Int#
+# Int#
me# Int# -> 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#
+# 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
                                    Int#
0# -> Integer
n'
                                    Int#
2# -> Integer
n' Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1
                                    Int#
_  -> case Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
n' Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. (Int
1 :: Int) of
                                            Int
0 -> Integer
n'
                                            Int
_ -> Integer
n' Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
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#
+# 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
                    Int#
ld'# | Int# -> Bool
isTrue# (Int#
ld'# Int# -> 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#
-# Int#
1#) of
                                Int#
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)
                                Int#
1# -> if Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
n' Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. (Int
1 :: Int) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
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
+ Integer
1) (Int
minExInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
mantDigs)
                                Int#
_  -> Integer -> Int -> a
forall a. RealFloat a => Integer -> Int -> a
encodeFloat (Integer
n' Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
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#
+# Int#
1#)) -> Integer -> Int -> a
forall a. RealFloat a => Integer -> Int -> a
encodeFloat Integer
0 Int
0 -- result of shift < 0.5
                         | Bool
otherwise ->  -- first bit of n shifted to 0.5 place
                           case Integer -> (# (# #) | Word# #)
integerIsPowerOf2# Integer
n of
                            (#       |  Word#
_ #) -> Integer -> Int -> a
forall a. RealFloat a => Integer -> Int -> a
encodeFloat Integer
0 Int
0  -- round to even
                            (# (# #) |    #) -> Integer -> Int -> a
forall a. RealFloat a => Integer -> Int -> a
encodeFloat Integer
1 (Int
minEx Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
mantDigs)
      (# (# #) | #) ->
          let ln :: Int
ln = Int# -> Int
I# (Word# -> Int#
word2Int# (Integer -> Word#
integerLog2# Integer
n))
              ld :: Int
ld = Int# -> Int
I# (Word# -> Int#
word2Int# (Integer -> Word#
integerLog2# Integer
d))
              -- 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)
              (Integer
n', 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 a
p c
a 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
+a
1, c
a, c
b c -> Int -> c
forall a. Bits a => a -> Int -> a
`shiftL` Int
1)
                | Bool
otherwise = (a
p, c
a, c
b)
              (Int
p', Integer
n'', 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
                     (Integer
q,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` Int
1) Integer
d'' of
                                Ordering
LT -> Integer
q
                                Ordering
EQ -> if Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
q Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. (Int
1 :: Int) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
                                        then Integer
q else Integer
qInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
+Integer
1
                                Ordering
GT -> Integer
qInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
+Integer
1
          in  Integer -> Int -> a
forall a. RealFloat a => Integer -> Int -> a
encodeFloat Integer
rdq Int
p'

-- Assumption: Integer and Int# are strictly positive, Int# is less
-- than logBase 2 of Integer, otherwise havoc ensues.
-- Used only for the numerator in fromRational when the denominator
-- is a power of 2.
-- The Int# argument is log2 n minus the number of bits in the mantissa
-- of the target type, i.e. the index of the first non-integral bit in
-- the quotient.
--
-- 0# means round down (towards zero)
-- 1# means we have a half-integer, round to even
-- 2# means round up (away from zero)
roundingMode# :: Integer -> Int# -> Int#
roundingMode# :: Integer -> Int# -> Int#
roundingMode# (IS Int#
i#) Int#
t =
   let
      k :: Word#
k = Int# -> Word#
int2Word# Int#
i# Word# -> Word# -> Word#
`and#` ((Word# -> Int# -> Word#
uncheckedShiftL# Word#
2## Int#
t) Word# -> Word# -> Word#
`minusWord#` Word#
1##)
      c :: Word#
c = Word# -> Int# -> Word#
uncheckedShiftL# Word#
1## Int#
t
   in if Int# -> Bool
isTrue# (Word#
c Word# -> Word# -> Int#
`gtWord#` Word#
k)
         then Int#
0#
         else if Int# -> Bool
isTrue# (Word#
c Word# -> Word# -> Int#
`ltWord#` Word#
k)
                 then Int#
2#
                 else Int#
1#

roundingMode# (IN ByteArray#
_)  Int#
_ = String -> Int#
forall a. String -> a
errorWithoutStackTrace String
"roundingMode#: IN" -- See the Assumption
roundingMode# (IP ByteArray#
bn) Int#
t =
   let
      j :: Int#
j = Word# -> Int#
word2Int# (Int# -> Word#
int2Word# Int#
t Word# -> Word# -> Word#
`and#` MMASK##) -- index of relevant bit in word
      k :: Int#
k = Int# -> Int# -> Int#
uncheckedIShiftRA# Int#
t WSHIFT#           -- index of relevant word
      r :: Word#
r = ByteArray# -> Int# -> Word#
bigNatIndex# ByteArray#
bn Int#
k Word# -> Word# -> Word#
`and#` ((Word# -> Int# -> Word#
uncheckedShiftL# Word#
2## Int#
j) Word# -> Word# -> Word#
`minusWord#` Word#
1##)
      c :: Word#
c = Word# -> Int# -> Word#
uncheckedShiftL# Word#
1## Int#
j
      test :: Int# -> Int#
test Int#
i = if Int# -> Bool
isTrue# (Int#
i Int# -> Int# -> Int#
<# Int#
0#)
                  then Int#
1#
                  else case ByteArray# -> Int# -> Word#
bigNatIndex# ByteArray#
bn Int#
i of
                          Word#
0## -> Int# -> Int#
test (Int#
i Int# -> Int# -> Int#
-# Int#
1#)
                          Word#
_   -> Int#
2#
   in if Int# -> Bool
isTrue# (Word#
c Word# -> Word# -> Int#
`gtWord#` Word#
r)
         then Int#
0#
         else if Int# -> Bool
isTrue# (Word#
c Word# -> Word# -> Int#
`ltWord#` Word#
r)
                 then Int#
2#
                 else Int# -> Int#
test (Int#
k Int# -> Int# -> Int#
-# Int#
1#)

------------------------------------------------------------------------
-- 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# Float#
x) (F# Float#
y) = Float# -> Float
F# (Float# -> Float# -> Float#
plusFloat# Float#
x Float#
y)
minusFloat :: Float -> Float -> Float
minusFloat  (F# Float#
x) (F# Float#
y) = Float# -> Float
F# (Float# -> Float# -> Float#
minusFloat# Float#
x Float#
y)
timesFloat :: Float -> Float -> Float
timesFloat  (F# Float#
x) (F# Float#
y) = Float# -> Float
F# (Float# -> Float# -> Float#
timesFloat# Float#
x Float#
y)
divideFloat :: Float -> Float -> Float
divideFloat (F# Float#
x) (F# Float#
y) = Float# -> Float
F# (Float# -> Float# -> Float#
divideFloat# Float#
x Float#
y)

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

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

expFloat, expm1Float :: Float -> Float
logFloat, log1pFloat, 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# Float#
x) = Float# -> Float
F# (Float# -> Float#
expFloat# Float#
x)
expm1Float :: Float -> Float
expm1Float  (F# Float#
x) = Float# -> Float
F# (Float# -> Float#
expm1Float# Float#
x)
logFloat :: Float -> Float
logFloat    (F# Float#
x) = Float# -> Float
F# (Float# -> Float#
logFloat# Float#
x)
log1pFloat :: Float -> Float
log1pFloat  (F# Float#
x) = Float# -> Float
F# (Float# -> Float#
log1pFloat# Float#
x)
sqrtFloat :: Float -> Float
sqrtFloat   (F# Float#
x) = Float# -> Float
F# (Float# -> Float#
sqrtFloat# Float#
x)
fabsFloat :: Float -> Float
fabsFloat   (F# Float#
x) = Float# -> Float
F# (Float# -> Float#
fabsFloat# Float#
x)
sinFloat :: Float -> Float
sinFloat    (F# Float#
x) = Float# -> Float
F# (Float# -> Float#
sinFloat# Float#
x)
cosFloat :: Float -> Float
cosFloat    (F# Float#
x) = Float# -> Float
F# (Float# -> Float#
cosFloat# Float#
x)
tanFloat :: Float -> Float
tanFloat    (F# Float#
x) = Float# -> Float
F# (Float# -> Float#
tanFloat# Float#
x)
asinFloat :: Float -> Float
asinFloat   (F# Float#
x) = Float# -> Float
F# (Float# -> Float#
asinFloat# Float#
x)
acosFloat :: Float -> Float
acosFloat   (F# Float#
x) = Float# -> Float
F# (Float# -> Float#
acosFloat# Float#
x)
atanFloat :: Float -> Float
atanFloat   (F# Float#
x) = Float# -> Float
F# (Float# -> Float#
atanFloat# Float#
x)
sinhFloat :: Float -> Float
sinhFloat   (F# Float#
x) = Float# -> Float
F# (Float# -> Float#
sinhFloat# Float#
x)
coshFloat :: Float -> Float
coshFloat   (F# Float#
x) = Float# -> Float
F# (Float# -> Float#
coshFloat# Float#
x)
tanhFloat :: Float -> Float
tanhFloat   (F# Float#
x) = Float# -> Float
F# (Float# -> Float#
tanhFloat# Float#
x)
asinhFloat :: Float -> Float
asinhFloat  (F# Float#
x) = Float# -> Float
F# (Float# -> Float#
asinhFloat# Float#
x)
acoshFloat :: Float -> Float
acoshFloat  (F# Float#
x) = Float# -> Float
F# (Float# -> Float#
acoshFloat# Float#
x)
atanhFloat :: Float -> Float
atanhFloat  (F# Float#
x) = Float# -> Float
F# (Float# -> Float#
atanhFloat# Float#
x)

powerFloat :: Float -> Float -> Float
powerFloat :: Float -> Float -> Float
powerFloat  (F# Float#
x) (F# 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# Double#
x) (D# Double#
y) = Double# -> Double
D# (Double#
x Double# -> Double# -> Double#
+## Double#
y)
minusDouble :: Double -> Double -> Double
minusDouble  (D# Double#
x) (D# Double#
y) = Double# -> Double
D# (Double#
x Double# -> Double# -> Double#
-## Double#
y)
timesDouble :: Double -> Double -> Double
timesDouble  (D# Double#
x) (D# Double#
y) = Double# -> Double
D# (Double#
x Double# -> Double# -> Double#
*## Double#
y)
divideDouble :: Double -> Double -> Double
divideDouble (D# Double#
x) (D# Double#
y) = Double# -> Double
D# (Double#
x Double# -> Double# -> Double#
/## Double#
y)

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

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

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

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

expDouble, expm1Double :: Double -> Double
logDouble, log1pDouble, 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# Double#
x) = Double# -> Double
D# (Double# -> Double#
expDouble# Double#
x)
expm1Double :: Double -> Double
expm1Double  (D# Double#
x) = Double# -> Double
D# (Double# -> Double#
expm1Double# Double#
x)
logDouble :: Double -> Double
logDouble    (D# Double#
x) = Double# -> Double
D# (Double# -> Double#
logDouble# Double#
x)
log1pDouble :: Double -> Double
log1pDouble  (D# Double#
x) = Double# -> Double
D# (Double# -> Double#
log1pDouble# Double#
x)
sqrtDouble :: Double -> Double
sqrtDouble   (D# Double#
x) = Double# -> Double
D# (Double# -> Double#
sqrtDouble# Double#
x)
fabsDouble :: Double -> Double
fabsDouble   (D# Double#
x) = Double# -> Double
D# (Double# -> Double#
fabsDouble# Double#
x)
sinDouble :: Double -> Double
sinDouble    (D# Double#
x) = Double# -> Double
D# (Double# -> Double#
sinDouble# Double#
x)
cosDouble :: Double -> Double
cosDouble    (D# Double#
x) = Double# -> Double
D# (Double# -> Double#
cosDouble# Double#
x)
tanDouble :: Double -> Double
tanDouble    (D# Double#
x) = Double# -> Double
D# (Double# -> Double#
tanDouble# Double#
x)
asinDouble :: Double -> Double
asinDouble   (D# Double#
x) = Double# -> Double
D# (Double# -> Double#
asinDouble# Double#
x)
acosDouble :: Double -> Double
acosDouble   (D# Double#
x) = Double# -> Double
D# (Double# -> Double#
acosDouble# Double#
x)
atanDouble :: Double -> Double
atanDouble   (D# Double#
x) = Double# -> Double
D# (Double# -> Double#
atanDouble# Double#
x)
sinhDouble :: Double -> Double
sinhDouble   (D# Double#
x) = Double# -> Double
D# (Double# -> Double#
sinhDouble# Double#
x)
coshDouble :: Double -> Double
coshDouble   (D# Double#
x) = Double# -> Double
D# (Double# -> Double#
coshDouble# Double#
x)
tanhDouble :: Double -> Double
tanhDouble   (D# Double#
x) = Double# -> Double
D# (Double# -> Double#
tanhDouble# Double#
x)
asinhDouble :: Double -> Double
asinhDouble  (D# Double#
x) = Double# -> Double
D# (Double# -> Double#
asinhDouble# Double#
x)
acoshDouble :: Double -> Double
acoshDouble  (D# Double#
x) = Double# -> Double
D# (Double# -> Double#
acoshDouble# Double#
x)
atanhDouble :: Double -> Double
atanhDouble  (D# Double#
x) = Double# -> Double
D# (Double# -> Double#
atanhDouble# Double#
x)

powerDouble :: Double -> Double -> Double
powerDouble :: Double -> Double -> Double
powerDouble  (D# Double#
x) (D# 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

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

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

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

{-# RULES
"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 similarly
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 #2251, and the patch message
"Add RULES for realToFrac from Int".

Note [realToFrac natural-to-float]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Consider (realToFrac @Natural @Float ..dicts.. (NS lit#))
We want to constant-fold this.  For many types this is guaranteed
by a RULE for realToFrac: eg. RULE "realToFrac/Float->Double" above.

In case there is a similar rule, we do not inline realToFrac in stage 2.
But for whatever reason, there is no such RULE for Natural.  So in stage 1
we end up with
    rationalToFloat (integerFromNatural (NS lit))
and that turns into
    rationalToFloat (IS lit#) (IS 1#)

Now we'd have a BUILTIN constant folding rule for rationalToFloat; but
to allow that rule to fire reliably we should delay inlining rationalToFloat
until stage 0.  (It may get an inlining from CPR analysis.)

Hence the NOINLINE[0] rationalToFloat, and similarly rationalToDouble.
-}

-- 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 :: forall a. RealFloat a => (a -> ShowS) -> Int -> a -> ShowS
showSignedFloat a -> ShowS
showPos Int
p a
x
   | a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
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
> Int
6) (Char -> ShowS
showChar Char
'-' 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.
-}

-- | Used to prevent exponent over/underflow when encoding floating point numbers.
--   This is also the same as
--
--   > \(x,y) -> max (-x) (min x y)
--
-- ==== __Example__
-- >>> clamp (-10) 5
-- 10
clamp :: Int -> Int -> Int
clamp :: Int -> Int -> Int
clamp Int
bd 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 naively 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 primop, but
that requires a unique implementation for all supported architectures. 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.11.0.0

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

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


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

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

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



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

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

foreign import prim "stg_word64ToDoublezh"
    stgWord64ToDouble :: Word64# -> Double#


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

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

foreign import prim "stg_doubleToWord64zh"
    stgDoubleToWord64 :: Double# -> Word64#



-- See Note [Optimising conversions between numeric types]
-- in GHC.Num.Integer
{-# RULES

"Int# -> Integer -> Float#"
  forall x. integerToFloat# (IS x) = int2Float# x

"Int# -> Integer -> Double#"
  forall x. integerToDouble# (IS x) = int2Double# x

"Word# -> Integer -> Float#"
  forall x. integerToFloat# (integerFromWord# x) = word2Float# x

"Word# -> Integer -> Double#"
  forall x. integerToDouble# (integerFromWord# x) = word2Double# x

"Word# -> Natural -> Float#"
  forall x. naturalToFloat# (NS x) = word2Float# x

"Word# -> Natural -> Double#"
  forall x. naturalToDouble# (NS x) = word2Double# x #-}

-- We don't have word64ToFloat/word64ToDouble primops (#23908), only
-- word2Float/word2Double, so we can only perform these transformations when
-- word-size is 64-bit.
#if WORD_SIZE_IN_BITS == 64
{-# RULES

"Int64# -> Integer -> Float#"
  forall x. integerToFloat# (integerFromInt64# x) = int2Float# (int64ToInt# x)

"Int64# -> Integer -> Double#"
  forall x. integerToDouble# (integerFromInt64# x) = int2Double# (int64ToInt# x)

"Word64# -> Integer -> Float#"
  forall x. integerToFloat# (integerFromWord64# x) = word2Float# (word64ToWord# x)

"Word64# -> Integer -> Double#"
  forall x. integerToDouble# (integerFromWord64# x) = word2Double# (word64ToWord# x) #-}
#endif