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

The types in this module implements rounding-mode-controlled operations in C.

There are several ways to control rounding mode in C, and an appropriate technology will be selected at compile time.
This library implements the following options:

    * C99 @fesetround@
    * On x86 systems,

        * SSE2 MXCSR (for 'Float' and 'Double')
        * AVX512 EVEX encoding (for 'Float' and 'Double')
        * x87 Control Word (for 'Numeric.LongDouble.LongDouble')

    * On AArch64, FPCR

You should not need to import this module directly.

This module is not available if the package flag @pure-hs@ is set.
-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
module Numeric.Rounded.Hardware.Backend.C
  ( CFloat(..)
  , CDouble(..)
  , VUM.MVector(..)
  , VU.Vector(..)
  , roundedFloatFromInt64
  , roundedFloatFromWord64
  , roundedDoubleFromInt64
  , roundedDoubleFromWord64
  ) where
import           Control.DeepSeq (NFData (..))
import           Data.Bifunctor
import           Data.Coerce
import           Data.Int (Int64)
import           Data.Primitive (Prim)
import           Data.Primitive.ByteArray
import           Data.Tagged
import qualified Data.Vector.Generic as VG
import qualified Data.Vector.Generic.Mutable as VGM
import qualified Data.Vector.Primitive as VP
import qualified Data.Vector.Primitive.Mutable as VPM
import qualified Data.Vector.Storable as VS
import qualified Data.Vector.Storable.Mutable as VSM
import qualified Data.Vector.Unboxed.Base as VU
import qualified Data.Vector.Unboxed.Mutable as VUM
import           Data.Word (Word64)
import qualified FFIWrapper.Double as D
import qualified FFIWrapper.Float as F
import           Foreign.C.String (CString, peekCString)
import           Foreign.Ptr (Ptr, castPtr)
import           Foreign.Storable (Storable)
import           GHC.Generics (Generic)
import           GHC.Exts (RealWorld)
import           Numeric.Rounded.Hardware.Internal.Class
import           Numeric.Rounded.Hardware.Internal.Conversion
import           System.IO.Unsafe (unsafePerformIO)

--
-- Float
--

-- | A wrapper providing particular instances for 'RoundedRing', 'RoundedFractional' and 'RoundedSqrt'.
--
-- This type is different from @CFloat@ from "Foreign.C.Types".
newtype CFloat = CFloat Float
  deriving (CFloat -> CFloat -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CFloat -> CFloat -> Bool
$c/= :: CFloat -> CFloat -> Bool
== :: CFloat -> CFloat -> Bool
$c== :: CFloat -> CFloat -> Bool
Eq,Eq CFloat
CFloat -> CFloat -> Bool
CFloat -> CFloat -> Ordering
CFloat -> CFloat -> CFloat
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 :: CFloat -> CFloat -> CFloat
$cmin :: CFloat -> CFloat -> CFloat
max :: CFloat -> CFloat -> CFloat
$cmax :: CFloat -> CFloat -> CFloat
>= :: CFloat -> CFloat -> Bool
$c>= :: CFloat -> CFloat -> Bool
> :: CFloat -> CFloat -> Bool
$c> :: CFloat -> CFloat -> Bool
<= :: CFloat -> CFloat -> Bool
$c<= :: CFloat -> CFloat -> Bool
< :: CFloat -> CFloat -> Bool
$c< :: CFloat -> CFloat -> Bool
compare :: CFloat -> CFloat -> Ordering
$ccompare :: CFloat -> CFloat -> Ordering
Ord,Int -> CFloat -> ShowS
[CFloat] -> ShowS
CFloat -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CFloat] -> ShowS
$cshowList :: [CFloat] -> ShowS
show :: CFloat -> String
$cshow :: CFloat -> String
showsPrec :: Int -> CFloat -> ShowS
$cshowsPrec :: Int -> CFloat -> ShowS
Show,forall x. Rep CFloat x -> CFloat
forall x. CFloat -> Rep CFloat x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CFloat x -> CFloat
$cfrom :: forall x. CFloat -> Rep CFloat x
Generic,Integer -> CFloat
CFloat -> CFloat
CFloat -> CFloat -> CFloat
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> CFloat
$cfromInteger :: Integer -> CFloat
signum :: CFloat -> CFloat
$csignum :: CFloat -> CFloat
abs :: CFloat -> CFloat
$cabs :: CFloat -> CFloat
negate :: CFloat -> CFloat
$cnegate :: CFloat -> CFloat
* :: CFloat -> CFloat -> CFloat
$c* :: CFloat -> CFloat -> CFloat
- :: CFloat -> CFloat -> CFloat
$c- :: CFloat -> CFloat -> CFloat
+ :: CFloat -> CFloat -> CFloat
$c+ :: CFloat -> CFloat -> CFloat
Num,Ptr CFloat -> IO CFloat
Ptr CFloat -> Int -> IO CFloat
Ptr CFloat -> Int -> CFloat -> IO ()
Ptr CFloat -> CFloat -> IO ()
CFloat -> Int
forall b. Ptr b -> Int -> IO CFloat
forall b. Ptr b -> Int -> CFloat -> 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 CFloat -> CFloat -> IO ()
$cpoke :: Ptr CFloat -> CFloat -> IO ()
peek :: Ptr CFloat -> IO CFloat
$cpeek :: Ptr CFloat -> IO CFloat
pokeByteOff :: forall b. Ptr b -> Int -> CFloat -> IO ()
$cpokeByteOff :: forall b. Ptr b -> Int -> CFloat -> IO ()
peekByteOff :: forall b. Ptr b -> Int -> IO CFloat
$cpeekByteOff :: forall b. Ptr b -> Int -> IO CFloat
pokeElemOff :: Ptr CFloat -> Int -> CFloat -> IO ()
$cpokeElemOff :: Ptr CFloat -> Int -> CFloat -> IO ()
peekElemOff :: Ptr CFloat -> Int -> IO CFloat
$cpeekElemOff :: Ptr CFloat -> Int -> IO CFloat
alignment :: CFloat -> Int
$calignment :: CFloat -> Int
sizeOf :: CFloat -> Int
$csizeOf :: CFloat -> Int
Storable)

instance NFData CFloat

