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

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

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

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

module Bindings.Gsl.NumericalDifferentiation 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/NumericalDifferentiation.hsc" #-}
import Bindings.Gsl.MathematicalFunctions

foreign import ccall "gsl_deriv_central" c'gsl_deriv_central
  :: Ptr C'gsl_function -> CDouble -> CDouble -> Ptr CDouble -> Ptr CDouble -> IO CInt
foreign import ccall "&gsl_deriv_central" p'gsl_deriv_central
  :: FunPtr (Ptr C'gsl_function -> CDouble -> CDouble -> Ptr CDouble -> Ptr CDouble -> IO CInt)

{-# LINE 11 "src/Bindings/Gsl/NumericalDifferentiation.hsc" #-}
foreign import ccall "gsl_deriv_backward" c'gsl_deriv_backward
  :: Ptr C'gsl_function -> CDouble -> CDouble -> Ptr CDouble -> Ptr CDouble -> IO CInt
foreign import ccall "&gsl_deriv_backward" p'gsl_deriv_backward
  :: FunPtr (Ptr C'gsl_function -> CDouble -> CDouble -> Ptr CDouble -> Ptr CDouble -> IO CInt)

{-# LINE 12 "src/Bindings/Gsl/NumericalDifferentiation.hsc" #-}
foreign import ccall "gsl_deriv_forward" c'gsl_deriv_forward
  :: Ptr C'gsl_function -> CDouble -> CDouble -> Ptr CDouble -> Ptr CDouble -> IO CInt
foreign import ccall "&gsl_deriv_forward" p'gsl_deriv_forward
  :: FunPtr (Ptr C'gsl_function -> CDouble -> CDouble -> Ptr CDouble -> Ptr CDouble -> IO CInt)

{-# LINE 13 "src/Bindings/Gsl/NumericalDifferentiation.hsc" #-}