diff --git a/casadi-bindings-internal.cabal b/casadi-bindings-internal.cabal --- a/casadi-bindings-internal.cabal +++ b/casadi-bindings-internal.cabal @@ -1,5 +1,5 @@ name: casadi-bindings-internal -version: 0.1.3.1 +version: 0.1.4.0 license: LGPL-3 license-file: LICENSE category: Numerical, Math @@ -13,8 +13,6 @@ homepage: http://github.com/ghorn/casadi-bindings -extra-tmp-files: Casadi/Callback_stub.h - library build-depends: base >=4.6 && <5, vector >=0.10, containers @@ -23,21 +21,19 @@ extra-libraries: stdc++ - pkgconfig-depends: casadi + pkgconfig-depends: casadi == 3.0.0 ghc-prof-options: -O2 -prof -fprof-auto -fprof-cafs -rtsopts ghc-options: -O2 cc-options: -Wall -Wno-delete-non-virtual-dtor -Wno-sign-compare -std=c++11 C-sources: cbits/hs_tools.cpp - cbits/callback.cpp exposed-modules: Casadi.Internal.Marshal Casadi.Internal.MarshalTypes Casadi.Internal.WrapReturn Casadi.Internal.CppHelpers Casadi.Internal.CToolsImports - Casadi.Internal.Callback Casadi.Internal.FormatException diff --git a/cbits/callback.cpp b/cbits/callback.cpp deleted file mode 100644 --- a/cbits/callback.cpp +++ /dev/null @@ -1,166 +0,0 @@ -#include -#include "casadi/core/core.hpp" -#include "casadi/core/function/custom_function.hpp" -#include "casadi/core/functor_internal.hpp" - -#include "HsFFI.h" - -// #define DEBUG_WOO - -using namespace std; -using namespace casadi; - -extern "C" { - //todo: use casadi typedefs in functor.hpp - typedef int (*hs_callback_t)(Function &f); - typedef void (*hs_custom_evaluate_t)(CustomFunction &f); - typedef Function& (*hs_derivative_generator_t)(Function &f, int nder); -} - -namespace casadi { - // functor - template class FunctorHaskellInternal { - public: - FunctorHaskellInternal(T hscb) { - functor_fun_ptr = hscb; - } - ~FunctorHaskellInternal() { - // free the haskell FunPtr - #ifdef DEBUG_WOO - std::cout << "functor_internal_free\n"; - #endif - hs_free_fun_ptr(HsFunPtr(functor_fun_ptr)); - #ifdef DEBUG_WOO - std::cout << "functor_internal_free finished\n"; - #endif - } - protected: - T functor_fun_ptr; - }; - - - // Callback - class CallbackHaskellInternal : - public CallbackInternal, FunctorHaskellInternal { - - friend class CallbackHaskell; - CallbackHaskellInternal(hs_callback_t hscb) : FunctorHaskellInternal(hscb) {} - virtual int call(Function& fcn, void* user_data); - virtual CallbackHaskellInternal* clone() const { - return new CallbackHaskellInternal(functor_fun_ptr); - } - }; - - class CallbackHaskell : public Callback { - public: - CallbackHaskell(hs_callback_t hscb) { - assignNode(new CallbackHaskellInternal(hscb)); - } - }; - - int CallbackHaskellInternal::call(Function& fcn, void* user_data) { - #ifdef DEBUG_WOO - std::cout << "CallbackHaskellInternal::call()\n"; - #endif - int f = functor_fun_ptr(fcn); - #ifdef DEBUG_WOO - std::cout << "CallbackHaskellInternal::call() finished\n"; - #endif - return f; - } - - - // CustomEvaluate - class CustomEvaluateHaskellInternal : - public CustomEvaluateInternal, FunctorHaskellInternal { - - friend class CustomEvaluateHaskell; - - CustomEvaluateHaskellInternal(hs_custom_evaluate_t hsce) : - FunctorHaskellInternal(hsce) {} - virtual void call(CustomFunction& fcn, void* user_data); - virtual CustomEvaluateHaskellInternal* clone() const { - return new CustomEvaluateHaskellInternal(functor_fun_ptr); - } - }; - - class CustomEvaluateHaskell : public CustomEvaluate { - public: - CustomEvaluateHaskell(hs_custom_evaluate_t hsce) { - assignNode(new CustomEvaluateHaskellInternal(hsce)); - } - }; - - void CustomEvaluateHaskellInternal::call(CustomFunction& fcn, void* user_data) { - #ifdef DEBUG_WOO - std::cout << "CustomEvaluateHaskellInternal::call()\n"; - #endif - functor_fun_ptr(fcn); - #ifdef DEBUG_WOO - std::cout << "CustomEvaluateHaskellInternal::call() finished\n"; - #endif - } - - - // DerivateGenerator - class DerivativeGeneratorHaskellInternal : - public DerivativeGeneratorInternal, FunctorHaskellInternal { - - friend class DerivativeGeneratorHaskell; - - DerivativeGeneratorHaskellInternal(hs_derivative_generator_t hsdg) : - FunctorHaskellInternal(hsdg) {} - virtual Function call(Function& fcn, int nder, void* user_data); - virtual DerivativeGeneratorHaskellInternal* clone() const { - return new DerivativeGeneratorHaskellInternal(functor_fun_ptr); - } - }; - - class DerivativeGeneratorHaskell : public DerivativeGenerator { - public: - DerivativeGeneratorHaskell(hs_derivative_generator_t hsce) { - assignNode(new DerivativeGeneratorHaskellInternal(hsce)); - } - }; - - Function DerivativeGeneratorHaskellInternal::call(Function& fcn, int nder, void* user_data) { - #ifdef DEBUG_WOO - std::cout << "DerivativeGeneratorHaskellInternal::call()\n"; - #endif - Function& f = functor_fun_ptr(fcn, nder); - #ifdef DEBUG_WOO - std::cout << "DerivativeGeneratorHaskellInternal::call() finished\n"; - #endif - return f; - } - - -} // namespace casadi - -extern "C" CallbackHaskell * new_callback_haskell(hs_callback_t hs_callback); -CallbackHaskell * new_callback_haskell(hs_callback_t hs_callback){ - return new CallbackHaskell(hs_callback); -} -extern "C" CustomEvaluateHaskell * new_custom_evaluate_haskell(hs_custom_evaluate_t hs_custom_evaluate); -CustomEvaluateHaskell * new_custom_evaluate_haskell(hs_custom_evaluate_t hs_custom_evaluate){ - return new CustomEvaluateHaskell(hs_custom_evaluate); -} -extern "C" DerivativeGeneratorHaskell * new_derivative_generator_haskell(hs_derivative_generator_t hs_derivative_generator); -DerivativeGeneratorHaskell * new_derivative_generator_haskell(hs_derivative_generator_t hs_derivative_generator){ - return new DerivativeGeneratorHaskell(hs_derivative_generator); -} - - - -extern "C" void delete_callback_haskell(casadi::CallbackHaskell* obj); -void delete_callback_haskell(casadi::CallbackHaskell* obj){ - delete obj; -} -extern "C" void delete_custom_evaluate_haskell(casadi::CustomEvaluateHaskell* obj); -void delete_custom_evaluate_haskell(casadi::CustomEvaluateHaskell* obj){ - delete obj; -} -extern "C" void delete_derivative_generator_haskell(casadi::DerivativeGeneratorHaskell* obj); -void delete_derivative_generator_haskell(casadi::DerivativeGeneratorHaskell* obj){ - delete obj; -} diff --git a/src/Casadi/Internal/Callback.hs b/src/Casadi/Internal/Callback.hs deleted file mode 100644 --- a/src/Casadi/Internal/Callback.hs +++ /dev/null @@ -1,43 +0,0 @@ -{-# OPTIONS_GHC -Wall #-} -{-# Language ScopedTypeVariables #-} -{-# Language FlexibleContexts #-} - -module Casadi.Internal.Callback - ( c_newCallbackHaskell - , mkCallback - , c_newCustomEvaluateHaskell - , mkCustomEvaluate - , c_newDerivativeGeneratorHaskell - , mkDerivativeGenerator - ) where - - -import Foreign.C.Types -import Foreign.Ptr ( Ptr, FunPtr ) ---import Foreign.ForeignPtr ( ForeignPtr, newForeignPtr_ ) - ---import Casadi.Symbolic.Data ---import Casadi.Internal.Marshal ( withMarshal ) ---import Casadi.Internal.WrapReturn ( WrapReturn(..) ) - --- these guys all have type parameters because core depends on internal, not the other way around - -type CasadiCallback' function = Ptr function -> IO CInt -foreign import ccall "wrapper" mkCallback - :: CasadiCallback' function -> IO (FunPtr (CasadiCallback' function)) -foreign import ccall safe "new_callback_haskell" c_newCallbackHaskell - :: FunPtr (CasadiCallback' function) -> IO (Ptr callback) - - -type CasadiCustomEvaluate' customFunction = Ptr customFunction -> IO () -foreign import ccall "wrapper" mkCustomEvaluate - :: CasadiCustomEvaluate' customFunction -> IO (FunPtr (CasadiCustomEvaluate' customFunction)) -foreign import ccall safe "new_custom_evaluate_haskell" c_newCustomEvaluateHaskell - :: FunPtr (CasadiCustomEvaluate' customFunction) -> IO (Ptr customEvaluate) - - -type CasadiDerivativeGenerator' function = Ptr function -> CInt -> IO (Ptr function) -foreign import ccall "wrapper" mkDerivativeGenerator - :: CasadiDerivativeGenerator' function -> IO (FunPtr (CasadiDerivativeGenerator' function)) -foreign import ccall safe "new_derivative_generator_haskell" c_newDerivativeGeneratorHaskell - :: FunPtr (CasadiDerivativeGenerator' function) -> IO (Ptr derivativeGenerator) diff --git a/src/Casadi/Internal/WrapReturn.hs b/src/Casadi/Internal/WrapReturn.hs --- a/src/Casadi/Internal/WrapReturn.hs +++ b/src/Casadi/Internal/WrapReturn.hs @@ -112,5 +112,8 @@ instance WrapReturn (Ptr (StdVec CInt)) (V.Vector Int) where wrapReturn = wrapReturnVec c_sizeVecCInt c_copyVecCInt c_deleteVecCInt wrapReturn +instance WrapReturn (Ptr (StdVec CInt)) (V.Vector Bool) where + wrapReturn = wrapReturnVec c_sizeVecCInt c_copyVecCInt c_deleteVecCInt wrapReturn + instance WrapReturn (Ptr (StdVec CDouble)) (V.Vector Double) where wrapReturn = wrapReturnVec c_sizeVecCDouble c_copyVecCDouble c_deleteVecCDouble wrapReturn