{-# 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 r :: RoundingMode
r (ViaRational x :: a
x) (ViaRational y :: 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
== 0 Bool -> Bool -> Bool
&& a
y a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== 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
                    0 -> a -> ViaRational a
forall a. a -> ViaRational a
ViaRational a
roundedZero
                    z :: 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
            ToNearest    ->  0
            TowardNegInf -> -0
            TowardInf    ->  0
            TowardZero   ->  0
  roundedSub :: RoundingMode -> ViaRational a -> ViaRational a -> ViaRational a
roundedSub r :: RoundingMode
r (ViaRational x :: a
x) (ViaRational y :: 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
== 0 Bool -> Bool -> Bool
&& a
y a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== 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
                    0 -> a -> ViaRational a
forall a. a -> ViaRational a
ViaRational a
roundedZero
                    z :: 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
            ToNearest    ->  0
            TowardNegInf -> -0
            TowardInf    ->  0
            TowardZero   ->  0
  roundedMul :: RoundingMode -> ViaRational a -> ViaRational a -> ViaRational a
roundedMul r :: RoundingMode
r (ViaRational x :: a
x) (ViaRational y :: 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 r :: RoundingMode
r (ViaRational x :: a
x) (ViaRational y :: a
y) (ViaRational z :: 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
                    0 -> if a
z a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== 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
                    w :: 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
              ToNearest    ->  0
              TowardNegInf -> -0
              TowardInf    ->  0
              TowardZero   ->  0
  roundedFromInteger :: RoundingMode -> Integer -> ViaRational a
roundedFromInteger r :: RoundingMode
r x :: 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 x :: 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
    (a :: Rounded 'TowardNegInf a
a, b :: 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 "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 r :: RoundingMode
r (ViaRational x :: a
x) (ViaRational y :: 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
== 0 Bool -> Bool -> Bool
|| a
y a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== 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 r :: RoundingMode
r x :: 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 r :: RoundingMode
r x :: b
x | b -> Bool
forall a. RealFloat a => a -> Bool
isNaN b
x = a -> ViaRational a
forall a. a -> ViaRational a
ViaRational (0a -> a -> a
forall a. Fractional 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
> 0 then 1a -> a -> a
forall a. Fractional a => a -> a -> a
/0 else -1a -> a -> a
forall a. Fractional 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 (-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 x :: 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
    (a :: Rounded 'TowardNegInf a
a, b :: 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 r :: RoundingMode
r (ViaRational x :: 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
>= 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
^ (2 :: Int)) (a -> Rational
forall a. Real a => a -> Rational
toRational a
x) of
        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
^ (2 :: Int)) a
z
           | Bool
otherwise -> a
y
        EQ -> a
y
        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
^ (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 i :: Int
i l :: 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 l :: 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 i :: Int
i x :: 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
forall a b. Coercible a b => a -> b
coerce ViaRational a
x)
  basicUnsafeRead :: MVector (PrimState m) (ViaRational a) -> Int -> m (ViaRational a)
basicUnsafeRead (MV_ViaRational mv) i :: Int
i = a -> ViaRational a
forall a b. Coercible a b => a -> b
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) i :: Int
i x :: 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
forall a b. Coercible a b => a -> b
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) x :: 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
forall a b. Coercible a b => a -> b
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) n :: 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 i :: Int
i l :: 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) i :: Int
i = a -> ViaRational a
forall a b. Coercible a b => a -> b
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) x :: ViaRational a
x y :: 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
forall a b. Coercible a b => a -> b
coerce ViaRational a
x) b
y

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