{-# LANGUAGE DataKinds #-}
module Numeric.Rounded.Hardware.Internal.Conversion
  ( roundedFromInteger_default
  , roundedFromRational_default
  , intervalFromInteger_default
  , intervalFromIntegral
  , intervalFromRational_default
  ) where
import           Data.Functor.Product
import           Numeric.Floating.IEEE
import           Numeric.Floating.IEEE.Internal (fromIntegerR, fromIntegralR,
                                                 fromRationalR,
                                                 roundTowardNegative,
                                                 roundTowardPositive)
import           Numeric.Rounded.Hardware.Internal.Rounding

roundedFromInteger_default :: RealFloat a => RoundingMode -> Integer -> a
roundedFromInteger_default :: RoundingMode -> Integer -> a
roundedFromInteger_default RoundingMode
ToNearest    = Integer -> a
forall a. RealFloat a => Integer -> a
fromIntegerTiesToEven
roundedFromInteger_default RoundingMode
TowardZero   = Integer -> a
forall a. RealFloat a => Integer -> a
fromIntegerTowardZero
roundedFromInteger_default RoundingMode
TowardInf    = Integer -> a
forall a. RealFloat a => Integer -> a
fromIntegerTowardPositive
roundedFromInteger_default RoundingMode
TowardNegInf = Integer -> a
forall a. RealFloat a => Integer -> a
fromIntegerTowardNegative
{-# INLINE roundedFromInteger_default #-}

roundedFromRational_default :: RealFloat a => RoundingMode -> Rational -> a
roundedFromRational_default :: RoundingMode -> Rational -> a
roundedFromRational_default RoundingMode
ToNearest    = Rational -> a
forall a. RealFloat a => Rational -> a
fromRationalTiesToEven
roundedFromRational_default RoundingMode
TowardZero   = Rational -> a
forall a. RealFloat a => Rational -> a
fromRationalTowardZero
roundedFromRational_default RoundingMode
TowardInf    = Rational -> a
forall a. RealFloat a => Rational -> a
fromRationalTowardPositive
roundedFromRational_default RoundingMode
TowardNegInf = Rational -> a
forall a. RealFloat a => Rational -> a
fromRationalTowardNegative
{-# INLINE roundedFromRational_default #-}

intervalFromInteger_default :: RealFloat a => Integer -> (Rounded 'TowardNegInf a, Rounded 'TowardInf a)
intervalFromInteger_default :: Integer -> (Rounded 'TowardNegInf a, Rounded 'TowardInf a)
intervalFromInteger_default Integer
x = case Integer -> Product RoundTowardNegative RoundTowardPositive a
forall a (f :: * -> *).
(RealFloat a, RoundingStrategy f) =>
Integer -> f a
fromIntegerR Integer
x of
  Pair RoundTowardNegative a
a RoundTowardPositive a
b -> (a -> Rounded 'TowardNegInf a
forall (r :: RoundingMode) a. a -> Rounded r a
Rounded (RoundTowardNegative a -> a
forall a. RoundTowardNegative a -> a
roundTowardNegative RoundTowardNegative a
a), a -> Rounded 'TowardInf a
forall (r :: RoundingMode) a. a -> Rounded r a
Rounded (RoundTowardPositive a -> a
forall a. RoundTowardPositive a -> a
roundTowardPositive RoundTowardPositive a
b))
{-# INLINE intervalFromInteger_default #-}

intervalFromRational_default :: RealFloat a => Rational -> (Rounded 'TowardNegInf a, Rounded 'TowardInf a)
intervalFromRational_default :: Rational -> (Rounded 'TowardNegInf a, Rounded 'TowardInf a)
intervalFromRational_default Rational
x = case Rational -> Product RoundTowardNegative RoundTowardPositive a
forall a (f :: * -> *).
(RealFloat a, RoundingStrategy f) =>
Rational -> f a
fromRationalR Rational
x of
  Pair RoundTowardNegative a
a RoundTowardPositive a
b -> (a -> Rounded 'TowardNegInf a
forall (r :: RoundingMode) a. a -> Rounded r a
Rounded (RoundTowardNegative a -> a
forall a. RoundTowardNegative a -> a
roundTowardNegative RoundTowardNegative a
a), a -> Rounded 'TowardInf a
forall (r :: RoundingMode) a. a -> Rounded r a
Rounded (RoundTowardPositive a -> a
forall a. RoundTowardPositive a -> a
roundTowardPositive RoundTowardPositive a
b))
{-# INLINE intervalFromRational_default #-}

intervalFromIntegral :: (Integral i, RealFloat a) => i -> (Rounded 'TowardNegInf a, Rounded 'TowardInf a)
intervalFromIntegral :: i -> (Rounded 'TowardNegInf a, Rounded 'TowardInf a)
intervalFromIntegral i
x = case i -> Product RoundTowardNegative RoundTowardPositive a
forall i a (f :: * -> *).
(Integral i, RealFloat a, RoundingStrategy f) =>
i -> f a
fromIntegralR i
x of
  Pair RoundTowardNegative a
a RoundTowardPositive a
b -> (a -> Rounded 'TowardNegInf a
forall (r :: RoundingMode) a. a -> Rounded r a
Rounded (RoundTowardNegative a -> a
forall a. RoundTowardNegative a -> a
roundTowardNegative RoundTowardNegative a
a), a -> Rounded 'TowardInf a
forall (r :: RoundingMode) a. a -> Rounded r a
Rounded (RoundTowardPositive a -> a
forall a. RoundTowardPositive a -> a
roundTowardPositive RoundTowardPositive a
b))
{-# INLINE intervalFromIntegral #-}