{-# LANGUAGE HexFloatLiterals #-}
{-# OPTIONS_GHC -Wno-orphans #-}
module Numeric.Rounded.Hardware.Backend.X87LongDouble
  (
  ) where
import           Data.Tagged
import           Foreign.C.String (CString, peekCString)
import           Foreign.Marshal (alloca, with)
import           Foreign.Ptr (Ptr)
import           Foreign.Storable (peek)
import           Numeric.LongDouble (LongDouble)
import           Numeric.Rounded.Hardware.Internal.Class
import           Numeric.Rounded.Hardware.Internal.Constants
import           Numeric.Rounded.Hardware.Internal.Conversion
import           System.IO.Unsafe

foreign import ccall unsafe "rounded_hw_add_longdouble"
  c_rounded_add_longdouble :: Int -> Ptr LongDouble -> Ptr LongDouble -> Ptr LongDouble -> IO ()
foreign import ccall unsafe "rounded_hw_sub_longdouble"
  c_rounded_sub_longdouble :: Int -> Ptr LongDouble -> Ptr LongDouble -> Ptr LongDouble -> IO ()
foreign import ccall unsafe "rounded_hw_mul_longdouble"
  c_rounded_mul_longdouble :: Int -> Ptr LongDouble -> Ptr LongDouble -> Ptr LongDouble -> IO ()
foreign import ccall unsafe "rounded_hw_div_longdouble"
  c_rounded_div_longdouble :: Int -> Ptr LongDouble -> Ptr LongDouble -> Ptr LongDouble -> IO ()
foreign import ccall unsafe "rounded_hw_sqrt_longdouble"
  c_rounded_sqrt_longdouble :: Int -> Ptr LongDouble -> Ptr LongDouble -> IO ()
foreign import ccall unsafe "rounded_hw_fma_longdouble"
  c_rounded_fma_longdouble :: Int -> Ptr LongDouble -> Ptr LongDouble -> Ptr LongDouble -> Ptr LongDouble -> IO ()

roundedAdd_ld :: RoundingMode -> LongDouble -> LongDouble -> LongDouble
roundedAdd_ld :: RoundingMode -> LongDouble -> LongDouble -> LongDouble
roundedAdd_ld RoundingMode
mode LongDouble
x LongDouble
y = IO LongDouble -> LongDouble
forall a. IO a -> a
unsafePerformIO (IO LongDouble -> LongDouble) -> IO LongDouble -> LongDouble
forall a b. (a -> b) -> a -> b
$
  LongDouble -> (Ptr LongDouble -> IO LongDouble) -> IO LongDouble
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with LongDouble
x ((Ptr LongDouble -> IO LongDouble) -> IO LongDouble)
-> (Ptr LongDouble -> IO LongDouble) -> IO LongDouble
forall a b. (a -> b) -> a -> b
$ \Ptr LongDouble
xPtr ->
  LongDouble -> (Ptr LongDouble -> IO LongDouble) -> IO LongDouble
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with LongDouble
y ((Ptr LongDouble -> IO LongDouble) -> IO LongDouble)
-> (Ptr LongDouble -> IO LongDouble) -> IO LongDouble
forall a b. (a -> b) -> a -> b
$ \Ptr LongDouble
yPtr ->
  (Ptr LongDouble -> IO LongDouble) -> IO LongDouble
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr LongDouble -> IO LongDouble) -> IO LongDouble)
-> (Ptr LongDouble -> IO LongDouble) -> IO LongDouble
forall a b. (a -> b) -> a -> b
$ \Ptr LongDouble
resultPtr -> do
  Int -> Ptr LongDouble -> Ptr LongDouble -> Ptr LongDouble -> IO ()
c_rounded_add_longdouble (RoundingMode -> Int
forall a. Enum a => a -> Int
fromEnum RoundingMode
mode) Ptr LongDouble
resultPtr Ptr LongDouble
xPtr Ptr LongDouble
yPtr
  Ptr LongDouble -> IO LongDouble
forall a. Storable a => Ptr a -> IO a
peek Ptr LongDouble
resultPtr

