casadi-bindings-internal 0.1.3.0 → 0.1.3.1
raw patch · 7 files changed
+260/−50 lines, 7 filesdep +containers
Dependencies added: containers
Files
- casadi-bindings-internal.cabal +3/−4
- cbits/hs_tools.cpp +81/−0
- src/Casadi/Internal/CToolsImports.hs +35/−0
- src/Casadi/Internal/CToolsInstances.hs +0/−43
- src/Casadi/Internal/Marshal.hs +96/−2
- src/Casadi/Internal/MarshalTypes.hs +2/−0
- src/Casadi/Internal/WrapReturn.hs +43/−1
casadi-bindings-internal.cabal view
@@ -1,5 +1,5 @@ name: casadi-bindings-internal-version: 0.1.3.0+version: 0.1.3.1 license: LGPL-3 license-file: LICENSE category: Numerical, Math@@ -16,7 +16,7 @@ extra-tmp-files: Casadi/Callback_stub.h library- build-depends: base >=4.6 && <5, vector >=0.10+ build-depends: base >=4.6 && <5, vector >=0.10, containers default-language: Haskell2010 hs-source-dirs: src@@ -27,7 +27,7 @@ ghc-prof-options: -O2 -prof -fprof-auto -fprof-cafs -rtsopts ghc-options: -O2- cc-options: -Wall -Wno-delete-non-virtual-dtor -Wno-sign-compare+ cc-options: -Wall -Wno-delete-non-virtual-dtor -Wno-sign-compare -std=c++11 C-sources: cbits/hs_tools.cpp cbits/callback.cpp@@ -37,7 +37,6 @@ Casadi.Internal.WrapReturn Casadi.Internal.CppHelpers Casadi.Internal.CToolsImports- Casadi.Internal.CToolsInstances Casadi.Internal.Callback Casadi.Internal.FormatException
cbits/hs_tools.cpp view
@@ -1,5 +1,6 @@ #include <iostream> #include <vector>+#include <map> #include "string.h" using namespace std;@@ -23,6 +24,86 @@ delete x; } +////////////////// std::pair /////////////////+extern "C" std::pair<void*,void*> * hs_new_stdpair(void * x, void * y);+std::pair<void*,void*> * hs_new_stdpair(void * x, void * y) {+ return new std::pair<void*,void*>(x, y);+}+extern "C" void * hs_stdpair_fst(std::pair<void*,void*> * stdpair);+void * hs_stdpair_fst(std::pair<void*,void*> * stdpair) {+ return stdpair->first;+}+extern "C" void * hs_stdpair_snd(std::pair<void*,void*> * stdpair);+void * hs_stdpair_snd(std::pair<void*,void*> * stdpair) {+ return stdpair->second;+}+extern "C" void hs_delete_stdpair(std::pair<void*,void*> * pair);+void hs_delete_stdpair(std::pair<void*,void*> * pair){+ delete pair;+}++extern "C" std::pair<int,int> * hs_new_stdpair_int(int x, int y);+std::pair<int,int> * hs_new_stdpair_int(int x, int y) {+ return new std::pair<int,int>(x, y);+}+extern "C" int hs_stdpair_fst_int(std::pair<int,int> * stdpair);+int hs_stdpair_fst_int(std::pair<int,int> * stdpair) {+ return stdpair->first;+}+extern "C" int hs_stdpair_snd_int(std::pair<int,int> * stdpair);+int hs_stdpair_snd_int(std::pair<int,int> * stdpair) {+ return stdpair->second;+}+extern "C" void hs_delete_stdpair_int(std::pair<int,int> * pair);+void hs_delete_stdpair_int(std::pair<int,int> * pair){+ delete pair;+}+++////////////////// std::map /////////////////+extern "C" std::map<string,void*> * hs_new_dict(std::vector<std::string*> * keys,+ std::vector<void*> * vals);+std::map<string,void*> * hs_new_dict(std::vector<std::string*> * keys, std::vector<void*> * vals) {+ std::map<std::string,void*> * ret = new std::map<std::string,void*>;+ for (int k = 0; k < keys->size(); k++) {+ std::string key = *((*keys)[k]);+ void * val = (*vals)[k];+ std::pair<std::string, void*> keyVal(key, val);+ ret->insert(keyVal);+ }+ return ret;+}++extern "C" int hs_dict_size(std::map<std::string, void*> * map);+int hs_dict_size(std::map<std::string, void*> * map) {+ return map->size();+}++extern "C" void hs_dict_copy(std::map<std::string, void*> * map,+ std::string * keys[],+ void * vals[]);+void hs_dict_copy(std::map<std::string, void*> * map,+ std::string * keys[],+ void * vals[]) {+ int k = 0;+ for(std::map<std::string, void*>::iterator it = map->begin(); it != map->end(); it++) {+ std::string * key = new std::string(it->first);+ void * val = it->second;+ keys[k] = key;+ vals[k] = val;+ k++;+ }+}++extern "C" void * hs_lookup_dict(std::map<std::string, void*> * map, std::string* key);+void * hs_lookup_dict(std::map<std::string, void*> * map, std::string* key) {+ return map->at(*key);+}++extern "C" void hs_delete_dict(std::map<std::string,void*> *);+void hs_delete_dict(std::map<std::string,void*> * dict) {+ delete dict;+} ////////////////////////// copying vectors to arrays ///////////////////// template <typename T>
src/Casadi/Internal/CToolsImports.hs view
@@ -8,6 +8,41 @@ import Casadi.Internal.MarshalTypes +--------------------------- stdpair -----------------------------------+foreign import ccall unsafe "hs_new_stdpair" c_newStdPair+ :: Ptr a -> Ptr b -> IO (Ptr (StdPair (Ptr a) (Ptr b)))+foreign import ccall unsafe "hs_stdpair_fst" c_stdPairFst+ :: Ptr (StdPair (Ptr a) (Ptr b)) -> IO (Ptr a)+foreign import ccall unsafe "hs_stdpair_snd" c_stdPairSnd+ :: Ptr (StdPair (Ptr a) (Ptr b)) -> IO (Ptr b)+foreign import ccall unsafe "hs_delete_stdpair" c_deleteStdPair+ :: Ptr (StdPair (Ptr a) (Ptr b)) -> IO ()++foreign import ccall unsafe "hs_new_stdpair_int" c_newStdPairInt+ :: CInt -> CInt -> IO (Ptr (StdPair CInt CInt))+foreign import ccall unsafe "hs_stdpair_fst_int" c_stdPairFstInt+ :: Ptr (StdPair CInt CInt) -> IO CInt+foreign import ccall unsafe "hs_stdpair_snd_int" c_stdPairSndInt+ :: Ptr (StdPair CInt CInt) -> IO CInt+foreign import ccall unsafe "hs_delete_stdpair_int" c_deleteStdPairInt+ :: Ptr (StdPair CInt CInt) -> IO ()++--------------------------- stdmap -----------------------------------+foreign import ccall unsafe "hs_new_dict" c_newDict+ :: Ptr (StdVec (Ptr StdString)) -> Ptr (StdVec (Ptr a)) -> IO (Ptr (StdMap StdString (Ptr a)))++foreign import ccall unsafe "hs_dict_size" c_dictSize+ :: Ptr (StdMap StdString (Ptr a)) -> IO CInt++foreign import ccall unsafe "hs_lookup_dict" c_lookupDict+ :: Ptr (StdMap StdString (Ptr a)) -> Ptr StdString -> IO (Ptr a)++foreign import ccall unsafe "hs_dict_copy" c_dictCopy+ :: Ptr (StdMap StdString (Ptr a)) -> Ptr (Ptr StdString) -> Ptr (Ptr a) -> IO ()++foreign import ccall unsafe "hs_delete_dict" c_deleteDict+ :: Ptr (StdMap StdString (Ptr a)) -> IO ()+ --------------------------- ("int","CInt",Nothing,["Int","Bool"]) ----------------------------------- foreign import ccall unsafe "hs_new_vec_int" c_newVecCInt :: Ptr CInt -> CInt -> IO (Ptr (StdVec CInt))
− src/Casadi/Internal/CToolsInstances.hs
@@ -1,43 +0,0 @@-{-# 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/Marshal.hs view
@@ -3,6 +3,7 @@ {-# Language MultiParamTypeClasses #-} {-# Language FlexibleInstances #-} {-# Language FlexibleContexts #-}+{-# Language InstanceSigs #-} module Casadi.Internal.Marshal ( Marshal(..)@@ -14,15 +15,17 @@ import Control.Monad ( when ) import qualified Data.Vector as V+import qualified Data.Map as M 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.CToolsImports+--import Casadi.Internal.CToolsImports ( c_deleteVecVoidP ) import Casadi.Internal.CppHelpers ( newStdVec, readStdVec, c_newStdString, c_deleteStdString )-import Casadi.Internal.MarshalTypes ( StdVec, StdString, StdPair )+import Casadi.Internal.MarshalTypes ( StdMap, StdPair, StdVec, StdString ) class Marshal a b where marshal :: a -> IO b@@ -65,6 +68,97 @@ marshal = return . hsToC instance Marshal CSize CSize where marshal = return . hsToC++-- ("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++-- stdpair+instance (Marshal a (Ptr pa), Marshal b (Ptr pb))+ => Marshal (a, b) (Ptr (StdPair (Ptr pa) (Ptr pb))) where+ marshal (x,y) = do+ px <- marshal x+ py <- marshal y+ c_newStdPair px py+ marshalFree (x,y) stdpair = do+ px <- c_stdPairFst stdpair+ py <- c_stdPairSnd stdpair+ marshalFree x px+ marshalFree y py+ c_deleteStdPair stdpair++-- stdpair+instance (Marshal a CInt, Marshal b CInt)+ => Marshal (a, b) (Ptr (StdPair CInt CInt)) where+ marshal (x,y) = do+ px <- marshal x+ py <- marshal y+ c_newStdPairInt px py+ marshalFree (x,y) stdpair = do+ cx <- c_stdPairFstInt stdpair+ cy <- c_stdPairSndInt stdpair+ marshalFree x cx+ marshalFree y cy+ c_deleteStdPairInt stdpair++-- stdmap+instance (Marshal a (Ptr pa))+ => Marshal (M.Map String a) (Ptr (StdMap StdString (Ptr pa))) where+ marshal m = do+ let (keys, vals) = unzip (M.toAscList m)+ vecKeys = V.fromList keys+ vecKeyPtrs <- V.mapM marshal vecKeys :: IO (V.Vector (Ptr StdString))+ vecValPtrs <- V.mapM marshal (V.fromList vals) :: IO (V.Vector (Ptr pa))++ stdVecKeys <- newStdVec vecKeyPtrs+ :: IO (Ptr (StdVec (Ptr StdString)))+ stdVecVals <- newStdVec vecValPtrs+ :: IO (Ptr (StdVec (Ptr pa)))++ dict <- c_newDict stdVecKeys stdVecVals++ c_deleteVecVoidP stdVecKeys+ c_deleteVecVoidP stdVecVals++ V.zipWithM_ marshalFree vecKeys vecKeyPtrs++ return dict++ marshalFree m dict = do+ let (keys, vals) = unzip (M.toAscList m)+ vecKeys = V.fromList keys+ vecKeyPtrs <- V.mapM marshal vecKeys :: IO (V.Vector (Ptr StdString))+ vecVals <- V.mapM (c_lookupDict dict) vecKeyPtrs :: IO (V.Vector (Ptr pa))++ V.zipWithM_ marshalFree vecKeys vecKeyPtrs+ V.zipWithM_ marshalFree (V.fromList vals) vecVals+ c_deleteDict dict+ instance Marshal String (Ptr StdString) where marshal str = newStdString str
src/Casadi/Internal/MarshalTypes.hs view
@@ -5,9 +5,11 @@ , StdString , StdOstream , StdPair+ , StdMap ) where data StdVec a data StdPair a b+data StdMap a b data StdString data StdOstream
src/Casadi/Internal/WrapReturn.hs view
@@ -8,6 +8,7 @@ ( WrapReturn(..) ) where +import qualified Data.Map as M import qualified Data.Vector as V import Foreign.C.Types import Foreign.C.String@@ -15,7 +16,7 @@ import Foreign.Storable ( Storable ) import Foreign.Marshal ( mallocArray, free, peekArray ) -import Casadi.Internal.MarshalTypes ( StdVec, StdString )+import Casadi.Internal.MarshalTypes ( StdMap, StdVec, StdString, StdPair ) import Casadi.Internal.CppHelpers ( readStdVec, c_lengthStdString, c_copyStdString, c_deleteStdString ) import Casadi.Internal.CToolsImports@@ -33,6 +34,47 @@ instance WrapReturn CInt Bool where wrapReturn 0 = return False wrapReturn _ = return True++instance WrapReturn (Ptr a) b => WrapReturn (Ptr (StdMap StdString (Ptr a))) (M.Map String b) where+ wrapReturn stdMap = do+ msize <- fmap fromIntegral (c_dictSize stdMap)+ keyArray <- mallocArray msize :: IO (Ptr (Ptr StdString))+ valArray <- mallocArray msize :: IO (Ptr (Ptr a))++ c_dictCopy stdMap keyArray valArray+ c_deleteDict stdMap++ keys0 <- peekArray msize keyArray :: IO [Ptr StdString]+ vals0 <- peekArray msize valArray :: IO [Ptr a]++ free keyArray+ free valArray++ keys <- mapM wrapReturn keys0 :: IO [String]+ vals <- mapM wrapReturn vals0 :: IO [b]++ return $ M.fromList (zip keys vals)+++instance (WrapReturn (Ptr pa) a, WrapReturn (Ptr pb) b)+ => WrapReturn (Ptr (StdPair (Ptr pa) (Ptr pb))) (a, b) where+ wrapReturn stdPair = do+ px <- c_stdPairFst stdPair+ py <- c_stdPairSnd stdPair+ x <- wrapReturn px+ y <- wrapReturn py+ c_deleteStdPair stdPair+ return (x, y)++instance (WrapReturn CInt a, WrapReturn CInt b)+ => WrapReturn (Ptr (StdPair CInt CInt)) (a, b) where+ wrapReturn stdPair = do+ px <- c_stdPairFstInt stdPair+ py <- c_stdPairSndInt stdPair+ x <- wrapReturn px+ y <- wrapReturn py+ c_deleteStdPairInt stdPair+ return (x, y) instance WrapReturn (Ptr a) b => WrapReturn (Ptr (StdVec (Ptr a))) (V.Vector b) where