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

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

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

-- | <http://www.gnu.org/software/gsl/manual/html_node/Ordinary-Differential-Equations.html>

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

data C'gsl_odeiv_system = C'gsl_odeiv_system{
{-# LINE 10 "src/Bindings/Gsl/OrdinaryDifferentialEquations.hsc" #-}

  c'gsl_odeiv_system'function :: FunPtr (CDouble -> Ptr CDouble -> Ptr CDouble -> Ptr () -> IO CInt)
{-# LINE 11 "src/Bindings/Gsl/OrdinaryDifferentialEquations.hsc" #-}
,
  c'gsl_odeiv_system'jacobian :: FunPtr (CDouble -> Ptr CDouble -> Ptr CDouble -> Ptr CDouble -> Ptr () -> IO CInt)
{-# LINE 12 "src/Bindings/Gsl/OrdinaryDifferentialEquations.hsc" #-}
,
  c'gsl_odeiv_system'dimension :: CSize
{-# LINE 13 "src/Bindings/Gsl/OrdinaryDifferentialEquations.hsc" #-}
,
  c'gsl_odeiv_system'params :: Ptr ()
{-# LINE 14 "src/Bindings/Gsl/OrdinaryDifferentialEquations.hsc" #-}

 } deriving (Eq,Show)
instance Storable C'gsl_odeiv_system where
  sizeOf _ = 16
  alignment = sizeOf
  peek p = do
    v0 <- peekByteOff p 0
    v1 <- peekByteOff p 4
    v2 <- peekByteOff p 8
    v3 <- peekByteOff p 12
    return $ C'gsl_odeiv_system v0 v1 v2 v3
  poke p (C'gsl_odeiv_system v0 v1 v2 v3) = do
    pokeByteOff p 0 v0
    pokeByteOff p 4 v1
    pokeByteOff p 8 v2
    pokeByteOff p 12 v3
    return ()

{-# LINE 15 "src/Bindings/Gsl/OrdinaryDifferentialEquations.hsc" #-}

foreign import ccall "inline_GSL_ODEIV_FN_EVAL" c'GSL_ODEIV_FN_EVAL
  :: Ptr C'gsl_odeiv_system -> CDouble -> Ptr CDouble -> Ptr CDouble -> IO CInt

{-# LINE 17 "src/Bindings/Gsl/OrdinaryDifferentialEquations.hsc" #-}
foreign import ccall "inline_GSL_ODEIV_JA_EVAL" c'GSL_ODEIV_JA_EVAL
  :: Ptr C'gsl_odeiv_system -> CDouble -> Ptr CDouble -> Ptr CDouble -> Ptr CDouble -> IO CInt

{-# LINE 18 "src/Bindings/Gsl/OrdinaryDifferentialEquations.hsc" #-}

data C'gsl_odeiv_step_type = C'gsl_odeiv_step_type{
{-# LINE 20 "src/Bindings/Gsl/OrdinaryDifferentialEquations.hsc" #-}

  c'gsl_odeiv_step_type'name :: CString
{-# LINE 21 "src/Bindings/Gsl/OrdinaryDifferentialEquations.hsc" #-}
,
  c'gsl_odeiv_step_type'can_use_dydt_in :: CInt
{-# LINE 22 "src/Bindings/Gsl/OrdinaryDifferentialEquations.hsc" #-}
,
  c'gsl_odeiv_step_type'gives_exact_dydt_out :: CInt
{-# LINE 23 "src/Bindings/Gsl/OrdinaryDifferentialEquations.hsc" #-}
,
  c'gsl_odeiv_step_type'alloc :: FunPtr (CSize -> IO (Ptr ()))
{-# LINE 24 "src/Bindings/Gsl/OrdinaryDifferentialEquations.hsc" #-}
,
  c'gsl_odeiv_step_type'apply :: FunPtr (Ptr () -> CSize -> CDouble -> CDouble -> Ptr CDouble -> Ptr CDouble -> Ptr CDouble -> Ptr CDouble -> Ptr C'gsl_odeiv_system -> IO CInt)
{-# LINE 25 "src/Bindings/Gsl/OrdinaryDifferentialEquations.hsc" #-}
,
  c'gsl_odeiv_step_type'reset :: FunPtr (Ptr () -> CSize -> IO CInt)
{-# LINE 26 "src/Bindings/Gsl/OrdinaryDifferentialEquations.hsc" #-}
,
  c'gsl_odeiv_step_type'order :: FunPtr (Ptr () -> IO CUInt)
{-# LINE 27 "src/Bindings/Gsl/OrdinaryDifferentialEquations.hsc" #-}
,
  c'gsl_odeiv_step_type'free :: FunPtr (Ptr () -> IO ())
{-# LINE 28 "src/Bindings/Gsl/OrdinaryDifferentialEquations.hsc" #-}

 } deriving (Eq,Show)
instance Storable C'gsl_odeiv_step_type where
  sizeOf _ = 32
  alignment = sizeOf
  peek p = do
    v0 <- peekByteOff p 0
    v1 <- peekByteOff p 4
    v2 <- peekByteOff p 8
    v3 <- peekByteOff p 12
    v4 <- peekByteOff p 16
    v5 <- peekByteOff p 20
    v6 <- peekByteOff p 24
    v7 <- peekByteOff p 28
    return $ C'gsl_odeiv_step_type v0 v1 v2 v3 v4 v5 v6 v7
  poke p (C'gsl_odeiv_step_type v0 v1 v2 v3 v4 v5 v6 v7) = do
    pokeByteOff p 0 v0
    pokeByteOff p 4 v1
    pokeByteOff p 8 v2
    pokeByteOff p 12 v3
    pokeByteOff p 16 v4
    pokeByteOff p 20 v5
    pokeByteOff p 24 v6
    pokeByteOff p 28 v7
    return ()

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

data C'gsl_odeiv_step = C'gsl_odeiv_step{
{-# LINE 31 "src/Bindings/Gsl/OrdinaryDifferentialEquations.hsc" #-}

  c'gsl_odeiv_step'type :: Ptr C'gsl_odeiv_step_type
{-# LINE 32 "src/Bindings/Gsl/OrdinaryDifferentialEquations.hsc" #-}
,
  c'gsl_odeiv_step'dimension :: CSize
{-# LINE 33 "src/Bindings/Gsl/OrdinaryDifferentialEquations.hsc" #-}
,
  c'gsl_odeiv_step'state :: Ptr ()
{-# LINE 34 "src/Bindings/Gsl/OrdinaryDifferentialEquations.hsc" #-}

 } deriving (Eq,Show)
instance Storable C'gsl_odeiv_step where
  sizeOf _ = 12
  alignment = sizeOf
  peek p = do
    v0 <- peekByteOff p 0
    v1 <- peekByteOff p 4
    v2 <- peekByteOff p 8
    return $ C'gsl_odeiv_step v0 v1 v2
  poke p (C'gsl_odeiv_step v0 v1 v2) = do
    pokeByteOff p 0 v0
    pokeByteOff p 4 v1
    pokeByteOff p 8 v2
    return ()

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

foreign import ccall "&gsl_odeiv_step_rk2" p'gsl_odeiv_step_rk2
  :: Ptr (Ptr gsl_odeiv_step_type)

{-# LINE 37 "src/Bindings/Gsl/OrdinaryDifferentialEquations.hsc" #-}
foreign import ccall "&gsl_odeiv_step_rk4" p'gsl_odeiv_step_rk4
  :: Ptr (Ptr gsl_odeiv_step_type)

{-# LINE 38 "src/Bindings/Gsl/OrdinaryDifferentialEquations.hsc" #-}
foreign import ccall "&gsl_odeiv_step_rkf45" p'gsl_odeiv_step_rkf45
  :: Ptr (Ptr gsl_odeiv_step_type)

{-# LINE 39 "src/Bindings/Gsl/OrdinaryDifferentialEquations.hsc" #-}
foreign import ccall "&gsl_odeiv_step_rkck" p'gsl_odeiv_step_rkck
  :: Ptr (Ptr gsl_odeiv_step_type)

{-# LINE 40 "src/Bindings/Gsl/OrdinaryDifferentialEquations.hsc" #-}
foreign import ccall "&gsl_odeiv_step_rk8pd" p'gsl_odeiv_step_rk8pd
  :: Ptr (Ptr gsl_odeiv_step_type)

{-# LINE 41 "src/Bindings/Gsl/OrdinaryDifferentialEquations.hsc" #-}
foreign import ccall "&gsl_odeiv_step_rk2imp" p'gsl_odeiv_step_rk2imp
  :: Ptr (Ptr gsl_odeiv_step_type)

{-# LINE 42 "src/Bindings/Gsl/OrdinaryDifferentialEquations.hsc" #-}
foreign import ccall "&gsl_odeiv_step_rk2simp" p'gsl_odeiv_step_rk2simp
  :: Ptr (Ptr gsl_odeiv_step_type)

{-# LINE 43 "src/Bindings/Gsl/OrdinaryDifferentialEquations.hsc" #-}
foreign import ccall "&gsl_odeiv_step_rk4imp" p'gsl_odeiv_step_rk4imp
  :: Ptr (Ptr gsl_odeiv_step_type)

{-# LINE 44 "src/Bindings/Gsl/OrdinaryDifferentialEquations.hsc" #-}
foreign import ccall "&gsl_odeiv_step_bsimp" p'gsl_odeiv_step_bsimp
  :: Ptr (Ptr gsl_odeiv_step_type)

{-# LINE 45 "src/Bindings/Gsl/OrdinaryDifferentialEquations.hsc" #-}
foreign import ccall "&gsl_odeiv_step_gear1" p'gsl_odeiv_step_gear1
  :: Ptr (Ptr gsl_odeiv_step_type)

{-# LINE 46 "src/Bindings/Gsl/OrdinaryDifferentialEquations.hsc" #-}
foreign import ccall "&gsl_odeiv_step_gear2" p'gsl_odeiv_step_gear2
  :: Ptr (Ptr gsl_odeiv_step_type)

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

foreign import ccall "gsl_odeiv_step_alloc" c'gsl_odeiv_step_alloc
  :: Ptr C'gsl_odeiv_step_type -> CSize -> IO (Ptr C'gsl_odeiv_step)
foreign import ccall "&gsl_odeiv_step_alloc" p'gsl_odeiv_step_alloc
  :: FunPtr (Ptr C'gsl_odeiv_step_type -> CSize -> IO (Ptr C'gsl_odeiv_step))

{-# LINE 49 "src/Bindings/Gsl/OrdinaryDifferentialEquations.hsc" #-}
foreign import ccall "gsl_odeiv_step_reset" c'gsl_odeiv_step_reset
  :: Ptr C'gsl_odeiv_step -> IO CInt
foreign import ccall "&gsl_odeiv_step_reset" p'gsl_odeiv_step_reset
  :: FunPtr (Ptr C'gsl_odeiv_step -> IO CInt)

{-# LINE 50 "src/Bindings/Gsl/OrdinaryDifferentialEquations.hsc" #-}
foreign import ccall "gsl_odeiv_step_free" c'gsl_odeiv_step_free
  :: Ptr C'gsl_odeiv_step -> IO ()
foreign import ccall "&gsl_odeiv_step_free" p'gsl_odeiv_step_free
  :: FunPtr (Ptr C'gsl_odeiv_step -> IO ())

{-# LINE 51 "src/Bindings/Gsl/OrdinaryDifferentialEquations.hsc" #-}
foreign import ccall "gsl_odeiv_step_name" c'gsl_odeiv_step_name
  :: Ptr C'gsl_odeiv_step -> IO CString
foreign import ccall "&gsl_odeiv_step_name" p'gsl_odeiv_step_name
  :: FunPtr (Ptr C'gsl_odeiv_step -> IO CString)

{-# LINE 52 "src/Bindings/Gsl/OrdinaryDifferentialEquations.hsc" #-}
foreign import ccall "gsl_odeiv_step_order" c'gsl_odeiv_step_order
  :: Ptr C'gsl_odeiv_step -> IO CUInt
foreign import ccall "&gsl_odeiv_step_order" p'gsl_odeiv_step_order
  :: FunPtr (Ptr C'gsl_odeiv_step -> IO CUInt)

{-# LINE 53 "src/Bindings/Gsl/OrdinaryDifferentialEquations.hsc" #-}
foreign import ccall "gsl_odeiv_step_apply" c'gsl_odeiv_step_apply
  :: Ptr C'gsl_odeiv_step -> CDouble -> CDouble -> Ptr CDouble -> Ptr CDouble -> Ptr CDouble -> Ptr CDouble -> Ptr C'gsl_odeiv_system -> IO CInt
foreign import ccall "&gsl_odeiv_step_apply" p'gsl_odeiv_step_apply
  :: FunPtr (Ptr C'gsl_odeiv_step -> CDouble -> CDouble -> Ptr CDouble -> Ptr CDouble -> Ptr CDouble -> Ptr CDouble -> Ptr C'gsl_odeiv_system -> IO CInt)

{-# LINE 54 "src/Bindings/Gsl/OrdinaryDifferentialEquations.hsc" #-}

data C'gsl_odeiv_control_type = C'gsl_odeiv_control_type{
{-# LINE 56 "src/Bindings/Gsl/OrdinaryDifferentialEquations.hsc" #-}

  c'gsl_odeiv_control_type'name :: CString
{-# LINE 57 "src/Bindings/Gsl/OrdinaryDifferentialEquations.hsc" #-}
,
  c'gsl_odeiv_control_type'alloc :: FunPtr (IO (Ptr ()))
{-# LINE 58 "src/Bindings/Gsl/OrdinaryDifferentialEquations.hsc" #-}
,
  c'gsl_odeiv_control_type'init :: FunPtr (Ptr () -> CDouble -> CDouble -> CDouble -> CDouble -> IO CInt)
{-# LINE 59 "src/Bindings/Gsl/OrdinaryDifferentialEquations.hsc" #-}
,
  c'gsl_odeiv_control_type'hadjust :: FunPtr (Ptr () -> CSize -> CUInt -> Ptr CDouble -> Ptr CDouble -> Ptr CDouble -> Ptr CDouble -> IO CInt)
{-# LINE 60 "src/Bindings/Gsl/OrdinaryDifferentialEquations.hsc" #-}
,
  c'gsl_odeiv_control_type'free :: FunPtr (Ptr () -> IO ())
{-# LINE 61 "src/Bindings/Gsl/OrdinaryDifferentialEquations.hsc" #-}

 } deriving (Eq,Show)
instance Storable C'gsl_odeiv_control_type where
  sizeOf _ = 20
  alignment = sizeOf
  peek p = do
    v0 <- peekByteOff p 0
    v1 <- peekByteOff p 4
    v2 <- peekByteOff p 8
    v3 <- peekByteOff p 12
    v4 <- peekByteOff p 16
    return $ C'gsl_odeiv_control_type v0 v1 v2 v3 v4
  poke p (C'gsl_odeiv_control_type v0 v1 v2 v3 v4) = do
    pokeByteOff p 0 v0
    pokeByteOff p 4 v1
    pokeByteOff p 8 v2
    pokeByteOff p 12 v3
    pokeByteOff p 16 v4
    return ()

{-# LINE 62 "src/Bindings/Gsl/OrdinaryDifferentialEquations.hsc" #-}

data C'gsl_odeiv_control = C'gsl_odeiv_control{
{-# LINE 64 "src/Bindings/Gsl/OrdinaryDifferentialEquations.hsc" #-}

  c'gsl_odeiv_control'type :: Ptr C'gsl_odeiv_control_type
{-# LINE 65 "src/Bindings/Gsl/OrdinaryDifferentialEquations.hsc" #-}
,
  c'gsl_odeiv_control'state :: Ptr ()
{-# LINE 66 "src/Bindings/Gsl/OrdinaryDifferentialEquations.hsc" #-}

 } deriving (Eq,Show)
instance Storable C'gsl_odeiv_control where
  sizeOf _ = 8
  alignment = sizeOf
  peek p = do
    v0 <- peekByteOff p 0
    v1 <- peekByteOff p 4
    return $ C'gsl_odeiv_control v0 v1
  poke p (C'gsl_odeiv_control v0 v1) = do
    pokeByteOff p 0 v0
    pokeByteOff p 4 v1
    return ()

{-# LINE 67 "src/Bindings/Gsl/OrdinaryDifferentialEquations.hsc" #-}

c'GSL_ODEIV_HADJ_INC = 1
c'GSL_ODEIV_HADJ_INC :: (Num a) => a

{-# LINE 69 "src/Bindings/Gsl/OrdinaryDifferentialEquations.hsc" #-}
c'GSL_ODEIV_HADJ_NIL = 0
c'GSL_ODEIV_HADJ_NIL :: (Num a) => a

{-# LINE 70 "src/Bindings/Gsl/OrdinaryDifferentialEquations.hsc" #-}
c'GSL_ODEIV_HADJ_DEC = -1
c'GSL_ODEIV_HADJ_DEC :: (Num a) => a

{-# LINE 71 "src/Bindings/Gsl/OrdinaryDifferentialEquations.hsc" #-}

foreign import ccall "gsl_odeiv_control_alloc" c'gsl_odeiv_control_alloc
  :: Ptr C'gsl_odeiv_control_type -> IO (Ptr C'gsl_odeiv_control)
foreign import ccall "&gsl_odeiv_control_alloc" p'gsl_odeiv_control_alloc
  :: FunPtr (Ptr C'gsl_odeiv_control_type -> IO (Ptr C'gsl_odeiv_control))

{-# LINE 73 "src/Bindings/Gsl/OrdinaryDifferentialEquations.hsc" #-}
foreign import ccall "gsl_odeiv_control_init" c'gsl_odeiv_control_init
  :: Ptr C'gsl_odeiv_control -> CDouble -> CDouble -> CDouble -> CDouble -> IO CInt
foreign import ccall "&gsl_odeiv_control_init" p'gsl_odeiv_control_init
  :: FunPtr (Ptr C'gsl_odeiv_control -> CDouble -> CDouble -> CDouble -> CDouble -> IO CInt)

{-# LINE 74 "src/Bindings/Gsl/OrdinaryDifferentialEquations.hsc" #-}
foreign import ccall "gsl_odeiv_control_free" c'gsl_odeiv_control_free
  :: Ptr C'gsl_odeiv_control -> IO ()
foreign import ccall "&gsl_odeiv_control_free" p'gsl_odeiv_control_free
  :: FunPtr (Ptr C'gsl_odeiv_control -> IO ())

{-# LINE 75 "src/Bindings/Gsl/OrdinaryDifferentialEquations.hsc" #-}
foreign import ccall "gsl_odeiv_control_hadjust" c'gsl_odeiv_control_hadjust
  :: Ptr C'gsl_odeiv_control -> Ptr C'gsl_odeiv_step -> Ptr CDouble -> Ptr CDouble -> Ptr CDouble -> Ptr CDouble -> IO CInt
foreign import ccall "&gsl_odeiv_control_hadjust" p'gsl_odeiv_control_hadjust
  :: FunPtr (Ptr C'gsl_odeiv_control -> Ptr C'gsl_odeiv_step -> Ptr CDouble -> Ptr CDouble -> Ptr CDouble -> Ptr CDouble -> IO CInt)

{-# LINE 76 "src/Bindings/Gsl/OrdinaryDifferentialEquations.hsc" #-}
foreign import ccall "gsl_odeiv_control_name" c'gsl_odeiv_control_name
  :: Ptr C'gsl_odeiv_control -> IO CString
foreign import ccall "&gsl_odeiv_control_name" p'gsl_odeiv_control_name
  :: FunPtr (Ptr C'gsl_odeiv_control -> IO CString)

{-# LINE 77 "src/Bindings/Gsl/OrdinaryDifferentialEquations.hsc" #-}
foreign import ccall "gsl_odeiv_control_standard_new" c'gsl_odeiv_control_standard_new
  :: CDouble -> CDouble -> CDouble -> CDouble -> IO (Ptr C'gsl_odeiv_control)
foreign import ccall "&gsl_odeiv_control_standard_new" p'gsl_odeiv_control_standard_new
  :: FunPtr (CDouble -> CDouble -> CDouble -> CDouble -> IO (Ptr C'gsl_odeiv_control))

{-# LINE 78 "src/Bindings/Gsl/OrdinaryDifferentialEquations.hsc" #-}
foreign import ccall "gsl_odeiv_control_y_new" c'gsl_odeiv_control_y_new
  :: CDouble -> CDouble -> IO (Ptr C'gsl_odeiv_control)
foreign import ccall "&gsl_odeiv_control_y_new" p'gsl_odeiv_control_y_new
  :: FunPtr (CDouble -> CDouble -> IO (Ptr C'gsl_odeiv_control))

{-# LINE 79 "src/Bindings/Gsl/OrdinaryDifferentialEquations.hsc" #-}
foreign import ccall "gsl_odeiv_control_yp_new" c'gsl_odeiv_control_yp_new
  :: CDouble -> CDouble -> IO (Ptr C'gsl_odeiv_control)
foreign import ccall "&gsl_odeiv_control_yp_new" p'gsl_odeiv_control_yp_new
  :: FunPtr (CDouble -> CDouble -> IO (Ptr C'gsl_odeiv_control))

{-# LINE 80 "src/Bindings/Gsl/OrdinaryDifferentialEquations.hsc" #-}
foreign import ccall "gsl_odeiv_control_scaled_new" c'gsl_odeiv_control_scaled_new
  :: CDouble -> CDouble -> CDouble -> CDouble -> Ptr CDouble -> CSize -> IO (Ptr C'gsl_odeiv_control)
foreign import ccall "&gsl_odeiv_control_scaled_new" p'gsl_odeiv_control_scaled_new
  :: FunPtr (CDouble -> CDouble -> CDouble -> CDouble -> Ptr CDouble -> CSize -> IO (Ptr C'gsl_odeiv_control))

{-# LINE 81 "src/Bindings/Gsl/OrdinaryDifferentialEquations.hsc" #-}

data C'gsl_odeiv_evolve = C'gsl_odeiv_evolve{
{-# LINE 83 "src/Bindings/Gsl/OrdinaryDifferentialEquations.hsc" #-}

  c'gsl_odeiv_evolve'dimension :: CSize
{-# LINE 84 "src/Bindings/Gsl/OrdinaryDifferentialEquations.hsc" #-}
,
  c'gsl_odeiv_evolve'y0 :: Ptr CDouble
{-# LINE 85 "src/Bindings/Gsl/OrdinaryDifferentialEquations.hsc" #-}
,
  c'gsl_odeiv_evolve'yerr :: Ptr CDouble
{-# LINE 86 "src/Bindings/Gsl/OrdinaryDifferentialEquations.hsc" #-}
,
  c'gsl_odeiv_evolve'dydt_in :: Ptr CDouble
{-# LINE 87 "src/Bindings/Gsl/OrdinaryDifferentialEquations.hsc" #-}
,
  c'gsl_odeiv_evolve'dydt_out :: Ptr CDouble
{-# LINE 88 "src/Bindings/Gsl/OrdinaryDifferentialEquations.hsc" #-}
,
  c'gsl_odeiv_evolve'last_step :: CDouble
{-# LINE 89 "src/Bindings/Gsl/OrdinaryDifferentialEquations.hsc" #-}
,
  c'gsl_odeiv_evolve'count :: CULong
{-# LINE 90 "src/Bindings/Gsl/OrdinaryDifferentialEquations.hsc" #-}
,
  c'gsl_odeiv_evolve'failed_steps :: CULong
{-# LINE 91 "src/Bindings/Gsl/OrdinaryDifferentialEquations.hsc" #-}

 } deriving (Eq,Show)
instance Storable C'gsl_odeiv_evolve where
  sizeOf _ = 36
  alignment = sizeOf
  peek p = do
    v0 <- peekByteOff p 0
    v1 <- peekByteOff p 4
    v2 <- peekByteOff p 8
    v3 <- peekByteOff p 12
    v4 <- peekByteOff p 16
    v5 <- peekByteOff p 20
    v6 <- peekByteOff p 28
    v7 <- peekByteOff p 32
    return $ C'gsl_odeiv_evolve v0 v1 v2 v3 v4 v5 v6 v7
  poke p (C'gsl_odeiv_evolve v0 v1 v2 v3 v4 v5 v6 v7) = do
    pokeByteOff p 0 v0
    pokeByteOff p 4 v1
    pokeByteOff p 8 v2
    pokeByteOff p 12 v3
    pokeByteOff p 16 v4
    pokeByteOff p 20 v5
    pokeByteOff p 28 v6
    pokeByteOff p 32 v7
    return ()

{-# LINE 92 "src/Bindings/Gsl/OrdinaryDifferentialEquations.hsc" #-}

foreign import ccall "gsl_odeiv_evolve_alloc" c'gsl_odeiv_evolve_alloc
  :: CSize -> IO (Ptr C'gsl_odeiv_evolve)
foreign import ccall "&gsl_odeiv_evolve_alloc" p'gsl_odeiv_evolve_alloc
  :: FunPtr (CSize -> IO (Ptr C'gsl_odeiv_evolve))

{-# LINE 94 "src/Bindings/Gsl/OrdinaryDifferentialEquations.hsc" #-}
foreign import ccall "gsl_odeiv_evolve_apply" c'gsl_odeiv_evolve_apply
  :: Ptr C'gsl_odeiv_evolve -> Ptr C'gsl_odeiv_control -> Ptr C'gsl_odeiv_step -> Ptr C'gsl_odeiv_system -> Ptr CDouble -> CDouble -> Ptr CDouble -> Ptr CDouble -> IO CInt
foreign import ccall "&gsl_odeiv_evolve_apply" p'gsl_odeiv_evolve_apply
  :: FunPtr (Ptr C'gsl_odeiv_evolve -> Ptr C'gsl_odeiv_control -> Ptr C'gsl_odeiv_step -> Ptr C'gsl_odeiv_system -> Ptr CDouble -> CDouble -> Ptr CDouble -> Ptr CDouble -> IO CInt)

{-# LINE 95 "src/Bindings/Gsl/OrdinaryDifferentialEquations.hsc" #-}
foreign import ccall "gsl_odeiv_evolve_reset" c'gsl_odeiv_evolve_reset
  :: Ptr C'gsl_odeiv_evolve -> IO CInt
foreign import ccall "&gsl_odeiv_evolve_reset" p'gsl_odeiv_evolve_reset
  :: FunPtr (Ptr C'gsl_odeiv_evolve -> IO CInt)

{-# LINE 96 "src/Bindings/Gsl/OrdinaryDifferentialEquations.hsc" #-}
foreign import ccall "gsl_odeiv_evolve_free" c'gsl_odeiv_evolve_free
  :: Ptr C'gsl_odeiv_evolve -> IO ()
foreign import ccall "&gsl_odeiv_evolve_free" p'gsl_odeiv_evolve_free
  :: FunPtr (Ptr C'gsl_odeiv_evolve -> IO ())

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