{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
module Numeric.Floating.IEEE.Internal.Rounding.Integral where
import           Control.Exception (assert)
import           Data.Bits
import           Data.Functor.Product
import           Data.Int
import           Data.Proxy
import           Data.Word
import           GHC.Exts
import           Math.NumberTheory.Logarithms (integerLog2', integerLogBase',
                                               wordLog2')
import           MyPrelude
import           Numeric.Floating.IEEE.Internal.Base
import           Numeric.Floating.IEEE.Internal.IntegerInternals
import           Numeric.Floating.IEEE.Internal.Rounding.Common

default ()

-- |
-- IEEE 754 @convertFromInt@ operation, with each rounding attributes.
fromIntegerTiesToEven, fromIntegerTiesToAway, fromIntegerTowardPositive, fromIntegerTowardNegative, fromIntegerTowardZero :: RealFloat a => Integer -> a
fromIntegerTiesToEven :: forall a. RealFloat a => Integer -> a
fromIntegerTiesToEven = forall a. RoundTiesToEven a -> a
roundTiesToEven forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (f :: * -> *).
(RealFloat a, RoundingStrategy f) =>
Integer -> f a
fromIntegerR
fromIntegerTiesToAway :: forall a. RealFloat a => Integer -> a
fromIntegerTiesToAway = forall a. RoundTiesToAway a -> a
roundTiesToAway forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (f :: * -> *).
(RealFloat a, RoundingStrategy f) =>
Integer -> f a
fromIntegerR
fromIntegerTowardPositive :: forall a. RealFloat a => Integer -> a
fromIntegerTowardPositive = forall a. RoundTowardPositive a -> a
roundTowardPositive forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (f :: * -> *).
(RealFloat a, RoundingStrategy f) =>
Integer -> f a
fromIntegerR
fromIntegerTowardNegative :: forall a. RealFloat a => Integer -> a
fromIntegerTowardNegative = forall a. RoundTowardNegative a -> a
roundTowardNegative forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (f :: * -> *).
(RealFloat a, RoundingStrategy f) =>
Integer -> f a
fromIntegerR
fromIntegerTowardZero :: forall a. RealFloat a => Integer -> a
fromIntegerTowardZero = forall a. RoundTowardZero a -> a
roundTowardZero forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (f :: * -> *).
(RealFloat a, RoundingStrategy f) =>
Integer -> f a
fromIntegerR
{-# INLINE fromIntegerTiesToEven #-}
{-# INLINE fromIntegerTiesToAway #-}
{-# INLINE fromIntegerTowardPositive #-}
{-# INLINE fromIntegerTowardNegative #-}
{-# INLINE fromIntegerTowardZero #-}

-- |
-- IEEE 754 @convertFromInt@ operation, with each rounding attributes.
fromIntegralTiesToEven, fromIntegralTiesToAway, fromIntegralTowardPositive, fromIntegralTowardNegative, fromIntegralTowardZero :: (Integral i, RealFloat a) => i -> a
fromIntegralTiesToEven :: forall i a. (Integral i, RealFloat a) => i -> a
fromIntegralTiesToEven = forall a. RoundTiesToEven a -> a
roundTiesToEven forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i a (f :: * -> *).
(Integral i, RealFloat a, RoundingStrategy f) =>
i -> f a
fromIntegralR
fromIntegralTiesToAway :: forall i a. (Integral i, RealFloat a) => i -> a
fromIntegralTiesToAway = forall a. RoundTiesToAway a -> a
roundTiesToAway forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i a (f :: * -> *).
(Integral i, RealFloat a, RoundingStrategy f) =>
i -> f a
fromIntegralR
fromIntegralTowardPositive :: forall i a. (Integral i, RealFloat a) => i -> a
fromIntegralTowardPositive = forall a. RoundTowardPositive a -> a
roundTowardPositive forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i a (f :: * -> *).
(Integral i, RealFloat a, RoundingStrategy f) =>
i -> f a
fromIntegralR
fromIntegralTowardNegative :: forall i a. (Integral i, RealFloat a) => i -> a
fromIntegralTowardNegative = forall a. RoundTowardNegative a -> a
roundTowardNegative forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i a (f :: * -> *).
(Integral i, RealFloat a, RoundingStrategy f) =>
i -> f a
fromIntegralR
fromIntegralTowardZero :: forall i a. (Integral i, RealFloat a) => i -> a
fromIntegralTowardZero = forall a. RoundTowardZero a -> a
roundTowardZero forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i a (f :: * -> *).
(Integral i, RealFloat a, RoundingStrategy f) =>
i -> f a
fromIntegralR
{-# INLINE fromIntegralTiesToEven #-}
{-# INLINE fromIntegralTiesToAway #-}
{-# INLINE fromIntegralTowardPositive #-}
{-# INLINE fromIntegralTowardNegative #-}
{-# INLINE fromIntegralTowardZero #-}

fromIntegerR :: (RealFloat a, RoundingStrategy f) => Integer -> f a
fromIntegerR :: forall a (f :: * -> *).
(RealFloat a, RoundingStrategy f) =>
Integer -> f a
fromIntegerR Integer
n = case Integer -> Maybe Int
integerToIntMaybe Integer
n of
                   Just Int
x -> forall i (f :: * -> *) a.
(Integral i, Bits i, RealFloat a, RoundingStrategy f) =>
i -> f a
fromIntegralRBits Int
x
                   Maybe Int
Nothing | Integer
n forall a. Ord a => a -> a -> Bool
< Integer
0 -> forall a. Num a => a -> a
negate forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a.
(RealFloat a, RoundingStrategy f) =>
Bool -> Integer -> f a
fromPositiveIntegerR Bool
True (- Integer
n)
                           | Bool
otherwise -> forall (f :: * -> *) a.
(RealFloat a, RoundingStrategy f) =>
Bool -> Integer -> f a
fromPositiveIntegerR Bool
False Integer
n
{-# INLINE fromIntegerR #-}

fromIntegralR :: (Integral i, RealFloat a, RoundingStrategy f) => i -> f a
fromIntegralR :: forall i a (f :: * -> *).
(Integral i, RealFloat a, RoundingStrategy f) =>
i -> f a
fromIntegralR i
x = forall a (f :: * -> *).
(RealFloat a, RoundingStrategy f) =>
Integer -> f a
fromIntegerR (forall a. Integral a => a -> Integer
toInteger i
x)
{-# INLINE [0] fromIntegralR #-}
{-# RULES
"fromIntegralR/Integer->a" fromIntegralR = fromIntegerR
"fromIntegralR/Int->a" fromIntegralR = fromIntegralRBits @Int
"fromIntegralR/Int8->a" fromIntegralR = fromIntegralRBits @Int8
"fromIntegralR/Int16->a" fromIntegralR = fromIntegralRBits @Int16
"fromIntegralR/Int32->a" fromIntegralR = fromIntegralRBits @Int32
"fromIntegralR/Int64->a" fromIntegralR = fromIntegralRBits @Int64
"fromIntegralR/Word->a" fromIntegralR = fromIntegralRBits @Word
"fromIntegralR/Word8->a" fromIntegralR = fromIntegralRBits @Word8
"fromIntegralR/Word16->a" fromIntegralR = fromIntegralRBits @Word16
"fromIntegralR/Word32->a" fromIntegralR = fromIntegralRBits @Word32
"fromIntegralR/Word64->a" fromIntegralR = fromIntegralRBits @Word64
  #-}

fromIntegralRBits :: forall i f a. (Integral i, Bits i, RealFloat a, RoundingStrategy f) => i -> f a
fromIntegralRBits :: forall i (f :: * -> *) a.
(Integral i, Bits i, RealFloat a, RoundingStrategy f) =>
i -> f a
fromIntegralRBits i
x
  -- Small enough: fromIntegral should be sufficient
  | Bool
ieee
  , let resultI :: a
resultI = forall a b. (Integral a, Num b) => a -> b
fromIntegral i
x
  , let (Maybe i
min', Maybe i
max') = forall a i.
(Integral i, Bits i, RealFloat a) =>
Proxy a -> (Maybe i, Maybe i)
boundsForExactConversion (forall {k} (t :: k). Proxy t
Proxy :: Proxy a)
  , forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (forall a. Ord a => a -> a -> Bool
<= i
x) Maybe i
min'
  , forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (i
x forall a. Ord a => a -> a -> Bool
<=) Maybe i
max'
  = forall (f :: * -> *) a. RoundingStrategy f => a -> f a
exact a
resultI

  -- Signed, and not small enough: Test if the value fits in Int
  | Bool
ieee
  , Integer
base forall a. Eq a => a -> a -> Bool
== Integer
2
  , Bool
signed
  , Just Int
y <- forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
toIntegralSized i
x :: Maybe Int
  = if Int
y forall a. Ord a => a -> a -> Bool
< Int
0 then
      forall a. Num a => a -> a
negate forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a (f :: * -> *).
(RealFloat a, RoundingStrategy f) =>
Bool -> Word -> f a
positiveWordToBinaryFloatR Bool
True (Int -> Word
negateIntAsWord Int
y)
    else
      -- We can assume x /= 0
      forall a (f :: * -> *).
(RealFloat a, RoundingStrategy f) =>
Bool -> Word -> f a
positiveWordToBinaryFloatR Bool
False (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
y)

  -- Unsigned, and not small enough: Test if the value fits in Word
  | Bool
ieee
  , Integer
base forall a. Eq a => a -> a -> Bool
== Integer
2
  , Bool -> Bool
not Bool
signed
  , Just Word
y <- forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
toIntegralSized i
x :: Maybe Word
  = -- We can assume x /= 0
    forall a (f :: * -> *).
(RealFloat a, RoundingStrategy f) =>
Bool -> Word -> f a
positiveWordToBinaryFloatR Bool
False Word
y

  -- General case: Convert via Integer
  | Bool
otherwise = f a
result
  where
    result :: f a
result | i
x forall a. Eq a => a -> a -> Bool
== i
0 = forall (f :: * -> *) a. RoundingStrategy f => a -> f a
exact a
0
           | i
x forall a. Ord a => a -> a -> Bool
< i
0 = forall a. Num a => a -> a
negate forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a.
(RealFloat a, RoundingStrategy f) =>
Bool -> Integer -> f a
fromPositiveIntegerR Bool
True (- forall a. Integral a => a -> Integer
toInteger i
x)
           | Bool
otherwise = forall (f :: * -> *) a.
(RealFloat a, RoundingStrategy f) =>
Bool -> Integer -> f a
fromPositiveIntegerR Bool
False (forall a. Integral a => a -> Integer
toInteger i
x)
    signed :: Bool
signed = forall a. Bits a => a -> Bool
isSigned i
x
    ieee :: Bool
ieee = forall a. RealFloat a => a -> Bool
isIEEE (forall a. HasCallStack => a
undefined :: a)
    base :: Integer
base = forall a. RealFloat a => a -> Integer
floatRadix (forall a. HasCallStack => a
undefined :: a)
{-# INLINE fromIntegralRBits #-}

-- |
-- >>> boundsForExactConversion (Proxy :: Proxy Double) :: (Maybe Integer, Maybe Integer) -- (Just (-2^53),Just (2^53))
-- (Just (-9007199254740992),Just 9007199254740992)
-- >>> boundsForExactConversion (Proxy :: Proxy Double) :: (Maybe Int32, Maybe Int32) -- the conversion is always exact
-- (Nothing,Nothing)
-- >>> boundsForExactConversion (Proxy :: Proxy Float) :: (Maybe Word, Maybe Word) -- (Nothing,Just (2^24))
-- (Nothing,Just 16777216)
boundsForExactConversion :: forall a i. (Integral i, Bits i, RealFloat a) => Proxy a -> (Maybe i, Maybe i)
boundsForExactConversion :: forall a i.
(Integral i, Bits i, RealFloat a) =>
Proxy a -> (Maybe i, Maybe i)
boundsForExactConversion Proxy a
_ = forall a. HasCallStack => Bool -> a -> a
assert Bool
ieee (Maybe i
minI, Maybe i
maxI)
  where
    maxInteger :: Integer
maxInteger = Integer
base Integer -> Int -> Integer
^! Int
digits
    minInteger :: Integer
minInteger = - Integer
maxInteger
    minI :: Maybe i
minI = case forall i. Bits i => i -> Maybe Integer
minBoundAsInteger (forall a. HasCallStack => a
undefined :: i) of
             Just Integer
minBound' | Integer
minInteger forall a. Ord a => a -> a -> Bool
<= Integer
minBound' -> forall a. Maybe a
Nothing -- all negative integers can be expressed in the target floating-type: no check for lower-bound is needed
             Maybe Integer
_ -> forall a. a -> Maybe a
Just (forall a. Num a => Integer -> a
fromInteger Integer
minInteger)
    maxI :: Maybe i
maxI = case forall i. Bits i => i -> Maybe Integer
maxBoundAsInteger (forall a. HasCallStack => a
undefined :: i) of
             Just Integer
maxBound' | Integer
maxBound' forall a. Ord a => a -> a -> Bool
<= Integer
maxInteger -> forall a. Maybe a
Nothing -- all positive integral values can be expressed in the target floating-type: no check for upper-bound is needed
             Maybe Integer
_ -> forall a. a -> Maybe a
Just (forall a. Num a => Integer -> a
fromInteger Integer
maxInteger)
    ieee :: Bool
ieee = forall a. RealFloat a => a -> Bool
isIEEE (forall a. HasCallStack => a
undefined :: a)
    base :: Integer
base = forall a. RealFloat a => a -> Integer
floatRadix (forall a. HasCallStack => a
undefined :: a)
    digits :: Int
digits = forall a. RealFloat a => a -> Int
floatDigits (forall a. HasCallStack => a
undefined :: a)
{-# INLINE boundsForExactConversion #-}

minBoundAsInteger :: Bits i => i -> Maybe Integer
minBoundAsInteger :: forall i. Bits i => i -> Maybe Integer
minBoundAsInteger i
dummyI = if forall a. Bits a => a -> Bool
isSigned i
dummyI then
                             case forall a. Bits a => a -> Maybe Int
bitSizeMaybe i
dummyI of
                               Just Int
bits -> forall a. a -> Maybe a
Just (- forall a. Bits a => Int -> a
bit (Int
bitsforall a. Num a => a -> a -> a
-Int
1))
                               Maybe Int
Nothing   -> forall a. Maybe a
Nothing
                           else
                             forall a. a -> Maybe a
Just Integer
0
{-# INLINE [1] minBoundAsInteger #-}
{-# RULES
"minBoundAsInteger/Int" minBoundAsInteger = (\_ -> Just (toInteger (minBound :: Int))) :: Int -> Maybe Integer
"minBoundAsInteger/Int8" minBoundAsInteger = (\_ -> Just (toInteger (minBound :: Int8))) :: Int8 -> Maybe Integer
"minBoundAsInteger/Int16" minBoundAsInteger = (\_ -> Just (toInteger (minBound :: Int16))) :: Int16 -> Maybe Integer
"minBoundAsInteger/Int32" minBoundAsInteger = (\_ -> Just (toInteger (minBound :: Int32))) :: Int32 -> Maybe Integer
"minBoundAsInteger/Int64" minBoundAsInteger = (\_ -> Just (toInteger (minBound :: Int64))) :: Int64 -> Maybe Integer
"minBoundAsInteger/Word" minBoundAsInteger = (\_ -> Just 0) :: Word -> Maybe Integer
"minBoundAsInteger/Word8" minBoundAsInteger = (\_ -> Just 0) :: Word8 -> Maybe Integer
"minBoundAsInteger/Word16" minBoundAsInteger = (\_ -> Just 0) :: Word16 -> Maybe Integer
"minBoundAsInteger/Word32" minBoundAsInteger = (\_ -> Just 0) :: Word32 -> Maybe Integer
"minBoundAsInteger/Word64" minBoundAsInteger = (\_ -> Just 0) :: Word64 -> Maybe Integer
  #-}

maxBoundAsInteger :: Bits i => i -> Maybe Integer
maxBoundAsInteger :: forall i. Bits i => i -> Maybe Integer
maxBoundAsInteger i
dummyI = case forall a. Bits a => a -> Maybe Int
bitSizeMaybe i
dummyI of
                             Just Int
bits | forall a. Bits a => a -> Bool
isSigned i
dummyI -> forall a. a -> Maybe a
Just (forall a. Bits a => Int -> a
bit (Int
bitsforall a. Num a => a -> a -> a
-Int
1) forall a. Num a => a -> a -> a
- Integer
1)
                                       | Bool
otherwise -> forall a. a -> Maybe a
Just (forall a. Bits a => Int -> a
bit Int
bits forall a. Num a => a -> a -> a
- Integer
1)
                             Maybe Int
Nothing -> forall a. Maybe a
Nothing
{-# INLINE [1] maxBoundAsInteger #-}
{-# RULES
"maxBoundAsInteger/Int" maxBoundAsInteger = (\_ -> Just (toInteger (maxBound :: Int))) :: Int -> Maybe Integer
"maxBoundAsInteger/Int8" maxBoundAsInteger = (\_ -> Just (toInteger (maxBound :: Int8))) :: Int8 -> Maybe Integer
"maxBoundAsInteger/Int16" maxBoundAsInteger = (\_ -> Just (toInteger (maxBound :: Int16))) :: Int16 -> Maybe Integer
"maxBoundAsInteger/Int32" maxBoundAsInteger = (\_ -> Just (toInteger (maxBound :: Int32))) :: Int32 -> Maybe Integer
"maxBoundAsInteger/Int64" maxBoundAsInteger = (\_ -> Just (toInteger (maxBound :: Int64))) :: Int64 -> Maybe Integer
"maxBoundAsInteger/Word" maxBoundAsInteger = (\_ -> Just (toInteger (maxBound :: Word))) :: Word -> Maybe Integer
"maxBoundAsInteger/Word8" maxBoundAsInteger = (\_ -> Just (toInteger (maxBound :: Word8))) :: Word8 -> Maybe Integer
"maxBoundAsInteger/Word16" maxBoundAsInteger = (\_ -> Just (toInteger (maxBound :: Word16))) :: Word16 -> Maybe Integer
"maxBoundAsInteger/Word32" maxBoundAsInteger = (\_ -> Just (toInteger (maxBound :: Word32))) :: Word32 -> Maybe Integer
"maxBoundAsInteger/Word64" maxBoundAsInteger = (\_ -> Just (toInteger (maxBound :: Word64))) :: Word64 -> Maybe Integer
  #-}

-- Avoid cross-module specialization issue with manual worker/wrapper transformation
positiveWordToBinaryFloatR :: (RealFloat a, RoundingStrategy f) => Bool -> Word -> f a
positiveWordToBinaryFloatR :: forall a (f :: * -> *).
(RealFloat a, RoundingStrategy f) =>
Bool -> Word -> f a
positiveWordToBinaryFloatR Bool
neg (W# Word#
n#) = forall (f :: * -> *) a.
(RealFloat a, RoundingStrategy f) =>
Bool -> Word# -> f a
positiveWordToBinaryFloatR# Bool
neg Word#
n#
{-# INLINE positiveWordToBinaryFloatR #-}

positiveWordToBinaryFloatR# :: forall f a. (RealFloat a, RoundingStrategy f) => Bool -> Word# -> f a
positiveWordToBinaryFloatR# :: forall (f :: * -> *) a.
(RealFloat a, RoundingStrategy f) =>
Bool -> Word# -> f a
positiveWordToBinaryFloatR# !Bool
neg Word#
n# = f a
result
  where
    n :: Word
n = Word# -> Word
W# Word#
n#
    result :: f a
result = let k :: Int
k = Word -> Int
wordLog2' Word
n -- floor (log2 n)
                 -- 2^k <= n < 2^(k+1) <= 2^(finiteBitSize n)
                 -- k <= finiteBitSize n - 1
             in if Int
k forall a. Ord a => a -> a -> Bool
< Int
fDigits then
                  forall (f :: * -> *) a. RoundingStrategy f => a -> f a
exact forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
n
                else
                  -- expMax <= k implies expMax <= finiteBitSize n - 1
                  if Int
expMax forall a. Ord a => a -> a -> Bool
<= forall b. FiniteBits b => b -> Int
finiteBitSize Word
n forall a. Num a => a -> a -> a
- Int
1 Bool -> Bool -> Bool
&& Int
k forall a. Ord a => a -> a -> Bool
>= Int
expMax then
                    -- overflow
                    let inf :: a
inf = a
1 forall a. Fractional a => a -> a -> a
/ a
0
                    in forall (f :: * -> *) a.
RoundingStrategy f =>
Ordering -> Bool -> Int -> a -> a -> f a
inexact Ordering
GT Bool
neg Int
1 forall a. RealFloat a => a
maxFinite a
inf
                  else
                    -- k >= fDigits
                    let e :: Int
e = Int
k forall a. Num a => a -> a -> a
- Int
fDigits forall a. Num a => a -> a -> a
+ Int
1 -- 1 <= e <= finiteBitSize n - fDigits
                        q :: Word
q = Word
n forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
e -- q <= n / 2^e = 2^(log2 n - (floor (log2 n) - fDigits + 1)) < 2^fDigits
                        r :: Word
r = Word
n forall a. Bits a => a -> a -> a
.&. ((Word
1 forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
e) forall a. Num a => a -> a -> a
- Word
1)
                        -- (q, r) = n `quotRem` (base^e)
                        -- base^(fDigits - 1) <= q < base^fDigits, 0 <= r < base^(k-fDigits+1)
                        towardzero_or_exact :: a
towardzero_or_exact = forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word
q forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
e)
                        -- Although (q `unsafeShiftL` e) fits in Word, ((q + 1) `unsafeShiftL` e) may overflow.
                        -- fDigits + e = k + 1 <= WORD_SIZE_IN_BITS
                        -- Equality holds when wordLog2' n == WORD_SIZE_IN_BITS - 1, i.e. 2^(WORD_SIZE_IN_BITS - 1) <= n.
                        -- In particular,
                        -- * When q + 1 < 2^fDigits, (q + 1) * 2^e < 2^(fDigits + e) = 2^(k + 1) <= 2^WORD_SIZE_IN_BITS, so (q + 1) * 2^e does not overflow.
                        -- * When k + 1 < WORD_SIZE_IN_BITS, (q + 1) * 2^e <= 2^(fDigits + e) = 2^(k+1) < 2^WORD_SIZE_IN_BITS, so (q + 1) * 2^e does not overflow.
                        -- * q + 1 <= 2^fDigits and k + 1 <= WORD_SIZE_IN_BITS always hold.
                        -- * Therefore, ((q + 1) `unsafeShiftL` e) overflows only if q + 1 == 2^fDigits && k + 1 == WORD_SIZE_IN_BITS
                        awayfromzero :: a
awayfromzero = if Word
q forall a. Num a => a -> a -> a
+ Word
1 forall a. Eq a => a -> a -> Bool
== (Word
1 forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
fDigits) Bool -> Bool -> Bool
&& Int
k forall a. Eq a => a -> a -> Bool
== forall b. FiniteBits b => b -> Int
finiteBitSize Word
n forall a. Num a => a -> a -> a
- Int
1 then
                                         -- (q + 1) `shiftL` e = 2^(fDigits + e) = 2^(k+1) = 2^(finiteBitSize n)
                                         forall a. RealFloat a => Integer -> Int -> a
encodeFloat Integer
1 (forall b. FiniteBits b => b -> Int
finiteBitSize Word
n)
                                       else
                                         forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Word
q forall a. Num a => a -> a -> a
+ Word
1) forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
e)
                        parity :: Int
parity = forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
q :: Int
                    in forall (f :: * -> *) a.
RoundingStrategy f =>
Bool -> Ordering -> Bool -> Int -> a -> a -> f a
doRound
                         (Word
r forall a. Eq a => a -> a -> Bool
== Word
0) -- exactness
                         (forall a. Ord a => a -> a -> Ordering
compare Word
r (Word
1 forall a. Bits a => a -> Int -> a
`unsafeShiftL` (Int
e forall a. Num a => a -> a -> a
- Int
1)))
                         Bool
neg
                         Int
parity
                         a
towardzero_or_exact
                         a
awayfromzero

    !fDigits :: Int
fDigits = forall a. RealFloat a => a -> Int
floatDigits (forall a. HasCallStack => a
undefined :: a) -- 53 for Double
    (Int
_expMin, !Int
expMax) = forall a. RealFloat a => a -> (Int, Int)
floatRange (forall a. HasCallStack => a
undefined :: a) -- (-1021, 1024) for Double
{-# INLINABLE [0] positiveWordToBinaryFloatR# #-}
{-# SPECIALIZE
  positiveWordToBinaryFloatR# :: RoundingStrategy f => Bool -> Word# -> f Float
                               , RoundingStrategy f => Bool -> Word# -> f Double
                               , RealFloat a => Bool -> Word# -> RoundTiesToEven a
                               , RealFloat a => Bool -> Word# -> RoundTiesToAway a
                               , RealFloat a => Bool -> Word# -> RoundTowardPositive a
                               , RealFloat a => Bool -> Word# -> RoundTowardZero a
                               , RealFloat a => Bool -> Word# -> Product RoundTowardNegative RoundTowardPositive a
                               , Bool -> Word# -> RoundTiesToEven Float
                               , Bool -> Word# -> RoundTiesToAway Float
                               , Bool -> Word# -> RoundTowardPositive Float
                               , Bool -> Word# -> RoundTowardZero Float
                               , Bool -> Word# -> RoundTiesToEven Double
                               , Bool -> Word# -> RoundTiesToAway Double
                               , Bool -> Word# -> RoundTowardPositive Double
                               , Bool -> Word# -> RoundTowardZero Double
                               , Bool -> Word# -> Product RoundTowardNegative RoundTowardPositive Float
                               , Bool -> Word# -> Product RoundTowardNegative RoundTowardPositive Double
  #-}
{-# RULES
"positiveWordToBinaryFloatR#/RoundTowardNegative"
  positiveWordToBinaryFloatR# = \neg x -> RoundTowardNegative (roundTowardPositive (positiveWordToBinaryFloatR# (not neg) x))
  #-}

-- n > 0
fromPositiveIntegerR :: forall f a. (RealFloat a, RoundingStrategy f) => Bool -> Integer -> f a
fromPositiveIntegerR :: forall (f :: * -> *) a.
(RealFloat a, RoundingStrategy f) =>
Bool -> Integer -> f a
fromPositiveIntegerR !Bool
neg !Integer
n = forall a. HasCallStack => Bool -> a -> a
assert (Integer
n forall a. Ord a => a -> a -> Bool
> Integer
0) f a
result
  where
    result :: f a
result = let k :: Int
k = if Integer
base forall a. Eq a => a -> a -> Bool
== Integer
2 then
                       Integer -> Int
integerLog2' Integer
n
                     else
                       Integer -> Integer -> Int
integerLogBase' Integer
base Integer
n -- floor (logBase base n)
                 -- base^k <= n < base^(k+1)
             in if Int
k forall a. Ord a => a -> a -> Bool
< Int
fDigits then
                  forall (f :: * -> *) a. RoundingStrategy f => a -> f a
exact forall a b. (a -> b) -> a -> b
$ forall a. Num a => Integer -> a
fromInteger Integer
n
                else
                  if Int
k forall a. Ord a => a -> a -> Bool
>= Int
expMax then
                    -- overflow
                    let inf :: a
inf = a
1 forall a. Fractional a => a -> a -> a
/ a
0
                    in forall (f :: * -> *) a.
RoundingStrategy f =>
Ordering -> Bool -> Int -> a -> a -> f a
inexact Ordering
GT Bool
neg Int
1 forall a. RealFloat a => a
maxFinite a
inf
                  else
                    -- k >= fDigits
                    let e :: Int
e = Int
k forall a. Num a => a -> a -> a
- Int
fDigits forall a. Num a => a -> a -> a
+ Int
1
                        -- k >= e (assuming fDigits >= 1)
                        -- Therefore, base^e <= n
                        (Integer
q, Integer
r) = Integer -> Integer -> Int -> (Integer, Integer)
quotRemByExpt Integer
n Integer
base Int
e -- n `quotRem` (base^e)
                        -- base^(fDigits - 1) <= q < base^fDigits, 0 <= r < base^(k-fDigits+1)
                        towardzero_or_exact :: a
towardzero_or_exact = forall a. RealFloat a => Integer -> Int -> a
encodeFloat Integer
q Int
e
                        awayfromzero :: a
awayfromzero = forall a. RealFloat a => Integer -> Int -> a
encodeFloat (Integer
q forall a. Num a => a -> a -> a
+ Integer
1) Int
e
                        parity :: Int
parity = forall a. Num a => Integer -> a
fromInteger Integer
q :: Int
                    in forall (f :: * -> *) a.
RoundingStrategy f =>
Bool -> Ordering -> Bool -> Int -> a -> a -> f a
doRound
                         (Integer -> Integer -> Int -> Integer -> Bool
isDivisibleByExpt Integer
n Integer
base Int
e Integer
r) -- exactness (r == 0)
                         (Integer -> Integer -> Integer -> Int -> Ordering
compareWithExpt Integer
base Integer
n Integer
r (Int
e forall a. Num a => a -> a -> a
- Int
1))
                         -- (compare r (expt base (e - 1)))
                         Bool
neg
                         Int
parity
                         a
towardzero_or_exact
                         a
awayfromzero

    !base :: Integer
base = forall a. RealFloat a => a -> Integer
floatRadix (forall a. HasCallStack => a
undefined :: a) -- 2 or 10
    !fDigits :: Int
fDigits = forall a. RealFloat a => a -> Int
floatDigits (forall a. HasCallStack => a
undefined :: a) -- 53 for Double
    (Int
_expMin, !Int
expMax) = forall a. RealFloat a => a -> (Int, Int)
floatRange (forall a. HasCallStack => a
undefined :: a) -- (-1021, 1024) for Double
{-# INLINABLE [0] fromPositiveIntegerR #-}
{-# SPECIALIZE
  fromPositiveIntegerR :: RealFloat a => Bool -> Integer -> RoundTiesToEven a
                        , RealFloat a => Bool -> Integer -> RoundTiesToAway a
                        , RealFloat a => Bool -> Integer -> RoundTowardPositive a
                        , RealFloat a => Bool -> Integer -> RoundTowardZero a
                        , RealFloat a => Bool -> Integer -> Product RoundTowardNegative RoundTowardPositive a
                        , RoundingStrategy f => Bool -> Integer -> f Double
                        , RoundingStrategy f => Bool -> Integer -> f Float
                        , Bool -> Integer -> RoundTiesToEven Double
                        , Bool -> Integer -> RoundTiesToAway Double
                        , Bool -> Integer -> RoundTowardPositive Double
                        , Bool -> Integer -> RoundTowardZero Double
                        , Bool -> Integer -> RoundTiesToEven Float
                        , Bool -> Integer -> RoundTiesToAway Float
                        , Bool -> Integer -> RoundTowardPositive Float
                        , Bool -> Integer -> RoundTowardZero Float
                        , Bool -> Integer -> Product RoundTowardNegative RoundTowardPositive Double
                        , Bool -> Integer -> Product RoundTowardNegative RoundTowardPositive Float
  #-}
{-# RULES
"fromPositiveIntegerR/RoundTowardNegative"
  fromPositiveIntegerR = \neg x -> RoundTowardNegative (roundTowardPositive (fromPositiveIntegerR (not neg) x))
  #-}