{-|
Module: Numeric.Rounded.Hardware.Backend.FastFFI

The types in this module implements interval addition and subtraction in assembly.

Currently, the only platform supported is x86_64.

One of the following technology will be used to control rounding mode:

    * SSE2 MXCSR
    * AVX512 EVEX encoding

You should not need to import this module directly.

This module may not be available depending on the platform or package flags.
-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE GHCForeignImportPrim #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UnboxedTuples #-}
{-# LANGUAGE UnliftedFFITypes #-}
{-# OPTIONS_GHC -fobject-code #-}
module Numeric.Rounded.Hardware.Backend.FastFFI
  ( CDouble(..)
  , fastIntervalAdd
  , fastIntervalSub
  , fastIntervalRecip
  , VUM.MVector(MV_CFloat, MV_CDouble)
  , VU.Vector(V_CFloat, V_CDouble)
  ) where
import           Control.DeepSeq (NFData (..))
import           Data.Coerce
import           Data.Proxy
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 qualified FFIWrapper.Double as D
import           Foreign.C.String (CString, peekCString)
import           Foreign.Storable (Storable)
import           GHC.Exts
import           GHC.Generics (Generic)
-- import           GHC.Int (Int64 (I64#))
-- import           GHC.Word (Word64 (W64#))
import qualified Numeric.Rounded.Hardware.Backend.C as C
import           Numeric.Rounded.Hardware.Internal.Class
import           System.IO.Unsafe (unsafePerformIO)
import           Unsafe.Coerce

#include "MachDeps.h"

--
-- Double
--

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

instance NFData CDouble

instance RoundedRing CDouble where
  roundedAdd :: RoundingMode -> CDouble -> CDouble -> CDouble
roundedAdd = (RoundingMode -> Double -> Double -> Double)
-> RoundingMode -> CDouble -> CDouble -> CDouble
forall a b. Coercible a b => a -> b
coerce RoundingMode -> Double -> Double -> Double
D.roundedAdd
  roundedSub :: RoundingMode -> CDouble -> CDouble -> CDouble
roundedSub = (RoundingMode -> Double -> Double -> Double)
-> RoundingMode -> CDouble -> CDouble -> CDouble
forall a b. Coercible a b => a -> b
coerce RoundingMode -> Double -> Double -> Double
D.roundedSub
  roundedMul :: RoundingMode -> CDouble -> CDouble -> CDouble
roundedMul = (RoundingMode -> Double -> Double -> Double)
-> RoundingMode -> CDouble -> CDouble -> CDouble
forall a b. Coercible a b => a -> b
coerce RoundingMode -> Double -> Double -> Double
D.roundedMul
  roundedFusedMultiplyAdd :: RoundingMode -> CDouble -> CDouble -> CDouble -> CDouble
roundedFusedMultiplyAdd = (RoundingMode -> Double -> Double -> Double -> Double)
-> RoundingMode -> CDouble -> CDouble -> CDouble -> CDouble
forall a b. Coercible a b => a -> b
coerce RoundingMode -> Double -> Double -> Double -> Double
D.roundedFMA
  intervalAdd :: Rounded 'TowardNegInf CDouble
-> Rounded 'TowardInf CDouble
-> Rounded 'TowardNegInf CDouble
-> Rounded 'TowardInf CDouble
-> (Rounded 'TowardNegInf CDouble, Rounded 'TowardInf CDouble)
intervalAdd Rounded 'TowardNegInf CDouble
x Rounded 'TowardInf CDouble
x' Rounded 'TowardNegInf CDouble
y Rounded 'TowardInf CDouble
y' = (Double -> Double -> Double -> Double -> (Double, Double))
-> Rounded 'TowardNegInf CDouble
-> Rounded 'TowardInf CDouble
-> Rounded 'TowardNegInf CDouble
-> Rounded 'TowardInf CDouble
-> (Rounded 'TowardNegInf CDouble, Rounded 'TowardInf CDouble)
forall a b. Coercible a b => a -> b
coerce Double -> Double -> Double -> Double -> (Double, Double)
fastIntervalAdd Rounded 'TowardNegInf CDouble
x Rounded 'TowardInf CDouble
x' Rounded 'TowardNegInf CDouble
y Rounded 'TowardInf CDouble
y'
  intervalSub :: Rounded 'TowardNegInf CDouble
-> Rounded 'TowardInf CDouble
-> Rounded 'TowardNegInf CDouble
-> Rounded 'TowardInf CDouble
-> (Rounded 'TowardNegInf CDouble, Rounded 'TowardInf CDouble)
intervalSub Rounded 'TowardNegInf CDouble
x Rounded 'TowardInf CDouble
x' Rounded 'TowardNegInf CDouble
y Rounded 'TowardInf CDouble
y' = (Double -> Double -> Double -> Double -> (Double, Double))
-> Rounded 'TowardNegInf CDouble
-> Rounded 'TowardInf CDouble
-> Rounded 'TowardNegInf CDouble
-> Rounded 'TowardInf CDouble
-> (Rounded 'TowardNegInf CDouble, Rounded 'TowardInf CDouble)
forall a b. Coercible a b => a -> b
coerce Double -> Double -> Double -> Double -> (Double, Double)
fastIntervalSub Rounded 'TowardNegInf CDouble
x Rounded 'TowardInf CDouble
x' Rounded 'TowardNegInf CDouble
y Rounded 'TowardInf CDouble
y'
  intervalMul :: Rounded 'TowardNegInf CDouble
-> Rounded 'TowardInf CDouble
-> Rounded 'TowardNegInf CDouble
-> Rounded 'TowardInf CDouble
-> (Rounded 'TowardNegInf CDouble, Rounded 'TowardInf CDouble)
intervalMul Rounded 'TowardNegInf CDouble
x Rounded 'TowardInf CDouble
x' Rounded 'TowardNegInf CDouble
y Rounded 'TowardInf CDouble
y' = ((Double -> Double -> Double -> Double -> Double)
-> Rounded 'TowardNegInf CDouble
-> Rounded 'TowardInf CDouble
-> Rounded 'TowardNegInf CDouble
-> Rounded 'TowardInf CDouble
-> Rounded 'TowardNegInf CDouble
forall a b. Coercible a b => a -> b
coerce Double -> Double -> Double -> Double -> Double
D.intervalMul_down Rounded 'TowardNegInf CDouble
x Rounded 'TowardInf CDouble
x' Rounded 'TowardNegInf CDouble
y Rounded 'TowardInf CDouble
y', (Double -> Double -> Double -> Double -> Double)
-> Rounded 'TowardNegInf CDouble
-> Rounded 'TowardInf CDouble
-> Rounded 'TowardNegInf CDouble
-> Rounded 'TowardInf CDouble
-> Rounded 'TowardInf CDouble
forall a b. Coercible a b => a -> b
coerce Double -> Double -> Double -> Double -> Double
D.intervalMul_up Rounded 'TowardNegInf CDouble
x Rounded 'TowardInf CDouble
x' Rounded 'TowardNegInf CDouble
y Rounded 'TowardInf CDouble
y')
  intervalMulAdd :: Rounded 'TowardNegInf CDouble
-> Rounded 'TowardInf CDouble
-> Rounded 'TowardNegInf CDouble
-> Rounded 'TowardInf CDouble
-> Rounded 'TowardNegInf CDouble
-> Rounded 'TowardInf CDouble
-> (Rounded 'TowardNegInf CDouble, Rounded 'TowardInf CDouble)
intervalMulAdd Rounded 'TowardNegInf CDouble
x Rounded 'TowardInf CDouble
x' Rounded 'TowardNegInf CDouble
y Rounded 'TowardInf CDouble
y' Rounded 'TowardNegInf CDouble
z Rounded 'TowardInf CDouble
z' = ((Double -> Double -> Double -> Double -> Double -> Double)
-> Rounded 'TowardNegInf CDouble
-> Rounded 'TowardInf CDouble
-> Rounded 'TowardNegInf CDouble
-> Rounded 'TowardInf CDouble
-> Rounded 'TowardNegInf CDouble
-> Rounded 'TowardNegInf CDouble
forall a b. Coercible a b => a -> b
coerce Double -> Double -> Double -> Double -> Double -> Double
D.intervalMulAdd_down Rounded 'TowardNegInf CDouble
x Rounded 'TowardInf CDouble
x' Rounded 'TowardNegInf CDouble
y Rounded 'TowardInf CDouble
y' Rounded 'TowardNegInf CDouble
z, (Double -> Double -> Double -> Double -> Double -> Double)
-> Rounded 'TowardNegInf CDouble
-> Rounded 'TowardInf CDouble
-> Rounded 'TowardNegInf CDouble
-> Rounded 'TowardInf CDouble
-> Rounded 'TowardInf CDouble
-> Rounded 'TowardInf CDouble
forall a b. Coercible a b => a -> b
coerce Double -> Double -> Double -> Double -> Double -> Double
D.intervalMulAdd_up Rounded 'TowardNegInf CDouble
x Rounded 'TowardInf CDouble
x' Rounded 'TowardNegInf CDouble
y Rounded 'TowardInf CDouble
y' Rounded 'TowardInf CDouble
z')
  roundedFromInteger :: RoundingMode -> Integer -> CDouble
roundedFromInteger = (RoundingMode -> Integer -> CDouble)
-> RoundingMode -> Integer -> CDouble
forall a b. Coercible a b => a -> b
coerce (RoundingMode -> Integer -> CDouble
forall a. RoundedRing a => RoundingMode -> Integer -> a
roundedFromInteger :: RoundingMode -> Integer -> C.CDouble)
  intervalFromInteger :: Integer
-> (Rounded 'TowardNegInf CDouble, Rounded 'TowardInf CDouble)
intervalFromInteger = (Integer
 -> (Rounded 'TowardNegInf CDouble, Rounded 'TowardInf CDouble))
-> Integer
-> (Rounded 'TowardNegInf CDouble, Rounded 'TowardInf CDouble)
forall a b. Coercible a b => a -> b
coerce (Integer
-> (Rounded 'TowardNegInf CDouble, Rounded 'TowardInf CDouble)
forall a.
RoundedRing a =>
Integer -> (Rounded 'TowardNegInf a, Rounded 'TowardInf a)
intervalFromInteger :: Integer -> (Rounded 'TowardNegInf C.CDouble, Rounded 'TowardInf C.CDouble))
  backendNameT :: Tagged CDouble String
backendNameT = String -> Tagged CDouble String
forall {k} (s :: k) b. b -> Tagged s b
Tagged (String -> Tagged CDouble String)
-> String -> Tagged CDouble String
forall a b. (a -> b) -> a -> b
$ let base :: String
base = Proxy CDouble -> String
forall a (proxy :: * -> *). RoundedRing a => proxy a -> String
backendName (Proxy CDouble
forall {k} (t :: k). Proxy t
Proxy :: Proxy C.CDouble)
                              intervals :: String
intervals = String
intervalBackendName
                          in if String
base String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
intervals
                             then String
base String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"+FastFFI"
                             else String
base String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"+FastFFI(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
intervals String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
  {-# INLINE roundedAdd #-}
  {-# INLINE roundedSub #-}
  {-# INLINE roundedMul #-}
  {-# INLINE roundedFusedMultiplyAdd #-}
  {-# INLINE intervalAdd #-}
  {-# INLINE intervalSub #-}
  {-# INLINE intervalMul #-}
  {-# INLINE roundedFromInteger #-}
  {-# INLINE intervalFromInteger #-}

instance RoundedFractional CDouble where
  roundedDiv :: RoundingMode -> CDouble -> CDouble -> CDouble
roundedDiv = (RoundingMode -> Double -> Double -> Double)
-> RoundingMode -> CDouble -> CDouble -> CDouble
forall a b. Coercible a b => a -> b
coerce RoundingMode -> Double -> Double -> Double
D.roundedDiv
  intervalDiv :: Rounded 'TowardNegInf CDouble
-> Rounded 'TowardInf CDouble
-> Rounded 'TowardNegInf CDouble
-> Rounded 'TowardInf CDouble
-> (Rounded 'TowardNegInf CDouble, Rounded 'TowardInf CDouble)
intervalDiv Rounded 'TowardNegInf CDouble
x Rounded 'TowardInf CDouble
x' Rounded 'TowardNegInf CDouble
y Rounded 'TowardInf CDouble
y' = ((Double -> Double -> Double -> Double -> Double)
-> Rounded 'TowardNegInf CDouble
-> Rounded 'TowardInf CDouble
-> Rounded 'TowardNegInf CDouble
-> Rounded 'TowardInf CDouble
-> Rounded 'TowardNegInf CDouble
forall a b. Coercible a b => a -> b
coerce Double -> Double -> Double -> Double -> Double
D.intervalDiv_down Rounded 'TowardNegInf CDouble
x Rounded 'TowardInf CDouble
x' Rounded 'TowardNegInf CDouble
y Rounded 'TowardInf CDouble
y', (Double -> Double -> Double -> Double -> Double)
-> Rounded 'TowardNegInf CDouble
-> Rounded 'TowardInf CDouble
-> Rounded 'TowardNegInf CDouble
-> Rounded 'TowardInf CDouble
-> Rounded 'TowardInf CDouble
forall a b. Coercible a b => a -> b
coerce Double -> Double -> Double -> Double -> Double
D.intervalDiv_up Rounded 'TowardNegInf CDouble
x Rounded 'TowardInf CDouble
x' Rounded 'TowardNegInf CDouble
y Rounded 'TowardInf CDouble
y')
  intervalDivAdd :: Rounded 'TowardNegInf CDouble
-> Rounded 'TowardInf CDouble
-> Rounded 'TowardNegInf CDouble
-> Rounded 'TowardInf CDouble
-> Rounded 'TowardNegInf CDouble
-> Rounded 'TowardInf CDouble
-> (Rounded 'TowardNegInf CDouble, Rounded 'TowardInf CDouble)
intervalDivAdd Rounded 'TowardNegInf CDouble
x Rounded 'TowardInf CDouble
x' Rounded 'TowardNegInf CDouble
y Rounded 'TowardInf CDouble
y' Rounded 'TowardNegInf CDouble
z Rounded 'TowardInf CDouble
z' = ((Double -> Double -> Double -> Double -> Double -> Double)
-> Rounded 'TowardNegInf CDouble
-> Rounded 'TowardInf CDouble
-> Rounded 'TowardNegInf CDouble
-> Rounded 'TowardInf CDouble
-> Rounded 'TowardNegInf CDouble
-> Rounded 'TowardNegInf CDouble
forall a b. Coercible a b => a -> b
coerce Double -> Double -> Double -> Double -> Double -> Double
D.intervalDivAdd_down Rounded 'TowardNegInf CDouble
x Rounded 'TowardInf CDouble
x' Rounded 'TowardNegInf CDouble
y Rounded 'TowardInf CDouble
y' Rounded 'TowardNegInf CDouble
z, (Double -> Double -> Double -> Double -> Double -> Double)
-> Rounded 'TowardNegInf CDouble
-> Rounded 'TowardInf CDouble
-> Rounded 'TowardNegInf CDouble
-> Rounded 'TowardInf CDouble
-> Rounded 'TowardInf CDouble
-> Rounded 'TowardInf CDouble
forall a b. Coercible a b => a -> b
coerce Double -> Double -> Double -> Double -> Double -> Double
D.intervalDivAdd_up Rounded 'TowardNegInf CDouble
x Rounded 'TowardInf CDouble
x' Rounded 'TowardNegInf CDouble
y Rounded 'TowardInf CDouble
y' Rounded 'TowardInf CDouble
z')
  intervalRecip :: Rounded 'TowardNegInf CDouble
-> Rounded 'TowardInf CDouble
-> (Rounded 'TowardNegInf CDouble, Rounded 'TowardInf CDouble)
intervalRecip Rounded 'TowardNegInf CDouble
x Rounded 'TowardInf CDouble
x' = (Double -> Double -> (Double, Double))
-> Rounded 'TowardNegInf CDouble
-> Rounded 'TowardInf CDouble
-> (Rounded 'TowardNegInf CDouble, Rounded 'TowardInf CDouble)
forall a b. Coercible a b => a -> b
coerce Double -> Double -> (Double, Double)
fastIntervalRecip Rounded 'TowardNegInf CDouble
x Rounded 'TowardInf CDouble
x'
  roundedFromRational :: RoundingMode -> Rational -> CDouble
roundedFromRational = (RoundingMode -> Rational -> CDouble)
-> RoundingMode -> Rational -> CDouble
forall a b. Coercible a b => a -> b
coerce (RoundingMode -> Rational -> CDouble
forall a. RoundedFractional a => RoundingMode -> Rational -> a
roundedFromRational :: RoundingMode -> Rational -> C.CDouble)
  roundedFromRealFloat :: forall b. RealFloat b => RoundingMode -> b -> CDouble
roundedFromRealFloat RoundingMode
r b
x = CDouble -> CDouble
forall a b. Coercible a b => a -> b
coerce (RoundingMode -> b -> CDouble
forall b. RealFloat b => RoundingMode -> b -> CDouble
forall a b.
(RoundedFractional a, RealFloat b) =>
RoundingMode -> b -> a
roundedFromRealFloat RoundingMode
r b
x :: C.CDouble)
  intervalFromRational :: Rational
-> (Rounded 'TowardNegInf CDouble, Rounded 'TowardInf CDouble)
intervalFromRational = (Rational
 -> (Rounded 'TowardNegInf CDouble, Rounded 'TowardInf CDouble))
-> Rational
-> (Rounded 'TowardNegInf CDouble, Rounded 'TowardInf CDouble)
forall a b. Coercible a b => a -> b
coerce (Rational
-> (Rounded 'TowardNegInf CDouble, Rounded 'TowardInf CDouble)
forall a.
RoundedFractional a =>
Rational -> (Rounded 'TowardNegInf a, Rounded 'TowardInf a)
intervalFromRational :: Rational -> (Rounded 'TowardNegInf C.CDouble, Rounded 'TowardInf C.CDouble))
  {-# INLINE roundedDiv #-}
  {-# INLINE intervalDiv #-}
  {-# INLINE intervalRecip #-}
  {-# INLINE roundedFromRational #-}
  {-# INLINE roundedFromRealFloat #-}
  {-# INLINE intervalFromRational #-}

instance RoundedSqrt CDouble where
  roundedSqrt :: RoundingMode -> CDouble -> CDouble
roundedSqrt = (RoundingMode -> Double -> Double)
-> RoundingMode -> CDouble -> CDouble
forall a b. Coercible a b => a -> b
coerce RoundingMode -> Double -> Double
D.roundedSqrt
  {-# INLINE roundedSqrt #-}

instance RoundedRing_Vector VS.Vector CDouble where
  roundedSum :: RoundingMode -> Vector CDouble -> CDouble
roundedSum RoundingMode
mode Vector CDouble
vec = CDouble -> CDouble
forall a b. Coercible a b => a -> b
coerce (RoundingMode -> Vector CDouble -> CDouble
forall (vector :: * -> *) a.
RoundedRing_Vector vector a =>
RoundingMode -> vector a -> a
roundedSum RoundingMode
mode (Vector CDouble -> Vector CDouble
forall a b. a -> b
unsafeCoerce Vector CDouble
vec :: VS.Vector C.CDouble))
  zipWith_roundedAdd :: RoundingMode -> Vector CDouble -> Vector CDouble -> Vector CDouble
zipWith_roundedAdd RoundingMode
mode Vector CDouble
vec Vector CDouble
vec' = Vector CDouble -> Vector CDouble
forall a b. a -> b
unsafeCoerce (RoundingMode -> Vector CDouble -> Vector CDouble -> Vector CDouble
forall (vector :: * -> *) a.
RoundedRing_Vector vector a =>
RoundingMode -> vector a -> vector a -> vector a
zipWith_roundedAdd RoundingMode
mode (Vector CDouble -> Vector CDouble
forall a b. a -> b
unsafeCoerce Vector CDouble
vec) (Vector CDouble -> Vector CDouble
forall a b. a -> b
unsafeCoerce Vector CDouble
vec') :: VS.Vector C.CDouble)
  zipWith_roundedSub :: RoundingMode -> Vector CDouble -> Vector CDouble -> Vector CDouble
zipWith_roundedSub RoundingMode
mode Vector CDouble
vec Vector CDouble
vec' = Vector CDouble -> Vector CDouble
forall a b. a -> b
unsafeCoerce (RoundingMode -> Vector CDouble -> Vector CDouble -> Vector CDouble
forall (vector :: * -> *) a.
RoundedRing_Vector vector a =>
RoundingMode -> vector a -> vector a -> vector a
zipWith_roundedSub RoundingMode
mode (Vector CDouble -> Vector CDouble
forall a b. a -> b
unsafeCoerce Vector CDouble
vec) (Vector CDouble -> Vector CDouble
forall a b. a -> b
unsafeCoerce Vector CDouble
vec') :: VS.Vector C.CDouble)
  zipWith_roundedMul :: RoundingMode -> Vector CDouble -> Vector CDouble -> Vector CDouble
zipWith_roundedMul RoundingMode
mode Vector CDouble
vec Vector CDouble
vec' = Vector CDouble -> Vector CDouble
forall a b. a -> b
unsafeCoerce (RoundingMode -> Vector CDouble -> Vector CDouble -> Vector CDouble
forall (vector :: * -> *) a.
RoundedRing_Vector vector a =>
RoundingMode -> vector a -> vector a -> vector a
zipWith_roundedMul RoundingMode
mode (Vector CDouble -> Vector CDouble
forall a b. a -> b
unsafeCoerce Vector CDouble
vec) (Vector CDouble -> Vector CDouble
forall a b. a -> b
unsafeCoerce Vector CDouble
vec') :: VS.Vector C.CDouble)
  zipWith3_roundedFusedMultiplyAdd :: RoundingMode
-> Vector CDouble
-> Vector CDouble
-> Vector CDouble
-> Vector CDouble
zipWith3_roundedFusedMultiplyAdd RoundingMode
mode Vector CDouble
vec1 Vector CDouble
vec2 Vector CDouble
vec3 = Vector CDouble -> Vector CDouble
forall a b. a -> b
unsafeCoerce (RoundingMode
-> Vector CDouble
-> Vector CDouble
-> Vector CDouble
-> Vector CDouble
forall (vector :: * -> *) a.
RoundedRing_Vector vector a =>
RoundingMode -> vector a -> vector a -> vector a -> vector a
zipWith3_roundedFusedMultiplyAdd RoundingMode
mode (Vector CDouble -> Vector CDouble
forall a b. a -> b
unsafeCoerce Vector CDouble
vec1) (Vector CDouble -> Vector CDouble
forall a b. a -> b
unsafeCoerce Vector CDouble
vec2) (Vector CDouble -> Vector CDouble
forall a b. a -> b
unsafeCoerce Vector CDouble
vec3) :: VS.Vector C.CDouble)
  {-# INLINE roundedSum #-}
  {-# INLINE zipWith_roundedAdd #-}
  {-# INLINE zipWith_roundedSub #-}
  {-# INLINE zipWith_roundedMul #-}
  {-# INLINE zipWith3_roundedFusedMultiplyAdd #-}

instance RoundedFractional_Vector VS.Vector CDouble where
  zipWith_roundedDiv :: RoundingMode -> Vector CDouble -> Vector CDouble -> Vector CDouble
zipWith_roundedDiv RoundingMode
mode Vector CDouble
vec Vector CDouble
vec' = Vector CDouble -> Vector CDouble
forall a b. a -> b
unsafeCoerce (RoundingMode -> Vector CDouble -> Vector CDouble -> Vector CDouble
forall (vector :: * -> *) a.
RoundedFractional_Vector vector a =>
RoundingMode -> vector a -> vector a -> vector a
zipWith_roundedDiv RoundingMode
mode (Vector CDouble -> Vector CDouble
forall a b. a -> b
unsafeCoerce Vector CDouble
vec) (Vector CDouble -> Vector CDouble
forall a b. a -> b
unsafeCoerce Vector CDouble
vec') :: VS.Vector C.CDouble)
  {-# INLINE zipWith_roundedDiv #-}

instance RoundedSqrt_Vector VS.Vector CDouble where
  map_roundedSqrt :: RoundingMode -> Vector CDouble -> Vector CDouble
map_roundedSqrt RoundingMode
mode Vector CDouble
vec = Vector CDouble -> Vector CDouble
forall a b. a -> b
unsafeCoerce (RoundingMode -> Vector CDouble -> Vector CDouble
forall (vector :: * -> *) a.
RoundedSqrt_Vector vector a =>
RoundingMode -> vector a -> vector a
map_roundedSqrt RoundingMode
mode (Vector CDouble -> Vector CDouble
forall a b. a -> b
unsafeCoerce Vector CDouble
vec) :: VS.Vector C.CDouble)
  {-# INLINE map_roundedSqrt #-}

deriving via C.CDouble instance RoundedRing_Vector VU.Vector CDouble
deriving via C.CDouble instance RoundedFractional_Vector VU.Vector CDouble
deriving via C.CDouble instance RoundedSqrt_Vector VU.Vector CDouble

--
-- FFI
--

foreign import prim "rounded_hw_interval_add"
  fastIntervalAdd# :: Double# -- lower 1, %xmm1
                   -> Double# -- upper 1, %xmm2
                   -> Double# -- lower 2, %xmm3
                   -> Double# -- upper 2, %xmm4
                   -> (# Double#  -- lower, %xmm1
                       , Double#  -- upper, %xmm2
                       #)

foreign import prim "rounded_hw_interval_sub"
  fastIntervalSub# :: Double# -- lower 1, %xmm1
                   -> Double# -- upper 1, %xmm2
                   -> Double# -- lower 2, %xmm3
                   -> Double# -- upper 2, %xmm4
                   -> (# Double#  -- lower, %xmm1
                       , Double#  -- upper, %xmm2
                       #)

foreign import prim "rounded_hw_interval_recip"
  fastIntervalRecip# :: Double# -- lower 1, %xmm1
                     -> Double# -- upper 1, %xmm2
                     -> (# Double#  -- lower, %xmm1
                         , Double#  -- upper, %xmm2
                         #)

{-
foreign import prim "rounded_hw_interval_sqrt"
  fastIntervalSqrt# :: Double# -- lower 1, %xmm1
                    -> Double# -- upper 1, %xmm2
                    -> (# Double#  -- lower, %xmm1
                        , Double#  -- upper, %xmm2
                        #)

#if WORD_SIZE_IN_BITS >= 64 && !MIN_VERSION_base(4,17,0)
type INT64# = Int#
type WORD64# = Word#
#else
type INT64# = Int64#
type WORD64# = Word64#
#endif

foreign import prim "rounded_hw_interval_from_int64"
  fastIntervalFromInt64# :: INT64# -- value
                         -> (# Double# -- lower, %xmm1
                             , Double# -- upper, %xmm2
                             #)

foreign import prim "rounded_hw_interval_from_word64"
  fastIntervalFromWord64# :: WORD64# -- value
                          -> (# Double# -- lower, %xmm1
                              , Double# -- upper, %xmm2
                              #)
-}

fastIntervalAdd :: Double -> Double -> Double -> Double -> (Double, Double)
fastIntervalAdd :: Double -> Double -> Double -> Double -> (Double, Double)
fastIntervalAdd (D# Double#
l1) (D# Double#
h1) (D# Double#
l2) (D# Double#
h2) = case Double# -> Double# -> Double# -> Double# -> (# Double#, Double# #)
fastIntervalAdd# Double#
l1 Double#
h1 Double#
l2 Double#
h2 of
  (# Double#
l3, Double#
h3 #) -> (Double# -> Double
D# Double#
l3, Double# -> Double
D# Double#
h3)
{-# INLINE fastIntervalAdd #-}

fastIntervalSub :: Double -> Double -> Double -> Double -> (Double, Double)
fastIntervalSub :: Double -> Double -> Double -> Double -> (Double, Double)
fastIntervalSub (D# Double#
l1) (D# Double#
h1) (D# Double#
l2) (D# Double#
h2) = case Double# -> Double# -> Double# -> Double# -> (# Double#, Double# #)
fastIntervalSub# Double#
l1 Double#
h1 Double#
l2 Double#
h2 of
  (# Double#
l3, Double#
h3 #) -> (Double# -> Double
D# Double#
l3, Double# -> Double
D# Double#
h3)
{-# INLINE fastIntervalSub #-}

fastIntervalRecip :: Double -> Double -> (Double, Double)
fastIntervalRecip :: Double -> Double -> (Double, Double)
fastIntervalRecip (D# Double#
l1) (D# Double#
h1) = case Double# -> Double# -> (# Double#, Double# #)
fastIntervalRecip# Double#
l1 Double#
h1 of
  (# Double#
l2, Double#
h2 #) -> (Double# -> Double
D# Double#
l2, Double# -> Double
D# Double#
h2)
{-# INLINE fastIntervalRecip #-}

{-
fastIntervalSqrt :: Double -> Double -> (Double, Double)
fastIntervalSqrt (D# l1) (D# h1) = case fastIntervalSqrt# l1 h1 of
  (# l2, h2 #) -> (D# l2, D# h2)
{-# INLINE fastIntervalSqrt #-}

fastIntervalFromInt64 :: Int64 -> (Double, Double)
fastIntervalFromInt64 (I64# x) = case fastIntervalFromInt64# x of
  (# l, h #) -> (D# l, D# h)
{-# INLINE fastIntervalFromInt64 #-}

fastIntervalFromWord64 :: Word64 -> (Double, Double)
fastIntervalFromWord64 (W64# x) = case fastIntervalFromWord64# x of
  (# l, h #) -> (D# l, D# h)
{-# INLINE fastIntervalFromWord64 #-}
-}

--
-- Backend name
--

foreign import ccall "&rounded_hw_interval_backend_name"
  c_interval_backend_name :: CString

intervalBackendName :: String
intervalBackendName :: String
intervalBackendName = IO String -> String
forall a. IO a -> a
unsafePerformIO (CString -> IO String
peekCString CString
c_interval_backend_name)

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

newtype instance VUM.MVector s CDouble = MV_CDouble (VUM.MVector s Double)
newtype instance VU.Vector CDouble = V_CDouble (VU.Vector Double)

instance VGM.MVector VUM.MVector CDouble where
  basicLength :: forall s. MVector s CDouble -> Int
basicLength (MV_CDouble MVector s Double
mv) = MVector s Double -> Int
forall s. MVector s Double -> Int
forall (v :: * -> * -> *) a s. MVector v a => v s a -> Int
VGM.basicLength MVector s Double
mv
  basicUnsafeSlice :: forall s. Int -> Int -> MVector s CDouble -> MVector s CDouble
basicUnsafeSlice Int
i Int
l (MV_CDouble MVector s Double
mv) = MVector s Double -> MVector s CDouble
forall s. MVector s Double -> MVector s CDouble
MV_CDouble (Int -> Int -> MVector s Double -> MVector s Double
forall s. Int -> Int -> MVector s Double -> MVector s Double
forall (v :: * -> * -> *) a s.
MVector v a =>
Int -> Int -> v s a -> v s a
VGM.basicUnsafeSlice Int
i Int
l MVector s Double
mv)
  basicOverlaps :: forall s. MVector s CDouble -> MVector s CDouble -> Bool
basicOverlaps (MV_CDouble MVector s Double
mv) (MV_CDouble MVector s Double
mv') = MVector s Double -> MVector s Double -> Bool
forall s. MVector s Double -> MVector s Double -> Bool
forall (v :: * -> * -> *) a s.
MVector v a =>
v s a -> v s a -> Bool
VGM.basicOverlaps MVector s Double
mv MVector s Double
mv'
  basicUnsafeNew :: forall s. Int -> ST s (MVector s CDouble)
basicUnsafeNew Int
l = MVector s Double -> MVector s CDouble
forall s. MVector s Double -> MVector s CDouble
MV_CDouble (MVector s Double -> MVector s CDouble)
-> ST s (MVector s Double) -> ST s (MVector s CDouble)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> ST s (MVector s Double)
forall s. Int -> ST s (MVector s Double)
forall (v :: * -> * -> *) a s. MVector v a => Int -> ST s (v s a)
VGM.basicUnsafeNew Int
l
  basicInitialize :: forall s. MVector s CDouble -> ST s ()
basicInitialize (MV_CDouble MVector s Double
mv) = MVector s Double -> ST s ()
forall s. MVector s Double -> ST s ()
forall (v :: * -> * -> *) a s. MVector v a => v s a -> ST s ()
VGM.basicInitialize MVector s Double
mv
  basicUnsafeReplicate :: forall s. Int -> CDouble -> ST s (MVector s CDouble)
basicUnsafeReplicate Int
i CDouble
x = MVector s Double -> MVector s CDouble
forall s. MVector s Double -> MVector s CDouble
MV_CDouble (MVector s Double -> MVector s CDouble)
-> ST s (MVector s Double) -> ST s (MVector s CDouble)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Double -> ST s (MVector s Double)
forall s. Int -> Double -> ST s (MVector s Double)
forall (v :: * -> * -> *) a s.
MVector v a =>
Int -> a -> ST s (v s a)
VGM.basicUnsafeReplicate Int
i (CDouble -> Double
forall a b. Coercible a b => a -> b
coerce CDouble
x)
  basicUnsafeRead :: forall s. MVector s CDouble -> Int -> ST s CDouble
basicUnsafeRead (MV_CDouble MVector s Double
mv) Int
i = Double -> CDouble
forall a b. Coercible a b => a -> b
coerce (Double -> CDouble) -> ST s Double -> ST s CDouble
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MVector s Double -> Int -> ST s Double
forall s. MVector s Double -> Int -> ST s Double
forall (v :: * -> * -> *) a s.
MVector v a =>
v s a -> Int -> ST s a
VGM.basicUnsafeRead MVector s Double
mv Int
i
  basicUnsafeWrite :: forall s. MVector s CDouble -> Int -> CDouble -> ST s ()
basicUnsafeWrite (MV_CDouble MVector s Double
mv) Int
i CDouble
x = MVector s Double -> Int -> Double -> ST s ()
forall s. MVector s Double -> Int -> Double -> ST s ()
forall (v :: * -> * -> *) a s.
MVector v a =>
v s a -> Int -> a -> ST s ()
VGM.basicUnsafeWrite MVector s Double
mv Int
i (CDouble -> Double
forall a b. Coercible a b => a -> b
coerce CDouble
x)
  basicClear :: forall s. MVector s CDouble -> ST s ()
basicClear (MV_CDouble MVector s Double
mv) = MVector s Double -> ST s ()
forall s. MVector s Double -> ST s ()
forall (v :: * -> * -> *) a s. MVector v a => v s a -> ST s ()
VGM.basicClear MVector s Double
mv
  basicSet :: forall s. MVector s CDouble -> CDouble -> ST s ()
basicSet (MV_CDouble MVector s Double
mv) CDouble
x = MVector s Double -> Double -> ST s ()
forall s. MVector s Double -> Double -> ST s ()
forall (v :: * -> * -> *) a s. MVector v a => v s a -> a -> ST s ()
VGM.basicSet MVector s Double
mv (CDouble -> Double
forall a b. Coercible a b => a -> b
coerce CDouble
x)
  basicUnsafeCopy :: forall s. MVector s CDouble -> MVector s CDouble -> ST s ()
basicUnsafeCopy (MV_CDouble MVector s Double
mv) (MV_CDouble MVector s Double
mv') = MVector s Double -> MVector s Double -> ST s ()
forall s. MVector s Double -> MVector s Double -> ST s ()
forall (v :: * -> * -> *) a s.
MVector v a =>
v s a -> v s a -> ST s ()
VGM.basicUnsafeCopy MVector s Double
mv MVector s Double
mv'
  basicUnsafeMove :: forall s. MVector s CDouble -> MVector s CDouble -> ST s ()
basicUnsafeMove (MV_CDouble MVector s Double
mv) (MV_CDouble MVector s Double
mv') = MVector s Double -> MVector s Double -> ST s ()
forall s. MVector s Double -> MVector s Double -> ST s ()
forall (v :: * -> * -> *) a s.
MVector v a =>
v s a -> v s a -> ST s ()
VGM.basicUnsafeMove MVector s Double
mv MVector s Double
mv'
  basicUnsafeGrow :: forall s. MVector s CDouble -> Int -> ST s (MVector s CDouble)
basicUnsafeGrow (MV_CDouble MVector s Double
mv) Int
n = MVector s Double -> MVector s CDouble
forall s. MVector s Double -> MVector s CDouble
MV_CDouble (MVector s Double -> MVector s CDouble)
-> ST s (MVector s Double) -> ST s (MVector s CDouble)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MVector s Double -> Int -> ST s (MVector s Double)
forall s. MVector s Double -> Int -> ST s (MVector s Double)
forall (v :: * -> * -> *) a s.
MVector v a =>
v s a -> Int -> ST s (v s a)
VGM.basicUnsafeGrow MVector s Double
mv Int
n

instance VG.Vector VU.Vector CDouble where
  basicUnsafeFreeze :: forall s. Mutable Vector s CDouble -> ST s (Vector CDouble)
basicUnsafeFreeze (MV_CDouble MVector s Double
mv) = Vector Double -> Vector CDouble
V_CDouble (Vector Double -> Vector CDouble)
-> ST s (Vector Double) -> ST s (Vector CDouble)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mutable Vector s Double -> ST s (Vector Double)
forall s. Mutable Vector s Double -> ST s (Vector Double)
forall (v :: * -> *) a s. Vector v a => Mutable v s a -> ST s (v a)
VG.basicUnsafeFreeze Mutable Vector s Double
MVector s Double
mv
  basicUnsafeThaw :: forall s. Vector CDouble -> ST s (Mutable Vector s CDouble)
basicUnsafeThaw (V_CDouble Vector Double
v) = MVector s Double -> MVector s CDouble
forall s. MVector s Double -> MVector s CDouble
MV_CDouble (MVector s Double -> MVector s CDouble)
-> ST s (MVector s Double) -> ST s (MVector s CDouble)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Vector Double -> ST s (Mutable Vector s Double)
forall s. Vector Double -> ST s (Mutable Vector s Double)
forall (v :: * -> *) a s. Vector v a => v a -> ST s (Mutable v s a)
VG.basicUnsafeThaw Vector Double
v
  basicLength :: Vector CDouble -> Int
basicLength (V_CDouble Vector Double
v) = Vector Double -> Int
forall (v :: * -> *) a. Vector v a => v a -> Int
VG.basicLength Vector Double
v
  basicUnsafeSlice :: Int -> Int -> Vector CDouble -> Vector CDouble
basicUnsafeSlice Int
i Int
l (V_CDouble Vector Double
v) = Vector Double -> Vector CDouble
V_CDouble (Int -> Int -> Vector Double -> Vector Double
forall (v :: * -> *) a. Vector v a => Int -> Int -> v a -> v a
VG.basicUnsafeSlice Int
i Int
l Vector Double
v)
  basicUnsafeIndexM :: Vector CDouble -> Int -> Box CDouble
basicUnsafeIndexM (V_CDouble Vector Double
v) Int
i = Double -> CDouble
forall a b. Coercible a b => a -> b
coerce (Double -> CDouble) -> Box Double -> Box CDouble
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Vector Double -> Int -> Box Double
forall (v :: * -> *) a. Vector v a => v a -> Int -> Box a
VG.basicUnsafeIndexM Vector Double
v Int
i
  basicUnsafeCopy :: forall s. Mutable Vector s CDouble -> Vector CDouble -> ST s ()
basicUnsafeCopy (MV_CDouble MVector s Double
mv) (V_CDouble Vector Double
v) = Mutable Vector s Double -> Vector Double -> ST s ()
forall s. Mutable Vector s Double -> Vector Double -> ST s ()
forall (v :: * -> *) a s.
Vector v a =>
Mutable v s a -> v a -> ST s ()
VG.basicUnsafeCopy Mutable Vector s Double
MVector s Double
mv Vector Double
v
  elemseq :: forall b. Vector CDouble -> CDouble -> b -> b
elemseq (V_CDouble Vector Double
v) CDouble
x b
y = Vector Double -> Double -> b -> b
forall b. Vector Double -> Double -> b -> b
forall (v :: * -> *) a b. Vector v a => v a -> a -> b -> b
VG.elemseq Vector Double
v (CDouble -> Double
forall a b. Coercible a b => a -> b
coerce CDouble
x) b
y

instance VU.Unbox CDouble