roundedSub_ld :: RoundingMode -> LongDouble -> LongDouble -> LongDouble
roundedSub_ld :: RoundingMode -> LongDouble -> LongDouble -> LongDouble
roundedSub_ld RoundingMode
mode LongDouble
x LongDouble
y = IO LongDouble -> LongDouble
forall a. IO a -> a
unsafePerformIO (IO LongDouble -> LongDouble) -> IO LongDouble -> LongDouble
forall a b. (a -> b) -> a -> b
$
  LongDouble -> (Ptr LongDouble -> IO LongDouble) -> IO LongDouble
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with LongDouble
x ((Ptr LongDouble -> IO LongDouble) -> IO LongDouble)
-> (Ptr LongDouble -> IO LongDouble) -> IO LongDouble
forall a b. (a -> b) -> a -> b
$ \Ptr LongDouble
xPtr ->
  LongDouble -> (Ptr LongDouble -> IO LongDouble) -> IO LongDouble
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with LongDouble
y ((Ptr LongDouble -> IO LongDouble) -> IO LongDouble)
-> (Ptr LongDouble -> IO LongDouble) -> IO LongDouble
forall a b. (a -> b) -> a -> b
$ \Ptr LongDouble
yPtr ->
  (Ptr LongDouble -> IO LongDouble) -> IO LongDouble
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr LongDouble -> IO LongDouble) -> IO LongDouble)
-> (Ptr LongDouble -> IO LongDouble) -> IO LongDouble
forall a b. (a -> b) -> a -> b
$ \Ptr LongDouble
resultPtr -> do
  Int -> Ptr LongDouble -> Ptr LongDouble -> Ptr LongDouble -> IO ()
c_rounded_sub_longdouble (RoundingMode -> Int
forall a. Enum a => a -> Int
fromEnum RoundingMode
mode) Ptr LongDouble
resultPtr Ptr LongDouble
xPtr Ptr LongDouble
yPtr
  Ptr LongDouble -> IO LongDouble
forall a. Storable a => Ptr a -> IO a
peek Ptr LongDouble
resultPtr

roundedMul_ld :: RoundingMode -> LongDouble -> LongDouble -> LongDouble
roundedMul_ld :: RoundingMode -> LongDouble -> LongDouble -> LongDouble
roundedMul_ld RoundingMode
mode LongDouble
x LongDouble
y = IO LongDouble -> LongDouble
forall a. IO a -> a
unsafePerformIO (IO LongDouble -> LongDouble) -> IO LongDouble -> LongDouble
forall a b. (a -> b) -> a -> b
$
  LongDouble -> (Ptr LongDouble -> IO LongDouble) -> IO LongDouble
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with LongDouble
x ((Ptr LongDouble -> IO LongDouble) -> IO LongDouble)
-> (Ptr LongDouble -> IO LongDouble) -> IO LongDouble
forall a b. (a -> b) -> a -> b
$ \Ptr LongDouble
xPtr ->
  LongDouble -> (Ptr LongDouble -> IO LongDouble) -> IO LongDouble
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with LongDouble
y ((Ptr LongDouble -> IO LongDouble) -> IO LongDouble)
-> (Ptr LongDouble -> IO LongDouble) -> IO LongDouble
forall a b. (a -> b) -> a -> b
$ \Ptr LongDouble
yPtr ->
  (Ptr LongDouble -> IO LongDouble) -> IO LongDouble
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr LongDouble -> IO LongDouble) -> IO LongDouble)
-> (Ptr LongDouble -> IO LongDouble) -> IO LongDouble
forall a b. (a -> b) -> a -> b
$ \Ptr LongDouble
resultPtr -> do
  Int -> Ptr LongDouble -> Ptr LongDouble -> Ptr LongDouble -> IO ()
c_rounded_mul_longdouble (RoundingMode -> Int
forall a. Enum a => a -> Int
fromEnum RoundingMode
mode) Ptr LongDouble
resultPtr Ptr LongDouble
xPtr Ptr LongDouble
yPtr
  Ptr LongDouble -> IO LongDouble
forall a. Storable a => Ptr a -> IO a
peek Ptr LongDouble
resultPtr

