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

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

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

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

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


{-# LINE 11 "src/Bindings/Gsl/NumericalIntegration.hsc" #-}

{-# LINE 12 "src/Bindings/Gsl/NumericalIntegration.hsc" #-}

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

{-# LINE 14 "src/Bindings/Gsl/NumericalIntegration.hsc" #-}

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

{-# LINE 16 "src/Bindings/Gsl/NumericalIntegration.hsc" #-}

{-# LINE 17 "src/Bindings/Gsl/NumericalIntegration.hsc" #-}

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

{-# LINE 19 "src/Bindings/Gsl/NumericalIntegration.hsc" #-}

{-# LINE 20 "src/Bindings/Gsl/NumericalIntegration.hsc" #-}

{-# LINE 21 "src/Bindings/Gsl/NumericalIntegration.hsc" #-}

{-# LINE 22 "src/Bindings/Gsl/NumericalIntegration.hsc" #-}
data C'gsl_integration_workspace = C'gsl_integration_workspace{
  c'gsl_integration_workspace'limit :: CSize,
  c'gsl_integration_workspace'size :: CSize,
  c'gsl_integration_workspace'nrmax :: CSize,
  c'gsl_integration_workspace'i :: CSize,
  c'gsl_integration_workspace'maximum_level :: CSize,
  c'gsl_integration_workspace'alist :: Ptr CDouble,
  c'gsl_integration_workspace'blist :: Ptr CDouble,
  c'gsl_integration_workspace'rlist :: Ptr CDouble,
  c'gsl_integration_workspace'elist :: Ptr CDouble,
  c'gsl_integration_workspace'order :: Ptr CSize,
  c'gsl_integration_workspace'level :: Ptr CSize
} deriving (Eq,Show)
p'gsl_integration_workspace'limit p = plusPtr p 0
p'gsl_integration_workspace'limit :: Ptr (C'gsl_integration_workspace) -> Ptr (CSize)
p'gsl_integration_workspace'size p = plusPtr p 4
p'gsl_integration_workspace'size :: Ptr (C'gsl_integration_workspace) -> Ptr (CSize)
p'gsl_integration_workspace'nrmax p = plusPtr p 8
p'gsl_integration_workspace'nrmax :: Ptr (C'gsl_integration_workspace) -> Ptr (CSize)
p'gsl_integration_workspace'i p = plusPtr p 12
p'gsl_integration_workspace'i :: Ptr (C'gsl_integration_workspace) -> Ptr (CSize)
p'gsl_integration_workspace'maximum_level p = plusPtr p 16
p'gsl_integration_workspace'maximum_level :: Ptr (C'gsl_integration_workspace) -> Ptr (CSize)
p'gsl_integration_workspace'alist p = plusPtr p 20
p'gsl_integration_workspace'alist :: Ptr (C'gsl_integration_workspace) -> Ptr (Ptr CDouble)
p'gsl_integration_workspace'blist p = plusPtr p 24
p'gsl_integration_workspace'blist :: Ptr (C'gsl_integration_workspace) -> Ptr (Ptr CDouble)
p'gsl_integration_workspace'rlist p = plusPtr p 28
p'gsl_integration_workspace'rlist :: Ptr (C'gsl_integration_workspace) -> Ptr (Ptr CDouble)
p'gsl_integration_workspace'elist p = plusPtr p 32
p'gsl_integration_workspace'elist :: Ptr (C'gsl_integration_workspace) -> Ptr (Ptr CDouble)
p'gsl_integration_workspace'order p = plusPtr p 36
p'gsl_integration_workspace'order :: Ptr (C'gsl_integration_workspace) -> Ptr (Ptr CSize)
p'gsl_integration_workspace'level p = plusPtr p 40
p'gsl_integration_workspace'level :: Ptr (C'gsl_integration_workspace) -> Ptr (Ptr CSize)
instance Storable C'gsl_integration_workspace where
  sizeOf _ = 44
  alignment _ = 4
  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
    v8 <- peekByteOff p 32
    v9 <- peekByteOff p 36
    v10 <- peekByteOff p 40
    return $ C'gsl_integration_workspace v0 v1 v2 v3 v4 v5 v6 v7 v8 v9 v10
  poke p (C'gsl_integration_workspace v0 v1 v2 v3 v4 v5 v6 v7 v8 v9 v10) = 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
    pokeByteOff p 32 v8
    pokeByteOff p 36 v9
    pokeByteOff p 40 v10
    return ()

{-# LINE 23 "src/Bindings/Gsl/NumericalIntegration.hsc" #-}


{-# LINE 25 "src/Bindings/Gsl/NumericalIntegration.hsc" #-}

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

{-# LINE 27 "src/Bindings/Gsl/NumericalIntegration.hsc" #-}

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

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

{-# LINE 30 "src/Bindings/Gsl/NumericalIntegration.hsc" #-}

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

{-# LINE 32 "src/Bindings/Gsl/NumericalIntegration.hsc" #-}

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

{-# LINE 34 "src/Bindings/Gsl/NumericalIntegration.hsc" #-}
data C'gsl_integration_cquad_ival = C'gsl_integration_cquad_ival{
  c'gsl_integration_cquad_ival'a :: CDouble,
  c'gsl_integration_cquad_ival'b :: CDouble,
  c'gsl_integration_cquad_ival'c :: [CDouble],
  c'gsl_integration_cquad_ival'fx :: [CDouble],
  c'gsl_integration_cquad_ival'igral :: CDouble,
  c'gsl_integration_cquad_ival'err :: CDouble,
  c'gsl_integration_cquad_ival'depth :: CInt,
  c'gsl_integration_cquad_ival'rdepth :: CInt,
  c'gsl_integration_cquad_ival'ndiv :: CInt
} deriving (Eq,Show)
p'gsl_integration_cquad_ival'a p = plusPtr p 0
p'gsl_integration_cquad_ival'a :: Ptr (C'gsl_integration_cquad_ival) -> Ptr (CDouble)
p'gsl_integration_cquad_ival'b p = plusPtr p 8
p'gsl_integration_cquad_ival'b :: Ptr (C'gsl_integration_cquad_ival) -> Ptr (CDouble)
p'gsl_integration_cquad_ival'c p = plusPtr p 16
p'gsl_integration_cquad_ival'c :: Ptr (C'gsl_integration_cquad_ival) -> Ptr (CDouble)
p'gsl_integration_cquad_ival'fx p = plusPtr p 528
p'gsl_integration_cquad_ival'fx :: Ptr (C'gsl_integration_cquad_ival) -> Ptr (CDouble)
p'gsl_integration_cquad_ival'igral p = plusPtr p 792
p'gsl_integration_cquad_ival'igral :: Ptr (C'gsl_integration_cquad_ival) -> Ptr (CDouble)
p'gsl_integration_cquad_ival'err p = plusPtr p 800
p'gsl_integration_cquad_ival'err :: Ptr (C'gsl_integration_cquad_ival) -> Ptr (CDouble)
p'gsl_integration_cquad_ival'depth p = plusPtr p 808
p'gsl_integration_cquad_ival'depth :: Ptr (C'gsl_integration_cquad_ival) -> Ptr (CInt)
p'gsl_integration_cquad_ival'rdepth p = plusPtr p 812
p'gsl_integration_cquad_ival'rdepth :: Ptr (C'gsl_integration_cquad_ival) -> Ptr (CInt)
p'gsl_integration_cquad_ival'ndiv p = plusPtr p 816
p'gsl_integration_cquad_ival'ndiv :: Ptr (C'gsl_integration_cquad_ival) -> Ptr (CInt)
instance Storable C'gsl_integration_cquad_ival where
  sizeOf _ = 820
  alignment _ = 4
  peek p = do
    v0 <- peekByteOff p 0
    v1 <- peekByteOff p 8
    v2 <- let s = div 512 $ sizeOf $ (undefined :: CDouble) in peekArray s (plusPtr p 16)
    v3 <- let s = div 264 $ sizeOf $ (undefined :: CDouble) in peekArray s (plusPtr p 528)
    v4 <- peekByteOff p 792
    v5 <- peekByteOff p 800
    v6 <- peekByteOff p 808
    v7 <- peekByteOff p 812
    v8 <- peekByteOff p 816
    return $ C'gsl_integration_cquad_ival v0 v1 v2 v3 v4 v5 v6 v7 v8
  poke p (C'gsl_integration_cquad_ival v0 v1 v2 v3 v4 v5 v6 v7 v8) = do
    pokeByteOff p 0 v0
    pokeByteOff p 8 v1
    let s = div 512 $ sizeOf $ (undefined :: CDouble)
    pokeArray (plusPtr p 16) (take s v2)
    let s = div 264 $ sizeOf $ (undefined :: CDouble)
    pokeArray (plusPtr p 528) (take s v3)
    pokeByteOff p 792 v4
    pokeByteOff p 800 v5
    pokeByteOff p 808 v6
    pokeByteOff p 812 v7
    pokeByteOff p 816 v8
    return ()

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


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

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

{-# LINE 39 "src/Bindings/Gsl/NumericalIntegration.hsc" #-}

{-# LINE 40 "src/Bindings/Gsl/NumericalIntegration.hsc" #-}
data C'gsl_integration_cquad_workspace = C'gsl_integration_cquad_workspace{
  c'gsl_integration_cquad_workspace'size :: CSize,
  c'gsl_integration_cquad_workspace'ivals :: Ptr C'gsl_integration_cquad_ival,
  c'gsl_integration_cquad_workspace'heap :: Ptr CSize
} deriving (Eq,Show)
p'gsl_integration_cquad_workspace'size p = plusPtr p 0
p'gsl_integration_cquad_workspace'size :: Ptr (C'gsl_integration_cquad_workspace) -> Ptr (CSize)
p'gsl_integration_cquad_workspace'ivals p = plusPtr p 4
p'gsl_integration_cquad_workspace'ivals :: Ptr (C'gsl_integration_cquad_workspace) -> Ptr (Ptr C'gsl_integration_cquad_ival)
p'gsl_integration_cquad_workspace'heap p = plusPtr p 8
p'gsl_integration_cquad_workspace'heap :: Ptr (C'gsl_integration_cquad_workspace) -> Ptr (Ptr CSize)
instance Storable C'gsl_integration_cquad_workspace where
  sizeOf _ = 12
  alignment _ = 4
  peek p = do
    v0 <- peekByteOff p 0
    v1 <- peekByteOff p 4
    v2 <- peekByteOff p 8
    return $ C'gsl_integration_cquad_workspace v0 v1 v2
  poke p (C'gsl_integration_cquad_workspace v0 v1 v2) = do
    pokeByteOff p 0 v0
    pokeByteOff p 4 v1
    pokeByteOff p 8 v2
    return ()

{-# LINE 41 "src/Bindings/Gsl/NumericalIntegration.hsc" #-}

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

{-# LINE 43 "src/Bindings/Gsl/NumericalIntegration.hsc" #-}
foreign import ccall "gsl_integration_workspace_free" c'gsl_integration_workspace_free
  :: Ptr C'gsl_integration_workspace -> IO ()
foreign import ccall "&gsl_integration_workspace_free" p'gsl_integration_workspace_free
  :: FunPtr (Ptr C'gsl_integration_workspace -> IO ())

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


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

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

{-# LINE 48 "src/Bindings/Gsl/NumericalIntegration.hsc" #-}

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

{-# LINE 50 "src/Bindings/Gsl/NumericalIntegration.hsc" #-}

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

{-# LINE 52 "src/Bindings/Gsl/NumericalIntegration.hsc" #-}

{-# LINE 53 "src/Bindings/Gsl/NumericalIntegration.hsc" #-}

{-# LINE 54 "src/Bindings/Gsl/NumericalIntegration.hsc" #-}
data C'gsl_integration_qaws_table = C'gsl_integration_qaws_table{
  c'gsl_integration_qaws_table'alpha :: CDouble,
  c'gsl_integration_qaws_table'beta :: CDouble,
  c'gsl_integration_qaws_table'mu :: CInt,
  c'gsl_integration_qaws_table'nu :: CInt,
  c'gsl_integration_qaws_table'ri :: [CDouble],
  c'gsl_integration_qaws_table'rj :: [CDouble],
  c'gsl_integration_qaws_table'rg :: [CDouble],
  c'gsl_integration_qaws_table'rh :: [CDouble]
} deriving (Eq,Show)
p'gsl_integration_qaws_table'alpha p = plusPtr p 0
p'gsl_integration_qaws_table'alpha :: Ptr (C'gsl_integration_qaws_table) -> Ptr (CDouble)
p'gsl_integration_qaws_table'beta p = plusPtr p 8
p'gsl_integration_qaws_table'beta :: Ptr (C'gsl_integration_qaws_table) -> Ptr (CDouble)
p'gsl_integration_qaws_table'mu p = plusPtr p 16
p'gsl_integration_qaws_table'mu :: Ptr (C'gsl_integration_qaws_table) -> Ptr (CInt)
p'gsl_integration_qaws_table'nu p = plusPtr p 20
p'gsl_integration_qaws_table'nu :: Ptr (C'gsl_integration_qaws_table) -> Ptr (CInt)
p'gsl_integration_qaws_table'ri p = plusPtr p 24
p'gsl_integration_qaws_table'ri :: Ptr (C'gsl_integration_qaws_table) -> Ptr (CDouble)
p'gsl_integration_qaws_table'rj p = plusPtr p 224
p'gsl_integration_qaws_table'rj :: Ptr (C'gsl_integration_qaws_table) -> Ptr (CDouble)
p'gsl_integration_qaws_table'rg p = plusPtr p 424
p'gsl_integration_qaws_table'rg :: Ptr (C'gsl_integration_qaws_table) -> Ptr (CDouble)
p'gsl_integration_qaws_table'rh p = plusPtr p 624
p'gsl_integration_qaws_table'rh :: Ptr (C'gsl_integration_qaws_table) -> Ptr (CDouble)
instance Storable C'gsl_integration_qaws_table where
  sizeOf _ = 824
  alignment _ = 4
  peek p = do
    v0 <- peekByteOff p 0
    v1 <- peekByteOff p 8
    v2 <- peekByteOff p 16
    v3 <- peekByteOff p 20
    v4 <- let s = div 200 $ sizeOf $ (undefined :: CDouble) in peekArray s (plusPtr p 24)
    v5 <- let s = div 200 $ sizeOf $ (undefined :: CDouble) in peekArray s (plusPtr p 224)
    v6 <- let s = div 200 $ sizeOf $ (undefined :: CDouble) in peekArray s (plusPtr p 424)
    v7 <- let s = div 200 $ sizeOf $ (undefined :: CDouble) in peekArray s (plusPtr p 624)
    return $ C'gsl_integration_qaws_table v0 v1 v2 v3 v4 v5 v6 v7
  poke p (C'gsl_integration_qaws_table v0 v1 v2 v3 v4 v5 v6 v7) = do
    pokeByteOff p 0 v0
    pokeByteOff p 8 v1
    pokeByteOff p 16 v2
    pokeByteOff p 20 v3
    let s = div 200 $ sizeOf $ (undefined :: CDouble)
    pokeArray (plusPtr p 24) (take s v4)
    let s = div 200 $ sizeOf $ (undefined :: CDouble)
    pokeArray (plusPtr p 224) (take s v5)
    let s = div 200 $ sizeOf $ (undefined :: CDouble)
    pokeArray (plusPtr p 424) (take s v6)
    let s = div 200 $ sizeOf $ (undefined :: CDouble)
    pokeArray (plusPtr p 624) (take s v7)
    return ()

{-# LINE 55 "src/Bindings/Gsl/NumericalIntegration.hsc" #-}

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

{-# LINE 57 "src/Bindings/Gsl/NumericalIntegration.hsc" #-}
foreign import ccall "gsl_integration_qaws_table_set" c'gsl_integration_qaws_table_set
  :: Ptr C'gsl_integration_qaws_table -> CDouble -> CDouble -> CInt -> CInt -> CInt -> IO CInt
foreign import ccall "&gsl_integration_qaws_table_set" p'gsl_integration_qaws_table_set
  :: FunPtr (Ptr C'gsl_integration_qaws_table -> CDouble -> CDouble -> CInt -> CInt -> CInt -> IO CInt)

{-# LINE 58 "src/Bindings/Gsl/NumericalIntegration.hsc" #-}
foreign import ccall "gsl_integration_qaws_table_free" c'gsl_integration_qaws_table_free
  :: Ptr C'gsl_integration_qaws_table -> IO ()
foreign import ccall "&gsl_integration_qaws_table_free" p'gsl_integration_qaws_table_free
  :: FunPtr (Ptr C'gsl_integration_qaws_table -> IO ())

{-# LINE 59 "src/Bindings/Gsl/NumericalIntegration.hsc" #-}

type C'gsl_integration_qawo_enum = CUInt

{-# LINE 61 "src/Bindings/Gsl/NumericalIntegration.hsc" #-}
c'GSL_INTEG_COSINE = 0
c'GSL_INTEG_COSINE :: (Num a) => a

{-# LINE 62 "src/Bindings/Gsl/NumericalIntegration.hsc" #-}
c'GSL_INTEG_SINE = 1
c'GSL_INTEG_SINE :: (Num a) => a

{-# LINE 63 "src/Bindings/Gsl/NumericalIntegration.hsc" #-}


{-# LINE 65 "src/Bindings/Gsl/NumericalIntegration.hsc" #-}

{-# LINE 66 "src/Bindings/Gsl/NumericalIntegration.hsc" #-}

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

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

{-# LINE 69 "src/Bindings/Gsl/NumericalIntegration.hsc" #-}

{-# LINE 70 "src/Bindings/Gsl/NumericalIntegration.hsc" #-}

{-# LINE 71 "src/Bindings/Gsl/NumericalIntegration.hsc" #-}
data C'gsl_integration_qawo_table = C'gsl_integration_qawo_table{
  c'gsl_integration_qawo_table'n :: CSize,
  c'gsl_integration_qawo_table'omega :: CDouble,
  c'gsl_integration_qawo_table'L :: CDouble,
  c'gsl_integration_qawo_table'par :: CDouble,
  c'gsl_integration_qawo_table'sine :: C'gsl_integration_qawo_enum,
  c'gsl_integration_qawo_table'chebmo :: Ptr CDouble
} deriving (Eq,Show)
p'gsl_integration_qawo_table'n p = plusPtr p 0
p'gsl_integration_qawo_table'n :: Ptr (C'gsl_integration_qawo_table) -> Ptr (CSize)
p'gsl_integration_qawo_table'omega p = plusPtr p 4
p'gsl_integration_qawo_table'omega :: Ptr (C'gsl_integration_qawo_table) -> Ptr (CDouble)
p'gsl_integration_qawo_table'L p = plusPtr p 12
p'gsl_integration_qawo_table'L :: Ptr (C'gsl_integration_qawo_table) -> Ptr (CDouble)
p'gsl_integration_qawo_table'par p = plusPtr p 20
p'gsl_integration_qawo_table'par :: Ptr (C'gsl_integration_qawo_table) -> Ptr (CDouble)
p'gsl_integration_qawo_table'sine p = plusPtr p 28
p'gsl_integration_qawo_table'sine :: Ptr (C'gsl_integration_qawo_table) -> Ptr (C'gsl_integration_qawo_enum)
p'gsl_integration_qawo_table'chebmo p = plusPtr p 32
p'gsl_integration_qawo_table'chebmo :: Ptr (C'gsl_integration_qawo_table) -> Ptr (Ptr CDouble)
instance Storable C'gsl_integration_qawo_table where
  sizeOf _ = 36
  alignment _ = 4
  peek p = do
    v0 <- peekByteOff p 0
    v1 <- peekByteOff p 4
    v2 <- peekByteOff p 12
    v3 <- peekByteOff p 20
    v4 <- peekByteOff p 28
    v5 <- peekByteOff p 32
    return $ C'gsl_integration_qawo_table v0 v1 v2 v3 v4 v5
  poke p (C'gsl_integration_qawo_table v0 v1 v2 v3 v4 v5) = do
    pokeByteOff p 0 v0
    pokeByteOff p 4 v1
    pokeByteOff p 12 v2
    pokeByteOff p 20 v3
    pokeByteOff p 28 v4
    pokeByteOff p 32 v5
    return ()

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

foreign import ccall "gsl_integration_qawo_table_alloc" c'gsl_integration_qawo_table_alloc
  :: CDouble -> CDouble -> C'gsl_integration_qawo_enum -> CSize -> IO (Ptr C'gsl_integration_qawo_table)
foreign import ccall "&gsl_integration_qawo_table_alloc" p'gsl_integration_qawo_table_alloc
  :: FunPtr (CDouble -> CDouble -> C'gsl_integration_qawo_enum -> CSize -> IO (Ptr C'gsl_integration_qawo_table))

{-# LINE 74 "src/Bindings/Gsl/NumericalIntegration.hsc" #-}
foreign import ccall "gsl_integration_qawo_table_set" c'gsl_integration_qawo_table_set
  :: Ptr C'gsl_integration_qawo_table -> CDouble -> CDouble -> C'gsl_integration_qawo_enum -> IO CInt
foreign import ccall "&gsl_integration_qawo_table_set" p'gsl_integration_qawo_table_set
  :: FunPtr (Ptr C'gsl_integration_qawo_table -> CDouble -> CDouble -> C'gsl_integration_qawo_enum -> IO CInt)

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

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

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

type C'gsl_integration_rule = FunPtr (Ptr C'gsl_function -> CDouble -> CDouble -> Ptr CDouble -> Ptr CDouble -> Ptr CDouble -> Ptr CDouble -> IO ())
foreign import ccall "wrapper" mk'gsl_integration_rule
  :: (Ptr C'gsl_function -> CDouble -> CDouble -> Ptr CDouble -> Ptr CDouble -> Ptr CDouble -> Ptr CDouble -> IO ()) -> IO C'gsl_integration_rule
foreign import ccall "dynamic" mK'gsl_integration_rule
  :: C'gsl_integration_rule -> (Ptr C'gsl_function -> CDouble -> CDouble -> Ptr CDouble -> Ptr CDouble -> Ptr CDouble -> Ptr CDouble -> IO ())

{-# LINE 79 "src/Bindings/Gsl/NumericalIntegration.hsc" #-}

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

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

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

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

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

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

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

{-# LINE 87 "src/Bindings/Gsl/NumericalIntegration.hsc" #-}

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

{-# LINE 89 "src/Bindings/Gsl/NumericalIntegration.hsc" #-}
c'GSL_INTEG_GAUSS21 = 2
c'GSL_INTEG_GAUSS21 :: (Num a) => a

{-# LINE 90 "src/Bindings/Gsl/NumericalIntegration.hsc" #-}
c'GSL_INTEG_GAUSS31 = 3
c'GSL_INTEG_GAUSS31 :: (Num a) => a

{-# LINE 91 "src/Bindings/Gsl/NumericalIntegration.hsc" #-}
c'GSL_INTEG_GAUSS41 = 4
c'GSL_INTEG_GAUSS41 :: (Num a) => a

{-# LINE 92 "src/Bindings/Gsl/NumericalIntegration.hsc" #-}
c'GSL_INTEG_GAUSS51 = 5
c'GSL_INTEG_GAUSS51 :: (Num a) => a

{-# LINE 93 "src/Bindings/Gsl/NumericalIntegration.hsc" #-}
c'GSL_INTEG_GAUSS61 = 6
c'GSL_INTEG_GAUSS61 :: (Num a) => a

{-# LINE 94 "src/Bindings/Gsl/NumericalIntegration.hsc" #-}

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

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

{-# LINE 97 "src/Bindings/Gsl/NumericalIntegration.hsc" #-}
foreign import ccall "gsl_integration_qag" c'gsl_integration_qag
  :: Ptr C'gsl_function -> CDouble -> CDouble -> CDouble -> CDouble -> CSize -> CInt -> CInt -> Ptr C'gsl_integration_workspace -> Ptr CDouble -> Ptr CDouble -> IO CInt
foreign import ccall "&gsl_integration_qag" p'gsl_integration_qag
  :: FunPtr (Ptr C'gsl_function -> CDouble -> CDouble -> CDouble -> CDouble -> CSize -> CInt -> CInt -> Ptr C'gsl_integration_workspace -> Ptr CDouble -> Ptr CDouble -> IO CInt)

{-# LINE 98 "src/Bindings/Gsl/NumericalIntegration.hsc" #-}
foreign import ccall "gsl_integration_qagi" c'gsl_integration_qagi
  :: Ptr C'gsl_function -> CDouble -> CDouble -> CSize -> Ptr C'gsl_integration_workspace -> Ptr CDouble -> Ptr CDouble -> IO CInt
foreign import ccall "&gsl_integration_qagi" p'gsl_integration_qagi
  :: FunPtr (Ptr C'gsl_function -> CDouble -> CDouble -> CSize -> Ptr C'gsl_integration_workspace -> Ptr CDouble -> Ptr CDouble -> IO CInt)

{-# LINE 99 "src/Bindings/Gsl/NumericalIntegration.hsc" #-}
foreign import ccall "gsl_integration_qagiu" c'gsl_integration_qagiu
  :: Ptr C'gsl_function -> CDouble -> CDouble -> CDouble -> CSize -> Ptr C'gsl_integration_workspace -> Ptr CDouble -> Ptr CDouble -> IO CInt
foreign import ccall "&gsl_integration_qagiu" p'gsl_integration_qagiu
  :: FunPtr (Ptr C'gsl_function -> CDouble -> CDouble -> CDouble -> CSize -> Ptr C'gsl_integration_workspace -> Ptr CDouble -> Ptr CDouble -> IO CInt)

{-# LINE 100 "src/Bindings/Gsl/NumericalIntegration.hsc" #-}
foreign import ccall "gsl_integration_qagil" c'gsl_integration_qagil
  :: Ptr C'gsl_function -> CDouble -> CDouble -> CDouble -> CSize -> Ptr C'gsl_integration_workspace -> Ptr CDouble -> Ptr CDouble -> IO CInt
foreign import ccall "&gsl_integration_qagil" p'gsl_integration_qagil
  :: FunPtr (Ptr C'gsl_function -> CDouble -> CDouble -> CDouble -> CSize -> Ptr C'gsl_integration_workspace -> Ptr CDouble -> Ptr CDouble -> IO CInt)

{-# LINE 101 "src/Bindings/Gsl/NumericalIntegration.hsc" #-}
foreign import ccall "gsl_integration_qags" c'gsl_integration_qags
  :: Ptr C'gsl_function -> CDouble -> CDouble -> CDouble -> CDouble -> CSize -> Ptr C'gsl_integration_workspace -> Ptr CDouble -> Ptr CDouble -> IO CInt
foreign import ccall "&gsl_integration_qags" p'gsl_integration_qags
  :: FunPtr (Ptr C'gsl_function -> CDouble -> CDouble -> CDouble -> CDouble -> CSize -> Ptr C'gsl_integration_workspace -> Ptr CDouble -> Ptr CDouble -> IO CInt)

{-# LINE 102 "src/Bindings/Gsl/NumericalIntegration.hsc" #-}
foreign import ccall "gsl_integration_qagp" c'gsl_integration_qagp
  :: Ptr C'gsl_function -> Ptr CDouble -> CSize -> CDouble -> CDouble -> CSize -> Ptr C'gsl_integration_workspace -> Ptr CDouble -> Ptr CDouble -> IO CInt
foreign import ccall "&gsl_integration_qagp" p'gsl_integration_qagp
  :: FunPtr (Ptr C'gsl_function -> Ptr CDouble -> CSize -> CDouble -> CDouble -> CSize -> Ptr C'gsl_integration_workspace -> Ptr CDouble -> Ptr CDouble -> IO CInt)

{-# LINE 103 "src/Bindings/Gsl/NumericalIntegration.hsc" #-}
foreign import ccall "gsl_integration_qawc" c'gsl_integration_qawc
  :: Ptr C'gsl_function -> CDouble -> CDouble -> CDouble -> CDouble -> CDouble -> CSize -> Ptr C'gsl_integration_workspace -> Ptr CDouble -> Ptr CDouble -> IO CInt
foreign import ccall "&gsl_integration_qawc" p'gsl_integration_qawc
  :: FunPtr (Ptr C'gsl_function -> CDouble -> CDouble -> CDouble -> CDouble -> CDouble -> CSize -> Ptr C'gsl_integration_workspace -> Ptr CDouble -> Ptr CDouble -> IO CInt)

{-# LINE 104 "src/Bindings/Gsl/NumericalIntegration.hsc" #-}
foreign import ccall "gsl_integration_qaws" c'gsl_integration_qaws
  :: Ptr C'gsl_function -> CDouble -> CDouble -> Ptr C'gsl_integration_qaws_table -> CDouble -> CDouble -> CSize -> Ptr C'gsl_integration_workspace -> Ptr CDouble -> Ptr CDouble -> IO CInt
foreign import ccall "&gsl_integration_qaws" p'gsl_integration_qaws
  :: FunPtr (Ptr C'gsl_function -> CDouble -> CDouble -> Ptr C'gsl_integration_qaws_table -> CDouble -> CDouble -> CSize -> Ptr C'gsl_integration_workspace -> Ptr CDouble -> Ptr CDouble -> IO CInt)

{-# LINE 105 "src/Bindings/Gsl/NumericalIntegration.hsc" #-}
foreign import ccall "gsl_integration_qawo" c'gsl_integration_qawo
  :: Ptr C'gsl_function -> CDouble -> CDouble -> CDouble -> CSize -> Ptr C'gsl_integration_workspace -> Ptr C'gsl_integration_qawo_table -> Ptr CDouble -> Ptr CDouble -> IO CInt
foreign import ccall "&gsl_integration_qawo" p'gsl_integration_qawo
  :: FunPtr (Ptr C'gsl_function -> CDouble -> CDouble -> CDouble -> CSize -> Ptr C'gsl_integration_workspace -> Ptr C'gsl_integration_qawo_table -> Ptr CDouble -> Ptr CDouble -> IO CInt)

{-# LINE 106 "src/Bindings/Gsl/NumericalIntegration.hsc" #-}
foreign import ccall "gsl_integration_qawf" c'gsl_integration_qawf
  :: Ptr C'gsl_function -> CDouble -> CDouble -> CSize -> Ptr C'gsl_integration_workspace -> Ptr C'gsl_integration_workspace -> Ptr C'gsl_integration_qawo_table -> Ptr CDouble -> Ptr CDouble -> IO CInt
foreign import ccall "&gsl_integration_qawf" p'gsl_integration_qawf
  :: FunPtr (Ptr C'gsl_function -> CDouble -> CDouble -> CSize -> Ptr C'gsl_integration_workspace -> Ptr C'gsl_integration_workspace -> Ptr C'gsl_integration_qawo_table -> Ptr CDouble -> Ptr CDouble -> IO CInt)

{-# LINE 107 "src/Bindings/Gsl/NumericalIntegration.hsc" #-}

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

{-# LINE 110 "src/Bindings/Gsl/NumericalIntegration.hsc" #-}
foreign import ccall "gsl_integration_cquad_workspace_free" c'gsl_integration_cquad_workspace_free
  :: Ptr C'gsl_integration_cquad_workspace -> IO ()
foreign import ccall "&gsl_integration_cquad_workspace_free" p'gsl_integration_cquad_workspace_free
  :: FunPtr (Ptr C'gsl_integration_cquad_workspace -> IO ())

{-# LINE 112 "src/Bindings/Gsl/NumericalIntegration.hsc" #-}
foreign import ccall "gsl_integration_cquad" c'gsl_integration_cquad
  :: Ptr C'gsl_function -> CDouble -> CDouble -> CDouble -> CDouble -> Ptr C'gsl_integration_cquad_workspace -> Ptr CDouble -> Ptr CDouble -> Ptr CSize -> IO CInt
foreign import ccall "&gsl_integration_cquad" p'gsl_integration_cquad
  :: FunPtr (Ptr C'gsl_function -> CDouble -> CDouble -> CDouble -> CDouble -> Ptr C'gsl_integration_cquad_workspace -> Ptr CDouble -> Ptr CDouble -> Ptr CSize -> IO CInt)

{-# LINE 115 "src/Bindings/Gsl/NumericalIntegration.hsc" #-}


{-# LINE 117 "src/Bindings/Gsl/NumericalIntegration.hsc" #-}

{-# LINE 118 "src/Bindings/Gsl/NumericalIntegration.hsc" #-}

{-# LINE 119 "src/Bindings/Gsl/NumericalIntegration.hsc" #-}

{-# LINE 120 "src/Bindings/Gsl/NumericalIntegration.hsc" #-}

{-# LINE 121 "src/Bindings/Gsl/NumericalIntegration.hsc" #-}
data C'gsl_integration_glfixed_table = C'gsl_integration_glfixed_table{
  c'gsl_integration_glfixed_table'n :: CSize,
  c'gsl_integration_glfixed_table'x :: Ptr CDouble,
  c'gsl_integration_glfixed_table'w :: Ptr CDouble,
  c'gsl_integration_glfixed_table'precomputed :: CInt
} deriving (Eq,Show)
p'gsl_integration_glfixed_table'n p = plusPtr p 0
p'gsl_integration_glfixed_table'n :: Ptr (C'gsl_integration_glfixed_table) -> Ptr (CSize)
p'gsl_integration_glfixed_table'x p = plusPtr p 4
p'gsl_integration_glfixed_table'x :: Ptr (C'gsl_integration_glfixed_table) -> Ptr (Ptr CDouble)
p'gsl_integration_glfixed_table'w p = plusPtr p 8
p'gsl_integration_glfixed_table'w :: Ptr (C'gsl_integration_glfixed_table) -> Ptr (Ptr CDouble)
p'gsl_integration_glfixed_table'precomputed p = plusPtr p 12
p'gsl_integration_glfixed_table'precomputed :: Ptr (C'gsl_integration_glfixed_table) -> Ptr (CInt)
instance Storable C'gsl_integration_glfixed_table 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_integration_glfixed_table v0 v1 v2 v3
  poke p (C'gsl_integration_glfixed_table v0 v1 v2 v3) = do
    pokeByteOff p 0 v0
    pokeByteOff p 4 v1
    pokeByteOff p 8 v2
    pokeByteOff p 12 v3
    return ()

{-# LINE 122 "src/Bindings/Gsl/NumericalIntegration.hsc" #-}

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

{-# LINE 125 "src/Bindings/Gsl/NumericalIntegration.hsc" #-}
foreign import ccall "gsl_integration_glfixed" c'gsl_integration_glfixed
  :: Ptr C'gsl_function -> CDouble -> CDouble -> Ptr C'gsl_integration_glfixed_table -> IO CDouble
foreign import ccall "&gsl_integration_glfixed" p'gsl_integration_glfixed
  :: FunPtr (Ptr C'gsl_function -> CDouble -> CDouble -> Ptr C'gsl_integration_glfixed_table -> IO CDouble)

{-# LINE 127 "src/Bindings/Gsl/NumericalIntegration.hsc" #-}
foreign import ccall "gsl_integration_glfixed_point" c'gsl_integration_glfixed_point
  :: CDouble -> CDouble -> CSize -> Ptr CDouble -> Ptr CDouble -> Ptr C'gsl_integration_glfixed_table -> IO CInt
foreign import ccall "&gsl_integration_glfixed_point" p'gsl_integration_glfixed_point
  :: FunPtr (CDouble -> CDouble -> CSize -> Ptr CDouble -> Ptr CDouble -> Ptr C'gsl_integration_glfixed_table -> IO CInt)

{-# LINE 130 "src/Bindings/Gsl/NumericalIntegration.hsc" #-}
foreign import ccall "gsl_integration_glfixed_table_free" c'gsl_integration_glfixed_table_free
  :: Ptr C'gsl_integration_glfixed_table -> IO ()
foreign import ccall "&gsl_integration_glfixed_table_free" p'gsl_integration_glfixed_table_free
  :: FunPtr (Ptr C'gsl_integration_glfixed_table -> IO ())

{-# LINE 132 "src/Bindings/Gsl/NumericalIntegration.hsc" #-}