{-# LANGUAGE ForeignFunctionInterface, FlexibleContexts, TypeFamilies #-}
{-# LANGUAGE CPP #-}
#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702
{-# LANGUAGE Trustworthy #-}
#endif
module Numeric.Extras
( RealExtras(..)
) where
#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ < 710
import Control.Applicative ((<$>), (<*>))
#endif
import Control.Arrow ((***))
import Foreign
import Foreign.C.Types
#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702
import System.IO.Unsafe (unsafeDupablePerformIO)
#else
import System.IO.Unsafe (unsafePerformIO)
#endif
{-# ANN module "HLint: ignore Use camelCase" #-}
class (Storable (C a), RealFloat (C a), RealFloat a) => a where
type C a :: *
fmod :: a -> a -> a
expm1 :: a -> a
log1p :: a -> a
hypot :: a -> a -> a
cbrt :: a -> a
erf :: a -> a
floor :: a -> a
ceil :: a -> a
trunc :: a -> a
modf :: a -> (a, a)
remainder :: a -> a -> a
instance RealExtras Double where
type C Double = CDouble
fmod :: Double -> Double -> Double
fmod = (CDouble -> CDouble -> CDouble) -> Double -> Double -> Double
lift2D CDouble -> CDouble -> CDouble
c_fmod
expm1 :: Double -> Double
expm1 = (CDouble -> CDouble) -> Double -> Double
lift1D CDouble -> CDouble
c_expm1
log1p :: Double -> Double
log1p = (CDouble -> CDouble) -> Double -> Double
lift1D CDouble -> CDouble
c_log1p
hypot :: Double -> Double -> Double
hypot = (CDouble -> CDouble -> CDouble) -> Double -> Double -> Double
lift2D CDouble -> CDouble -> CDouble
c_hypot
cbrt :: Double -> Double
cbrt = (CDouble -> CDouble) -> Double -> Double
lift1D CDouble -> CDouble
c_cbrt
erf :: Double -> Double
erf = (CDouble -> CDouble) -> Double -> Double
lift1D CDouble -> CDouble
c_erf
floor :: Double -> Double
floor = (CDouble -> CDouble) -> Double -> Double
lift1D CDouble -> CDouble
c_floor
ceil :: Double -> Double
ceil = (CDouble -> CDouble) -> Double -> Double
lift1D CDouble -> CDouble
c_ceil
trunc :: Double -> Double
trunc = (CDouble -> CDouble) -> Double -> Double
lift1D CDouble -> CDouble
c_trunc
modf :: Double -> (Double, Double)
modf = (CDouble -> (CDouble, CDouble)) -> Double -> (Double, Double)
lift1D2 CDouble -> (CDouble, CDouble)
c_modf
remainder :: Double -> Double -> Double
remainder = (CDouble -> CDouble -> CDouble) -> Double -> Double -> Double
lift2D CDouble -> CDouble -> CDouble
c_remainder
lift1D :: (CDouble -> CDouble) -> Double -> Double
lift1D :: (CDouble -> CDouble) -> Double -> Double
lift1D CDouble -> CDouble
f Double
a = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac (CDouble -> CDouble
f (Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
a))
{-# INLINE lift1D #-}
lift1D2 :: (CDouble -> (CDouble, CDouble)) -> Double -> (Double, Double)
lift1D2 :: (CDouble -> (CDouble, CDouble)) -> Double -> (Double, Double)
lift1D2 CDouble -> (CDouble, CDouble)
f Double
a = (CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac (CDouble -> Double)
-> (CDouble -> Double) -> (CDouble, CDouble) -> (Double, Double)
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac) (CDouble -> (CDouble, CDouble)
f (Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
a))
{-# INLINE lift1D2 #-}
lift2D :: (CDouble -> CDouble -> CDouble) -> Double -> Double -> Double
lift2D :: (CDouble -> CDouble -> CDouble) -> Double -> Double -> Double
lift2D CDouble -> CDouble -> CDouble
f Double
a Double
b = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac (CDouble -> CDouble -> CDouble
f (Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
a) (Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
b))
{-# INLINE lift2D #-}
c_modf :: CDouble -> (CDouble, CDouble)
#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702
c_modf :: CDouble -> (CDouble, CDouble)
c_modf CDouble
a = IO (CDouble, CDouble) -> (CDouble, CDouble)
forall a. IO a -> a
unsafeDupablePerformIO (IO (CDouble, CDouble) -> (CDouble, CDouble))
-> IO (CDouble, CDouble) -> (CDouble, CDouble)
forall a b. (a -> b) -> a -> b
$ (Ptr CDouble -> IO (CDouble, CDouble)) -> IO (CDouble, CDouble)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CDouble -> IO (CDouble, CDouble)) -> IO (CDouble, CDouble))
-> (Ptr CDouble -> IO (CDouble, CDouble)) -> IO (CDouble, CDouble)
forall a b. (a -> b) -> a -> b
$ \Ptr CDouble
i -> (,) (CDouble -> CDouble -> (CDouble, CDouble))
-> IO CDouble -> IO (CDouble -> (CDouble, CDouble))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CDouble -> Ptr CDouble -> IO CDouble
c_modf_imp CDouble
a Ptr CDouble
i IO (CDouble -> (CDouble, CDouble))
-> IO CDouble -> IO (CDouble, CDouble)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ptr CDouble -> IO CDouble
forall a. Storable a => Ptr a -> IO a
peek Ptr CDouble
i
#else
c_modf a = unsafePerformIO $ alloca $ \i -> (,) <$> c_modf_imp a i <*> peek i
#endif
instance RealExtras Float where
type C Float = CFloat
fmod :: Float -> Float -> Float
fmod = (CFloat -> CFloat -> CFloat) -> Float -> Float -> Float
lift2F CFloat -> CFloat -> CFloat
c_fmodf
expm1 :: Float -> Float
expm1 = (CFloat -> CFloat) -> Float -> Float
lift1F CFloat -> CFloat
c_expm1f
log1p :: Float -> Float
log1p = (CFloat -> CFloat) -> Float -> Float
lift1F CFloat -> CFloat
c_log1pf
hypot :: Float -> Float -> Float
hypot = (CFloat -> CFloat -> CFloat) -> Float -> Float -> Float
lift2F CFloat -> CFloat -> CFloat
c_hypotf
cbrt :: Float -> Float
cbrt = (CFloat -> CFloat) -> Float -> Float
lift1F CFloat -> CFloat
c_cbrtf
erf :: Float -> Float
erf = (CFloat -> CFloat) -> Float -> Float
lift1F CFloat -> CFloat
c_erff
floor :: Float -> Float
floor = (CFloat -> CFloat) -> Float -> Float
lift1F CFloat -> CFloat
c_floorf
ceil :: Float -> Float
ceil = (CFloat -> CFloat) -> Float -> Float
lift1F CFloat -> CFloat
c_ceilf
trunc :: Float -> Float
trunc = (CFloat -> CFloat) -> Float -> Float
lift1F CFloat -> CFloat
c_truncf
modf :: Float -> (Float, Float)
modf = (CFloat -> (CFloat, CFloat)) -> Float -> (Float, Float)
lift1F2 CFloat -> (CFloat, CFloat)
c_modff
remainder :: Float -> Float -> Float
remainder = (CFloat -> CFloat -> CFloat) -> Float -> Float -> Float
lift2F CFloat -> CFloat -> CFloat
c_remainderf
lift1F :: (CFloat -> CFloat) -> Float -> Float
lift1F :: (CFloat -> CFloat) -> Float -> Float
lift1F CFloat -> CFloat
f Float
a = CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac (CFloat -> CFloat
f (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
a))
{-# INLINE lift1F #-}
lift1F2 :: (CFloat -> (CFloat, CFloat)) -> Float -> (Float, Float)
lift1F2 :: (CFloat -> (CFloat, CFloat)) -> Float -> (Float, Float)
lift1F2 CFloat -> (CFloat, CFloat)
f Float
a = (CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac (CFloat -> Float)
-> (CFloat -> Float) -> (CFloat, CFloat) -> (Float, Float)
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac) (CFloat -> (CFloat, CFloat)
f (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
a))
{-# INLINE lift1F2 #-}
lift2F :: (CFloat -> CFloat -> CFloat) -> Float -> Float -> Float
lift2F :: (CFloat -> CFloat -> CFloat) -> Float -> Float -> Float
lift2F CFloat -> CFloat -> CFloat
f Float
a Float
b = CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac (CFloat -> CFloat -> CFloat
f (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
a) (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
b))
{-# INLINE lift2F #-}
c_modff :: CFloat -> (CFloat, CFloat)
#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702
c_modff :: CFloat -> (CFloat, CFloat)
c_modff CFloat
a = IO (CFloat, CFloat) -> (CFloat, CFloat)
forall a. IO a -> a
unsafeDupablePerformIO (IO (CFloat, CFloat) -> (CFloat, CFloat))
-> IO (CFloat, CFloat) -> (CFloat, CFloat)
forall a b. (a -> b) -> a -> b
$ (Ptr CFloat -> IO (CFloat, CFloat)) -> IO (CFloat, CFloat)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CFloat -> IO (CFloat, CFloat)) -> IO (CFloat, CFloat))
-> (Ptr CFloat -> IO (CFloat, CFloat)) -> IO (CFloat, CFloat)
forall a b. (a -> b) -> a -> b
$ \Ptr CFloat
i -> (,) (CFloat -> CFloat -> (CFloat, CFloat))
-> IO CFloat -> IO (CFloat -> (CFloat, CFloat))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CFloat -> Ptr CFloat -> IO CFloat
c_modff_imp CFloat
a Ptr CFloat
i IO (CFloat -> (CFloat, CFloat)) -> IO CFloat -> IO (CFloat, CFloat)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ptr CFloat -> IO CFloat
forall a. Storable a => Ptr a -> IO a
peek Ptr CFloat
i
#else
c_modff a = unsafePerformIO $ alloca $ \i -> (,) <$> c_modff_imp a i <*> peek i
#endif
foreign import ccall unsafe "math.h fmod"
c_fmod :: CDouble -> CDouble -> CDouble
foreign import ccall unsafe "math.h expm1"
c_expm1 :: CDouble -> CDouble
foreign import ccall unsafe "math.h log1p"
c_log1p :: CDouble -> CDouble
foreign import ccall unsafe "math.h hypot"
c_hypot :: CDouble -> CDouble -> CDouble
foreign import ccall unsafe "math.h cbrt"
c_cbrt :: CDouble -> CDouble
foreign import ccall unsafe "math.h erf"
c_erf :: CDouble -> CDouble
foreign import ccall unsafe "math.h floor"
c_floor :: CDouble -> CDouble
foreign import ccall unsafe "math.h ceil"
c_ceil :: CDouble -> CDouble
foreign import ccall unsafe "math.h trunc"
c_trunc :: CDouble -> CDouble
foreign import ccall unsafe "math.h modf"
c_modf_imp :: CDouble -> Ptr CDouble -> IO CDouble
foreign import ccall unsafe "math.h remainder"
c_remainder :: CDouble -> CDouble -> CDouble
foreign import ccall unsafe "math.h fmodf"
c_fmodf :: CFloat -> CFloat -> CFloat
foreign import ccall unsafe "math.h expm1f"
c_expm1f :: CFloat -> CFloat
foreign import ccall unsafe "math.h log1pf"
c_log1pf :: CFloat -> CFloat
foreign import ccall unsafe "math.h hypotf"
c_hypotf :: CFloat -> CFloat -> CFloat
foreign import ccall unsafe "math.h cbrtf"
c_cbrtf :: CFloat -> CFloat
foreign import ccall unsafe "math.h erff"
c_erff :: CFloat -> CFloat
foreign import ccall unsafe "math.h floorf"
c_floorf :: CFloat -> CFloat
foreign import ccall unsafe "math.h ceilf"
c_ceilf :: CFloat -> CFloat
foreign import ccall unsafe "math.h truncf"
c_truncf :: CFloat -> CFloat
foreign import ccall unsafe "math.h modff"
c_modff_imp :: CFloat -> Ptr CFloat -> IO CFloat
foreign import ccall unsafe "math.h remainderf"
c_remainderf :: CFloat -> CFloat -> CFloat
default (Double)