roundedDiv_ld :: RoundingMode -> LongDouble -> LongDouble -> LongDouble
roundedDiv_ld :: RoundingMode -> LongDouble -> LongDouble -> LongDouble
roundedDiv_ld RoundingMode
mode LongDouble
x LongDouble
y = IO LongDouble -> LongDouble
forall a. IO a -> a
unsafePerformIO (IO LongDouble -> LongDouble) -> IO LongDouble -> LongDouble
forall a b. (a -> b) -> a -> b
$
  LongDouble -> (Ptr LongDouble -> IO LongDouble) -> IO LongDouble
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with LongDouble
x ((Ptr LongDouble -> IO LongDouble) -> IO LongDouble)
-> (Ptr LongDouble -> IO LongDouble) -> IO LongDouble
forall a b. (a -> b) -> a -> b
$ \Ptr LongDouble
xPtr ->
  LongDouble -> (Ptr LongDouble -> IO LongDouble) -> IO LongDouble
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with LongDouble
y ((Ptr LongDouble -> IO LongDouble) -> IO LongDouble)
-> (Ptr LongDouble -> IO LongDouble) -> IO LongDouble
forall a b. (a -> b) -> a -> b
$ \Ptr LongDouble
yPtr ->
  (Ptr LongDouble -> IO LongDouble) -> IO LongDouble
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr LongDouble -> IO LongDouble) -> IO LongDouble)
-> (Ptr LongDouble -> IO LongDouble) -> IO LongDouble
forall a b. (a -> b) -> a -> b
$ \Ptr LongDouble
resultPtr -> do
  Int -> Ptr LongDouble -> Ptr LongDouble -> Ptr LongDouble -> IO ()
c_rounded_div_longdouble (RoundingMode -> Int
forall a. Enum a => a -> Int
fromEnum RoundingMode
mode) Ptr LongDouble
resultPtr Ptr LongDouble
xPtr Ptr LongDouble
yPtr
  Ptr LongDouble -> IO LongDouble
forall a. Storable a => Ptr a -> IO a
peek Ptr LongDouble
resultPtr

roundedSqrt_ld :: RoundingMode -> LongDouble -> LongDouble
roundedSqrt_ld :: RoundingMode -> LongDouble -> LongDouble
roundedSqrt_ld RoundingMode
mode LongDouble
x = IO LongDouble -> LongDouble
forall a. IO a -> a
unsafePerformIO (IO LongDouble -> LongDouble) -> IO LongDouble -> LongDouble
forall a b. (a -> b) -> a -> b
$
  LongDouble -> (Ptr LongDouble -> IO LongDouble) -> IO LongDouble
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with LongDouble
x ((Ptr LongDouble -> IO LongDouble) -> IO LongDouble)
-> (Ptr LongDouble -> IO LongDouble) -> IO LongDouble
forall a b. (a -> b) -> a -> b
$ \Ptr LongDouble
xPtr ->
  (Ptr LongDouble -> IO LongDouble) -> IO LongDouble
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr LongDouble -> IO LongDouble) -> IO LongDouble)
-> (Ptr LongDouble -> IO LongDouble) -> IO LongDouble
forall a b. (a -> b) -> a -> b
$ \Ptr LongDouble
resultPtr -> do
  Int -> Ptr LongDouble -> Ptr LongDouble -> IO ()
c_rounded_sqrt_longdouble (RoundingMode -> Int
forall a. Enum a => a -> Int
fromEnum RoundingMode
mode) Ptr LongDouble
resultPtr Ptr LongDouble
xPtr
  Ptr LongDouble -> IO LongDouble
forall a. Storable a => Ptr a -> IO a
peek Ptr LongDouble
resultPtr

roundedFMA_ld :: RoundingMode -> LongDouble -> LongDouble -> LongDouble -> LongDouble
roundedFMA_ld :: RoundingMode
-> LongDouble -> LongDouble -> LongDouble -> LongDouble
roundedFMA_ld RoundingMode
mode LongDouble
x LongDouble
y LongDouble
z = IO LongDouble -> LongDouble
forall a. IO a -> a
unsafePerformIO (IO LongDouble -> LongDouble) -> IO LongDouble -> LongDouble
forall a b. (a -> b) -> a -> b
$
  LongDouble -> (Ptr LongDouble -> IO LongDouble) -> IO LongDouble
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with LongDouble
x ((Ptr LongDouble -> IO LongDouble) -> IO LongDouble)
-> (Ptr LongDouble -> IO LongDouble) -> IO LongDouble
forall a b. (a -> b) -> a -> b
$ \Ptr LongDouble
xPtr ->
  LongDouble -> (Ptr LongDouble -> IO LongDouble) -> IO LongDouble
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with LongDouble
y ((Ptr LongDouble -> IO LongDouble) -> IO LongDouble)
-> (Ptr LongDouble -> IO LongDouble) -> IO LongDouble
forall a b. (a -> b) -> a -> b
$ \Ptr LongDouble
yPtr ->
  LongDouble -> (Ptr LongDouble -> IO LongDouble) -> IO LongDouble
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with LongDouble
z ((Ptr LongDouble -> IO LongDouble) -> IO LongDouble)
-> (Ptr LongDouble -> IO LongDouble) -> IO LongDouble
forall a b. (a -> b) -> a -> b
$ \Ptr LongDouble
zPtr ->
  (Ptr LongDouble -> IO LongDouble) -> IO LongDouble
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr LongDouble -> IO LongDouble) -> IO LongDouble)
-> (Ptr LongDouble -> IO LongDouble) -> IO LongDouble
forall a b. (a -> b) -> a -> b
$ \Ptr LongDouble
resultPtr -> do
  Int
