    {-# LANGUAGE BangPatterns #-}
    {-# LANGUAGE MagicHash #-}
    {-# LANGUAGE NoImplicitPrelude #-}
    {-# LANGUAGE ScopedTypeVariables #-}
    module Numeric.Floating.IEEE.Internal.Rounding.Encode where
    import           Control.Exception (assert)
    import           Data.Functor.Product
    import           Data.Int
    import           GHC.Exts
    import           Math.NumberTheory.Logarithms (integerLog2', integerLogBase')
    import           MyPrelude
    import           Numeric.Floating.IEEE.Internal.Base
    import           Numeric.Floating.IEEE.Internal.Classify (isFinite)
    import           Numeric.Floating.IEEE.Internal.Rounding.Common

    default ()

    encodeFloatTiesToEven, encodeFloatTiesToAway, encodeFloatTowardPositive, encodeFloatTowardNegative, encodeFloatTowardZero :: RealFloat a => Integer -> Int -> a
    encodeFloatTiesToEven :: forall a. RealFloat a => Integer -> Int -> a
    encodeFloatTiesToEven Integer
    m = RoundTiesToEven a -> a
    forall a. RoundTiesToEven a -> a
    roundTiesToEven (RoundTiesToEven a -> a) -> (Int -> RoundTiesToEven a) -> Int -> a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Integer -> Int -> RoundTiesToEven a
    forall a (f :: * -> *).
    (RealFloat a, RoundingStrategy f) =>
    Integer -> Int -> f a
    encodeFloatR Integer
    m
    encodeFloatTiesToAway :: forall a. RealFloat a => Integer -> Int -> a
    encodeFloatTiesToAway Integer
    m = RoundTiesToAway a -> a
    forall a. RoundTiesToAway a -> a
    roundTiesToAway (RoundTiesToAway a -> a) -> (Int -> RoundTiesToAway a) -> Int -> a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Integer -> Int -> RoundTiesToAway a
    forall a (f :: * -> *).
    (RealFloat a, RoundingStrategy f) =>
    Integer -> Int -> f a
    encodeFloatR Integer
    m
    encodeFloatTowardPositive :: forall a. RealFloat a => Integer -> Int -> a
    encodeFloatTowardPositive Integer
    m = RoundTowardPositive a -> a
    forall a. RoundTowardPositive a -> a
    roundTowardPositive (RoundTowardPositive a -> a)
    -> (Int -> RoundTowardPositive a) -> Int -> a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Integer -> Int -> RoundTowardPositive a
    forall a (f :: * -> *).
    (RealFloat a, RoundingStrategy f) =>
    Integer -> Int -> f a
    encodeFloatR Integer
    m
    encodeFloatTowardNegative :: forall a. RealFloat a => Integer -> Int -> a
    encodeFloatTowardNegative Integer
    m = RoundTowardNegative a -> a
    forall a. RoundTowardNegative a -> a
    roundTowardNegative (RoundTowardNegative a -> a)
    -> (Int -> RoundTowardNegative a) -> Int -> a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Integer -> Int -> RoundTowardNegative a
    forall a (f :: * -> *).
    (RealFloat a, RoundingStrategy f) =>
    Integer -> Int -> f a
    encodeFloatR Integer
    m
    encodeFloatTowardZero :: forall a. RealFloat a => Integer -> Int -> a
    encodeFloatTowardZero Integer
    m = RoundTowardZero a -> a
    forall a. RoundTowardZero a -> a
    roundTowardZero (RoundTowardZero a -> a) -> (Int -> RoundTowardZero a) -> Int -> a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Integer -> Int -> RoundTowardZero a
    forall a (f :: * -> *).
    (RealFloat a, RoundingStrategy f) =>
    Integer -> Int -> f a
    encodeFloatR Integer
    m
    {-# INLINE encodeFloatTiesToEven #-}
    {-# INLINE encodeFloatTiesToAway #-}
    {-# INLINE encodeFloatTowardPositive #-}
    {-# INLINE encodeFloatTowardNegative #-}
    {-# INLINE encodeFloatTowardZero #-}

    encodeFloatR :: (RealFloat a, RoundingStrategy f) => Integer -> Int -> f a
    encodeFloatR :: forall a (f :: * -> *).
    (RealFloat a, RoundingStrategy f) =>
    Integer -> Int -> f a
    encodeFloatR Integer
    0 !Int
    _ = a -> f a
    forall a. a -> f a
    forall (f :: * -> *) a. RoundingStrategy f => a -> f a
    exact a
    0
    encodeFloatR Integer
    m Int
    n | Integer
    m 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 -> Int -> f a
    forall a (f :: * -> *).
    (RealFloat a, RoundingStrategy f) =>
    Bool -> Integer -> Int -> f a
    encodePositiveFloatR Bool
    True (- Integer
    m) Int
    n
                     | Bool
    otherwise = Bool -> Integer -> Int -> f a
    forall a (f :: * -> *).
    (RealFloat a, RoundingStrategy f) =>
    Bool -> Integer -> Int -> f a
    encodePositiveFloatR Bool
    False Integer
    m Int
    n
    {-# INLINE encodeFloatR #-}

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

    encodePositiveFloatR# :: forall f a. (RealFloat a, RoundingStrategy f) => Bool -> Integer -> Int# -> f a
    encodePositiveFloatR# :: forall (f :: * -> *) a.
    (RealFloat a, RoundingStrategy f) =>
    Bool -> Integer -> Int# -> f a
    encodePositiveFloatR# !Bool
    neg !Integer
    m Int#
    n# = Bool -> f a -> f a
    forall a. (?callStack::CallStack) => Bool -> a -> a
    assert (Integer
    m Integer -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    > Integer
    0) f a
    result
      where
        n :: Int
    n = Int# -> Int
    I# Int#
    n#
        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
    m
                         else
                           Integer -> Integer -> Int
    integerLogBase' Integer
    base Integer
    m
                     -- base^k <= m < base^(k+1)
                     -- base^^(k+n) <= m * base^^n < base^^(k+n+1)
                 in if Int
    expMin Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    k Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    n Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1 Bool -> Bool -> Bool
    && Int
    k Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    n Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1 Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    expMax then
                      -- normal
                      -- base^(fDigits-1) <= m / base^(k-fDigits+1) < base^fDigits
                      if Int
    k Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    fDigits then
                        -- m < base^(k+1) <= base^fDigits
                        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 -> Int -> a
    forall a. RealFloat a => Integer -> Int -> a
    encodeFloat Integer
    m Int
    n
                      else
                        -- k >= fDigits
                        let (Integer
    q,Integer
    r) = Integer -> Integer -> Int -> (Integer, Integer)
    quotRemByExpt Integer
    m Integer
    base (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)
                            -- m = q * base^^(k-fDigits+1) + r
                            -- base^(fDigits-1) <= q = m `quot` (base^^(k-fDigits+1)) < base^fDigits
                            -- m * base^^n = q * base^^(n+k-fDigits+1) + r * base^^n
                            towardzero_or_exact :: a
    towardzero_or_exact = Integer -> Int -> a
    forall a. RealFloat a => Integer -> Int -> a
    encodeFloat Integer
    q (Int
    n Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + 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)
                            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
    n Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + 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)
                            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
    m Integer
    base (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) Integer
    r) -- exactness (r == 0)
                             (Integer -> Integer -> Integer -> Int -> Ordering
    compareWithExpt Integer
    base Integer
    m Integer
    r (Int
    k Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    fDigits))
                             -- (compare r (expt base (k - fDigits)))
                             Bool
    neg
                             Int
    parity
                             a
    towardzero_or_exact
                             a
    awayfromzero
                    else
                      if Int
    expMax Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    k Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    n 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 + n + 1 < expMin
                        -- subnormal
                        if Int
    expMin Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    fDigits Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    n then
                          -- k <= expMin - n <= fDigits
                          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 -> Int -> a
    forall a. RealFloat a => Integer -> Int -> a
    encodeFloat Integer
    m Int
    n
                        else -- n < expMin - fDigits
                          -- k <= expMin - n, fDigits < expMin - n
                          let (Integer
    q,Integer
    r) = Integer -> Integer -> Int -> (Integer, Integer)
    quotRemByExpt Integer
    m Integer
    base (Int
    expMin Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    fDigits Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    n)
                              -- m = q * base^(expMin-fDigits-n) + r
                              -- q <= m * base^^(n-expMin+fDigits) < q+1
                              -- q * base^^(expMin-fDigits) <= m * base^^n < (q+1) * base^^(expMin-fDigits)
                              !()
    _ = Bool -> () -> ()
    forall a. (?callStack::CallStack) => Bool -> a -> a
    assert (Integer -> Rational
    forall a. Real a => a -> Rational
    toRational Integer
    q Rational -> Rational -> Rational
    forall a. Num a => a -> a -> a
    * Integer -> Rational
    forall a. Real a => a -> Rational
    toRational Integer
    baseRational -> Int -> Rational
    forall a b. (Fractional a, Integral b) => a -> b -> a
    ^^(Int
    expMinInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    fDigits) Rational -> Rational -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Integer -> Rational
    forall a. Real a => a -> Rational
    toRational Integer
    m Rational -> Rational -> Rational
    forall a. Num a => a -> a -> a
    * Integer -> Rational
    forall a. Real a => a -> Rational
    toRational Integer
    baseRational -> Int -> Rational
    forall a b. (Fractional a, Integral b) => a -> b -> a
    ^^Int
    n) ()
                              !()
    _ = Bool -> () -> ()
    forall a. (?callStack::CallStack) => Bool -> a -> a
    assert (Integer -> Rational
    forall a. Real a => a -> Rational
    toRational Integer
    m Rational -> Rational -> Rational
    forall a. Num a => a -> a -> a
    * Integer -> Rational
    forall a. Real a => a -> Rational
    toRational Integer
    baseRational -> Int -> Rational
    forall a b. (Fractional a, Integral b) => a -> b -> a
    ^^Int
    n Rational -> Rational -> Bool
    forall a. Ord a => a -> a -> Bool
    < Integer -> Rational
    forall a. Real a => a -> Rational
    toRational (Integer
    qInteger -> Integer -> Integer
    forall a. Num a => a -> a -> a
    +Integer
    1) Rational -> Rational -> Rational
    forall a. Num a => a -> a -> a
    * Integer -> Rational
    forall a. Real a => a -> Rational
    toRational Integer
    baseRational -> Int -> Rational
    forall a b. (Fractional a, Integral b) => a -> b -> a
    ^^(Int
    expMinInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    fDigits)) ()
                              towardzero_or_exact :: a
    towardzero_or_exact = Integer -> Int -> a
    forall a. RealFloat a => Integer -> Int -> a
    encodeFloat Integer
    q (Int
    expMin Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    fDigits)
                              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
    expMin Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    fDigits)
                              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
    m Integer
    base (Int
    expMin Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    fDigits Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    n) Integer
    r) -- exactness (r == 0)
                               (Integer -> Integer -> Integer -> Int -> Ordering
    compareWithExpt Integer
    base Integer
    m Integer
    r (Int
    expMin Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    fDigits Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    n Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1))
                               -- (compare r (expt base (expMin - fDigits - n - 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. (?callStack::CallStack) => a
    undefined :: a)
        !fDigits :: Int
    fDigits = a -> Int
    forall a. RealFloat a => a -> Int
    floatDigits (a
    forall a. (?callStack::CallStack) => a
    undefined :: a) -- 53 for Double
        (!Int
    expMin, !Int
    expMax) = a -> (Int, Int)
    forall a. RealFloat a => a -> (Int, Int)
    floatRange (a
    forall a. (?callStack::CallStack) => a
    undefined :: a) -- (-1021, 1024) for Double
    {-# INLINABLE [0] encodePositiveFloatR# #-}
    {-# SPECIALIZE encodePositiveFloatR# :: RealFloat a => Bool -> Integer -> Int# -> RoundTiesToEven a #-}
    {-# SPECIALIZE encodePositiveFloatR# :: RealFloat a => Bool -> Integer -> Int# -> RoundTiesToAway a #-}
    {-# SPECIALIZE encodePositiveFloatR# :: RealFloat a => Bool -> Integer -> Int# -> RoundTowardPositive a #-}
    {-# SPECIALIZE encodePositiveFloatR# :: RealFloat a => Bool -> Integer -> Int# -> RoundTowardZero a #-}
    {-# SPECIALIZE encodePositiveFloatR# :: RealFloat a => Bool -> Integer -> Int# -> Product RoundTowardNegative RoundTowardPositive a #-}
    {-# SPECIALIZE encodePositiveFloatR# :: RoundingStrategy f => Bool -> Integer -> Int# -> f Double #-}
    {-# SPECIALIZE encodePositiveFloatR# :: RoundingStrategy f => Bool -> Integer -> Int# -> f Float #-}
    {-# SPECIALIZE encodePositiveFloatR# :: Bool -> Integer -> Int# -> RoundTiesToEven Double #-}
    {-# SPECIALIZE encodePositiveFloatR# :: Bool -> Integer -> Int# -> RoundTiesToAway Double #-}
    {-# SPECIALIZE encodePositiveFloatR# :: Bool -> Integer -> Int# -> RoundTowardPositive Double #-}
    {-# SPECIALIZE encodePositiveFloatR# :: Bool -> Integer -> Int# -> RoundTowardZero Double #-}
    {-# SPECIALIZE encodePositiveFloatR# :: Bool -> Integer -> Int# -> RoundTiesToEven Float #-}
    {-# SPECIALIZE encodePositiveFloatR# :: Bool -> Integer -> Int# -> RoundTiesToAway Float #-}
    {-# SPECIALIZE encodePositiveFloatR# :: Bool -> Integer -> Int# -> RoundTowardPositive Float #-}
    {-# SPECIALIZE encodePositiveFloatR# :: Bool -> Integer -> Int# -> RoundTowardZero Float #-}
    {-# SPECIALIZE encodePositiveFloatR# :: Bool -> Integer -> Int# -> Product RoundTowardNegative RoundTowardPositive Double #-}
    {-# SPECIALIZE encodePositiveFloatR# :: Bool -> Integer -> Int# -> Product RoundTowardNegative RoundTowardPositive Float #-}
    {-# RULES
    "encodePositiveFloatR#/RoundTowardNegative"
      encodePositiveFloatR# = \neg x y -> RoundTowardNegative (roundTowardPositive (encodePositiveFloatR# (not neg) x y))
      #-}

    -- |
    -- IEEE 754 @scaleB@ operation, with each rounding attributes.
    scaleFloatTiesToEven, scaleFloatTiesToAway, scaleFloatTowardPositive, scaleFloatTowardNegative, scaleFloatTowardZero :: RealFloat a => Int -> a -> a
    scaleFloatTiesToEven :: forall a. RealFloat a => Int -> a -> a
    scaleFloatTiesToEven Int
    e = RoundTiesToEven a -> a
    forall a. RoundTiesToEven a -> a
    roundTiesToEven (RoundTiesToEven a -> a) -> (a -> RoundTiesToEven a) -> a -> a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> a -> RoundTiesToEven a
    forall a (f :: * -> *).
    (RealFloat a, RoundingStrategy f) =>
    Int -> a -> f a
    scaleFloatR Int
    e
    scaleFloatTiesToAway :: forall a. RealFloat a => Int -> a -> a
    scaleFloatTiesToAway Int
    e = RoundTiesToAway a -> a
    forall a. RoundTiesToAway a -> a
    roundTiesToAway (RoundTiesToAway a -> a) -> (a -> RoundTiesToAway a) -> a -> a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> a -> RoundTiesToAway a
    forall a (f :: * -> *).
    (RealFloat a, RoundingStrategy f) =>
    Int -> a -> f a
    scaleFloatR Int
    e
    scaleFloatTowardPositive :: forall a. RealFloat a => Int -> a -> a
    scaleFloatTowardPositive Int
    e = RoundTowardPositive a -> a
    forall a. RoundTowardPositive a -> a
    roundTowardPositive (RoundTowardPositive a -> a)
    -> (a -> RoundTowardPositive a) -> a -> a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> a -> RoundTowardPositive a
    forall a (f :: * -> *).
    (RealFloat a, RoundingStrategy f) =>
    Int -> a -> f a
    scaleFloatR Int
    e
    scaleFloatTowardNegative :: forall a. RealFloat a => Int -> a -> a
    scaleFloatTowardNegative Int
    e = RoundTowardNegative a -> a
    forall a. RoundTowardNegative a -> a
    roundTowardNegative (RoundTowardNegative a -> a)
    -> (a -> RoundTowardNegative a) -> a -> a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> a -> RoundTowardNegative a
    forall a (f :: * -> *).
    (RealFloat a, RoundingStrategy f) =>
    Int -> a -> f a
    scaleFloatR Int
    e
    scaleFloatTowardZero :: forall a. RealFloat a => Int -> a -> a
    scaleFloatTowardZero Int
    e = RoundTowardZero a -> a
    forall a. RoundTowardZero a -> a
    roundTowardZero (RoundTowardZero a -> a) -> (a -> RoundTowardZero a) -> a -> a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> a -> RoundTowardZero a
    forall a (f :: * -> *).
    (RealFloat a, RoundingStrategy f) =>
    Int -> a -> f a
    scaleFloatR Int
    e
    {-# INLINE scaleFloatTiesToEven #-}
    {-# INLINE scaleFloatTiesToAway #-}
    {-# INLINE scaleFloatTowardPositive #-}
    {-# INLINE scaleFloatTowardNegative #-}
    {-# INLINE scaleFloatTowardZero #-}

    scaleFloatR :: (RealFloat a, RoundingStrategy f) => Int -> a -> f a
    scaleFloatR :: forall a (f :: * -> *).
    (RealFloat a, RoundingStrategy f) =>
    Int -> a -> f a
    scaleFloatR (I# Int#
    e#) a
    x = Int# -> a -> f a
    forall a (f :: * -> *).
    (RealFloat a, RoundingStrategy f) =>
    Int# -> a -> f a
    scaleFloatR# Int#
    e# a
    x
    {-# INLINE scaleFloatR #-}

    scaleFloatR# :: (RealFloat a, RoundingStrategy f) => Int# -> a -> f a
    scaleFloatR# :: forall a (f :: * -> *).
    (RealFloat a, RoundingStrategy f) =>
    Int# -> a -> f a
    scaleFloatR# Int#
    e# a
    x
      | a
    x a -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    /= a
    0, a -> Bool
    forall a. RealFloat a => a -> Bool
    isFinite a
    x =
          let e :: Int
    e = Int# -> Int
    I# Int#
    e#
              (Integer
    m,Int
    n) = a -> (Integer, Int)
    forall a. RealFloat a => a -> (Integer, Int)
    decodeFloat a
    x
              -- x = m * base^^n, expMin <= n <= expMax
              -- base^(fDigits-1) <= abs m < base^fDigits
              -- base^(fDigits+n+e-1) <= abs x * base^^e < base^(fDigits+n+e)
          in if Int
    expMin Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    fDigits Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    n Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    e Bool -> Bool -> Bool
    && Int
    n Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    e Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    expMax Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    fDigits then
               -- normal
               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 -> Int -> a
    forall a. RealFloat a => Integer -> Int -> a
    encodeFloat Integer
    m (Int
    n Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    e)
             else
               if Int
    expMax Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    fDigits Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    n Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    e then
                 -- infinity
                 (a -> a
    forall a. Num a => a -> a
    signum a
    x a -> a -> a
    forall a. Num a => a -> a -> a
    *) (a -> a) -> f a -> f a
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> 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 (a
    x a -> a -> Bool
    forall a. Ord a => a -> a -> Bool
    < a
    0) Int
    1 a
    forall a. RealFloat a => a
    maxFinite (a
    1 a -> a -> a
    forall a. Fractional a => a -> a -> a
    / a
    0)
               else
                 -- subnormal
                 let !()
    _ = Bool -> () -> ()
    forall a. (?callStack::CallStack) => Bool -> a -> a
    assert (Int
    e Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    n Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    expMin Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    fDigits) ()
                     m' :: Integer
    m' = Integer -> Integer
    forall a. Num a => a -> a
    abs Integer
    m
                     (Integer
    q,Integer
    r) = Integer -> Integer -> Int -> (Integer, Integer)
    quotRemByExpt Integer
    m' Integer
    base (Int
    expMin Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    fDigits Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - (Int
    e Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    n))
                     towardzero_or_exact :: a
    towardzero_or_exact = Integer -> Int -> a
    forall a. RealFloat a => Integer -> Int -> a
    encodeFloat Integer
    q (Int
    expMin Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    fDigits)
                     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
    expMin Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    fDigits)
                     parity :: Int
    parity = Integer -> Int
    forall a. Num a => Integer -> a
    fromInteger Integer
    q :: Int
                 in (a -> a
    forall a. Num a => a -> a
    signum a
    x a -> a -> a
    forall a. Num a => a -> a -> a
    *) (a -> a) -> f a -> f a
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> 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
    m' Integer
    base (Int
    expMin Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    fDigits Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - (Int
    e Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    n)) Integer
    r)
                      (Integer -> Integer -> Integer -> Int -> Ordering
    compareWithExpt Integer
    base Integer
    m' Integer
    r (Int
    expMin Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    fDigits Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - (Int
    e Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    n) Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1))
                      (a
    x a -> a -> Bool
    forall a. Ord a => a -> a -> Bool
    < a
    0)
                      Int
    parity
                      a
    towardzero_or_exact
                      a
    awayfromzero
      | Bool
    otherwise = a -> f a
    forall a. a -> f a
    forall (f :: * -> *) a. RoundingStrategy f => a -> f a
    exact (a
    x a -> a -> a
    forall a. Num a => a -> a -> a
    + a
    x) -- +-0, +-Infinity, NaN
      where
        base :: Integer
    base = a -> Integer
    forall a. RealFloat a => a -> Integer
    floatRadix a
    x
        (Int
    expMin,Int
    expMax) = a -> (Int, Int)
    forall a. RealFloat a => a -> (Int, Int)
    floatRange a
    x
        fDigits :: Int
    fDigits = a -> Int
    forall a. RealFloat a => a -> Int
    floatDigits a
    x
    {-# INLINABLE [0] scaleFloatR# #-}
    {-# SPECIALIZE scaleFloatR# :: RealFloat a => Int# -> a -> RoundTiesToEven a #-}
    {-# SPECIALIZE scaleFloatR# :: RealFloat a => Int# -> a -> RoundTiesToAway a #-}
    {-# SPECIALIZE scaleFloatR# :: RealFloat a => Int# -> a -> RoundTowardPositive a #-}
    {-# SPECIALIZE scaleFloatR# :: RealFloat a => Int# -> a -> RoundTowardNegative a #-}
    {-# SPECIALIZE scaleFloatR# :: RealFloat a => Int# -> a -> RoundTowardZero a #-}
    {-# SPECIALIZE scaleFloatR# :: RoundingStrategy f => Int# -> Double -> f Double #-}
    {-# SPECIALIZE scaleFloatR# :: RoundingStrategy f => Int# -> Float -> f Float #-}
    {-# SPECIALIZE scaleFloatR# :: Int# -> Double -> RoundTiesToEven Double #-}
    {-# SPECIALIZE scaleFloatR# :: Int# -> Double -> RoundTiesToAway Double #-}
    {-# SPECIALIZE scaleFloatR# :: Int# -> Double -> RoundTowardPositive Double #-}
    {-# SPECIALIZE scaleFloatR# :: Int# -> Double -> RoundTowardNegative Double #-}
    {-# SPECIALIZE scaleFloatR# :: Int# -> Double -> RoundTowardZero Double #-}
    {-# SPECIALIZE scaleFloatR# :: Int# -> Float -> RoundTiesToEven Float #-}
    {-# SPECIALIZE scaleFloatR# :: Int# -> Float -> RoundTiesToAway Float #-}
    {-# SPECIALIZE scaleFloatR# :: Int# -> Float -> RoundTowardPositive Float #-}
    {-# SPECIALIZE scaleFloatR# :: Int# -> Float -> RoundTowardNegative Float #-}
    {-# SPECIALIZE scaleFloatR# :: Int# -> Float -> RoundTowardZero Float #-}