{-# OPTIONS_GHC -Wall #-} {-# OPTIONS_GHC -fno-warn-unused-imports #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-# Language ForeignFunctionInterface #-} {-# Language FlexibleInstances #-} {-# Language MultiParamTypeClasses #-} module Casadi.Core.Classes.IOInterfaceFunction ( IOInterfaceFunction, IOInterfaceFunctionClass(..), ioInterfaceFunction_getInput__0, ioInterfaceFunction_getInput__1, ioInterfaceFunction_getInput__2, ioInterfaceFunction_getOutput__0, ioInterfaceFunction_getOutput__1, ioInterfaceFunction_getOutput__2, ioInterfaceFunction_setInputNZ__0, ioInterfaceFunction_setInputNZ__1, ioInterfaceFunction_setInputNZ__2, ioInterfaceFunction_setInput__0, ioInterfaceFunction_setInput__1, ioInterfaceFunction_setInput__2, ioInterfaceFunction_setOutputNZ__0, ioInterfaceFunction_setOutputNZ__1, ioInterfaceFunction_setOutputNZ__2, ioInterfaceFunction_setOutput__0, ioInterfaceFunction_setOutput__1, ioInterfaceFunction_setOutput__2, ) 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__IOInterface_casadi__Function___getInput__0" c_casadi__IOInterface_casadi__Function___getInput__0 :: Ptr (Ptr StdString) -> Ptr IOInterfaceFunction' -> Ptr StdString -> IO (Ptr DMatrix') casadi__IOInterface_casadi__Function___getInput__0 :: IOInterfaceFunction -> String -> IO DMatrix casadi__IOInterface_casadi__Function___getInput__0 x0 x1 = withMarshal x0 $ \x0' -> withMarshal x1 $ \x1' -> do errStrPtrP <- new nullPtr ret <- c_casadi__IOInterface_casadi__Function___getInput__0 errStrPtrP x0' x1' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper ioInterfaceFunction_getInput__0 :: IOInterfaceFunctionClass a => a -> String -> IO DMatrix ioInterfaceFunction_getInput__0 x = casadi__IOInterface_casadi__Function___getInput__0 (castIOInterfaceFunction x) -- direct wrapper foreign import ccall unsafe "casadi__IOInterface_casadi__Function___getInput__1" c_casadi__IOInterface_casadi__Function___getInput__1 :: Ptr (Ptr StdString) -> Ptr IOInterfaceFunction' -> IO (Ptr DMatrix') casadi__IOInterface_casadi__Function___getInput__1 :: IOInterfaceFunction -> IO DMatrix casadi__IOInterface_casadi__Function___getInput__1 x0 = withMarshal x0 $ \x0' -> do errStrPtrP <- new nullPtr ret <- c_casadi__IOInterface_casadi__Function___getInput__1 errStrPtrP x0' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper ioInterfaceFunction_getInput__1 :: IOInterfaceFunctionClass a => a -> IO DMatrix ioInterfaceFunction_getInput__1 x = casadi__IOInterface_casadi__Function___getInput__1 (castIOInterfaceFunction x) -- direct wrapper foreign import ccall unsafe "casadi__IOInterface_casadi__Function___getInput__2" c_casadi__IOInterface_casadi__Function___getInput__2 :: Ptr (Ptr StdString) -> Ptr IOInterfaceFunction' -> CInt -> IO (Ptr DMatrix') casadi__IOInterface_casadi__Function___getInput__2 :: IOInterfaceFunction -> Int -> IO DMatrix casadi__IOInterface_casadi__Function___getInput__2 x0 x1 = withMarshal x0 $ \x0' -> withMarshal x1 $ \x1' -> do errStrPtrP <- new nullPtr ret <- c_casadi__IOInterface_casadi__Function___getInput__2 errStrPtrP x0' x1' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper ioInterfaceFunction_getInput__2 :: IOInterfaceFunctionClass a => a -> Int -> IO DMatrix ioInterfaceFunction_getInput__2 x = casadi__IOInterface_casadi__Function___getInput__2 (castIOInterfaceFunction x) -- direct wrapper foreign import ccall unsafe "casadi__IOInterface_casadi__Function___getOutput__0" c_casadi__IOInterface_casadi__Function___getOutput__0 :: Ptr (Ptr StdString) -> Ptr IOInterfaceFunction' -> Ptr StdString -> IO (Ptr DMatrix') casadi__IOInterface_casadi__Function___getOutput__0 :: IOInterfaceFunction -> String -> IO DMatrix casadi__IOInterface_casadi__Function___getOutput__0 x0 x1 = withMarshal x0 $ \x0' -> withMarshal x1 $ \x1' -> do errStrPtrP <- new nullPtr ret <- c_casadi__IOInterface_casadi__Function___getOutput__0 errStrPtrP x0' x1' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper ioInterfaceFunction_getOutput__0 :: IOInterfaceFunctionClass a => a -> String -> IO DMatrix ioInterfaceFunction_getOutput__0 x = casadi__IOInterface_casadi__Function___getOutput__0 (castIOInterfaceFunction x) -- direct wrapper foreign import ccall unsafe "casadi__IOInterface_casadi__Function___getOutput__1" c_casadi__IOInterface_casadi__Function___getOutput__1 :: Ptr (Ptr StdString) -> Ptr IOInterfaceFunction' -> IO (Ptr DMatrix') casadi__IOInterface_casadi__Function___getOutput__1 :: IOInterfaceFunction -> IO DMatrix casadi__IOInterface_casadi__Function___getOutput__1 x0 = withMarshal x0 $ \x0' -> do errStrPtrP <- new nullPtr ret <- c_casadi__IOInterface_casadi__Function___getOutput__1 errStrPtrP x0' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper ioInterfaceFunction_getOutput__1 :: IOInterfaceFunctionClass a => a -> IO DMatrix ioInterfaceFunction_getOutput__1 x = casadi__IOInterface_casadi__Function___getOutput__1 (castIOInterfaceFunction x) -- direct wrapper foreign import ccall unsafe "casadi__IOInterface_casadi__Function___getOutput__2" c_casadi__IOInterface_casadi__Function___getOutput__2 :: Ptr (Ptr StdString) -> Ptr IOInterfaceFunction' -> CInt -> IO (Ptr DMatrix') casadi__IOInterface_casadi__Function___getOutput__2 :: IOInterfaceFunction -> Int -> IO DMatrix casadi__IOInterface_casadi__Function___getOutput__2 x0 x1 = withMarshal x0 $ \x0' -> withMarshal x1 $ \x1' -> do errStrPtrP <- new nullPtr ret <- c_casadi__IOInterface_casadi__Function___getOutput__2 errStrPtrP x0' x1' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper ioInterfaceFunction_getOutput__2 :: IOInterfaceFunctionClass a => a -> Int -> IO DMatrix ioInterfaceFunction_getOutput__2 x = casadi__IOInterface_casadi__Function___getOutput__2 (castIOInterfaceFunction x) -- direct wrapper foreign import ccall unsafe "casadi__IOInterface_casadi__Function___setInput__0" c_casadi__IOInterface_casadi__Function___setInput__0 :: Ptr (Ptr StdString) -> Ptr IOInterfaceFunction' -> Ptr DMatrix' -> Ptr StdString -> IO () casadi__IOInterface_casadi__Function___setInput__0 :: IOInterfaceFunction -> DMatrix -> String -> IO () casadi__IOInterface_casadi__Function___setInput__0 x0 x1 x2 = withMarshal x0 $ \x0' -> withMarshal x1 $ \x1' -> withMarshal x2 $ \x2' -> do errStrPtrP <- new nullPtr ret <- c_casadi__IOInterface_casadi__Function___setInput__0 errStrPtrP x0' x1' x2' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper ioInterfaceFunction_setInput__0 :: IOInterfaceFunctionClass a => a -> DMatrix -> String -> IO () ioInterfaceFunction_setInput__0 x = casadi__IOInterface_casadi__Function___setInput__0 (castIOInterfaceFunction x) -- direct wrapper foreign import ccall unsafe "casadi__IOInterface_casadi__Function___setInput__1" c_casadi__IOInterface_casadi__Function___setInput__1 :: Ptr (Ptr StdString) -> Ptr IOInterfaceFunction' -> Ptr DMatrix' -> IO () casadi__IOInterface_casadi__Function___setInput__1 :: IOInterfaceFunction -> DMatrix -> IO () casadi__IOInterface_casadi__Function___setInput__1 x0 x1 = withMarshal x0 $ \x0' -> withMarshal x1 $ \x1' -> do errStrPtrP <- new nullPtr ret <- c_casadi__IOInterface_casadi__Function___setInput__1 errStrPtrP x0' x1' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper ioInterfaceFunction_setInput__1 :: IOInterfaceFunctionClass a => a -> DMatrix -> IO () ioInterfaceFunction_setInput__1 x = casadi__IOInterface_casadi__Function___setInput__1 (castIOInterfaceFunction x) -- direct wrapper foreign import ccall unsafe "casadi__IOInterface_casadi__Function___setInput__2" c_casadi__IOInterface_casadi__Function___setInput__2 :: Ptr (Ptr StdString) -> Ptr IOInterfaceFunction' -> Ptr DMatrix' -> CInt -> IO () casadi__IOInterface_casadi__Function___setInput__2 :: IOInterfaceFunction -> DMatrix -> Int -> IO () casadi__IOInterface_casadi__Function___setInput__2 x0 x1 x2 = withMarshal x0 $ \x0' -> withMarshal x1 $ \x1' -> withMarshal x2 $ \x2' -> do errStrPtrP <- new nullPtr ret <- c_casadi__IOInterface_casadi__Function___setInput__2 errStrPtrP x0' x1' x2' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper ioInterfaceFunction_setInput__2 :: IOInterfaceFunctionClass a => a -> DMatrix -> Int -> IO () ioInterfaceFunction_setInput__2 x = casadi__IOInterface_casadi__Function___setInput__2 (castIOInterfaceFunction x) -- direct wrapper foreign import ccall unsafe "casadi__IOInterface_casadi__Function___setInputNZ__0" c_casadi__IOInterface_casadi__Function___setInputNZ__0 :: Ptr (Ptr StdString) -> Ptr IOInterfaceFunction' -> Ptr DMatrix' -> Ptr StdString -> IO () casadi__IOInterface_casadi__Function___setInputNZ__0 :: IOInterfaceFunction -> DMatrix -> String -> IO () casadi__IOInterface_casadi__Function___setInputNZ__0 x0 x1 x2 = withMarshal x0 $ \x0' -> withMarshal x1 $ \x1' -> withMarshal x2 $ \x2' -> do errStrPtrP <- new nullPtr ret <- c_casadi__IOInterface_casadi__Function___setInputNZ__0 errStrPtrP x0' x1' x2' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper ioInterfaceFunction_setInputNZ__0 :: IOInterfaceFunctionClass a => a -> DMatrix -> String -> IO () ioInterfaceFunction_setInputNZ__0 x = casadi__IOInterface_casadi__Function___setInputNZ__0 (castIOInterfaceFunction x) -- direct wrapper foreign import ccall unsafe "casadi__IOInterface_casadi__Function___setInputNZ__1" c_casadi__IOInterface_casadi__Function___setInputNZ__1 :: Ptr (Ptr StdString) -> Ptr IOInterfaceFunction' -> Ptr DMatrix' -> IO () casadi__IOInterface_casadi__Function___setInputNZ__1 :: IOInterfaceFunction -> DMatrix -> IO () casadi__IOInterface_casadi__Function___setInputNZ__1 x0 x1 = withMarshal x0 $ \x0' -> withMarshal x1 $ \x1' -> do errStrPtrP <- new nullPtr ret <- c_casadi__IOInterface_casadi__Function___setInputNZ__1 errStrPtrP x0' x1' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper ioInterfaceFunction_setInputNZ__1 :: IOInterfaceFunctionClass a => a -> DMatrix -> IO () ioInterfaceFunction_setInputNZ__1 x = casadi__IOInterface_casadi__Function___setInputNZ__1 (castIOInterfaceFunction x) -- direct wrapper foreign import ccall unsafe "casadi__IOInterface_casadi__Function___setInputNZ__2" c_casadi__IOInterface_casadi__Function___setInputNZ__2 :: Ptr (Ptr StdString) -> Ptr IOInterfaceFunction' -> Ptr DMatrix' -> CInt -> IO () casadi__IOInterface_casadi__Function___setInputNZ__2 :: IOInterfaceFunction -> DMatrix -> Int -> IO () casadi__IOInterface_casadi__Function___setInputNZ__2 x0 x1 x2 = withMarshal x0 $ \x0' -> withMarshal x1 $ \x1' -> withMarshal x2 $ \x2' -> do errStrPtrP <- new nullPtr ret <- c_casadi__IOInterface_casadi__Function___setInputNZ__2 errStrPtrP x0' x1' x2' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper ioInterfaceFunction_setInputNZ__2 :: IOInterfaceFunctionClass a => a -> DMatrix -> Int -> IO () ioInterfaceFunction_setInputNZ__2 x = casadi__IOInterface_casadi__Function___setInputNZ__2 (castIOInterfaceFunction x) -- direct wrapper foreign import ccall unsafe "casadi__IOInterface_casadi__Function___setOutput__0" c_casadi__IOInterface_casadi__Function___setOutput__0 :: Ptr (Ptr StdString) -> Ptr IOInterfaceFunction' -> Ptr DMatrix' -> Ptr StdString -> IO () casadi__IOInterface_casadi__Function___setOutput__0 :: IOInterfaceFunction -> DMatrix -> String -> IO () casadi__IOInterface_casadi__Function___setOutput__0 x0 x1 x2 = withMarshal x0 $ \x0' -> withMarshal x1 $ \x1' -> withMarshal x2 $ \x2' -> do errStrPtrP <- new nullPtr ret <- c_casadi__IOInterface_casadi__Function___setOutput__0 errStrPtrP x0' x1' x2' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper ioInterfaceFunction_setOutput__0 :: IOInterfaceFunctionClass a => a -> DMatrix -> String -> IO () ioInterfaceFunction_setOutput__0 x = casadi__IOInterface_casadi__Function___setOutput__0 (castIOInterfaceFunction x) -- direct wrapper foreign import ccall unsafe "casadi__IOInterface_casadi__Function___setOutput__1" c_casadi__IOInterface_casadi__Function___setOutput__1 :: Ptr (Ptr StdString) -> Ptr IOInterfaceFunction' -> Ptr DMatrix' -> IO () casadi__IOInterface_casadi__Function___setOutput__1 :: IOInterfaceFunction -> DMatrix -> IO () casadi__IOInterface_casadi__Function___setOutput__1 x0 x1 = withMarshal x0 $ \x0' -> withMarshal x1 $ \x1' -> do errStrPtrP <- new nullPtr ret <- c_casadi__IOInterface_casadi__Function___setOutput__1 errStrPtrP x0' x1' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper ioInterfaceFunction_setOutput__1 :: IOInterfaceFunctionClass a => a -> DMatrix -> IO () ioInterfaceFunction_setOutput__1 x = casadi__IOInterface_casadi__Function___setOutput__1 (castIOInterfaceFunction x) -- direct wrapper foreign import ccall unsafe "casadi__IOInterface_casadi__Function___setOutput__2" c_casadi__IOInterface_casadi__Function___setOutput__2 :: Ptr (Ptr StdString) -> Ptr IOInterfaceFunction' -> Ptr DMatrix' -> CInt -> IO () casadi__IOInterface_casadi__Function___setOutput__2 :: IOInterfaceFunction -> DMatrix -> Int -> IO () casadi__IOInterface_casadi__Function___setOutput__2 x0 x1 x2 = withMarshal x0 $ \x0' -> withMarshal x1 $ \x1' -> withMarshal x2 $ \x2' -> do errStrPtrP <- new nullPtr ret <- c_casadi__IOInterface_casadi__Function___setOutput__2 errStrPtrP x0' x1' x2' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper ioInterfaceFunction_setOutput__2 :: IOInterfaceFunctionClass a => a -> DMatrix -> Int -> IO () ioInterfaceFunction_setOutput__2 x = casadi__IOInterface_casadi__Function___setOutput__2 (castIOInterfaceFunction x) -- direct wrapper foreign import ccall unsafe "casadi__IOInterface_casadi__Function___setOutputNZ__0" c_casadi__IOInterface_casadi__Function___setOutputNZ__0 :: Ptr (Ptr StdString) -> Ptr IOInterfaceFunction' -> Ptr DMatrix' -> Ptr StdString -> IO () casadi__IOInterface_casadi__Function___setOutputNZ__0 :: IOInterfaceFunction -> DMatrix -> String -> IO () casadi__IOInterface_casadi__Function___setOutputNZ__0 x0 x1 x2 = withMarshal x0 $ \x0' -> withMarshal x1 $ \x1' -> withMarshal x2 $ \x2' -> do errStrPtrP <- new nullPtr ret <- c_casadi__IOInterface_casadi__Function___setOutputNZ__0 errStrPtrP x0' x1' x2' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper ioInterfaceFunction_setOutputNZ__0 :: IOInterfaceFunctionClass a => a -> DMatrix -> String -> IO () ioInterfaceFunction_setOutputNZ__0 x = casadi__IOInterface_casadi__Function___setOutputNZ__0 (castIOInterfaceFunction x) -- direct wrapper foreign import ccall unsafe "casadi__IOInterface_casadi__Function___setOutputNZ__1" c_casadi__IOInterface_casadi__Function___setOutputNZ__1 :: Ptr (Ptr StdString) -> Ptr IOInterfaceFunction' -> Ptr DMatrix' -> IO () casadi__IOInterface_casadi__Function___setOutputNZ__1 :: IOInterfaceFunction -> DMatrix -> IO () casadi__IOInterface_casadi__Function___setOutputNZ__1 x0 x1 = withMarshal x0 $ \x0' -> withMarshal x1 $ \x1' -> do errStrPtrP <- new nullPtr ret <- c_casadi__IOInterface_casadi__Function___setOutputNZ__1 errStrPtrP x0' x1' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper ioInterfaceFunction_setOutputNZ__1 :: IOInterfaceFunctionClass a => a -> DMatrix -> IO () ioInterfaceFunction_setOutputNZ__1 x = casadi__IOInterface_casadi__Function___setOutputNZ__1 (castIOInterfaceFunction x) -- direct wrapper foreign import ccall unsafe "casadi__IOInterface_casadi__Function___setOutputNZ__2" c_casadi__IOInterface_casadi__Function___setOutputNZ__2 :: Ptr (Ptr StdString) -> Ptr IOInterfaceFunction' -> Ptr DMatrix' -> CInt -> IO () casadi__IOInterface_casadi__Function___setOutputNZ__2 :: IOInterfaceFunction -> DMatrix -> Int -> IO () casadi__IOInterface_casadi__Function___setOutputNZ__2 x0 x1 x2 = withMarshal x0 $ \x0' -> withMarshal x1 $ \x1' -> withMarshal x2 $ \x2' -> do errStrPtrP <- new nullPtr ret <- c_casadi__IOInterface_casadi__Function___setOutputNZ__2 errStrPtrP x0' x1' x2' errStrPtr <- peek errStrPtrP free errStrPtrP if errStrPtr == nullPtr then wrapReturn ret else wrapReturn errStrPtr >>= (error . formatException) -- classy wrapper ioInterfaceFunction_setOutputNZ__2 :: IOInterfaceFunctionClass a => a -> DMatrix -> Int -> IO () ioInterfaceFunction_setOutputNZ__2 x = casadi__IOInterface_casadi__Function___setOutputNZ__2 (castIOInterfaceFunction x)