rounded-hw-0.2.0: benchmark/Conversion.hs
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE HexFloatLiterals #-}
{-# LANGUAGE NumericUnderscores #-}
{-# OPTIONS_GHC -Wno-type-defaults #-}
module Conversion (benchmark) where
import Data.Bits
import Data.Functor.Product
import Data.Int
import Data.Ratio
import Data.Word
import Gauge.Benchmark
import Numeric.Floating.IEEE
import qualified Numeric.Floating.IEEE.Internal as IEEE.Internal
import Numeric.Rounded.Hardware
import qualified Numeric.Rounded.Hardware.Backend.C as C
import Numeric.Rounded.Hardware.Class
import Numeric.Rounded.Hardware.Interval
word64ToDouble :: RoundingMode -> Word64 -> Double
word64ToDouble ToNearest x
| x >= 0xFFFF_FFFF_FFFF_FC00 = 0x1p64
| otherwise = let z = countLeadingZeros x
y = if x .&. (0x0000_0000_0000_0800 `unsafeShiftR` z) == 0
then x + (0x0000_0000_0000_03FF `unsafeShiftR` z)
else x + (0x0000_0000_0000_0400 `unsafeShiftR` z)
in fromIntegral (y .&. (0xFFFF_FFFF_FFFF_F800 `unsafeShiftR` z))
word64ToDouble TowardInf x
| x >= 0xFFFF_FFFF_FFFF_F800 = 0x1p64
| otherwise = let z = countLeadingZeros x
y = x + (0x0000_0000_0000_07FF `unsafeShiftR` z)
in fromIntegral (y .&. (0xFFFF_FFFF_FFFF_F800 `unsafeShiftR` z))
word64ToDouble TowardNegInf x = let z = countLeadingZeros x
in fromIntegral (x .&. (0xFFFF_FFFF_FFFF_F800 `unsafeShiftR` z))
word64ToDouble TowardZero x = let z = countLeadingZeros x
in fromIntegral (x .&. (0xFFFF_FFFF_FFFF_F800 `unsafeShiftR` z))
int64ToDouble :: RoundingMode -> Int64 -> Double
int64ToDouble r x | x >= 0 = word64ToDouble r (fromIntegral x)
| r == TowardInf = - word64ToDouble TowardNegInf (fromIntegral (-x))
| r == TowardNegInf = - word64ToDouble TowardInf (fromIntegral (-x))
| otherwise = - word64ToDouble r (fromIntegral (-x))
benchmark :: Benchmark
benchmark = bgroup "Conversion"
[ bgroup "fromInteger/to Double"
[ bgroup name $ map ($ value)
[ bench "plain" . nf (fromInteger :: Integer -> Double)
, bench "Rounded/ToNearest" . nf (fromInteger :: Integer -> Rounded 'ToNearest Double)
, bench "Rounded/TowardInf" . nf (fromInteger :: Integer -> Rounded 'TowardInf Double)
, bench "roundedFromInteger/ToNearest" . nf (roundedFromInteger ToNearest :: Integer -> Double)
, bench "roundedFromInteger/TowardInf" . nf (roundedFromInteger TowardInf :: Integer -> Double)
, bench "fp-ieee/ToNearest" . nf (fromIntegerTiesToEven :: Integer -> Double)
, bench "fp-ieee/TowardInf" . nf (fromIntegerTowardPositive :: Integer -> Double)
, bench "Interval/default" . nf (fromInteger :: Integer -> Interval Double)
, bench "Interval/individual" . nf (\n -> (fromIntegerTowardNegative n, fromIntegerTowardPositive n) :: (Double, Double))
, bench "Interval/fromIntegerR" . nf (\n -> case IEEE.Internal.fromIntegerR n of
Pair (IEEE.Internal.RoundTowardNegative x) (IEEE.Internal.RoundTowardPositive y) -> (x, y) :: (Double, Double)
)
]
| (name, value) <- [ ("small", -2^50 + 2^13 + 127)
, ("medium", -2^60 + 42 * 2^53 - 137 * 2^24 + 3)
, ("large", -2^100 - 37 * 2^80 + 2^13 + 127)
] :: [(String, Integer)]
]
, bgroup "fromIntegral/Int64->Double"
[ bgroup name $ map ($ value)
[ bench "plain" . nf (fromIntegral :: Int64 -> Double)
, bench "Rounded/ToNearest" . nf (fromIntegral :: Int64 -> Rounded 'ToNearest Double)
, bench "Rounded/TowardInf" . nf (fromIntegral :: Int64 -> Rounded 'TowardInf Double)
, bench "roundedFromInteger/ToNearest" . nf (roundedFromInteger ToNearest . fromIntegral :: Int64 -> Double)
, bench "roundedFromInteger/TowardInf" . nf (roundedFromInteger TowardInf . fromIntegral :: Int64 -> Double)
, bench "fp-ieee/ToNearest" . nf (fromIntegralTiesToEven :: Int64 -> Double)
, bench "fp-ieee/TowardInf" . nf (fromIntegralTowardPositive :: Int64 -> Double)
, bench "int64ToDouble/ToNearest" . nf (int64ToDouble ToNearest :: Int64 -> Double)
, bench "int64ToDouble/TowardInf" . nf (int64ToDouble TowardInf :: Int64 -> Double)
, bench "Interval/default" . nf (fromIntegral :: Int64 -> Interval Double)
, bench "Interval/individual" . nf (\n -> (fromIntegralTowardNegative n, fromIntegralTowardPositive n) :: (Double, Double))
, bench "Interval/fromIntegralR" . nf (\n -> case IEEE.Internal.fromIntegralR n of
Pair (IEEE.Internal.RoundTowardNegative x) (IEEE.Internal.RoundTowardPositive y) -> (x, y) :: (Double, Double)
)
, bench "Interval/individual/C" . nf (\n -> (C.roundedDoubleFromInt64 TowardNegInf n, C.roundedDoubleFromInt64 TowardInf n))
]
| (name, value) <- [ ("small", -2^50 + 2^13 + 127)
, ("medium", -2^60 + 42 * 2^53 - 137 * 2^24 + 3)
] :: [(String, Int64)]
]
, bgroup "fromIntegral/Word64->Double"
[ bgroup name $ map ($ value)
[ bench "plain" . nf (fromIntegral :: Word64 -> Double)
, bench "Rounded/ToNearest" . nf (fromIntegral :: Word64 -> Rounded 'ToNearest Double)
, bench "Rounded/TowardInf" . nf (fromIntegral :: Word64 -> Rounded 'TowardInf Double)
, bench "roundedFromInteger/ToNearest" . nf (roundedFromInteger ToNearest . fromIntegral :: Word64 -> Double)
, bench "roundedFromInteger/TowardInf" . nf (roundedFromInteger TowardInf . fromIntegral :: Word64 -> Double)
, bench "fp-ieee/ToNearest" . nf (fromIntegralTiesToEven :: Word64 -> Double)
, bench "fp-ieee/TowardInf" . nf (fromIntegralTowardPositive :: Word64 -> Double)
, bench "word64ToDouble/ToNearest" . nf (word64ToDouble ToNearest :: Word64 -> Double)
, bench "word64ToDouble/TowardInf" . nf (word64ToDouble TowardInf :: Word64 -> Double)
, bench "Interval/default" . nf (fromIntegral :: Word64 -> Interval Double)
, bench "Interval/individual" . nf (\n -> (fromIntegralTowardNegative n, fromIntegralTowardPositive n) :: (Double, Double))
, bench "Interval/fromIntegralR" . nf (\n -> case IEEE.Internal.fromIntegralR n of
Pair (IEEE.Internal.RoundTowardNegative x) (IEEE.Internal.RoundTowardPositive y) -> (x, y) :: (Double, Double)
)
, bench "Interval/individual/C" . nf (\n -> (C.roundedDoubleFromWord64 TowardNegInf n, C.roundedDoubleFromWord64 TowardInf n))
]
| (name, value) <- [ ("small", 2^50 + 2^13 + 127)
, ("medium", 2^63 + 42 * 2^53 - 137 * 2^24 + 3)
] :: [(String, Word64)]
]
, bgroup "fromRational/to Double"
[ bgroup name $ map ($ value)
[ bench "plain" . nf (fromRational :: Rational -> Double)
, bench "Rounded/ToNearest" . nf (fromRational :: Rational -> Rounded 'ToNearest Double)
, bench "Rounded/TowardInf" . nf (fromRational :: Rational -> Rounded 'TowardInf Double)
, bench "fp-ieee/ToNearest" . nf (fromRationalTiesToEven :: Rational -> Double)
, bench "fp-ieee/TowardInf" . nf (fromRationalTowardPositive :: Rational -> Double)
, bench "Interval/default" . nf (fromRational :: Rational -> Interval Double)
, bench "Interval/individual" . nf (\x -> (fromRationalTowardNegative x :: Double, fromRationalTowardPositive x :: Double))
, bench "Interval/fromRationalR" . nf (\x -> case IEEE.Internal.fromRationalR x of
Pair (IEEE.Internal.RoundTowardNegative a) (IEEE.Internal.RoundTowardPositive b) -> (a, b) :: (Double, Double)
)
]
| (name, value) <- [ ("decimal", 3.14159265358979323846264338327950)
, ("binary", 0xcafec0ffeecafec0ffeep-177)
, ("small", 22 % 7)
, ("large", 78326489123342523452342137498719847192 % 348912374981749170413424213275017)
] :: [(String, Rational)]
]
]