-> Ptr LongDouble
-> Ptr LongDouble
-> Ptr LongDouble
-> Ptr LongDouble
-> IO ()
c_rounded_fma_longdouble (RoundingMode -> Int
forall a. Enum a => a -> Int
fromEnum RoundingMode
mode) Ptr LongDouble
resultPtr Ptr LongDouble
xPtr Ptr LongDouble
yPtr Ptr LongDouble
zPtr
  Ptr LongDouble -> IO LongDouble
forall a. Storable a => Ptr a -> IO a
peek Ptr LongDouble
resultPtr

instance RealFloatConstants LongDouble where
  positiveInfinity :: LongDouble
positiveInfinity = LongDouble
1LongDouble -> LongDouble -> LongDouble
forall a. Fractional a => a -> a -> a
/LongDouble
0
  negativeInfinity :: LongDouble
negativeInfinity = -LongDouble
1LongDouble -> LongDouble -> LongDouble
forall a. Fractional a => a -> a -> a
/LongDouble
0
  maxFinite :: LongDouble
maxFinite = LongDouble
0x1.fffffffffffffffep+16383
  minPositive :: LongDouble
minPositive = Integer -> Int -> LongDouble
forall a. RealFloat a => Integer -> Int -> a
encodeFloat Integer
1 (-Int
16445) -- The literal 0x1p-16445 yields 0 on long-double-0.1.1
  pi_down :: Rounded 'TowardNegInf LongDouble
pi_down = LongDouble -> Rounded 'TowardNegInf LongDouble
forall (r :: RoundingMode) a. a -> Rounded r a
Rounded LongDouble
0x1.921fb54442d18468p+1
  pi_up :: Rounded 'TowardInf LongDouble
pi_up   = LongDouble -> Rounded 'TowardInf LongDouble
forall (r :: RoundingMode) a. a -> Rounded r a
Rounded LongDouble
0x1.921fb54442d1846ap+1
  -- 3*pi
  three_pi_down :: Rounded 'TowardNegInf LongDouble
three_pi_down = LongDouble -> Rounded 'TowardNegInf LongDouble
forall (r :: RoundingMode) a. a -> Rounded r a
Rounded LongDouble
0x1.2d97c7f3321d234ep+3
  three_pi_up :: Rounded 'TowardInf LongDouble
three_pi_up   = LongDouble -> Rounded 'TowardInf LongDouble
forall (r :: RoundingMode) a. a -> Rounded r a
Rounded LongDouble
0x1.2d97c7f3321d2350p+3
  -- 5*pi
  five_pi_down :: Rounded 'TowardNegInf LongDouble
five_pi_down = LongDouble -> Rounded 'TowardNegInf LongDouble
forall (r :: RoundingMode) a. a -> Rounded r a
Rounded LongDouble
0x1.f6a7a2955385e582p+3
  five_pi_up :: Rounded 'TowardInf LongDouble
five_pi_up   = LongDouble -> Rounded 'TowardInf LongDouble
forall (r :: RoundingMode) a. a -> Rounded r a
Rounded LongDouble
0x1.f6a7a2955385e584p+3
  -- log(2)
  log2_down :: Rounded 'TowardNegInf LongDouble
log2_down = LongDouble -> Rounded 'TowardNegInf LongDouble
forall (r :: RoundingMode) a. a -> Rounded r a
Rounded LongDouble
0x1.62e42fefa39ef356p-1
  log2_up :: Rounded 'TowardInf LongDouble
log2_up   = LongDouble -> Rounded 'TowardInf LongDouble
forall (r :: RoundingMode) a. a -> Rounded r a
Rounded LongDouble
0x1.62e42fefa39ef358p-1
  -- exp(1)
  exp1_down :: Rounded 'TowardNegInf LongDouble