roundedFloatFromInt64 :: RoundingMode -> Int64 -> Float
roundedFloatFromInt64 :: RoundingMode -> Int64 -> Float
roundedFloatFromInt64 RoundingMode
r Int64
x = forall a. Bool -> a -> a -> a
staticIf
  (-Int64
0x1000000 forall a. Ord a => a -> a -> Bool
<= Int64
x Bool -> Bool -> Bool
&& Int64
x forall a. Ord a => a -> a -> Bool
<= Int64
0x1000000 {- abs x <= 2^24 -}) -- if input is known to be small enough
  (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
x)
  (RoundingMode -> Int64 -> Float
F.roundedFromInt64 RoundingMode
r Int64
x)
{-# INLINE roundedFloatFromInt64 #-}

roundedFloatFromWord64 :: RoundingMode -> Word64 -> Float
roundedFloatFromWord64 :: RoundingMode -> Word64 -> Float
roundedFloatFromWord64 RoundingMode
r Word64
x = forall a. Bool -> a -> a -> a
staticIf
  (Word64
x forall a. Ord a => a -> a -> Bool
<= Word64
0x1000000 {- x <= 2^24 -}) -- if input is known to be small enough
  (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
x)
  (RoundingMode -> Word64 -> Float
F.roundedFromWord64 RoundingMode
r Word64
x)
{-# INLINE roundedFloatFromWord64 #-}

roundedFloatFromRealFloat :: RealFloat a => RoundingMode -> a -> Float
roundedFloatFromRealFloat :: forall a. RealFloat a => RoundingMode -> a -> Float
roundedFloatFromRealFloat RoundingMode
r a
x | forall a. RealFloat a => a -> Bool
isNaN a
x = Float
0forall a. Fractional a => a -> a -> a
/Float
0
                              | forall a. RealFloat a => a -> Bool
isInfinite a
x = if a
x forall a. Ord a => a -> a -> Bool
> a
0 then Float
1forall a. Fractional a => a -> a -> a
/Float
0 else -Float
1forall a. Fractional a => a -> a -> a
/Float
0
                              | forall a. RealFloat a => a -> Bool
isNegativeZero a
x = -Float
0
                              | Bool
otherwise = coerce :: forall a b. Coercible a b => a -> b
coerce (forall a. RoundedFractional a => RoundingMode -> Rational -> a
roundedFromRational RoundingMode
r (forall a. Real a => a -> Rational
toRational a
x) :: CFloat)
{-# NOINLINE [1] roundedFloatFromRealFloat #-}
{-# RULES
"roundedFloatFromRealFloat/Float" forall r (x :: Float).
  roundedFloatFromRealFloat r x = x
  #-}

instance RoundedRing CFloat where
  roundedAdd :: RoundingMode -> CFloat -> CFloat -> CFloat
roundedAdd = coerce :: forall a b. Coercible a b => a -> b
coerce RoundingMode -> Float -> Float -> Float
F.roundedAdd
  roundedSub :: RoundingMode -> CFloat -> CFloat -> CFloat
roundedSub = coerce :: forall a b. Coercible a b => a -> b
coerce RoundingMode -> Float -> Float -> Float
F.roundedSub
  roundedMul :: RoundingMode -> CFloat -> CFloat -> CFloat
roundedMul = coerce :: forall a b. Coercible a b => a -> b
coerce RoundingMode -> Float -> Float -> Float
F.roundedMul
  roundedFusedMultiplyAdd :: RoundingMode -> CFloat -> CFloat -> CFloat -> CFloat
roundedFusedMultiplyAdd = coerce :: forall a b. Coercible a b => a -> b
coerce RoundingMode -> Float -> Float -> Float -> Float
F.roundedFMA
  intervalMul :: Rounded 'TowardNegInf CFloat
-> Rounded 'TowardInf CFloat
-> Rounded 'TowardNegInf CFloat
-> Rounded 'TowardInf CFloat
-> (Rounded 'TowardNegInf CFloat, Rounded 'TowardInf CFloat)
intervalMul Rounded 'TowardNegInf CFloat
x Rounded 'TowardInf CFloat
x' Rounded 'TowardNegInf CFloat
y Rounded 'TowardInf CFloat
y' = (coerce :: forall a b. Coercible a b => a -> b
coerce Float -> Float -> Float -> Float -> Float
F.intervalMul_down Rounded 'TowardNegInf CFloat
x Rounded 'TowardInf CFloat
x' Rounded 'TowardNegInf CFloat
y Rounded 'TowardInf CFloat
y', coerce :: forall a b. Coercible a b => a -> b
coerce Float -> Float -> Float -> Float -> Float
F.intervalMul_up Rounded 'TowardNegInf CFloat
x Rounded 'TowardInf CFloat
x' Rounded 'TowardNegInf CFloat
y Rounded 'TowardInf CFloat
y')
  intervalMulAdd :: Rounded 'TowardNegInf CFloat
-> Rounded 'TowardInf CFloat
-> Rounded 'TowardNegInf CFloat
-> Rounded 'TowardInf CFloat
-> Rounded 'TowardNegInf CFloat
-> Rounded 'TowardInf CFloat
-> (Rounded 'TowardNegInf CFloat, Rounded 'TowardInf CFloat)
intervalMulAdd Rounded 'TowardNegInf CFloat
x Rounded 'TowardInf CFloat
x' Rounded 'TowardNegInf CFloat
y Rounded 'TowardInf CFloat
y' Rounded 'TowardNegInf CFloat
z Rounded 'TowardInf CFloat
z' = (coerce :: forall a b. Coercible a b => a -> b
coerce Float -> Float -> Float -> Float -> Float -> Float
F.intervalMulAdd_down Rounded 'TowardNegInf CFloat
x Rounded 'TowardInf CFloat
x' Rounded 'TowardNegInf CFloat
y Rounded 'TowardInf CFloat
y' Rounded 'TowardNegInf CFloat
z, coerce :: forall a b. Coercible a b => a -> b
coerce Float -> Float -> Float -> Float -> Float -> Float
F.intervalMulAdd_up Rounded 'TowardNegInf CFloat
x Rounded 'TowardInf CFloat
x' Rounded 'TowardNegInf CFloat
y Rounded 'TowardInf CFloat
y' Rounded 'TowardInf CFloat
z')
  roundedFromInteger :: RoundingMode -> Integer -> CFloat
roundedFromInteger RoundingMode
r Integer
x = Float -> CFloat
CFloat (forall a. RealFloat a => RoundingMode -> Integer -> a
roundedFromInteger_default RoundingMode
r Integer
x)
  intervalFromInteger :: Integer
-> (Rounded 'TowardNegInf CFloat, Rounded 'TowardInf CFloat)
intervalFromInteger = (coerce :: forall a b. Coercible a b => a -> b
coerce forall a. a -> a -> a
`asTypeOf` (forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (Float -> CFloat
CFloat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (Float -> CFloat
CFloat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) forall b c a. (b -> c) -> (a -> b) -> a -> c
.)) forall a.
RealFloat a =>
Integer -> (Rounded 'TowardNegInf a, Rounded 'TowardInf a)
intervalFromInteger_default
  backendNameT :: Tagged CFloat String
backendNameT = forall {k} (s :: k) b. b -> Tagged s b
Tagged String
cBackendName
  {-# INLINE roundedAdd #-}
  {-# INLINE roundedSub #-}
  {-# INLINE roundedMul #-}
  {-# INLINE roundedFusedMultiplyAdd #-}
  {-# INLINE intervalMul #-}
  {-# INLINE roundedFromInteger #-}
  {-# INLINE intervalFromInteger #-}

instance RoundedFractional CFloat where
  roundedDiv :: RoundingMode -> CFloat -> CFloat -> CFloat
roundedDiv = coerce :: forall a b. Coercible a b => a -> b
coerce RoundingMode -> Float -> Float -> Float
F.roundedDiv
  intervalDiv :: Rounded 'TowardNegInf CFloat
-> Rounded 'TowardInf CFloat
-> Rounded 'TowardNegInf CFloat
-> Rounded 'TowardInf CFloat
-> (Rounded 'TowardNegInf CFloat, Rounded 'TowardInf CFloat)
intervalDiv Rounded 'TowardNegInf CFloat
x Rounded 'TowardInf CFloat
x' Rounded 'TowardNegInf CFloat
y Rounded 'TowardInf CFloat
y' = (coerce :: forall a b. Coercible a b => a -> b
coerce Float -> Float -> Float -> Float -> Float
F.intervalDiv_down Rounded 'TowardNegInf CFloat
x Rounded 'TowardInf CFloat
x' Rounded 'TowardNegInf CFloat
y Rounded 'TowardInf CFloat
y', coerce :: forall a b. Coercible a b => a -> b
coerce Float -> Float -> Float -> Float -> Float
F.intervalDiv_up Rounded 'TowardNegInf CFloat
x Rounded 'TowardInf CFloat
x' Rounded 'TowardNegInf CFloat
y Rounded 'TowardInf CFloat
y')
  intervalDivAdd :: Rounded 'TowardNegInf CFloat
-> Rounded 'TowardInf CFloat
-> Rounded 'TowardNegInf CFloat
-> Rounded 'TowardInf CFloat
-> Rounded 'TowardNegInf CFloat
-> Rounded 'TowardInf CFloat
-> (Rounded 'TowardNegInf CFloat, Rounded 'TowardInf CFloat)
intervalDivAdd Rounded 'TowardNegInf CFloat
x Rounded 'TowardInf CFloat
x' Rounded 'TowardNegInf CFloat
y Rounded 'TowardInf CFloat
y' Rounded 'TowardNegInf CFloat
z Rounded 'TowardInf CFloat
z' = (coerce :: forall a b. Coercible a b => a -> b
coerce Float -> Float -> Float -> Float -> Float -> Float
F.intervalDivAdd_down Rounded 'TowardNegInf CFloat
x Rounded 'TowardInf CFloat
x' Rounded 'TowardNegInf CFloat
y Rounded 'TowardInf CFloat
y' Rounded 'TowardNegInf CFloat
z, coerce :: forall a b. Coercible a b => a -> b
coerce Float -> Float -> Float -> Float -> Float -> Float
F.intervalDivAdd_up Rounded 'TowardNegInf CFloat
x Rounded 'TowardInf CFloat
x' Rounded 'TowardNegInf CFloat
y Rounded 'TowardInf CFloat
y' Rounded 'TowardInf CFloat
z')
  roundedFromRational :: RoundingMode -> Rational -> CFloat
roundedFromRational RoundingMode
r Rational
x = Float -> CFloat
CFloat (forall a. RealFloat a => RoundingMode -> Rational -> a
roundedFromRational_default RoundingMode
r Rational
x)
  intervalFromRational :: Rational
-> (Rounded 'TowardNegInf CFloat, Rounded 'TowardInf CFloat)
intervalFromRational = (coerce :: forall a b. Coercible a b => a -> b
coerce forall a. a -> a -> a
`asTypeOf` (forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (Float -> CFloat
CFloat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (Float -> CFloat
CFloat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) forall b c a. (b -> c) -> (a -> b) -> a -> c
.)) forall a.
RealFloat a =>
Rational -> (Rounded 'TowardNegInf a, Rounded 'TowardInf a)
intervalFromRational_default
  roundedFromRealFloat :: forall b. RealFloat b => RoundingMode -> b -> CFloat
roundedFromRealFloat RoundingMode
r b
x = coerce :: forall a b. Coercible a b => a -> b
coerce (forall a. RealFloat a => RoundingMode -> a -> Float
roundedFloatFromRealFloat RoundingMode
r b
x)
  {-# INLINE roundedDiv #-}
  {-# INLINE intervalDiv #-}
  {-# INLINE roundedFromRational #-}
  {-# INLINE intervalFromRational #-}
  {-# INLINE roundedFromRealFloat #-}

instance RoundedSqrt CFloat where
  roundedSqrt :: RoundingMode -> CFloat -> CFloat
roundedSqrt = coerce :: forall a b. Coercible a b => a -> b
coerce RoundingMode -> Float -> Float
F.roundedSqrt
  {-# INLINE roundedSqrt #-}

instance RoundedRing_Vector VS.Vector CFloat where
  roundedSum :: RoundingMode -> Vector CFloat -> CFloat
roundedSum RoundingMode
mode Vector CFloat
vec = Float -> CFloat
CFloat forall a b. (a -> b) -> a -> b
$ forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$
    forall a b. Storable a => Vector a -> (Ptr a -> IO b) -> IO b
VS.unsafeWith Vector CFloat
vec forall a b. (a -> b) -> a -> b
$ \Ptr CFloat
ptr -> RoundingMode -> Int -> Int -> Ptr Float -> IO Float
F.vectorSumPtr RoundingMode
mode (forall a. Storable a => Vector a -> Int
VS.length Vector CFloat
vec) Int
0 (forall a b. Ptr a -> Ptr b
castPtr Ptr CFloat
ptr)
  zipWith_roundedAdd :: RoundingMode -> Vector CFloat -> Vector CFloat -> Vector CFloat
zipWith_roundedAdd = forall a b c.
(Storable a, Storable b, Storable c) =>
(RoundingMode
 -> Int -> Int -> Ptr c -> Int -> Ptr a -> Int -> Ptr b -> IO ())
-> RoundingMode -> Vector a -> Vector b -> Vector c
zipWith_Storable (coerce :: forall a b. Coercible a b => a -> b
coerce RoundingMode
-> Int
-> Int
-> Ptr Float
-> Int
-> Ptr Float
-> Int
-> Ptr Float
-> IO ()
F.vectorAddPtr)
  zipWith_roundedSub :: RoundingMode -> Vector CFloat -> Vector CFloat -> Vector CFloat
zipWith_roundedSub = forall a b c.
(Storable a, Storable b, Storable c) =>
(RoundingMode
 -> Int -> Int -> Ptr c -> Int -> Ptr a -> Int -> Ptr b -> IO ())
-> RoundingMode -> Vector a -> Vector b -> Vector c
zipWith_Storable (coerce :: forall a b. Coercible a b => a -> b
coerce RoundingMode
-> Int
-> Int
-> Ptr Float
-> Int
-> Ptr Float
-> Int
-> Ptr Float
-> IO ()
F.vectorSubPtr)
  zipWith_roundedMul :: RoundingMode -> Vector CFloat -> Vector CFloat -> Vector CFloat
zipWith_roundedMul = forall a b c.
(Storable a, Storable b, Storable c) =>
(RoundingMode
 -> Int -> Int -> Ptr c -> Int -> Ptr a -> Int -> Ptr b -> IO ())
-> RoundingMode -> Vector a -> Vector b -> Vector c
zipWith_Storable (coerce :: forall a b. Coercible a b => a -> b
coerce RoundingMode
-> Int
-> Int
-> Ptr Float
-> Int
-> Ptr Float
-> Int
-> Ptr Float
-> IO ()
F.vectorMulPtr)
  zipWith3_roundedFusedMultiplyAdd :: RoundingMode
-> Vector CFloat -> Vector CFloat -> Vector CFloat -> Vector CFloat
zipWith3_roundedFusedMultiplyAdd = forall a b c d.
(Storable a, Storable b, Storable c, Storable d) =>
(RoundingMode
 -> Int
 -> Int
 -> Ptr d
 -> Int
 -> Ptr a
 -> Int
 -> Ptr b
 -> Int
 -> Ptr c
 -> IO ())
-> RoundingMode -> Vector a -> Vector b -> Vector c -> Vector d
zipWith3_Storable (coerce :: forall a b. Coercible a b => a -> b
coerce RoundingMode
-> Int
-> Int
-> Ptr Float
-> Int
-> Ptr Float
-> Int
-> Ptr Float
-> Int
-> Ptr Float
-> IO ()
F.vectorFMAPtr)

instance RoundedFractional_Vector VS.Vector CFloat where
  zipWith_roundedDiv :: RoundingMode -> Vector CFloat -> Vector CFloat -> Vector CFloat
zipWith_roundedDiv = forall a b c.
(Storable a, Storable b, Storable c) =>
(RoundingMode
 -> Int -> Int -> Ptr c -> Int -> Ptr a -> Int -> Ptr b -> IO ())
-> RoundingMode -> Vector a -> Vector b -> Vector c
zipWith_Storable (coerce :: forall a b. Coercible a b => a -> b
coerce RoundingMode
-> Int
-> Int
-> Ptr Float
-> Int
-> Ptr Float
-> Int
-> Ptr Float
-> IO ()
F.vectorDivPtr)

instance RoundedSqrt_Vector VS.Vector CFloat where
  map_roundedSqrt :: RoundingMode -> Vector CFloat -> Vector CFloat
map_roundedSqrt = forall a b.
(Storable a, Storable b) =>
(RoundingMode -> Int -> Int -> Ptr b -> Int -> Ptr a -> IO ())
-> RoundingMode -> Vector a -> Vector b
map_Storable (coerce :: forall a b. Coercible a b => a -> b
coerce RoundingMode
-> Int -> Int -> Ptr Float -> Int -> Ptr Float -> IO ()
F.vectorSqrtPtr)

instance RoundedRing_Vector VU.Vector CFloat where
  roundedSum :: RoundingMode -> Vector CFloat -> CFloat
roundedSum RoundingMode
mode (V_CFloat (VU.V_Float (VP.Vector Int
off Int
len (ByteArray ByteArray#
arr)))) =
    Float -> CFloat
CFloat forall a b. (a -> b) -> a -> b
$ RoundingMode -> Int -> Int -> ByteArray# -> Float
F.vectorSumByteArray RoundingMode
mode Int
len Int
off ByteArray#
arr
  zipWith_roundedAdd :: RoundingMode -> Vector CFloat -> Vector CFloat -> Vector CFloat
zipWith_roundedAdd = coerce :: forall a b. Coercible a b => a -> b
coerce (forall a b c.
(Prim a, Prim b, Prim c) =>
(RoundingMode
 -> Int
 -> Int
 -> MutableByteArray# RealWorld
 -> Int
 -> ByteArray#
 -> Int
 -> ByteArray#
 -> IO ())
-> RoundingMode -> Vector a -> Vector b -> Vector c
zipWith_Primitive RoundingMode
-> Int
-> Int
-> MutableByteArray# RealWorld
-> Int
-> ByteArray#
-> Int
-> ByteArray#
-> IO ()
F.vectorAddByteArray :: RoundingMode -> VP.Vector Float -> VP.Vector Float -> VP.Vector Float)
  zipWith_roundedSub :: RoundingMode -> Vector CFloat -> Vector CFloat -> Vector CFloat
zipWith_roundedSub = coerce :: forall a b. Coercible a b => a -> b
coerce (forall a b c.
(Prim a, Prim b, Prim c) =>
(RoundingMode
 -> Int
 -> Int
 -> MutableByteArray# RealWorld
 -> Int
 -> ByteArray#
 -> Int
 -> ByteArray#
 -> IO ())
-> RoundingMode -> Vector a -> Vector b -> Vector c
zipWith_Primitive RoundingMode
-> Int
-> Int
-> MutableByteArray# RealWorld
-> Int
-> ByteArray#
-> Int
-> ByteArray#
-> IO ()
F.vectorSubByteArray :: RoundingMode -> VP.Vector Float -> VP.Vector Float -> VP.Vector Float)
  zipWith_roundedMul :: RoundingMode -> Vector CFloat -> Vector CFloat -> Vector CFloat
zipWith_roundedMul = coerce :: forall a b. Coercible a b => a -> b
coerce (forall a b c.
(Prim a, Prim b, Prim c) =>
(RoundingMode
 -> Int
 -> Int
 -> MutableByteArray# RealWorld
 -> Int
 -> ByteArray#
 -> Int
 -> ByteArray#
 -> IO ())
-> RoundingMode -> Vector a -> Vector b -> Vector c
zipWith_Primitive RoundingMode
-> Int
-> Int
-> MutableByteArray# RealWorld
-> Int
-> ByteArray#
-> Int
-> ByteArray#
-> IO ()
F.vectorMulByteArray :: RoundingMode -> VP.Vector Float -> VP.Vector Float -> VP.Vector Float)
  zipWith3_roundedFusedMultiplyAdd :: RoundingMode
-> Vector CFloat -> Vector CFloat -> Vector CFloat -> Vector CFloat
zipWith3_roundedFusedMultiplyAdd = coerce :: forall a b. Coercible a b => a -> b
coerce (forall a b c d.
(Prim a, Prim b, Prim c, Prim d) =>
(RoundingMode
 -> Int
 -> Int
 -> MutableByteArray# RealWorld
 -> Int
 -> ByteArray#
 -> Int
 -> ByteArray#
 -> Int
 -> ByteArray#
 -> IO ())
-> RoundingMode -> Vector a -> Vector b -> Vector c -> Vector d
zipWith3_Primitive RoundingMode
-> Int
-> Int
-> MutableByteArray# RealWorld
-> Int
-> ByteArray#
-> Int
-> ByteArray#
-> Int
-> ByteArray#
-> IO ()
F.vectorFMAByteArray :: RoundingMode -> VP.Vector Float -> VP.Vector Float -> VP.Vector Float -> VP.Vector Float)

instance RoundedFractional_Vector VU.Vector CFloat where
  zipWith_roundedDiv :: RoundingMode -> Vector CFloat -> Vector CFloat -> Vector CFloat
zipWith_roundedDiv = coerce :: forall a b. Coercible a b => a -> b
coerce (forall a b c.
(Prim a, Prim b, Prim c) =>
(RoundingMode
 -> Int
 -> Int
 -> MutableByteArray# RealWorld
 -> Int
 -> ByteArray#
 -> Int
 -> ByteArray#
 -> IO ())
-> RoundingMode -> Vector a -> Vector b -> Vector c
zipWith_Primitive RoundingMode
-> Int
-> Int
-> MutableByteArray# RealWorld
-> Int
-> ByteArray#
-> Int
-> ByteArray#
-> IO ()
F.vectorDivByteArray :: RoundingMode -> VP.Vector Float -> VP.Vector Float -> VP.Vector Float)

instance RoundedSqrt_Vector VU.Vector CFloat where
  map_roundedSqrt :: RoundingMode -> Vector CFloat -> Vector CFloat
map_roundedSqrt = coerce :: forall a b. Coercible a b => a -> b
coerce (forall a b.
(Prim a, Prim b) =>
(RoundingMode
 -> Int
 -> Int
 -> MutableByteArray# RealWorld
 -> Int
 -> ByteArray#
 -> IO ())
-> RoundingMode -> Vector a -> Vector b
map_Primitive RoundingMode
-> Int
-> Int
-> MutableByteArray# RealWorld
-> Int
-> ByteArray#
-> IO ()
F.vectorSqrtByteArray :: RoundingMode -> VP.Vector Float -> VP.Vector Float)

--
-- Double
--

-- | A wrapper providing particular instances for 'RoundedRing', 'RoundedFractional' and 'RoundedSqrt'.
--
-- This type is different from @CDouble@ from "Foreign.C.Types".
newtype CDouble = CDouble Double
  deriving (CDouble -> CDouble -> Bool
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
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
Ord,Int -> CDouble -> ShowS
[CDouble] -> ShowS
CDouble -> String
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. 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
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 CDouble -> IO CDouble
Ptr CDouble -> Int -> IO CDouble
Ptr CDouble -> Int -> CDouble -> IO ()
Ptr CDouble -> CDouble -> IO ()
CDouble -> Int
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 :: forall b. Ptr b -> Int -> CDouble -> IO ()
$cpokeByteOff :: forall b. Ptr b -> Int -> CDouble -> IO ()
peekByteOff :: forall b. 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

roundedDoubleFromInt64 :: RoundingMode -> Int64 -> Double
roundedDoubleFromInt64 :: RoundingMode -> Int64 -> Double
roundedDoubleFromInt64 RoundingMode
r Int64
x = forall a. Bool -> a -> a -> a
staticIf
  (-Int64
0x20000000000000 forall a. Ord a => a -> a -> Bool
<= Int64
x Bool -> Bool -> Bool
&& Int64
x forall a. Ord a => a -> a -> Bool
<= Int64
0x20000000000000 {- abs x <= 2^53 -}) -- if input is known to be small enough
  (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
x)
  (RoundingMode -> Int64 -> Double
D.roundedFromInt64 RoundingMode
r Int64
x)
{-# INLINE roundedDoubleFromInt64 #-}

roundedDoubleFromWord64 :: RoundingMode -> Word64 -> Double
roundedDoubleFromWord64 :: RoundingMode -> Word64 -> Double
roundedDoubleFromWord64 RoundingMode
r Word64
x = forall a. Bool -> a -> a -> a
staticIf
  (Word64
x forall a. Ord a => a -> a -> Bool
<= Word64
0x20000000000000 {- x <= 2^53 -}) -- if input is known to be small enough
  (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
x)
  (RoundingMode -> Word64 -> Double
D.roundedFromWord64 RoundingMode
r Word64
x)
{-# INLINE roundedDoubleFromWord64 #-}

roundedDoubleFromRealFloat :: RealFloat a => RoundingMode -> a -> Double
roundedDoubleFromRealFloat :: forall a. RealFloat a => RoundingMode -> a -> Double
roundedDoubleFromRealFloat RoundingMode
r a
x | forall a. RealFloat a => a -> Bool
isNaN a
x = Double
0forall a. Fractional a => a -> a -> a
/Double
0
                               | forall a. RealFloat a => a -> Bool
isInfinite a
x = if a
x forall a. Ord a => a -> a -> Bool
> a
0 then Double
1forall a. Fractional a => a -> a -> a
/Double
0 else -Double
1forall a. Fractional a => a -> a -> a
/Double
0
                               | forall a. RealFloat a => a -> Bool
isNegativeZero a
x = -Double
0
                               | Bool
otherwise = coerce :: forall a b. Coercible a b => a -> b
coerce (forall a. RoundedFractional a => RoundingMode -> Rational -> a
roundedFromRational RoundingMode
r (forall a. Real a => a -> Rational
toRational a
x) :: CDouble)
{-# NOINLINE [1] roundedDoubleFromRealFloat #-}
{-# RULES
"roundedDoubleFromRealFloat/Double" forall r (x :: Double).
  roundedDoubleFromRealFloat r x = x
"roundedDoubleFromRealFloat/Float" forall r (x :: Float).
  roundedDoubleFromRealFloat r x = realToFrac x -- should be rewritten into float2Double
  #-}

instance RoundedRing CDouble where
  roundedAdd :: RoundingMode -> CDouble -> CDouble -> CDouble
roundedAdd = coerce :: forall a b. Coercible a b => a -> b
coerce RoundingMode -> Double -> Double -> Double
D.roundedAdd
  roundedSub :: RoundingMode -> CDouble -> CDouble -> CDouble
roundedSub = coerce :: forall a b. Coercible a b => a -> b
coerce RoundingMode -> Double -> Double -> Double
D.roundedSub
  roundedMul :: RoundingMode -> CDouble -> CDouble -> CDouble
roundedMul = coerce :: forall a b. Coercible a b => a -> b
coerce RoundingMode -> Double -> Double -> Double
D.roundedMul
  roundedFusedMultiplyAdd :: RoundingMode -> CDouble -> CDouble -> CDouble -> CDouble
roundedFusedMultiplyAdd = coerce :: forall a b. Coercible a b => a -> b
coerce RoundingMode -> Double -> Double -> Double -> Double
D.roundedFMA
  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' = (coerce :: 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', coerce :: 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' = (coerce :: 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, coerce :: 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
r Integer
x = Double -> CDouble
CDouble (forall a. RealFloat a => RoundingMode -> Integer -> a
roundedFromInteger_default RoundingMode
r Integer
x)
  intervalFromInteger :: Integer
-> (Rounded 'TowardNegInf CDouble, Rounded 'TowardInf CDouble)
intervalFromInteger = (coerce :: forall a b. Coercible a b => a -> b
coerce forall a. a -> a -> a
`asTypeOf` (forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (Double -> CDouble
CDouble forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (Double -> CDouble
CDouble forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) forall b c a. (b -> c) -> (a -> b) -> a -> c
.)) forall a.
RealFloat a =>
Integer -> (Rounded 'TowardNegInf a, Rounded 'TowardInf a)
intervalFromInteger_default
  backendNameT :: Tagged CDouble String
backendNameT = forall {k} (s :: k) b. b -> Tagged s b
Tagged String
cBackendName
  {-# INLINE roundedAdd #-}
  {-# INLINE roundedSub #-}
  {-# INLINE roundedMul #-}
  {-# INLINE roundedFusedMultiplyAdd #-}
  {-# INLINE intervalMul #-}
  {-# INLINE roundedFromInteger #-}
  {-# INLINE intervalFromInteger #-}

instance RoundedFractional CDouble where
  roundedDiv :: RoundingMode -> CDouble -> CDouble -> CDouble
roundedDiv = coerce :: 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' = (coerce :: 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', coerce :: 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' = (coerce :: 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, coerce :: 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')
  roundedFromRational :: RoundingMode -> Rational -> CDouble
roundedFromRational RoundingMode
r Rational
x = Double -> CDouble
CDouble (forall a. RealFloat a => RoundingMode -> Rational -> a
roundedFromRational_default RoundingMode
r Rational
x)
  intervalFromRational :: Rational
-> (Rounded 'TowardNegInf CDouble, Rounded 'TowardInf CDouble)
intervalFromRational = (coerce :: forall a b. Coercible a b => a -> b
coerce forall a. a -> a -> a
`asTypeOf` (forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (Double -> CDouble
CDouble forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (Double -> CDouble
CDouble forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) forall b c a. (b -> c) -> (a -> b) -> a -> c
.)) forall a.
RealFloat a =>
Rational -> (Rounded 'TowardNegInf a, Rounded 'TowardInf a)
intervalFromRational_default
  -- TODO: Specialize small case in ***FromRational?
  roundedFromRealFloat :: forall b. RealFloat b => RoundingMode -> b -> CDouble
roundedFromRealFloat RoundingMode
r b
x = coerce :: forall a b. Coercible a b => a -> b
coerce (forall a. RealFloat a => RoundingMode -> a -> Double
roundedDoubleFromRealFloat RoundingMode
r b
x)
  {-# INLINE roundedDiv #-}
  {-# INLINE intervalDiv #-}
  {-# INLINE roundedFromRational #-}
  {-# INLINE intervalFromRational #-}
  {-# INLINE roundedFromRealFloat #-}

instance RoundedSqrt CDouble where
  roundedSqrt :: RoundingMode -> CDouble -> CDouble
roundedSqrt = coerce :: 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 = Double -> CDouble
CDouble forall a b. (a -> b) -> a -> b
$ forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$
    forall a b. Storable a => Vector a -> (Ptr a -> IO b) -> IO b
VS.unsafeWith Vector CDouble
vec forall a b. (a -> b) -> a -> b
$ \Ptr CDouble
ptr -> RoundingMode -> Int -> Int -> Ptr Double -> IO Double
D.vectorSumPtr RoundingMode
mode (forall a. Storable a => Vector a -> Int
VS.length Vector CDouble
vec) Int
0 (forall a b. Ptr a -> Ptr b
castPtr Ptr CDouble
ptr)
  zipWith_roundedAdd :: RoundingMode -> Vector CDouble -> Vector CDouble -> Vector CDouble
zipWith_roundedAdd = forall a b c.
(Storable a, Storable b, Storable c) =>
(RoundingMode
 -> Int -> Int -> Ptr c -> Int -> Ptr a -> Int -> Ptr b -> IO ())
-> RoundingMode -> Vector a -> Vector b -> Vector c
zipWith_Storable (coerce :: forall a b. Coercible a b => a -> b
coerce RoundingMode
-> Int
-> Int
-> Ptr Double
-> Int
-> Ptr Double
-> Int
-> Ptr Double
-> IO ()
D.vectorAddPtr)
  zipWith_roundedSub :: RoundingMode -> Vector CDouble -> Vector CDouble -> Vector CDouble
zipWith_roundedSub = forall a b c.
(Storable a, Storable b, Storable c) =>
(RoundingMode
 -> Int -> Int -> Ptr c -> Int -> Ptr a -> Int -> Ptr b -> IO ())
-> RoundingMode -> Vector a -> Vector b -> Vector c
zipWith_Storable (coerce :: forall a b. Coercible a b => a -> b
coerce RoundingMode
-> Int
-> Int
-> Ptr Double
-> Int
-> Ptr Double
-> Int
-> Ptr Double
-> IO ()
D.vectorSubPtr)
  zipWith_roundedMul :: RoundingMode -> Vector CDouble -> Vector CDouble -> Vector CDouble
zipWith_roundedMul = forall a b c.
(Storable a, Storable b, Storable c) =>
(RoundingMode
 -> Int -> Int -> Ptr c -> Int -> Ptr a -> Int -> Ptr b -> IO ())
-> RoundingMode -> Vector a -> Vector b -> Vector c
zipWith_Storable (coerce :: forall a b. Coercible a b => a -> b
coerce RoundingMode
-> Int
-> Int
-> Ptr Double
-> Int
-> Ptr Double
-> Int
-> Ptr Double
-> IO ()
D.vectorMulPtr)
  zipWith3_roundedFusedMultiplyAdd :: RoundingMode
-> Vector CDouble
-> Vector CDouble
-> Vector CDouble
-> Vector CDouble
zipWith3_roundedFusedMultiplyAdd = forall a b c d.
(Storable a, Storable b, Storable c, Storable d) =>
(RoundingMode
 -> Int
 -> Int
 -> Ptr d
 -> Int
 -> Ptr a
 -> Int
 -> Ptr b
 -> Int
 -> Ptr c
 -> IO ())
-> RoundingMode -> Vector a -> Vector b -> Vector c -> Vector d
zipWith3_Storable (coerce :: forall a b. Coercible a b => a -> b
coerce RoundingMode
-> Int
-> Int
-> Ptr Double
-> Int
-> Ptr Double
-> Int
-> Ptr Double
-> Int
-> Ptr Double
-> IO ()
D.vectorFMAPtr)

instance RoundedFractional_Vector VS.Vector CDouble where
  zipWith_roundedDiv :: RoundingMode -> Vector CDouble -> Vector CDouble -> Vector CDouble
zipWith_roundedDiv = forall a b c.
(Storable a, Storable b, Storable c) =>
(RoundingMode
 -> Int -> Int -> Ptr c -> Int -> Ptr a -> Int -> Ptr b -> IO ())
-> RoundingMode -> Vector a -> Vector b -> Vector c
zipWith_Storable (coerce :: forall a b. Coercible a b => a -> b
coerce RoundingMode
-> Int
-> Int
-> Ptr Double
-> Int
-> Ptr Double
-> Int
-> Ptr Double
-> IO ()
D.vectorDivPtr)

instance RoundedSqrt_Vector VS.Vector CDouble where
  map_roundedSqrt :: RoundingMode -> Vector CDouble -> Vector CDouble
map_roundedSqrt = forall a b.
(Storable a, Storable b) =>
(RoundingMode -> Int -> Int -> Ptr b -> Int -> Ptr a -> IO ())
-> RoundingMode -> Vector a -> Vector b
map_Storable (coerce :: forall a b. Coercible a b => a -> b
coerce RoundingMode
-> Int -> Int -> Ptr Double -> Int -> Ptr Double -> IO ()
D.vectorSqrtPtr)

instance RoundedRing_Vector VU.Vector CDouble where
  roundedSum :: RoundingMode -> Vector CDouble -> CDouble
roundedSum RoundingMode
mode (V_CDouble (VU.V_Double (VP.Vector Int
off Int
len (ByteArray ByteArray#
arr)))) =
    Double -> CDouble
CDouble forall a b. (a -> b) -> a -> b
$ RoundingMode -> Int -> Int -> ByteArray# -> Double
D.vectorSumByteArray RoundingMode
mode Int
len Int
off ByteArray#
arr
  zipWith_roundedAdd :: RoundingMode -> Vector CDouble -> Vector CDouble -> Vector CDouble
zipWith_roundedAdd = coerce :: forall a b. Coercible a b => a -> b
coerce (forall a b c.
(Prim a, Prim b, Prim c) =>
(RoundingMode
 -> Int
 -> Int
 -> MutableByteArray# RealWorld
 -> Int
 -> ByteArray#
 -> Int
 -> ByteArray#
 -> IO ())
-> RoundingMode -> Vector a -> Vector b -> Vector c
zipWith_Primitive RoundingMode
-> Int
-> Int
-> MutableByteArray# RealWorld
-> Int
-> ByteArray#
-> Int
-> ByteArray#
-> IO ()
D.vectorAddByteArray :: RoundingMode -> VP.Vector Double -> VP.Vector Double -> VP.Vector Double)
  zipWith_roundedSub :: RoundingMode -> Vector CDouble -> Vector CDouble -> Vector CDouble
zipWith_roundedSub = coerce :: forall a b. Coercible a b => a -> b
coerce (forall a b c.
(Prim a, Prim b, Prim c) =>
(RoundingMode
 -> Int
 -> Int
 -> MutableByteArray# RealWorld
 -> Int
 -> ByteArray#
 -> Int
 -> ByteArray#
 -> IO ())
-> RoundingMode -> Vector a -> Vector b -> Vector c
zipWith_Primitive RoundingMode
-> Int
-> Int
-> MutableByteArray# RealWorld
-> Int
-> ByteArray#
-> Int
-> ByteArray#
-> IO ()
D.vectorSubByteArray :: RoundingMode -> VP.Vector Double -> VP.Vector Double -> VP.Vector Double)
  zipWith_roundedMul :: RoundingMode -> Vector CDouble -> Vector CDouble -> Vector CDouble
zipWith_roundedMul = coerce :: forall a b. Coercible a b => a -> b
coerce (forall a b c.
(Prim a, Prim b, Prim c) =>
(RoundingMode
 -> Int
 -> Int
 -> MutableByteArray# RealWorld
 -> Int
 -> ByteArray#
 -> Int
 -> ByteArray#
 -> IO ())
-> RoundingMode -> Vector a -> Vector b -> Vector c
zipWith_Primitive RoundingMode
-> Int
-> Int
-> MutableByteArray# RealWorld
-> Int
-> ByteArray#
-> Int
-> ByteArray#
-> IO ()
D.vectorMulByteArray :: RoundingMode -> VP.Vector Double -> VP.Vector Double -> VP.Vector Double)
  zipWith3_roundedFusedMultiplyAdd :: RoundingMode
-> Vector CDouble
-> Vector CDouble
-> Vector CDouble
-> Vector CDouble
zipWith3_roundedFusedMultiplyAdd = coerce :: forall a b. Coercible a b => a -> b
coerce (forall a b c d.
(Prim a, Prim b, Prim c, Prim d) =>
(RoundingMode
 -> Int
 -> Int
 -> MutableByteArray# RealWorld
 -> Int
 -> ByteArray#
 -> Int
 -> ByteArray#
 -> Int
 -> ByteArray#
 -> IO ())
-> RoundingMode -> Vector a -> Vector b -> Vector c -> Vector d
zipWith3_Primitive RoundingMode
-> Int
-> Int
-> MutableByteArray# RealWorld
-> Int
-> ByteArray#
-> Int
-> ByteArray#
-> Int
-> ByteArray#
-> IO ()
D.vectorFMAByteArray :: RoundingMode -> VP.Vector Double -> VP.Vector Double -> VP.Vector Double -> VP.Vector Double)

instance RoundedFractional_Vector VU.Vector CDouble where
  zipWith_roundedDiv :: RoundingMode -> Vector CDouble -> Vector CDouble -> Vector CDouble
zipWith_roundedDiv = coerce :: forall a b. Coercible a b => a -> b
coerce (forall a b c.
(Prim a, Prim b, Prim c) =>
(RoundingMode
 -> Int
 -> Int
 -> MutableByteArray# RealWorld
 -> Int
 -> ByteArray#
 -> Int
 -> ByteArray#
 -> IO ())
-> RoundingMode -> Vector a -> Vector b -> Vector c
zipWith_Primitive RoundingMode
-> Int
-> Int
-> MutableByteArray# RealWorld
-> Int
-> ByteArray#
-> Int
-> ByteArray#
-> IO ()
D.vectorDivByteArray :: RoundingMode -> VP.Vector Double -> VP.Vector Double -> VP.Vector Double)

instance RoundedSqrt_Vector VU.Vector CDouble where
  map_roundedSqrt :: RoundingMode -> Vector CDouble -> Vector CDouble
map_roundedSqrt = coerce :: forall a b. Coercible a b => a -> b
coerce (forall a b.
(Prim a, Prim b) =>
(RoundingMode
 -> Int
 -> Int
 -> MutableByteArray# RealWorld
 -> Int
 -> ByteArray#
 -> IO ())
-> RoundingMode -> Vector a -> Vector b
map_Primitive RoundingMode
-> Int
-> Int
-> MutableByteArray# RealWorld
-> Int
-> ByteArray#
-> IO ()
D.vectorSqrtByteArray :: RoundingMode -> VP.Vector Double -> VP.Vector Double)

--
-- Backend name
--

foreign import ccall unsafe "rounded_hw_backend_name"
  c_backend_name :: CString

cBackendName :: String
cBackendName :: String
cBackendName = forall a. IO a -> a
unsafePerformIO (CString -> IO String
peekCString CString
c_backend_name)

--
-- Utility function for constant folding
--

staticIf :: Bool -> a -> a -> a
staticIf :: forall a. Bool -> a -> a -> a
staticIf Bool
_ a
_ a
x = a
x
{-# INLINE [0] staticIf #-}

{-# RULES
"staticIf/True" forall x y. staticIf True x y = x
"staticIf/False" forall x y. staticIf False x y = y
  #-}

--
-- Utility functions for vector operations
--

map_Storable :: (Storable a, Storable b) => (RoundingMode -> Int -> Int -> Ptr b -> Int -> Ptr a -> IO ()) -> RoundingMode -> VS.Vector a -> VS.Vector b
map_Storable :: forall a b.
(Storable a, Storable b) =>
(RoundingMode -> Int -> Int -> Ptr b -> Int -> Ptr a -> IO ())
-> RoundingMode -> Vector a -> Vector b
map_Storable RoundingMode -> Int -> Int -> Ptr b -> Int -> Ptr a -> IO ()
f RoundingMode
mode Vector a
vec = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ do
  let !len :: Int
len = forall a. Storable a => Vector a -> Int
VS.length Vector a
vec
  IOVector b
result <- forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
Int -> m (MVector (PrimState m) a)
VSM.new Int
len
  forall a b. Storable a => Vector a -> (Ptr a -> IO b) -> IO b
VS.unsafeWith Vector a
vec forall a b. (a -> b) -> a -> b
$ \Ptr a
ptr ->
    forall a b. Storable a => IOVector a -> (Ptr a -> IO b) -> IO b
VSM.unsafeWith IOVector b
result forall a b. (a -> b) -> a -> b
$ \Ptr b
resultPtr ->
      RoundingMode -> Int -> Int -> Ptr b -> Int -> Ptr a -> IO ()
f RoundingMode
mode Int
len Int
0 Ptr b
resultPtr Int
0 Ptr a
ptr
  forall a (m :: * -> *).
(Storable a, PrimMonad m) =>
MVector (PrimState m) a -> m (Vector a)
VS.unsafeFreeze IOVector b
result
{-# INLINE map_Storable #-}

zipWith_Storable :: (Storable a, Storable b, Storable c) => (RoundingMode -> Int -> Int -> Ptr c -> Int -> Ptr a -> Int -> Ptr b -> IO ()) -> RoundingMode -> VS.Vector a -> VS.Vector b -> VS.Vector c
zipWith_Storable :: forall a b c.
(Storable a, Storable b, Storable c) =>
(RoundingMode
 -> Int -> Int -> Ptr c -> Int -> Ptr a -> Int -> Ptr b -> IO ())
-> RoundingMode -> Vector a -> Vector b -> Vector c
zipWith_Storable RoundingMode
-> Int -> Int -> Ptr c -> Int -> Ptr a -> Int -> Ptr b -> IO ()
f RoundingMode
mode Vector a
vec Vector b
vec' = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ do
  let !len :: Int
len = forall a. Ord a => a -> a -> a
min (forall a. Storable a => Vector a -> Int
VS.length Vector a
vec) (forall a. Storable a => Vector a -> Int
VS.length Vector b
vec')
  IOVector c
result <- forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
Int -> m (MVector (PrimState m) a)
VSM.new Int
len
  forall a b. Storable a => Vector a -> (Ptr a -> IO b) -> IO b
VS.unsafeWith Vector a
vec forall a b. (a -> b) -> a -> b
$ \Ptr a
ptr ->
    forall a b. Storable a => Vector a -> (Ptr a -> IO b) -> IO b
VS.unsafeWith Vector b
vec' forall a b. (a -> b) -> a -> b
$ \Ptr b
ptr' ->
      forall a b. Storable a => IOVector a -> (Ptr a -> IO b) -> IO b
VSM.unsafeWith IOVector c
result forall a b. (a -> b) -> a -> b
$ \Ptr c
resultPtr ->
        RoundingMode
-> Int -> Int -> Ptr c -> Int -> Ptr a -> Int -> Ptr b -> IO ()
f RoundingMode
mode Int
len Int
0 Ptr c
resultPtr Int
0 Ptr a
ptr Int
0 Ptr b
ptr'
  forall a (m :: * -> *).
(Storable a, PrimMonad m) =>
MVector (PrimState m) a -> m (Vector a)
VS.unsafeFreeze IOVector c
result
{-# INLINE zipWith_Storable #-}

zipWith3_Storable :: (Storable a, Storable b, Storable c, Storable d) => (RoundingMode -> Int -> Int -> Ptr d -> Int -> Ptr a -> Int -> Ptr b -> Int -> Ptr c -> IO ()) -> RoundingMode -> VS.Vector a -> VS.Vector b -> VS.Vector c -> VS.Vector d
zipWith3_Storable :: forall a b c d.
(Storable a, Storable b, Storable c, Storable d) =>
(RoundingMode
 -> Int
 -> Int
 -> Ptr d
 -> Int
 -> Ptr a
 -> Int
 -> Ptr b
 -> Int
 -> Ptr c
 -> IO ())
-> RoundingMode -> Vector a -> Vector b -> Vector c -> Vector d
zipWith3_Storable RoundingMode
-> Int
-> Int
-> Ptr d
-> Int
-> Ptr a
-> Int
-> Ptr b
-> Int
-> Ptr c
-> IO ()
f RoundingMode
mode Vector a
vec1 Vector b
vec2 Vector c
vec3 = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ do
  let !len :: Int
len = forall a. Ord a => a -> a -> a
min (forall a. Storable a => Vector a -> Int
VS.length Vector a
vec1) (forall a. Ord a => a -> a -> a
min (forall a. Storable a => Vector a -> Int
VS.length Vector b
vec2) (forall a. Storable a => Vector a -> Int
VS.length Vector c
vec3))
  IOVector d
result <- forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
Int -> m (MVector (PrimState m) a)
VSM.new Int
len
  forall a b. Storable a => Vector a -> (Ptr a -> IO b) -> IO b
VS.unsafeWith Vector a
vec1 forall a b. (a -> b) -> a -> b
$ \Ptr a
ptr1 ->
    forall a b. Storable a => Vector a -> (Ptr a -> IO b) -> IO b
VS.unsafeWith Vector b
vec2 forall a b. (a -> b) -> a -> b
$ \Ptr b
ptr2 ->
      forall a b. Storable a => Vector a -> (Ptr a -> IO b) -> IO b
VS.unsafeWith Vector c
vec3 forall a b. (a -> b) -> a -> b
$ \Ptr c
ptr3 ->
        forall a b. Storable a => IOVector a -> (Ptr a -> IO b) -> IO b
VSM.unsafeWith IOVector d
result forall a b. (a -> b) -> a -> b
$ \Ptr d
resultPtr ->
          RoundingMode
-> Int
-> Int
-> Ptr d
-> Int
-> Ptr a
-> Int
-> Ptr b
-> Int
-> Ptr c
-> IO ()
f RoundingMode
mode Int
len Int
0 Ptr d
resultPtr Int
0 Ptr a
ptr1 Int
0 Ptr b
ptr2 Int
0 Ptr c
ptr3
  forall a (m :: * -> *).
(Storable a, PrimMonad m) =>
MVector (PrimState m) a -> m (Vector a)
VS.unsafeFreeze IOVector d
result
{-# INLINE zipWith3_Storable #-}

map_Primitive :: (Prim a, Prim b) => (RoundingMode -> Int -> Int -> MutableByteArray# RealWorld -> Int -> ByteArray# -> IO ()) -> RoundingMode -> VP.Vector a -> VP.Vector b
map_Primitive :: forall a b.
(Prim a, Prim b) =>
(RoundingMode
 -> Int
 -> Int
 -> MutableByteArray# RealWorld
 -> Int
 -> ByteArray#
 -> IO ())
-> RoundingMode -> Vector a -> Vector b
map_Primitive RoundingMode
-> Int
-> Int
-> MutableByteArray# RealWorld
-> Int
-> ByteArray#
-> IO ()
f RoundingMode
mode (VP.Vector Int
offA Int
lenA (ByteArray ByteArray#
arrA)) = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ do
  result :: MVector RealWorld b
result@(VPM.MVector Int
offR Int
lenR (MutableByteArray MutableByteArray# RealWorld
arrR)) <- forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MVector (PrimState m) a)
VPM.unsafeNew Int
lenA
  RoundingMode
-> Int
-> Int
-> MutableByteArray# RealWorld
-> Int
-> ByteArray#
-> IO ()
f RoundingMode
mode Int
lenR Int
offR MutableByteArray# RealWorld
arrR Int
offA ByteArray#
arrA
  forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MVector (PrimState m) a -> m (Vector a)
VP.unsafeFreeze MVector RealWorld b
result
{-# INLINE map_Primitive #-}

zipWith_Primitive :: (Prim a, Prim b, Prim c) => (RoundingMode -> Int -> Int -> MutableByteArray# RealWorld -> Int -> ByteArray# -> Int -> ByteArray# -> IO ()) -> RoundingMode -> VP.Vector a -> VP.Vector b -> VP.Vector c
zipWith_Primitive :: forall a b c.
(Prim a, Prim b, Prim c) =>
(RoundingMode
 -> Int
 -> Int
 -> MutableByteArray# RealWorld
 -> Int
 -> ByteArray#
 -> Int
 -> ByteArray#
 -> IO ())
-> RoundingMode -> Vector a -> Vector b -> Vector c
zipWith_Primitive RoundingMode
-> Int
-> Int
-> MutableByteArray# RealWorld
-> Int
-> ByteArray#
-> Int
-> ByteArray#
-> IO ()
f RoundingMode
mode (VP.Vector Int
offA Int
lenA (ByteArray ByteArray#
arrA)) (VP.Vector Int
offB Int
lenB (ByteArray ByteArray#
arrB)) = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ do
  result :: MVector RealWorld c
result@(VPM.MVector Int
offR Int
lenR (MutableByteArray MutableByteArray# RealWorld
arrR)) <- forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MVector (PrimState m) a)
VPM.unsafeNew (forall a. Ord a => a -> a -> a
min Int
lenA Int
lenB)
  RoundingMode
-> Int
-> Int
-> MutableByteArray# RealWorld
-> Int
-> ByteArray#
-> Int
-> ByteArray#
-> IO ()
f RoundingMode
mode Int
lenR Int
offR MutableByteArray# RealWorld
arrR Int
offA ByteArray#
arrA Int
offB ByteArray#
arrB
  forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MVector (PrimState m) a -> m (Vector a)
VP.unsafeFreeze MVector RealWorld c
result
{-# INLINE zipWith_Primitive #-}

zipWith3_Primitive :: (Prim a, Prim b, Prim c, Prim d) => (RoundingMode -> Int -> Int -> MutableByteArray# RealWorld -> Int -> ByteArray# -> Int -> ByteArray# -> Int -> ByteArray# -> IO ()) -> RoundingMode -> VP.Vector a -> VP.Vector b -> VP.Vector c -> VP.Vector d
zipWith3_Primitive :: forall a b c d.
(Prim a, Prim b, Prim c, Prim d) =>
(RoundingMode
 -> Int
 -> Int
 -> MutableByteArray# RealWorld
 -> Int
 -> ByteArray#
 -> Int
 -> ByteArray#
 -> Int
 -> ByteArray#
 -> IO ())
-> RoundingMode -> Vector a -> Vector b -> Vector c -> Vector d
zipWith3_Primitive RoundingMode
-> Int
-> Int
-> MutableByteArray# RealWorld
-> Int
-> ByteArray#
-> Int
-> ByteArray#
-> Int
-> ByteArray#
-> IO ()
f RoundingMode
mode (VP.Vector Int
offA Int
lenA (ByteArray ByteArray#
arrA)) (VP.Vector Int
offB Int
lenB (ByteArray ByteArray#
arrB)) (VP.Vector Int
offC Int
lenC (ByteArray ByteArray#
arrC))= forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ do
  result :: MVector RealWorld d
result@(VPM.MVector Int
offR Int
lenR (MutableByteArray MutableByteArray# RealWorld
arrR)) <- forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MVector (PrimState m) a)
VPM.unsafeNew (forall a. Ord a => a -> a -> a
min Int
lenA (forall a. Ord a => a -> a -> a
min Int
lenB Int
lenC))
  RoundingMode
-> Int
-> Int
-> MutableByteArray# RealWorld
-> Int
-> ByteArray#
-> Int
-> ByteArray#
-> Int
-> ByteArray#
-> IO ()
f RoundingMode
mode Int
lenR Int
offR MutableByteArray# RealWorld
arrR Int
offA ByteArray#
arrA Int
offB ByteArray#
arrB Int
offC ByteArray#
arrC
  forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MVector (PrimState m) a -> m (Vector a)
VP.unsafeFreeze MVector RealWorld d
result
{-# INLINE zipWith3_Primitive #-}

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

newtype instance VUM.MVector s CFloat = MV_CFloat (VUM.MVector s Float)
newtype instance VU.Vector CFloat = V_CFloat (VU.Vector Float)

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

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

instance VU.Unbox CFloat

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) = 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) = forall s. MVector s Double -> MVector s CDouble
MV_CDouble (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') = 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 = forall s. MVector s Double -> MVector s CDouble
MV_CDouble forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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) = 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 = forall s. MVector s Double -> MVector s CDouble
MV_CDouble forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (v :: * -> * -> *) a s.
MVector v a =>
Int -> a -> ST s (v s a)
VGM.basicUnsafeReplicate Int
i (coerce :: 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 = coerce :: forall a b. Coercible a b => a -> b
coerce forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 = forall (v :: * -> * -> *) a s.
MVector v a =>
v s a -> Int -> a -> ST s ()
VGM.basicUnsafeWrite MVector s Double
mv Int
i (coerce :: 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) = 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 = forall (v :: * -> * -> *) a s. MVector v a => v s a -> a -> ST s ()
VGM.basicSet MVector s Double
mv (coerce :: 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') = 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') = 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 = forall s. MVector s Double -> MVector s CDouble
MV_CDouble forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (v :: * -> *) a s. Vector v a => Mutable v s a -> ST s (v a)
VG.basicUnsafeFreeze MVector s Double
mv
  basicUnsafeThaw :: forall s. Vector CDouble -> ST s (Mutable Vector s CDouble)
basicUnsafeThaw (V_CDouble Vector Double
v) = forall s. MVector s Double -> MVector s CDouble
MV_CDouble forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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) = 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 (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 = coerce :: forall a b. Coercible a b => a -> b
coerce forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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) = forall (v :: * -> *) a s.
Vector v a =>
Mutable v s a -> v a -> ST s ()
VG.basicUnsafeCopy 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 = forall (v :: * -> *) a b. Vector v a => v a -> a -> b -> b
VG.elemseq Vector Double
v (coerce :: forall a b. Coercible a b => a -> b
coerce CDouble
x) b
y

instance VU.Unbox CDouble