{-# LANGUAGE ConstrainedClassMethods #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -Wno-orphans #-}
module Numeric.Rounded.Hardware.Internal.Class
  ( module Numeric.Rounded.Hardware.Internal.Class
  , module Numeric.Rounded.Hardware.Internal.Rounding
  ) where
import           Data.Coerce
import           Data.Proxy
import           Data.Ratio
import           Data.Tagged
import qualified Data.Vector.Generic as VG
import           Numeric.Floating.IEEE
import           Numeric.Rounded.Hardware.Internal.Conversion
import           Numeric.Rounded.Hardware.Internal.Rounding
import           Prelude hiding (fromInteger, fromRational, recip, sqrt, (*),
                          (+), (-), (/))
import qualified Prelude

-- | Rounding-controlled version of 'Num'.
class Ord a => RoundedRing a where
  roundedAdd :: RoundingMode -> a -> a -> a
  roundedSub :: RoundingMode -> a -> a -> a
  roundedMul :: RoundingMode -> a -> a -> a
  roundedFusedMultiplyAdd :: RoundingMode -> a -> a -> a -> a
  roundedFromInteger :: RoundingMode -> Integer -> a
  default roundedFromInteger :: RealFloat a => RoundingMode -> Integer -> a
  roundedFromInteger = RoundingMode -> Integer -> a
forall a. RealFloat a => RoundingMode -> Integer -> a
roundedFromInteger_default
  -- roundedToFloat :: RoundingMode -> a -> Float
  -- roundedToDouble :: RoundingMode -> a -> Double

  -- |
  -- prop> \x_lo x_hi y_lo y_hi -> intervalAdd (Rounded x_lo) (Rounded x_hi) (Rounded y_lo) (Rounded y_hi) == (Rounded (roundedAdd TowardNegInf x_lo y_lo), Rounded (roundedAdd TowardInf x_hi y_hi))
  intervalAdd :: Rounded 'TowardNegInf a -> Rounded 'TowardInf a -> Rounded 'TowardNegInf a -> Rounded 'TowardInf a -> (Rounded 'TowardNegInf a, Rounded 'TowardInf a)
  intervalAdd Rounded 'TowardNegInf a
x_lo Rounded 'TowardInf a
x_hi Rounded 'TowardNegInf a
y_lo Rounded 'TowardInf a
y_hi = (Rounded 'TowardNegInf a
x_lo Rounded 'TowardNegInf a
-> Rounded 'TowardNegInf a -> Rounded 'TowardNegInf a
forall (r :: RoundingMode).
Rounding r =>
Rounded r a -> Rounded r a -> Rounded r a
+ Rounded 'TowardNegInf a
y_lo, Rounded 'TowardInf a
x_hi Rounded 'TowardInf a
-> Rounded 'TowardInf a -> Rounded 'TowardInf a
forall (r :: RoundingMode).
Rounding r =>
Rounded r a -> Rounded r a -> Rounded r a
+ Rounded 'TowardInf a
y_hi)
    where (+) :: forall r. Rounding r => Rounded r a -> Rounded r a -> Rounded r a
          Rounded a
x + :: Rounded r a -> Rounded r a -> Rounded r a
+ Rounded a
y = a -> Rounded r a
forall (r :: RoundingMode) a. a -> Rounded r a
Rounded (RoundingMode -> a -> a -> a
forall a. RoundedRing a => RoundingMode -> a -> a -> a
roundedAdd (Proxy r -> RoundingMode
forall (r :: RoundingMode) (proxy :: RoundingMode -> *).
Rounding r =>
proxy r -> RoundingMode
rounding (Proxy r
forall k (t :: k). Proxy t
Proxy :: Proxy r)) a
x a
y)

  -- |
  -- prop> \x_lo x_hi y_lo y_hi -> intervalSub (Rounded x_lo) (Rounded x_hi) (Rounded y_lo) (Rounded y_hi) == (Rounded (roundedSub TowardNegInf x_lo y_hi), Rounded (roundedSub TowardInf x_hi y_lo))
  intervalSub :: Rounded 'TowardNegInf a -> Rounded 'TowardInf a -> Rounded 'TowardNegInf a -> Rounded 'TowardInf a -> (Rounded 'TowardNegInf a, Rounded 'TowardInf a)
  intervalSub Rounded 'TowardNegInf a
x_lo Rounded 'TowardInf a
x_hi Rounded 'TowardNegInf a
y_lo Rounded 'TowardInf a
y_hi = (Rounded 'TowardNegInf a
x_lo Rounded 'TowardNegInf a
-> Rounded 'TowardNegInf a -> Rounded 'TowardNegInf a
forall (r :: RoundingMode).
Rounding r =>
Rounded r a -> Rounded r a -> Rounded r a
- Rounded 'TowardInf a -> Rounded 'TowardNegInf a
coerce Rounded 'TowardInf a
y_hi, Rounded 'TowardInf a
x_hi Rounded 'TowardInf a
-> Rounded 'TowardInf a -> Rounded 'TowardInf a
forall (r :: RoundingMode).
Rounding r =>
Rounded r a -> Rounded r a -> Rounded r a
- Rounded 'TowardNegInf a -> Rounded 'TowardInf a
coerce Rounded 'TowardNegInf a
y_lo)
    where (-) :: forall r. Rounding r => Rounded r a -> Rounded r a -> Rounded r a
          Rounded a
x - :: Rounded r a -> Rounded r a -> Rounded r a
- Rounded a
y = a -> Rounded r a
forall (r :: RoundingMode) a. a -> Rounded r a
Rounded (RoundingMode -> a -> a -> a
forall a. RoundedRing a => RoundingMode -> a -> a -> a
roundedSub (Proxy r -> RoundingMode
forall (r :: RoundingMode) (proxy :: RoundingMode -> *).
Rounding r =>
proxy r -> RoundingMode
rounding (Proxy r
forall k (t :: k). Proxy t
Proxy :: Proxy r)) a
x a
y)
  intervalMul :: Rounded 'TowardNegInf a -> Rounded 'TowardInf a -> Rounded 'TowardNegInf a -> Rounded 'TowardInf a -> (Rounded 'TowardNegInf a, Rounded 'TowardInf a)
  intervalMul Rounded 'TowardNegInf a
x_lo Rounded 'TowardInf a
x_hi Rounded 'TowardNegInf a
y_lo Rounded 'TowardInf a
y_hi
    = ( [Rounded 'TowardNegInf a] -> Rounded 'TowardNegInf a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [        Rounded 'TowardNegInf a
x_lo Rounded 'TowardNegInf a
-> Rounded 'TowardNegInf a -> Rounded 'TowardNegInf a
forall (r :: RoundingMode).
Rounding r =>
Rounded r a -> Rounded r a -> Rounded r a
*        Rounded 'TowardNegInf a
y_lo
                ,        Rounded 'TowardNegInf a
x_lo Rounded 'TowardNegInf a
-> Rounded 'TowardNegInf a -> Rounded 'TowardNegInf a
forall (r :: RoundingMode).
Rounding r =>
Rounded r a -> Rounded r a -> Rounded r a
* Rounded 'TowardInf a -> Rounded 'TowardNegInf a
coerce Rounded 'TowardInf a
y_hi
                , Rounded 'TowardInf a -> Rounded 'TowardNegInf a
coerce Rounded 'TowardInf a
x_hi Rounded 'TowardNegInf a
-> Rounded 'TowardNegInf a -> Rounded 'TowardNegInf a
forall (r :: RoundingMode).
Rounding r =>
Rounded r a -> Rounded r a -> Rounded r a
*        Rounded 'TowardNegInf a
y_lo
                , Rounded 'TowardInf a -> Rounded 'TowardNegInf a
coerce Rounded 'TowardInf a
x_hi Rounded 'TowardNegInf a
-> Rounded 'TowardNegInf a -> Rounded 'TowardNegInf a
forall (r :: RoundingMode).
Rounding r =>
Rounded r a -> Rounded r a -> Rounded r a
* Rounded 'TowardInf a -> Rounded 'TowardNegInf a
coerce Rounded 'TowardInf a
y_hi
                ]
      , [Rounded 'TowardInf a] -> Rounded 'TowardInf a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [ Rounded 'TowardNegInf a -> Rounded 'TowardInf a
coerce Rounded 'TowardNegInf a
x_lo Rounded 'TowardInf a
-> Rounded 'TowardInf a -> Rounded 'TowardInf a
forall (r :: RoundingMode).
Rounding r =>
Rounded r a -> Rounded r a -> Rounded r a
* Rounded 'TowardNegInf a -> Rounded 'TowardInf a
coerce Rounded 'TowardNegInf a
y_lo
                , Rounded 'TowardNegInf a -> Rounded 'TowardInf a
coerce Rounded 'TowardNegInf a
x_lo Rounded 'TowardInf a
-> Rounded 'TowardInf a -> Rounded 'TowardInf a
forall (r :: RoundingMode).
Rounding r =>
Rounded r a -> Rounded r a -> Rounded r a
*        Rounded 'TowardInf a
y_hi
                ,        Rounded 'TowardInf a
x_hi Rounded 'TowardInf a
-> Rounded 'TowardInf a -> Rounded 'TowardInf a
forall (r :: RoundingMode).
Rounding r =>
Rounded r a -> Rounded r a -> Rounded r a
* Rounded 'TowardNegInf a -> Rounded 'TowardInf a
coerce Rounded 'TowardNegInf a
y_lo
                ,        Rounded 'TowardInf a
x_hi Rounded 'TowardInf a
-> Rounded 'TowardInf a -> Rounded 'TowardInf a
forall (r :: RoundingMode).
Rounding r =>
Rounded r a -> Rounded r a -> Rounded r a
*        Rounded 'TowardInf a
y_hi
                ]
      )
    where (*) :: forall r. Rounding r => Rounded r a -> Rounded r a -> Rounded r a
          Rounded a
x * :: Rounded r a -> Rounded r a -> Rounded r a
* Rounded a
y = a -> Rounded r a
forall (r :: RoundingMode) a. a -> Rounded r a
Rounded (RoundingMode -> a -> a -> a
forall a. RoundedRing a => RoundingMode -> a -> a -> a
roundedMul (Proxy r -> RoundingMode
forall (r :: RoundingMode) (proxy :: RoundingMode -> *).
Rounding r =>
proxy r -> RoundingMode
rounding (Proxy r
forall k (t :: k). Proxy t
Proxy :: Proxy r)) a
x a
y)
  intervalMulAdd :: Rounded 'TowardNegInf a -> Rounded 'TowardInf a -> Rounded 'TowardNegInf a -> Rounded 'TowardInf a -> Rounded 'TowardNegInf a -> Rounded 'TowardInf a -> (Rounded 'TowardNegInf a, Rounded 'TowardInf a)
  intervalMulAdd Rounded 'TowardNegInf a
x_lo Rounded 'TowardInf a
x_hi Rounded 'TowardNegInf a
y_lo Rounded 'TowardInf a
y_hi Rounded 'TowardNegInf a
z_lo Rounded 'TowardInf a
z_hi = case Rounded 'TowardNegInf a
-> Rounded 'TowardInf a
-> Rounded 'TowardNegInf a
-> Rounded 'TowardInf a
-> (Rounded 'TowardNegInf a, Rounded 'TowardInf a)
forall a.
RoundedRing a =>
Rounded 'TowardNegInf a
-> Rounded 'TowardInf a
-> Rounded 'TowardNegInf a
-> Rounded 'TowardInf a
-> (Rounded 'TowardNegInf a, Rounded 'TowardInf a)
intervalMul Rounded 'TowardNegInf a
x_lo Rounded 'TowardInf a
x_hi Rounded 'TowardNegInf a
y_lo Rounded 'TowardInf a
y_hi of
                                                   (Rounded 'TowardNegInf a
xy_lo, Rounded 'TowardInf a
xy_hi) -> Rounded 'TowardNegInf a
-> Rounded 'TowardInf a
-> Rounded 'TowardNegInf a
-> Rounded 'TowardInf a
-> (Rounded 'TowardNegInf a, Rounded 'TowardInf a)
forall a.
RoundedRing a =>
Rounded 'TowardNegInf a
-> Rounded 'TowardInf a
-> Rounded 'TowardNegInf a
-> Rounded 'TowardInf a
-> (Rounded 'TowardNegInf a, Rounded 'TowardInf a)
intervalAdd Rounded 'TowardNegInf a
xy_lo Rounded 'TowardInf a
xy_hi Rounded 'TowardNegInf a
z_lo Rounded 'TowardInf a
z_hi
  intervalFromInteger :: Integer -> (Rounded 'TowardNegInf a, Rounded 'TowardInf a)
  intervalFromInteger Integer
x = (Integer -> Rounded 'TowardNegInf a
forall (r :: RoundingMode). Rounding r => Integer -> Rounded r a
fromInteger Integer
x, Integer -> Rounded 'TowardInf a
forall (r :: RoundingMode). Rounding r => Integer -> Rounded r a
fromInteger Integer
x)
    where fromInteger :: forall r. Rounding r => Integer -> Rounded r a
          fromInteger :: Integer -> Rounded r a
fromInteger Integer
y = a -> Rounded r a
forall (r :: RoundingMode) a. a -> Rounded r a
Rounded (RoundingMode -> Integer -> a
forall a. RoundedRing a => RoundingMode -> Integer -> a
roundedFromInteger (Proxy r -> RoundingMode
forall (r :: RoundingMode) (proxy :: RoundingMode -> *).
Rounding r =>
proxy r -> RoundingMode
rounding (Proxy r
forall k (t :: k). Proxy t
Proxy :: Proxy r)) Integer
y)
  {-# INLINE intervalAdd #-}
  {-# INLINE intervalSub #-}
  {-# INLINE intervalMul #-}
  {-# INLINE intervalFromInteger #-}

  backendNameT :: Tagged a String

-- | Returns the name of backend as a string.
--
-- Example:
--
-- @
-- >>> :m + Data.Proxy
-- >>> 'backendName' (Proxy :: Proxy Double)
-- "FastFFI+SSE2"
-- @
backendName :: RoundedRing a => proxy a -> String
backendName :: proxy a -> String
backendName = Tagged a String -> proxy a -> String
forall k (s :: k) a (proxy :: k -> *). Tagged s a -> proxy s -> a
Data.Tagged.proxy Tagged a String
forall a. RoundedRing a => Tagged a String
backendNameT
{-# INLINE backendName #-}

-- | Rounding-controlled version of 'Fractional'.
class RoundedRing a => RoundedFractional a where
  roundedDiv :: RoundingMode -> a -> a -> a
  roundedRecip :: RoundingMode -> a -> a
  default roundedRecip :: Num a => RoundingMode -> a -> a
  roundedRecip RoundingMode
r = RoundingMode -> a -> a -> a
forall a. RoundedFractional a => RoundingMode -> a -> a -> a
roundedDiv RoundingMode
r a
1
  roundedFromRational :: RoundingMode -> Rational -> a
  default roundedFromRational :: RealFloat a => RoundingMode -> Rational -> a
  roundedFromRational = RoundingMode -> Rational -> a
forall a. RealFloat a => RoundingMode -> Rational -> a
roundedFromRational_default
  roundedFromRealFloat :: RealFloat b => RoundingMode -> b -> a
  default roundedFromRealFloat :: (Fractional a, RealFloat b) => RoundingMode -> b -> a
  roundedFromRealFloat RoundingMode
r b
x | b -> Bool
forall a. RealFloat a => a -> Bool
isNaN b
x = a
0 a -> a -> a
forall a. Fractional a => a -> a -> a
Prelude./ a
0
                           | b -> Bool
forall a. RealFloat a => a -> Bool
isInfinite b
x = if b
x b -> b -> Bool
forall a. Ord a => a -> a -> Bool
> b
0 then a
1 a -> a -> a
forall a. Fractional a => a -> a -> a
Prelude./ a
0 else -a
1 a -> a -> a
forall a. Fractional a => a -> a -> a
Prelude./ a
0
                           | b -> Bool
forall a. RealFloat a => a -> Bool
isNegativeZero b
x = -a
0
                           | Bool
otherwise = RoundingMode -> Rational -> a
forall a. RoundedFractional a => RoundingMode -> Rational -> a
roundedFromRational RoundingMode
r (b -> Rational
forall a. Real a => a -> Rational
toRational b
x)
  intervalDiv :: Rounded 'TowardNegInf a -> Rounded 'TowardInf a -> Rounded 'TowardNegInf a -> Rounded 'TowardInf a -> (Rounded 'TowardNegInf a, Rounded 'TowardInf a)
  intervalDiv Rounded 'TowardNegInf a
x_lo Rounded 'TowardInf a
x_hi Rounded 'TowardNegInf a
y_lo Rounded 'TowardInf a
y_hi
    = ( [Rounded 'TowardNegInf a] -> Rounded 'TowardNegInf a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [        Rounded 'TowardNegInf a
x_lo Rounded 'TowardNegInf a
-> Rounded 'TowardNegInf a -> Rounded 'TowardNegInf a
forall (r :: RoundingMode).
Rounding r =>
Rounded r a -> Rounded r a -> Rounded r a
/        Rounded 'TowardNegInf a
y_lo
                ,        Rounded 'TowardNegInf a
x_lo Rounded 'TowardNegInf a
-> Rounded 'TowardNegInf a -> Rounded 'TowardNegInf a
forall (r :: RoundingMode).
Rounding r =>
Rounded r a -> Rounded r a -> Rounded r a
/ Rounded 'TowardInf a -> Rounded 'TowardNegInf a
coerce Rounded 'TowardInf a
y_hi
                , Rounded 'TowardInf a -> Rounded 'TowardNegInf a
coerce Rounded 'TowardInf a
x_hi Rounded 'TowardNegInf a
-> Rounded 'TowardNegInf a -> Rounded 'TowardNegInf a
forall (r :: RoundingMode).
Rounding r =>
Rounded r a -> Rounded r a -> Rounded r a
/        Rounded 'TowardNegInf a
y_lo
                , Rounded 'TowardInf a -> Rounded 'TowardNegInf a
coerce Rounded 'TowardInf a
x_hi Rounded 'TowardNegInf a
-> Rounded 'TowardNegInf a -> Rounded 'TowardNegInf a
forall (r :: RoundingMode).
Rounding r =>
Rounded r a -> Rounded r a -> Rounded r a
/ Rounded 'TowardInf a -> Rounded 'TowardNegInf a
coerce Rounded 'TowardInf a
y_hi
                ]
      , [Rounded 'TowardInf a] -> Rounded 'TowardInf a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [ Rounded 'TowardNegInf a -> Rounded 'TowardInf a
coerce Rounded 'TowardNegInf a
x_lo Rounded 'TowardInf a
-> Rounded 'TowardInf a -> Rounded 'TowardInf a
forall (r :: RoundingMode).
Rounding r =>
Rounded r a -> Rounded r a -> Rounded r a
/ Rounded 'TowardNegInf a -> Rounded 'TowardInf a
coerce Rounded 'TowardNegInf a
y_lo
                , Rounded 'TowardNegInf a -> Rounded 'TowardInf a
coerce Rounded 'TowardNegInf a
x_lo Rounded 'TowardInf a
-> Rounded 'TowardInf a -> Rounded 'TowardInf a
forall (r :: RoundingMode).
Rounding r =>
Rounded r a -> Rounded r a -> Rounded r a
/        Rounded 'TowardInf a
y_hi
                ,        Rounded 'TowardInf a
x_hi Rounded 'TowardInf a
-> Rounded 'TowardInf a -> Rounded 'TowardInf a
forall (r :: RoundingMode).
Rounding r =>
Rounded r a -> Rounded r a -> Rounded r a
/ Rounded 'TowardNegInf a -> Rounded 'TowardInf a
coerce Rounded 'TowardNegInf a
y_lo
                ,        Rounded 'TowardInf a
x_hi Rounded 'TowardInf a
-> Rounded 'TowardInf a -> Rounded 'TowardInf a
forall (r :: RoundingMode).
Rounding r =>
Rounded r a -> Rounded r a -> Rounded r a
/        Rounded 'TowardInf a
y_hi
                ]
      )
    where (/) :: forall r. Rounding r => Rounded r a -> Rounded r a -> Rounded r a
          Rounded a
x / :: Rounded r a -> Rounded r a -> Rounded r a
/ Rounded a
y = a -> Rounded r a
forall (r :: RoundingMode) a. a -> Rounded r a
Rounded (RoundingMode -> a -> a -> a
forall a. RoundedFractional a => RoundingMode -> a -> a -> a
roundedDiv (Proxy r -> RoundingMode
forall (r :: RoundingMode) (proxy :: RoundingMode -> *).
Rounding r =>
proxy r -> RoundingMode
rounding (Proxy r
forall k (t :: k). Proxy t
Proxy :: Proxy r)) a
x a
y)
  intervalDivAdd :: Rounded 'TowardNegInf a -> Rounded 'TowardInf a -> Rounded 'TowardNegInf a -> Rounded 'TowardInf a -> Rounded 'TowardNegInf a -> Rounded 'TowardInf a -> (Rounded 'TowardNegInf a, Rounded 'TowardInf a)
  intervalDivAdd Rounded 'TowardNegInf a
x_lo Rounded 'TowardInf a
x_hi Rounded 'TowardNegInf a
y_lo Rounded 'TowardInf a
y_hi Rounded 'TowardNegInf a
z_lo Rounded 'TowardInf a
z_hi = case Rounded 'TowardNegInf a
-> Rounded 'TowardInf a
-> Rounded 'TowardNegInf a
-> Rounded 'TowardInf a
-> (Rounded 'TowardNegInf a, Rounded 'TowardInf a)
forall a.
RoundedFractional a =>
Rounded 'TowardNegInf a
-> Rounded 'TowardInf a
-> Rounded 'TowardNegInf a
-> Rounded 'TowardInf a
-> (Rounded 'TowardNegInf a, Rounded 'TowardInf a)
intervalDiv Rounded 'TowardNegInf a
x_lo Rounded 'TowardInf a
x_hi Rounded 'TowardNegInf a
y_lo Rounded 'TowardInf a
y_hi of
                                                   (Rounded 'TowardNegInf a
xy_lo, Rounded 'TowardInf a
xy_hi) -> Rounded 'TowardNegInf a
-> Rounded 'TowardInf a
-> Rounded 'TowardNegInf a
-> Rounded 'TowardInf a
-> (Rounded 'TowardNegInf a, Rounded 'TowardInf a)
forall a.
RoundedRing a =>
Rounded 'TowardNegInf a
-> Rounded 'TowardInf a
-> Rounded 'TowardNegInf a
-> Rounded 'TowardInf a
-> (Rounded 'TowardNegInf a, Rounded 'TowardInf a)
intervalAdd Rounded 'TowardNegInf a
xy_lo Rounded 'TowardInf a
xy_hi Rounded 'TowardNegInf a
z_lo Rounded 'TowardInf a
z_hi
  intervalRecip :: Rounded 'TowardNegInf a -> Rounded 'TowardInf a -> (Rounded 'TowardNegInf a, Rounded 'TowardInf a)
  intervalRecip Rounded 'TowardNegInf a
x_lo Rounded 'TowardInf a
x_hi = (Rounded 'TowardNegInf a -> Rounded 'TowardNegInf a
forall (r :: RoundingMode).
Rounding r =>
Rounded r a -> Rounded r a
recip (Rounded 'TowardInf a -> Rounded 'TowardNegInf a
coerce Rounded 'TowardInf a
x_hi), Rounded 'TowardInf a -> Rounded 'TowardInf a
forall (r :: RoundingMode).
Rounding r =>
Rounded r a -> Rounded r a
recip (Rounded 'TowardNegInf a -> Rounded 'TowardInf a
coerce Rounded 'TowardNegInf a
x_lo))
    where recip :: forall r. Rounding r => Rounded r a -> Rounded r a
          recip :: Rounded r a -> Rounded r a
recip (Rounded a
x) = a -> Rounded r a
forall (r :: RoundingMode) a. a -> Rounded r a
Rounded (RoundingMode -> a -> a
forall a. RoundedFractional a => RoundingMode -> a -> a
roundedRecip (Proxy r -> RoundingMode
forall (r :: RoundingMode) (proxy :: RoundingMode -> *).
Rounding r =>
proxy r -> RoundingMode
rounding (Proxy r
forall k (t :: k). Proxy t
Proxy :: Proxy r)) a
x)
  intervalFromRational :: Rational -> (Rounded 'TowardNegInf a, Rounded 'TowardInf a)
  intervalFromRational Rational
x = (Rational -> Rounded 'TowardNegInf a
forall (r :: RoundingMode). Rounding r => Rational -> Rounded r a
fromRational Rational
x, Rational -> Rounded 'TowardInf a
forall (r :: RoundingMode). Rounding r => Rational -> Rounded r a
fromRational Rational
x)
    where fromRational :: forall r. Rounding r => Rational -> Rounded r a
          fromRational :: Rational -> Rounded r a
fromRational Rational
y = a -> Rounded r a
forall (r :: RoundingMode) a. a -> Rounded r a
Rounded (RoundingMode -> Rational -> a
forall a. RoundedFractional a => RoundingMode -> Rational -> a
roundedFromRational (Proxy r -> RoundingMode
forall (r :: RoundingMode) (proxy :: RoundingMode -> *).
Rounding r =>
proxy r -> RoundingMode
rounding (Proxy r
forall k (t :: k). Proxy t
Proxy :: Proxy r)) Rational
y)
  {-# INLINE intervalDiv #-}
  {-# INLINE intervalRecip #-}
  {-# INLINE intervalFromRational #-}

-- | Rounding-controlled version of 'sqrt'.
class RoundedRing a => RoundedSqrt a where
  roundedSqrt :: RoundingMode -> a -> a
  intervalSqrt :: Rounded 'TowardNegInf a -> Rounded 'TowardInf a -> (Rounded 'TowardNegInf a, Rounded 'TowardInf a)
  intervalSqrt Rounded 'TowardNegInf a
x Rounded 'TowardInf a
y = (Rounded 'TowardNegInf a -> Rounded 'TowardNegInf a
forall (r :: RoundingMode).
Rounding r =>
Rounded r a -> Rounded r a
sqrt Rounded 'TowardNegInf a
x, Rounded 'TowardInf a -> Rounded 'TowardInf a
forall (r :: RoundingMode).
Rounding r =>
Rounded r a -> Rounded r a
sqrt Rounded 'TowardInf a
y)
    where sqrt :: forall r. Rounding r => Rounded r a -> Rounded r a
          sqrt :: Rounded r a -> Rounded r a
sqrt (Rounded a
z) = a -> Rounded r a
forall (r :: RoundingMode) a. a -> Rounded r a
Rounded (RoundingMode -> a -> a
forall a. RoundedSqrt a => RoundingMode -> a -> a
roundedSqrt (Proxy r -> RoundingMode
forall (r :: RoundingMode) (proxy :: RoundingMode -> *).
Rounding r =>
proxy r -> RoundingMode
rounding (Proxy r
forall k (t :: k). Proxy t
Proxy :: Proxy r)) a
z)
  {-# INLINE intervalSqrt #-}

-- | Lifted version of 'RoundedRing'
class RoundedRing a => RoundedRing_Vector vector a where
  -- | Equivalent to @\\r -> foldl ('roundedAdd' r) 0@
  roundedSum :: RoundingMode -> vector a -> a
  -- | Equivalent to @zipWith . 'roundedAdd'@
  zipWith_roundedAdd :: RoundingMode -> vector a -> vector a -> vector a
  -- | Equivalent to @zipWith . 'roundedSub'@
  zipWith_roundedSub :: RoundingMode -> vector a -> vector a -> vector a
  -- | Equivalent to @zipWith . 'roundedMul'@
  zipWith_roundedMul :: RoundingMode -> vector a -> vector a -> vector a
  -- | Equivalent to @zipWith3 . 'roundedFusedMultiplyAdd'@
  zipWith3_roundedFusedMultiplyAdd :: RoundingMode -> vector a -> vector a -> vector a -> vector a

  default roundedSum :: (VG.Vector vector a, Num a) => RoundingMode -> vector a -> a
  roundedSum RoundingMode
mode = (a -> a -> a) -> a -> vector a -> a
forall (v :: * -> *) b a.
Vector v b =>
(a -> b -> a) -> a -> v b -> a
VG.foldl' (RoundingMode -> a -> a -> a
forall a. RoundedRing a => RoundingMode -> a -> a -> a
roundedAdd RoundingMode
mode) a
0

  default zipWith_roundedAdd :: (VG.Vector vector a) => RoundingMode -> vector a -> vector a -> vector a
  zipWith_roundedAdd RoundingMode
mode = (a -> a -> a) -> vector a -> vector a -> vector a
forall (v :: * -> *) a b c.
(Vector v a, Vector v b, Vector v c) =>
(a -> b -> c) -> v a -> v b -> v c
VG.zipWith (RoundingMode -> a -> a -> a
forall a. RoundedRing a => RoundingMode -> a -> a -> a
roundedAdd RoundingMode
mode)

  default zipWith_roundedSub :: (VG.Vector vector a) => RoundingMode -> vector a -> vector a -> vector a
  zipWith_roundedSub RoundingMode
mode = (a -> a -> a) -> vector a -> vector a -> vector a
forall (v :: * -> *) a b c.
(Vector v a, Vector v b, Vector v c) =>
(a -> b -> c) -> v a -> v b -> v c
VG.zipWith (RoundingMode -> a -> a -> a
forall a. RoundedRing a => RoundingMode -> a -> a -> a
roundedSub RoundingMode
mode)

  default zipWith_roundedMul :: (VG.Vector vector a) => RoundingMode -> vector a -> vector a -> vector a
  zipWith_roundedMul RoundingMode
mode = (a -> a -> a) -> vector a -> vector a -> vector a
forall (v :: * -> *) a b c.
(Vector v a, Vector v b, Vector v c) =>
(a -> b -> c) -> v a -> v b -> v c
VG.zipWith (RoundingMode -> a -> a -> a
forall a. RoundedRing a => RoundingMode -> a -> a -> a
roundedMul RoundingMode
mode)

  default zipWith3_roundedFusedMultiplyAdd :: (VG.Vector vector a) => RoundingMode -> vector a -> vector a -> vector a -> vector a
  zipWith3_roundedFusedMultiplyAdd RoundingMode
mode = (a -> a -> a -> a) -> vector a -> vector a -> vector a -> vector a
forall (v :: * -> *) a b c d.
(Vector v a, Vector v b, Vector v c, Vector v d) =>
(a -> b -> c -> d) -> v a -> v b -> v c -> v d
VG.zipWith3 (RoundingMode -> a -> a -> a -> a
forall a. RoundedRing a => RoundingMode -> a -> a -> a -> a
roundedFusedMultiplyAdd RoundingMode
mode)

-- | Lifted version of 'RoundedFractional'
class (RoundedFractional a, RoundedRing_Vector vector a) => RoundedFractional_Vector vector a where
  -- | Equivalent to @zipWith . 'roundedDiv'@
  zipWith_roundedDiv :: RoundingMode -> vector a -> vector a -> vector a
  -- map_roundedRecip :: RoundingMode -> vector a -> vector a

  default zipWith_roundedDiv :: (VG.Vector vector a) => RoundingMode -> vector a -> vector a -> vector a
  zipWith_roundedDiv RoundingMode
mode = (a -> a -> a) -> vector a -> vector a -> vector a
forall (v :: * -> *) a b c.
(Vector v a, Vector v b, Vector v c) =>
(a -> b -> c) -> v a -> v b -> v c
VG.zipWith (RoundingMode -> a -> a -> a
forall a. RoundedFractional a => RoundingMode -> a -> a -> a
roundedDiv RoundingMode
mode)

-- | Lifted version of 'RoundedSqrt'
class (RoundedSqrt a, RoundedRing_Vector vector a) => RoundedSqrt_Vector vector a where
  -- | Equivalent to @map . 'roundedSqrt'@
  map_roundedSqrt :: RoundingMode -> vector a -> vector a

  default map_roundedSqrt :: (VG.Vector vector a) => RoundingMode -> vector a -> vector a
  map_roundedSqrt RoundingMode
mode = (a -> a) -> vector a -> vector a
forall (v :: * -> *) a b.
(Vector v a, Vector v b) =>
(a -> b) -> v a -> v b
VG.map (RoundingMode -> a -> a
forall a. RoundedSqrt a => RoundingMode -> a -> a
roundedSqrt RoundingMode
mode)

instance (Rounding r, Num a, RoundedRing a) => Num (Rounded r a) where
  Rounded a
x + :: Rounded r a -> Rounded r a -> Rounded r a
+ Rounded a
y = a -> Rounded r a
forall (r :: RoundingMode) a. a -> Rounded r a
Rounded (RoundingMode -> a -> a -> a
forall a. RoundedRing a => RoundingMode -> a -> a -> a
roundedAdd (Proxy r -> RoundingMode
forall (r :: RoundingMode) (proxy :: RoundingMode -> *).
Rounding r =>
proxy r -> RoundingMode
rounding (Proxy r
forall k (t :: k). Proxy t
Proxy :: Proxy r)) a
x a
y)
  Rounded a
x - :: Rounded r a -> Rounded r a -> Rounded r a
- Rounded a
y = a -> Rounded r a
forall (r :: RoundingMode) a. a -> Rounded r a
Rounded (RoundingMode -> a -> a -> a
forall a. RoundedRing a => RoundingMode -> a -> a -> a
roundedSub (Proxy r -> RoundingMode
forall (r :: RoundingMode) (proxy :: RoundingMode -> *).
Rounding r =>
proxy r -> RoundingMode
rounding (Proxy r
forall k (t :: k). Proxy t
Proxy :: Proxy r)) a
x a
y)
  Rounded a
x * :: Rounded r a -> Rounded r a -> Rounded r a
* Rounded a
y = a -> Rounded r a
forall (r :: RoundingMode) a. a -> Rounded r a
Rounded (RoundingMode -> a -> a -> a
forall a. RoundedRing a => RoundingMode -> a -> a -> a
roundedMul (Proxy r -> RoundingMode
forall (r :: RoundingMode) (proxy :: RoundingMode -> *).
Rounding r =>
proxy r -> RoundingMode
rounding (Proxy r
forall k (t :: k). Proxy t
Proxy :: Proxy r)) a
x a
y)
  negate :: Rounded r a -> Rounded r a
negate = (a -> a) -> Rounded r a -> Rounded r a
coerce (a -> a
forall a. Num a => a -> a
negate :: a -> a)
  abs :: Rounded r a -> Rounded r a
abs = (a -> a) -> Rounded r a -> Rounded r a
coerce (a -> a
forall a. Num a => a -> a
abs :: a -> a)
  signum :: Rounded r a -> Rounded r a
signum = (a -> a) -> Rounded r a -> Rounded r a
coerce (a -> a
forall a. Num a => a -> a
signum :: a -> a)
  fromInteger :: Integer -> Rounded r a
fromInteger Integer
x = a -> Rounded r a
forall (r :: RoundingMode) a. a -> Rounded r a
Rounded (RoundingMode -> Integer -> a
forall a. RoundedRing a => RoundingMode -> Integer -> a
roundedFromInteger (Proxy r -> RoundingMode
forall (r :: RoundingMode) (proxy :: RoundingMode -> *).
Rounding r =>
proxy r -> RoundingMode
rounding (Proxy r
forall k (t :: k). Proxy t
Proxy :: Proxy r)) Integer
x)
  {-# INLINE (+) #-}
  {-# INLINE (-) #-}
  {-# INLINE (*) #-}
  {-# INLINE negate #-}
  {-# INLINE abs #-}
  {-# INLINE signum #-}
  {-# INLINE fromInteger #-}

instance (Rounding r, Num a, RoundedFractional a) => Fractional (Rounded r a) where
  Rounded a
x / :: Rounded r a -> Rounded r a -> Rounded r a
/ Rounded a
y = a -> Rounded r a
forall (r :: RoundingMode) a. a -> Rounded r a
Rounded (RoundingMode -> a -> a -> a
forall a. RoundedFractional a => RoundingMode -> a -> a -> a
roundedDiv (Proxy r -> RoundingMode
forall (r :: RoundingMode) (proxy :: RoundingMode -> *).
Rounding r =>
proxy r -> RoundingMode
rounding (Proxy r
forall k (t :: k). Proxy t
Proxy :: Proxy r)) a
x a
y)
  recip :: Rounded r a -> Rounded r a
recip (Rounded a
x) = a -> Rounded r a
forall (r :: RoundingMode) a. a -> Rounded r a
Rounded (RoundingMode -> a -> a
forall a. RoundedFractional a => RoundingMode -> a -> a
roundedRecip (Proxy r -> RoundingMode
forall (r :: RoundingMode) (proxy :: RoundingMode -> *).
Rounding r =>
proxy r -> RoundingMode
rounding (Proxy r
forall k (t :: k). Proxy t
Proxy :: Proxy r)) a
x)
  fromRational :: Rational -> Rounded r a
fromRational Rational
x = a -> Rounded r a
forall (r :: RoundingMode) a. a -> Rounded r a
Rounded (RoundingMode -> Rational -> a
forall a. RoundedFractional a => RoundingMode -> Rational -> a
roundedFromRational (Proxy r -> RoundingMode
forall (r :: RoundingMode) (proxy :: RoundingMode -> *).
Rounding r =>
proxy r -> RoundingMode
rounding (Proxy r
forall k (t :: k). Proxy t
Proxy :: Proxy r)) Rational
x)
  {-# INLINE (/) #-}
  {-# INLINE recip #-}
  {-# INLINE fromRational #-}

deriving newtype instance (Rounding r, Real a, RoundedFractional a) => Real (Rounded r a)
deriving newtype instance (Rounding r, RealFrac a, RoundedFractional a) => RealFrac (Rounded r a)
-- no instance for Floating/RealFloat currently...

-- These instances are provided in Numeric.Rounded.Hardware.Backend.Default:
--   instance RoundedRing Float
--   instance RoundedFractional Float
--   instance RoundedSqrt Float
--   instance RoundedRing Double
--   instance RoundedFractional Double
--   instance RoundedSqrt Double

instance RoundedRing Integer where
  roundedAdd :: RoundingMode -> Integer -> Integer -> Integer
roundedAdd RoundingMode
_ = Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
(Prelude.+)
  roundedSub :: RoundingMode -> Integer -> Integer -> Integer
roundedSub RoundingMode
_ = Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
(Prelude.-)
  roundedMul :: RoundingMode -> Integer -> Integer -> Integer
roundedMul RoundingMode
_ = Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
(Prelude.*)
  roundedFusedMultiplyAdd :: RoundingMode -> Integer -> Integer -> Integer -> Integer
roundedFusedMultiplyAdd RoundingMode
_ Integer
x Integer
y Integer
z = Integer
x Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
Prelude.* Integer
y Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
Prelude.+ Integer
z
  roundedFromInteger :: RoundingMode -> Integer -> Integer
roundedFromInteger RoundingMode
_ = Integer -> Integer
forall a. a -> a
id
  backendNameT :: Tagged Integer String
backendNameT = String -> Tagged Integer String
forall k (s :: k) b. b -> Tagged s b
Tagged String
"Integer"

instance RoundedFractional Integer where
  roundedDiv :: RoundingMode -> Integer -> Integer -> Integer
roundedDiv RoundingMode
r Integer
x Integer
y = RoundingMode -> Rational -> Integer
forall a. RoundedFractional a => RoundingMode -> Rational -> a
roundedFromRational RoundingMode
r (Integer
x Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
y)
  roundedFromRational :: RoundingMode -> Rational -> Integer
roundedFromRational RoundingMode
ToNearest    = Rational -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
round
  roundedFromRational RoundingMode
TowardNegInf = Rational -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
floor
  roundedFromRational RoundingMode
TowardInf    = Rational -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
ceiling
  roundedFromRational RoundingMode
TowardZero   = Rational -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
truncate
  roundedFromRealFloat :: RoundingMode -> b -> Integer
roundedFromRealFloat RoundingMode
r b
x | b -> Bool
forall a. RealFloat a => a -> Bool
isNaN b
x = String -> Integer
forall a. HasCallStack => String -> a
error String
"NaN"
                           | b -> Bool
forall a. RealFloat a => a -> Bool
isInfinite b
x = String -> Integer
forall a. HasCallStack => String -> a
error String
"Infinity"
                           | Bool
otherwise = RoundingMode -> Rational -> Integer
forall a. RoundedFractional a => RoundingMode -> Rational -> a
roundedFromRational RoundingMode
r (b -> Rational
forall a. Real a => a -> Rational
toRational b
x)

-- TODO: instance RoundedSqrt Integer

instance Integral a => RoundedRing (Ratio a) where
  roundedAdd :: RoundingMode -> Ratio a -> Ratio a -> Ratio a
roundedAdd RoundingMode
_ = Ratio a -> Ratio a -> Ratio a
forall a. Num a => a -> a -> a
(Prelude.+)
  roundedSub :: RoundingMode -> Ratio a -> Ratio a -> Ratio a
roundedSub RoundingMode
_ = Ratio a -> Ratio a -> Ratio a
forall a. Num a => a -> a -> a
(Prelude.-)
  roundedMul :: RoundingMode -> Ratio a -> Ratio a -> Ratio a
roundedMul RoundingMode
_ = Ratio a -> Ratio a -> Ratio a
forall a. Num a => a -> a -> a
(Prelude.*)
  roundedFusedMultiplyAdd :: RoundingMode -> Ratio a -> Ratio a -> Ratio a -> Ratio a
roundedFusedMultiplyAdd RoundingMode
_ Ratio a
x Ratio a
y Ratio a
z = Ratio a
x Ratio a -> Ratio a -> Ratio a
forall a. Num a => a -> a -> a
Prelude.* Ratio a
y Ratio a -> Ratio a -> Ratio a
forall a. Num a => a -> a -> a
Prelude.+ Ratio a
z
  roundedFromInteger :: RoundingMode -> Integer -> Ratio a
roundedFromInteger RoundingMode
_ = Integer -> Ratio a
forall a. Num a => Integer -> a
Prelude.fromInteger
  backendNameT :: Tagged (Ratio a) String
backendNameT = String -> Tagged (Ratio a) String
forall k (s :: k) b. b -> Tagged s b
Tagged String
"Rational"

instance Integral a => RoundedFractional (Ratio a) where
  roundedDiv :: RoundingMode -> Ratio a -> Ratio a -> Ratio a
roundedDiv RoundingMode
_ = Ratio a -> Ratio a -> Ratio a
forall a. Fractional a => a -> a -> a
(Prelude./)
  roundedRecip :: RoundingMode -> Ratio a -> Ratio a
roundedRecip RoundingMode
_ = Ratio a -> Ratio a
forall a. Fractional a => a -> a
Prelude.recip
  roundedFromRational :: RoundingMode -> Rational -> Ratio a
roundedFromRational RoundingMode
_ = Rational -> Ratio a
forall a. Fractional a => Rational -> a
Prelude.fromRational
  roundedFromRealFloat :: RoundingMode -> b -> Ratio a
roundedFromRealFloat RoundingMode
_ b
x | b -> Bool
forall a. RealFloat a => a -> Bool
isNaN b
x = String -> Ratio a
forall a. HasCallStack => String -> a
error String
"NaN"
                           | b -> Bool
forall a. RealFloat a => a -> Bool
isInfinite b
x = String -> Ratio a
forall a. HasCallStack => String -> a
error String
"Infinity"
                           | Bool
otherwise = Rational -> Ratio a
forall a. Fractional a => Rational -> a
Prelude.fromRational (b -> Rational
forall a. Real a => a -> Rational
toRational b
x)

-- There is no RoundedSqrt (Ratio a)