    {-# 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 = RoundTiesToEven a -> a
    forall a. RoundTiesToEven a -> a
    roundTiesToEven (RoundTiesToEven a -> a)
    -> (Integer -> RoundTiesToEven a) -> Integer -> a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Integer -> RoundTiesToEven a
    forall a (f :: * -> *).
    (RealFloat a, RoundingStrategy f) =>
    Integer -> f a
    fromIntegerR
    fromIntegerTiesToAway :: forall a. RealFloat a => Integer -> a
    fromIntegerTiesToAway = RoundTiesToAway a -> a
    forall a. RoundTiesToAway a -> a
    roundTiesToAway (RoundTiesToAway a -> a)
    -> (Integer -> RoundTiesToAway a) -> Integer -> a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Integer -> RoundTiesToAway a
    forall a (f :: * -> *).
    (RealFloat a, RoundingStrategy f) =>
    Integer -> f a
    fromIntegerR
    fromIntegerTowardPositive :: forall a. RealFloat a => Integer -> a
    fromIntegerTowardPositive = RoundTowardPositive a -> a
    forall a. RoundTowardPositive a -> a
    roundTowardPositive (RoundTowardPositive a -> a)
    -> (Integer -> RoundTowardPositive a) -> Integer -> a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Integer -> RoundTowardPositive a
    forall a (f :: * -> *).
    (RealFloat a, RoundingStrategy f) =>
    Integer -> f a
    fromIntegerR
    fromIntegerTowardNegative :: forall a. RealFloat a => Integer -> a
    fromIntegerTowardNegative = RoundTowardNegative a -> a
    forall a. RoundTowardNegative a -> a
    roundTowardNegative (RoundTowardNegative a -> a)
    -> (Integer -> RoundTowardNegative a) -> Integer -> a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Integer -> RoundTowardNegative a
    forall a (f :: * -> *).
    (RealFloat a, RoundingStrategy f) =>
    Integer -> f a
    fromIntegerR
    fromIntegerTowardZero :: forall a. RealFloat a => Integer -> a
    fromIntegerTowardZero = RoundTowardZero a -> a
    forall a. RoundTowardZero a -> a
    roundTowardZero (RoundTowardZero a -> a)
    -> (Integer -> RoundTowardZero a) -> Integer -> a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Integer -> RoundTowardZero a
    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 = RoundTiesToEven a -> a
    forall a. RoundTiesToEven a -> a
    roundTiesToEven (RoundTiesToEven a -> a) -> (i -> RoundTiesToEven a) -> i -> a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . i -> RoundTiesToEven a
    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 = RoundTiesToAway a -> a
    forall a. RoundTiesToAway a -> a
    roundTiesToAway (RoundTiesToAway a -> a) -> (i -> RoundTiesToAway a) -> i -> a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . i -> RoundTiesToAway a
    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 = RoundTowardPositive a -> a
    forall a. RoundTowardPositive a -> a
    roundTowardPositive (RoundTowardPositive a -> a)
    -> (i -> RoundTowardPositive a) -> i -> a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . i -> RoundTowardPositive a
    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 = RoundTowardNegative a -> a
    forall a. RoundTowardNegative a -> a
    roundTowardNegative (RoundTowardNegative a -> a)
    -> (i -> RoundTowardNegative a) -> i -> a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . i -> RoundTowardNegative a
    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 = RoundTowardZero a -> a
    forall a. RoundTowardZero a -> a
    roundTowardZero (RoundTowardZero a -> a) -> (i -> RoundTowardZero a) -> i -> a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . i -> RoundTowardZero a
    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 -> Int -> f a
    forall i (f :: * -> *) a.
    (Integral i, Bits i, RealFloat a, RoundingStrategy f) =>
    i -> f a
    fromIntegralRBits Int
    x
                       Maybe Int
    Nothing | Integer
    n Integer -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    < Integer
    0 -> a -> a
    forall a. Num a => a -> a
    negate (a -> a) -> f a -> f a
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Bool -> Integer -> f a
    forall (f :: * -> *) a.
    (RealFloat a, RoundingStrategy f) =>
    Bool -> Integer -> f a
    fromPositiveIntegerR Bool
    True (- Integer
    n)
                               | Bool
    otherwise -> Bool -> Integer -> f a
    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 = Integer -> f a
    forall a (f :: * -> *).
    (RealFloat a, RoundingStrategy f) =>
    Integer -> f a
    fromIntegerR (i -> Integer
    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 = i -> a
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral i
    x
      , let (Maybe i
    min', Maybe i
    max') = Proxy a -> (Maybe i, Maybe i)
    forall a i.
    (Integral i, Bits i, RealFloat a) =>
    Proxy a -> (Maybe i, Maybe i)
    boundsForExactConversion (Proxy a
    forall {k} (t :: k). Proxy t
    Proxy :: Proxy a)
      , Bool -> (i -> Bool) -> Maybe i -> Bool
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Bool
    True (i -> i -> Bool
    forall a. Ord a => a -> a -> Bool
    <= i
    x) Maybe i
    min'
      , Bool -> (i -> Bool) -> Maybe i -> Bool
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Bool
    True (i
    x i -> i -> Bool
    forall a. Ord a => a -> a -> Bool
    <=) Maybe i
    max'
      = a -> f a
    forall a. a -> f a
    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 Integer -> Integer -> Bool
    forall a. Eq a => a -> a -> Bool
    == Integer
    2
      , Bool
    signed
      , Just Int
    y <- i -> Maybe Int
    forall a b.
    (Integral a, Integral b, Bits a, Bits b) =>
    a -> Maybe b
    toIntegralSized i
    x :: Maybe Int
      = if Int
    y Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    0 then
          a -> a
    forall a. Num a => a -> a
    negate (a -> a) -> f a -> f a
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Bool -> Word -> f a
    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
          Bool -> Word -> f a
    forall a (f :: * -> *).
    (RealFloat a, RoundingStrategy f) =>
    Bool -> Word -> f a
    positiveWordToBinaryFloatR Bool
    False (Int -> Word
    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 Integer -> Integer -> Bool
    forall a. Eq a => a -> a -> Bool
    == Integer
    2
      , Bool -> Bool
    not Bool
    signed
      , Just Word
    y <- i -> Maybe Word
    forall a b.
    (Integral a, Integral b, Bits a, Bits b) =>
    a -> Maybe b
    toIntegralSized i
    x :: Maybe Word
      = -- We can assume x /= 0
        Bool -> Word -> f a
    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 i -> i -> Bool
    forall a. Eq a => a -> a -> Bool
    == i
    0 = a -> f a
    forall a. a -> f a
    forall (f :: * -> *) a. RoundingStrategy f => a -> f a
    exact a
    0
               | i
    x i -> i -> Bool
    forall a. Ord a => a -> a -> Bool
    < i
    0 = a -> a
    forall a. Num a => a -> a
    negate (a -> a) -> f a -> f a
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Bool -> Integer -> f a
    forall (f :: * -> *) a.
    (RealFloat a, RoundingStrategy f) =>
    Bool -> Integer -> f a
    fromPositiveIntegerR Bool
    True (- i -> Integer
    forall a. Integral a => a -> Integer
    toInteger i
    x)
               | Bool
    otherwise = Bool -> Integer -> f a
    forall (f :: * -> *) a.
    (RealFloat a, RoundingStrategy f) =>
    Bool -> Integer -> f a
    fromPositiveIntegerR Bool
    False (i -> Integer
    forall a. Integral a => a -> Integer
    toInteger i
    x)
        signed :: Bool
    signed = i -> Bool
    forall a. Bits a => a -> Bool
    isSigned i
    x
        ieee :: Bool
    ieee = a -> Bool
    forall a. RealFloat a => a -> Bool
    isIEEE (a
    forall a. HasCallStack => a
    undefined :: a)
        base :: Integer
    base = a -> Integer
    forall a. RealFloat a => a -> Integer
    floatRadix (a
    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
    _ = Bool -> (Maybe i, Maybe i) -> (Maybe i, Maybe i)
    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 i -> Maybe Integer
    forall i. Bits i => i -> Maybe Integer
    minBoundAsInteger (i
    forall a. HasCallStack => a
    undefined :: i) of
                 Just Integer
    minBound' | Integer
    minInteger Integer -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Integer
    minBound' -> Maybe i
    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
    _ -> i -> Maybe i
    forall a. a -> Maybe a
    Just (Integer -> i
    forall a. Num a => Integer -> a
    fromInteger Integer
    minInteger)
        maxI :: Maybe i
    maxI = case i -> Maybe Integer
    forall i. Bits i => i -> Maybe Integer
    maxBoundAsInteger (i
    forall a. HasCallStack => a
    undefined :: i) of
                 Just Integer
    maxBound' | Integer
    maxBound' Integer -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Integer
    maxInteger -> Maybe i
    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
    _ -> i -> Maybe i
    forall a. a -> Maybe a
    Just (Integer -> i
    forall a. Num a => Integer -> a
    fromInteger Integer
    maxInteger)
        ieee :: Bool
    ieee = a -> Bool
    forall a. RealFloat a => a -> Bool
    isIEEE (a
    forall a. HasCallStack => a
    undefined :: a)
        base :: Integer
    base = a -> Integer
    forall a. RealFloat a => a -> Integer
    floatRadix (a
    forall a. HasCallStack => a
    undefined :: a)
        digits :: Int
    digits = a -> Int
    forall a. RealFloat a => a -> Int
    floatDigits (a
    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 i -> Bool
    forall a. Bits a => a -> Bool
    isSigned i
    dummyI then
                                 case i -> Maybe Int
    forall a. Bits a => a -> Maybe Int
    bitSizeMaybe i
    dummyI of
                                   Just Int
    bits -> Integer -> Maybe Integer
    forall a. a -> Maybe a
    Just (- Int -> Integer
    forall a. Bits a => Int -> a
    bit (Int
    bitsInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    1))
                                   Maybe Int
    Nothing   -> Maybe Integer
    forall a. Maybe a
    Nothing
                               else
                                 Integer -> Maybe Integer
    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 i -> Maybe Int
    forall a. Bits a => a -> Maybe Int
    bitSizeMaybe i
    dummyI of
                                 Just Int
    bits | i -> Bool
    forall a. Bits a => a -> Bool
    isSigned i
    dummyI -> Integer -> Maybe Integer
    forall a. a -> Maybe a
    Just (Int -> Integer
    forall a. Bits a => Int -> a
    bit (Int
    bitsInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    1) Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    - Integer
    1)
                                           | Bool
    otherwise -> Integer -> Maybe Integer
    forall a. a -> Maybe a
    Just (Int -> Integer
    forall a. Bits a => Int -> a
    bit Int
    bits Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    - Integer
    1)
                                 Maybe Int
    Nothing -> Maybe Integer
    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#) = Bool -> Word# -> f a
    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 Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    fDigits then
                      a -> f a
    forall a. a -> f a
    forall (f :: * -> *) a. RoundingStrategy f => a -> f a
    exact (a -> f a) -> a -> f a
    forall a b. (a -> b) -> a -> b
    $ Word -> a
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word
    n
                    else
                      -- expMax <= k implies expMax <= finiteBitSize n - 1
                      if Int
    expMax Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Word -> Int
    forall b. FiniteBits b => b -> Int
    finiteBitSize Word
    n Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1 Bool -> Bool -> Bool
    && Int
    k Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    expMax then
                        -- overflow
                        let inf :: a
    inf = a
    1 a -> a -> a
    forall a. Fractional a => a -> a -> a
    / a
    0
                        in Ordering -> Bool -> Int -> a -> a -> f a
    forall a. Ordering -> Bool -> Int -> a -> a -> f a
    forall (f :: * -> *) a.
    RoundingStrategy f =>
    Ordering -> Bool -> Int -> a -> a -> f a
    inexact Ordering
    GT Bool
    neg Int
    1 a
    forall a. RealFloat a => a
    maxFinite a
    inf
                      else
                        -- k >= fDigits
                        let e :: Int
    e = Int
    k Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    fDigits Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1 -- 1 <= e <= finiteBitSize n - fDigits
                            q :: Word
    q = Word
    n Word -> Int -> Word
    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 Word -> Word -> Word
    forall a. Bits a => a -> a -> a
    .&. ((Word
    1 Word -> Int -> Word
    forall a. Bits a => a -> Int -> a
    `unsafeShiftL` Int
    e) Word -> Word -> Word
    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 = Word -> a
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word
    q Word -> Int -> Word
    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 Word -> Word -> Word
    forall a. Num a => a -> a -> a
    + Word
    1 Word -> Word -> Bool
    forall a. Eq a => a -> a -> Bool
    == (Word
    1 Word -> Int -> Word
    forall a. Bits a => a -> Int -> a
    `unsafeShiftL` Int
    fDigits) Bool -> Bool -> Bool
    && Int
    k Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Word -> Int
    forall b. FiniteBits b => b -> Int
    finiteBitSize Word
    n Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1 then
                                             -- (q + 1) `shiftL` e = 2^(fDigits + e) = 2^(k+1) = 2^(finiteBitSize n)
                                             Integer -> Int -> a
    forall a. RealFloat a => Integer -> Int -> a
    encodeFloat Integer
    1 (Word -> Int
    forall b. FiniteBits b => b -> Int
    finiteBitSize Word
    n)
                                           else
                                             Word -> a
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral ((Word
    q Word -> Word -> Word
    forall a. Num a => a -> a -> a
    + Word
    1) Word -> Int -> Word
    forall a. Bits a => a -> Int -> a
    `unsafeShiftL` Int
    e)
                            parity :: Int
    parity = Word -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word
    q :: Int
                        in Bool -> Ordering -> Bool -> Int -> a -> a -> f a
    forall a. Bool -> Ordering -> Bool -> Int -> a -> a -> f a
    forall (f :: * -> *) a.
    RoundingStrategy f =>
    Bool -> Ordering -> Bool -> Int -> a -> a -> f a
    doRound
                             (Word
    r Word -> Word -> Bool
    forall a. Eq a => a -> a -> Bool
    == Word
    0) -- exactness
                             (Word -> Word -> Ordering
    forall a. Ord a => a -> a -> Ordering
    compare Word
    r (Word
    1 Word -> Int -> Word
    forall a. Bits a => a -> Int -> a
    `unsafeShiftL` (Int
    e Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1)))
                             Bool
    neg
                             Int
    parity
                             a
    towardzero_or_exact
                             a
    awayfromzero

        !fDigits :: Int
    fDigits = a -> Int
    forall a. RealFloat a => a -> Int
    floatDigits (a
    forall a. HasCallStack => a
    undefined :: a) -- 53 for Double
        (Int
    _expMin, !Int
    expMax) = a -> (Int, Int)
    forall a. RealFloat a => a -> (Int, Int)
    floatRange (a
    forall a. HasCallStack => a
    undefined :: a) -- (-1021, 1024) for Double
    {-# INLINABLE [0] positiveWordToBinaryFloatR# #-}
    {-# SPECIALIZE positiveWordToBinaryFloatR# :: RoundingStrategy f => Bool -> Word# -> f Float #-}
    {-# SPECIALIZE positiveWordToBinaryFloatR# :: RoundingStrategy f => Bool -> Word# -> f Double #-}
    {-# SPECIALIZE positiveWordToBinaryFloatR# :: RealFloat a => Bool -> Word# -> RoundTiesToEven a #-}
    {-# SPECIALIZE positiveWordToBinaryFloatR# :: RealFloat a => Bool -> Word# -> RoundTiesToAway a #-}
    {-# SPECIALIZE positiveWordToBinaryFloatR# :: RealFloat a => Bool -> Word# -> RoundTowardPositive a #-}
    {-# SPECIALIZE positiveWordToBinaryFloatR# :: RealFloat a => Bool -> Word# -> RoundTowardZero a #-}
    {-# SPECIALIZE positiveWordToBinaryFloatR# :: RealFloat a => Bool -> Word# -> Product RoundTowardNegative RoundTowardPositive a #-}
    {-# SPECIALIZE positiveWordToBinaryFloatR# :: Bool -> Word# -> RoundTiesToEven Float #-}
    {-# SPECIALIZE positiveWordToBinaryFloatR# :: Bool -> Word# -> RoundTiesToAway Float #-}
    {-# SPECIALIZE positiveWordToBinaryFloatR# :: Bool -> Word# -> RoundTowardPositive Float #-}
    {-# SPECIALIZE positiveWordToBinaryFloatR# :: Bool -> Word# -> RoundTowardZero Float #-}
    {-# SPECIALIZE positiveWordToBinaryFloatR# :: Bool -> Word# -> RoundTiesToEven Double #-}
    {-# SPECIALIZE positiveWordToBinaryFloatR# :: Bool -> Word# -> RoundTiesToAway Double #-}
    {-# SPECIALIZE positiveWordToBinaryFloatR# :: Bool -> Word# -> RoundTowardPositive Double #-}
    {-# SPECIALIZE positiveWordToBinaryFloatR# :: Bool -> Word# -> RoundTowardZero Double #-}
    {-# SPECIALIZE positiveWordToBinaryFloatR# :: Bool -> Word# -> Product RoundTowardNegative RoundTowardPositive Float #-}
    {-# SPECIALIZE positiveWordToBinaryFloatR# :: 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 = Bool -> f a -> f a
    forall a. HasCallStack => Bool -> a -> a
    assert (Integer
    n Integer -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    > Integer
    0) f a
    result
      where
        result :: f a
    result = let k :: Int
    k = if Integer
    base Integer -> Integer -> Bool
    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 Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    fDigits then
                      a -> f a
    forall a. a -> f a
    forall (f :: * -> *) a. RoundingStrategy f => a -> f a
    exact (a -> f a) -> a -> f a
    forall a b. (a -> b) -> a -> b
    $ Integer -> a
    forall a. Num a => Integer -> a
    fromInteger Integer
    n
                    else
                      if Int
    k Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    expMax then
                        -- overflow
                        let inf :: a
    inf = a
    1 a -> a -> a
    forall a. Fractional a => a -> a -> a
    / a
    0
                        in Ordering -> Bool -> Int -> a -> a -> f a
    forall a. Ordering -> Bool -> Int -> a -> a -> f a
    forall (f :: * -> *) a.
    RoundingStrategy f =>
    Ordering -> Bool -> Int -> a -> a -> f a
    inexact Ordering
    GT Bool
    neg Int
    1 a
    forall a. RealFloat a => a
    maxFinite a
    inf
                      else
                        -- k >= fDigits
                        let e :: Int
    e = Int
    k Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    fDigits Int -> Int -> Int
    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 = Integer -> Int -> a
    forall a. RealFloat a => Integer -> Int -> a
    encodeFloat Integer
    q Int
    e
                            awayfromzero :: a
    awayfromzero = Integer -> Int -> a
    forall a. RealFloat a => Integer -> Int -> a
    encodeFloat (Integer
    q Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    + Integer
    1) Int
    e
                            parity :: Int
    parity = Integer -> Int
    forall a. Num a => Integer -> a
    fromInteger Integer
    q :: Int
                        in Bool -> Ordering -> Bool -> Int -> a -> a -> f a
    forall a. Bool -> Ordering -> Bool -> Int -> a -> a -> f a
    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 Int -> Int -> Int
    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 = a -> Integer
    forall a. RealFloat a => a -> Integer
    floatRadix (a
    forall a. HasCallStack => a
    undefined :: a) -- 2 or 10
        !fDigits :: Int
    fDigits = a -> Int
    forall a. RealFloat a => a -> Int
    floatDigits (a
    forall a. HasCallStack => a
    undefined :: a) -- 53 for Double
        (Int
    _expMin, !Int
    expMax) = a -> (Int, Int)
    forall a. RealFloat a => a -> (Int, Int)
    floatRange (a
    forall a. HasCallStack => a
    undefined :: a) -- (-1021, 1024) for Double
    {-# INLINABLE [0] fromPositiveIntegerR #-}
    {-# SPECIALIZE fromPositiveIntegerR :: RealFloat a => Bool -> Integer -> RoundTiesToEven a #-}
    {-# SPECIALIZE fromPositiveIntegerR :: RealFloat a => Bool -> Integer -> RoundTiesToAway a #-}
    {-# SPECIALIZE fromPositiveIntegerR :: RealFloat a => Bool -> Integer -> RoundTowardPositive a #-}
    {-# SPECIALIZE fromPositiveIntegerR :: RealFloat a => Bool -> Integer -> RoundTowardZero a #-}
    {-# SPECIALIZE fromPositiveIntegerR :: RealFloat a => Bool -> Integer -> Product RoundTowardNegative RoundTowardPositive a #-}
    {-# SPECIALIZE fromPositiveIntegerR :: RoundingStrategy f => Bool -> Integer -> f Double #-}
    {-# SPECIALIZE fromPositiveIntegerR :: RoundingStrategy f => Bool -> Integer -> f Float #-}
    {-# SPECIALIZE fromPositiveIntegerR :: Bool -> Integer -> RoundTiesToEven Double #-}
    {-# SPECIALIZE fromPositiveIntegerR :: Bool -> Integer -> RoundTiesToAway Double #-}
    {-# SPECIALIZE fromPositiveIntegerR :: Bool -> Integer -> RoundTowardPositive Double #-}
    {-# SPECIALIZE fromPositiveIntegerR :: Bool -> Integer -> RoundTowardZero Double #-}
    {-# SPECIALIZE fromPositiveIntegerR :: Bool -> Integer -> RoundTiesToEven Float #-}
    {-# SPECIALIZE fromPositiveIntegerR :: Bool -> Integer -> RoundTiesToAway Float #-}
    {-# SPECIALIZE fromPositiveIntegerR :: Bool -> Integer -> RoundTowardPositive Float #-}
    {-# SPECIALIZE fromPositiveIntegerR :: Bool -> Integer -> RoundTowardZero Float #-}
    {-# SPECIALIZE fromPositiveIntegerR :: Bool -> Integer -> Product RoundTowardNegative RoundTowardPositive Double #-}
    {-# SPECIALIZE fromPositiveIntegerR :: Bool -> Integer -> Product RoundTowardNegative RoundTowardPositive Float #-}
    {-# RULES
    "fromPositiveIntegerR/RoundTowardNegative"
      fromPositiveIntegerR = \neg x -> RoundTowardNegative (roundTowardPositive (fromPositiveIntegerR (not neg) x))
      #-}