{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
module Numeric.Rounded.Hardware.Backend.ViaRational where
import           Control.DeepSeq (NFData (..))
import           Control.Exception (assert)
import           Data.Coerce
import           Data.Tagged
import qualified Data.Vector.Generic as VG
import qualified Data.Vector.Generic.Mutable as VGM
import qualified Data.Vector.Storable as VS
import qualified Data.Vector.Unboxed as VU
import qualified Data.Vector.Unboxed.Mutable as VUM
import           Foreign.Storable (Storable)
import           GHC.Generics (Generic)
import           Numeric.Rounded.Hardware.Internal.Class
import           Numeric.Rounded.Hardware.Internal.Constants
import           Numeric.Rounded.Hardware.Internal.Conversion
import           Numeric.Floating.IEEE (isFinite, nextDown, nextUp)

newtype ViaRational a = ViaRational a
  deriving (ViaRational a -> ViaRational a -> Bool
(ViaRational a -> ViaRational a -> Bool)
-> (ViaRational a -> ViaRational a -> Bool) -> Eq (ViaRational a)
forall a. Eq a => ViaRational a -> ViaRational a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ViaRational a -> ViaRational a -> Bool
$c/= :: forall a. Eq a => ViaRational a -> ViaRational a -> Bool
== :: ViaRational a -> ViaRational a -> Bool
$c== :: forall a. Eq a => ViaRational a -> ViaRational a -> Bool
Eq,Eq (ViaRational a)
Eq (ViaRational a)
-> (ViaRational a -> ViaRational a -> Ordering)
-> (ViaRational a -> ViaRational a -> Bool)
-> (ViaRational a -> ViaRational a -> Bool)
-> (ViaRational a -> ViaRational a -> Bool)
-> (ViaRational a -> ViaRational a -> Bool)
-> (ViaRational a -> ViaRational a -> ViaRational a)
-> (ViaRational a -> ViaRational a -> ViaRational a)
-> Ord (ViaRational a)
ViaRational a -> ViaRational a -> Bool
ViaRational a -> ViaRational a -> Ordering
ViaRational a -> ViaRational a -> ViaRational a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (ViaRational a)
forall a. Ord a => ViaRational a -> ViaRational a -> Bool
forall a. Ord a => ViaRational a -> ViaRational a -> Ordering
forall a. Ord a => ViaRational a -> ViaRational a -> ViaRational a
min :: ViaRational a -> ViaRational a -> ViaRational a
$cmin :: forall a. Ord a => ViaRational a -> ViaRational a -> ViaRational a
max :: ViaRational a -> ViaRational a -> ViaRational a
$cmax :: forall a. Ord a => ViaRational a -> ViaRational a -> ViaRational a
>= :: ViaRational a -> ViaRational a -> Bool
$c>= :: forall a. Ord a => ViaRational a -> ViaRational a -> Bool
> :: ViaRational a -> ViaRational a -> Bool
$c> :: forall a. Ord a => ViaRational a -> ViaRational a -> Bool
<= :: ViaRational a -> ViaRational a -> Bool
$c<= :: forall a. Ord a => ViaRational a -> ViaRational a -> Bool
< :: ViaRational a -> ViaRational a -> Bool
$c< :: forall a. Ord a => ViaRational a -> ViaRational a -> Bool
compare :: ViaRational a -> ViaRational a -> Ordering
$ccompare :: forall a. Ord a => ViaRational a -> ViaRational a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (ViaRational a)
Ord,Int -> ViaRational a -> ShowS
[ViaRational a] -> ShowS
ViaRational a -> String
(Int -> ViaRational a -> ShowS)
-> (ViaRational a -> String)
-> ([ViaRational a] -> ShowS)
-> Show (ViaRational a)
forall a. Show a => Int -> ViaRational a -> ShowS
forall a. Show a => [ViaRational a] -> ShowS
forall a. Show a => ViaRational a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ViaRational a] -> ShowS
$cshowList :: forall a. Show a => [ViaRational a] -> ShowS
show :: ViaRational a -> String
$cshow :: forall a. Show a => ViaRational a -> String
showsPrec :: Int -> ViaRational a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> ViaRational a -> ShowS
Show,(forall x. ViaRational a -> Rep (ViaRational a) x)
-> (forall x. Rep (ViaRational a) x -> ViaRational a)
-> Generic (ViaRational a)
forall x. Rep (ViaRational a) x -> ViaRational a
forall x. ViaRational a -> Rep (ViaRational a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (ViaRational a) x -> ViaRational a
forall a x. ViaRational a -> Rep (ViaRational a) x
$cto :: forall a x. Rep (ViaRational a) x -> ViaRational a
$cfrom :: forall a x. ViaRational a -> Rep (ViaRational a) x
Generic,Integer -> ViaRational a
ViaRational a -> ViaRational a
ViaRational a -> ViaRational a -> ViaRational a
(ViaRational a -> ViaRational a -> ViaRational a)
-> (ViaRational a -> ViaRational a -> ViaRational a)
-> (ViaRational a -> ViaRational a -> ViaRational a)
-> (ViaRational a -> ViaRational a)
-> (ViaRational a -> ViaRational a)
-> (ViaRational a -> ViaRational a)
-> (Integer -> ViaRational a)
-> Num (ViaRational a)
forall a. Num a => Integer -> ViaRational a
forall a. Num a => ViaRational a -> ViaRational a
forall a. Num a => ViaRational a -> ViaRational a -> ViaRational a
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> ViaRational a
$cfromInteger :: forall a. Num a => Integer -> ViaRational a
signum :: ViaRational a -> ViaRational a
$csignum :: forall a. Num a => ViaRational a -> ViaRational a
abs :: ViaRational a -> ViaRational a
$cabs :: forall a. Num a => ViaRational a -> ViaRational a
negate :: ViaRational a -> ViaRational a
$cnegate :: forall a. Num a => ViaRational a -> ViaRational a
* :: ViaRational a -> ViaRational a -> ViaRational a
$c* :: forall a. Num a => ViaRational a -> ViaRational a -> ViaRational a
- :: ViaRational a -> ViaRational a -> ViaRational a
$c- :: forall a. Num a => ViaRational a -> ViaRational a -> ViaRational a
+ :: ViaRational a -> ViaRational a -> ViaRational a
$c+ :: forall a. Num a => ViaRational a -> ViaRational a -> ViaRational a
Num,Ptr b -> Int -> IO (ViaRational a)
Ptr b -> Int -> ViaRational a -> IO ()
Ptr (ViaRational a) -> IO (ViaRational a)
Ptr (ViaRational a) -> Int -> IO (ViaRational a)
Ptr (ViaRational a) -> Int -> ViaRational a -> IO ()
Ptr (ViaRational a) -> ViaRational a -> IO ()
ViaRational a -> Int
(ViaRational a -> Int)
-> (ViaRational a -> Int)
-> (Ptr (ViaRational a) -> Int -> IO (ViaRational a))
-> (Ptr (ViaRational a) -> Int -> ViaRational a -> IO ())
-> (forall b. Ptr b -> Int -> IO (ViaRational a))
-> (forall b. Ptr b -> Int -> ViaRational a -> IO ())
-> (Ptr (ViaRational a) -> IO (ViaRational a))
-> (Ptr (ViaRational a) -> ViaRational a -> IO ())
-> Storable (ViaRational a)
forall b. Ptr b -> Int -> IO (ViaRational a)
forall b. Ptr b -> Int -> ViaRational a -> IO ()
forall a. Storable a => Ptr (ViaRational a) -> IO (ViaRational a)
forall a.
Storable a =>
Ptr (ViaRational a) -> Int -> IO (ViaRational a)
forall a.
Storable a =>
Ptr (ViaRational a) -> Int -> ViaRational a -> IO ()
forall a.
Storable a =>
Ptr (ViaRational a) -> ViaRational a -> IO ()
forall a. Storable a => ViaRational a -> Int
forall a b. Storable a => Ptr b -> Int -> IO (ViaRational a)
forall a b. Storable a => Ptr b -> Int -> ViaRational a -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
poke :: Ptr (ViaRational a) -> ViaRational a -> IO ()
$cpoke :: forall a.
Storable a =>
Ptr (ViaRational a) -> ViaRational a -> IO ()
peek :: Ptr (ViaRational a) -> IO (ViaRational a)
$cpeek :: forall a. Storable a => Ptr (ViaRational a) -> IO (ViaRational a)
pokeByteOff :: Ptr b -> Int -> ViaRational a -> IO ()
$cpokeByteOff :: forall a b. Storable a => Ptr b -> Int -> ViaRational a -> IO ()
peekByteOff :: Ptr b -> Int -> IO (ViaRational a)
$cpeekByteOff :: forall a b. Storable a => Ptr b -> Int -> IO (ViaRational a)
pokeElemOff :: Ptr (ViaRational a) -> Int -> ViaRational a -> IO ()
$cpokeElemOff :: forall a.
Storable a =>
Ptr (ViaRational a) -> Int -> ViaRational a -> IO ()
peekElemOff :: Ptr (ViaRational a) -> Int -> IO (ViaRational a)
$cpeekElemOff :: forall a.
Storable a =>
Ptr (ViaRational a) -> Int -> IO (ViaRational a)
alignment :: ViaRational a -> Int
$calignment :: forall a. Storable a => ViaRational a -> Int
sizeOf :: ViaRational a -> Int
$csizeOf :: forall a. Storable a => ViaRational a -> Int
Storable)

instance NFData a => NFData (ViaRational a)

instance (RealFloat a, Num a, RealFloatConstants a) => RoundedRing (ViaRational a) where
  roundedAdd :: RoundingMode -> ViaRational a -> ViaRational a -> ViaRational a
roundedAdd RoundingMode
r (ViaRational a
x) (ViaRational a
y)
    | a -> Bool
forall a. RealFloat a => a -> Bool
isNaN a
x Bool -> Bool -> Bool
|| a -> Bool
forall a. RealFloat a => a -> Bool
isNaN a
y Bool -> Bool -> Bool
|| a -> Bool
forall a. RealFloat a => a -> Bool
isInfinite a
x Bool -> Bool -> Bool
|| a -> Bool
forall a. RealFloat a => a -> Bool
isInfinite a
y = a -> ViaRational a
forall a. a -> ViaRational a
ViaRational (a
x a -> a -> a
forall a. Num a => a -> a -> a
+ a
y)
    | a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0 Bool -> Bool -> Bool
&& a
y a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0 = a -> ViaRational a
forall a. a -> ViaRational a
ViaRational (a -> ViaRational a) -> a -> ViaRational a
forall a b. (a -> b) -> a -> b
$ if a -> Bool
forall a. RealFloat a => a -> Bool
isNegativeZero a
x Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== a -> Bool
forall a. RealFloat a => a -> Bool
isNegativeZero a
y
                                       then a
x
                                       else a
roundedZero
    | Bool
otherwise = case a -> Rational
forall a. Real a => a -> Rational
toRational a
x Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ a -> Rational
forall a. Real a => a -> Rational
toRational a
y of
                    Rational
0 -> a -> ViaRational a
forall a. a -> ViaRational a
ViaRational a
roundedZero
                    Rational
z -> RoundingMode -> Rational -> ViaRational a
forall a. RoundedFractional a => RoundingMode -> Rational -> a
roundedFromRational RoundingMode
r Rational
z
    where roundedZero :: a
roundedZero = case RoundingMode
r of
            RoundingMode
ToNearest    ->  a
0
            RoundingMode
TowardNegInf -> -a
0
            RoundingMode
TowardInf    ->  a
0
            RoundingMode
TowardZero   ->  a
0
  roundedSub :: RoundingMode -> ViaRational a -> ViaRational a -> ViaRational a
roundedSub RoundingMode
r (ViaRational a
x) (ViaRational a
y)
    | a -> Bool
forall a. RealFloat a => a -> Bool
isNaN a
x Bool -> Bool -> Bool
|| a -> Bool
forall a. RealFloat a => a -> Bool
isNaN a
y Bool -> Bool -> Bool
|| a -> Bool
forall a. RealFloat a => a -> Bool
isInfinite a
x Bool -> Bool -> Bool
|| a -> Bool
forall a. RealFloat a => a -> Bool
isInfinite a
y = a -> ViaRational a
forall a. a -> ViaRational a
ViaRational (a
x a -> a -> a
forall a. Num a => a -> a -> a
- a
y)
    | a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0 Bool -> Bool -> Bool
&& a
y a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0 = a -> ViaRational a
forall a. a -> ViaRational a
ViaRational (a -> ViaRational a) -> a -> ViaRational a
forall a b. (a -> b) -> a -> b
$ if a -> Bool
forall a. RealFloat a => a -> Bool
isNegativeZero a
x Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
/= a -> Bool
forall a. RealFloat a => a -> Bool
isNegativeZero a
y
                                       then a
x
                                       else a
roundedZero
    | Bool
otherwise = case a -> Rational
forall a. Real a => a -> Rational
toRational a
x Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
- a -> Rational
forall a. Real a => a -> Rational
toRational a
y of
                    Rational
0 -> a -> ViaRational a
forall a. a -> ViaRational a
ViaRational a
roundedZero
                    Rational
z -> RoundingMode -> Rational -> ViaRational a
forall a. RoundedFractional a => RoundingMode -> Rational -> a
roundedFromRational RoundingMode
r Rational
z
    where roundedZero :: a
roundedZero = case RoundingMode
r of
            RoundingMode
ToNearest    ->  a
0
            RoundingMode
TowardNegInf -> -a
0
            RoundingMode
TowardInf    ->  a
0
            RoundingMode
TowardZero   ->  a
0
  roundedMul :: RoundingMode -> ViaRational a -> ViaRational a -> ViaRational a
roundedMul RoundingMode
r (ViaRational a
x) (ViaRational a
y)
    | a -> Bool
forall a. RealFloat a => a -> Bool
isNaN a
x Bool -> Bool -> Bool
|| a -> Bool
forall a. RealFloat a => a -> Bool
isNaN a
y Bool -> Bool -> Bool
|| a -> Bool
forall a. RealFloat a => a -> Bool
isInfinite a
x Bool -> Bool -> Bool
|| a -> Bool
forall a. RealFloat a => a -> Bool
isInfinite a
y Bool -> Bool -> Bool
|| a -> Bool
forall a. RealFloat a => a -> Bool
isNegativeZero a
x Bool -> Bool -> Bool
|| a -> Bool
forall a. RealFloat a => a -> Bool
isNegativeZero a
y = a -> ViaRational a
forall a. a -> ViaRational a
ViaRational (a
x a -> a -> a
forall a. Num a => a -> a -> a
* a
y)
    | Bool
otherwise = RoundingMode -> Rational -> ViaRational a
forall a. RoundedFractional a => RoundingMode -> Rational -> a
roundedFromRational RoundingMode
r (a -> Rational
forall a. Real a => a -> Rational
toRational a
x Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* a -> Rational
forall a. Real a => a -> Rational
toRational a
y)
  roundedFusedMultiplyAdd :: RoundingMode
-> ViaRational a -> ViaRational a -> ViaRational a -> ViaRational a
roundedFusedMultiplyAdd RoundingMode
r (ViaRational a
x) (ViaRational a
y) (ViaRational a
z)
    | a -> Bool
forall a. RealFloat a => a -> Bool
isFinite a
x Bool -> Bool -> Bool
&& a -> Bool
forall a. RealFloat a => a -> Bool
isFinite a
y Bool -> Bool -> Bool
&& a -> Bool
forall a. RealFloat a => a -> Bool
isFinite a
z = case a -> Rational
forall a. Real a => a -> Rational
toRational a
x Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* a -> Rational
forall a. Real a => a -> Rational
toRational a
y Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ a -> Rational
forall a. Real a => a -> Rational
toRational a
z of
                    Rational
0 -> if a
z a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0 Bool -> Bool -> Bool
&& a -> Bool
forall a. RealFloat a => a -> Bool
isNegativeZero (a
x a -> a -> a
forall a. Num a => a -> a -> a
* a
y) Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== a -> Bool
forall a. RealFloat a => a -> Bool
isNegativeZero a
z
                         then a -> ViaRational a
forall a. a -> ViaRational a
ViaRational a
z
                         else a -> ViaRational a
forall a. a -> ViaRational a
ViaRational a
roundedZero
                    Rational
w -> RoundingMode -> Rational -> ViaRational a
forall a. RoundedFractional a => RoundingMode -> Rational -> a
roundedFromRational RoundingMode
r Rational
w
    | a -> Bool
forall a. RealFloat a => a -> Bool
isFinite a
x Bool -> Bool -> Bool
&& a -> Bool
forall a. RealFloat a => a -> Bool
isFinite a
y = a -> ViaRational a
forall a. a -> ViaRational a
ViaRational a
z -- Infinity or NaN
    | Bool
otherwise = a -> ViaRational a
forall a. a -> ViaRational a
ViaRational (a
x a -> a -> a
forall a. Num a => a -> a -> a
* a
y a -> a -> a
forall a. Num a => a -> a -> a
+ a
z)
      where roundedZero :: a
roundedZero = case RoundingMode
r of
              RoundingMode
ToNearest    ->  a
0
              RoundingMode
TowardNegInf -> -a
0
              RoundingMode
TowardInf    ->  a
0
              RoundingMode
TowardZero   ->  a
0
  roundedFromInteger :: RoundingMode -> Integer -> ViaRational a
roundedFromInteger RoundingMode
r Integer
x = a -> ViaRational a
forall a. a -> ViaRational a
ViaRational (RoundingMode -> Integer -> a
forall a. RealFloat a => RoundingMode -> Integer -> a
roundedFromInteger_default RoundingMode
r Integer
x)
  intervalFromInteger :: Integer
-> (Rounded 'TowardNegInf (ViaRational a),
    Rounded 'TowardInf (ViaRational a))
intervalFromInteger Integer
x = case Integer -> (Rounded 'TowardNegInf a, Rounded 'TowardInf a)
forall a.
RealFloat a =>
Integer -> (Rounded 'TowardNegInf a, Rounded 'TowardInf a)
intervalFromInteger_default Integer
x of
    (Rounded 'TowardNegInf a
a, Rounded 'TowardInf a
b) -> (a -> ViaRational a
forall a. a -> ViaRational a
ViaRational (a -> ViaRational a)
-> Rounded 'TowardNegInf a -> Rounded 'TowardNegInf (ViaRational a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Rounded 'TowardNegInf a
a, a -> ViaRational a
forall a. a -> ViaRational a
ViaRational (a -> ViaRational a)
-> Rounded 'TowardInf a -> Rounded 'TowardInf (ViaRational a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Rounded 'TowardInf a
b)
  backendNameT :: Tagged (ViaRational a) String
backendNameT = String -> Tagged (ViaRational a) String
forall k (s :: k) b. b -> Tagged s b
Tagged String
"via Rational"
  {-# INLINE roundedFromInteger #-}
  {-# INLINE intervalFromInteger #-}
  {-# SPECIALIZE instance RoundedRing (ViaRational Float) #-}
  {-# SPECIALIZE instance RoundedRing (ViaRational Double) #-}

instance (RealFloat a, Num a, RealFloatConstants a) => RoundedFractional (ViaRational a) where
  roundedDiv :: RoundingMode -> ViaRational a -> ViaRational a -> ViaRational a
roundedDiv RoundingMode
r (ViaRational a
x) (ViaRational a
y)
    | a -> Bool
forall a. RealFloat a => a -> Bool
isNaN a
x Bool -> Bool -> Bool
|| a -> Bool
forall a. RealFloat a => a -> Bool
isNaN a
y Bool -> Bool -> Bool
|| a -> Bool
forall a. RealFloat a => a -> Bool
isInfinite a
x Bool -> Bool -> Bool
|| a -> Bool
forall a. RealFloat a => a -> Bool
isInfinite a
y Bool -> Bool -> Bool
|| a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0 Bool -> Bool -> Bool
|| a
y a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0 = a -> ViaRational a
forall a. a -> ViaRational a
ViaRational (a
x a -> a -> a
forall a. Fractional a => a -> a -> a
/ a
y)
    | Bool
otherwise = RoundingMode -> Rational -> ViaRational a
forall a. RoundedFractional a => RoundingMode -> Rational -> a
roundedFromRational RoundingMode
r (a -> Rational
forall a. Real a => a -> Rational
toRational a
x Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ a -> Rational
forall a. Real a => a -> Rational
toRational a
y)
  roundedFromRational :: RoundingMode -> Rational -> ViaRational a
roundedFromRational RoundingMode
r Rational
x = a -> ViaRational a
forall a. a -> ViaRational a
ViaRational (a -> ViaRational a) -> a -> ViaRational a
forall a b. (a -> b) -> a -> b
$ RoundingMode -> Rational -> a
forall a. RealFloat a => RoundingMode -> Rational -> a
roundedFromRational_default RoundingMode
r Rational
x
  roundedFromRealFloat :: RoundingMode -> b -> ViaRational a
roundedFromRealFloat RoundingMode
r b
x | b -> Bool
forall a. RealFloat a => a -> Bool
isNaN b
x = a -> ViaRational a
forall a. a -> ViaRational a
ViaRational (a
0a -> a -> a
forall a. Fractional a => a -> a -> a
/a
0)
                           | b -> Bool
forall a. RealFloat a => a -> Bool
isInfinite b
x = a -> ViaRational a
forall a. a -> ViaRational a
ViaRational (if b
x b -> b -> Bool
forall a. Ord a => a -> a -> Bool
> b
0 then a
1a -> a -> a
forall a. Fractional a => a -> a -> a
/a
0 else -a
1a -> a -> a
forall a. Fractional a => a -> a -> a
/a
0)
                           | b -> Bool
forall a. RealFloat a => a -> Bool
isNegativeZero b
x = a -> ViaRational a
forall a. a -> ViaRational a
ViaRational (-a
0)
                           | Bool
otherwise = RoundingMode -> Rational -> ViaRational a
forall a. RoundedFractional a => RoundingMode -> Rational -> a
roundedFromRational RoundingMode
r (b -> Rational
forall a. Real a => a -> Rational
toRational b
x)
  intervalFromRational :: Rational
-> (Rounded 'TowardNegInf (ViaRational a),
    Rounded 'TowardInf (ViaRational a))
intervalFromRational Rational
x = case Rational -> (Rounded 'TowardNegInf a, Rounded 'TowardInf a)
forall a.
RealFloat a =>
Rational -> (Rounded 'TowardNegInf a, Rounded 'TowardInf a)
intervalFromRational_default Rational
x of
    (Rounded 'TowardNegInf a
a, Rounded 'TowardInf a
b) -> (a -> ViaRational a
forall a. a -> ViaRational a
ViaRational (a -> ViaRational a)
-> Rounded 'TowardNegInf a -> Rounded 'TowardNegInf (ViaRational a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Rounded 'TowardNegInf a
a, a -> ViaRational a
forall a. a -> ViaRational a
ViaRational (a -> ViaRational a)
-> Rounded 'TowardInf a -> Rounded 'TowardInf (ViaRational a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Rounded 'TowardInf a
b)
  {-# INLINE roundedFromRational #-}
  {-# INLINE intervalFromRational #-}
  {-# SPECIALIZE instance RoundedFractional (ViaRational Float) #-}
  {-# SPECIALIZE instance RoundedFractional (ViaRational Double) #-}

instance (RealFloat a, RealFloatConstants a) => RoundedSqrt (ViaRational a) where
  roundedSqrt :: RoundingMode -> ViaRational a -> ViaRational a
roundedSqrt RoundingMode
r (ViaRational a
x)
    | RoundingMode
r RoundingMode -> RoundingMode -> Bool
forall a. Eq a => a -> a -> Bool
/= RoundingMode
ToNearest Bool -> Bool -> Bool
&& a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
0 = a -> ViaRational a
forall a. a -> ViaRational a
ViaRational (a -> ViaRational a) -> a -> ViaRational a
forall a b. (a -> b) -> a -> b
$
      case Rational -> Rational -> Ordering
forall a. Ord a => a -> a -> Ordering
compare ((a -> Rational
forall a. Real a => a -> Rational
toRational a
y) Rational -> Int -> Rational
forall a b. (Num a, Integral b) => a -> b -> a
^ (Int
2 :: Int)) (a -> Rational
forall a. Real a => a -> Rational
toRational a
x) of
        Ordering
LT | RoundingMode
r RoundingMode -> RoundingMode -> Bool
forall a. Eq a => a -> a -> Bool
== RoundingMode
TowardInf -> let z :: a
z = a -> a
forall a. RealFloat a => a -> a
nextUp a
y
                               in Bool -> a -> a
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (a -> Rational
forall a. Real a => a -> Rational
toRational a
x Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
< (a -> Rational
forall a. Real a => a -> Rational
toRational a
z) Rational -> Int -> Rational
forall a b. (Num a, Integral b) => a -> b -> a
^ (Int
2 :: Int)) a
z
           | Bool
otherwise -> a
y
        Ordering
EQ -> a
y
        Ordering
GT | RoundingMode
r RoundingMode -> RoundingMode -> Bool
forall a. Eq a => a -> a -> Bool
== RoundingMode
TowardInf -> a
y
           | Bool
otherwise -> let z :: a
z = a -> a
forall a. RealFloat a => a -> a
nextDown a
y
                          in Bool -> a -> a
forall a. (?callStack::CallStack) => Bool -> a -> a
assert ((a -> Rational
forall a. Real a => a -> Rational
toRational a
z) Rational -> Int -> Rational
forall a b. (Num a, Integral b) => a -> b -> a
^ (Int
2 :: Int) Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
< a -> Rational
forall a. Real a => a -> Rational
toRational a
x) a
z
    | Bool
otherwise = a -> ViaRational a
forall a. a -> ViaRational a
ViaRational a
y
    where y :: a
y = a -> a
forall a. Floating a => a -> a
sqrt a
x

instance (RealFloat a, RealFloatConstants a, Storable a) => RoundedRing_Vector VS.Vector (ViaRational a)
instance (RealFloat a, RealFloatConstants a, Storable a) => RoundedFractional_Vector VS.Vector (ViaRational a)
instance (RealFloat a, RealFloatConstants a, Storable a) => RoundedSqrt_Vector VS.Vector (ViaRational a)
instance (RealFloat a, RealFloatConstants a, VU.Unbox a) => RoundedRing_Vector VU.Vector (ViaRational a)
instance (RealFloat a, RealFloatConstants a, VU.Unbox a) => RoundedFractional_Vector VU.Vector (ViaRational a)
instance (RealFloat a, RealFloatConstants a, VU.Unbox a) => RoundedSqrt_Vector VU.Vector (ViaRational a)

--
-- instance for Data.Vector.Unboxed.Unbox
--

newtype instance VUM.MVector s (ViaRational a) = MV_ViaRational (VUM.MVector s a)
newtype instance VU.Vector (ViaRational a) = V_ViaRational (VU.Vector a)

instance VU.Unbox a => VGM.MVector VUM.MVector (ViaRational a) where
  basicLength :: MVector s (ViaRational a) -> Int
basicLength (MV_ViaRational mv) = MVector s a -> Int
forall (v :: * -> * -> *) a s. MVector v a => v s a -> Int
VGM.basicLength MVector s a
mv
  basicUnsafeSlice :: Int
-> Int -> MVector s (ViaRational a) -> MVector s (ViaRational a)
basicUnsafeSlice Int
i Int
l (MV_ViaRational mv) = MVector s a -> MVector s (ViaRational a)
forall s a. MVector s a -> MVector s (ViaRational a)
MV_ViaRational (Int -> Int -> MVector s a -> MVector s a
forall (v :: * -> * -> *) a s.
MVector v a =>
Int -> Int -> v s a -> v s a
VGM.basicUnsafeSlice Int
i Int
l MVector s a
mv)
  basicOverlaps :: MVector s (ViaRational a) -> MVector s (ViaRational a) -> Bool
basicOverlaps (MV_ViaRational mv) (MV_ViaRational mv') = MVector s a -> MVector s a -> Bool
forall (v :: * -> * -> *) a s.
MVector v a =>
v s a -> v s a -> Bool
VGM.basicOverlaps MVector s a
mv MVector s a
mv'
  basicUnsafeNew :: Int -> m (MVector (PrimState m) (ViaRational a))
basicUnsafeNew Int
l = MVector (PrimState m) a -> MVector (PrimState m) (ViaRational a)
forall s a. MVector s a -> MVector s (ViaRational a)
MV_ViaRational (MVector (PrimState m) a -> MVector (PrimState m) (ViaRational a))
-> m (MVector (PrimState m) a)
-> m (MVector (PrimState m) (ViaRational a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> m (MVector (PrimState m) a)
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
Int -> m (v (PrimState m) a)
VGM.basicUnsafeNew Int
l
  basicInitialize :: MVector (PrimState m) (ViaRational a) -> m ()
basicInitialize (MV_ViaRational mv) = MVector (PrimState m) a -> m ()
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> m ()
VGM.basicInitialize MVector (PrimState m) a
mv
  basicUnsafeReplicate :: Int -> ViaRational a -> m (MVector (PrimState m) (ViaRational a))
basicUnsafeReplicate Int
i ViaRational a
x = MVector (PrimState m) a -> MVector (PrimState m) (ViaRational a)
forall s a. MVector s a -> MVector s (ViaRational a)
MV_ViaRational (MVector (PrimState m) a -> MVector (PrimState m) (ViaRational a))
-> m (MVector (PrimState m) a)
-> m (MVector (PrimState m) (ViaRational a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> a -> m (MVector (PrimState m) a)
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
Int -> a -> m (v (PrimState m) a)
VGM.basicUnsafeReplicate Int
i (ViaRational a -> a
coerce ViaRational a
x)
  basicUnsafeRead :: MVector (PrimState m) (ViaRational a) -> Int -> m (ViaRational a)
basicUnsafeRead (MV_ViaRational mv) Int
i = a -> ViaRational a
coerce (a -> ViaRational a) -> m a -> m (ViaRational a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MVector (PrimState m) a -> Int -> m a
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> Int -> m a
VGM.basicUnsafeRead MVector (PrimState m) a
mv Int
i
  basicUnsafeWrite :: MVector (PrimState m) (ViaRational a)
-> Int -> ViaRational a -> m ()
basicUnsafeWrite (MV_ViaRational mv) Int
i ViaRational a
x = MVector (PrimState m) a -> Int -> a -> m ()
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> Int -> a -> m ()
VGM.basicUnsafeWrite MVector (PrimState m) a
mv Int
i (ViaRational a -> a
coerce ViaRational a
x)
  basicClear :: MVector (PrimState m) (ViaRational a) -> m ()
basicClear (MV_ViaRational mv) = MVector (PrimState m) a -> m ()
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> m ()
VGM.basicClear MVector (PrimState m) a
mv
  basicSet :: MVector (PrimState m) (ViaRational a) -> ViaRational a -> m ()
basicSet (MV_ViaRational mv) ViaRational a
x = MVector (PrimState m) a -> a -> m ()
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> a -> m ()
VGM.basicSet MVector (PrimState m) a
mv (ViaRational a -> a
coerce ViaRational a
x)
  basicUnsafeCopy :: MVector (PrimState m) (ViaRational a)
-> MVector (PrimState m) (ViaRational a) -> m ()
basicUnsafeCopy (MV_ViaRational mv) (MV_ViaRational mv') = MVector (PrimState m) a -> MVector (PrimState m) a -> m ()
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> v (PrimState m) a -> m ()
VGM.basicUnsafeCopy MVector (PrimState m) a
mv MVector (PrimState m) a
mv'
  basicUnsafeMove :: MVector (PrimState m) (ViaRational a)
-> MVector (PrimState m) (ViaRational a) -> m ()
basicUnsafeMove (MV_ViaRational mv) (MV_ViaRational mv') = MVector (PrimState m) a -> MVector (PrimState m) a -> m ()
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> v (PrimState m) a -> m ()
VGM.basicUnsafeMove MVector (PrimState m) a
mv MVector (PrimState m) a
mv'
  basicUnsafeGrow :: MVector (PrimState m) (ViaRational a)
-> Int -> m (MVector (PrimState m) (ViaRational a))
basicUnsafeGrow (MV_ViaRational mv) Int
n = MVector (PrimState m) a -> MVector (PrimState m) (ViaRational a)
forall s a. MVector s a -> MVector s (ViaRational a)
MV_ViaRational (MVector (PrimState m) a -> MVector (PrimState m) (ViaRational a))
-> m (MVector (PrimState m) a)
-> m (MVector (PrimState m) (ViaRational a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MVector (PrimState m) a -> Int -> m (MVector (PrimState m) a)
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> Int -> m (v (PrimState m) a)
VGM.basicUnsafeGrow MVector (PrimState m) a
mv Int
n

instance VU.Unbox a => VG.Vector VU.Vector (ViaRational a) where
  basicUnsafeFreeze :: Mutable Vector (PrimState m) (ViaRational a)
-> m (Vector (ViaRational a))
basicUnsafeFreeze (MV_ViaRational mv) = Vector a -> Vector (ViaRational a)
forall a. Vector a -> Vector (ViaRational a)
V_ViaRational (Vector a -> Vector (ViaRational a))
-> m (Vector a) -> m (Vector (ViaRational a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mutable Vector (PrimState m) a -> m (Vector a)
forall (v :: * -> *) a (m :: * -> *).
(Vector v a, PrimMonad m) =>
Mutable v (PrimState m) a -> m (v a)
VG.basicUnsafeFreeze MVector (PrimState m) a
Mutable Vector (PrimState m) a
mv
  basicUnsafeThaw :: Vector (ViaRational a)
-> m (Mutable Vector (PrimState m) (ViaRational a))
basicUnsafeThaw (V_ViaRational v) = MVector (PrimState m) a -> MVector (PrimState m) (ViaRational a)
forall s a. MVector s a -> MVector s (ViaRational a)
MV_ViaRational (MVector (PrimState m) a -> MVector (PrimState m) (ViaRational a))
-> m (MVector (PrimState m) a)
-> m (MVector (PrimState m) (ViaRational a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Vector a -> m (Mutable Vector (PrimState m) a)
forall (v :: * -> *) a (m :: * -> *).
(Vector v a, PrimMonad m) =>
v a -> m (Mutable v (PrimState m) a)
VG.basicUnsafeThaw Vector a
v
  basicLength :: Vector (ViaRational a) -> Int
basicLength (V_ViaRational v) = Vector a -> Int
forall (v :: * -> *) a. Vector v a => v a -> Int
VG.basicLength Vector a
v
  basicUnsafeSlice :: Int -> Int -> Vector (ViaRational a) -> Vector (ViaRational a)
basicUnsafeSlice Int
i Int
l (V_ViaRational v) = Vector a -> Vector (ViaRational a)
forall a. Vector a -> Vector (ViaRational a)
V_ViaRational (Int -> Int -> Vector a -> Vector a
forall (v :: * -> *) a. Vector v a => Int -> Int -> v a -> v a
VG.basicUnsafeSlice Int
i Int
l Vector a
v)
  basicUnsafeIndexM :: Vector (ViaRational a) -> Int -> m (ViaRational a)
basicUnsafeIndexM (V_ViaRational v) Int
i = a -> ViaRational a
coerce (a -> ViaRational a) -> m a -> m (ViaRational a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Vector a -> Int -> m a
forall (v :: * -> *) a (m :: * -> *).
(Vector v a, Monad m) =>
v a -> Int -> m a
VG.basicUnsafeIndexM Vector a
v Int
i
  basicUnsafeCopy :: Mutable Vector (PrimState m) (ViaRational a)
-> Vector (ViaRational a) -> m ()
basicUnsafeCopy (MV_ViaRational mv) (V_ViaRational v) = Mutable Vector (PrimState m) a -> Vector a -> m ()
forall (v :: * -> *) a (m :: * -> *).
(Vector v a, PrimMonad m) =>
Mutable v (PrimState m) a -> v a -> m ()
VG.basicUnsafeCopy MVector (PrimState m) a
Mutable Vector (PrimState m) a
mv Vector a
v
  elemseq :: Vector (ViaRational a) -> ViaRational a -> b -> b
elemseq (V_ViaRational v) ViaRational a
x b
y = Vector a -> a -> b -> b
forall (v :: * -> *) a b. Vector v a => v a -> a -> b -> b
VG.elemseq Vector a
v (ViaRational a -> a
coerce ViaRational a
x) b
y

instance VU.Unbox a => VU.Unbox (ViaRational a)