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

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

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

import Data.Maybe

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

infixr 8  **

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

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

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

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

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

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

    {-# INLINE (**) #-}
    {-# INLINE logBase #-}
    {-# INLINE sqrt #-}
    {-# INLINE tan #-}
    {-# INLINE tanh #-}
    a
x ** a
y              =  a -> a
forall a. Floating a => a -> a
Evidence bound by a type signature of the constraint type Floating a
exp (a -> a
forall a. Floating a => a -> a
Evidence bound by a type signature of the constraint type Floating a
log a
x a -> a -> a
forall a. Num a => a -> a -> a
External instance of the constraint type forall a. Fractional a => Num a
Evidence bound by a superclass of: Floating of the constraint type forall a. Floating a => Fractional a
Evidence bound by a type signature of the constraint type Floating a
* a
y)
    logBase a
x a
y         =  a -> a
forall a. Floating a => a -> a
Evidence bound by a type signature of the constraint type Floating a
log a
y a -> a -> a
forall a. Fractional a => a -> a -> a
Evidence bound by a superclass of: Floating of the constraint type forall a. Floating a => Fractional a
Evidence bound by a type signature of the constraint type Floating a
/ a -> a
forall a. Floating a => a -> a
Evidence bound by a type signature of the constraint type Floating a
log a
x
    sqrt a
x              =  a
x a -> a -> a
forall a. Floating a => a -> a -> a
Evidence bound by a type signature of the constraint type Floating a
** a
0.5
    tan  a
x              =  a -> a
forall a. Floating a => a -> a
Evidence bound by a type signature of the constraint type Floating a
sin  a
x a -> a -> a
forall a. Fractional a => a -> a -> a
Evidence bound by a superclass of: Floating of the constraint type forall a. Floating a => Fractional a
Evidence bound by a type signature of the constraint type Floating a
/ a -> a
forall a. Floating a => a -> a
Evidence bound by a type signature of the constraint type Floating a
cos  a
x
    tanh a
x              =  a -> a
forall a. Floating a => a -> a
Evidence bound by a type signature of the constraint type Floating a
sinh a
x a -> a -> a
forall a. Fractional a => a -> a -> a
Evidence bound by a superclass of: Floating of the constraint type forall a. Floating a => Fractional a
Evidence bound by a type signature of the constraint type Floating a
/ a -> a
forall a. Floating a => a -> a
Evidence bound by a type signature of the constraint type Floating a
cosh a
x

    {-# INLINE log1p #-}
    {-# INLINE expm1 #-}
    {-# INLINE log1pexp #-}
    {-# INLINE log1mexp #-}
    log1p a
x = a -> a
forall a. Floating a => a -> a
Evidence bound by a type signature of the constraint type Floating a
log (a
1 a -> a -> a
forall a. Num a => a -> a -> a
External instance of the constraint type forall a. Fractional a => Num a
Evidence bound by a superclass of: Floating of the constraint type forall a. Floating a => Fractional a
Evidence bound by a type signature of the constraint type Floating a
+ a
x)
    expm1 a
x = a -> a
forall a. Floating a => a -> a
Evidence bound by a type signature of the constraint type Floating a
exp a
x a -> a -> a
forall a. Num a => a -> a -> a
External instance of the constraint type forall a. Fractional a => Num a
Evidence bound by a superclass of: Floating of the constraint type forall a. Floating a => Fractional a
Evidence bound by a type signature of the constraint type Floating a
- a
1
    log1pexp a
x = a -> a
forall a. Floating a => a -> a
Evidence bound by a type signature of the constraint type Floating a
log1p (a -> a
forall a. Floating a => a -> a
Evidence bound by a type signature of the constraint type Floating a
exp a
x)
    log1mexp a
x = a -> a
forall a. Floating a => a -> a
Evidence bound by a type signature of the constraint type Floating a
log1p (a -> a
forall a. Num a => a -> a
External instance of the constraint type forall a. Fractional a => Num a
Evidence bound by a superclass of: Floating of the constraint type forall a. Floating a => Fractional a
Evidence bound by a type signature of the constraint type Floating a
negate (a -> a
forall a. Floating a => a -> a
Evidence bound by a type signature of the constraint type Floating a
exp a
x))

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


    exponent a
x          =  if Integer
m Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq Integer
== Integer
0 then Int
0 else Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ a -> Int
forall a. RealFloat a => a -> Int
Evidence bound by a type signature of the constraint type RealFloat a
floatDigits a
x
                           where (Integer
m,Int
n) = a -> (Integer, Int)
forall a. RealFloat a => a -> (Integer, Int)
Evidence bound by a type signature of the constraint type RealFloat a
decodeFloat a
x

    significand a
x       =  Integer -> Int -> a
forall a. RealFloat a => Integer -> Int -> a
Evidence bound by a type signature of the constraint type RealFloat a
encodeFloat Integer
m (Int -> Int
forall a. Num a => a -> a
External instance of the constraint type Num Int
negate (a -> Int
forall a. RealFloat a => a -> Int
Evidence bound by a type signature of the constraint type RealFloat a
floatDigits a
x))
                           where (Integer
m,Int
_) = a -> (Integer, Int)
forall a. RealFloat a => a -> (Integer, Int)
Evidence bound by a type signature of the constraint type RealFloat a
decodeFloat a
x

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

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

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

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

-- | @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
smallInteger Int#
m# Integer -> Int# -> Integer
`shiftLInteger` Int#
e#) Integer -> Integer -> Rational
forall a. a -> a -> Ratio a
:% Integer
1
            | Int# -> Bool
isTrue# ((Int# -> Word#
int2Word# Int#
m# Word# -> Word# -> Word#
`and#` Word#
1##) Word# -> Word# -> Int#
`eqWord#` Word#
0##) ->
                    case Int# -> Int# -> (# Integer, Int# #)
elimZerosInt# Int#
m# (Int# -> Int#
negateInt# Int#
e#) of
                      (# Integer
n, Int#
d# #) -> Integer
n Integer -> Integer -> Rational
forall a. a -> a -> Ratio a
:% Integer -> Int# -> Integer
shiftLInteger Integer
1 Int#
d#
            | Bool
otherwise                                         ->
                    Int# -> Integer
smallInteger Int#
m# Integer -> Integer -> Rational
forall a. a -> a -> Ratio a
:% Integer -> Int# -> Integer
shiftLInteger Integer
1 (Int# -> Int#
negateInt# Int#
e#)

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

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

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

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

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

    truncate :: Float -> b
truncate Float
x  = case Float -> (b, Float)
forall a b. (RealFrac a, Integral b) => a -> (b, a)
Evidence bound by a type signature of the constraint type Integral b
Instance of class: RealFrac of the constraint type RealFrac Float
properFraction Float
x of
                     (b
n,Float
_) -> b
n

    round :: Float -> b
round Float
x     = case Float -> (b, Float)
forall a b. (RealFrac a, Integral b) => a -> (b, a)
Evidence bound by a type signature of the constraint type Integral b
Instance of class: RealFrac of the constraint type RealFrac Float
properFraction Float
x of
                     (b
n,Float
r) -> let
                                m :: b
m         = if Float
r Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Float
< Float
0.0 then b
n b -> b -> b
forall a. Num a => a -> a -> a
External instance of the constraint type forall a. Real a => Num a
External instance of the constraint type forall a. Integral a => Real a
Evidence bound by a type signature of the constraint type Integral b
- b
1 else b
n b -> b -> b
forall a. Num a => a -> a -> a
External instance of the constraint type forall a. Real a => Num a
External instance of the constraint type forall a. Integral a => Real a
Evidence bound by a type signature of the constraint type Integral b
+ b
1
                                half_down :: Float
half_down = Float -> Float
forall a. Num a => a -> a
Instance of class: Num of the constraint type Num Float
abs Float
r Float -> Float -> Float
forall a. Num a => a -> a -> a
Instance of class: Num of the constraint type Num Float
- Float
0.5
                              in
                              case (Float -> Float -> Ordering
forall a. Ord a => a -> a -> Ordering
External instance of the constraint type Ord Float
compare Float
half_down Float
0.0) of
                                Ordering
LT -> b
n
                                Ordering
EQ -> if b -> Bool
forall a. Integral a => a -> Bool
Evidence bound by a type signature of the constraint type Integral b
even b
n then b
n else b
m
                                Ordering
GT -> b
m

    ceiling :: Float -> b
ceiling Float
x   = case Float -> (b, Float)
forall a b. (RealFrac a, Integral b) => a -> (b, a)
Evidence bound by a type signature of the constraint type Integral b
Instance of class: RealFrac of the constraint type RealFrac Float
properFraction Float
x of
                    (b
n,Float
r) -> if Float
r Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Float
> Float
0.0 then b
n b -> b -> b
forall a. Num a => a -> a -> a
External instance of the constraint type forall a. Real a => Num a
External instance of the constraint type forall a. Integral a => Real a
Evidence bound by a type signature of the constraint type Integral b
+ b
1 else b
n

    floor :: Float -> b
floor Float
x     = case Float -> (b, Float)
forall a b. (RealFrac a, Integral b) => a -> (b, a)
Evidence bound by a type signature of the constraint type Integral b
Instance of class: RealFrac of the constraint type RealFrac Float
properFraction Float
x of
                    (b
n,Float
r) -> if Float
r Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Float
< Float
0.0 then b
n b -> b -> b
forall a. Num a => a -> a -> a
External instance of the constraint type forall a. Real a => Num a
External instance of the constraint type forall a. Integral a => Real a
Evidence bound by a type signature of the constraint type Integral b
- 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         =  Float -> Float
forall a. Floating a => a -> a
Instance of class: Floating of the constraint type Floating Float
log Float
y Float -> Float -> Float
forall a. Fractional a => a -> a -> a
Instance of class: Fractional of the constraint type Fractional Float
/ Float -> Float
forall a. Floating a => a -> a
Instance of class: Floating of the constraint type Floating Float
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
a
      | Float
a Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Float
<= Float -> Float
forall a. Floating a => a -> a
Instance of class: Floating of the constraint type Floating Float
log Float
2 = Float -> Float
forall a. Floating a => a -> a
Instance of class: Floating of the constraint type Floating Float
log (Float -> Float
forall a. Num a => a -> a
Instance of class: Num of the constraint type Num Float
negate (Float -> Float
expm1Float Float
a))
      | Bool
otherwise  = Float -> Float
log1pFloat (Float -> Float
forall a. Num a => a -> a
Instance of class: Num of the constraint type Num Float
negate (Float -> Float
forall a. Floating a => a -> a
Instance of class: Floating of the constraint type Floating Float
exp Float
a))
    {-# INLINE log1mexp #-}
    log1pexp :: Float -> Float
log1pexp Float
a
      | Float
a Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Float
<= Float
18   = Float -> Float
log1pFloat (Float -> Float
forall a. Floating a => a -> a
Instance of class: Floating of the constraint type Floating Float
exp Float
a)
      | Float
a Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Float
<= Float
100  = Float
a Float -> Float -> Float
forall a. Num a => a -> a -> a
Instance of class: Num of the constraint type Num Float
+ Float -> Float
forall a. Floating a => a -> a
Instance of class: Floating of the constraint type Floating Float
exp (Float -> Float
forall a. Num a => a -> a
Instance of class: Num of the constraint type Num Float
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
smallInteger Int#
i, Int# -> Int
I# Int#
e)

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

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

    significand :: Float -> Float
significand Float
x       = case Float -> (Integer, Int)
forall a. RealFloat a => a -> (Integer, Int)
Instance of class: RealFloat of the constraint type RealFloat Float
decodeFloat Float
x of
                            (Integer
m,Int
_) -> Integer -> Int -> Float
forall a. RealFloat a => Integer -> Int -> a
Instance of class: RealFloat of the constraint type RealFloat Float
encodeFloat Integer
m (Int -> Int
forall a. Num a => a -> a
External instance of the constraint type Num Int
negate (Float -> Int
forall a. RealFloat a => a -> Int
Instance of class: RealFloat of the constraint type RealFloat Float
floatDigits Float
x))

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

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

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

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

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


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

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

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

-- | @since 2.01
instance  Floating Double  where
    pi :: Double
pi                  =  Double
3.141592653589793238
    exp :: Double -> Double
exp Double
x               =  Double -> Double
expDouble Double
x
    log :: Double -> Double
log Double
x               =  Double -> Double
logDouble Double
x
    sqrt :: Double -> Double
sqrt Double
x              =  Double -> Double
sqrtDouble Double
x
    sin :: Double -> Double
sin  Double
x              =  Double -> Double
sinDouble Double
x
    cos :: Double -> Double
cos  Double
x              =  Double -> Double
cosDouble Double
x
    tan :: Double -> Double
tan  Double
x              =  Double -> Double
tanDouble Double
x
    asin :: Double -> Double
asin Double
x              =  Double -> Double
asinDouble Double
x
    acos :: Double -> Double
acos Double
x              =  Double -> Double
acosDouble Double
x
    atan :: Double -> Double
atan Double
x              =  Double -> Double
atanDouble Double
x
    sinh :: Double -> Double
sinh Double
x              =  Double -> Double
sinhDouble Double
x
    cosh :: Double -> Double
cosh Double
x              =  Double -> Double
coshDouble Double
x
    tanh :: Double -> Double
tanh Double
x              =  Double -> Double
tanhDouble Double
x
    ** :: Double -> Double -> Double
(**) Double
x Double
y            =  Double -> Double -> Double
powerDouble Double
x Double
y
    logBase :: Double -> Double -> Double
logBase Double
x Double
y         =  Double -> Double
forall a. Floating a => a -> a
Instance of class: Floating of the constraint type Floating Double
log Double
y Double -> Double -> Double
forall a. Fractional a => a -> a -> a
Instance of class: Fractional of the constraint type Fractional Double
/ Double -> Double
forall a. Floating a => a -> a
Instance of class: Floating of the constraint type Floating Double
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
a
      | Double
a Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Double
<= Double -> Double
forall a. Floating a => a -> a
Instance of class: Floating of the constraint type Floating Double
log Double
2 = Double -> Double
forall a. Floating a => a -> a
Instance of class: Floating of the constraint type Floating Double
log (Double -> Double
forall a. Num a => a -> a
Instance of class: Num of the constraint type Num Double
negate (Double -> Double
expm1Double Double
a))
      | Bool
otherwise  = Double -> Double
log1pDouble (Double -> Double
forall a. Num a => a -> a
Instance of class: Num of the constraint type Num Double
negate (Double -> Double
forall a. Floating a => a -> a
Instance of class: Floating of the constraint type Floating Double
exp Double
a))
    {-# INLINE log1mexp #-}
    log1pexp :: Double -> Double
log1pexp Double
a
      | Double
a Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Double
<= Double
18   = Double -> Double
log1pDouble (Double -> Double
forall a. Floating a => a -> a
Instance of class: Floating of the constraint type Floating Double
exp Double
a)
      | Double
a Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Double
<= Double
100  = Double
a Double -> Double -> Double
forall a. Num a => a -> a -> a
Instance of class: Num of the constraint type Num Double
+ Double -> Double
forall a. Floating a => a -> a
Instance of class: Floating of the constraint type Floating Double
exp (Double -> Double
forall a. Num a => a -> a
Instance of class: Num of the constraint type Num Double
negate Double
a)
      | Bool
otherwise = Double
a
    {-# INLINE log1pexp #-}

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

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

    properFraction :: Double -> (b, Double)
properFraction Double
x
      = case (Double -> (Integer, Int)
forall a. RealFloat a => a -> (Integer, Int)
Instance of class: RealFloat of the constraint type RealFloat Double
decodeFloat Double
x)      of { (Integer
m,Int
n) ->
        if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
>= Int
0 then
            (Integer -> b
forall a. Num a => Integer -> a
External instance of the constraint type forall a. Real a => Num a
External instance of the constraint type forall a. Integral a => Real a
Evidence bound by a type signature of the constraint type Integral b
fromInteger Integer
m b -> b -> b
forall a. Num a => a -> a -> a
External instance of the constraint type forall a. Real a => Num a
External instance of the constraint type forall a. Integral a => Real a
Evidence bound by a type signature of the constraint type Integral b
* b
2 b -> Int -> b
forall a b. (Num a, Integral b) => a -> b -> a
External instance of the constraint type Integral Int
External instance of the constraint type forall a. Real a => Num a
External instance of the constraint type forall a. Integral a => Real a
Evidence bound by a type signature of the constraint type Integral b
^ Int
n, Double
0.0)
        else
            case (Integer -> Integer -> (Integer, Integer)
forall a. Integral a => a -> a -> (a, a)
External instance of the constraint type Integral Integer
quotRem Integer
m (Integer
2Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
External instance of the constraint type Integral Int
External instance of the constraint type Num Integer
^(Int -> Int
forall a. Num a => a -> a
External instance of the constraint type Num Int
negate Int
n))) of { (Integer
w,Integer
r) ->
            (Integer -> b
forall a. Num a => Integer -> a
External instance of the constraint type forall a. Real a => Num a
External instance of the constraint type forall a. Integral a => Real a
Evidence bound by a type signature of the constraint type Integral b
fromInteger Integer
w, Integer -> Int -> Double
forall a. RealFloat a => Integer -> Int -> a
Instance of class: RealFloat of the constraint type RealFloat Double
encodeFloat Integer
r Int
n)
            }
        }

    truncate :: Double -> b
truncate Double
x  = case Double -> (b, Double)
forall a b. (RealFrac a, Integral b) => a -> (b, a)
Evidence bound by a type signature of the constraint type Integral b
Instance of class: RealFrac of the constraint type RealFrac Double
properFraction Double
x of
                     (b
n,Double
_) -> b
n

    round :: Double -> b
round Double
x     = case Double -> (b, Double)
forall a b. (RealFrac a, Integral b) => a -> (b, a)
Evidence bound by a type signature of the constraint type Integral b
Instance of class: RealFrac of the constraint type RealFrac Double
properFraction Double
x of
                     (b
n,Double
r) -> let
                                m :: b
m         = if Double
r Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Double
< Double
0.0 then b
n b -> b -> b
forall a. Num a => a -> a -> a
External instance of the constraint type forall a. Real a => Num a
External instance of the constraint type forall a. Integral a => Real a
Evidence bound by a type signature of the constraint type Integral b
- b
1 else b
n b -> b -> b
forall a. Num a => a -> a -> a
External instance of the constraint type forall a. Real a => Num a
External instance of the constraint type forall a. Integral a => Real a
Evidence bound by a type signature of the constraint type Integral b
+ b
1
                                half_down :: Double
half_down = Double -> Double
forall a. Num a => a -> a
Instance of class: Num of the constraint type Num Double
abs Double
r Double -> Double -> Double
forall a. Num a => a -> a -> a
Instance of class: Num of the constraint type Num Double
- Double
0.5
                              in
                              case (Double -> Double -> Ordering
forall a. Ord a => a -> a -> Ordering
External instance of the constraint type Ord Double
compare Double
half_down Double
0.0) of
                                Ordering
LT -> b
n
                                Ordering
EQ -> if b -> Bool
forall a. Integral a => a -> Bool
Evidence bound by a type signature of the constraint type Integral b
even b
n then b
n else b
m
                                Ordering
GT -> b
m

    ceiling :: Double -> b
ceiling Double
x   = case Double -> (b, Double)
forall a b. (RealFrac a, Integral b) => a -> (b, a)
Evidence bound by a type signature of the constraint type Integral b
Instance of class: RealFrac of the constraint type RealFrac Double
properFraction Double
x of
                    (b
n,Double
r) -> if Double
r Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Double
> Double
0.0 then b
n b -> b -> b
forall a. Num a => a -> a -> a
External instance of the constraint type forall a. Real a => Num a
External instance of the constraint type forall a. Integral a => Real a
Evidence bound by a type signature of the constraint type Integral b
+ b
1 else b
n

    floor :: Double -> b
floor Double
x     = case Double -> (b, Double)
forall a b. (RealFrac a, Integral b) => a -> (b, a)
Evidence bound by a type signature of the constraint type Integral b
Instance of class: RealFrac of the constraint type RealFrac Double
properFraction Double
x of
                    (b
n,Double
r) -> if Double
r Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Double
< Double
0.0 then b
n b -> b -> b
forall a. Num a => a -> a -> a
External instance of the constraint type forall a. Real a => Num a
External instance of the constraint type forall a. Integral a => Real a
Evidence bound by a type signature of the constraint type Integral b
- 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# #)
decodeDoubleInteger 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#
encodeDoubleInteger Integer
i Int#
j)

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

    significand :: Double -> Double
significand Double
x       = case Double -> (Integer, Int)
forall a. RealFloat a => a -> (Integer, Int)
Instance of class: RealFloat of the constraint type RealFloat Double
decodeFloat Double
x of
                            (Integer
m,Int
_) -> Integer -> Int -> Double
forall a. RealFloat a => Integer -> Int -> a
Instance of class: RealFloat of the constraint type RealFloat Double
encodeFloat Integer
m (Int -> Int
forall a. Num a => a -> a
External instance of the constraint type Num Int
negate (Double -> Int
forall a. RealFloat a => a -> Int
Instance of class: RealFloat of the constraint type RealFloat Double
floatDigits Double
x))

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

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

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


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

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

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

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

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

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

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

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

data FFFormat = FFExponent | FFFixed | FFGeneric

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

formatRealFloatAlt :: (RealFloat a) => FFFormat -> Maybe Int -> Bool -> a
                 -> String
formatRealFloatAlt :: FFFormat -> Maybe Int -> Bool -> a -> String
formatRealFloatAlt FFFormat
fmt Maybe Int
decs Bool
alt a
x
   | a -> Bool
forall a. RealFloat a => a -> Bool
Evidence bound by a type signature of the constraint type RealFloat a
isNaN a
x                   = String
"NaN"
   | a -> Bool
forall a. RealFloat a => a -> Bool
Evidence bound by a type signature of the constraint type RealFloat a
isInfinite a
x              = if a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type forall a. Real a => Ord a
External instance of the constraint type forall a. RealFrac a => Real a
Evidence bound by a superclass of: RealFloat of the constraint type forall a. RealFloat a => RealFrac a
Evidence bound by a type signature of the constraint type RealFloat a
< a
0 then String
"-Infinity" else String
"Infinity"
   | a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type forall a. Real a => Ord a
External instance of the constraint type forall a. RealFrac a => Real a
Evidence bound by a superclass of: RealFloat of the constraint type forall a. RealFloat a => RealFrac a
Evidence bound by a type signature of the constraint type RealFloat a
< a
0 Bool -> Bool -> Bool
|| a -> Bool
forall a. RealFloat a => a -> Bool
Evidence bound by a type signature of the constraint type RealFloat a
isNegativeZero a
x = Char
'-'Char -> ShowS
forall a. a -> [a] -> [a]
:FFFormat -> ([Int], Int) -> String
doFmt FFFormat
fmt (Integer -> a -> ([Int], Int)
forall a. RealFloat a => Integer -> a -> ([Int], Int)
Evidence bound by a type signature of the constraint type RealFloat a
floatToDigits (Int -> Integer
forall a. Integral a => a -> Integer
External instance of the constraint type Integral Int
toInteger Int
base) (-a
x))
   | Bool
otherwise                 = FFFormat -> ([Int], Int) -> String
doFmt FFFormat
fmt (Integer -> a -> ([Int], Int)
forall a. RealFloat a => Integer -> a -> ([Int], Int)
Evidence bound by a type signature of the constraint type RealFloat a
floatToDigits (Int -> Integer
forall a. Integral a => a -> Integer
External instance of the constraint type Integral Int
toInteger Int
base) a
x)
 where
  base :: Int
base = Int
10

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


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

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

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

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

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

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

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

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

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

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

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

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

This program prints
        0.0000000000000000
instead of
        1.8217369128763981e-300

Here's Joe's code:

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

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

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

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

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

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

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

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

-- Deal with special cases first, delegating the real work to fromRat'
fromRat :: Rational -> a
fromRat (Integer
n :% Integer
0) | Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Integer
> Integer
0     =  a
1a -> a -> a
forall a. Fractional a => a -> a -> a
External instance of the constraint type forall a. RealFrac a => Fractional a
Evidence bound by a superclass of: RealFloat of the constraint type forall a. RealFloat a => RealFrac a
Evidence bound by a type signature of the constraint type RealFloat a
/a
0        -- +Infinity
                 | Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Integer
< Integer
0     = -a
1a -> a -> a
forall a. Fractional a => a -> a -> a
External instance of the constraint type forall a. RealFrac a => Fractional a
Evidence bound by a superclass of: RealFloat of the constraint type forall a. RealFloat a => RealFrac a
Evidence bound by a type signature of the constraint type RealFloat a
/a
0        -- -Infinity
                 | Bool
otherwise =  a
0a -> a -> a
forall a. Fractional a => a -> a -> a
External instance of the constraint type forall a. RealFrac a => Fractional a
Evidence bound by a superclass of: RealFloat of the constraint type forall a. RealFloat a => RealFrac a
Evidence bound by a type signature of the constraint type RealFloat a
/a
0        -- NaN

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

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

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

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

maxExpt10 :: Int
maxExpt10 :: Int
maxExpt10 = Int
324

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

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

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

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

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

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

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

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

plusFloat, minusFloat, timesFloat, divideFloat :: Float -> Float -> Float
plusFloat :: Float -> Float -> Float
plusFloat   (F# 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
"fromIntegral/Int->Float"   fromIntegral = int2Float
"fromIntegral/Int->Double"  fromIntegral = int2Double
"fromIntegral/Word->Float"  fromIntegral = word2Float
"fromIntegral/Word->Double" fromIntegral = word2Double
"realToFrac/Float->Float"   realToFrac   = id :: Float -> Float
"realToFrac/Float->Double"  realToFrac   = float2Double
"realToFrac/Double->Float"  realToFrac   = double2Float
"realToFrac/Double->Double" realToFrac   = id :: Double -> Double
"realToFrac/Int->Double"    realToFrac   = int2Double   -- See Note [realToFrac int-to-float]
"realToFrac/Int->Float"     realToFrac   = int2Float    --      ..ditto
    #-}

{-
Note [realToFrac int-to-float]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Don found that the RULES for realToFrac/Int->Double and 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 :: (a -> ShowS) -> Int -> a -> ShowS
showSignedFloat a -> ShowS
showPos Int
p a
x
   | a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type forall a. Real a => Ord a
External instance of the constraint type forall a. RealFrac a => Real a
Evidence bound by a superclass of: RealFloat of the constraint type forall a. RealFloat a => RealFrac a
Evidence bound by a type signature of the constraint type RealFloat a
< a
0 Bool -> Bool -> Bool
|| a -> Bool
forall a. RealFloat a => a -> Bool
Evidence bound by a type signature of the constraint type RealFloat a
isNegativeZero a
x
       = Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
> Int
6) (Char -> ShowS
showChar Char
'-' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ShowS
showPos (-a
x))
   | Bool
otherwise = a -> ShowS
showPos a
x

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

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

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


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

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

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



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

{-# INLINE castWord64ToDouble #-}
castWord64ToDouble :: Word64 -> Double
castWord64ToDouble :: Word64 -> Double
castWord64ToDouble (W64# 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.10.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