{-# 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
$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
/= :: 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
$ccompare :: forall a. Ord a => ViaRational a -> ViaRational a -> Ordering
compare :: ViaRational a -> ViaRational a -> Ordering
$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
>= :: ViaRational a -> ViaRational a -> Bool
$cmax :: forall a. Ord a => ViaRational a -> ViaRational a -> ViaRational a
max :: ViaRational a -> ViaRational a -> ViaRational a
$cmin :: forall a. Ord a => ViaRational a -> ViaRational a -> ViaRational a
min :: ViaRational a -> ViaRational a -> 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
$cshowsPrec :: forall a. Show a => Int -> ViaRational a -> ShowS
showsPrec :: Int -> ViaRational a -> ShowS
$cshow :: forall a. Show a => ViaRational a -> String
show :: ViaRational a -> String
$cshowList :: forall a. Show a => [ViaRational a] -> ShowS
showList :: [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
$cfrom :: forall a x. ViaRational a -> Rep (ViaRational a) x
from :: forall x. ViaRational a -> Rep (ViaRational a) x
$cto :: forall a x. Rep (ViaRational a) x -> ViaRational a
to :: forall x. Rep (ViaRational a) x -> ViaRational a
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
$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
* :: ViaRational a -> ViaRational a -> ViaRational a
$cnegate :: forall a. Num a => ViaRational a -> ViaRational a
negate :: ViaRational a -> ViaRational a
$cabs :: forall a. Num a => ViaRational a -> ViaRational a
abs :: ViaRational a -> ViaRational a
$csignum :: forall a. Num a => ViaRational a -> ViaRational a
signum :: ViaRational a -> ViaRational a
$cfromInteger :: forall a. Num a => Integer -> ViaRational a
fromInteger :: Integer -> ViaRational a
Num,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
$csizeOf :: forall a. Storable a => ViaRational a -> Int
sizeOf :: ViaRational a -> Int
$calignment :: forall a. Storable a => ViaRational a -> Int
alignment :: ViaRational a -> Int
$cpeekElemOff :: forall a.
Storable a =>
Ptr (ViaRational a) -> Int -> IO (ViaRational a)
peekElemOff :: Ptr (ViaRational a) -> Int -> IO (ViaRational a)
$cpokeElemOff :: forall a.
Storable a =>
Ptr (ViaRational a) -> Int -> ViaRational a -> IO ()
pokeElemOff :: Ptr (ViaRational a) -> Int -> ViaRational a -> IO ()
$cpeekByteOff :: forall a b. Storable a => Ptr b -> Int -> IO (ViaRational a)
peekByteOff :: forall b. Ptr b -> Int -> IO (ViaRational a)
$cpokeByteOff :: forall a b. Storable a => Ptr b -> Int -> ViaRational a -> IO ()
pokeByteOff :: forall b. Ptr b -> Int -> ViaRational a -> IO ()
$cpeek :: forall a. Storable a => Ptr (ViaRational a) -> IO (ViaRational a)
peek :: Ptr (ViaRational a) -> IO (ViaRational a)
$cpoke :: forall a.
Storable a =>
Ptr (ViaRational a) -> ViaRational a -> IO ()
poke :: Ptr (ViaRational a) -> ViaRational a -> IO ()
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
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. 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 :: forall b. RealFloat b => 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 :: forall s. MVector s (ViaRational a) -> Int
basicLength (MV_ViaRational MVector s a
mv) = MVector s a -> Int
forall s. MVector s a -> Int
forall (v :: * -> * -> *) a s. MVector v a => v s a -> Int
VGM.basicLength MVector s a
mv
  basicUnsafeSlice :: forall s.
Int
-> Int -> MVector s (ViaRational a) -> MVector s (ViaRational a)
basicUnsafeSlice Int
i Int
l (MV_ViaRational MVector s a
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 s. 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 :: forall s.
MVector s (ViaRational a) -> MVector s (ViaRational a) -> Bool
basicOverlaps (MV_ViaRational MVector s a
mv) (MV_ViaRational MVector s a
mv') = MVector s a -> MVector s a -> Bool
forall s. 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 :: forall s. Int -> ST s (MVector s (ViaRational a))
basicUnsafeNew Int
l = MVector s a -> MVector s (ViaRational a)
forall s a. MVector s a -> MVector s (ViaRational a)
MV_ViaRational (MVector s a -> MVector s (ViaRational a))
-> ST s (MVector s a) -> ST s (MVector s (ViaRational a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> ST s (MVector s a)
forall s. Int -> ST s (MVector s a)
forall (v :: * -> * -> *) a s. MVector v a => Int -> ST s (v s a)
VGM.basicUnsafeNew Int
l
  basicInitialize :: forall s. MVector s (ViaRational a) -> ST s ()
basicInitialize (MV_ViaRational MVector s a
mv) = MVector s a -> ST s ()
forall s. MVector s a -> ST s ()
forall (v :: * -> * -> *) a s. MVector v a => v s a -> ST s ()
VGM.basicInitialize MVector s a
mv
  basicUnsafeReplicate :: forall s. Int -> ViaRational a -> ST s (MVector s (ViaRational a))
basicUnsafeReplicate Int
i ViaRational a
x = MVector s a -> MVector s (ViaRational a)
forall s a. MVector s a -> MVector s (ViaRational a)
MV_ViaRational (MVector s a -> MVector s (ViaRational a))
-> ST s (MVector s a) -> ST s (MVector s (ViaRational a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> a -> ST s (MVector s a)
forall s. Int -> a -> ST s (MVector s a)
forall (v :: * -> * -> *) a s.
MVector v a =>
Int -> a -> ST s (v s a)
VGM.basicUnsafeReplicate Int
i (ViaRational a -> a
forall a b. Coercible a b => a -> b
coerce ViaRational a
x)
  basicUnsafeRead :: forall s. MVector s (ViaRational a) -> Int -> ST s (ViaRational a)
basicUnsafeRead (MV_ViaRational MVector s a
mv) Int
i = a -> ViaRational a
forall a b. Coercible a b => a -> b
coerce (a -> ViaRational a) -> ST s a -> ST s (ViaRational a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MVector s a -> Int -> ST s a
forall s. MVector s a -> Int -> ST s a
forall (v :: * -> * -> *) a s.
MVector v a =>
v s a -> Int -> ST s a
VGM.basicUnsafeRead MVector s a
mv Int
i
  basicUnsafeWrite :: forall s.
MVector s (ViaRational a) -> Int -> ViaRational a -> ST s ()
basicUnsafeWrite (MV_ViaRational MVector s a
mv) Int
i ViaRational a
x = MVector s a -> Int -> a -> ST s ()
forall s. MVector s a -> Int -> a -> ST s ()
forall (v :: * -> * -> *) a s.
MVector v a =>
v s a -> Int -> a -> ST s ()
VGM.basicUnsafeWrite MVector s a
mv Int
i (ViaRational a -> a
forall a b. Coercible a b => a -> b
coerce ViaRational a
x)
  basicClear :: forall s. MVector s (ViaRational a) -> ST s ()
basicClear (MV_ViaRational MVector s a
mv) = MVector s a -> ST s ()
forall s. MVector s a -> ST s ()
forall (v :: * -> * -> *) a s. MVector v a => v s a -> ST s ()
VGM.basicClear MVector s a
mv
  basicSet :: forall s. MVector s (ViaRational a) -> ViaRational a -> ST s ()
basicSet (MV_ViaRational MVector s a
mv) ViaRational a
x = MVector s a -> a -> ST s ()
forall s. MVector s a -> a -> ST s ()
forall (v :: * -> * -> *) a s. MVector v a => v s a -> a -> ST s ()
VGM.basicSet MVector s a
mv (ViaRational a -> a
forall a b. Coercible a b => a -> b
coerce ViaRational a
x)
  basicUnsafeCopy :: forall s.
MVector s (ViaRational a) -> MVector s (ViaRational a) -> ST s ()
basicUnsafeCopy (MV_ViaRational MVector s a
mv) (MV_ViaRational MVector s a
mv') = MVector s a -> MVector s a -> ST s ()
forall s. MVector s a -> MVector s a -> ST s ()
forall (v :: * -> * -> *) a s.
MVector v a =>
v s a -> v s a -> ST s ()
VGM.basicUnsafeCopy MVector s a
mv MVector s a
mv'
  basicUnsafeMove :: forall s.
MVector s (ViaRational a) -> MVector s (ViaRational a) -> ST s ()
basicUnsafeMove (MV_ViaRational MVector s a
mv) (MV_ViaRational MVector s a
mv') = MVector s a -> MVector s a -> ST s ()
forall s. MVector s a -> MVector s a -> ST s ()
forall (v :: * -> * -> *) a s.
MVector v a =>
v s a -> v s a -> ST s ()
VGM.basicUnsafeMove MVector s a
mv MVector s a
mv'
  basicUnsafeGrow :: forall s.
MVector s (ViaRational a)
-> Int -> ST s (MVector s (ViaRational a))
basicUnsafeGrow (MV_ViaRational MVector s a
mv) Int
n = MVector s a -> MVector s (ViaRational a)
forall s a. MVector s a -> MVector s (ViaRational a)
MV_ViaRational (MVector s a -> MVector s (ViaRational a))
-> ST s (MVector s a) -> ST s (MVector s (ViaRational a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MVector s a -> Int -> ST s (MVector s a)
forall s. MVector s a -> Int -> ST s (MVector s a)
forall (v :: * -> * -> *) a s.
MVector v a =>
v s a -> Int -> ST s (v s a)
VGM.basicUnsafeGrow MVector s a
mv Int
n

instance VU.Unbox a => VG.Vector VU.Vector (ViaRational a) where
  basicUnsafeFreeze :: forall s.
Mutable Vector s (ViaRational a) -> ST s (Vector (ViaRational a))
basicUnsafeFreeze (MV_ViaRational MVector s a
mv) = Vector a -> Vector (ViaRational a)
forall a. Vector a -> Vector (ViaRational a)
V_ViaRational (Vector a -> Vector (ViaRational a))
-> ST s (Vector a) -> ST s (Vector (ViaRational a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mutable Vector s a -> ST s (Vector a)
forall s. Mutable Vector s a -> ST s (Vector a)
forall (v :: * -> *) a s. Vector v a => Mutable v s a -> ST s (v a)
VG.basicUnsafeFreeze Mutable Vector s a
MVector s a
mv
  basicUnsafeThaw :: forall s.
Vector (ViaRational a) -> ST s (Mutable Vector s (ViaRational a))
basicUnsafeThaw (V_ViaRational Vector a
v) = MVector s a -> MVector s (ViaRational a)
forall s a. MVector s a -> MVector s (ViaRational a)
MV_ViaRational (MVector s a -> MVector s (ViaRational a))
-> ST s (MVector s a) -> ST s (MVector s (ViaRational a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Vector a -> ST s (Mutable Vector s a)
forall s. Vector a -> ST s (Mutable Vector s a)
forall (v :: * -> *) a s. Vector v a => v a -> ST s (Mutable v s a)
VG.basicUnsafeThaw Vector a
v
  basicLength :: Vector (ViaRational a) -> Int
basicLength (V_ViaRational Vector a
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 Vector a
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 -> Box (ViaRational a)
basicUnsafeIndexM (V_ViaRational Vector a
v) Int
i = a -> ViaRational a
forall a b. Coercible a b => a -> b
coerce (a -> ViaRational a) -> Box a -> Box (ViaRational a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Vector a -> Int -> Box a
forall (v :: * -> *) a. Vector v a => v a -> Int -> Box a
VG.basicUnsafeIndexM Vector a
v Int
i
  basicUnsafeCopy :: forall s.
Mutable Vector s (ViaRational a)
-> Vector (ViaRational a) -> ST s ()
basicUnsafeCopy (MV_ViaRational MVector s a
mv) (V_ViaRational Vector a
v) = Mutable Vector s a -> Vector a -> ST s ()
forall s. Mutable Vector s a -> Vector a -> ST s ()
forall (v :: * -> *) a s.
Vector v a =>
Mutable v s a -> v a -> ST s ()
VG.basicUnsafeCopy Mutable Vector s a
MVector s a
mv Vector a
v
  elemseq :: forall b. Vector (ViaRational a) -> ViaRational a -> b -> b
elemseq (V_ViaRational Vector a
v) ViaRational a
x b
y = Vector a -> a -> b -> b
forall b. 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
forall a b. Coercible a b => a -> b
coerce ViaRational a
x) b
y

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