{-# 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              =  forall a. Floating a => a -> a
exp (forall a. Floating a => a -> a
log a
x forall a. Num a => a -> a -> a
* a
y)
    logBase a
x a
y         =  forall a. Floating a => a -> a
log a
y forall a. Fractional a => a -> a -> a
/ forall a. Floating a => a -> a
log a
x
    sqrt a
x              =  a
x forall a. Floating a => a -> a -> a
** a
0.5
    tan  a
x              =  forall a. Floating a => a -> a
sin  a
x forall a. Fractional a => a -> a -> a
/ forall a. Floating a => a -> a
cos  a
x
    tanh a
x              =  forall a. Floating a => a -> a
sinh a
x forall a. Fractional a => a -> a -> a
/ forall a. Floating a => a -> a
cosh a
x

    {-# INLINE log1p #-}
    {-# INLINE expm1 #-}
    {-# INLINE log1pexp #-}
    {-# INLINE log1mexp #-}
    log1p a
x = forall a. Floating a => a -> a
log (a
1 forall a. Num a => a -> a -> a
+ a
x)
    expm1 a
x = forall a. Floating a => a -> a
exp a
x forall a. Num a => a -> a -> a
- a
1
    log1pexp a
x = forall a. Floating a => a -> a
log1p (forall a. Floating a => a -> a
exp a
x)
    log1mexp a
x = forall a. Floating a => a -> a
log1p (forall a. Num a => a -> a
negate (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 forall a. Ord a => a -> a -> Bool
> -(forall a. Floating a => a -> a
log a
2) = forall a. Floating a => a -> a
log (forall a. Num a => a -> a
negate (forall a. Floating a => a -> a
expm1 a
a))
    | Bool
otherwise  = forall a. Floating a => a -> a
log1p (forall a. Num a => a -> a
negate (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 origin to the
    -- point @(x,y)@.  @'atan2' y x@ returns a value in the range [@-pi@,
    -- @pi@].  It follows the Common Lisp semantics for the origin when
    -- signed zeroes are supported.  @'atan2' y 1@, with @y@ in a type
    -- that is 'RealFloat', should return the same value as @'atan' y@.
    -- A default definition of 'atan2' is provided, but implementors
    -- can provide a more accurate implementation.
    atan2               :: a -> a -> a


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

    significand a
x       =  forall a. RealFloat a => Integer -> Int -> a
encodeFloat Integer
m (forall a. Num a => a -> a
negate (forall a. RealFloat a => a -> Int
floatDigits a
x))
                           where (Integer
m,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       =  forall a. RealFloat a => Integer -> Int -> a
encodeFloat Integer
m (Int
n forall a. Num a => a -> a -> a
+ Int -> Int -> Int
clamp Int
b Int
k)
                           where (Integer
m,Int
n) = forall a. RealFloat a => a -> (Integer, Int)
decodeFloat a
x
                                 (Int
l,Int
h) = forall a. RealFloat a => a -> (Int, Int)
floatRange a
x
                                 d :: Int
d     = forall a. RealFloat a => a -> Int
floatDigits a
x
                                 b :: Int
b     = Int
h forall a. Num a => a -> a -> a
- Int
l forall a. Num a => a -> a -> a
+ Int
4forall 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 forall a. Eq a => a -> a -> Bool
== a
0 Bool -> Bool -> Bool
|| forall a. RealFloat a => a -> Bool
isNaN a
x Bool -> Bool -> Bool
|| forall a. RealFloat a => a -> Bool
isInfinite a
x

    atan2 a
y a
x
      | a
x forall a. Ord a => a -> a -> Bool
> a
0            =  forall a. Floating a => a -> a
atan (a
yforall a. Fractional a => a -> a -> a
/a
x)
      | a
x forall a. Eq a => a -> a -> Bool
== a
0 Bool -> Bool -> Bool
&& a
y forall a. Ord a => a -> a -> Bool
> a
0  =  forall a. Floating a => a
piforall a. Fractional a => a -> a -> a
/a
2
      | a
x forall a. Ord a => a -> a -> Bool
<  a
0 Bool -> Bool -> Bool
&& a
y forall a. Ord a => a -> a -> Bool
> a
0  =  forall a. Floating a => a
pi forall a. Num a => a -> a -> a
+ forall a. Floating a => a -> a
atan (a
yforall a. Fractional a => a -> a -> a
/a
x)
      |(a
x forall a. Ord a => a -> a -> Bool
<= a
0 Bool -> Bool -> Bool
&& a
y forall a. Ord a => a -> a -> Bool
< a
0)            Bool -> Bool -> Bool
||
       (a
x forall a. Ord a => a -> a -> Bool
<  a
0 Bool -> Bool -> Bool
&& forall a. RealFloat a => a -> Bool
isNegativeZero a
y) Bool -> Bool -> Bool
||
       (forall a. RealFloat a => a -> Bool
isNegativeZero a
x Bool -> Bool -> Bool
&& forall a. RealFloat a => a -> Bool
isNegativeZero a
y)
                         = -forall a. RealFloat a => a -> a -> a
atan2 (-a
y) a
x
      | a
y forall a. Eq a => a -> a -> Bool
== a
0 Bool -> Bool -> Bool
&& (a
x forall a. Ord a => a -> a -> Bool
< a
0 Bool -> Bool -> Bool
|| forall a. RealFloat a => a -> Bool
isNegativeZero a
x)
                          =  forall a. Floating a => a
pi    -- must be after the previous test on zero y
      | a
xforall a. Eq a => a -> a -> Bool
==a
0 Bool -> Bool -> Bool
&& a
yforall a. Eq a => a -> a -> Bool
==a
0      =  a
y     -- must be after the other double zero tests
      | Bool
otherwise         =  a
x 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 forall a. Ord a => a -> a -> Bool
> Float
0     = Float
1
             | Float
x 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 forall a. RealFloat a => Integer -> a
integerToBinaryFloat' Integer
i of
                             F# Float#
x -> Float#
x
integerToFloat# (IN ByteArray#
bn)  = case 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 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#) 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 forall a. a -> a -> Ratio a
:% Integer -> Word# -> Integer
integerShiftL# Integer
1 (Int# -> Word#
int2Word# Int#
d#)
            | Bool
otherwise                                         ->
                    Int# -> Integer
IS Int#
m# 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
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 forall a. Fractional a => a -> a -> a
/ Float
x

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

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

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

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

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

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

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

    floor :: forall b. Integral b => Float -> b
floor Float
x     = case forall a b. (RealFrac a, Integral b) => a -> (b, a)
properFraction Float
x of
                    (b
n,Float
r) -> if Float
r forall a. Ord a => a -> a -> Bool
< Float
0.0 then b
n forall a. Num a => a -> a -> a
- b
1 else b
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         =  forall a. Floating a => a -> a
log Float
y forall a. Fractional a => a -> a -> a
/ 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 = forall a. (Ord a, Floating a) => a -> a
log1mexpOrd Float
x
    {-# INLINE log1mexp #-}
    log1pexp :: Float -> Float
log1pexp Float
a
      | Float
a forall a. Ord a => a -> a -> Bool
<= Float
18   = Float -> Float
log1pFloat (forall a. Floating a => a -> a
exp Float
a)
      | Float
a forall a. Ord a => a -> a -> Bool
<= Float
100  = Float
a forall a. Num a => a -> a -> a
+ forall a. Floating a => a -> a
exp (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 forall a. RealFloat a => a -> (Integer, Int)
decodeFloat Float
x of
                            (Integer
m,Int
n) -> if Integer
m forall a. Eq a => a -> a -> Bool
== Integer
0 then Int
0 else Int
n forall a. Num a => a -> a -> a
+ forall a. RealFloat a => a -> Int
floatDigits Float
x

    significand :: Float -> Float
significand Float
x       = case forall a. RealFloat a => a -> (Integer, Int)
decodeFloat Float
x of
                            (Integer
m,Int
_) -> forall a. RealFloat a => Integer -> Int -> a
encodeFloat Integer
m (forall a. Num a => a -> a
negate (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 forall a. RealFloat a => a -> (Integer, Int)
decodeFloat Float
x of
                            (Integer
m,Int
n) -> forall a. RealFloat a => Integer -> Int -> a
encodeFloat Integer
m (Int
n 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 forall a. Eq a => a -> a -> Bool
== Float
0 Bool -> Bool -> Bool
|| Float -> Int
isFloatFinite Float
x forall a. Eq a => a -> a -> Bool
== Int
0

    isNaN :: Float -> Bool
isNaN Float
x          = Int
0 forall a. Eq a => a -> a -> Bool
/= Float -> Int
isFloatNaN Float
x
    isInfinite :: Float -> Bool
isInfinite Float
x     = Int
0 forall a. Eq a => a -> a -> Bool
/= Float -> Int
isFloatInfinite Float
x
    isDenormalized :: Float -> Bool
isDenormalized Float
x = Int
0 forall a. Eq a => a -> a -> Bool
/= Float -> Int
isFloatDenormalized Float
x
    isNegativeZero :: Float -> Bool
isNegativeZero Float
x = Int
0 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 = forall a. RealFloat a => (a -> ShowS) -> Int -> a -> ShowS
showSignedFloat forall a. RealFloat a => a -> ShowS
showFloat Int
x
    showList :: [Float] -> ShowS
showList = forall a. (a -> ShowS) -> [a] -> ShowS
showList__ (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 forall a. Ord a => a -> a -> Bool
> Double
0     = Double
1
             | Double
x 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 forall a. RealFloat a => Integer -> a
integerToBinaryFloat' Integer
i of
                              D# Double#
x -> Double#
x
integerToDouble# (IN ByteArray#
bn)  = case 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 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#) 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 forall a. a -> a -> Ratio a
:% Integer -> Word# -> Integer
integerShiftL# Integer
1 (Int# -> Word#
int2Word# Int#
d#)
            | Bool
otherwise                                            ->
                Integer
m 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
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 forall a. Fractional a => a -> a -> a
/ Double
x

rationalToDouble :: Integer -> Integer -> Double
{-# NOINLINE [1] rationalToDouble #-}
rationalToDouble :: Integer -> Integer -> Double
rationalToDouble Integer
n Integer
0
    | Integer
n forall a. Eq a => a -> a -> Bool
== Integer
0        = Double
0forall a. Fractional a => a -> a -> a
/Double
0
    | Integer
n forall a. Ord a => a -> a -> Bool
< Integer
0         = (-Double
1)forall a. Fractional a => a -> a -> a
/Double
0
    | Bool
otherwise     = Double
1forall a. Fractional a => a -> a -> a
/Double
0
rationalToDouble Integer
n Integer
d
    | Integer
n forall a. Eq a => a -> a -> Bool
== Integer
0        = forall a. RealFloat a => Integer -> Int -> a
encodeFloat Integer
0 Int
0
    | Integer
n forall a. Ord a => a -> a -> Bool
< Integer
0         = -(forall a. RealFloat a => Int -> Int -> Integer -> Integer -> a
fromRat'' Int
minEx Int
mantDigs (-Integer
n) Integer
d)
    | Bool
otherwise     = 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         =  forall a. Floating a => a -> a
log Double
y forall a. Fractional a => a -> a -> a
/ 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 = forall a. (Ord a, Floating a) => a -> a
log1mexpOrd Double
x
    {-# INLINE log1mexp #-}
    log1pexp :: Double -> Double
log1pexp Double
a
      | Double
a forall a. Ord a => a -> a -> Bool
<= Double
18   = Double -> Double
log1pDouble (forall a. Floating a => a -> a
exp Double
a)
      | Double
a forall a. Ord a => a -> a -> Bool
<= Double
100  = Double
a forall a. Num a => a -> a -> a
+ forall a. Floating a => a -> a
exp (forall a. Num a => a -> a
negate Double
a)
      | Bool
otherwise = Double
a
    {-# INLINE log1pexp #-}

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

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

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

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

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

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

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

-- | @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 forall a. RealFloat a => a -> (Integer, Int)
decodeFloat Double
x of
                            (Integer
m,Int
n) -> if Integer
m forall a. Eq a => a -> a -> Bool
== Integer
0 then Int
0 else Int
n forall a. Num a => a -> a -> a
+ forall a. RealFloat a => a -> Int
floatDigits Double
x

    significand :: Double -> Double
significand Double
x       = case forall a. RealFloat a => a -> (Integer, Int)
decodeFloat Double
x of
                            (Integer
m,Int
_) -> forall a. RealFloat a => Integer -> Int -> a
encodeFloat Integer
m (forall a. Num a => a -> a
negate (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 forall a. RealFloat a => a -> (Integer, Int)
decodeFloat Double
x of
                            (Integer
m,Int
n) -> forall a. RealFloat a => Integer -> Int -> a
encodeFloat Integer
m (Int
n 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 forall a. Eq a => a -> a -> Bool
== Double
0 Bool -> Bool -> Bool
|| Double -> Int
isDoubleFinite Double
x forall a. Eq a => a -> a -> Bool
== Int
0

    isNaN :: Double -> Bool
isNaN Double
x             = Int
0 forall a. Eq a => a -> a -> Bool
/= Double -> Int
isDoubleNaN Double
x
    isInfinite :: Double -> Bool
isInfinite Double
x        = Int
0 forall a. Eq a => a -> a -> Bool
/= Double -> Int
isDoubleInfinite Double
x
    isDenormalized :: Double -> Bool
isDenormalized Double
x    = Int
0 forall a. Eq a => a -> a -> Bool
/= Double -> Int
isDoubleDenormalized Double
x
    isNegativeZero :: Double -> Bool
isNegativeZero Double
x    = Int
0 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 = forall a. RealFloat a => (a -> ShowS) -> Int -> a -> ShowS
showSignedFloat forall a. RealFloat a => a -> ShowS
showFloat Int
x
    showList :: [Double] -> ShowS
showList = forall a. (a -> ShowS) -> [a] -> ShowS
showList__ (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 forall a. Num a => a -> a -> a
+ Float
1
    pred :: Float -> Float
pred Float
x         = Float
x forall a. Num a => a -> a -> a
- Float
1
    toEnum :: Int -> Float
toEnum         = Int -> Float
int2Float
    fromEnum :: Float -> Int
fromEnum       = forall a. Num a => Integer -> a
fromInteger forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (RealFrac a, Integral b) => a -> b
truncate   -- may overflow
    enumFrom :: Float -> [Float]
enumFrom       = forall a. Fractional a => a -> [a]
numericEnumFrom
    enumFromTo :: Float -> Float -> [Float]
enumFromTo     = forall a. (Ord a, Fractional a) => a -> a -> [a]
numericEnumFromTo
    enumFromThen :: Float -> Float -> [Float]
enumFromThen   = forall a. Fractional a => a -> a -> [a]
numericEnumFromThen
    enumFromThenTo :: Float -> Float -> Float -> [Float]
enumFromThenTo = 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 forall a. Num a => a -> a -> a
+ Double
1
    pred :: Double -> Double
pred Double
x         = Double
x forall a. Num a => a -> a -> a
- Double
1
    toEnum :: Int -> Double
toEnum         =  Int -> Double
int2Double
    fromEnum :: Double -> Int
fromEnum       =  forall a. Num a => Integer -> a
fromInteger forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (RealFrac a, Integral b) => a -> b
truncate   -- may overflow
    enumFrom :: Double -> [Double]
enumFrom       =  forall a. Fractional a => a -> [a]
numericEnumFrom
    enumFromTo :: Double -> Double -> [Double]
enumFromTo     =  forall a. (Ord a, Fractional a) => a -> a -> [a]
numericEnumFromTo
    enumFromThen :: Double -> Double -> [Double]
enumFromThen   =  forall a. Fractional a => a -> a -> [a]
numericEnumFromThen
    enumFromThenTo :: Double -> Double -> Double -> [Double]
enumFromThenTo =  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 (forall a. RealFloat a => FFFormat -> Maybe Int -> a -> String
formatRealFloat FFFormat
FFGeneric 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 = 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
   | forall a. RealFloat a => a -> Bool
isNaN a
x                   = String
"NaN"
   | forall a. RealFloat a => a -> Bool
isInfinite a
x              = if a
x forall a. Ord a => a -> a -> Bool
< a
0 then String
"-Infinity" else String
"Infinity"
   | a
x forall a. Ord a => a -> a -> Bool
< a
0 Bool -> Bool -> Bool
|| forall a. RealFloat a => a -> Bool
isNegativeZero a
x = Char
'-'forall a. a -> [a] -> [a]
:FFFormat -> ([Int], Int) -> String
doFmt FFFormat
fmt (forall a. RealFloat a => Integer -> a -> ([Int], Int)
floatToDigits (forall a. Integral a => a -> Integer
toInteger Int
base) (-a
x))
   | Bool
otherwise                 = FFFormat -> ([Int], Int) -> String
doFmt FFFormat
fmt (forall a. RealFloat a => Integer -> a -> ([Int], Int)
floatToDigits (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 = 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 forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
e 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' = forall a. Show a => a -> String
show (Int
eforall a. Num a => a -> a -> a
-Int
1) in
        case String
ds of
          String
"0"     -> String
"0.0e0"
          [Char
d]     -> Char
d forall a. a -> [a] -> [a]
: String
".0e" forall a. [a] -> [a] -> [a]
++ String
show_e'
          (Char
d:String
ds') -> Char
d forall a. a -> [a] -> [a]
: Char
'.' forall a. a -> [a] -> [a]
: String
ds' forall a. [a] -> [a] -> [a]
++ String
"e" forall a. [a] -> [a] -> [a]
++ String
show_e'
          []      -> forall a. String -> a
errorWithoutStackTrace String
"formatRealFloat/doFmt/FFExponent: []"
       Just Int
d | Int
d 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
_ = forall a b. (a -> b) -> [a] -> [b]
map Int -> Char
intToDigit (if Int
ei forall a. Ord a => a -> a -> Bool
> Int
0 then forall a. [a] -> [a]
init [Int]
is' else [Int]
is')
           in Char
n forall a. a -> [a] -> [a]
: Char
'e' forall a. a -> [a] -> [a]
: forall a. Show a => a -> String
show (Int
eforall a. Num a => a -> a -> a
-Int
1forall a. Num a => a -> a -> a
+Int
ei)
       Just Int
dec ->
        let dec' :: Int
dec' = forall a. Ord a => a -> a -> a
max Int
dec Int
1 in
        case [Int]
is of
         [Int
0] -> Char
'0' forall a. a -> [a] -> [a]
:Char
'.' forall a. a -> [a] -> [a]
: forall a. Int -> [a] -> [a]
take Int
dec' (forall a. a -> [a]
repeat Char
'0') forall a. [a] -> [a] -> [a]
++ String
"e0"
         [Int]
_ ->
          let
           (Int
ei,[Int]
is') = Int -> Int -> [Int] -> (Int, [Int])
roundTo Int
base (Int
dec'forall a. Num a => a -> a -> a
+Int
1) [Int]
is
           (Char
d:String
ds') = forall a b. (a -> b) -> [a] -> [b]
map Int -> Char
intToDigit (if Int
ei forall a. Ord a => a -> a -> Bool
> Int
0 then forall a. [a] -> [a]
init [Int]
is' else [Int]
is')
          in
          Char
dforall a. a -> [a] -> [a]
:Char
'.'forall a. a -> [a] -> [a]
:String
ds' forall a. [a] -> [a] -> [a]
++ Char
'e'forall a. a -> [a] -> [a]
:forall a. Show a => a -> String
show (Int
eforall a. Num a => a -> a -> a
-Int
1forall 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 forall a. Ord a => a -> a -> Bool
<= Int
0    -> String
"0." forall a. [a] -> [a] -> [a]
++ forall a. Int -> a -> [a]
replicate (-Int
e) Char
'0' forall a. [a] -> [a] -> [a]
++ String
ds
          | Bool
otherwise ->
             let
                f :: t -> String -> ShowS
f t
0 String
s    String
rs  = ShowS
mk0 (forall a. [a] -> [a]
reverse String
s) forall a. [a] -> [a] -> [a]
++ Char
'.'forall a. a -> [a] -> [a]
:ShowS
mk0 String
rs
                f t
n String
s    String
""  = t -> String -> ShowS
f (t
nforall a. Num a => a -> a -> a
-t
1) (Char
'0'forall a. a -> [a] -> [a]
:String
s) String
""
                f t
n String
s (Char
r:String
rs) = t -> String -> ShowS
f (t
nforall a. Num a => a -> a -> a
-t
1) (Char
rforall a. a -> [a] -> [a]
:String
s) String
rs
             in
                forall {t}. (Eq t, Num t) => t -> String -> ShowS
f Int
e String
"" String
ds
       Just Int
dec ->
        let dec' :: Int
dec' = forall a. Ord a => a -> a -> a
max Int
dec Int
0 in
        if Int
e 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' forall a. Num a => a -> a -> a
+ Int
e) [Int]
is
          (String
ls,String
rs)  = forall a. Int -> [a] -> ([a], [a])
splitAt (Int
eforall a. Num a => a -> a -> a
+Int
ei) (forall a b. (a -> b) -> [a] -> [b]
map Int -> Char
intToDigit [Int]
is')
         in
         ShowS
mk0 String
ls forall a. [a] -> [a] -> [a]
++ (if forall a. [a] -> Bool
null String
rs Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
alt then String
"" else Char
'.'forall a. a -> [a] -> [a]
:String
rs)
        else
         let
          (Int
ei,[Int]
is') = Int -> Int -> [Int] -> (Int, [Int])
roundTo Int
base Int
dec' (forall a. Int -> a -> [a]
replicate (-Int
e) Int
0 forall a. [a] -> [a] -> [a]
++ [Int]
is)
          Char
d:String
ds' = forall a b. (a -> b) -> [a] -> [b]
map Int -> Char
intToDigit (if Int
ei forall a. Ord a => a -> a -> Bool
> Int
0 then [Int]
is' else Int
0forall a. a -> [a] -> [a]
:[Int]
is')
         in
         Char
d forall a. a -> [a] -> [a]
: (if forall a. [a] -> Bool
null String
ds' Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
alt then String
"" else Char
'.'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
1forall a. a -> [a] -> [a]
:[Int]
xs)
    (Int, [Int])
_       -> forall a. String -> a
errorWithoutStackTrace String
"roundTo: bad Value"
 where
  b2 :: Int
b2 = Int
base forall a. Integral a => a -> a -> a
`quot` Int
2

  f :: Int -> Bool -> [Int] -> (Int, [Int])
f Int
n Bool
_ []     = (Int
0, forall a. Int -> a -> [a]
replicate Int
n Int
0)
  f Int
0 Bool
e (Int
x:[Int]
xs) | Int
x forall a. Eq a => a -> a -> Bool
== Int
b2 Bool -> Bool -> Bool
&& Bool
e Bool -> Bool -> Bool
&& forall a. (a -> Bool) -> [a] -> Bool
all (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 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' forall a. Eq a => a -> a -> Bool
== Int
base = (Int
1,Int
0forall a. a -> [a] -> [a]
:[Int]
ds)
     | Bool
otherwise  = (Int
0,Int
i'forall a. a -> [a] -> [a]
:[Int]
ds)
      where
       (Int
c,[Int]
ds) = Int -> Bool -> [Int] -> (Int, [Int])
f (Int
nforall a. Num a => a -> a -> a
-Int
1) (forall a. Integral a => a -> Bool
even Int
i) [Int]
xs
       i' :: Int
i'     = Int
c 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) = forall a. RealFloat a => a -> (Integer, Int)
decodeFloat a
x
  (Int
minExp0, Int
_) = forall a. RealFloat a => a -> (Int, Int)
floatRange a
x
  p :: Int
p = forall a. RealFloat a => a -> Int
floatDigits a
x
  b :: Integer
b = forall a. RealFloat a => a -> Integer
floatRadix a
x
  minExp :: Int
minExp = Int
minExp0 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 forall a. Num a => a -> a -> a
- Int
e0 in
   if Int
n forall a. Ord a => a -> a -> Bool
> Int
0 then (Integer
f0 forall a. Integral a => a -> a -> a
`quot` (Integer -> Int -> Integer
expt Integer
b Int
n), Int
e0forall a. Num a => a -> a -> a
+Int
n) else (Integer
f0, Int
e0)
  (Integer
r, Integer
s, Integer
mUp, Integer
mDn) =
   if Int
e 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 forall a. Eq a => a -> a -> Bool
== Integer -> Int -> Integer
expt Integer
b (Int
pforall a. Num a => a -> a -> a
-Int
1) then
      (Integer
fforall a. Num a => a -> a -> a
*Integer
beforall a. Num a => a -> a -> a
*Integer
bforall a. Num a => a -> a -> a
*Integer
2, Integer
2forall a. Num a => a -> a -> a
*Integer
b, Integer
beforall a. Num a => a -> a -> a
*Integer
b, Integer
be)     -- according to Burger and Dybvig
    else
      (Integer
fforall a. Num a => a -> a -> a
*Integer
beforall a. Num a => a -> a -> a
*Integer
2, Integer
2, Integer
be, Integer
be)
   else
    if Int
e forall a. Ord a => a -> a -> Bool
> Int
minExp Bool -> Bool -> Bool
&& Integer
f forall a. Eq a => a -> a -> Bool
== Integer -> Int -> Integer
expt Integer
b (Int
pforall a. Num a => a -> a -> a
-Int
1) then
      (Integer
fforall a. Num a => a -> a -> a
*Integer
bforall a. Num a => a -> a -> a
*Integer
2, Integer -> Int -> Integer
expt Integer
b (-Int
eforall a. Num a => a -> a -> a
+Int
1)forall a. Num a => a -> a -> a
*Integer
2, Integer
b, Integer
1)
    else
      (Integer
fforall a. Num a => a -> a -> a
*Integer
2, Integer -> Int -> Integer
expt Integer
b (-Int
e)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 forall a. Eq a => a -> a -> Bool
== Integer
2 Bool -> Bool -> Bool
&& Integer
base 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 forall a. Num a => a -> a -> a
- Int
1 forall a. Num a => a -> a -> a
+ Int
e0
            k1 :: Int
k1 = (Int
lx forall a. Num a => a -> a -> a
* Int
8651) forall a. Integral a => a -> a -> a
`quot` Int
28738
        in if Int
lx forall a. Ord a => a -> a -> Bool
>= Int
0 then Int
k1 forall a. Num a => a -> a -> a
+ Int
1 else Int
k1
     else
        -- f :: Integer, log :: Float -> Float,
        --               ceiling :: Float -> Int
        forall a b. (RealFrac a, Integral b) => a -> b
ceiling ((forall a. Floating a => a -> a
log (forall a. Num a => Integer -> a
fromInteger (Integer
fforall a. Num a => a -> a -> a
+Integer
1) :: Float) forall a. Num a => a -> a -> a
+
                 forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
e forall a. Num a => a -> a -> a
* forall a. Floating a => a -> a
log (forall a. Num a => Integer -> a
fromInteger Integer
b)) forall a. Fractional a => a -> a -> a
/
                   forall a. Floating a => a -> a
log (forall a. Num a => Integer -> a
fromInteger Integer
base))
--WAS:            fromInt e * log (fromInteger b))

    fixup :: Int -> Int
fixup Int
n =
      if Int
n forall a. Ord a => a -> a -> Bool
>= Int
0 then
        if Integer
r forall a. Num a => a -> a -> a
+ Integer
mUp forall a. Ord a => a -> a -> Bool
<= Integer -> Int -> Integer
expt Integer
base Int
n forall a. Num a => a -> a -> a
* Integer
s then Int
n else Int -> Int
fixup (Int
nforall a. Num a => a -> a -> a
+Int
1)
      else
        if Integer -> Int -> Integer
expt Integer
base (-Int
n) forall a. Num a => a -> a -> a
* (Integer
r forall a. Num a => a -> a -> a
+ Integer
mUp) forall a. Ord a => a -> a -> Bool
<= Integer
s then Int
n else Int -> Int
fixup (Int
nforall 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 forall a. Num a => a -> a -> a
* Integer
base) forall a. Integral a => a -> a -> (a, a)
`quotRem` Integer
sN
    mUpN' :: Integer
mUpN' = Integer
mUpN forall a. Num a => a -> a -> a
* Integer
base
    mDnN' :: Integer
mDnN' = Integer
mDnN forall a. Num a => a -> a -> a
* Integer
base
   in
   case (Integer
rn' forall a. Ord a => a -> a -> Bool
< Integer
mDnN', Integer
rn' forall a. Num a => a -> a -> a
+ Integer
mUpN' forall a. Ord a => a -> a -> Bool
> Integer
sN) of
    (Bool
True,  Bool
False) -> Integer
dn forall a. a -> [a] -> [a]
: [Integer]
ds
    (Bool
False, Bool
True)  -> Integer
dnforall a. Num a => a -> a -> a
+Integer
1 forall a. a -> [a] -> [a]
: [Integer]
ds
    (Bool
True,  Bool
True)  -> if Integer
rn' forall a. Num a => a -> a -> a
* Integer
2 forall a. Ord a => a -> a -> Bool
< Integer
sN then Integer
dn forall a. a -> [a] -> [a]
: [Integer]
ds else Integer
dnforall a. Num a => a -> a -> a
+Integer
1 forall a. a -> [a] -> [a]
: [Integer]
ds
    (Bool
False, Bool
False) -> [Integer] -> Integer -> Integer -> Integer -> Integer -> [Integer]
gen (Integer
dnforall a. a -> [a] -> [a]
:[Integer]
ds) Integer
rn' Integer
sN Integer
mUpN' Integer
mDnN'

  rds :: [Integer]
rds =
   if Int
k forall a. Ord a => a -> a -> Bool
>= Int
0 then
      [Integer] -> Integer -> Integer -> Integer -> Integer -> [Integer]
gen [] Integer
r (Integer
s 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 forall a. Num a => a -> a -> a
* Integer
bk) Integer
s (Integer
mUp forall a. Num a => a -> a -> a
* Integer
bk) (Integer
mDn forall a. Num a => a -> a -> a
* Integer
bk)
 in
 (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Integral a, Num b) => a -> b
fromIntegral (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 = 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 forall a. Ord a => a -> a -> Bool
< Int
mantDigs then
               forall a. RealFloat a => Integer -> Int -> a
encodeFloat Integer
n Int
0
             else
               let !e :: Int
e@(I# Int#
e#) = Int
k forall a. Num a => a -> a -> a
- Int
mantDigs forall a. Num a => a -> a -> a
+ Int
1
                   q :: Integer
q = Integer
n 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 forall a. Bits a => a -> a -> a
.&. Int
1 forall a. Eq a => a -> a -> Bool
== Int
0 then
                                  Integer
q
                                else
                                  Integer
q forall a. Num a => a -> a -> a
+ Integer
1
                          Int#
_ {- 2# -} -> Integer
q forall a. Num a => a -> a -> a
+ Integer
1
               in 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 original version of the conversion function was in fact
simply a floating-point divide, as you suggest above. The new version
is, I grant you, somewhat denser.

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

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

This program prints
        0.0000000000000000
instead of
        1.8217369128763981e-300

Here's Joe's code:

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

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

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

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

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

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

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

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

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

fromRat (Integer
n :% Integer
d) | Integer
n forall a. Ord a => a -> a -> Bool
> Integer
0     = forall a. RealFloat a => Rational -> a
fromRat' (Integer
n forall a. a -> a -> Ratio a
:% Integer
d)
                 | Integer
n forall a. Ord a => a -> a -> Bool
< Integer
0     = - forall a. RealFloat a => Rational -> a
fromRat' ((-Integer
n) forall a. a -> a -> Ratio a
:% Integer
d)
                 | Bool
otherwise = 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 = forall a. RealFloat a => a -> Integer
floatRadix a
r
        p :: Int
p = forall a. RealFloat a => a -> Int
floatDigits a
r
        (Int
minExp0, Int
_) = forall a. RealFloat a => a -> (Int, Int)
floatRange a
r
        minExp :: Int
minExp = Int
minExp0 forall a. Num a => a -> a -> a
- Int
p            -- the real minimum exponent
        xMax :: Rational
xMax   = 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 (forall a. Ratio a -> a
numerator Rational
x)))
        ld :: Int
ld     = Int# -> Int
I# (Word# -> Int#
word2Int# (Integer -> Integer -> Word#
integerLogBase# Integer
b (forall a. Ratio a -> a
denominator Rational
x)))
        p0 :: Int
p0     = (Int
ln forall a. Num a => a -> a -> a
- Int
ld forall a. Num a => a -> a -> a
- Int
p) 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 forall a. Ord a => a -> a -> Bool
< Int
0 then Integer
1 forall a. a -> a -> Ratio a
:% Integer -> Int -> Integer
expt Integer
b (-Int
p0) else Integer -> Int -> Integer
expt Integer
b Int
p0 forall a. a -> a -> Ratio a
:% Integer
1
        x0 :: Rational
x0 = Rational
x 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 forall a. Ord a => a -> a -> Bool
>= Rational
xMax then (Rational
x0 forall a. Fractional a => a -> a -> a
/ forall a. Real a => a -> Rational
toRational Integer
b, Int
p0forall a. Num a => a -> a -> a
+Int
1) else (Rational
x0, Int
p0)
        r :: a
r = forall a. RealFloat a => Integer -> Int -> a
encodeFloat (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 forall a. Eq a => a -> a -> Bool
== Integer
2 Bool -> Bool -> Bool
&& Int
n forall a. Ord a => a -> a -> Bool
>= Int
minExpt Bool -> Bool -> Bool
&& Int
n forall a. Ord a => a -> a -> Bool
<= Int
maxExpt then
        Array Int Integer
exptsforall i e. Ix i => Array i e -> i -> e
!Int
n
    else
        if Integer
base forall a. Eq a => a -> a -> Bool
== Integer
10 Bool -> Bool -> Bool
&& Int
n forall a. Ord a => a -> a -> Bool
<= Int
maxExpt10 then
            Array Int Integer
expts10forall i e. Ix i => Array i e -> i -> e
!Int
n
        else
            Integer
baseforall a b. (Num a, Integral b) => a -> b -> a
^Int
n

expts :: Array Int Integer
expts :: Array Int Integer
expts = forall i e. Ix i => (i, i) -> [(i, e)] -> Array i e
array (Int
minExpt,Int
maxExpt) [(Int
n,Integer
2forall 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 = forall i e. Ix i => (i, i) -> [(i, e)] -> Array i e
array (Int
minExpt,Int
maxExpt10) [(Int
n,Integer
10forall 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 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 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' forall a. Num a => a -> a -> a
+ Integer
1
                                    Int#
_  -> case forall a. Num a => Integer -> a
fromInteger Integer
n' forall a. Bits a => a -> a -> a
.&. (Int
1 :: Int) of
                                            Int
0 -> Integer
n'
                                            Int
_ -> Integer
n' forall a. Num a => a -> a -> a
+ Integer
1
                         in 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
                           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 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# -> forall a. RealFloat a => Integer -> Int -> a
encodeFloat Integer
n' (Int
minEx forall a. Num a => a -> a -> a
- Int
mantDigs)
                                Int#
1# -> if forall a. Num a => Integer -> a
fromInteger Integer
n' forall a. Bits a => a -> a -> a
.&. (Int
1 :: Int) forall a. Eq a => a -> a -> Bool
== Int
0
                                        then forall a. RealFloat a => Integer -> Int -> a
encodeFloat Integer
n' (Int
minExforall a. Num a => a -> a -> a
-Int
mantDigs)
                                        else forall a. RealFloat a => Integer -> Int -> a
encodeFloat (Integer
n' forall a. Num a => a -> a -> a
+ Integer
1) (Int
minExforall a. Num a => a -> a -> a
-Int
mantDigs)
                                Int#
_  -> forall a. RealFloat a => Integer -> Int -> a
encodeFloat (Integer
n' forall a. Num a => a -> a -> a
+ Integer
1) (Int
minExforall a. Num a => a -> a -> a
-Int
mantDigs)
                         | Int# -> Bool
isTrue# (Int#
ld'# Int# -> Int# -> Int#
># (Int#
ln# Int# -> Int# -> Int#
+# Int#
1#)) -> 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#
_ #) -> forall a. RealFloat a => Integer -> Int -> a
encodeFloat Integer
0 Int
0  -- round to even
                            (# (# #) |    #) -> forall a. RealFloat a => Integer -> Int -> a
encodeFloat Integer
1 (Int
minEx 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 = forall a. Ord a => a -> a -> a
max Int
minEx (Int
ln forall a. Num a => a -> a -> a
- Int
ld)
              (Integer
n', Integer
d')
                | Int
p0 forall a. Ord a => a -> a -> Bool
< Int
mantDigs = (Integer
n forall a. Bits a => a -> Int -> a
`shiftL` (Int
mantDigs forall a. Num a => a -> a -> a
- Int
p0), Integer
d)
                | Int
p0 forall a. Eq a => a -> a -> Bool
== Int
mantDigs = (Integer
n, Integer
d)
                | Bool
otherwise     = (Integer
n, Integer
d forall a. Bits a => a -> Int -> a
`shiftL` (Int
p0 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 forall a. Bits a => a -> Int -> a
`shiftL` Int
mantDigs) forall a. Ord a => a -> a -> Bool
<= c
a = (a
pforall a. Num a => a -> a -> a
+a
1, c
a, c
b forall a. Bits a => a -> Int -> a
`shiftL` Int
1)
                | Bool
otherwise = (a
p, c
a, c
b)
              (Int
p', Integer
n'', Integer
d'') = forall {c} {a}. (Ord c, Bits c, Num a) => a -> c -> c -> (a, c, c)
scale (Int
p0forall 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'' forall a. Integral a => a -> a -> (a, a)
`quotRem` Integer
d'' of
                     (Integer
q,Integer
r) -> case forall a. Ord a => a -> a -> Ordering
compare (Integer
r forall a. Bits a => a -> Int -> a
`shiftL` Int
1) Integer
d'' of
                                Ordering
LT -> Integer
q
                                Ordering
EQ -> if forall a. Num a => Integer -> a
fromInteger Integer
q forall a. Bits a => a -> a -> a
.&. (Int
1 :: Int) forall a. Eq a => a -> a -> Bool
== Int
0
                                        then Integer
q else Integer
qforall a. Num a => a -> a -> a
+Integer
1
                                Ordering
GT -> Integer
qforall a. Num a => a -> a -> a
+Integer
1
          in  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#
bn) Int#
t = Integer -> Int# -> Int#
roundingMode# (ByteArray# -> Integer
IP ByteArray#
bn) Int#
t -- dummy
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".
-}

-- 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 forall a. Ord a => a -> a -> Bool
< a
0 Bool -> Bool -> Bool
|| forall a. RealFloat a => a -> Bool
isNegativeZero a
x
       = Bool -> ShowS -> ShowS
showParen (Int
p forall a. Ord a => a -> a -> Bool
> Int
6) (Char -> ShowS
showChar Char
'-' forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ShowS
showPos (-a
x))
   | Bool
otherwise = a -> ShowS
showPos a
x

{-
We need to prevent over/underflow of the exponent in encodeFloat when
called from scaleFloat, hence we clamp the scaling parameter.
We must have a large enough range to cover the maximum difference of
exponents returned by decodeFloat.
-}
clamp :: Int -> Int -> Int
clamp :: Int -> Int -> Int
clamp Int
bd Int
k = forall a. Ord a => a -> a -> a
max (-Int
bd) (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 primpop, but
that requires a unique implementation for all supported archetectures. The next
best solution is to write the value from the source register to memory and then
read it from memory into the destination register and the best way to do that
is using CMM.
-}

-- | @'castWord32ToFloat' w@ does a bit-for-bit copy from an integral value
-- to a floating-point value.
--
-- @since 4.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# Word#
w) = Double# -> Double
D# (Word# -> Double#
stgWord64ToDouble Word#
w)

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


-- | @'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#) = Word# -> Word64
W64# (Double# -> Word#
stgDoubleToWord64 Double#
d#)

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