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

instance NFData CDouble

instance RoundedRing CDouble where
  roundedAdd :: RoundingMode -> CDouble -> CDouble -> CDouble
roundedAdd = (RoundingMode -> Double -> Double -> Double)
-> RoundingMode -> CDouble -> CDouble -> CDouble
coerce RoundingMode -> Double -> Double -> Double
D.roundedAdd
  roundedSub :: RoundingMode -> CDouble -> CDouble -> CDouble
roundedSub = (RoundingMode -> Double -> Double -> Double)
-> RoundingMode -> CDouble -> CDouble -> CDouble
coerce RoundingMode -> Double -> Double -> Double
D.roundedSub
  roundedMul :: RoundingMode -> CDouble -> CDouble -> CDouble
roundedMul = (RoundingMode -> Double -> Double -> Double)
-> RoundingMode -> CDouble -> CDouble -> CDouble
coerce RoundingMode -> Double -> Double -> Double
D.roundedMul
  roundedFusedMultiplyAdd :: RoundingMode -> CDouble -> CDouble -> CDouble -> CDouble
roundedFusedMultiplyAdd = (RoundingMode -> Double -> Double -> Double -> Double)
-> RoundingMode -> CDouble -> CDouble -> CDouble -> CDouble
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)
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)
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
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
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
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
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
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)
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
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
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
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
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
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)
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
coerce (RoundingMode -> Rational -> CDouble
forall a. RoundedFractional a => RoundingMode -> Rational -> a
roundedFromRational :: RoundingMode -> Rational -> C.CDouble)
  roundedFromRealFloat :: RoundingMode -> b -> CDouble
