{-# 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 :: 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 :: 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 :: 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 :: 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 :: 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 :: Integer -> Int -> f a
encodeFloatR Integer
0 !Int
_ = 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 :: 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# :: 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 (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 (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 (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 (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 (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
                         , RealFloat a => Bool -> Integer -> Int# -> RoundTiesToAway a
                         , RealFloat a => Bool -> Integer -> Int# -> RoundTowardPositive a
                         , RealFloat a => Bool -> Integer -> Int# -> RoundTowardZero a
                         , RealFloat a => Bool -> Integer -> Int# -> Product RoundTowardNegative RoundTowardPositive a
                         , RoundingStrategy f => Bool -> Integer -> Int# -> f Double
                         , RoundingStrategy f => Bool -> Integer -> Int# -> f Float
                         , Bool -> Integer -> Int# -> RoundTiesToEven Double
                         , Bool -> Integer -> Int# -> RoundTiesToAway Double
                         , Bool -> Integer -> Int# -> RoundTowardPositive Double
                         , Bool -> Integer -> Int# -> RoundTowardZero Double
                         , Bool -> Integer -> Int# -> RoundTiesToEven Float
                         , Bool -> Integer -> Int# -> RoundTiesToAway Float
                         , Bool -> Integer -> Int# -> RoundTowardPositive Float
                         , Bool -> Integer -> Int# -> RoundTowardZero Float
                         , Bool -> Integer -> Int# -> Product RoundTowardNegative RoundTowardPositive Double
                         , 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 :: 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 :: 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 :: 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 :: 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 :: 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 :: 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# :: 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 (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 (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 (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 (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
                , RealFloat a => Int# -> a -> RoundTiesToAway a
                , RealFloat a => Int# -> a -> RoundTowardPositive a
                , RealFloat a => Int# -> a -> RoundTowardNegative a
                , RealFloat a => Int# -> a -> RoundTowardZero a
                , RoundingStrategy f => Int# -> Double -> f Double
                , RoundingStrategy f => Int# -> Float -> f Float
                , Int# -> Double -> RoundTiesToEven Double
                , Int# -> Double -> RoundTiesToAway Double
                , Int# -> Double -> RoundTowardPositive Double
                , Int# -> Double -> RoundTowardNegative Double
                , Int# -> Double -> RoundTowardZero Double
                , Int# -> Float -> RoundTiesToEven Float
                , Int# -> Float -> RoundTiesToAway Float
                , Int# -> Float -> RoundTowardPositive Float
                , Int# -> Float -> RoundTowardNegative Float
                , Int# -> Float -> RoundTowardZero Float
  #-}