exp1_down = LongDouble -> Rounded 'TowardNegInf LongDouble
forall (r :: RoundingMode) a. a -> Rounded r a
Rounded LongDouble
0x1.5bf0a8b145769534p+1
  exp1_up :: Rounded 'TowardInf LongDouble
exp1_up   = LongDouble -> Rounded 'TowardInf LongDouble
forall (r :: RoundingMode) a. a -> Rounded r a
Rounded LongDouble
0x1.5bf0a8b145769536p+1
  -- exp(1/2)
  exp1_2_down :: Rounded 'TowardNegInf LongDouble
exp1_2_down = LongDouble -> Rounded 'TowardNegInf LongDouble
forall (r :: RoundingMode) a. a -> Rounded r a
Rounded LongDouble
0x1.a61298e1e069bc96p+0
  exp1_2_up :: Rounded 'TowardInf LongDouble
exp1_2_up   = LongDouble -> Rounded 'TowardInf LongDouble
forall (r :: RoundingMode) a. a -> Rounded r a
Rounded LongDouble
0x1.a61298e1e069bc98p+0
  -- exp(-1/2)
  expm1_2_down :: Rounded 'TowardNegInf LongDouble
expm1_2_down = LongDouble -> Rounded 'TowardNegInf LongDouble
forall (r :: RoundingMode) a. a -> Rounded r a
Rounded LongDouble
0x1.368b2fc6f9609fe6p-1
  expm1_2_up :: Rounded 'TowardInf LongDouble
expm1_2_up   = LongDouble -> Rounded 'TowardInf LongDouble
forall (r :: RoundingMode) a. a -> Rounded r a
Rounded LongDouble
0x1.368b2fc6f9609fe8p-1
  -- sqrt(2)
  sqrt2_down :: Rounded 'TowardNegInf LongDouble
sqrt2_down = LongDouble -> Rounded 'TowardNegInf LongDouble
forall (r :: RoundingMode) a. a -> Rounded r a
Rounded LongDouble
0x1.6a09e667f3bcc908p+0
  sqrt2_up :: Rounded 'TowardInf LongDouble
sqrt2_up   = LongDouble -> Rounded 'TowardInf LongDouble
forall (r :: RoundingMode) a. a -> Rounded r a
Rounded LongDouble
0x1.6a09e667f3bcc90ap+0
  -- sqrt(1/2)
  sqrt1_2_down :: Rounded 'TowardNegInf LongDouble
sqrt1_2_down = LongDouble -> Rounded 'TowardNegInf LongDouble
forall (r :: RoundingMode) a. a -> Rounded r a
Rounded LongDouble
0x1.6a09e667f3bcc908p-1
  sqrt1_2_up :: Rounded 'TowardInf LongDouble
sqrt1_2_up   = LongDouble -> Rounded 'TowardInf LongDouble
forall (r :: RoundingMode) a. a -> Rounded r a
Rounded LongDouble
0x1.6a09e667f3bcc90ap-1
  -- sqrt(2)-1
  sqrt2m1_down :: Rounded 'TowardNegInf LongDouble
sqrt2m1_down = LongDouble -> Rounded 'TowardNegInf LongDouble
forall (r :: RoundingMode) a. a -> Rounded r a
Rounded LongDouble
0x1.a827999fcef32422p-2
  sqrt2m1_up :: Rounded 'TowardInf LongDouble
sqrt2m1_up   = LongDouble -> Rounded 'TowardInf LongDouble
forall (r :: RoundingMode) a. a -> Rounded r a
Rounded LongDouble
0x1.a827999fcef32424p-2
  -- 3 - 2 * sqrt(2)
  three_minus_2sqrt2_down :: Rounded 'TowardNegInf LongDouble
three_minus_2sqrt2_down = LongDouble -> Rounded 'TowardNegInf LongDouble
forall (r :: RoundingMode) a. a -> Rounded r a
Rounded LongDouble
0x1.5f619980c4336f74p-3
  three_minus_2sqrt2_up :: Rounded 'TowardInf LongDouble
three_minus_2sqrt2_up   = LongDouble -> Rounded 'TowardInf LongDouble
forall (r :: RoundingMode) a. a -> Rounded r a
Rounded LongDouble
0x1.5f619980c4336f76p-3
  -- 2 - sqrt(2)
  two_minus_sqrt2_down :: Rounded 'TowardNegInf LongDouble
