packages feed

casadi-bindings-internal (empty) → 0.1

raw patch · 13 files changed

+707/−0 lines, 13 filesdep +basedep +vectorsetup-changed

Dependencies added: base, vector

Files

+ LICENSE view
@@ -0,0 +1,165 @@+                  GNU LESSER GENERAL PUBLIC LICENSE+                       Version 3, 29 June 2007++ Copyright (C) 2007 Free Software Foundation, Inc. <http://fsf.org/>+ Everyone is permitted to copy and distribute verbatim copies+ of this license document, but changing it is not allowed.+++  This version of the GNU Lesser General Public License incorporates+the terms and conditions of version 3 of the GNU General Public+License, supplemented by the additional permissions listed below.++  0. Additional Definitions. ++  As used herein, "this License" refers to version 3 of the GNU Lesser+General Public License, and the "GNU GPL" refers to version 3 of the GNU+General Public License.++  "The Library" refers to a covered work governed by this License,+other than an Application or a Combined Work as defined below.++  An "Application" is any work that makes use of an interface provided+by the Library, but which is not otherwise based on the Library.+Defining a subclass of a class defined by the Library is deemed a mode+of using an interface provided by the Library.++  A "Combined Work" is a work produced by combining or linking an+Application with the Library.  The particular version of the Library+with which the Combined Work was made is also called the "Linked+Version".++  The "Minimal Corresponding Source" for a Combined Work means the+Corresponding Source for the Combined Work, excluding any source code+for portions of the Combined Work that, considered in isolation, are+based on the Application, and not on the Linked Version.++  The "Corresponding Application Code" for a Combined Work means the+object code and/or source code for the Application, including any data+and utility programs needed for reproducing the Combined Work from the+Application, but excluding the System Libraries of the Combined Work.++  1. Exception to Section 3 of the GNU GPL.++  You may convey a covered work under sections 3 and 4 of this License+without being bound by section 3 of the GNU GPL.++  2. Conveying Modified Versions.++  If you modify a copy of the Library, and, in your modifications, a+facility refers to a function or data to be supplied by an Application+that uses the facility (other than as an argument passed when the+facility is invoked), then you may convey a copy of the modified+version:++   a) under this License, provided that you make a good faith effort to+   ensure that, in the event an Application does not supply the+   function or data, the facility still operates, and performs+   whatever part of its purpose remains meaningful, or++   b) under the GNU GPL, with none of the additional permissions of+   this License applicable to that copy.++  3. Object Code Incorporating Material from Library Header Files.++  The object code form of an Application may incorporate material from+a header file that is part of the Library.  You may convey such object+code under terms of your choice, provided that, if the incorporated+material is not limited to numerical parameters, data structure+layouts and accessors, or small macros, inline functions and templates+(ten or fewer lines in length), you do both of the following:++   a) Give prominent notice with each copy of the object code that the+   Library is used in it and that the Library and its use are+   covered by this License.++   b) Accompany the object code with a copy of the GNU GPL and this license+   document.++  4. Combined Works.++  You may convey a Combined Work under terms of your choice that,+taken together, effectively do not restrict modification of the+portions of the Library contained in the Combined Work and reverse+engineering for debugging such modifications, if you also do each of+the following:++   a) Give prominent notice with each copy of the Combined Work that+   the Library is used in it and that the Library and its use are+   covered by this License.++   b) Accompany the Combined Work with a copy of the GNU GPL and this license+   document.++   c) For a Combined Work that displays copyright notices during+   execution, include the copyright notice for the Library among+   these notices, as well as a reference directing the user to the+   copies of the GNU GPL and this license document.++   d) Do one of the following:++       0) Convey the Minimal Corresponding Source under the terms of this+       License, and the Corresponding Application Code in a form+       suitable for, and under terms that permit, the user to+       recombine or relink the Application with a modified version of+       the Linked Version to produce a modified Combined Work, in the+       manner specified by section 6 of the GNU GPL for conveying+       Corresponding Source.++       1) Use a suitable shared library mechanism for linking with the+       Library.  A suitable mechanism is one that (a) uses at run time+       a copy of the Library already present on the user's computer+       system, and (b) will operate properly with a modified version+       of the Library that is interface-compatible with the Linked+       Version. ++   e) Provide Installation Information, but only if you would otherwise+   be required to provide such information under section 6 of the+   GNU GPL, and only to the extent that such information is+   necessary to install and execute a modified version of the+   Combined Work produced by recombining or relinking the+   Application with a modified version of the Linked Version. (If+   you use option 4d0, the Installation Information must accompany+   the Minimal Corresponding Source and Corresponding Application+   Code. If you use option 4d1, you must provide the Installation+   Information in the manner specified by section 6 of the GNU GPL+   for conveying Corresponding Source.)++  5. Combined Libraries.++  You may place library facilities that are a work based on the+Library side by side in a single library together with other library+facilities that are not Applications and are not covered by this+License, and convey such a combined library under terms of your+choice, if you do both of the following:++   a) Accompany the combined library with a copy of the same work based+   on the Library, uncombined with any other library facilities,+   conveyed under the terms of this License.++   b) Give prominent notice with the combined library that part of it+   is a work based on the Library, and explaining where to find the+   accompanying uncombined form of the same work.++  6. Revised Versions of the GNU Lesser General Public License.++  The Free Software Foundation may publish revised and/or new versions+of the GNU Lesser General Public License from time to time. Such new+versions will be similar in spirit to the present version, but may+differ in detail to address new problems or concerns.++  Each version is given a distinguishing version number. If the+Library as you received it specifies that a certain numbered version+of the GNU Lesser General Public License "or any later version"+applies to it, you have the option of following the terms and+conditions either of that published version or of any later version+published by the Free Software Foundation. If the Library as you+received it does not specify a version number of the GNU Lesser+General Public License, you may choose any version of the GNU Lesser+General Public License ever published by the Free Software Foundation.++  If the Library as you received it specifies that a proxy can decide+whether future versions of the GNU Lesser General Public License shall+apply, that proxy's public statement of acceptance of any version is+permanent authorization for you to choose that version for the+Library.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMainWithHooks simpleUserHooks
+ casadi-bindings-internal.cabal view
@@ -0,0 +1,59 @@+name:                casadi-bindings-internal+version:             0.1+license:             LGPL-3+license-file:        LICENSE+category:            Numerical, Math+copyright:           (c) 2013-2014 Greg Horn+author:              Greg Horn+maintainer:          gregmainland@gmail.com+build-type:          Simple+cabal-version:       >=1.10+synopsis:            low level bindings to CasADi+description:+    Debian/Ubuntu instructions+    .+    Version numbers correspond to the C++ library version numbers except the very last number which may indicate breaking changes.+    .+    This only works on Debian/Ubuntu at the moment (sorry).+    .+    Install libcasadi from a .deb package here: https://github.com/casadi/casadi/releases, I use libcasadi-shared. (Get the version corresponding to the current casadi-bindings version, for example casadi-bindings-1.9.0.0 is libcasadi 1.9.0)+    .+    Then,+    - `cabal update; cabal install casadi-bindings`+    .+    Temporary note: there is something wrong with casadi and ipopt related to http://list.coin-or.org/pipermail/ipopt/2014-April/003670.html, and https://github.com/casadi/casadi/issues/1075. At the moment this .cabal package works for me as is, but YMMV+homepage:            http://github.com/ghorn/casadi-bindings+++extra-tmp-files:     Casadi/Callback_stub.h++library+  build-depends:       base >=4.6 && <5, vector >=0.10++  default-language:    Haskell2010+  hs-source-dirs: src++  extra-libraries:  stdc++++  pkgconfig-depends: casadi_core++  ghc-prof-options: -O2 -prof -fprof-auto -fprof-cafs -rtsopts+  ghc-options: -O2+  cc-options: -Wall -Wno-delete-non-virtual-dtor++  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.CToolsInstances+                    Casadi.Internal.Callback+                    Casadi.Internal.FormatException+++source-repository head+  type: git+  location: git://github.com/ghorn/casadi-bindings.git
+ cbits/callback.cpp view
@@ -0,0 +1,56 @@+#include <iostream>+#include "casadi/core/casadi.hpp"+#include "casadi/core/function/custom_function.hpp"+#include "casadi/core/functor_internal.hpp"++#include "HsFFI.h"++using namespace std;+using namespace casadi;++extern "C" {+typedef int (*hs_callback_t)(Function &f);+}++namespace casadi {+  class FunctorHaskellInternal {+    public:+      FunctorHaskellInternal(hs_callback_t hscb)+      {+          hs_callback = hscb;+      }+      ~FunctorHaskellInternal() {+          // free the haskell FunPtr+          hs_free_fun_ptr(HsFunPtr(hs_callback));+      }+    protected:+      hs_callback_t hs_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(hs_callback); }+  };++  class CallbackHaskell : public Callback {+    public:+      CallbackHaskell(hs_callback_t hscb) { assignNode(new CallbackHaskellInternal(hscb)); }+  };++  int CallbackHaskellInternal::call(Function& fcn, void* user_data) {+      return hs_callback(fcn);+  }+}++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" void delete_callback_haskell(casadi::CallbackHaskell* obj);+void delete_callback_haskell(casadi::CallbackHaskell* obj){+    delete obj;+}
+ cbits/hs_tools.cpp view
@@ -0,0 +1,57 @@+#include <iostream>+#include <vector>+#include "string.h"++using namespace std;++///////////// scalars /////////////+// string+extern "C" int hs_length_string(string * str);+int hs_length_string(string * str){+    return str->length();+}+extern "C" void hs_copy_string(string * str, char outputs[]);+void hs_copy_string(string * str, char outputs[]){+    strcpy(outputs, str->c_str());+}+extern "C" string * hs_new_string(char x[]);+string * hs_new_string(char x[]){+    return new string(x);+}+extern "C" void hs_delete_string(string * x);+void hs_delete_string(string * x){+    delete x;+}+++////////////////////////// copying vectors to arrays /////////////////////+template <typename T>+void hs_copy_vec_T(vector<T> * vec, T outputs[]){+    memcpy(outputs, &((*vec)[0]), vec->size()*sizeof(T));+}++//////////////////////    CREATING VECTORS FROM ARRAYS ///////////////////////////////////+// 1-dimensional+template <typename T>+vector<T> * hs_new_vec_T(T inputs[], int length){+    vector<T> vec;+    for (int k=0; k<length; k++)+        vec.push_back(inputs[k]);+    return new vector<T>(vec);+}++////////////////////////////////////////////////////////////////////////////////////////////+#define WRITE_STUFF(name, type) \+    extern "C" vector<type>* hs_new_vec_##name( type inputs[], int length); \+    vector<type>* hs_new_vec_##name( type inputs[], int length){return hs_new_vec_T(inputs, length);} \+    extern "C" void hs_delete_vec_##name(vector<type> * vec); \+    void hs_delete_vec_##name(vector<type> * vec){ delete vec; } \+    extern "C" void hs_copy_vec_##name(vector<type> * vec, type outputs[]); \+    void hs_copy_vec_##name(vector<type> * vec, type outputs[]){hs_copy_vec_T(vec, outputs);} \+    extern "C" int hs_size_vec_##name(vector<type> * vec); \+    int hs_size_vec_##name(vector<type> * vec){ return vec->size(); }++WRITE_STUFF(int,int)+WRITE_STUFF(voidp, void*)+WRITE_STUFF(uchar, unsigned char)+WRITE_STUFF(double, double)
+ src/Casadi/Internal/CToolsImports.hs view
@@ -0,0 +1,49 @@+{-# OPTIONS_GHC -Wall #-}+{-# Language ForeignFunctionInterface #-}++module Casadi.Internal.CToolsImports where++import Foreign.C.Types+import Foreign.Ptr ( Ptr )++import Casadi.Internal.MarshalTypes++--------------------------- ("int","CInt",Nothing,["Int","Bool"]) -----------------------------------+foreign import ccall unsafe "hs_new_vec_int" c_newVecCInt+  :: Ptr CInt -> CInt -> IO (Ptr (StdVec CInt))+foreign import ccall unsafe "hs_delete_vec_int" c_deleteVecCInt+  :: Ptr (StdVec CInt) -> IO ()+foreign import ccall unsafe "hs_copy_vec_int" c_copyVecCInt+  :: Ptr (StdVec CInt) -> Ptr CInt -> IO ()+foreign import ccall unsafe "hs_size_vec_int" c_sizeVecCInt+  :: Ptr (StdVec CInt) -> IO CInt++--------------------------- ("voidp","VoidP",Just "(Ptr a)",[]) -----------------------------------+foreign import ccall unsafe "hs_new_vec_voidp" c_newVecVoidP+  :: Ptr (Ptr a) -> CInt -> IO (Ptr (StdVec (Ptr a)))+foreign import ccall unsafe "hs_delete_vec_voidp" c_deleteVecVoidP+  :: Ptr (StdVec (Ptr a)) -> IO ()+foreign import ccall unsafe "hs_copy_vec_voidp" c_copyVecVoidP+  :: Ptr (StdVec (Ptr a)) -> Ptr (Ptr a) -> IO ()+foreign import ccall unsafe "hs_size_vec_voidp" c_sizeVecVoidP+  :: Ptr (StdVec (Ptr a)) -> IO CInt++--------------------------- ("uchar","CUChar",Nothing,[]) -----------------------------------+foreign import ccall unsafe "hs_new_vec_uchar" c_newVecCUChar+  :: Ptr CUChar -> CInt -> IO (Ptr (StdVec CUChar))+foreign import ccall unsafe "hs_delete_vec_uchar" c_deleteVecCUChar+  :: Ptr (StdVec CUChar) -> IO ()+foreign import ccall unsafe "hs_copy_vec_uchar" c_copyVecCUChar+  :: Ptr (StdVec CUChar) -> Ptr CUChar -> IO ()+foreign import ccall unsafe "hs_size_vec_uchar" c_sizeVecCUChar+  :: Ptr (StdVec CUChar) -> IO CInt++--------------------------- ("double","CDouble",Nothing,["Double"]) -----------------------------------+foreign import ccall unsafe "hs_new_vec_double" c_newVecCDouble+  :: Ptr CDouble -> CInt -> IO (Ptr (StdVec CDouble))+foreign import ccall unsafe "hs_delete_vec_double" c_deleteVecCDouble+  :: Ptr (StdVec CDouble) -> IO ()+foreign import ccall unsafe "hs_copy_vec_double" c_copyVecCDouble+  :: Ptr (StdVec CDouble) -> Ptr CDouble -> IO ()+foreign import ccall unsafe "hs_size_vec_double" c_sizeVecCDouble+  :: Ptr (StdVec CDouble) -> IO CInt
+ src/Casadi/Internal/CToolsInstances.hs view
@@ -0,0 +1,43 @@+{-# OPTIONS_GHC -Wall -fno-warn-orphans #-}+{-# Language FlexibleInstances #-}+{-# Language MultiParamTypeClasses #-}++module Casadi.Internal.CToolsInstances where++import Foreign.C.Types+import Foreign.Ptr ( Ptr )+import qualified Data.Vector as V++import Casadi.Internal.MarshalTypes+import Casadi.Internal.Marshal+import Casadi.Internal.CToolsImports+++-- ("int","CInt",Nothing,["Int","Bool"])+instance Marshal (V.Vector CInt) (Ptr (StdVec CInt)) where+  marshal = newStorableVec c_newVecCInt+  marshalFree = const c_deleteVecCInt+instance Marshal (V.Vector Int) (Ptr (StdVec CInt)) where+  marshal = newStorableVec c_newVecCInt . (V.map hsToC)+  marshalFree = const c_deleteVecCInt+instance Marshal (V.Vector Bool) (Ptr (StdVec CInt)) where+  marshal = newStorableVec c_newVecCInt . (V.map hsToC)+  marshalFree = const c_deleteVecCInt++-- ("voidp","VoidP",Just "(Ptr a)",[])+instance Marshal (V.Vector (Ptr a)) (Ptr (StdVec (Ptr a))) where+  marshal = newStorableVec c_newVecVoidP+  marshalFree = const c_deleteVecVoidP++-- ("uchar","CUChar",Nothing,[])+instance Marshal (V.Vector CUChar) (Ptr (StdVec CUChar)) where+  marshal = newStorableVec c_newVecCUChar+  marshalFree = const c_deleteVecCUChar++-- ("double","CDouble",Nothing,["Double"])+instance Marshal (V.Vector CDouble) (Ptr (StdVec CDouble)) where+  marshal = newStorableVec c_newVecCDouble+  marshalFree = const c_deleteVecCDouble+instance Marshal (V.Vector Double) (Ptr (StdVec CDouble)) where+  marshal = newStorableVec c_newVecCDouble . (V.map hsToC)+  marshalFree = const c_deleteVecCDouble
+ src/Casadi/Internal/Callback.hs view
@@ -0,0 +1,23 @@+{-# OPTIONS_GHC -Wall #-}+{-# Language ScopedTypeVariables #-}+{-# Language FlexibleContexts #-}++module Casadi.Internal.Callback+       ( c_newCallbackHaskell+       , mkCallback+       ) 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(..) )++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')
+ src/Casadi/Internal/CppHelpers.hs view
@@ -0,0 +1,41 @@+{-# OPTIONS_GHC -Wall #-}++module Casadi.Internal.CppHelpers+       ( newStdVec+       , readStdVec+       , c_newStdString+       , c_deleteStdString+       , c_lengthStdString+       , c_copyStdString+       ) where++import qualified Data.Vector as V+import Foreign.C.Types+import Foreign.Ptr ( Ptr )+import Foreign.Marshal ( mallocArray, free, peekArray, withArrayLen )++import Casadi.Internal.MarshalTypes+import Casadi.Internal.CToolsImports++newStdVec :: V.Vector (Ptr a) -> IO (Ptr (StdVec (Ptr a)))+newStdVec vec = do+  withArrayLen (V.toList vec) $ \num array ->+    c_newVecVoidP array (fromIntegral num)++readStdVec :: Ptr (StdVec (Ptr a)) -> IO (V.Vector (Ptr a))+readStdVec vecPtr = do+  n <- fmap fromIntegral (c_sizeVecVoidP vecPtr)+  arr <- mallocArray n+  c_copyVecVoidP vecPtr arr+  ret <- peekArray n arr+  free arr+  return (V.fromList ret)++foreign import ccall unsafe "hs_new_string" c_newStdString+  :: Ptr CChar -> IO (Ptr StdString)+foreign import ccall unsafe "hs_delete_string" c_deleteStdString+  :: Ptr StdString -> IO ()+foreign import ccall unsafe "hs_length_string" c_lengthStdString+  :: Ptr StdString -> IO CInt+foreign import ccall unsafe "hs_copy_string" c_copyStdString+  :: Ptr StdString -> Ptr CChar -> IO ()
+ src/Casadi/Internal/FormatException.hs view
@@ -0,0 +1,15 @@+{-# OPTIONS_GHC -Wall #-}++module Casadi.Internal.FormatException+       ( formatException+       ) where++formatException :: String -> String+formatException = rstrip . lstrip++rstrip :: String -> String+rstrip xs = reverse (lstrip (reverse xs))++lstrip :: String -> String+lstrip ('\n':xs) = lstrip xs+lstrip xs = xs
+ src/Casadi/Internal/Marshal.hs view
@@ -0,0 +1,110 @@+{-# OPTIONS_GHC -Wall #-}+{-# Language ScopedTypeVariables #-}+{-# Language MultiParamTypeClasses #-}+{-# Language FlexibleInstances #-}+{-# Language FlexibleContexts #-}++module Casadi.Internal.Marshal+       ( Marshal(..)+       , withMarshal+       , newStorableVec+       , HsToC(..)+       , withMarshalStorableVec+       ) where++import Control.Monad ( when )+import qualified Data.Vector as V+import Foreign.C.Types+import Foreign.C.String ( withCString )+import Foreign.Ptr ( Ptr )+import Foreign.Marshal ( withArrayLen )+import Foreign.Storable ( Storable )++import Casadi.Internal.CToolsImports ( c_deleteVecVoidP )+import Casadi.Internal.CppHelpers ( newStdVec, readStdVec, c_newStdString, c_deleteStdString )+import Casadi.Internal.MarshalTypes ( StdVec, StdString, StdPair )++class Marshal a b where+  marshal :: a -> IO b+  marshalFree :: a -> b -> IO ()++  marshalFree = const (const (return ()))++withMarshal :: forall a b c. Marshal a b => a -> (b -> IO c) -> IO c+withMarshal x f = do+  x' <- marshal x :: IO b+  ret <- f x' :: IO c+  marshalFree x x' :: IO ()+  return ret :: IO c++class HsToC a b where+  hsToC :: a -> b+instance HsToC Int CInt where+  hsToC = fromIntegral -- really should check min/max bounds here+instance HsToC Int CLong where+  hsToC = fromIntegral+instance HsToC Bool CInt where+  hsToC False = 0+  hsToC True = 1+instance HsToC Double CDouble where+  hsToC = realToFrac+instance HsToC CUChar CUChar where+  hsToC = id+instance HsToC CSize CSize where+  hsToC = id++instance Marshal Int CInt where+  marshal = return . hsToC+instance Marshal Int CLong where+  marshal = return . hsToC+instance Marshal Bool CInt where+  marshal = return . hsToC+instance Marshal Double CDouble where+  marshal = return . hsToC+instance Marshal CUChar CUChar where+  marshal = return . hsToC+instance Marshal CSize CSize where+  marshal = return . hsToC++instance Marshal String (Ptr StdString) where+  marshal str = newStdString str+  marshalFree _ stdStr = c_deleteStdString stdStr++newStdString :: String -> IO (Ptr StdString)+newStdString x = withCString x $ \cstring -> c_newStdString cstring++--instance Marshal String (Ptr CChar) where+--  withMarshal = withCString++++instance Marshal a (Ptr b) => Marshal (V.Vector a) (Ptr (StdVec (Ptr b))) where+  marshal vec = do+    ptrs <- V.mapM marshal vec :: IO (V.Vector (Ptr b))+    newStdVec ptrs+  marshalFree vec0 cppvec = do+    ptrs <- readStdVec cppvec :: IO (V.Vector (Ptr b))+    when (V.length vec0 /= V.length ptrs) $+      error "unmarshal: Marshal (Vector a) (Ptr (CooVec (Ptr b))) length mismatch"+    V.zipWithM_ marshalFree vec0 ptrs+    c_deleteVecVoidP cppvec++newStorableVec ::+  Storable a =>+  (Ptr a -> CInt -> IO (Ptr (StdVec a))) ->+  V.Vector a -> IO (Ptr (StdVec a))+newStorableVec newVec vec = do+  withArrayLen (V.toList vec) $ \num array ->+    newVec array (fromIntegral num)++withMarshalStorableVec ::+  Storable a =>+  (Ptr a -> CInt -> IO (Ptr (StdVec a))) ->+  (Ptr (StdVec a) -> IO ()) ->+  V.Vector a -> (Ptr (StdVec a) -> IO b) -> IO b+withMarshalStorableVec newVec deleteVec vec f = do+  ptrStdVec <- withArrayLen (V.toList vec) $ \num array ->+    newVec array (fromIntegral num)+  ret <- f ptrStdVec+  deleteVec ptrStdVec+  return ret
+ src/Casadi/Internal/MarshalTypes.hs view
@@ -0,0 +1,13 @@+{-# OPTIONS_GHC -Wall #-}++module Casadi.Internal.MarshalTypes+       ( StdVec+       , StdString+       , StdOstream+       , StdPair+       ) where++data StdVec a+data StdPair a b+data StdString+data StdOstream
+ src/Casadi/Internal/WrapReturn.hs view
@@ -0,0 +1,74 @@+{-# OPTIONS_GHC -Wall #-}+{-# Language MultiParamTypeClasses #-}+{-# Language FlexibleInstances #-}+{-# Language FlexibleContexts #-}+{-# Language ScopedTypeVariables #-}++module Casadi.Internal.WrapReturn+       ( WrapReturn(..)+       ) where++import qualified Data.Vector as V+import Foreign.C.Types+import Foreign.C.String+import Foreign.Ptr ( Ptr )+import Foreign.Storable ( Storable )+import Foreign.Marshal ( mallocArray, free, peekArray )++import Casadi.Internal.MarshalTypes ( StdVec, StdString )++import Casadi.Internal.CppHelpers ( readStdVec, c_lengthStdString, c_copyStdString, c_deleteStdString )+import Casadi.Internal.CToolsImports++class WrapReturn a b where+  wrapReturn :: a -> IO b+instance WrapReturn a a where+  wrapReturn = return+instance WrapReturn CInt Int where+  wrapReturn = return . fromIntegral+instance WrapReturn CDouble Double where+  wrapReturn = return . realToFrac+instance WrapReturn CLong Int where+  wrapReturn = return . fromIntegral+instance WrapReturn CInt Bool where+  wrapReturn 0 = return False+  wrapReturn _ = return True+++instance WrapReturn (Ptr a) b => WrapReturn (Ptr (StdVec (Ptr a))) (V.Vector b) where+  wrapReturn cppvec = do+    vec <- readStdVec cppvec >>= (V.mapM wrapReturn) :: IO (V.Vector b)+    c_deleteVecVoidP cppvec+    return vec++instance WrapReturn (Ptr StdString) String where+  wrapReturn stdStr = do+    len <- fmap fromIntegral $ c_lengthStdString stdStr+    cstring <- mallocArray (len + 1)+    c_copyStdString stdStr cstring+    ret <- peekCString cstring+    free cstring+    c_deleteStdString stdStr+    return ret++wrapReturnVec ::+  Storable a =>+  (Ptr (StdVec a) -> IO CInt) ->+  (Ptr (StdVec a) -> Ptr a -> IO ()) ->+  (Ptr (StdVec a) -> IO ()) ->+  (a -> IO b) ->+  Ptr (StdVec a) -> IO (V.Vector b)+wrapReturnVec vecSize vecCopy vecDel cToHs vecPtr = do+  n <- fmap fromIntegral (vecSize vecPtr)+  arr <- mallocArray n+  vecCopy vecPtr arr+  ret <- peekArray n arr+  free arr+  vecDel vecPtr+  fmap V.fromList (mapM cToHs ret)++instance WrapReturn (Ptr (StdVec CInt)) (V.Vector Int) 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