{-# OPTIONS_GHC -Wall #-} {-# OPTIONS_GHC -fno-warn-unused-imports #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-# Language ForeignFunctionInterface #-} {-# Language FlexibleInstances #-} {-# Language MultiParamTypeClasses #-} module Casadi.Core.Classes.SX ( SX, SXClass(..), sx_T, sx__0, sx__1, sx__10, sx__2, sx__3, sx__4, sx__5, sx__6, sx__7, sx__8, sx__9, sx___nonzero__, sx_append, sx_appendColumns, sx_binary, sx_className, sx_clear, sx_colind, sx_dimString, sx_enlarge__0, sx_enlarge__1, sx_erase__0, sx_erase__1, sx_erase__2, sx_erase__3, sx_eye, sx_find__0, sx_find__1, sx_getColind, sx_getDep__0, sx_getDep__1, sx_getDescription, sx_getElementHash, sx_getEqualityCheckingDepth, sx_getIntValue, sx_getNZ__0, sx_getNZ__1, sx_getNZ__2, sx_getName, sx_getNdeps, sx_getRepresentation, sx_getRow, sx_getSparsity, sx_getSym, sx_getValue__0, sx_getValue__1, sx_get__0, sx_get__1, sx_get__2, sx_get__3, sx_get__4, sx_get__5, sx_get__6, sx_get__7, sx_hasDuplicates, sx_hasNZ, sx_hasNonStructuralZeros, sx_inf__0, sx_inf__1, sx_inf__2, sx_inf__3, sx_inf__4, sx_isCommutative, sx_isConstant, sx_isIdentity, sx_isInteger, sx_isLeaf, sx_isMinusOne, sx_isOne, sx_isRegular, sx_isSlice__0, sx_isSlice__1, sx_isSmooth, sx_isSymbolic, sx_isValidInput, sx_isZero, sx_iscolumn, sx_isdense, sx_isempty__0, sx_isempty__1, sx_isrow, sx_isscalar__0, sx_isscalar__1, sx_issquare, sx_istril, sx_istriu, sx_isvector, sx_makeSparse__0, sx_makeSparse__1, sx_matrix_matrix, sx_matrix_scalar, sx_nan__0, sx_nan__1, sx_nan__2, sx_nan__3, sx_nan__4, sx_nnz, sx_nonzeros, sx_nonzeros_int, sx_numel__0, sx_numel__1, sx_ones__0, sx_ones__1, sx_ones__2, sx_ones__3, sx_ones__4, sx_operator_minus, sx_operator_plus, sx_printDense, sx_printScalar, sx_printSparse, sx_printSplit, sx_printVector, sx_printme, sx_remove, sx_reserve__0, sx_reserve__1, sx_resetInput, sx_resize, sx_row, sx_sanityCheck__0, sx_sanityCheck__1, sx_scalar_matrix, sx_setEqualityCheckingDepth__0, sx_setEqualityCheckingDepth__1, sx_setNZ__0, sx_setNZ__1, sx_setNZ__2, sx_setNZ__3, sx_setPrecision, sx_setScientific, sx_setSym, sx_setValue__0, sx_setValue__1, sx_setWidth, sx_setZero, sx_set__0, sx_set__1, sx_set__10, sx_set__2, sx_set__3, sx_set__4, sx_set__5, sx_set__6, sx_set__7, sx_set__8, sx_set__9, sx_shape__0, sx_shape__1, sx_size, sx_size1, sx_size2, sx_sizeD, sx_sizeL, sx_sizeU, sx_sparse__0, sx_sparse__1, sx_sparse__2, sx_sparse__3, sx_sparse__4, sx_sparsity, sx_sym__0, sx_sym__1, sx_sym__2, sx_sym__3, sx_sym__4, sx_sym__5, sx_sym__6, sx_sym__7, sx_sym__8, sx_toSlice__0, sx_toSlice__1, sx_triplet__0, sx_triplet__1, sx_triplet__2, sx_unary, sx_zeros__0, sx_zeros__1, sx_zeros__2, sx_zeros__3, sx_zeros__4, ) where import Prelude hiding ( Functor ) import Data.Vector ( Vector ) import qualified Data.Map as M import Foreign.C.Types import Foreign.Marshal ( new, free ) import Foreign.Storable ( peek ) import Foreign.Ptr ( Ptr, nullPtr ) import Foreign.ForeignPtr ( newForeignPtr ) import System.IO.Unsafe ( unsafePerformIO ) -- for show instances import Casadi.Internal.FormatException ( formatException ) import Casadi.Internal.MarshalTypes ( StdVec, StdString, StdMap, StdPair ) -- StdPair StdOstream' import Casadi.Internal.Marshal ( Marshal(..), withMarshal ) import Casadi.Internal.WrapReturn ( WrapReturn(..) ) import Casadi.Core.Data import Casadi.Core.Enums -- direct wrapper foreign import ccall unsafe "casadi__SX__CONSTRUCTOR__0" c_casadi__SX__CONSTRUCTOR__0 :: Ptr (Ptr StdString) -> Ptr (StdVec CDouble) -> IO (Ptr SX') casadi__SX__CONSTRUCTOR__0 :: Vector Double -> IO SX casadi__SX__CONSTRUCTOR__0 x0 = withMarshal x0 $ \x0' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__CONSTRUCTOR__0 errStrPtrP x0' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx__0 :: Vector Double -> IO SX sx__0 = casadi__SX__CONSTRUCTOR__0 -- direct wrapper foreign import ccall unsafe "casadi__SX__CONSTRUCTOR__1" c_casadi__SX__CONSTRUCTOR__1 :: Ptr (Ptr StdString) -> Ptr DMatrix' -> IO (Ptr SX') casadi__SX__CONSTRUCTOR__1 :: DMatrix -> IO SX casadi__SX__CONSTRUCTOR__1 x0 = withMarshal x0 $ \x0' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__CONSTRUCTOR__1 errStrPtrP x0' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx__1 :: DMatrix -> IO SX sx__1 = casadi__SX__CONSTRUCTOR__1 -- direct wrapper foreign import ccall unsafe "casadi__SX__CONSTRUCTOR__2" c_casadi__SX__CONSTRUCTOR__2 :: Ptr (Ptr StdString) -> Ptr (StdVec CInt) -> IO (Ptr SX') casadi__SX__CONSTRUCTOR__2 :: Vector Int -> IO SX casadi__SX__CONSTRUCTOR__2 x0 = withMarshal x0 $ \x0' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__CONSTRUCTOR__2 errStrPtrP x0' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx__2 :: Vector Int -> IO SX sx__2 = casadi__SX__CONSTRUCTOR__2 -- direct wrapper foreign import ccall unsafe "casadi__SX__CONSTRUCTOR__3" c_casadi__SX__CONSTRUCTOR__3 :: Ptr (Ptr StdString) -> Ptr IMatrix' -> IO (Ptr SX') casadi__SX__CONSTRUCTOR__3 :: IMatrix -> IO SX casadi__SX__CONSTRUCTOR__3 x0 = withMarshal x0 $ \x0' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__CONSTRUCTOR__3 errStrPtrP x0' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx__3 :: IMatrix -> IO SX sx__3 = casadi__SX__CONSTRUCTOR__3 -- direct wrapper foreign import ccall unsafe "casadi__SX__CONSTRUCTOR__4" c_casadi__SX__CONSTRUCTOR__4 :: Ptr (Ptr StdString) -> Ptr (StdVec (Ptr (StdVec CDouble))) -> IO (Ptr SX') casadi__SX__CONSTRUCTOR__4 :: Vector (Vector Double) -> IO SX casadi__SX__CONSTRUCTOR__4 x0 = withMarshal x0 $ \x0' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__CONSTRUCTOR__4 errStrPtrP x0' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx__4 :: Vector (Vector Double) -> IO SX sx__4 = casadi__SX__CONSTRUCTOR__4 -- direct wrapper foreign import ccall unsafe "casadi__SX__CONSTRUCTOR__5" c_casadi__SX__CONSTRUCTOR__5 :: Ptr (Ptr StdString) -> CDouble -> IO (Ptr SX') casadi__SX__CONSTRUCTOR__5 :: Double -> IO SX casadi__SX__CONSTRUCTOR__5 x0 = withMarshal x0 $ \x0' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__CONSTRUCTOR__5 errStrPtrP x0' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx__5 :: Double -> IO SX sx__5 = casadi__SX__CONSTRUCTOR__5 -- direct wrapper foreign import ccall unsafe "casadi__SX__CONSTRUCTOR__6" c_casadi__SX__CONSTRUCTOR__6 :: Ptr (Ptr StdString) -> Ptr Sparsity' -> Ptr SX' -> IO (Ptr SX') casadi__SX__CONSTRUCTOR__6 :: Sparsity -> SX -> IO SX casadi__SX__CONSTRUCTOR__6 x0 x1 = withMarshal x0 $ \x0' -> withMarshal x1 $ \x1' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__CONSTRUCTOR__6 errStrPtrP x0' x1' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx__6 :: Sparsity -> SX -> IO SX sx__6 = casadi__SX__CONSTRUCTOR__6 -- direct wrapper foreign import ccall unsafe "casadi__SX__CONSTRUCTOR__7" c_casadi__SX__CONSTRUCTOR__7 :: Ptr (Ptr StdString) -> Ptr Sparsity' -> IO (Ptr SX') casadi__SX__CONSTRUCTOR__7 :: Sparsity -> IO SX casadi__SX__CONSTRUCTOR__7 x0 = withMarshal x0 $ \x0' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__CONSTRUCTOR__7 errStrPtrP x0' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx__7 :: Sparsity -> IO SX sx__7 = casadi__SX__CONSTRUCTOR__7 -- direct wrapper foreign import ccall unsafe "casadi__SX__CONSTRUCTOR__8" c_casadi__SX__CONSTRUCTOR__8 :: Ptr (Ptr StdString) -> CInt -> CInt -> IO (Ptr SX') casadi__SX__CONSTRUCTOR__8 :: Int -> Int -> IO SX casadi__SX__CONSTRUCTOR__8 x0 x1 = withMarshal x0 $ \x0' -> withMarshal x1 $ \x1' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__CONSTRUCTOR__8 errStrPtrP x0' x1' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx__8 :: Int -> Int -> IO SX sx__8 = casadi__SX__CONSTRUCTOR__8 -- direct wrapper foreign import ccall unsafe "casadi__SX__CONSTRUCTOR__9" c_casadi__SX__CONSTRUCTOR__9 :: Ptr (Ptr StdString) -> Ptr SX' -> IO (Ptr SX') casadi__SX__CONSTRUCTOR__9 :: SX -> IO SX casadi__SX__CONSTRUCTOR__9 x0 = withMarshal x0 $ \x0' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__CONSTRUCTOR__9 errStrPtrP x0' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx__9 :: SX -> IO SX sx__9 = casadi__SX__CONSTRUCTOR__9 -- direct wrapper foreign import ccall unsafe "casadi__SX__CONSTRUCTOR__10" c_casadi__SX__CONSTRUCTOR__10 :: Ptr (Ptr StdString) -> IO (Ptr SX') casadi__SX__CONSTRUCTOR__10 :: IO SX casadi__SX__CONSTRUCTOR__10 = do errStrPtrP <- new nullPtr ret <- c_casadi__SX__CONSTRUCTOR__10 errStrPtrP errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx__10 :: IO SX sx__10 = casadi__SX__CONSTRUCTOR__10 -- direct wrapper foreign import ccall unsafe "casadi__SX__T" c_casadi__SX__T :: Ptr (Ptr StdString) -> Ptr SX' -> IO (Ptr SX') casadi__SX__T :: SX -> IO SX casadi__SX__T x0 = withMarshal x0 $ \x0' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__T errStrPtrP x0' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_T :: SXClass a => a -> IO SX sx_T x = casadi__SX__T (castSX x) -- direct wrapper foreign import ccall unsafe "casadi__SX____nonzero__" c_casadi__SX____nonzero__ :: Ptr (Ptr StdString) -> Ptr SX' -> IO CInt casadi__SX____nonzero__ :: SX -> IO Bool casadi__SX____nonzero__ x0 = withMarshal x0 $ \x0' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX____nonzero__ errStrPtrP x0' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx___nonzero__ :: SXClass a => a -> IO Bool sx___nonzero__ x = casadi__SX____nonzero__ (castSX x) -- direct wrapper foreign import ccall unsafe "casadi__SX__append" c_casadi__SX__append :: Ptr (Ptr StdString) -> Ptr SX' -> Ptr SX' -> IO () casadi__SX__append :: SX -> SX -> IO () casadi__SX__append x0 x1 = withMarshal x0 $ \x0' -> withMarshal x1 $ \x1' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__append errStrPtrP x0' x1' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_append :: SXClass a => a -> SX -> IO () sx_append x = casadi__SX__append (castSX x) -- direct wrapper foreign import ccall unsafe "casadi__SX__appendColumns" c_casadi__SX__appendColumns :: Ptr (Ptr StdString) -> Ptr SX' -> Ptr SX' -> IO () casadi__SX__appendColumns :: SX -> SX -> IO () casadi__SX__appendColumns x0 x1 = withMarshal x0 $ \x0' -> withMarshal x1 $ \x1' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__appendColumns errStrPtrP x0' x1' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_appendColumns :: SXClass a => a -> SX -> IO () sx_appendColumns x = casadi__SX__appendColumns (castSX x) -- direct wrapper foreign import ccall unsafe "casadi__SX__binary" c_casadi__SX__binary :: Ptr (Ptr StdString) -> CInt -> Ptr SX' -> Ptr SX' -> IO (Ptr SX') casadi__SX__binary :: Int -> SX -> SX -> IO SX casadi__SX__binary x0 x1 x2 = withMarshal x0 $ \x0' -> withMarshal x1 $ \x1' -> withMarshal x2 $ \x2' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__binary errStrPtrP x0' x1' x2' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_binary :: Int -> SX -> SX -> IO SX sx_binary = casadi__SX__binary -- direct wrapper foreign import ccall unsafe "casadi__SX__className" c_casadi__SX__className :: Ptr (Ptr StdString) -> IO (Ptr StdString) casadi__SX__className :: IO String casadi__SX__className = do errStrPtrP <- new nullPtr ret <- c_casadi__SX__className errStrPtrP errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_className :: IO String sx_className = casadi__SX__className -- direct wrapper foreign import ccall unsafe "casadi__SX__clear" c_casadi__SX__clear :: Ptr (Ptr StdString) -> Ptr SX' -> IO () casadi__SX__clear :: SX -> IO () casadi__SX__clear x0 = withMarshal x0 $ \x0' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__clear errStrPtrP x0' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_clear :: SXClass a => a -> IO () sx_clear x = casadi__SX__clear (castSX x) -- direct wrapper foreign import ccall unsafe "casadi__SX__colind" c_casadi__SX__colind :: Ptr (Ptr StdString) -> Ptr SX' -> CInt -> IO CInt casadi__SX__colind :: SX -> Int -> IO Int casadi__SX__colind x0 x1 = withMarshal x0 $ \x0' -> withMarshal x1 $ \x1' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__colind errStrPtrP x0' x1' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_colind :: SXClass a => a -> Int -> IO Int sx_colind x = casadi__SX__colind (castSX x) -- direct wrapper foreign import ccall unsafe "casadi__SX__dimString" c_casadi__SX__dimString :: Ptr (Ptr StdString) -> Ptr SX' -> IO (Ptr StdString) casadi__SX__dimString :: SX -> IO String casadi__SX__dimString x0 = withMarshal x0 $ \x0' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__dimString errStrPtrP x0' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_dimString :: SXClass a => a -> IO String sx_dimString x = casadi__SX__dimString (castSX x) -- direct wrapper foreign import ccall unsafe "casadi__SX__enlarge__0" c_casadi__SX__enlarge__0 :: Ptr (Ptr StdString) -> Ptr SX' -> CInt -> CInt -> Ptr (StdVec CInt) -> Ptr (StdVec CInt) -> IO () casadi__SX__enlarge__0 :: SX -> Int -> Int -> Vector Int -> Vector Int -> IO () casadi__SX__enlarge__0 x0 x1 x2 x3 x4 = withMarshal x0 $ \x0' -> withMarshal x1 $ \x1' -> withMarshal x2 $ \x2' -> withMarshal x3 $ \x3' -> withMarshal x4 $ \x4' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__enlarge__0 errStrPtrP x0' x1' x2' x3' x4' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_enlarge__0 :: SXClass a => a -> Int -> Int -> Vector Int -> Vector Int -> IO () sx_enlarge__0 x = casadi__SX__enlarge__0 (castSX x) -- direct wrapper foreign import ccall unsafe "casadi__SX__enlarge__1" c_casadi__SX__enlarge__1 :: Ptr (Ptr StdString) -> Ptr SX' -> CInt -> CInt -> Ptr (StdVec CInt) -> Ptr (StdVec CInt) -> CInt -> IO () casadi__SX__enlarge__1 :: SX -> Int -> Int -> Vector Int -> Vector Int -> Bool -> IO () casadi__SX__enlarge__1 x0 x1 x2 x3 x4 x5 = withMarshal x0 $ \x0' -> withMarshal x1 $ \x1' -> withMarshal x2 $ \x2' -> withMarshal x3 $ \x3' -> withMarshal x4 $ \x4' -> withMarshal x5 $ \x5' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__enlarge__1 errStrPtrP x0' x1' x2' x3' x4' x5' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_enlarge__1 :: SXClass a => a -> Int -> Int -> Vector Int -> Vector Int -> Bool -> IO () sx_enlarge__1 x = casadi__SX__enlarge__1 (castSX x) -- direct wrapper foreign import ccall unsafe "casadi__SX__erase__0" c_casadi__SX__erase__0 :: Ptr (Ptr StdString) -> Ptr SX' -> Ptr (StdVec CInt) -> IO () casadi__SX__erase__0 :: SX -> Vector Int -> IO () casadi__SX__erase__0 x0 x1 = withMarshal x0 $ \x0' -> withMarshal x1 $ \x1' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__erase__0 errStrPtrP x0' x1' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_erase__0 :: SXClass a => a -> Vector Int -> IO () sx_erase__0 x = casadi__SX__erase__0 (castSX x) -- direct wrapper foreign import ccall unsafe "casadi__SX__erase__1" c_casadi__SX__erase__1 :: Ptr (Ptr StdString) -> Ptr SX' -> Ptr (StdVec CInt) -> CInt -> IO () casadi__SX__erase__1 :: SX -> Vector Int -> Bool -> IO () casadi__SX__erase__1 x0 x1 x2 = withMarshal x0 $ \x0' -> withMarshal x1 $ \x1' -> withMarshal x2 $ \x2' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__erase__1 errStrPtrP x0' x1' x2' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_erase__1 :: SXClass a => a -> Vector Int -> Bool -> IO () sx_erase__1 x = casadi__SX__erase__1 (castSX x) -- direct wrapper foreign import ccall unsafe "casadi__SX__erase__2" c_casadi__SX__erase__2 :: Ptr (Ptr StdString) -> Ptr SX' -> Ptr (StdVec CInt) -> Ptr (StdVec CInt) -> IO () casadi__SX__erase__2 :: SX -> Vector Int -> Vector Int -> IO () casadi__SX__erase__2 x0 x1 x2 = withMarshal x0 $ \x0' -> withMarshal x1 $ \x1' -> withMarshal x2 $ \x2' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__erase__2 errStrPtrP x0' x1' x2' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_erase__2 :: SXClass a => a -> Vector Int -> Vector Int -> IO () sx_erase__2 x = casadi__SX__erase__2 (castSX x) -- direct wrapper foreign import ccall unsafe "casadi__SX__erase__3" c_casadi__SX__erase__3 :: Ptr (Ptr StdString) -> Ptr SX' -> Ptr (StdVec CInt) -> Ptr (StdVec CInt) -> CInt -> IO () casadi__SX__erase__3 :: SX -> Vector Int -> Vector Int -> Bool -> IO () casadi__SX__erase__3 x0 x1 x2 x3 = withMarshal x0 $ \x0' -> withMarshal x1 $ \x1' -> withMarshal x2 $ \x2' -> withMarshal x3 $ \x3' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__erase__3 errStrPtrP x0' x1' x2' x3' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_erase__3 :: SXClass a => a -> Vector Int -> Vector Int -> Bool -> IO () sx_erase__3 x = casadi__SX__erase__3 (castSX x) -- direct wrapper foreign import ccall unsafe "casadi__SX__eye" c_casadi__SX__eye :: Ptr (Ptr StdString) -> CInt -> IO (Ptr SX') casadi__SX__eye :: Int -> IO SX casadi__SX__eye x0 = withMarshal x0 $ \x0' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__eye errStrPtrP x0' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_eye :: Int -> IO SX sx_eye = casadi__SX__eye -- direct wrapper foreign import ccall unsafe "casadi__SX__find__0" c_casadi__SX__find__0 :: Ptr (Ptr StdString) -> Ptr SX' -> IO (Ptr (StdVec CInt)) casadi__SX__find__0 :: SX -> IO (Vector Int) casadi__SX__find__0 x0 = withMarshal x0 $ \x0' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__find__0 errStrPtrP x0' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_find__0 :: SXClass a => a -> IO (Vector Int) sx_find__0 x = casadi__SX__find__0 (castSX x) -- direct wrapper foreign import ccall unsafe "casadi__SX__find__1" c_casadi__SX__find__1 :: Ptr (Ptr StdString) -> Ptr SX' -> CInt -> IO (Ptr (StdVec CInt)) casadi__SX__find__1 :: SX -> Bool -> IO (Vector Int) casadi__SX__find__1 x0 x1 = withMarshal x0 $ \x0' -> withMarshal x1 $ \x1' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__find__1 errStrPtrP x0' x1' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_find__1 :: SXClass a => a -> Bool -> IO (Vector Int) sx_find__1 x = casadi__SX__find__1 (castSX x) -- direct wrapper foreign import ccall unsafe "casadi__SX__get__0" c_casadi__SX__get__0 :: Ptr (Ptr StdString) -> Ptr SX' -> Ptr SX' -> CInt -> Ptr IMatrix' -> Ptr IMatrix' -> IO () casadi__SX__get__0 :: SX -> SX -> Bool -> IMatrix -> IMatrix -> IO () casadi__SX__get__0 x0 x1 x2 x3 x4 = withMarshal x0 $ \x0' -> withMarshal x1 $ \x1' -> withMarshal x2 $ \x2' -> withMarshal x3 $ \x3' -> withMarshal x4 $ \x4' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__get__0 errStrPtrP x0' x1' x2' x3' x4' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_get__0 :: SXClass a => a -> SX -> Bool -> IMatrix -> IMatrix -> IO () sx_get__0 x = casadi__SX__get__0 (castSX x) -- direct wrapper foreign import ccall unsafe "casadi__SX__get__1" c_casadi__SX__get__1 :: Ptr (Ptr StdString) -> Ptr SX' -> Ptr SX' -> CInt -> Ptr IMatrix' -> Ptr Slice' -> IO () casadi__SX__get__1 :: SX -> SX -> Bool -> IMatrix -> Slice -> IO () casadi__SX__get__1 x0 x1 x2 x3 x4 = withMarshal x0 $ \x0' -> withMarshal x1 $ \x1' -> withMarshal x2 $ \x2' -> withMarshal x3 $ \x3' -> withMarshal x4 $ \x4' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__get__1 errStrPtrP x0' x1' x2' x3' x4' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_get__1 :: SXClass a => a -> SX -> Bool -> IMatrix -> Slice -> IO () sx_get__1 x = casadi__SX__get__1 (castSX x) -- direct wrapper foreign import ccall unsafe "casadi__SX__get__2" c_casadi__SX__get__2 :: Ptr (Ptr StdString) -> Ptr SX' -> Ptr SX' -> CInt -> Ptr Slice' -> Ptr IMatrix' -> IO () casadi__SX__get__2 :: SX -> SX -> Bool -> Slice -> IMatrix -> IO () casadi__SX__get__2 x0 x1 x2 x3 x4 = withMarshal x0 $ \x0' -> withMarshal x1 $ \x1' -> withMarshal x2 $ \x2' -> withMarshal x3 $ \x3' -> withMarshal x4 $ \x4' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__get__2 errStrPtrP x0' x1' x2' x3' x4' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_get__2 :: SXClass a => a -> SX -> Bool -> Slice -> IMatrix -> IO () sx_get__2 x = casadi__SX__get__2 (castSX x) -- direct wrapper foreign import ccall unsafe "casadi__SX__get__3" c_casadi__SX__get__3 :: Ptr (Ptr StdString) -> Ptr SX' -> Ptr SX' -> CInt -> Ptr Slice' -> Ptr Slice' -> IO () casadi__SX__get__3 :: SX -> SX -> Bool -> Slice -> Slice -> IO () casadi__SX__get__3 x0 x1 x2 x3 x4 = withMarshal x0 $ \x0' -> withMarshal x1 $ \x1' -> withMarshal x2 $ \x2' -> withMarshal x3 $ \x3' -> withMarshal x4 $ \x4' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__get__3 errStrPtrP x0' x1' x2' x3' x4' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_get__3 :: SXClass a => a -> SX -> Bool -> Slice -> Slice -> IO () sx_get__3 x = casadi__SX__get__3 (castSX x) -- direct wrapper foreign import ccall unsafe "casadi__SX__get__4" c_casadi__SX__get__4 :: Ptr (Ptr StdString) -> Ptr SX' -> Ptr SX' -> CInt -> Ptr Sparsity' -> IO () casadi__SX__get__4 :: SX -> SX -> Bool -> Sparsity -> IO () casadi__SX__get__4 x0 x1 x2 x3 = withMarshal x0 $ \x0' -> withMarshal x1 $ \x1' -> withMarshal x2 $ \x2' -> withMarshal x3 $ \x3' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__get__4 errStrPtrP x0' x1' x2' x3' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_get__4 :: SXClass a => a -> SX -> Bool -> Sparsity -> IO () sx_get__4 x = casadi__SX__get__4 (castSX x) -- direct wrapper foreign import ccall unsafe "casadi__SX__get__5" c_casadi__SX__get__5 :: Ptr (Ptr StdString) -> Ptr SX' -> Ptr SX' -> CInt -> Ptr IMatrix' -> IO () casadi__SX__get__5 :: SX -> SX -> Bool -> IMatrix -> IO () casadi__SX__get__5 x0 x1 x2 x3 = withMarshal x0 $ \x0' -> withMarshal x1 $ \x1' -> withMarshal x2 $ \x2' -> withMarshal x3 $ \x3' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__get__5 errStrPtrP x0' x1' x2' x3' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_get__5 :: SXClass a => a -> SX -> Bool -> IMatrix -> IO () sx_get__5 x = casadi__SX__get__5 (castSX x) -- direct wrapper foreign import ccall unsafe "casadi__SX__get__6" c_casadi__SX__get__6 :: Ptr (Ptr StdString) -> Ptr SX' -> Ptr SX' -> CInt -> Ptr Slice' -> IO () casadi__SX__get__6 :: SX -> SX -> Bool -> Slice -> IO () casadi__SX__get__6 x0 x1 x2 x3 = withMarshal x0 $ \x0' -> withMarshal x1 $ \x1' -> withMarshal x2 $ \x2' -> withMarshal x3 $ \x3' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__get__6 errStrPtrP x0' x1' x2' x3' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_get__6 :: SXClass a => a -> SX -> Bool -> Slice -> IO () sx_get__6 x = casadi__SX__get__6 (castSX x) -- direct wrapper foreign import ccall unsafe "casadi__SX__get__7" c_casadi__SX__get__7 :: Ptr (Ptr StdString) -> Ptr SX' -> Ptr (StdVec CDouble) -> IO () casadi__SX__get__7 :: SX -> Vector Double -> IO () casadi__SX__get__7 x0 x1 = withMarshal x0 $ \x0' -> withMarshal x1 $ \x1' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__get__7 errStrPtrP x0' x1' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_get__7 :: SXClass a => a -> Vector Double -> IO () sx_get__7 x = casadi__SX__get__7 (castSX x) -- direct wrapper foreign import ccall unsafe "casadi__SX__getColind" c_casadi__SX__getColind :: Ptr (Ptr StdString) -> Ptr SX' -> IO (Ptr (StdVec CInt)) casadi__SX__getColind :: SX -> IO (Vector Int) casadi__SX__getColind x0 = withMarshal x0 $ \x0' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__getColind errStrPtrP x0' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_getColind :: SXClass a => a -> IO (Vector Int) sx_getColind x = casadi__SX__getColind (castSX x) -- direct wrapper foreign import ccall unsafe "casadi__SX__getDep__0" c_casadi__SX__getDep__0 :: Ptr (Ptr StdString) -> Ptr SX' -> IO (Ptr SX') casadi__SX__getDep__0 :: SX -> IO SX casadi__SX__getDep__0 x0 = withMarshal x0 $ \x0' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__getDep__0 errStrPtrP x0' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_getDep__0 :: SXClass a => a -> IO SX sx_getDep__0 x = casadi__SX__getDep__0 (castSX x) -- direct wrapper foreign import ccall unsafe "casadi__SX__getDep__1" c_casadi__SX__getDep__1 :: Ptr (Ptr StdString) -> Ptr SX' -> CInt -> IO (Ptr SX') casadi__SX__getDep__1 :: SX -> Int -> IO SX casadi__SX__getDep__1 x0 x1 = withMarshal x0 $ \x0' -> withMarshal x1 $ \x1' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__getDep__1 errStrPtrP x0' x1' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_getDep__1 :: SXClass a => a -> Int -> IO SX sx_getDep__1 x = casadi__SX__getDep__1 (castSX x) -- direct wrapper foreign import ccall unsafe "casadi__SX__getElementHash" c_casadi__SX__getElementHash :: Ptr (Ptr StdString) -> Ptr SX' -> IO CSize casadi__SX__getElementHash :: SX -> IO CSize casadi__SX__getElementHash x0 = withMarshal x0 $ \x0' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__getElementHash errStrPtrP x0' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_getElementHash :: SXClass a => a -> IO CSize sx_getElementHash x = casadi__SX__getElementHash (castSX x) -- direct wrapper foreign import ccall unsafe "casadi__SX__getEqualityCheckingDepth" c_casadi__SX__getEqualityCheckingDepth :: Ptr (Ptr StdString) -> IO CInt casadi__SX__getEqualityCheckingDepth :: IO Int casadi__SX__getEqualityCheckingDepth = do errStrPtrP <- new nullPtr ret <- c_casadi__SX__getEqualityCheckingDepth errStrPtrP errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_getEqualityCheckingDepth :: IO Int sx_getEqualityCheckingDepth = casadi__SX__getEqualityCheckingDepth -- direct wrapper foreign import ccall unsafe "casadi__SX__getIntValue" c_casadi__SX__getIntValue :: Ptr (Ptr StdString) -> Ptr SX' -> IO CInt casadi__SX__getIntValue :: SX -> IO Int casadi__SX__getIntValue x0 = withMarshal x0 $ \x0' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__getIntValue errStrPtrP x0' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_getIntValue :: SXClass a => a -> IO Int sx_getIntValue x = casadi__SX__getIntValue (castSX x) -- direct wrapper foreign import ccall unsafe "casadi__SX__getNZ__0" c_casadi__SX__getNZ__0 :: Ptr (Ptr StdString) -> Ptr SX' -> Ptr SX' -> CInt -> Ptr IMatrix' -> IO () casadi__SX__getNZ__0 :: SX -> SX -> Bool -> IMatrix -> IO () casadi__SX__getNZ__0 x0 x1 x2 x3 = withMarshal x0 $ \x0' -> withMarshal x1 $ \x1' -> withMarshal x2 $ \x2' -> withMarshal x3 $ \x3' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__getNZ__0 errStrPtrP x0' x1' x2' x3' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_getNZ__0 :: SXClass a => a -> SX -> Bool -> IMatrix -> IO () sx_getNZ__0 x = casadi__SX__getNZ__0 (castSX x) -- direct wrapper foreign import ccall unsafe "casadi__SX__getNZ__1" c_casadi__SX__getNZ__1 :: Ptr (Ptr StdString) -> Ptr SX' -> Ptr SX' -> CInt -> Ptr Slice' -> IO () casadi__SX__getNZ__1 :: SX -> SX -> Bool -> Slice -> IO () casadi__SX__getNZ__1 x0 x1 x2 x3 = withMarshal x0 $ \x0' -> withMarshal x1 $ \x1' -> withMarshal x2 $ \x2' -> withMarshal x3 $ \x3' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__getNZ__1 errStrPtrP x0' x1' x2' x3' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_getNZ__1 :: SXClass a => a -> SX -> Bool -> Slice -> IO () sx_getNZ__1 x = casadi__SX__getNZ__1 (castSX x) -- direct wrapper foreign import ccall unsafe "casadi__SX__getNZ__2" c_casadi__SX__getNZ__2 :: Ptr (Ptr StdString) -> Ptr SX' -> Ptr (StdVec CDouble) -> IO () casadi__SX__getNZ__2 :: SX -> Vector Double -> IO () casadi__SX__getNZ__2 x0 x1 = withMarshal x0 $ \x0' -> withMarshal x1 $ \x1' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__getNZ__2 errStrPtrP x0' x1' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_getNZ__2 :: SXClass a => a -> Vector Double -> IO () sx_getNZ__2 x = casadi__SX__getNZ__2 (castSX x) -- direct wrapper foreign import ccall unsafe "casadi__SX__getName" c_casadi__SX__getName :: Ptr (Ptr StdString) -> Ptr SX' -> IO (Ptr StdString) casadi__SX__getName :: SX -> IO String casadi__SX__getName x0 = withMarshal x0 $ \x0' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__getName errStrPtrP x0' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_getName :: SXClass a => a -> IO String sx_getName x = casadi__SX__getName (castSX x) -- direct wrapper foreign import ccall unsafe "casadi__SX__getNdeps" c_casadi__SX__getNdeps :: Ptr (Ptr StdString) -> Ptr SX' -> IO CInt casadi__SX__getNdeps :: SX -> IO Int casadi__SX__getNdeps x0 = withMarshal x0 $ \x0' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__getNdeps errStrPtrP x0' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_getNdeps :: SXClass a => a -> IO Int sx_getNdeps x = casadi__SX__getNdeps (castSX x) -- direct wrapper foreign import ccall unsafe "casadi__SX__getRow" c_casadi__SX__getRow :: Ptr (Ptr StdString) -> Ptr SX' -> IO (Ptr (StdVec CInt)) casadi__SX__getRow :: SX -> IO (Vector Int) casadi__SX__getRow x0 = withMarshal x0 $ \x0' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__getRow errStrPtrP x0' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_getRow :: SXClass a => a -> IO (Vector Int) sx_getRow x = casadi__SX__getRow (castSX x) -- direct wrapper foreign import ccall unsafe "casadi__SX__getSparsity" c_casadi__SX__getSparsity :: Ptr (Ptr StdString) -> Ptr SX' -> IO (Ptr Sparsity') casadi__SX__getSparsity :: SX -> IO Sparsity casadi__SX__getSparsity x0 = withMarshal x0 $ \x0' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__getSparsity errStrPtrP x0' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_getSparsity :: SXClass a => a -> IO Sparsity sx_getSparsity x = casadi__SX__getSparsity (castSX x) -- direct wrapper foreign import ccall unsafe "casadi__SX__getSym" c_casadi__SX__getSym :: Ptr (Ptr StdString) -> Ptr SX' -> Ptr (StdVec CDouble) -> IO () casadi__SX__getSym :: SX -> Vector Double -> IO () casadi__SX__getSym x0 x1 = withMarshal x0 $ \x0' -> withMarshal x1 $ \x1' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__getSym errStrPtrP x0' x1' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_getSym :: SXClass a => a -> Vector Double -> IO () sx_getSym x = casadi__SX__getSym (castSX x) -- direct wrapper foreign import ccall unsafe "casadi__SX__getValue__0" c_casadi__SX__getValue__0 :: Ptr (Ptr StdString) -> Ptr SX' -> CInt -> IO CDouble casadi__SX__getValue__0 :: SX -> Int -> IO Double casadi__SX__getValue__0 x0 x1 = withMarshal x0 $ \x0' -> withMarshal x1 $ \x1' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__getValue__0 errStrPtrP x0' x1' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_getValue__0 :: SXClass a => a -> Int -> IO Double sx_getValue__0 x = casadi__SX__getValue__0 (castSX x) -- direct wrapper foreign import ccall unsafe "casadi__SX__getValue__1" c_casadi__SX__getValue__1 :: Ptr (Ptr StdString) -> Ptr SX' -> IO CDouble casadi__SX__getValue__1 :: SX -> IO Double casadi__SX__getValue__1 x0 = withMarshal x0 $ \x0' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__getValue__1 errStrPtrP x0' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_getValue__1 :: SXClass a => a -> IO Double sx_getValue__1 x = casadi__SX__getValue__1 (castSX x) -- direct wrapper foreign import ccall unsafe "casadi__SX__hasDuplicates" c_casadi__SX__hasDuplicates :: Ptr (Ptr StdString) -> Ptr SX' -> IO CInt casadi__SX__hasDuplicates :: SX -> IO Bool casadi__SX__hasDuplicates x0 = withMarshal x0 $ \x0' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__hasDuplicates errStrPtrP x0' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_hasDuplicates :: SXClass a => a -> IO Bool sx_hasDuplicates x = casadi__SX__hasDuplicates (castSX x) -- direct wrapper foreign import ccall unsafe "casadi__SX__hasNZ" c_casadi__SX__hasNZ :: Ptr (Ptr StdString) -> Ptr SX' -> CInt -> CInt -> IO CInt casadi__SX__hasNZ :: SX -> Int -> Int -> IO Bool casadi__SX__hasNZ x0 x1 x2 = withMarshal x0 $ \x0' -> withMarshal x1 $ \x1' -> withMarshal x2 $ \x2' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__hasNZ errStrPtrP x0' x1' x2' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_hasNZ :: SXClass a => a -> Int -> Int -> IO Bool sx_hasNZ x = casadi__SX__hasNZ (castSX x) -- direct wrapper foreign import ccall unsafe "casadi__SX__hasNonStructuralZeros" c_casadi__SX__hasNonStructuralZeros :: Ptr (Ptr StdString) -> Ptr SX' -> IO CInt casadi__SX__hasNonStructuralZeros :: SX -> IO Bool casadi__SX__hasNonStructuralZeros x0 = withMarshal x0 $ \x0' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__hasNonStructuralZeros errStrPtrP x0' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_hasNonStructuralZeros :: SXClass a => a -> IO Bool sx_hasNonStructuralZeros x = casadi__SX__hasNonStructuralZeros (castSX x) -- direct wrapper foreign import ccall unsafe "casadi__SX__inf__0" c_casadi__SX__inf__0 :: Ptr (Ptr StdString) -> Ptr (StdPair CInt CInt) -> IO (Ptr SX') casadi__SX__inf__0 :: (Int, Int) -> IO SX casadi__SX__inf__0 x0 = withMarshal x0 $ \x0' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__inf__0 errStrPtrP x0' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_inf__0 :: (Int, Int) -> IO SX sx_inf__0 = casadi__SX__inf__0 -- direct wrapper foreign import ccall unsafe "casadi__SX__inf__1" c_casadi__SX__inf__1 :: Ptr (Ptr StdString) -> IO (Ptr SX') casadi__SX__inf__1 :: IO SX casadi__SX__inf__1 = do errStrPtrP <- new nullPtr ret <- c_casadi__SX__inf__1 errStrPtrP errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_inf__1 :: IO SX sx_inf__1 = casadi__SX__inf__1 -- direct wrapper foreign import ccall unsafe "casadi__SX__inf__2" c_casadi__SX__inf__2 :: Ptr (Ptr StdString) -> CInt -> IO (Ptr SX') casadi__SX__inf__2 :: Int -> IO SX casadi__SX__inf__2 x0 = withMarshal x0 $ \x0' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__inf__2 errStrPtrP x0' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_inf__2 :: Int -> IO SX sx_inf__2 = casadi__SX__inf__2 -- direct wrapper foreign import ccall unsafe "casadi__SX__inf__3" c_casadi__SX__inf__3 :: Ptr (Ptr StdString) -> CInt -> CInt -> IO (Ptr SX') casadi__SX__inf__3 :: Int -> Int -> IO SX casadi__SX__inf__3 x0 x1 = withMarshal x0 $ \x0' -> withMarshal x1 $ \x1' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__inf__3 errStrPtrP x0' x1' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_inf__3 :: Int -> Int -> IO SX sx_inf__3 = casadi__SX__inf__3 -- direct wrapper foreign import ccall unsafe "casadi__SX__inf__4" c_casadi__SX__inf__4 :: Ptr (Ptr StdString) -> Ptr Sparsity' -> IO (Ptr SX') casadi__SX__inf__4 :: Sparsity -> IO SX casadi__SX__inf__4 x0 = withMarshal x0 $ \x0' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__inf__4 errStrPtrP x0' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_inf__4 :: Sparsity -> IO SX sx_inf__4 = casadi__SX__inf__4 -- direct wrapper foreign import ccall unsafe "casadi__SX__isCommutative" c_casadi__SX__isCommutative :: Ptr (Ptr StdString) -> Ptr SX' -> IO CInt casadi__SX__isCommutative :: SX -> IO Bool casadi__SX__isCommutative x0 = withMarshal x0 $ \x0' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__isCommutative errStrPtrP x0' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_isCommutative :: SXClass a => a -> IO Bool sx_isCommutative x = casadi__SX__isCommutative (castSX x) -- direct wrapper foreign import ccall unsafe "casadi__SX__isConstant" c_casadi__SX__isConstant :: Ptr (Ptr StdString) -> Ptr SX' -> IO CInt casadi__SX__isConstant :: SX -> IO Bool casadi__SX__isConstant x0 = withMarshal x0 $ \x0' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__isConstant errStrPtrP x0' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_isConstant :: SXClass a => a -> IO Bool sx_isConstant x = casadi__SX__isConstant (castSX x) -- direct wrapper foreign import ccall unsafe "casadi__SX__isIdentity" c_casadi__SX__isIdentity :: Ptr (Ptr StdString) -> Ptr SX' -> IO CInt casadi__SX__isIdentity :: SX -> IO Bool casadi__SX__isIdentity x0 = withMarshal x0 $ \x0' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__isIdentity errStrPtrP x0' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_isIdentity :: SXClass a => a -> IO Bool sx_isIdentity x = casadi__SX__isIdentity (castSX x) -- direct wrapper foreign import ccall unsafe "casadi__SX__isInteger" c_casadi__SX__isInteger :: Ptr (Ptr StdString) -> Ptr SX' -> IO CInt casadi__SX__isInteger :: SX -> IO Bool casadi__SX__isInteger x0 = withMarshal x0 $ \x0' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__isInteger errStrPtrP x0' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_isInteger :: SXClass a => a -> IO Bool sx_isInteger x = casadi__SX__isInteger (castSX x) -- direct wrapper foreign import ccall unsafe "casadi__SX__isLeaf" c_casadi__SX__isLeaf :: Ptr (Ptr StdString) -> Ptr SX' -> IO CInt casadi__SX__isLeaf :: SX -> IO Bool casadi__SX__isLeaf x0 = withMarshal x0 $ \x0' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__isLeaf errStrPtrP x0' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_isLeaf :: SXClass a => a -> IO Bool sx_isLeaf x = casadi__SX__isLeaf (castSX x) -- direct wrapper foreign import ccall unsafe "casadi__SX__isMinusOne" c_casadi__SX__isMinusOne :: Ptr (Ptr StdString) -> Ptr SX' -> IO CInt casadi__SX__isMinusOne :: SX -> IO Bool casadi__SX__isMinusOne x0 = withMarshal x0 $ \x0' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__isMinusOne errStrPtrP x0' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_isMinusOne :: SXClass a => a -> IO Bool sx_isMinusOne x = casadi__SX__isMinusOne (castSX x) -- direct wrapper foreign import ccall unsafe "casadi__SX__isOne" c_casadi__SX__isOne :: Ptr (Ptr StdString) -> Ptr SX' -> IO CInt casadi__SX__isOne :: SX -> IO Bool casadi__SX__isOne x0 = withMarshal x0 $ \x0' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__isOne errStrPtrP x0' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_isOne :: SXClass a => a -> IO Bool sx_isOne x = casadi__SX__isOne (castSX x) -- direct wrapper foreign import ccall unsafe "casadi__SX__isRegular" c_casadi__SX__isRegular :: Ptr (Ptr StdString) -> Ptr SX' -> IO CInt casadi__SX__isRegular :: SX -> IO Bool casadi__SX__isRegular x0 = withMarshal x0 $ \x0' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__isRegular errStrPtrP x0' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_isRegular :: SXClass a => a -> IO Bool sx_isRegular x = casadi__SX__isRegular (castSX x) -- direct wrapper foreign import ccall unsafe "casadi__SX__isSlice__0" c_casadi__SX__isSlice__0 :: Ptr (Ptr StdString) -> Ptr SX' -> IO CInt casadi__SX__isSlice__0 :: SX -> IO Bool casadi__SX__isSlice__0 x0 = withMarshal x0 $ \x0' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__isSlice__0 errStrPtrP x0' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_isSlice__0 :: SXClass a => a -> IO Bool sx_isSlice__0 x = casadi__SX__isSlice__0 (castSX x) -- direct wrapper foreign import ccall unsafe "casadi__SX__isSlice__1" c_casadi__SX__isSlice__1 :: Ptr (Ptr StdString) -> Ptr SX' -> CInt -> IO CInt casadi__SX__isSlice__1 :: SX -> Bool -> IO Bool casadi__SX__isSlice__1 x0 x1 = withMarshal x0 $ \x0' -> withMarshal x1 $ \x1' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__isSlice__1 errStrPtrP x0' x1' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_isSlice__1 :: SXClass a => a -> Bool -> IO Bool sx_isSlice__1 x = casadi__SX__isSlice__1 (castSX x) -- direct wrapper foreign import ccall unsafe "casadi__SX__isSmooth" c_casadi__SX__isSmooth :: Ptr (Ptr StdString) -> Ptr SX' -> IO CInt casadi__SX__isSmooth :: SX -> IO Bool casadi__SX__isSmooth x0 = withMarshal x0 $ \x0' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__isSmooth errStrPtrP x0' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_isSmooth :: SXClass a => a -> IO Bool sx_isSmooth x = casadi__SX__isSmooth (castSX x) -- direct wrapper foreign import ccall unsafe "casadi__SX__isSymbolic" c_casadi__SX__isSymbolic :: Ptr (Ptr StdString) -> Ptr SX' -> IO CInt casadi__SX__isSymbolic :: SX -> IO Bool casadi__SX__isSymbolic x0 = withMarshal x0 $ \x0' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__isSymbolic errStrPtrP x0' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_isSymbolic :: SXClass a => a -> IO Bool sx_isSymbolic x = casadi__SX__isSymbolic (castSX x) -- direct wrapper foreign import ccall unsafe "casadi__SX__isValidInput" c_casadi__SX__isValidInput :: Ptr (Ptr StdString) -> Ptr SX' -> IO CInt casadi__SX__isValidInput :: SX -> IO Bool casadi__SX__isValidInput x0 = withMarshal x0 $ \x0' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__isValidInput errStrPtrP x0' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_isValidInput :: SXClass a => a -> IO Bool sx_isValidInput x = casadi__SX__isValidInput (castSX x) -- direct wrapper foreign import ccall unsafe "casadi__SX__isZero" c_casadi__SX__isZero :: Ptr (Ptr StdString) -> Ptr SX' -> IO CInt casadi__SX__isZero :: SX -> IO Bool casadi__SX__isZero x0 = withMarshal x0 $ \x0' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__isZero errStrPtrP x0' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_isZero :: SXClass a => a -> IO Bool sx_isZero x = casadi__SX__isZero (castSX x) -- direct wrapper foreign import ccall unsafe "casadi__SX__iscolumn" c_casadi__SX__iscolumn :: Ptr (Ptr StdString) -> Ptr SX' -> IO CInt casadi__SX__iscolumn :: SX -> IO Bool casadi__SX__iscolumn x0 = withMarshal x0 $ \x0' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__iscolumn errStrPtrP x0' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_iscolumn :: SXClass a => a -> IO Bool sx_iscolumn x = casadi__SX__iscolumn (castSX x) -- direct wrapper foreign import ccall unsafe "casadi__SX__isdense" c_casadi__SX__isdense :: Ptr (Ptr StdString) -> Ptr SX' -> IO CInt casadi__SX__isdense :: SX -> IO Bool casadi__SX__isdense x0 = withMarshal x0 $ \x0' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__isdense errStrPtrP x0' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_isdense :: SXClass a => a -> IO Bool sx_isdense x = casadi__SX__isdense (castSX x) -- direct wrapper foreign import ccall unsafe "casadi__SX__isempty__0" c_casadi__SX__isempty__0 :: Ptr (Ptr StdString) -> Ptr SX' -> IO CInt casadi__SX__isempty__0 :: SX -> IO Bool casadi__SX__isempty__0 x0 = withMarshal x0 $ \x0' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__isempty__0 errStrPtrP x0' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_isempty__0 :: SXClass a => a -> IO Bool sx_isempty__0 x = casadi__SX__isempty__0 (castSX x) -- direct wrapper foreign import ccall unsafe "casadi__SX__isempty__1" c_casadi__SX__isempty__1 :: Ptr (Ptr StdString) -> Ptr SX' -> CInt -> IO CInt casadi__SX__isempty__1 :: SX -> Bool -> IO Bool casadi__SX__isempty__1 x0 x1 = withMarshal x0 $ \x0' -> withMarshal x1 $ \x1' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__isempty__1 errStrPtrP x0' x1' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_isempty__1 :: SXClass a => a -> Bool -> IO Bool sx_isempty__1 x = casadi__SX__isempty__1 (castSX x) -- direct wrapper foreign import ccall unsafe "casadi__SX__isrow" c_casadi__SX__isrow :: Ptr (Ptr StdString) -> Ptr SX' -> IO CInt casadi__SX__isrow :: SX -> IO Bool casadi__SX__isrow x0 = withMarshal x0 $ \x0' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__isrow errStrPtrP x0' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_isrow :: SXClass a => a -> IO Bool sx_isrow x = casadi__SX__isrow (castSX x) -- direct wrapper foreign import ccall unsafe "casadi__SX__isscalar__0" c_casadi__SX__isscalar__0 :: Ptr (Ptr StdString) -> Ptr SX' -> IO CInt casadi__SX__isscalar__0 :: SX -> IO Bool casadi__SX__isscalar__0 x0 = withMarshal x0 $ \x0' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__isscalar__0 errStrPtrP x0' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_isscalar__0 :: SXClass a => a -> IO Bool sx_isscalar__0 x = casadi__SX__isscalar__0 (castSX x) -- direct wrapper foreign import ccall unsafe "casadi__SX__isscalar__1" c_casadi__SX__isscalar__1 :: Ptr (Ptr StdString) -> Ptr SX' -> CInt -> IO CInt casadi__SX__isscalar__1 :: SX -> Bool -> IO Bool casadi__SX__isscalar__1 x0 x1 = withMarshal x0 $ \x0' -> withMarshal x1 $ \x1' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__isscalar__1 errStrPtrP x0' x1' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_isscalar__1 :: SXClass a => a -> Bool -> IO Bool sx_isscalar__1 x = casadi__SX__isscalar__1 (castSX x) -- direct wrapper foreign import ccall unsafe "casadi__SX__issquare" c_casadi__SX__issquare :: Ptr (Ptr StdString) -> Ptr SX' -> IO CInt casadi__SX__issquare :: SX -> IO Bool casadi__SX__issquare x0 = withMarshal x0 $ \x0' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__issquare errStrPtrP x0' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_issquare :: SXClass a => a -> IO Bool sx_issquare x = casadi__SX__issquare (castSX x) -- direct wrapper foreign import ccall unsafe "casadi__SX__istril" c_casadi__SX__istril :: Ptr (Ptr StdString) -> Ptr SX' -> IO CInt casadi__SX__istril :: SX -> IO Bool casadi__SX__istril x0 = withMarshal x0 $ \x0' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__istril errStrPtrP x0' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_istril :: SXClass a => a -> IO Bool sx_istril x = casadi__SX__istril (castSX x) -- direct wrapper foreign import ccall unsafe "casadi__SX__istriu" c_casadi__SX__istriu :: Ptr (Ptr StdString) -> Ptr SX' -> IO CInt casadi__SX__istriu :: SX -> IO Bool casadi__SX__istriu x0 = withMarshal x0 $ \x0' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__istriu errStrPtrP x0' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_istriu :: SXClass a => a -> IO Bool sx_istriu x = casadi__SX__istriu (castSX x) -- direct wrapper foreign import ccall unsafe "casadi__SX__isvector" c_casadi__SX__isvector :: Ptr (Ptr StdString) -> Ptr SX' -> IO CInt casadi__SX__isvector :: SX -> IO Bool casadi__SX__isvector x0 = withMarshal x0 $ \x0' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__isvector errStrPtrP x0' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_isvector :: SXClass a => a -> IO Bool sx_isvector x = casadi__SX__isvector (castSX x) -- direct wrapper foreign import ccall unsafe "casadi__SX__makeSparse__0" c_casadi__SX__makeSparse__0 :: Ptr (Ptr StdString) -> Ptr SX' -> IO () casadi__SX__makeSparse__0 :: SX -> IO () casadi__SX__makeSparse__0 x0 = withMarshal x0 $ \x0' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__makeSparse__0 errStrPtrP x0' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_makeSparse__0 :: SXClass a => a -> IO () sx_makeSparse__0 x = casadi__SX__makeSparse__0 (castSX x) -- direct wrapper foreign import ccall unsafe "casadi__SX__makeSparse__1" c_casadi__SX__makeSparse__1 :: Ptr (Ptr StdString) -> Ptr SX' -> CDouble -> IO () casadi__SX__makeSparse__1 :: SX -> Double -> IO () casadi__SX__makeSparse__1 x0 x1 = withMarshal x0 $ \x0' -> withMarshal x1 $ \x1' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__makeSparse__1 errStrPtrP x0' x1' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_makeSparse__1 :: SXClass a => a -> Double -> IO () sx_makeSparse__1 x = casadi__SX__makeSparse__1 (castSX x) -- direct wrapper foreign import ccall unsafe "casadi__SX__matrix_matrix" c_casadi__SX__matrix_matrix :: Ptr (Ptr StdString) -> CInt -> Ptr SX' -> Ptr SX' -> IO (Ptr SX') casadi__SX__matrix_matrix :: Int -> SX -> SX -> IO SX casadi__SX__matrix_matrix x0 x1 x2 = withMarshal x0 $ \x0' -> withMarshal x1 $ \x1' -> withMarshal x2 $ \x2' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__matrix_matrix errStrPtrP x0' x1' x2' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_matrix_matrix :: Int -> SX -> SX -> IO SX sx_matrix_matrix = casadi__SX__matrix_matrix -- direct wrapper foreign import ccall unsafe "casadi__SX__matrix_scalar" c_casadi__SX__matrix_scalar :: Ptr (Ptr StdString) -> CInt -> Ptr SX' -> Ptr SX' -> IO (Ptr SX') casadi__SX__matrix_scalar :: Int -> SX -> SX -> IO SX casadi__SX__matrix_scalar x0 x1 x2 = withMarshal x0 $ \x0' -> withMarshal x1 $ \x1' -> withMarshal x2 $ \x2' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__matrix_scalar errStrPtrP x0' x1' x2' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_matrix_scalar :: Int -> SX -> SX -> IO SX sx_matrix_scalar = casadi__SX__matrix_scalar -- direct wrapper foreign import ccall unsafe "casadi__SX__nan__0" c_casadi__SX__nan__0 :: Ptr (Ptr StdString) -> Ptr (StdPair CInt CInt) -> IO (Ptr SX') casadi__SX__nan__0 :: (Int, Int) -> IO SX casadi__SX__nan__0 x0 = withMarshal x0 $ \x0' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__nan__0 errStrPtrP x0' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_nan__0 :: (Int, Int) -> IO SX sx_nan__0 = casadi__SX__nan__0 -- direct wrapper foreign import ccall unsafe "casadi__SX__nan__1" c_casadi__SX__nan__1 :: Ptr (Ptr StdString) -> IO (Ptr SX') casadi__SX__nan__1 :: IO SX casadi__SX__nan__1 = do errStrPtrP <- new nullPtr ret <- c_casadi__SX__nan__1 errStrPtrP errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_nan__1 :: IO SX sx_nan__1 = casadi__SX__nan__1 -- direct wrapper foreign import ccall unsafe "casadi__SX__nan__2" c_casadi__SX__nan__2 :: Ptr (Ptr StdString) -> CInt -> IO (Ptr SX') casadi__SX__nan__2 :: Int -> IO SX casadi__SX__nan__2 x0 = withMarshal x0 $ \x0' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__nan__2 errStrPtrP x0' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_nan__2 :: Int -> IO SX sx_nan__2 = casadi__SX__nan__2 -- direct wrapper foreign import ccall unsafe "casadi__SX__nan__3" c_casadi__SX__nan__3 :: Ptr (Ptr StdString) -> CInt -> CInt -> IO (Ptr SX') casadi__SX__nan__3 :: Int -> Int -> IO SX casadi__SX__nan__3 x0 x1 = withMarshal x0 $ \x0' -> withMarshal x1 $ \x1' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__nan__3 errStrPtrP x0' x1' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_nan__3 :: Int -> Int -> IO SX sx_nan__3 = casadi__SX__nan__3 -- direct wrapper foreign import ccall unsafe "casadi__SX__nan__4" c_casadi__SX__nan__4 :: Ptr (Ptr StdString) -> Ptr Sparsity' -> IO (Ptr SX') casadi__SX__nan__4 :: Sparsity -> IO SX casadi__SX__nan__4 x0 = withMarshal x0 $ \x0' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__nan__4 errStrPtrP x0' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_nan__4 :: Sparsity -> IO SX sx_nan__4 = casadi__SX__nan__4 -- direct wrapper foreign import ccall unsafe "casadi__SX__nnz" c_casadi__SX__nnz :: Ptr (Ptr StdString) -> Ptr SX' -> IO CInt casadi__SX__nnz :: SX -> IO Int casadi__SX__nnz x0 = withMarshal x0 $ \x0' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__nnz errStrPtrP x0' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_nnz :: SXClass a => a -> IO Int sx_nnz x = casadi__SX__nnz (castSX x) -- direct wrapper foreign import ccall unsafe "casadi__SX__nonzeros" c_casadi__SX__nonzeros :: Ptr (Ptr StdString) -> Ptr SX' -> IO (Ptr (StdVec CDouble)) casadi__SX__nonzeros :: SX -> IO (Vector Double) casadi__SX__nonzeros x0 = withMarshal x0 $ \x0' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__nonzeros errStrPtrP x0' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_nonzeros :: SXClass a => a -> IO (Vector Double) sx_nonzeros x = casadi__SX__nonzeros (castSX x) -- direct wrapper foreign import ccall unsafe "casadi__SX__nonzeros_int" c_casadi__SX__nonzeros_int :: Ptr (Ptr StdString) -> Ptr SX' -> IO (Ptr (StdVec CInt)) casadi__SX__nonzeros_int :: SX -> IO (Vector Int) casadi__SX__nonzeros_int x0 = withMarshal x0 $ \x0' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__nonzeros_int errStrPtrP x0' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_nonzeros_int :: SXClass a => a -> IO (Vector Int) sx_nonzeros_int x = casadi__SX__nonzeros_int (castSX x) -- direct wrapper foreign import ccall unsafe "casadi__SX__numel__0" c_casadi__SX__numel__0 :: Ptr (Ptr StdString) -> Ptr SX' -> CInt -> IO CInt casadi__SX__numel__0 :: SX -> Int -> IO Int casadi__SX__numel__0 x0 x1 = withMarshal x0 $ \x0' -> withMarshal x1 $ \x1' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__numel__0 errStrPtrP x0' x1' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_numel__0 :: SXClass a => a -> Int -> IO Int sx_numel__0 x = casadi__SX__numel__0 (castSX x) -- direct wrapper foreign import ccall unsafe "casadi__SX__numel__1" c_casadi__SX__numel__1 :: Ptr (Ptr StdString) -> Ptr SX' -> IO CInt casadi__SX__numel__1 :: SX -> IO Int casadi__SX__numel__1 x0 = withMarshal x0 $ \x0' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__numel__1 errStrPtrP x0' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_numel__1 :: SXClass a => a -> IO Int sx_numel__1 x = casadi__SX__numel__1 (castSX x) -- direct wrapper foreign import ccall unsafe "casadi__SX__ones__0" c_casadi__SX__ones__0 :: Ptr (Ptr StdString) -> Ptr (StdPair CInt CInt) -> IO (Ptr SX') casadi__SX__ones__0 :: (Int, Int) -> IO SX casadi__SX__ones__0 x0 = withMarshal x0 $ \x0' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__ones__0 errStrPtrP x0' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_ones__0 :: (Int, Int) -> IO SX sx_ones__0 = casadi__SX__ones__0 -- direct wrapper foreign import ccall unsafe "casadi__SX__ones__1" c_casadi__SX__ones__1 :: Ptr (Ptr StdString) -> Ptr Sparsity' -> IO (Ptr SX') casadi__SX__ones__1 :: Sparsity -> IO SX casadi__SX__ones__1 x0 = withMarshal x0 $ \x0' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__ones__1 errStrPtrP x0' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_ones__1 :: Sparsity -> IO SX sx_ones__1 = casadi__SX__ones__1 -- direct wrapper foreign import ccall unsafe "casadi__SX__ones__2" c_casadi__SX__ones__2 :: Ptr (Ptr StdString) -> IO (Ptr SX') casadi__SX__ones__2 :: IO SX casadi__SX__ones__2 = do errStrPtrP <- new nullPtr ret <- c_casadi__SX__ones__2 errStrPtrP errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_ones__2 :: IO SX sx_ones__2 = casadi__SX__ones__2 -- direct wrapper foreign import ccall unsafe "casadi__SX__ones__3" c_casadi__SX__ones__3 :: Ptr (Ptr StdString) -> CInt -> IO (Ptr SX') casadi__SX__ones__3 :: Int -> IO SX casadi__SX__ones__3 x0 = withMarshal x0 $ \x0' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__ones__3 errStrPtrP x0' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_ones__3 :: Int -> IO SX sx_ones__3 = casadi__SX__ones__3 -- direct wrapper foreign import ccall unsafe "casadi__SX__ones__4" c_casadi__SX__ones__4 :: Ptr (Ptr StdString) -> CInt -> CInt -> IO (Ptr SX') casadi__SX__ones__4 :: Int -> Int -> IO SX casadi__SX__ones__4 x0 x1 = withMarshal x0 $ \x0' -> withMarshal x1 $ \x1' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__ones__4 errStrPtrP x0' x1' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_ones__4 :: Int -> Int -> IO SX sx_ones__4 = casadi__SX__ones__4 -- direct wrapper foreign import ccall unsafe "casadi__SX__operator_plus" c_casadi__SX__operator_plus :: Ptr (Ptr StdString) -> Ptr SX' -> IO (Ptr SX') casadi__SX__operator_plus :: SX -> IO SX casadi__SX__operator_plus x0 = withMarshal x0 $ \x0' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__operator_plus errStrPtrP x0' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_operator_plus :: SXClass a => a -> IO SX sx_operator_plus x = casadi__SX__operator_plus (castSX x) -- direct wrapper foreign import ccall unsafe "casadi__SX__operator_minus" c_casadi__SX__operator_minus :: Ptr (Ptr StdString) -> Ptr SX' -> IO (Ptr SX') casadi__SX__operator_minus :: SX -> IO SX casadi__SX__operator_minus x0 = withMarshal x0 $ \x0' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__operator_minus errStrPtrP x0' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_operator_minus :: SXClass a => a -> IO SX sx_operator_minus x = casadi__SX__operator_minus (castSX x) -- direct wrapper foreign import ccall unsafe "casadi__SX__printDense" c_casadi__SX__printDense :: Ptr (Ptr StdString) -> Ptr SX' -> IO () casadi__SX__printDense :: SX -> IO () casadi__SX__printDense x0 = withMarshal x0 $ \x0' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__printDense errStrPtrP x0' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_printDense :: SXClass a => a -> IO () sx_printDense x = casadi__SX__printDense (castSX x) -- direct wrapper foreign import ccall unsafe "casadi__SX__printScalar" c_casadi__SX__printScalar :: Ptr (Ptr StdString) -> Ptr SX' -> IO () casadi__SX__printScalar :: SX -> IO () casadi__SX__printScalar x0 = withMarshal x0 $ \x0' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__printScalar errStrPtrP x0' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_printScalar :: SXClass a => a -> IO () sx_printScalar x = casadi__SX__printScalar (castSX x) -- direct wrapper foreign import ccall unsafe "casadi__SX__printSparse" c_casadi__SX__printSparse :: Ptr (Ptr StdString) -> Ptr SX' -> IO () casadi__SX__printSparse :: SX -> IO () casadi__SX__printSparse x0 = withMarshal x0 $ \x0' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__printSparse errStrPtrP x0' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_printSparse :: SXClass a => a -> IO () sx_printSparse x = casadi__SX__printSparse (castSX x) -- direct wrapper foreign import ccall unsafe "casadi__SX__printSplit" c_casadi__SX__printSplit :: Ptr (Ptr StdString) -> Ptr SX' -> Ptr (StdVec (Ptr StdString)) -> Ptr (StdVec (Ptr StdString)) -> IO () casadi__SX__printSplit :: SX -> Vector String -> Vector String -> IO () casadi__SX__printSplit x0 x1 x2 = withMarshal x0 $ \x0' -> withMarshal x1 $ \x1' -> withMarshal x2 $ \x2' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__printSplit errStrPtrP x0' x1' x2' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_printSplit :: SXClass a => a -> Vector String -> Vector String -> IO () sx_printSplit x = casadi__SX__printSplit (castSX x) -- direct wrapper foreign import ccall unsafe "casadi__SX__printVector" c_casadi__SX__printVector :: Ptr (Ptr StdString) -> Ptr SX' -> IO () casadi__SX__printVector :: SX -> IO () casadi__SX__printVector x0 = withMarshal x0 $ \x0' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__printVector errStrPtrP x0' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_printVector :: SXClass a => a -> IO () sx_printVector x = casadi__SX__printVector (castSX x) -- direct wrapper foreign import ccall unsafe "casadi__SX__printme" c_casadi__SX__printme :: Ptr (Ptr StdString) -> Ptr SX' -> Ptr SX' -> IO (Ptr SX') casadi__SX__printme :: SX -> SX -> IO SX casadi__SX__printme x0 x1 = withMarshal x0 $ \x0' -> withMarshal x1 $ \x1' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__printme errStrPtrP x0' x1' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_printme :: SXClass a => a -> SX -> IO SX sx_printme x = casadi__SX__printme (castSX x) -- direct wrapper foreign import ccall unsafe "casadi__SX__remove" c_casadi__SX__remove :: Ptr (Ptr StdString) -> Ptr SX' -> Ptr (StdVec CInt) -> Ptr (StdVec CInt) -> IO () casadi__SX__remove :: SX -> Vector Int -> Vector Int -> IO () casadi__SX__remove x0 x1 x2 = withMarshal x0 $ \x0' -> withMarshal x1 $ \x1' -> withMarshal x2 $ \x2' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__remove errStrPtrP x0' x1' x2' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_remove :: SXClass a => a -> Vector Int -> Vector Int -> IO () sx_remove x = casadi__SX__remove (castSX x) -- direct wrapper foreign import ccall unsafe "casadi__SX__reserve__0" c_casadi__SX__reserve__0 :: Ptr (Ptr StdString) -> Ptr SX' -> CInt -> CInt -> IO () casadi__SX__reserve__0 :: SX -> Int -> Int -> IO () casadi__SX__reserve__0 x0 x1 x2 = withMarshal x0 $ \x0' -> withMarshal x1 $ \x1' -> withMarshal x2 $ \x2' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__reserve__0 errStrPtrP x0' x1' x2' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_reserve__0 :: SXClass a => a -> Int -> Int -> IO () sx_reserve__0 x = casadi__SX__reserve__0 (castSX x) -- direct wrapper foreign import ccall unsafe "casadi__SX__reserve__1" c_casadi__SX__reserve__1 :: Ptr (Ptr StdString) -> Ptr SX' -> CInt -> IO () casadi__SX__reserve__1 :: SX -> Int -> IO () casadi__SX__reserve__1 x0 x1 = withMarshal x0 $ \x0' -> withMarshal x1 $ \x1' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__reserve__1 errStrPtrP x0' x1' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_reserve__1 :: SXClass a => a -> Int -> IO () sx_reserve__1 x = casadi__SX__reserve__1 (castSX x) -- direct wrapper foreign import ccall unsafe "casadi__SX__resetInput" c_casadi__SX__resetInput :: Ptr (Ptr StdString) -> Ptr SX' -> IO () casadi__SX__resetInput :: SX -> IO () casadi__SX__resetInput x0 = withMarshal x0 $ \x0' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__resetInput errStrPtrP x0' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_resetInput :: SXClass a => a -> IO () sx_resetInput x = casadi__SX__resetInput (castSX x) -- direct wrapper foreign import ccall unsafe "casadi__SX__resize" c_casadi__SX__resize :: Ptr (Ptr StdString) -> Ptr SX' -> CInt -> CInt -> IO () casadi__SX__resize :: SX -> Int -> Int -> IO () casadi__SX__resize x0 x1 x2 = withMarshal x0 $ \x0' -> withMarshal x1 $ \x1' -> withMarshal x2 $ \x2' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__resize errStrPtrP x0' x1' x2' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_resize :: SXClass a => a -> Int -> Int -> IO () sx_resize x = casadi__SX__resize (castSX x) -- direct wrapper foreign import ccall unsafe "casadi__SX__row" c_casadi__SX__row :: Ptr (Ptr StdString) -> Ptr SX' -> CInt -> IO CInt casadi__SX__row :: SX -> Int -> IO Int casadi__SX__row x0 x1 = withMarshal x0 $ \x0' -> withMarshal x1 $ \x1' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__row errStrPtrP x0' x1' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_row :: SXClass a => a -> Int -> IO Int sx_row x = casadi__SX__row (castSX x) -- direct wrapper foreign import ccall unsafe "casadi__SX__sanityCheck__0" c_casadi__SX__sanityCheck__0 :: Ptr (Ptr StdString) -> Ptr SX' -> IO () casadi__SX__sanityCheck__0 :: SX -> IO () casadi__SX__sanityCheck__0 x0 = withMarshal x0 $ \x0' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__sanityCheck__0 errStrPtrP x0' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_sanityCheck__0 :: SXClass a => a -> IO () sx_sanityCheck__0 x = casadi__SX__sanityCheck__0 (castSX x) -- direct wrapper foreign import ccall unsafe "casadi__SX__sanityCheck__1" c_casadi__SX__sanityCheck__1 :: Ptr (Ptr StdString) -> Ptr SX' -> CInt -> IO () casadi__SX__sanityCheck__1 :: SX -> Bool -> IO () casadi__SX__sanityCheck__1 x0 x1 = withMarshal x0 $ \x0' -> withMarshal x1 $ \x1' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__sanityCheck__1 errStrPtrP x0' x1' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_sanityCheck__1 :: SXClass a => a -> Bool -> IO () sx_sanityCheck__1 x = casadi__SX__sanityCheck__1 (castSX x) -- direct wrapper foreign import ccall unsafe "casadi__SX__scalar_matrix" c_casadi__SX__scalar_matrix :: Ptr (Ptr StdString) -> CInt -> Ptr SX' -> Ptr SX' -> IO (Ptr SX') casadi__SX__scalar_matrix :: Int -> SX -> SX -> IO SX casadi__SX__scalar_matrix x0 x1 x2 = withMarshal x0 $ \x0' -> withMarshal x1 $ \x1' -> withMarshal x2 $ \x2' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__scalar_matrix errStrPtrP x0' x1' x2' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_scalar_matrix :: Int -> SX -> SX -> IO SX sx_scalar_matrix = casadi__SX__scalar_matrix -- direct wrapper foreign import ccall unsafe "casadi__SX__set__0" c_casadi__SX__set__0 :: Ptr (Ptr StdString) -> Ptr SX' -> Ptr SX' -> CInt -> Ptr IMatrix' -> Ptr IMatrix' -> IO () casadi__SX__set__0 :: SX -> SX -> Bool -> IMatrix -> IMatrix -> IO () casadi__SX__set__0 x0 x1 x2 x3 x4 = withMarshal x0 $ \x0' -> withMarshal x1 $ \x1' -> withMarshal x2 $ \x2' -> withMarshal x3 $ \x3' -> withMarshal x4 $ \x4' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__set__0 errStrPtrP x0' x1' x2' x3' x4' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_set__0 :: SXClass a => a -> SX -> Bool -> IMatrix -> IMatrix -> IO () sx_set__0 x = casadi__SX__set__0 (castSX x) -- direct wrapper foreign import ccall unsafe "casadi__SX__set__1" c_casadi__SX__set__1 :: Ptr (Ptr StdString) -> Ptr SX' -> Ptr SX' -> CInt -> Ptr IMatrix' -> Ptr Slice' -> IO () casadi__SX__set__1 :: SX -> SX -> Bool -> IMatrix -> Slice -> IO () casadi__SX__set__1 x0 x1 x2 x3 x4 = withMarshal x0 $ \x0' -> withMarshal x1 $ \x1' -> withMarshal x2 $ \x2' -> withMarshal x3 $ \x3' -> withMarshal x4 $ \x4' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__set__1 errStrPtrP x0' x1' x2' x3' x4' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_set__1 :: SXClass a => a -> SX -> Bool -> IMatrix -> Slice -> IO () sx_set__1 x = casadi__SX__set__1 (castSX x) -- direct wrapper foreign import ccall unsafe "casadi__SX__set__2" c_casadi__SX__set__2 :: Ptr (Ptr StdString) -> Ptr SX' -> Ptr SX' -> CInt -> Ptr Slice' -> Ptr IMatrix' -> IO () casadi__SX__set__2 :: SX -> SX -> Bool -> Slice -> IMatrix -> IO () casadi__SX__set__2 x0 x1 x2 x3 x4 = withMarshal x0 $ \x0' -> withMarshal x1 $ \x1' -> withMarshal x2 $ \x2' -> withMarshal x3 $ \x3' -> withMarshal x4 $ \x4' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__set__2 errStrPtrP x0' x1' x2' x3' x4' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_set__2 :: SXClass a => a -> SX -> Bool -> Slice -> IMatrix -> IO () sx_set__2 x = casadi__SX__set__2 (castSX x) -- direct wrapper foreign import ccall unsafe "casadi__SX__set__3" c_casadi__SX__set__3 :: Ptr (Ptr StdString) -> Ptr SX' -> Ptr SX' -> CInt -> Ptr Slice' -> Ptr Slice' -> IO () casadi__SX__set__3 :: SX -> SX -> Bool -> Slice -> Slice -> IO () casadi__SX__set__3 x0 x1 x2 x3 x4 = withMarshal x0 $ \x0' -> withMarshal x1 $ \x1' -> withMarshal x2 $ \x2' -> withMarshal x3 $ \x3' -> withMarshal x4 $ \x4' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__set__3 errStrPtrP x0' x1' x2' x3' x4' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_set__3 :: SXClass a => a -> SX -> Bool -> Slice -> Slice -> IO () sx_set__3 x = casadi__SX__set__3 (castSX x) -- direct wrapper foreign import ccall unsafe "casadi__SX__set__4" c_casadi__SX__set__4 :: Ptr (Ptr StdString) -> Ptr SX' -> Ptr SX' -> CInt -> Ptr Sparsity' -> IO () casadi__SX__set__4 :: SX -> SX -> Bool -> Sparsity -> IO () casadi__SX__set__4 x0 x1 x2 x3 = withMarshal x0 $ \x0' -> withMarshal x1 $ \x1' -> withMarshal x2 $ \x2' -> withMarshal x3 $ \x3' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__set__4 errStrPtrP x0' x1' x2' x3' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_set__4 :: SXClass a => a -> SX -> Bool -> Sparsity -> IO () sx_set__4 x = casadi__SX__set__4 (castSX x) -- direct wrapper foreign import ccall unsafe "casadi__SX__set__5" c_casadi__SX__set__5 :: Ptr (Ptr StdString) -> Ptr SX' -> Ptr SX' -> CInt -> Ptr IMatrix' -> IO () casadi__SX__set__5 :: SX -> SX -> Bool -> IMatrix -> IO () casadi__SX__set__5 x0 x1 x2 x3 = withMarshal x0 $ \x0' -> withMarshal x1 $ \x1' -> withMarshal x2 $ \x2' -> withMarshal x3 $ \x3' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__set__5 errStrPtrP x0' x1' x2' x3' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_set__5 :: SXClass a => a -> SX -> Bool -> IMatrix -> IO () sx_set__5 x = casadi__SX__set__5 (castSX x) -- direct wrapper foreign import ccall unsafe "casadi__SX__set__6" c_casadi__SX__set__6 :: Ptr (Ptr StdString) -> Ptr SX' -> Ptr SX' -> CInt -> Ptr Slice' -> IO () casadi__SX__set__6 :: SX -> SX -> Bool -> Slice -> IO () casadi__SX__set__6 x0 x1 x2 x3 = withMarshal x0 $ \x0' -> withMarshal x1 $ \x1' -> withMarshal x2 $ \x2' -> withMarshal x3 $ \x3' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__set__6 errStrPtrP x0' x1' x2' x3' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_set__6 :: SXClass a => a -> SX -> Bool -> Slice -> IO () sx_set__6 x = casadi__SX__set__6 (castSX x) -- direct wrapper foreign import ccall unsafe "casadi__SX__set__7" c_casadi__SX__set__7 :: Ptr (Ptr StdString) -> Ptr SX' -> Ptr (StdVec CDouble) -> IO () casadi__SX__set__7 :: SX -> Vector Double -> IO () casadi__SX__set__7 x0 x1 = withMarshal x0 $ \x0' -> withMarshal x1 $ \x1' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__set__7 errStrPtrP x0' x1' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_set__7 :: SXClass a => a -> Vector Double -> IO () sx_set__7 x = casadi__SX__set__7 (castSX x) -- direct wrapper foreign import ccall unsafe "casadi__SX__set__8" c_casadi__SX__set__8 :: Ptr (Ptr StdString) -> Ptr SX' -> Ptr (StdVec CDouble) -> CInt -> IO () casadi__SX__set__8 :: SX -> Vector Double -> Bool -> IO () casadi__SX__set__8 x0 x1 x2 = withMarshal x0 $ \x0' -> withMarshal x1 $ \x1' -> withMarshal x2 $ \x2' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__set__8 errStrPtrP x0' x1' x2' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_set__8 :: SXClass a => a -> Vector Double -> Bool -> IO () sx_set__8 x = casadi__SX__set__8 (castSX x) -- direct wrapper foreign import ccall unsafe "casadi__SX__set__9" c_casadi__SX__set__9 :: Ptr (Ptr StdString) -> Ptr SX' -> CDouble -> IO () casadi__SX__set__9 :: SX -> Double -> IO () casadi__SX__set__9 x0 x1 = withMarshal x0 $ \x0' -> withMarshal x1 $ \x1' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__set__9 errStrPtrP x0' x1' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_set__9 :: SXClass a => a -> Double -> IO () sx_set__9 x = casadi__SX__set__9 (castSX x) -- direct wrapper foreign import ccall unsafe "casadi__SX__set__10" c_casadi__SX__set__10 :: Ptr (Ptr StdString) -> Ptr SX' -> Ptr SX' -> IO () casadi__SX__set__10 :: SX -> SX -> IO () casadi__SX__set__10 x0 x1 = withMarshal x0 $ \x0' -> withMarshal x1 $ \x1' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__set__10 errStrPtrP x0' x1' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_set__10 :: SXClass a => a -> SX -> IO () sx_set__10 x = casadi__SX__set__10 (castSX x) -- direct wrapper foreign import ccall unsafe "casadi__SX__setEqualityCheckingDepth__0" c_casadi__SX__setEqualityCheckingDepth__0 :: Ptr (Ptr StdString) -> IO () casadi__SX__setEqualityCheckingDepth__0 :: IO () casadi__SX__setEqualityCheckingDepth__0 = do errStrPtrP <- new nullPtr ret <- c_casadi__SX__setEqualityCheckingDepth__0 errStrPtrP errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_setEqualityCheckingDepth__0 :: IO () sx_setEqualityCheckingDepth__0 = casadi__SX__setEqualityCheckingDepth__0 -- direct wrapper foreign import ccall unsafe "casadi__SX__setEqualityCheckingDepth__1" c_casadi__SX__setEqualityCheckingDepth__1 :: Ptr (Ptr StdString) -> CInt -> IO () casadi__SX__setEqualityCheckingDepth__1 :: Int -> IO () casadi__SX__setEqualityCheckingDepth__1 x0 = withMarshal x0 $ \x0' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__setEqualityCheckingDepth__1 errStrPtrP x0' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_setEqualityCheckingDepth__1 :: Int -> IO () sx_setEqualityCheckingDepth__1 = casadi__SX__setEqualityCheckingDepth__1 -- direct wrapper foreign import ccall unsafe "casadi__SX__setNZ__0" c_casadi__SX__setNZ__0 :: Ptr (Ptr StdString) -> Ptr SX' -> Ptr SX' -> CInt -> Ptr IMatrix' -> IO () casadi__SX__setNZ__0 :: SX -> SX -> Bool -> IMatrix -> IO () casadi__SX__setNZ__0 x0 x1 x2 x3 = withMarshal x0 $ \x0' -> withMarshal x1 $ \x1' -> withMarshal x2 $ \x2' -> withMarshal x3 $ \x3' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__setNZ__0 errStrPtrP x0' x1' x2' x3' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_setNZ__0 :: SXClass a => a -> SX -> Bool -> IMatrix -> IO () sx_setNZ__0 x = casadi__SX__setNZ__0 (castSX x) -- direct wrapper foreign import ccall unsafe "casadi__SX__setNZ__1" c_casadi__SX__setNZ__1 :: Ptr (Ptr StdString) -> Ptr SX' -> Ptr SX' -> CInt -> Ptr Slice' -> IO () casadi__SX__setNZ__1 :: SX -> SX -> Bool -> Slice -> IO () casadi__SX__setNZ__1 x0 x1 x2 x3 = withMarshal x0 $ \x0' -> withMarshal x1 $ \x1' -> withMarshal x2 $ \x2' -> withMarshal x3 $ \x3' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__setNZ__1 errStrPtrP x0' x1' x2' x3' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_setNZ__1 :: SXClass a => a -> SX -> Bool -> Slice -> IO () sx_setNZ__1 x = casadi__SX__setNZ__1 (castSX x) -- direct wrapper foreign import ccall unsafe "casadi__SX__setNZ__2" c_casadi__SX__setNZ__2 :: Ptr (Ptr StdString) -> Ptr SX' -> Ptr (StdVec CDouble) -> IO () casadi__SX__setNZ__2 :: SX -> Vector Double -> IO () casadi__SX__setNZ__2 x0 x1 = withMarshal x0 $ \x0' -> withMarshal x1 $ \x1' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__setNZ__2 errStrPtrP x0' x1' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_setNZ__2 :: SXClass a => a -> Vector Double -> IO () sx_setNZ__2 x = casadi__SX__setNZ__2 (castSX x) -- direct wrapper foreign import ccall unsafe "casadi__SX__setNZ__3" c_casadi__SX__setNZ__3 :: Ptr (Ptr StdString) -> Ptr SX' -> CDouble -> IO () casadi__SX__setNZ__3 :: SX -> Double -> IO () casadi__SX__setNZ__3 x0 x1 = withMarshal x0 $ \x0' -> withMarshal x1 $ \x1' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__setNZ__3 errStrPtrP x0' x1' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_setNZ__3 :: SXClass a => a -> Double -> IO () sx_setNZ__3 x = casadi__SX__setNZ__3 (castSX x) -- direct wrapper foreign import ccall unsafe "casadi__SX__setPrecision" c_casadi__SX__setPrecision :: Ptr (Ptr StdString) -> CInt -> IO () casadi__SX__setPrecision :: Int -> IO () casadi__SX__setPrecision x0 = withMarshal x0 $ \x0' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__setPrecision errStrPtrP x0' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_setPrecision :: Int -> IO () sx_setPrecision = casadi__SX__setPrecision -- direct wrapper foreign import ccall unsafe "casadi__SX__setScientific" c_casadi__SX__setScientific :: Ptr (Ptr StdString) -> CInt -> IO () casadi__SX__setScientific :: Bool -> IO () casadi__SX__setScientific x0 = withMarshal x0 $ \x0' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__setScientific errStrPtrP x0' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_setScientific :: Bool -> IO () sx_setScientific = casadi__SX__setScientific -- direct wrapper foreign import ccall unsafe "casadi__SX__setSym" c_casadi__SX__setSym :: Ptr (Ptr StdString) -> Ptr SX' -> Ptr (StdVec CDouble) -> IO () casadi__SX__setSym :: SX -> Vector Double -> IO () casadi__SX__setSym x0 x1 = withMarshal x0 $ \x0' -> withMarshal x1 $ \x1' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__setSym errStrPtrP x0' x1' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_setSym :: SXClass a => a -> Vector Double -> IO () sx_setSym x = casadi__SX__setSym (castSX x) -- direct wrapper foreign import ccall unsafe "casadi__SX__setValue__0" c_casadi__SX__setValue__0 :: Ptr (Ptr StdString) -> Ptr SX' -> CDouble -> CInt -> IO () casadi__SX__setValue__0 :: SX -> Double -> Int -> IO () casadi__SX__setValue__0 x0 x1 x2 = withMarshal x0 $ \x0' -> withMarshal x1 $ \x1' -> withMarshal x2 $ \x2' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__setValue__0 errStrPtrP x0' x1' x2' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_setValue__0 :: SXClass a => a -> Double -> Int -> IO () sx_setValue__0 x = casadi__SX__setValue__0 (castSX x) -- direct wrapper foreign import ccall unsafe "casadi__SX__setValue__1" c_casadi__SX__setValue__1 :: Ptr (Ptr StdString) -> Ptr SX' -> CDouble -> IO () casadi__SX__setValue__1 :: SX -> Double -> IO () casadi__SX__setValue__1 x0 x1 = withMarshal x0 $ \x0' -> withMarshal x1 $ \x1' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__setValue__1 errStrPtrP x0' x1' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_setValue__1 :: SXClass a => a -> Double -> IO () sx_setValue__1 x = casadi__SX__setValue__1 (castSX x) -- direct wrapper foreign import ccall unsafe "casadi__SX__setWidth" c_casadi__SX__setWidth :: Ptr (Ptr StdString) -> CInt -> IO () casadi__SX__setWidth :: Int -> IO () casadi__SX__setWidth x0 = withMarshal x0 $ \x0' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__setWidth errStrPtrP x0' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_setWidth :: Int -> IO () sx_setWidth = casadi__SX__setWidth -- direct wrapper foreign import ccall unsafe "casadi__SX__setZero" c_casadi__SX__setZero :: Ptr (Ptr StdString) -> Ptr SX' -> IO () casadi__SX__setZero :: SX -> IO () casadi__SX__setZero x0 = withMarshal x0 $ \x0' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__setZero errStrPtrP x0' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_setZero :: SXClass a => a -> IO () sx_setZero x = casadi__SX__setZero (castSX x) -- direct wrapper foreign import ccall unsafe "casadi__SX__shape__0" c_casadi__SX__shape__0 :: Ptr (Ptr StdString) -> Ptr SX' -> CInt -> IO CInt casadi__SX__shape__0 :: SX -> Int -> IO Int casadi__SX__shape__0 x0 x1 = withMarshal x0 $ \x0' -> withMarshal x1 $ \x1' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__shape__0 errStrPtrP x0' x1' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_shape__0 :: SXClass a => a -> Int -> IO Int sx_shape__0 x = casadi__SX__shape__0 (castSX x) -- direct wrapper foreign import ccall unsafe "casadi__SX__shape__1" c_casadi__SX__shape__1 :: Ptr (Ptr StdString) -> Ptr SX' -> IO (Ptr (StdPair CInt CInt)) casadi__SX__shape__1 :: SX -> IO (Int, Int) casadi__SX__shape__1 x0 = withMarshal x0 $ \x0' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__shape__1 errStrPtrP x0' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_shape__1 :: SXClass a => a -> IO (Int, Int) sx_shape__1 x = casadi__SX__shape__1 (castSX x) -- direct wrapper foreign import ccall unsafe "casadi__SX__size" c_casadi__SX__size :: Ptr (Ptr StdString) -> Ptr SX' -> IO CInt casadi__SX__size :: SX -> IO Int casadi__SX__size x0 = withMarshal x0 $ \x0' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__size errStrPtrP x0' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_size :: SXClass a => a -> IO Int sx_size x = casadi__SX__size (castSX x) -- direct wrapper foreign import ccall unsafe "casadi__SX__size1" c_casadi__SX__size1 :: Ptr (Ptr StdString) -> Ptr SX' -> IO CInt casadi__SX__size1 :: SX -> IO Int casadi__SX__size1 x0 = withMarshal x0 $ \x0' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__size1 errStrPtrP x0' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_size1 :: SXClass a => a -> IO Int sx_size1 x = casadi__SX__size1 (castSX x) -- direct wrapper foreign import ccall unsafe "casadi__SX__size2" c_casadi__SX__size2 :: Ptr (Ptr StdString) -> Ptr SX' -> IO CInt casadi__SX__size2 :: SX -> IO Int casadi__SX__size2 x0 = withMarshal x0 $ \x0' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__size2 errStrPtrP x0' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_size2 :: SXClass a => a -> IO Int sx_size2 x = casadi__SX__size2 (castSX x) -- direct wrapper foreign import ccall unsafe "casadi__SX__sizeD" c_casadi__SX__sizeD :: Ptr (Ptr StdString) -> Ptr SX' -> IO CInt casadi__SX__sizeD :: SX -> IO Int casadi__SX__sizeD x0 = withMarshal x0 $ \x0' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__sizeD errStrPtrP x0' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_sizeD :: SXClass a => a -> IO Int sx_sizeD x = casadi__SX__sizeD (castSX x) -- direct wrapper foreign import ccall unsafe "casadi__SX__sizeL" c_casadi__SX__sizeL :: Ptr (Ptr StdString) -> Ptr SX' -> IO CInt casadi__SX__sizeL :: SX -> IO Int casadi__SX__sizeL x0 = withMarshal x0 $ \x0' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__sizeL errStrPtrP x0' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_sizeL :: SXClass a => a -> IO Int sx_sizeL x = casadi__SX__sizeL (castSX x) -- direct wrapper foreign import ccall unsafe "casadi__SX__sizeU" c_casadi__SX__sizeU :: Ptr (Ptr StdString) -> Ptr SX' -> IO CInt casadi__SX__sizeU :: SX -> IO Int casadi__SX__sizeU x0 = withMarshal x0 $ \x0' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__sizeU errStrPtrP x0' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_sizeU :: SXClass a => a -> IO Int sx_sizeU x = casadi__SX__sizeU (castSX x) -- direct wrapper foreign import ccall unsafe "casadi__SX__sparse__0" c_casadi__SX__sparse__0 :: Ptr (Ptr StdString) -> Ptr Sparsity' -> Ptr SX' -> IO (Ptr SX') casadi__SX__sparse__0 :: Sparsity -> SX -> IO SX casadi__SX__sparse__0 x0 x1 = withMarshal x0 $ \x0' -> withMarshal x1 $ \x1' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__sparse__0 errStrPtrP x0' x1' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_sparse__0 :: Sparsity -> SX -> IO SX sx_sparse__0 = casadi__SX__sparse__0 -- direct wrapper foreign import ccall unsafe "casadi__SX__sparse__1" c_casadi__SX__sparse__1 :: Ptr (Ptr StdString) -> Ptr (StdPair CInt CInt) -> IO (Ptr SX') casadi__SX__sparse__1 :: (Int, Int) -> IO SX casadi__SX__sparse__1 x0 = withMarshal x0 $ \x0' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__sparse__1 errStrPtrP x0' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_sparse__1 :: (Int, Int) -> IO SX sx_sparse__1 = casadi__SX__sparse__1 -- direct wrapper foreign import ccall unsafe "casadi__SX__sparse__2" c_casadi__SX__sparse__2 :: Ptr (Ptr StdString) -> IO (Ptr SX') casadi__SX__sparse__2 :: IO SX casadi__SX__sparse__2 = do errStrPtrP <- new nullPtr ret <- c_casadi__SX__sparse__2 errStrPtrP errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_sparse__2 :: IO SX sx_sparse__2 = casadi__SX__sparse__2 -- direct wrapper foreign import ccall unsafe "casadi__SX__sparse__3" c_casadi__SX__sparse__3 :: Ptr (Ptr StdString) -> CInt -> IO (Ptr SX') casadi__SX__sparse__3 :: Int -> IO SX casadi__SX__sparse__3 x0 = withMarshal x0 $ \x0' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__sparse__3 errStrPtrP x0' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_sparse__3 :: Int -> IO SX sx_sparse__3 = casadi__SX__sparse__3 -- direct wrapper foreign import ccall unsafe "casadi__SX__sparse__4" c_casadi__SX__sparse__4 :: Ptr (Ptr StdString) -> CInt -> CInt -> IO (Ptr SX') casadi__SX__sparse__4 :: Int -> Int -> IO SX casadi__SX__sparse__4 x0 x1 = withMarshal x0 $ \x0' -> withMarshal x1 $ \x1' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__sparse__4 errStrPtrP x0' x1' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_sparse__4 :: Int -> Int -> IO SX sx_sparse__4 = casadi__SX__sparse__4 -- direct wrapper foreign import ccall unsafe "casadi__SX__sparsity" c_casadi__SX__sparsity :: Ptr (Ptr StdString) -> Ptr SX' -> IO (Ptr Sparsity') casadi__SX__sparsity :: SX -> IO Sparsity casadi__SX__sparsity x0 = withMarshal x0 $ \x0' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__sparsity errStrPtrP x0' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_sparsity :: SXClass a => a -> IO Sparsity sx_sparsity x = casadi__SX__sparsity (castSX x) -- direct wrapper foreign import ccall unsafe "casadi__SX__sym__0" c_casadi__SX__sym__0 :: Ptr (Ptr StdString) -> Ptr StdString -> CInt -> CInt -> CInt -> CInt -> IO (Ptr (StdVec (Ptr (StdVec (Ptr SX'))))) casadi__SX__sym__0 :: String -> Int -> Int -> Int -> Int -> IO (Vector (Vector SX)) casadi__SX__sym__0 x0 x1 x2 x3 x4 = withMarshal x0 $ \x0' -> withMarshal x1 $ \x1' -> withMarshal x2 $ \x2' -> withMarshal x3 $ \x3' -> withMarshal x4 $ \x4' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__sym__0 errStrPtrP x0' x1' x2' x3' x4' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_sym__0 :: String -> Int -> Int -> Int -> Int -> IO (Vector (Vector SX)) sx_sym__0 = casadi__SX__sym__0 -- direct wrapper foreign import ccall unsafe "casadi__SX__sym__1" c_casadi__SX__sym__1 :: Ptr (Ptr StdString) -> Ptr StdString -> Ptr Sparsity' -> CInt -> CInt -> IO (Ptr (StdVec (Ptr (StdVec (Ptr SX'))))) casadi__SX__sym__1 :: String -> Sparsity -> Int -> Int -> IO (Vector (Vector SX)) casadi__SX__sym__1 x0 x1 x2 x3 = withMarshal x0 $ \x0' -> withMarshal x1 $ \x1' -> withMarshal x2 $ \x2' -> withMarshal x3 $ \x3' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__sym__1 errStrPtrP x0' x1' x2' x3' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_sym__1 :: String -> Sparsity -> Int -> Int -> IO (Vector (Vector SX)) sx_sym__1 = casadi__SX__sym__1 -- direct wrapper foreign import ccall unsafe "casadi__SX__sym__2" c_casadi__SX__sym__2 :: Ptr (Ptr StdString) -> Ptr StdString -> CInt -> CInt -> CInt -> IO (Ptr (StdVec (Ptr SX'))) casadi__SX__sym__2 :: String -> Int -> Int -> Int -> IO (Vector SX) casadi__SX__sym__2 x0 x1 x2 x3 = withMarshal x0 $ \x0' -> withMarshal x1 $ \x1' -> withMarshal x2 $ \x2' -> withMarshal x3 $ \x3' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__sym__2 errStrPtrP x0' x1' x2' x3' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_sym__2 :: String -> Int -> Int -> Int -> IO (Vector SX) sx_sym__2 = casadi__SX__sym__2 -- direct wrapper foreign import ccall unsafe "casadi__SX__sym__3" c_casadi__SX__sym__3 :: Ptr (Ptr StdString) -> Ptr StdString -> Ptr Sparsity' -> CInt -> IO (Ptr (StdVec (Ptr SX'))) casadi__SX__sym__3 :: String -> Sparsity -> Int -> IO (Vector SX) casadi__SX__sym__3 x0 x1 x2 = withMarshal x0 $ \x0' -> withMarshal x1 $ \x1' -> withMarshal x2 $ \x2' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__sym__3 errStrPtrP x0' x1' x2' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_sym__3 :: String -> Sparsity -> Int -> IO (Vector SX) sx_sym__3 = casadi__SX__sym__3 -- direct wrapper foreign import ccall unsafe "casadi__SX__sym__4" c_casadi__SX__sym__4 :: Ptr (Ptr StdString) -> Ptr StdString -> Ptr Sparsity' -> IO (Ptr SX') casadi__SX__sym__4 :: String -> Sparsity -> IO SX casadi__SX__sym__4 x0 x1 = withMarshal x0 $ \x0' -> withMarshal x1 $ \x1' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__sym__4 errStrPtrP x0' x1' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_sym__4 :: String -> Sparsity -> IO SX sx_sym__4 = casadi__SX__sym__4 -- direct wrapper foreign import ccall unsafe "casadi__SX__sym__5" c_casadi__SX__sym__5 :: Ptr (Ptr StdString) -> Ptr StdString -> Ptr (StdPair CInt CInt) -> IO (Ptr SX') casadi__SX__sym__5 :: String -> (Int, Int) -> IO SX casadi__SX__sym__5 x0 x1 = withMarshal x0 $ \x0' -> withMarshal x1 $ \x1' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__sym__5 errStrPtrP x0' x1' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_sym__5 :: String -> (Int, Int) -> IO SX sx_sym__5 = casadi__SX__sym__5 -- direct wrapper foreign import ccall unsafe "casadi__SX__sym__6" c_casadi__SX__sym__6 :: Ptr (Ptr StdString) -> Ptr StdString -> IO (Ptr SX') casadi__SX__sym__6 :: String -> IO SX casadi__SX__sym__6 x0 = withMarshal x0 $ \x0' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__sym__6 errStrPtrP x0' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_sym__6 :: String -> IO SX sx_sym__6 = casadi__SX__sym__6 -- direct wrapper foreign import ccall unsafe "casadi__SX__sym__7" c_casadi__SX__sym__7 :: Ptr (Ptr StdString) -> Ptr StdString -> CInt -> IO (Ptr SX') casadi__SX__sym__7 :: String -> Int -> IO SX casadi__SX__sym__7 x0 x1 = withMarshal x0 $ \x0' -> withMarshal x1 $ \x1' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__sym__7 errStrPtrP x0' x1' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_sym__7 :: String -> Int -> IO SX sx_sym__7 = casadi__SX__sym__7 -- direct wrapper foreign import ccall unsafe "casadi__SX__sym__8" c_casadi__SX__sym__8 :: Ptr (Ptr StdString) -> Ptr StdString -> CInt -> CInt -> IO (Ptr SX') casadi__SX__sym__8 :: String -> Int -> Int -> IO SX casadi__SX__sym__8 x0 x1 x2 = withMarshal x0 $ \x0' -> withMarshal x1 $ \x1' -> withMarshal x2 $ \x2' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__sym__8 errStrPtrP x0' x1' x2' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_sym__8 :: String -> Int -> Int -> IO SX sx_sym__8 = casadi__SX__sym__8 -- direct wrapper foreign import ccall unsafe "casadi__SX__toSlice__0" c_casadi__SX__toSlice__0 :: Ptr (Ptr StdString) -> Ptr SX' -> IO (Ptr Slice') casadi__SX__toSlice__0 :: SX -> IO Slice casadi__SX__toSlice__0 x0 = withMarshal x0 $ \x0' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__toSlice__0 errStrPtrP x0' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_toSlice__0 :: SXClass a => a -> IO Slice sx_toSlice__0 x = casadi__SX__toSlice__0 (castSX x) -- direct wrapper foreign import ccall unsafe "casadi__SX__toSlice__1" c_casadi__SX__toSlice__1 :: Ptr (Ptr StdString) -> Ptr SX' -> CInt -> IO (Ptr Slice') casadi__SX__toSlice__1 :: SX -> Bool -> IO Slice casadi__SX__toSlice__1 x0 x1 = withMarshal x0 $ \x0' -> withMarshal x1 $ \x1' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__toSlice__1 errStrPtrP x0' x1' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_toSlice__1 :: SXClass a => a -> Bool -> IO Slice sx_toSlice__1 x = casadi__SX__toSlice__1 (castSX x) -- direct wrapper foreign import ccall unsafe "casadi__SX__triplet__0" c_casadi__SX__triplet__0 :: Ptr (Ptr StdString) -> Ptr (StdVec CInt) -> Ptr (StdVec CInt) -> Ptr SX' -> Ptr (StdPair CInt CInt) -> IO (Ptr SX') casadi__SX__triplet__0 :: Vector Int -> Vector Int -> SX -> (Int, Int) -> IO SX casadi__SX__triplet__0 x0 x1 x2 x3 = withMarshal x0 $ \x0' -> withMarshal x1 $ \x1' -> withMarshal x2 $ \x2' -> withMarshal x3 $ \x3' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__triplet__0 errStrPtrP x0' x1' x2' x3' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_triplet__0 :: Vector Int -> Vector Int -> SX -> (Int, Int) -> IO SX sx_triplet__0 = casadi__SX__triplet__0 -- direct wrapper foreign import ccall unsafe "casadi__SX__triplet__1" c_casadi__SX__triplet__1 :: Ptr (Ptr StdString) -> Ptr (StdVec CInt) -> Ptr (StdVec CInt) -> Ptr SX' -> CInt -> CInt -> IO (Ptr SX') casadi__SX__triplet__1 :: Vector Int -> Vector Int -> SX -> Int -> Int -> IO SX casadi__SX__triplet__1 x0 x1 x2 x3 x4 = withMarshal x0 $ \x0' -> withMarshal x1 $ \x1' -> withMarshal x2 $ \x2' -> withMarshal x3 $ \x3' -> withMarshal x4 $ \x4' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__triplet__1 errStrPtrP x0' x1' x2' x3' x4' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_triplet__1 :: Vector Int -> Vector Int -> SX -> Int -> Int -> IO SX sx_triplet__1 = casadi__SX__triplet__1 -- direct wrapper foreign import ccall unsafe "casadi__SX__triplet__2" c_casadi__SX__triplet__2 :: Ptr (Ptr StdString) -> Ptr (StdVec CInt) -> Ptr (StdVec CInt) -> Ptr SX' -> IO (Ptr SX') casadi__SX__triplet__2 :: Vector Int -> Vector Int -> SX -> IO SX casadi__SX__triplet__2 x0 x1 x2 = withMarshal x0 $ \x0' -> withMarshal x1 $ \x1' -> withMarshal x2 $ \x2' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__triplet__2 errStrPtrP x0' x1' x2' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_triplet__2 :: Vector Int -> Vector Int -> SX -> IO SX sx_triplet__2 = casadi__SX__triplet__2 -- direct wrapper foreign import ccall unsafe "casadi__SX__unary" c_casadi__SX__unary :: Ptr (Ptr StdString) -> CInt -> Ptr SX' -> IO (Ptr SX') casadi__SX__unary :: Int -> SX -> IO SX casadi__SX__unary x0 x1 = withMarshal x0 $ \x0' -> withMarshal x1 $ \x1' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__unary errStrPtrP x0' x1' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_unary :: Int -> SX -> IO SX sx_unary = casadi__SX__unary -- direct wrapper foreign import ccall unsafe "casadi__SX__zeros__0" c_casadi__SX__zeros__0 :: Ptr (Ptr StdString) -> Ptr (StdPair CInt CInt) -> IO (Ptr SX') casadi__SX__zeros__0 :: (Int, Int) -> IO SX casadi__SX__zeros__0 x0 = withMarshal x0 $ \x0' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__zeros__0 errStrPtrP x0' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_zeros__0 :: (Int, Int) -> IO SX sx_zeros__0 = casadi__SX__zeros__0 -- direct wrapper foreign import ccall unsafe "casadi__SX__zeros__1" c_casadi__SX__zeros__1 :: Ptr (Ptr StdString) -> Ptr Sparsity' -> IO (Ptr SX') casadi__SX__zeros__1 :: Sparsity -> IO SX casadi__SX__zeros__1 x0 = withMarshal x0 $ \x0' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__zeros__1 errStrPtrP x0' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_zeros__1 :: Sparsity -> IO SX sx_zeros__1 = casadi__SX__zeros__1 -- direct wrapper foreign import ccall unsafe "casadi__SX__zeros__2" c_casadi__SX__zeros__2 :: Ptr (Ptr StdString) -> IO (Ptr SX') casadi__SX__zeros__2 :: IO SX casadi__SX__zeros__2 = do errStrPtrP <- new nullPtr ret <- c_casadi__SX__zeros__2 errStrPtrP errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_zeros__2 :: IO SX sx_zeros__2 = casadi__SX__zeros__2 -- direct wrapper foreign import ccall unsafe "casadi__SX__zeros__3" c_casadi__SX__zeros__3 :: Ptr (Ptr StdString) -> CInt -> IO (Ptr SX') casadi__SX__zeros__3 :: Int -> IO SX casadi__SX__zeros__3 x0 = withMarshal x0 $ \x0' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__zeros__3 errStrPtrP x0' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_zeros__3 :: Int -> IO SX sx_zeros__3 = casadi__SX__zeros__3 -- direct wrapper foreign import ccall unsafe "casadi__SX__zeros__4" c_casadi__SX__zeros__4 :: Ptr (Ptr StdString) -> CInt -> CInt -> IO (Ptr SX') casadi__SX__zeros__4 :: Int -> Int -> IO SX casadi__SX__zeros__4 x0 x1 = withMarshal x0 $ \x0' -> withMarshal x1 $ \x1' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__zeros__4 errStrPtrP x0' x1' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_zeros__4 :: Int -> Int -> IO SX sx_zeros__4 = casadi__SX__zeros__4 -- direct wrapper foreign import ccall unsafe "casadi__SX__getRepresentation" c_casadi__SX__getRepresentation :: Ptr (Ptr StdString) -> Ptr SX' -> IO (Ptr StdString) casadi__SX__getRepresentation :: SX -> IO String casadi__SX__getRepresentation x0 = withMarshal x0 $ \x0' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__getRepresentation errStrPtrP x0' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_getRepresentation :: SXClass a => a -> IO String sx_getRepresentation x = casadi__SX__getRepresentation (castSX x) -- direct wrapper foreign import ccall unsafe "casadi__SX__getDescription" c_casadi__SX__getDescription :: Ptr (Ptr StdString) -> Ptr SX' -> IO (Ptr StdString) casadi__SX__getDescription :: SX -> IO String casadi__SX__getDescription x0 = withMarshal x0 $ \x0' -> do errStrPtrP <- new nullPtr ret <- c_casadi__SX__getDescription errStrPtrP x0' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper sx_getDescription :: SXClass a => a -> IO String sx_getDescription x = casadi__SX__getDescription (castSX x)