roundedFromRealFloat RoundingMode
r b
x = CDouble -> CDouble
coerce (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)
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
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
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
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 :: Double -> Double -> (Double, Double)
fastIntervalSqrt (D# Double#
l1) (D# Double#
h1) = case Double# -> Double# -> (# Double#, Double# #)
fastIntervalSqrt# Double#
l1 Double#
h1 of
  (# Double#
l2, Double#
h2 #) -> (Double# -> Double
D# Double#
l2, Double# -> Double
D# Double#
h2)
{-# INLINE fastIntervalSqrt #-}

fastIntervalFromInt64 :: Int64 -> (Double, Double)
fastIntervalFromInt64 :: Int64 -> (Double, Double)
fastIntervalFromInt64 (I64# Int#
x) = case Int# -> (# Double#, Double# #)
fastIntervalFromInt64# Int#
x of
  (# Double#
l, Double#
h #) -> (Double# -> Double
D# Double#
l, Double# -> Double
D# Double#
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 :: MVector s CDouble -> Int
basicLength (MV_CDouble mv) = MVector s Double -> Int
forall (v :: * -> * -> *) a s. MVector v a => v s a -> Int
VGM.basicLength MVector s Double
mv
  basicUnsafeSlice :: Int -> Int -> MVector s CDouble -> MVector s CDouble
basicUnsafeSlice Int
i Int
l (MV_CDouble 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 (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 :: MVector s CDouble -> MVector s CDouble -> Bool
basicOverlaps (MV_CDouble mv) (MV_CDouble mv') = 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 :: Int -> m (MVector (PrimState m) CDouble)
basicUnsafeNew Int
l = MVector (PrimState m) Double -> MVector (PrimState m) CDouble
forall s. MVector s Double -> MVector s CDouble
MV_CDouble (MVector (PrimState m) Double -> MVector (PrimState m) CDouble)
-> m (MVector (PrimState m) Double)
-> m (MVector (PrimState m) CDouble)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> m (MVector (PrimState m) Double)
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
Int -> m (v (PrimState m) a)
VGM.basicUnsafeNew Int
l
  basicInitialize :: MVector (PrimState m) CDouble -> m ()
basicInitialize (MV_CDouble mv) = MVector (PrimState m) Double -> m ()
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> m ()
VGM.basicInitialize MVector (PrimState m) Double
mv
  basicUnsafeReplicate :: Int -> CDouble -> m (MVector (PrimState m) CDouble)
basicUnsafeReplicate Int
i CDouble
x = MVector (PrimState m) Double -> MVector (PrimState m) CDouble
forall s. MVector s Double -> MVector s CDouble
MV_CDouble (MVector (PrimState m) Double -> MVector (PrimState m) CDouble)
-> m (MVector (PrimState m) Double)
-> m (MVector (PrimState m) CDouble)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Double -> m (MVector (PrimState m) Double)
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
Int -> a -> m (v (PrimState m) a)
VGM.basicUnsafeReplicate Int
i (CDouble -> Double
coerce CDouble
x)
  basicUnsafeRead :: MVector (PrimState m) CDouble -> Int -> m CDouble
basicUnsafeRead (MV_CDouble mv) Int
i = Double -> CDouble
coerce (Double -> CDouble) -> m Double -> m CDouble
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MVector (PrimState m) Double -> Int -> m Double
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> Int -> m a
VGM.basicUnsafeRead MVector (PrimState m) Double
mv Int
i
  basicUnsafeWrite :: MVector (PrimState m) CDouble -> Int -> CDouble -> m ()
basicUnsafeWrite (MV_CDouble mv) Int
i CDouble
x = MVector (PrimState m) Double -> Int -> Double -> m ()
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> Int -> a -> m ()
VGM.basicUnsafeWrite MVector (PrimState m) Double
mv Int
i (CDouble -> Double
coerce CDouble
x)
  basicClear :: MVector (PrimState m) CDouble -> m ()
basicClear (MV_CDouble mv) = MVector (PrimState m) Double -> m ()
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> m ()
VGM.basicClear MVector (PrimState m) Double
mv
  basicSet :: MVector (PrimState m) CDouble -> CDouble -> m ()
basicSet (MV_CDouble mv) CDouble
x = MVector (PrimState m) Double -> Double -> m ()
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> a -> m ()
VGM.basicSet MVector (PrimState m) Double
mv (CDouble -> Double
coerce CDouble
x)
  basicUnsafeCopy :: MVector (PrimState m) CDouble
-> MVector (PrimState m) CDouble -> m ()
basicUnsafeCopy (MV_CDouble mv) (MV_CDouble mv') = MVector (PrimState m) Double
-> MVector (PrimState m) Double -> m ()
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> v (PrimState m) a -> m ()
VGM.basicUnsafeCopy MVector (PrimState m) Double
mv MVector (PrimState m) Double
mv'
  basicUnsafeMove :: MVector (PrimState m) CDouble
-> MVector (PrimState m) CDouble -> m ()
basicUnsafeMove (MV_CDouble mv) (MV_CDouble mv') = MVector (PrimState m) Double
-> MVector (PrimState m) Double -> m ()
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> v (PrimState m) a -> m ()
VGM.basicUnsafeMove MVector (PrimState m) Double
mv MVector (PrimState m) Double
mv'
  basicUnsafeGrow :: MVector (PrimState m) CDouble
-> Int -> m (MVector (PrimState m) CDouble)
basicUnsafeGrow (MV_CDouble mv) Int
n = MVector (PrimState m) Double -> MVector (PrimState m) CDouble
forall s. MVector s Double -> MVector s CDouble
MV_CDouble (MVector (PrimState m) Double -> MVector (PrimState m) CDouble)
-> m (MVector (PrimState m) Double)
-> m (MVector (PrimState m) CDouble)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MVector (PrimState m) Double
-> Int -> m (MVector (PrimState m) Double)
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> Int -> m (v (PrimState m) a)
VGM.basicUnsafeGrow MVector (PrimState m) Double
mv Int
n

instance VG.Vector VU.Vector CDouble where
  basicUnsafeFreeze :: Mutable Vector (PrimState m) CDouble -> m (Vector CDouble)
basicUnsafeFreeze (MV_CDouble mv) = Vector Double -> Vector CDouble
V_CDouble (Vector Double -> Vector CDouble)
-> m (Vector Double) -> m (Vector CDouble)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mutable Vector (PrimState m) Double -> m (Vector Double)
forall (v :: * -> *) a (m :: * -> *).
(Vector v a, PrimMonad m) =>
Mutable v (PrimState m) a -> m (v a)
VG.basicUnsafeFreeze MVector (PrimState m) Double
Mutable Vector (PrimState m) Double
mv
  basicUnsafeThaw :: Vector CDouble -> m (Mutable Vector (PrimState m) CDouble)
basicUnsafeThaw (V_CDouble v) = MVector (PrimState m) Double -> MVector (PrimState m) CDouble
forall s. MVector s Double -> MVector s CDouble
MV_CDouble (MVector (PrimState m) Double -> MVector (PrimState m) CDouble)
-> m (MVector (PrimState m) Double)
-> m (MVector (PrimState m) CDouble)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Vector Double -> m (Mutable Vector (PrimState m) Double)
forall (v :: * -> *) a (m :: * -> *).
(Vector v a, PrimMonad m) =>
v a -> m (Mutable v (PrimState m) a)
VG.basicUnsafeThaw Vector Double
v
  basicLength :: Vector CDouble -> Int
basicLength (V_CDouble 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 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 -> m CDouble
basicUnsafeIndexM (V_CDouble v) Int
i = Double -> CDouble
coerce (Double -> CDouble) -> m Double -> m CDouble
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Vector Double -> Int -> m Double
forall (v :: * -> *) a (m :: * -> *).
(Vector v a, Monad m) =>
v a -> Int -> m a
VG.basicUnsafeIndexM Vector Double
v Int
i
  basicUnsafeCopy :: Mutable Vector (PrimState m) CDouble -> Vector CDouble -> m ()
basicUnsafeCopy (MV_CDouble mv) (V_CDouble v) = Mutable Vector (PrimState m) Double -> Vector Double -> m ()
forall (v :: * -> *) a (m :: * -> *).
(Vector v a, PrimMonad m) =>
Mutable v (PrimState m) a -> v a -> m ()
VG.basicUnsafeCopy MVector (PrimState m) Double
Mutable Vector (PrimState m) Double
mv Vector Double
v
  elemseq :: Vector CDouble -> CDouble -> b -> b
elemseq (V_CDouble v) CDouble
x b
y = Vector Double -> Double -> b -> b
forall (v :: * -> *) a b. Vector v a => v a -> a -> b -> b
VG.elemseq Vector Double
v (CDouble -> Double
coerce CDouble
x) b
y

instance VU.Unbox CDouble