two_minus_sqrt2_down = LongDouble -> Rounded 'TowardNegInf LongDouble
forall (r :: RoundingMode) a. a -> Rounded r a
Rounded LongDouble
0x1.2bec333018866deep-1
  two_minus_sqrt2_up :: Rounded 'TowardInf LongDouble
two_minus_sqrt2_up   = LongDouble -> Rounded 'TowardInf LongDouble
forall (r :: RoundingMode) a. a -> Rounded r a
Rounded LongDouble
0x1.2bec333018866df0p-1

-- | Only available on x86/x86_64 systems.
-- Note that 'LongDouble' may not work correctly on Win64.
instance RoundedRing LongDouble where
  roundedAdd :: RoundingMode -> LongDouble -> LongDouble -> LongDouble
roundedAdd = RoundingMode -> LongDouble -> LongDouble -> LongDouble
roundedAdd_ld
  roundedSub :: RoundingMode -> LongDouble -> LongDouble -> LongDouble
roundedSub = RoundingMode -> LongDouble -> LongDouble -> LongDouble
roundedSub_ld
  roundedMul :: RoundingMode -> LongDouble -> LongDouble -> LongDouble
roundedMul = RoundingMode -> LongDouble -> LongDouble -> LongDouble
roundedMul_ld
  roundedFusedMultiplyAdd :: RoundingMode
-> LongDouble -> LongDouble -> LongDouble -> LongDouble
roundedFusedMultiplyAdd = RoundingMode
-> LongDouble -> LongDouble -> LongDouble -> LongDouble
roundedFMA_ld
  roundedFromInteger :: RoundingMode -> Integer -> LongDouble
roundedFromInteger = RoundingMode -> Integer -> LongDouble
forall a. RealFloat a => RoundingMode -> Integer -> a
roundedFromInteger_default
  intervalFromInteger :: Integer
-> (Rounded 'TowardNegInf LongDouble,
    Rounded 'TowardInf LongDouble)
intervalFromInteger = Integer
-> (Rounded 'TowardNegInf LongDouble,
    Rounded 'TowardInf LongDouble)
forall a.
RealFloat a =>
Integer -> (Rounded 'TowardNegInf a, Rounded 'TowardInf a)
intervalFromInteger_default
  backendNameT :: Tagged LongDouble String
backendNameT = String -> Tagged LongDouble String
forall k (s :: k) b. b -> Tagged s b
Tagged String
cBackendName
  {-# INLINE roundedAdd #-}
  {-# INLINE roundedSub #-}
  {-# INLINE roundedMul #-}
  {-# INLINE roundedFusedMultiplyAdd #-}
  {-# INLINE roundedFromInteger #-}
  {-# INLINE intervalFromInteger #-}

-- | Only available on x86/x86_64 systems.
-- Note that 'LongDouble' may not work correctly on Win64.
instance RoundedFractional LongDouble where
  roundedDiv :: RoundingMode -> LongDouble -> LongDouble -> LongDouble
roundedDiv = RoundingMode -> LongDouble -> LongDouble -> LongDouble
roundedDiv_ld
  roundedFromRational :: RoundingMode -> Rational -> LongDouble
roundedFromRational = RoundingMode -> Rational -> LongDouble
forall a. RealFloat a => RoundingMode -> Rational -> a
roundedFromRational_default
  intervalFromRational :: Rational
-> (Rounded 'TowardNegInf LongDouble,
    Rounded 'TowardInf LongDouble)
intervalFromRational = Rational
-> (Rounded 'TowardNegInf LongDouble,
    Rounded 'TowardInf LongDouble)
forall a.
RealFloat a =>
Rational -> (Rounded 'TowardNegInf a, Rounded 'TowardInf a)
intervalFromRational_default
  {-# INLINE roundedDiv #-}
  {-# INLINE roundedFromRational #-}
  {-# INLINE intervalFromRational #-}

-- | Only available on x86/x86_64 systems.
-- Note that 'LongDouble' may not work correctly on Win64.
instance RoundedSqrt LongDouble where
  roundedSqrt :: RoundingMode -> LongDouble -> LongDouble
roundedSqrt = RoundingMode -> LongDouble -> LongDouble
roundedSqrt_ld
  {-# INLINE roundedSqrt #-}

--
-- Backend name
--

foreign import ccall unsafe "rounded_hw_backend_name_longdouble"
  c_backend_name :: CString

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