{-# 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 = forall a. RoundTiesToEven a -> a
roundTiesToEven forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall a. RoundTiesToAway a -> a
roundTiesToAway forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall a. RoundTowardPositive a -> a
roundTowardPositive forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall a. RoundTowardNegative a -> a
roundTowardNegative forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall a. RoundTowardZero a -> a
roundTowardZero forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
_ = forall (f :: * -> *) a. RoundingStrategy f => a -> f a
exact a
0
encodeFloatR Integer
m Int
n | Integer
m 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 a (f :: * -> *).
(RealFloat a, RoundingStrategy f) =>
Bool -> Integer -> Int -> f a
encodePositiveFloatR Bool
True (- Integer
m) Int
n
| Bool
otherwise = forall a (f :: * -> *).
(RealFloat a, RoundingStrategy f) =>
Bool -> Integer -> Int -> f a
encodePositiveFloatR Bool
False Integer
m Int
n
{-# INLINE encodeFloatR #-}
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#) = 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# = forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Integer
m 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 forall a. Eq a => a -> a -> Bool
== Integer
2 then
Integer -> Int
integerLog2' Integer
m
else
Integer -> Integer -> Int
integerLogBase' Integer
base Integer
m
in if Int
expMin forall a. Ord a => a -> a -> Bool
<= Int
k forall a. Num a => a -> a -> a
+ Int
n forall a. Num a => a -> a -> a
+ Int
1 Bool -> Bool -> Bool
&& Int
k forall a. Num a => a -> a -> a
+ Int
n forall a. Num a => a -> a -> a
+ Int
1 forall a. Ord a => a -> a -> Bool
<= Int
expMax then
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. RealFloat a => Integer -> Int -> a
encodeFloat Integer
m Int
n
else
let (Integer
q,Integer
r) = Integer -> Integer -> Int -> (Integer, Integer)
quotRemByExpt Integer
m Integer
base (Int
k forall a. Num a => a -> a -> a
- Int
fDigits forall a. Num a => a -> a -> a
+ Int
1)
towardzero_or_exact :: a
towardzero_or_exact = forall a. RealFloat a => Integer -> Int -> a
encodeFloat Integer
q (Int
n forall a. Num a => a -> a -> a
+ Int
k forall a. Num a => a -> a -> a
- Int
fDigits forall a. Num a => a -> a -> a
+ Int
1)
awayfromzero :: a
awayfromzero = forall a. RealFloat a => Integer -> Int -> a
encodeFloat (Integer
q forall a. Num a => a -> a -> a
+ Integer
1) (Int
n forall a. Num a => a -> a -> a
+ Int
k forall a. Num a => a -> a -> a
- Int
fDigits forall a. Num a => a -> a -> a
+ Int
1)
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
m Integer
base (Int
k forall a. Num a => a -> a -> a
- Int
fDigits forall a. Num a => a -> a -> a
+ Int
1) Integer
r)
(Integer -> Integer -> Integer -> Int -> Ordering
compareWithExpt Integer
base Integer
m Integer
r (Int
k forall a. Num a => a -> a -> a
- Int
fDigits))
Bool
neg
Int
parity
a
towardzero_or_exact
a
awayfromzero
else
if Int
expMax forall a. Ord a => a -> a -> Bool
<= Int
k forall a. Num a => a -> a -> a
+ Int
n then
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
if Int
expMin forall a. Num a => a -> a -> a
- Int
fDigits forall a. Ord a => a -> a -> Bool
<= Int
n then
forall (f :: * -> *) a. RoundingStrategy f => a -> f a
exact forall a b. (a -> b) -> a -> b
$ forall a. RealFloat a => Integer -> Int -> a
encodeFloat Integer
m Int
n
else
let (Integer
q,Integer
r) = Integer -> Integer -> Int -> (Integer, Integer)
quotRemByExpt Integer
m Integer
base (Int
expMin forall a. Num a => a -> a -> a
- Int
fDigits forall a. Num a => a -> a -> a
- Int
n)
!()
_ = forall a. (?callStack::CallStack) => Bool -> a -> a
assert (forall a. Real a => a -> Rational
toRational Integer
q forall a. Num a => a -> a -> a
* forall a. Real a => a -> Rational
toRational Integer
baseforall a b. (Fractional a, Integral b) => a -> b -> a
^^(Int
expMinforall a. Num a => a -> a -> a
-Int
fDigits) forall a. Ord a => a -> a -> Bool
<= forall a. Real a => a -> Rational
toRational Integer
m forall a. Num a => a -> a -> a
* forall a. Real a => a -> Rational
toRational Integer
baseforall a b. (Fractional a, Integral b) => a -> b -> a
^^Int
n) ()
!()
_ = forall a. (?callStack::CallStack) => Bool -> a -> a
assert (forall a. Real a => a -> Rational
toRational Integer
m forall a. Num a => a -> a -> a
* forall a. Real a => a -> Rational
toRational Integer
baseforall a b. (Fractional a, Integral b) => a -> b -> a
^^Int
n forall a. Ord a => a -> a -> Bool
< forall a. Real a => a -> Rational
toRational (Integer
qforall a. Num a => a -> a -> a
+Integer
1) forall a. Num a => a -> a -> a
* forall a. Real a => a -> Rational
toRational Integer
baseforall a b. (Fractional a, Integral b) => a -> b -> a
^^(Int
expMinforall a. Num a => a -> a -> a
-Int
fDigits)) ()
towardzero_or_exact :: a
towardzero_or_exact = forall a. RealFloat a => Integer -> Int -> a
encodeFloat Integer
q (Int
expMin forall a. Num a => a -> a -> a
- Int
fDigits)
awayfromzero :: a
awayfromzero = forall a. RealFloat a => Integer -> Int -> a
encodeFloat (Integer
q forall a. Num a => a -> a -> a
+ Integer
1) (Int
expMin forall a. Num a => a -> a -> a
- Int
fDigits)
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
m Integer
base (Int
expMin forall a. Num a => a -> a -> a
- Int
fDigits 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 forall a. Num a => a -> a -> a
- Int
fDigits forall a. Num a => a -> a -> a
- Int
n forall a. Num a => a -> a -> a
- Int
1))
Bool
neg
Int
parity
a
towardzero_or_exact
a
awayfromzero
!base :: Integer
base = forall a. RealFloat a => a -> Integer
floatRadix (forall a. (?callStack::CallStack) => a
undefined :: a)
!fDigits :: Int
fDigits = forall a. RealFloat a => a -> Int
floatDigits (forall a. (?callStack::CallStack) => a
undefined :: a)
(!Int
expMin, !Int
expMax) = forall a. RealFloat a => a -> (Int, Int)
floatRange (forall a. (?callStack::CallStack) => a
undefined :: a)
{-# 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))
#-}
scaleFloatTiesToEven, scaleFloatTiesToAway, scaleFloatTowardPositive, scaleFloatTowardNegative, scaleFloatTowardZero :: RealFloat a => Int -> a -> a
scaleFloatTiesToEven :: forall a. RealFloat a => Int -> a -> a
scaleFloatTiesToEven Int
e = forall a. RoundTiesToEven a -> a
roundTiesToEven forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall a. RoundTiesToAway a -> a
roundTiesToAway forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall a. RoundTowardPositive a -> a
roundTowardPositive forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall a. RoundTowardNegative a -> a
roundTowardNegative forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall a. RoundTowardZero a -> a
roundTowardZero forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = 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 forall a. Eq a => a -> a -> Bool
/= a
0, forall a. RealFloat a => a -> Bool
isFinite a
x =
let e :: Int
e = Int# -> Int
I# Int#
e#
(Integer
m,Int
n) = forall a. RealFloat a => a -> (Integer, Int)
decodeFloat a
x
in if Int
expMin forall a. Num a => a -> a -> a
- Int
fDigits forall a. Ord a => a -> a -> Bool
<= Int
n forall a. Num a => a -> a -> a
+ Int
e Bool -> Bool -> Bool
&& Int
n forall a. Num a => a -> a -> a
+ Int
e forall a. Ord a => a -> a -> Bool
<= Int
expMax forall a. Num a => a -> a -> a
- Int
fDigits then
forall (f :: * -> *) a. RoundingStrategy f => a -> f a
exact forall a b. (a -> b) -> a -> b
$ forall a. RealFloat a => Integer -> Int -> a
encodeFloat Integer
m (Int
n forall a. Num a => a -> a -> a
+ Int
e)
else
if Int
expMax forall a. Num a => a -> a -> a
- Int
fDigits forall a. Ord a => a -> a -> Bool
< Int
n forall a. Num a => a -> a -> a
+ Int
e then
(forall a. Num a => a -> a
signum a
x forall a. Num a => a -> a -> a
*) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a.
RoundingStrategy f =>
Ordering -> Bool -> Int -> a -> a -> f a
inexact Ordering
GT (a
x forall a. Ord a => a -> a -> Bool
< a
0) Int
1 forall a. RealFloat a => a
maxFinite (a
1 forall a. Fractional a => a -> a -> a
/ a
0)
else
let !()
_ = forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
e forall a. Num a => a -> a -> a
+ Int
n forall a. Ord a => a -> a -> Bool
< Int
expMin forall a. Num a => a -> a -> a
- Int
fDigits) ()
m' :: Integer
m' = 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 forall a. Num a => a -> a -> a
- Int
fDigits forall a. Num a => a -> a -> a
- (Int
e forall a. Num a => a -> a -> a
+ Int
n))
towardzero_or_exact :: a
towardzero_or_exact = forall a. RealFloat a => Integer -> Int -> a
encodeFloat Integer
q (Int
expMin forall a. Num a => a -> a -> a
- Int
fDigits)
awayfromzero :: a
awayfromzero = forall a. RealFloat a => Integer -> Int -> a
encodeFloat (Integer
q forall a. Num a => a -> a -> a
+ Integer
1) (Int
expMin forall a. Num a => a -> a -> a
- Int
fDigits)
parity :: Int
parity = forall a. Num a => Integer -> a
fromInteger Integer
q :: Int
in (forall a. Num a => a -> a
signum a
x forall a. Num a => a -> a -> a
*) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 forall a. Num a => a -> a -> a
- Int
fDigits forall a. Num a => a -> a -> a
- (Int
e 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 forall a. Num a => a -> a -> a
- Int
fDigits forall a. Num a => a -> a -> a
- (Int
e forall a. Num a => a -> a -> a
+ Int
n) forall a. Num a => a -> a -> a
- Int
1))
(a
x forall a. Ord a => a -> a -> Bool
< a
0)
Int
parity
a
towardzero_or_exact
a
awayfromzero
| Bool
otherwise = forall (f :: * -> *) a. RoundingStrategy f => a -> f a
exact (a
x forall a. Num a => a -> a -> a
+ a
x)
where
base :: Integer
base = forall a. RealFloat a => a -> Integer
floatRadix a
x
(Int
expMin,Int
expMax) = forall a. RealFloat a => a -> (Int, Int)
floatRange a
x
fDigits :: Int
fDigits = 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
#-}