{-# LINE 1 "src/Bindings/Gsl/MathematicalFunctions.hsc" #-}

{-# LINE 2 "src/Bindings/Gsl/MathematicalFunctions.hsc" #-}

{-# LINE 3 "src/Bindings/Gsl/MathematicalFunctions.hsc" #-}

-- | <http://www.gnu.org/software/gsl/manual/html_node/Mathematical-Functions.html>

module Bindings.Gsl.MathematicalFunctions where
import Foreign.Ptr (Ptr,FunPtr,plusPtr)
import Foreign.Ptr (wordPtrToPtr,castPtrToFunPtr)
import Foreign.Storable
import Foreign.C.Types
import Foreign.C.String (CString,CStringLen,CWString,CWStringLen)
import Foreign.Marshal.Alloc (alloca)
import Foreign.Marshal.Array (peekArray,pokeArray)
import Data.Int
import Data.Word

{-# LINE 8 "src/Bindings/Gsl/MathematicalFunctions.hsc" #-}

c'M_E = 2.718282e+00
c'M_E :: (Fractional a) => a

{-# LINE 10 "src/Bindings/Gsl/MathematicalFunctions.hsc" #-}
c'M_LOG2E = 1.442695e+00
c'M_LOG2E :: (Fractional a) => a

{-# LINE 11 "src/Bindings/Gsl/MathematicalFunctions.hsc" #-}
c'M_LOG10E = 4.342945e-01
c'M_LOG10E :: (Fractional a) => a

{-# LINE 12 "src/Bindings/Gsl/MathematicalFunctions.hsc" #-}
c'M_SQRT2 = 1.414214e+00
c'M_SQRT2 :: (Fractional a) => a

{-# LINE 13 "src/Bindings/Gsl/MathematicalFunctions.hsc" #-}
c'M_SQRT1_2 = 7.071068e-01
c'M_SQRT1_2 :: (Fractional a) => a

{-# LINE 14 "src/Bindings/Gsl/MathematicalFunctions.hsc" #-}
c'M_SQRT3 = 1.732051e+00
c'M_SQRT3 :: (Fractional a) => a

{-# LINE 15 "src/Bindings/Gsl/MathematicalFunctions.hsc" #-}
c'M_PI = 3.141593e+00
c'M_PI :: (Fractional a) => a

{-# LINE 16 "src/Bindings/Gsl/MathematicalFunctions.hsc" #-}
c'M_PI_2 = 1.570796e+00
c'M_PI_2 :: (Fractional a) => a

{-# LINE 17 "src/Bindings/Gsl/MathematicalFunctions.hsc" #-}
c'M_PI_4 = 7.853982e-01
c'M_PI_4 :: (Fractional a) => a

{-# LINE 18 "src/Bindings/Gsl/MathematicalFunctions.hsc" #-}
c'M_SQRTPI = 1.772454e+00
c'M_SQRTPI :: (Fractional a) => a

{-# LINE 19 "src/Bindings/Gsl/MathematicalFunctions.hsc" #-}
c'M_2_SQRTPI = 1.128379e+00
c'M_2_SQRTPI :: (Fractional a) => a

{-# LINE 20 "src/Bindings/Gsl/MathematicalFunctions.hsc" #-}
c'M_1_PI = 3.183099e-01
c'M_1_PI :: (Fractional a) => a

{-# LINE 21 "src/Bindings/Gsl/MathematicalFunctions.hsc" #-}
c'M_2_PI = 6.366198e-01
c'M_2_PI :: (Fractional a) => a

{-# LINE 22 "src/Bindings/Gsl/MathematicalFunctions.hsc" #-}
c'M_LN10 = 2.302585e+00
c'M_LN10 :: (Fractional a) => a

{-# LINE 23 "src/Bindings/Gsl/MathematicalFunctions.hsc" #-}
c'M_LN2 = 6.931472e-01
c'M_LN2 :: (Fractional a) => a

{-# LINE 24 "src/Bindings/Gsl/MathematicalFunctions.hsc" #-}
c'M_LNPI = 1.144730e+00
c'M_LNPI :: (Fractional a) => a

{-# LINE 25 "src/Bindings/Gsl/MathematicalFunctions.hsc" #-}
c'M_EULER = 5.772157e-01
c'M_EULER :: (Fractional a) => a

{-# LINE 26 "src/Bindings/Gsl/MathematicalFunctions.hsc" #-}


{-# LINE 28 "src/Bindings/Gsl/MathematicalFunctions.hsc" #-}

{-# LINE 29 "src/Bindings/Gsl/MathematicalFunctions.hsc" #-}

{-# LINE 30 "src/Bindings/Gsl/MathematicalFunctions.hsc" #-}
data C'gsl_function = C'gsl_function{
  c'gsl_function'function :: FunPtr (CDouble -> Ptr () -> IO CDouble),
  c'gsl_function'params :: Ptr ()
} deriving (Eq,Show)
p'gsl_function'function p = plusPtr p 0
p'gsl_function'function :: Ptr (C'gsl_function) -> Ptr (FunPtr (CDouble -> Ptr () -> IO CDouble))
p'gsl_function'params p = plusPtr p 4
p'gsl_function'params :: Ptr (C'gsl_function) -> Ptr (Ptr ())
instance Storable C'gsl_function where
  sizeOf _ = 8
  alignment _ = 4
  peek p = do
    v0 <- peekByteOff p 0
    v1 <- peekByteOff p 4
    return $ C'gsl_function v0 v1
  poke p (C'gsl_function v0 v1) = do
    pokeByteOff p 0 v0
    pokeByteOff p 4 v1
    return ()

{-# LINE 31 "src/Bindings/Gsl/MathematicalFunctions.hsc" #-}

foreign import ccall "inline_GSL_FN_EVAL" c'GSL_FN_EVAL
  :: Ptr C'gsl_function -> CDouble -> IO CDouble

{-# LINE 33 "src/Bindings/Gsl/MathematicalFunctions.hsc" #-}


{-# LINE 35 "src/Bindings/Gsl/MathematicalFunctions.hsc" #-}

{-# LINE 36 "src/Bindings/Gsl/MathematicalFunctions.hsc" #-}

{-# LINE 37 "src/Bindings/Gsl/MathematicalFunctions.hsc" #-}

{-# LINE 38 "src/Bindings/Gsl/MathematicalFunctions.hsc" #-}

{-# LINE 39 "src/Bindings/Gsl/MathematicalFunctions.hsc" #-}
data C'gsl_function_fdf = C'gsl_function_fdf{
  c'gsl_function_fdf'f :: FunPtr (CDouble -> Ptr () -> IO CDouble),
  c'gsl_function_fdf'df :: FunPtr (CDouble -> Ptr () -> IO CDouble),
  c'gsl_function_fdf'fdf :: FunPtr (CDouble -> Ptr () -> Ptr CDouble -> Ptr CDouble -> IO ()),
  c'gsl_function_fdf'params :: Ptr ()
} deriving (Eq,Show)
p'gsl_function_fdf'f p = plusPtr p 0
p'gsl_function_fdf'f :: Ptr (C'gsl_function_fdf) -> Ptr (FunPtr (CDouble -> Ptr () -> IO CDouble))
p'gsl_function_fdf'df p = plusPtr p 4
p'gsl_function_fdf'df :: Ptr (C'gsl_function_fdf) -> Ptr (FunPtr (CDouble -> Ptr () -> IO CDouble))
p'gsl_function_fdf'fdf p = plusPtr p 8
p'gsl_function_fdf'fdf :: Ptr (C'gsl_function_fdf) -> Ptr (FunPtr (CDouble -> Ptr () -> Ptr CDouble -> Ptr CDouble -> IO ()))
p'gsl_function_fdf'params p = plusPtr p 12
p'gsl_function_fdf'params :: Ptr (C'gsl_function_fdf) -> Ptr (Ptr ())
instance Storable C'gsl_function_fdf where
  sizeOf _ = 16
  alignment _ = 4
  peek p = do
    v0 <- peekByteOff p 0
    v1 <- peekByteOff p 4
    v2 <- peekByteOff p 8
    v3 <- peekByteOff p 12
    return $ C'gsl_function_fdf v0 v1 v2 v3
  poke p (C'gsl_function_fdf v0 v1 v2 v3) = do
    pokeByteOff p 0 v0
    pokeByteOff p 4 v1
    pokeByteOff p 8 v2
    pokeByteOff p 12 v3
    return ()

{-# LINE 40 "src/Bindings/Gsl/MathematicalFunctions.hsc" #-}

foreign import ccall "inline_GSL_FN_FDF_EVAL_F" c'GSL_FN_FDF_EVAL_F
  :: Ptr C'gsl_function_fdf -> CDouble -> IO CDouble

{-# LINE 42 "src/Bindings/Gsl/MathematicalFunctions.hsc" #-}
foreign import ccall "inline_GSL_FN_FDF_EVAL_DF" c'GSL_FN_FDF_EVAL_DF
  :: Ptr C'gsl_function_fdf -> CDouble -> IO CDouble

{-# LINE 43 "src/Bindings/Gsl/MathematicalFunctions.hsc" #-}
foreign import ccall "inline_GSL_FN_FDF_EVAL_F_DF" c'GSL_FN_FDF_EVAL_F_DF
  :: Ptr C'gsl_function_fdf -> CDouble -> Ptr CDouble -> Ptr CDouble -> IO ()

{-# LINE 44 "src/Bindings/Gsl/MathematicalFunctions.hsc" #-}


{-# LINE 46 "src/Bindings/Gsl/MathematicalFunctions.hsc" #-}

{-# LINE 47 "src/Bindings/Gsl/MathematicalFunctions.hsc" #-}

{-# LINE 48 "src/Bindings/Gsl/MathematicalFunctions.hsc" #-}
data C'gsl_function_vec = C'gsl_function_vec{
  c'gsl_function_vec'function :: FunPtr (CDouble -> Ptr CDouble -> Ptr () -> IO CInt),
  c'gsl_function_vec'params :: Ptr ()
} deriving (Eq,Show)
p'gsl_function_vec'function p = plusPtr p 0
p'gsl_function_vec'function :: Ptr (C'gsl_function_vec) -> Ptr (FunPtr (CDouble -> Ptr CDouble -> Ptr () -> IO CInt))
p'gsl_function_vec'params p = plusPtr p 4
p'gsl_function_vec'params :: Ptr (C'gsl_function_vec) -> Ptr (Ptr ())
instance Storable C'gsl_function_vec where
  sizeOf _ = 8
  alignment _ = 4
  peek p = do
    v0 <- peekByteOff p 0
    v1 <- peekByteOff p 4
    return $ C'gsl_function_vec v0 v1
  poke p (C'gsl_function_vec v0 v1) = do
    pokeByteOff p 0 v0
    pokeByteOff p 4 v1
    return ()

{-# LINE 49 "src/Bindings/Gsl/MathematicalFunctions.hsc" #-}

foreign import ccall "inline_GSL_FN_VEC_EVAL" c'GSL_FN_VEC_EVAL
  :: Ptr C'gsl_function_vec -> CDouble -> Ptr CDouble -> IO CDouble

{-# LINE 51 "src/Bindings/Gsl/MathematicalFunctions.hsc" #-}

foreign import ccall "gsl_max" c'gsl_max
  :: CDouble -> CDouble -> IO CDouble
foreign import ccall "&gsl_max" p'gsl_max
  :: FunPtr (CDouble -> CDouble -> IO CDouble)

{-# LINE 53 "src/Bindings/Gsl/MathematicalFunctions.hsc" #-}
foreign import ccall "gsl_min" c'gsl_min
  :: CDouble -> CDouble -> IO CDouble
foreign import ccall "&gsl_min" p'gsl_min
  :: FunPtr (CDouble -> CDouble -> IO CDouble)

{-# LINE 54 "src/Bindings/Gsl/MathematicalFunctions.hsc" #-}
foreign import ccall "GSL_MAX_INT" c'GSL_MAX_INT
  :: CInt -> CInt -> CInt -> IO CInt
foreign import ccall "&GSL_MAX_INT" p'GSL_MAX_INT
  :: FunPtr (CInt -> CInt -> CInt -> IO CInt)

{-# LINE 55 "src/Bindings/Gsl/MathematicalFunctions.hsc" #-}
foreign import ccall "GSL_MIN_INT" c'GSL_MIN_INT
  :: CInt -> CInt -> CInt -> IO CInt
foreign import ccall "&GSL_MIN_INT" p'GSL_MIN_INT
  :: FunPtr (CInt -> CInt -> CInt -> IO CInt)

{-# LINE 56 "src/Bindings/Gsl/MathematicalFunctions.hsc" #-}
foreign import ccall "GSL_MAX_DBL" c'GSL_MAX_DBL
  :: CDouble -> CDouble -> IO CDouble
foreign import ccall "&GSL_MAX_DBL" p'GSL_MAX_DBL
  :: FunPtr (CDouble -> CDouble -> IO CDouble)

{-# LINE 57 "src/Bindings/Gsl/MathematicalFunctions.hsc" #-}
foreign import ccall "GSL_MIN_DBL" c'GSL_MIN_DBL
  :: CDouble -> CDouble -> IO CDouble
foreign import ccall "&GSL_MIN_DBL" p'GSL_MIN_DBL
  :: FunPtr (CDouble -> CDouble -> IO CDouble)

{-# LINE 58 "src/Bindings/Gsl/MathematicalFunctions.hsc" #-}
-- #ccall GSL_MAX_LDBL , CLDouble -> CLDouble -> IO CLDouble
-- #ccall GSL_MIN_LDBL , CLDouble -> CLDouble -> IO CLDouble

foreign import ccall "gsl_log1p" c'gsl_log1p
  :: CDouble -> IO CDouble
foreign import ccall "&gsl_log1p" p'gsl_log1p
  :: FunPtr (CDouble -> IO CDouble)

{-# LINE 62 "src/Bindings/Gsl/MathematicalFunctions.hsc" #-}
foreign import ccall "gsl_expm1" c'gsl_expm1
  :: CDouble -> IO CDouble
foreign import ccall "&gsl_expm1" p'gsl_expm1
  :: FunPtr (CDouble -> IO CDouble)

{-# LINE 63 "src/Bindings/Gsl/MathematicalFunctions.hsc" #-}
foreign import ccall "gsl_hypot" c'gsl_hypot
  :: CDouble -> CDouble -> IO CDouble
foreign import ccall "&gsl_hypot" p'gsl_hypot
  :: FunPtr (CDouble -> CDouble -> IO CDouble)

{-# LINE 64 "src/Bindings/Gsl/MathematicalFunctions.hsc" #-}
foreign import ccall "gsl_hypot3" c'gsl_hypot3
  :: CDouble -> CDouble -> CDouble -> IO CDouble
foreign import ccall "&gsl_hypot3" p'gsl_hypot3
  :: FunPtr (CDouble -> CDouble -> CDouble -> IO CDouble)

{-# LINE 65 "src/Bindings/Gsl/MathematicalFunctions.hsc" #-}
foreign import ccall "gsl_acosh" c'gsl_acosh
  :: CDouble -> IO CDouble
foreign import ccall "&gsl_acosh" p'gsl_acosh
  :: FunPtr (CDouble -> IO CDouble)

{-# LINE 66 "src/Bindings/Gsl/MathematicalFunctions.hsc" #-}
foreign import ccall "gsl_asinh" c'gsl_asinh
  :: CDouble -> IO CDouble
foreign import ccall "&gsl_asinh" p'gsl_asinh
  :: FunPtr (CDouble -> IO CDouble)

{-# LINE 67 "src/Bindings/Gsl/MathematicalFunctions.hsc" #-}
foreign import ccall "gsl_atanh" c'gsl_atanh
  :: CDouble -> IO CDouble
foreign import ccall "&gsl_atanh" p'gsl_atanh
  :: FunPtr (CDouble -> IO CDouble)

{-# LINE 68 "src/Bindings/Gsl/MathematicalFunctions.hsc" #-}

foreign import ccall "gsl_isnan" c'gsl_isnan
  :: CDouble -> IO CInt
foreign import ccall "&gsl_isnan" p'gsl_isnan
  :: FunPtr (CDouble -> IO CInt)

{-# LINE 70 "src/Bindings/Gsl/MathematicalFunctions.hsc" #-}
foreign import ccall "gsl_isinf" c'gsl_isinf
  :: CDouble -> IO CInt
foreign import ccall "&gsl_isinf" p'gsl_isinf
  :: FunPtr (CDouble -> IO CInt)

{-# LINE 71 "src/Bindings/Gsl/MathematicalFunctions.hsc" #-}
foreign import ccall "gsl_finite" c'gsl_finite
  :: CDouble -> IO CInt
foreign import ccall "&gsl_finite" p'gsl_finite
  :: FunPtr (CDouble -> IO CInt)

{-# LINE 72 "src/Bindings/Gsl/MathematicalFunctions.hsc" #-}

foreign import ccall "gsl_nan" c'gsl_nan
  :: IO CDouble
foreign import ccall "&gsl_nan" p'gsl_nan
  :: FunPtr (IO CDouble)

{-# LINE 74 "src/Bindings/Gsl/MathematicalFunctions.hsc" #-}
foreign import ccall "gsl_posinf" c'gsl_posinf
  :: IO CDouble
foreign import ccall "&gsl_posinf" p'gsl_posinf
  :: FunPtr (IO CDouble)

{-# LINE 75 "src/Bindings/Gsl/MathematicalFunctions.hsc" #-}
foreign import ccall "gsl_neginf" c'gsl_neginf
  :: IO CDouble
foreign import ccall "&gsl_neginf" p'gsl_neginf
  :: FunPtr (IO CDouble)

{-# LINE 76 "src/Bindings/Gsl/MathematicalFunctions.hsc" #-}
foreign import ccall "gsl_fdiv" c'gsl_fdiv
  :: CDouble -> CDouble -> IO CDouble
foreign import ccall "&gsl_fdiv" p'gsl_fdiv
  :: FunPtr (CDouble -> CDouble -> IO CDouble)

{-# LINE 77 "src/Bindings/Gsl/MathematicalFunctions.hsc" #-}

foreign import ccall "gsl_coerce_double" c'gsl_coerce_double
  :: CDouble -> IO CDouble
foreign import ccall "&gsl_coerce_double" p'gsl_coerce_double
  :: FunPtr (CDouble -> IO CDouble)

{-# LINE 79 "src/Bindings/Gsl/MathematicalFunctions.hsc" #-}
foreign import ccall "gsl_coerce_float" c'gsl_coerce_float
  :: CFloat -> IO CFloat
foreign import ccall "&gsl_coerce_float" p'gsl_coerce_float
  :: FunPtr (CFloat -> IO CFloat)

{-# LINE 80 "src/Bindings/Gsl/MathematicalFunctions.hsc" #-}
-- #ccall gsl_coerce_long_double , CLDouble -> IO CLDouble

foreign import ccall "gsl_ldexp" c'gsl_ldexp
  :: CDouble -> CInt -> IO CDouble
foreign import ccall "&gsl_ldexp" p'gsl_ldexp
  :: FunPtr (CDouble -> CInt -> IO CDouble)

{-# LINE 83 "src/Bindings/Gsl/MathematicalFunctions.hsc" #-}
foreign import ccall "gsl_frexp" c'gsl_frexp
  :: CDouble -> Ptr CInt -> IO CDouble
foreign import ccall "&gsl_frexp" p'gsl_frexp
  :: FunPtr (CDouble -> Ptr CInt -> IO CDouble)

{-# LINE 84 "src/Bindings/Gsl/MathematicalFunctions.hsc" #-}

foreign import ccall "gsl_fcmp" c'gsl_fcmp
  :: CDouble -> CDouble -> CDouble -> IO CInt
foreign import ccall "&gsl_fcmp" p'gsl_fcmp
  :: FunPtr (CDouble -> CDouble -> CDouble -> IO CInt)

{-# LINE 86 "src/Bindings/Gsl/MathematicalFunctions.hsc" #-}

foreign import ccall "gsl_pow_2" c'gsl_pow_2
  :: CDouble -> IO CDouble
foreign import ccall "&gsl_pow_2" p'gsl_pow_2
  :: FunPtr (CDouble -> IO CDouble)

{-# LINE 88 "src/Bindings/Gsl/MathematicalFunctions.hsc" #-}
foreign import ccall "gsl_pow_3" c'gsl_pow_3
  :: CDouble -> IO CDouble
foreign import ccall "&gsl_pow_3" p'gsl_pow_3
  :: FunPtr (CDouble -> IO CDouble)

{-# LINE 89 "src/Bindings/Gsl/MathematicalFunctions.hsc" #-}
foreign import ccall "gsl_pow_4" c'gsl_pow_4
  :: CDouble -> IO CDouble
foreign import ccall "&gsl_pow_4" p'gsl_pow_4
  :: FunPtr (CDouble -> IO CDouble)

{-# LINE 90 "src/Bindings/Gsl/MathematicalFunctions.hsc" #-}
foreign import ccall "gsl_pow_5" c'gsl_pow_5
  :: CDouble -> IO CDouble
foreign import ccall "&gsl_pow_5" p'gsl_pow_5
  :: FunPtr (CDouble -> IO CDouble)

{-# LINE 91 "src/Bindings/Gsl/MathematicalFunctions.hsc" #-}
foreign import ccall "gsl_pow_6" c'gsl_pow_6
  :: CDouble -> IO CDouble
foreign import ccall "&gsl_pow_6" p'gsl_pow_6
  :: FunPtr (CDouble -> IO CDouble)

{-# LINE 92 "src/Bindings/Gsl/MathematicalFunctions.hsc" #-}
foreign import ccall "gsl_pow_7" c'gsl_pow_7
  :: CDouble -> IO CDouble
foreign import ccall "&gsl_pow_7" p'gsl_pow_7
  :: FunPtr (CDouble -> IO CDouble)

{-# LINE 93 "src/Bindings/Gsl/MathematicalFunctions.hsc" #-}
foreign import ccall "gsl_pow_8" c'gsl_pow_8
  :: CDouble -> IO CDouble
foreign import ccall "&gsl_pow_8" p'gsl_pow_8
  :: FunPtr (CDouble -> IO CDouble)

{-# LINE 94 "src/Bindings/Gsl/MathematicalFunctions.hsc" #-}
foreign import ccall "gsl_pow_9" c'gsl_pow_9
  :: CDouble -> IO CDouble
foreign import ccall "&gsl_pow_9" p'gsl_pow_9
  :: FunPtr (CDouble -> IO CDouble)

{-# LINE 95 "src/Bindings/Gsl/MathematicalFunctions.hsc" #-}
foreign import ccall "gsl_pow_int" c'gsl_pow_int
  :: CDouble -> CInt -> IO CDouble
foreign import ccall "&gsl_pow_int" p'gsl_pow_int
  :: FunPtr (CDouble -> CInt -> IO CDouble)

{-# LINE 96 "src/Bindings/Gsl/MathematicalFunctions.hsc" #-}
foreign import ccall "gsl_pow_uint" c'gsl_pow_uint
  :: CDouble -> CUInt -> IO CDouble
foreign import ccall "&gsl_pow_uint" p'gsl_pow_uint
  :: FunPtr (CDouble -> CUInt -> IO CDouble)

{-# LINE 97 "src/Bindings/Gsl/MathematicalFunctions.hsc" #-}