casadi-bindings-internal 0.1.1 → 0.1.2
raw patch · 3 files changed
+161/−31 lines, 3 files
Files
- casadi-bindings-internal.cabal +3/−3
- cbits/callback.cpp +135/−25
- src/Casadi/Internal/Callback.hs +23/−3
casadi-bindings-internal.cabal view
@@ -1,5 +1,5 @@ name: casadi-bindings-internal-version: 0.1.1+version: 0.1.2 license: LGPL-3 license-file: LICENSE category: Numerical, Math@@ -35,11 +35,11 @@ extra-libraries: stdc++ - pkgconfig-depends: casadi_core+ pkgconfig-depends: casadi ghc-prof-options: -O2 -prof -fprof-auto -fprof-cafs -rtsopts ghc-options: -O2- cc-options: -Wall -Wno-delete-non-virtual-dtor+ cc-options: -Wall -Wno-delete-non-virtual-dtor -Wno-sign-compare C-sources: cbits/hs_tools.cpp cbits/callback.cpp
cbits/callback.cpp view
@@ -5,52 +5,162 @@ #include "HsFFI.h" +// #define DEBUG_WOO+ using namespace std; using namespace casadi; extern "C" {-typedef int (*hs_callback_t)(Function &f);+ //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 nfwd, int nadj); } namespace casadi {- class FunctorHaskellInternal {+ // functor+ template <class T> class FunctorHaskellInternal { public:- FunctorHaskellInternal(hs_callback_t hscb)- {- hs_callback = hscb;- }- ~FunctorHaskellInternal() {- // free the haskell FunPtr- hs_free_fun_ptr(HsFunPtr(hs_callback));- }+ 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:- hs_callback_t hs_callback;- };+ T functor_fun_ptr;+ }; - 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(hs_callback); }- };+ // Callback+ class CallbackHaskellInternal :+ public CallbackInternal, FunctorHaskellInternal<hs_callback_t> { - class CallbackHaskell : public Callback {+ friend class CallbackHaskell;+ CallbackHaskellInternal(hs_callback_t hscb) : FunctorHaskellInternal<hs_callback_t>(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)); }- };+ CallbackHaskell(hs_callback_t hscb) {+ assignNode(new CallbackHaskellInternal(hscb));+ }+ }; - int CallbackHaskellInternal::call(Function& fcn, void* user_data) {- return hs_callback(fcn);- }-}+ 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<hs_custom_evaluate_t> {++ friend class CustomEvaluateHaskell;++ CustomEvaluateHaskellInternal(hs_custom_evaluate_t hsce) :+ FunctorHaskellInternal<hs_custom_evaluate_t>(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<hs_derivative_generator_t> {++ friend class DerivativeGeneratorHaskell;++ DerivativeGeneratorHaskellInternal(hs_derivative_generator_t hsdg) :+ FunctorHaskellInternal<hs_derivative_generator_t>(hsdg) {}+ virtual Function call(Function& fcn, int nfwd, int nadj, 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 nfwd, int nadj, void* user_data) {+ #ifdef DEBUG_WOO+ std::cout << "DerivativeGeneratorHaskellInternal::call()\n";+ #endif+ Function& f = functor_fun_ptr(fcn, nfwd, nadj);+ #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; }
src/Casadi/Internal/Callback.hs view
@@ -5,6 +5,10 @@ module Casadi.Internal.Callback ( c_newCallbackHaskell , mkCallback+ , c_newCustomEvaluateHaskell+ , mkCustomEvaluate+ , c_newDerivativeGeneratorHaskell+ , mkDerivativeGenerator ) where @@ -16,8 +20,24 @@ --import Casadi.Internal.Marshal ( withMarshal ) --import Casadi.Internal.WrapReturn ( WrapReturn(..) ) -type CasadiCallback' function' = Ptr function' -> IO CInt-foreign import ccall "wrapper" mkCallback :: CasadiCallback' function' -> IO (FunPtr (CasadiCallback' function'))+-- 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')+ :: 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 -> 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)