packages feed

casadi-bindings 2.4.1.9 → 3.0.0.0

raw patch · 22 files changed

+927/−727 lines, 22 filesdep +HUnitdep +QuickCheckdep +casadi-bindingsdep ~casadi-bindings-coredep ~casadi-bindings-internal

Dependencies added: HUnit, QuickCheck, casadi-bindings, test-framework, test-framework-hunit, test-framework-quickcheck2

Dependency ranges changed: casadi-bindings-core, casadi-bindings-internal

Files

casadi-bindings.cabal view
@@ -1,5 +1,5 @@ name:                casadi-bindings-version:             2.4.1.9+version:             3.0.0.0 synopsis:            mid-level bindings to CasADi category:            Numerical, Math description:@@ -37,22 +37,20 @@ build-type:          Simple cabal-version:       >=1.10 +extra-tmp-files:     Casadi/Callback_stub.h+ library   hs-source-dirs:      src   exposed-modules:     Casadi.CMatrix                        Casadi.Callback-                       Casadi.DMatrix+                       Casadi.DM                        Casadi.Function-                       Casadi.GenericC-                       Casadi.IOScheme+                       Casadi.GenericType                        Casadi.MX-                       Casadi.MXFunction-                       Casadi.Option                        Casadi.Overloading                        Casadi.Slice                        Casadi.Sparsity                        Casadi.SX-                       Casadi.SXFunction                        Casadi.Viewable   other-modules:       Casadi.SharedObject   build-depends:       base >=4.6 && <5,@@ -63,14 +61,14 @@                        cereal,                        binary,                        vector-binary-instances,-                       casadi-bindings-internal == 0.1.3.1,-                       casadi-bindings-core     == 2.4.1.0+                       casadi-bindings-internal == 0.1.4.0,+                       casadi-bindings-core     == 3.0.0.0   default-language:    Haskell2010 -  C-sources:           cbits/handwritten.cpp+  C-sources:           cbits/casadi_bindings.cpp   extra-libraries:     stdc++   pkgconfig-depends:   casadi-  cc-options: -Wall -Wno-sign-compare+  cc-options: -Wall -Wno-sign-compare -std=c++11  source-repository head   type: git@@ -82,6 +80,25 @@   build-depends:       base >= 4 && < 5,                        doctest >= 0.8   default-language:    Haskell2010-  ghc-options:         -threaded+  cc-options:          -std=c++11+  extra-libraries:     stdc++   hs-source-dirs:      tests ++test-suite unit-tests+  type:                exitcode-stdio-1.0+  hs-source-dirs:      tests+  main-is:             UnitTests.hs+  other-modules:       CallbackTests+                       GTypeTests+  default-language:    Haskell2010+  build-depends:       QuickCheck >= 2,+                       HUnit,+                       test-framework,+                       test-framework-hunit,+                       test-framework-quickcheck2,+                       containers,+                       vector,+                       casadi-bindings,+                       base >=4.6 && < 5+  ghc-options:         -O2
+ cbits/casadi_bindings.cpp view
@@ -0,0 +1,146 @@+#include "math.h"+#include <iostream>+#include "casadi/core/core.hpp"+#include "casadi/core/function/callback.hpp"++#include "HsFFI.h"++// #define DEBUG_WOO++#ifdef DEBUG_WOO+#define debug(msg)    \+  std::cerr << "* " << msg << std::endl;+#else+#define debug(msg){}+#endif++typedef std::vector<casadi::DM>*+  (*hs_callback_thing)(std::vector<casadi::DM*>*,+                       std::map<std::string, casadi::GenericType*>*);++class HaskellCallback : public casadi::Callback {+public:+  HaskellCallback(HsFunPtr hsfp,+                  std::vector<casadi::Sparsity> &sp_in_,+                  std::vector<casadi::Sparsity> &sp_out_) : sp_in(sp_in_), sp_out(sp_out_) {+    debug("HaskellCallback constructor called...");+    hs_fun_ptr = hsfp;+  }++  // Creator function, creates an owning reference+  static casadi::Function create(const std::string& name,+                                 HsFunPtr hsfp,+                                 std::vector<casadi::Sparsity> &sp_in_,+                                 std::vector<casadi::Sparsity> &sp_out_,+                                 const casadi::Dict& opts=casadi::Dict()) {+    debug("HaskellCallback create called...");+    return casadi::Callback::create(name, new HaskellCallback(hsfp, sp_in_, sp_out_), opts);+  }++  // Number of inputs and outputs+  virtual int get_n_in() { return sp_in.size(); }+  virtual int get_n_out() { return sp_out.size(); }+  virtual casadi::Sparsity get_sparsity_in(int i) {+    debug("HaskellCallback::get_sparsity_in called");+    return sp_in[i];+  }+  virtual casadi::Sparsity get_sparsity_out(int i) {+    debug("HaskellCallback::get_sparsity_out called");+    return sp_out[i];+  }+  +  virtual std::vector<casadi::DM> eval(const std::vector<casadi::DM>& args) {+    debug("HaskellCallback::eval() called. Converting inputs to haskell-friendly...");+    std::vector<casadi::DM*> *hsArgs = new std::vector<casadi::DM*>();+    for (int k = 0; k < args.size(); k++) {+      hsArgs->push_back(new casadi::DM(args[k]));+    }+    +    std::map<std::string, casadi::GenericType> latestStats = stats();+    debug("HaskellCallback::eval() called. Converting stats to haskell-friendly...");+    std::map<std::string, casadi::GenericType*> *hsStats =+      new std::map<std::string, casadi::GenericType*>();+    std::map<std::string, casadi::GenericType>::iterator it;+    for (it = latestStats.begin(); it != latestStats.end(); it++) {+      std::string key = it->first;+      casadi::GenericType *val = new casadi::GenericType(it->second);+      std::pair<std::string, casadi::GenericType*> keyVal(key, val);+      hsStats->insert(keyVal);+    }+    +    debug("HaskellCallback::eval() calling back to the haskell function...");+    std::vector<casadi::DM>* hsRet = ((hs_callback_thing)hs_fun_ptr)(hsArgs, hsStats);++    debug("HaskellCallback::call() converting haskell outputs to casadi-friendly...");+    std::vector<casadi::DM> ret;+    for (int k = 0; k < hsRet->size(); k++) {+      ret.push_back((*hsRet)[k]);+    }+    delete hsRet;++    debug("HaskellCallback::call() return size: " << ret.size());+    debug("HaskellCallback::call() returning casadi outputs to casadi...");+    return ret;+  }+  +  // Initialize the object+  virtual void init() {+    debug("HaskellCallback::init() called...");+  }++  ~HaskellCallback() {+    // free the haskell FunPtr+    debug("HaskellCallback destructor started\n");+    hs_free_fun_ptr(hs_fun_ptr);+    debug("HaskellCallback destructor finished\n");+  }+private:+  HsFunPtr hs_fun_ptr;+  std::vector<casadi::Sparsity> sp_in;+  std::vector<casadi::Sparsity> sp_out;++}; // class HaskellCallback+++extern "C"+casadi::Function * new_callback_haskell(HsFunPtr hsfp,+                                        std::vector<casadi::Sparsity*> *sp_in,+                                        std::vector<casadi::Sparsity*> *sp_out);+casadi::Function * new_callback_haskell(HsFunPtr hsfp,+                                        std::vector<casadi::Sparsity*> *sp_in_p,+                                        std::vector<casadi::Sparsity*> *sp_out_p) {+  casadi::Dict options = casadi::Dict();+  debug("new_callback_haskell called. Unpacking sparsity_in/sparsity_out");+  std::vector<casadi::Sparsity> sp_in;+  for (int k=0; k<sp_in_p->size(); k++) {+    sp_in.push_back(*((*sp_in_p)[k]));+  }+  std::vector<casadi::Sparsity> sp_out;+  for (int k=0; k<sp_out_p->size(); k++) {+    sp_out.push_back(*((*sp_out_p)[k]));+  }+  return new casadi::Function(HaskellCallback::create("haskell_callback",+                                                      hsfp,+                                                      sp_in, sp_out,+                                                      options));+}++extern "C"+std::vector<casadi::DM>* to_dm_vec(std::vector<casadi::DM*> *x);+std::vector<casadi::DM>* to_dm_vec(std::vector<casadi::DM*> *x) {+  std::vector<casadi::DM> *ret = new std::vector<casadi::DM>();+  for (int k=0; k<x->size(); k++) {+    ret->push_back(*((*x)[k]));+  }+  return ret;+}++extern "C" double c_fmod(double x, double y);+double c_fmod(double x, double y) {+  return fmod(x, y);+}++extern "C" float c_fmodf(float x, float y);+float c_fmodf(float x, float y) {+  return fmodf(x, y);+}
− cbits/handwritten.cpp 
@@ -1,11 +0,0 @@-#include "math.h"--extern "C" double c_fmod(double x, double y);-double c_fmod(double x, double y) {-  return fmod(x, y);-}--extern "C" float c_fmodf(float x, float y);-float c_fmodf(float x, float y) {-  return fmodf(x, y);-}
src/Casadi/CMatrix.hs view
@@ -8,7 +8,7 @@ import qualified Data.Vector as V import Data.Map ( Map ) -import Casadi.Core.Classes.DMatrix ( DMatrix )+import Casadi.Core.Classes.DM ( DM ) import Casadi.Core.Classes.GenericType ( GenericType )  import Casadi.Overloading ( Fmod, ArcTan2, SymOrd, Erf )@@ -32,9 +32,9 @@   -- | matrix matrix product   mm :: a -> a -> a   -- | sumAll(x*y), x and y same dimension-  innerProd :: a -> a -> a-  sumCols :: a -> a-  sumRows :: a -> a+  dot :: a -> a -> a+  sum1 :: a -> a+  sum2 :: a -> a   -- | transpose   trans :: a -> a   diag :: a -> a@@ -48,19 +48,23 @@   sparsity :: a -> Sparsity   getNZ :: a -> Slice -> a   setNZ :: a -> a -> Slice -> IO ()+  inv :: a -> a+  pinv :: a -> a+  pinv' :: a -> String -> Map String GenericType -> a   triu :: a -> a   tril :: a -> a   triu2symm :: a -> a   tril2symm :: a -> a   copy :: a -> IO a   densify :: a -> a-  fromDMatrix :: DMatrix -> a+  fromDM :: DM -> a   fromDVector :: V.Vector Double -> a   fromDouble :: Double -> a-  allocEmpty :: IO a   reshape :: a -> (Int, Int) -> a   conditional :: a -> V.Vector a -> a -> a   conditional' :: a -> V.Vector a -> a -> Bool -> a+  cmin :: a -> a -> a+  cmax :: a -> a -> a {-# DEPRECATED solve' "use the new solve, this one is going away" #-}
src/Casadi/Callback.hs view
@@ -4,66 +4,53 @@  module Casadi.Callback        ( makeCallback-       , makeCustomEvaluate-       , makeDerivativeGenerator        ) where -import Foreign.C.Types ( CInt )-import Foreign.Ptr ( Ptr )-import Foreign.ForeignPtr ( newForeignPtr_ )-import Foreign.ForeignPtr.Unsafe ( unsafeForeignPtrToPtr )+import Data.Map ( Map )+import qualified Data.Traversable as T+import Data.Vector ( Vector )+import Foreign.Ptr ( Ptr, FunPtr ) -import Casadi.Core.Data+import Casadi.Core.Data ( DM, DM', Function, Function'+                        , GenericType, GenericType', Sparsity, Sparsity' )+import Casadi.Internal.Marshal ( withMarshal )+import Casadi.Internal.MarshalTypes import Casadi.Internal.WrapReturn ( WrapReturn(..) )-import Casadi.Internal.Callback ( mkCallback, c_newCallbackHaskell-                                , mkCustomEvaluate, c_newCustomEvaluateHaskell-                                , mkDerivativeGenerator, c_newDerivativeGeneratorHaskell-                                ) --- | add a callback to an NLPSolver-makeCallback :: (Function -> IO CInt) -> IO Callback-makeCallback callback = do-  -- safely wrap the callback into the C-friendly version-  let callback' :: Ptr Function' -> IO CInt-      callback' ptrFx = do-        foreignCFun <- newForeignPtr_ ptrFx-        callback (Function foreignCFun)--  -- turn the callback into a FunPtr-  callbackFunPtr <- mkCallback callback'--  -- create the callback object-  (c_newCallbackHaskell callbackFunPtr :: IO (Ptr Callback')) >>= wrapReturn+import Casadi.GenericType ( GType, toGType ) +type HaskellCallback =+  Ptr (StdVec (Ptr DM')) -> Ptr (StdMap StdString (Ptr GenericType')) -> IO (Ptr (StdVec DM)) --- | add a callback to an NLPSolver-makeCustomEvaluate :: (CustomFunction -> IO ()) -> IO CustomEvaluate-makeCustomEvaluate callback = do-  -- safely wrap the callback into the C-friendly version-  let callback' :: Ptr CustomFunction' -> IO ()-      callback' ptrFx = do-        foreignCFun <- newForeignPtr_ ptrFx-        callback (CustomFunction foreignCFun)+foreign import ccall "wrapper" mkCallback+  :: HaskellCallback -> IO (FunPtr HaskellCallback) -  -- turn the callback into a FunPtr-  callbackFunPtr <- mkCustomEvaluate callback'+foreign import ccall safe "new_callback_haskell" c_newCallbackHaskell+  :: FunPtr HaskellCallback+     -> Ptr (StdVec (Ptr Sparsity')) -> Ptr (StdVec (Ptr Sparsity'))+     -> IO (Ptr Function') -  -- create the callback object-  (c_newCustomEvaluateHaskell callbackFunPtr :: IO (Ptr CustomEvaluate')) >>= wrapReturn+foreign import ccall safe "to_dm_vec" c_toDmVec+  :: Ptr (StdVec (Ptr DM')) -> IO (Ptr (StdVec DM))   -- | add a callback to an NLPSolver-makeDerivativeGenerator :: (Function -> Int -> IO Function) -> IO DerivativeGenerator-makeDerivativeGenerator callback = do+makeCallback :: Vector Sparsity -> Vector Sparsity+             -> (Vector DM -> Map String GType -> IO (Vector DM)) -> IO Function+makeCallback sp_in sp_out userCallback = do   -- safely wrap the callback into the C-friendly version-  let callback' :: Ptr Function' -> CInt -> IO (Ptr Function')-      callback' ptrFx nder = do-        foreignCFun <- newForeignPtr_ ptrFx-        Function fun <- callback (Function foreignCFun) (fromIntegral nder)-        return (unsafeForeignPtrToPtr fun)+  let lowlevelCallback :: HaskellCallback+      lowlevelCallback dmInPtrs statsInPtrs = do+        dmIns <- wrapReturn dmInPtrs :: IO (Vector DM)+        stats0 <- wrapReturn statsInPtrs :: IO (Map String GenericType)+        stats <- T.mapM toGType stats0+        dmOuts <- userCallback dmIns stats :: IO (Vector DM)+        withMarshal dmOuts c_toDmVec    -- turn the callback into a FunPtr-  callbackFunPtr <- mkDerivativeGenerator callback'+  callbackFunPtr <- mkCallback lowlevelCallback :: IO (FunPtr HaskellCallback)    -- create the callback object-  (c_newDerivativeGeneratorHaskell callbackFunPtr :: IO (Ptr DerivativeGenerator')) >>= wrapReturn+  withMarshal sp_in $ \sp_in' ->+    withMarshal sp_out $ \sp_out' ->+    c_newCallbackHaskell callbackFunPtr sp_in' sp_out' >>= wrapReturn
+ src/Casadi/DM.hs view
@@ -0,0 +1,233 @@+{-# OPTIONS_GHC -Wall -fno-cse -fno-warn-orphans #-}++module Casadi.DM+       ( DM+       , dsparsify+       , dnonzeros+       ) where++import qualified Data.Vector as V+import System.IO.Unsafe ( unsafePerformIO )+import Linear.Conjugate ( Conjugate(..) )+import qualified Data.Serialize as S+import qualified Data.Binary as B+import Data.Vector.Binary () -- instances++import Casadi.Core.Classes.DM+import Casadi.Core.Classes.Sparsity ( Sparsity )+import qualified Casadi.Core.Tools as C++import Casadi.Overloading ( Fmod(..), ArcTan2(..), SymOrd(..), Erf(..) )+import Casadi.CMatrix ( CMatrix(..) )+import Casadi.Viewable ( Viewable(..) )++getWith :: Monad m => m Sparsity -> m (V.Vector Double) -> m DM+getWith get getVector = do+  sp <- get+  data' <- getVector+  return (fromSparseData sp data')+putWith :: Monad m => (Sparsity -> m ()) -> (V.Vector Double -> m ()) -> DM -> m ()+putWith put putVector x = do+  put (sparsity x)+  putVector (dnonzeros x)++-- Data.Vector.Cereal looks deprecated, it's not in master anymore+instance S.Serialize DM where+  put = putWith S.put (S.put . V.toList)+  get = getWith S.get (fmap V.fromList S.get)+instance B.Binary DM where+  put = putWith B.put B.put+  get = getWith B.get B.get++instance Conjugate DM where+  conjugate = id++instance Viewable DM where+  vvertcat = vertcat+  vvertsplit = vertsplit+  vsize1 = size1+  vsize2 = size2+  vrecoverDimension _ dim = zeros dim++fromSparseData :: Sparsity -> V.Vector Double -> DM+fromSparseData s d = unsafePerformIO (dm__6 s (fromDVector d))+{-# NOINLINE fromSparseData #-}++dsparsify :: DM -> DM+dsparsify x = unsafePerformIO (C.casadi_sparsify__2 x)+{-# NOINLINE dsparsify #-}++dnonzeros :: DM -> V.Vector Double+dnonzeros x = unsafePerformIO (dm_get_nonzeros x)+{-# NOINLINE dnonzeros #-}++instance Show DM where+  show x = unsafePerformIO (dm_getDescription x)+  {-# NOINLINE show #-}++instance Eq DM where+  x == y = unsafePerformIO (C.casadi_is_equal__4 x y)+  {-# NOINLINE (==) #-}++instance CMatrix DM where+  blocksplit x ix iy = unsafePerformIO (C.casadi_blocksplit__7 x ix iy)+  {-# NOINLINE blocksplit #-}+  blockcat x = unsafePerformIO (C.casadi_blockcat__3 x)+  {-# NOINLINE blockcat #-}+  veccat x = unsafePerformIO (C.casadi_veccat__1 x)+  {-# NOINLINE veccat #-}+  ----  vertsplit = vertslice+  vertsplit x ks = unsafePerformIO (C.casadi_vertsplit__5 x ks)+  {-# NOINLINE vertsplit #-}+  vertcat x = unsafePerformIO (C.casadi_vertcat__1 x)+  {-# NOINLINE vertcat #-}+  --  horzsplit = horzslice+  horzsplit x ks = unsafePerformIO (C.casadi_horzsplit__5 x ks)+  {-# NOINLINE horzsplit #-}+  horzcat x = unsafePerformIO (C.casadi_horzcat__1 x)+  {-# NOINLINE horzcat #-}+  size1 x = unsafePerformIO (dm_size1 x)+  {-# NOINLINE size1 #-}+  size2 x = unsafePerformIO (dm_size2 x)+  {-# NOINLINE size2 #-}+  numel x = unsafePerformIO (dm_numel__1 x)+  {-# NOINLINE numel #-}+  mm x y = unsafePerformIO (C.casadi_mtimes__3 x y)+  {-# NOINLINE mm #-}+  dot x y = unsafePerformIO (C.casadi_dot__1 x y)+  {-# NOINLINE dot #-}+  sum1 x = unsafePerformIO (C.casadi_sum1__1 x)+  {-# NOINLINE sum1 #-}+  sum2 x = unsafePerformIO (C.casadi_sum2__1 x)+  {-# NOINLINE sum2 #-}+  trans x = unsafePerformIO (dm_T x)+  {-# NOINLINE trans #-}+  diag x = unsafePerformIO (C.casadi_diag__1 x)+  {-# NOINLINE diag #-}+  eye n = unsafePerformIO (dm_eye n)+  {-# NOINLINE eye #-}+  ones (r,c) = unsafePerformIO (dm_ones__4 r c)+  {-# NOINLINE ones #-}+  zeros (r,c) = unsafePerformIO (dm_zeros__4 r c)+  {-# NOINLINE zeros #-}+  zerosSp sp = unsafePerformIO (dm_zeros__1 sp)+  {-# NOINLINE zerosSp #-}+  solve x y s m = unsafePerformIO (C.casadi_solve__4 x y s m)+  {-# NOINLINE solve #-}+  solve' x y = unsafePerformIO (C.casadi_solve__5 x y)+  {-# NOINLINE solve' #-}+  indexed m spx spy = unsafePerformIO (dm_get__3 m False spx spy)+  {-# NOINLINE indexed #-}+  sparsity x = unsafePerformIO (dm_get_sparsity x)+  {-# NOINLINE sparsity #-}+  getNZ m sp = unsafePerformIO (dm_get_nz__1 m False sp)+  {-# NOINLINE getNZ #-}+  setNZ m y s = dm_set_nz__1 m y False s+  triu x = unsafePerformIO (C.casadi_triu__2 x)+  {-# NOINLINE triu #-}+  tril x = unsafePerformIO (C.casadi_tril__2 x)+  {-# NOINLINE tril #-}+  triu2symm x = unsafePerformIO (C.casadi_triu2symm__1 x)+  {-# NOINLINE triu2symm #-}+  tril2symm x = unsafePerformIO (C.casadi_tril2symm__1 x)+  {-# NOINLINE tril2symm #-}+  copy m = dm__9 m+  densify x = unsafePerformIO (C.casadi_densify__1 x)+  {-# NOINLINE densify #-}+  fromDM = id+  fromDVector x = unsafePerformIO (dm__4 (V.singleton x) >>= dm_T)+  {-# NOINLINE fromDVector #-}+  fromDouble x = unsafePerformIO (dm__5 x)+  {-# NOINLINE fromDouble #-}+  reshape x s = unsafePerformIO (C.casadi_reshape__4 x s)+  {-# NOINLINE reshape #-}+  conditional x0 x1 x2 = unsafePerformIO (C.casadi_conditional__2 x0 x1 x2)+  {-# NOINLINE conditional #-}+  conditional' x0 x1 x2 x3 = unsafePerformIO (C.casadi_conditional__3 x0 x1 x2 x3)+  {-# NOINLINE conditional' #-}+  inv x = unsafePerformIO (C.casadi_inv__1 x)+  {-# NOINLINE inv #-}+  pinv x = unsafePerformIO (C.casadi_pinv__5 x)+  {-# NOINLINE pinv #-}+  pinv' x n o = unsafePerformIO (C.casadi_pinv__4 x n o)+  {-# NOINLINE pinv' #-}+  cmax x y = unsafePerformIO (C.casadi_max__2 x y)+  {-# NOINLINE cmax #-}+  cmin x y = unsafePerformIO (C.casadi_min__2 x y)+  {-# NOINLINE cmin #-}++instance Num DM where+  (+) x y = unsafePerformIO (C.casadi_plus__2 x y)+  {-# NOINLINE (+) #-}+  (-) x y = unsafePerformIO (C.casadi_minus__2 x y)+  {-# NOINLINE (-) #-}+  (*) x y = unsafePerformIO (C.casadi_times__2 x y)+  {-# NOINLINE (*) #-}+  fromInteger x = fromDouble (fromInteger x :: Double)+  {-# NOINLINE fromInteger #-}+  abs x = unsafePerformIO (C.casadi_abs__2 x)+  {-# NOINLINE abs #-}+  signum x = unsafePerformIO (C.casadi_sign__2 x)+  {-# NOINLINE signum #-}++instance Fractional DM where+  (/) x y = unsafePerformIO (C.casadi_rdivide__2 x y)+  {-# NOINLINE (/) #-}+  fromRational x = fromDouble (fromRational x :: Double)+  {-# NOINLINE fromRational #-}++instance Floating DM where+  pi = fromDouble (pi :: Double)+  {-# NOINLINE pi #-}+  (**) x y = unsafePerformIO (C.casadi_power__2 x y)+  {-# NOINLINE (**) #-}+  exp x   = unsafePerformIO (C.casadi_exp__2 x)+  {-# NOINLINE exp #-}+  log x   = unsafePerformIO (C.casadi_log__2 x)+  {-# NOINLINE log #-}+  sin x   = unsafePerformIO (C.casadi_sin__2 x)+  {-# NOINLINE sin #-}+  cos x   = unsafePerformIO (C.casadi_cos__2 x)+  {-# NOINLINE cos #-}+  tan x   = unsafePerformIO (C.casadi_tan__2 x)+  {-# NOINLINE tan #-}+  asin x  = unsafePerformIO (C.casadi_asin__2 x)+  {-# NOINLINE asin #-}+  atan x  = unsafePerformIO (C.casadi_atan__2 x)+  {-# NOINLINE atan #-}+  acos x  = unsafePerformIO (C.casadi_acos__2 x)+  {-# NOINLINE acos #-}+  sinh x  = unsafePerformIO (C.casadi_sinh__2 x)+  {-# NOINLINE sinh #-}+  cosh x  = unsafePerformIO (C.casadi_cosh__2 x)+  {-# NOINLINE cosh #-}+  tanh x  = unsafePerformIO (C.casadi_tanh__2 x)+  {-# NOINLINE tanh #-}+  asinh x = unsafePerformIO (C.casadi_asinh__2 x)+  {-# NOINLINE asinh #-}+  atanh x = unsafePerformIO (C.casadi_atanh__2 x)+  {-# NOINLINE atanh #-}+  acosh x = unsafePerformIO (C.casadi_acosh__2 x)+  {-# NOINLINE acosh #-}++instance Fmod DM where+  fmod x y = unsafePerformIO (C.casadi_mod__2 x y)+  {-# NOINLINE fmod #-}++instance ArcTan2 DM where+  arctan2 x y = unsafePerformIO (C.casadi_atan2__2 x y)+  {-# NOINLINE arctan2 #-}++instance SymOrd DM where+  x `leq` y = unsafePerformIO (C.casadi_le__2 x y)+  {-# NOINLINE leq #-}+  x `geq` y = unsafePerformIO (C.casadi_ge__2 x y)+  {-# NOINLINE geq #-}+  x  `eq` y = unsafePerformIO (C.casadi_eq__2 x y)+  {-# NOINLINE eq #-}++instance Erf DM where+  erf x = unsafePerformIO (C.casadi_erf__2 x)+  {-# NOINLINE erf #-}+  erfinv x = unsafePerformIO (C.casadi_erfinv__2 x)+  {-# NOINLINE erfinv #-}
− src/Casadi/DMatrix.hs 
@@ -1,231 +0,0 @@-{-# OPTIONS_GHC -Wall -fno-cse -fno-warn-orphans #-}--module Casadi.DMatrix-       ( DMatrix-       , dsparsify-       , dnonzeros-       ) where--import qualified Data.Vector as V-import System.IO.Unsafe ( unsafePerformIO )-import Linear.Conjugate ( Conjugate(..) )-import qualified Data.Serialize as S-import qualified Data.Binary as B-import Data.Vector.Binary () -- instances--import Casadi.Core.Classes.DMatrix-import Casadi.Core.Classes.Sparsity ( Sparsity )-import qualified Casadi.Core.Tools as C--import Casadi.Overloading ( Fmod(..), ArcTan2(..), SymOrd(..), Erf(..) )-import Casadi.CMatrix ( CMatrix(..) )-import Casadi.Viewable ( Viewable(..) )--getWith :: Monad m => m Sparsity -> m (V.Vector Double) -> m DMatrix-getWith get getVector = do-  sp <- get-  data' <- getVector-  return (fromSparseData sp data')-putWith :: Monad m => (Sparsity -> m ()) -> (V.Vector Double -> m ()) -> DMatrix -> m ()-putWith put putVector x = do-  put (sparsity x)-  putVector (dnonzeros x)---- Data.Vector.Cereal looks deprecated, it's not in master anymore-instance S.Serialize DMatrix where-  put = putWith S.put (S.put . V.toList)-  get = getWith S.get (fmap V.fromList S.get)-instance B.Binary DMatrix where-  put = putWith B.put B.put-  get = getWith B.get B.get--instance Conjugate DMatrix where-  conjugate = id--instance Viewable DMatrix where-  vvertcat = vertcat-  vvertsplit = vertsplit-  vsize1 = size1-  vsize2 = size2-  vrecoverDimension _ dim = zeros dim--fromSparseData :: Sparsity -> V.Vector Double -> DMatrix-fromSparseData s d = unsafePerformIO (dmatrix__4 s (fromDVector d))-{-# NOINLINE fromSparseData #-}--dsparsify :: DMatrix -> DMatrix-dsparsify x = unsafePerformIO (C.casadi_sparsify__2 x)-{-# NOINLINE dsparsify #-}--dnonzeros :: DMatrix -> V.Vector Double-dnonzeros x = unsafePerformIO (dmatrix_nonzeros x)-{-# NOINLINE dnonzeros #-}--instance Show DMatrix where-  show x = unsafePerformIO (dmatrix_getDescription x)-  {-# NOINLINE show #-}--instance Eq DMatrix where-  x == y = unsafePerformIO (C.casadi_isEqual__2 x y)-  {-# NOINLINE (==) #-}--instance CMatrix DMatrix where-  blocksplit x ix iy = unsafePerformIO (C.casadi_blocksplit__7 x ix iy)-  {-# NOINLINE blocksplit #-}-  blockcat x = unsafePerformIO (C.casadi_blockcat__3 x)-  {-# NOINLINE blockcat #-}-  veccat x = unsafePerformIO (C.casadi_veccat__1 x)-  {-# NOINLINE veccat #-}-  ----  vertsplit = vertslice-  vertsplit x ks = unsafePerformIO (C.casadi_vertsplit__5 x ks)-  {-# NOINLINE vertsplit #-}-  vertcat x = unsafePerformIO (C.casadi_vertcat__1 x)-  {-# NOINLINE vertcat #-}-  --  horzsplit = horzslice-  horzsplit x ks = unsafePerformIO (C.casadi_horzsplit__5 x ks)-  {-# NOINLINE horzsplit #-}-  horzcat x = unsafePerformIO (C.casadi_horzcat__1 x)-  {-# NOINLINE horzcat #-}-  size1 x = unsafePerformIO (dmatrix_size1 x)-  {-# NOINLINE size1 #-}-  size2 x = unsafePerformIO (dmatrix_size2 x)-  {-# NOINLINE size2 #-}-  numel x = unsafePerformIO (dmatrix_numel__1 x)-  {-# NOINLINE numel #-}-  mm x y = unsafePerformIO (C.casadi_mul__3 x y)-  {-# NOINLINE mm #-}-  innerProd x y = unsafePerformIO (C.casadi_inner_prod__1 x y)-  {-# NOINLINE innerProd #-}-  sumCols x = unsafePerformIO (C.casadi_sumCols__1 x)-  {-# NOINLINE sumCols #-}-  sumRows x = unsafePerformIO (C.casadi_sumRows__1 x)-  {-# NOINLINE sumRows #-}-  trans x = unsafePerformIO (dmatrix_T x)-  {-# NOINLINE trans #-}-  diag x = unsafePerformIO (C.casadi_diag__1 x)-  {-# NOINLINE diag #-}-  eye n = unsafePerformIO (dmatrix_eye n)-  {-# NOINLINE eye #-}-  ones (r,c) = unsafePerformIO (dmatrix_ones__4 r c)-  {-# NOINLINE ones #-}-  zeros (r,c) = unsafePerformIO (dmatrix_zeros__4 r c)-  {-# NOINLINE zeros #-}-  zerosSp sp = unsafePerformIO (dmatrix_zeros__1 sp)-  {-# NOINLINE zerosSp #-}-  solve x y s m = unsafePerformIO (C.casadi_solve__4 x y s m)-  {-# NOINLINE solve #-}-  solve' x y = unsafePerformIO (C.casadi_solve__5 x y)-  {-# NOINLINE solve' #-}-  indexed m spx spy = unsafePerformIO $ do-    ret <- allocEmpty :: IO DMatrix-    dmatrix_get__3 m ret False spx spy-    return ret-  {-# NOINLINE indexed #-}-  sparsity x = unsafePerformIO (dmatrix_getSparsity x)-  {-# NOINLINE sparsity #-}-  getNZ m sp = unsafePerformIO $ do-    ret <- allocEmpty :: IO DMatrix-    dmatrix_getNZ__1 m ret False sp-    return ret-  {-# NOINLINE getNZ #-}-  setNZ m y s = dmatrix_setNZ__1 m y False s-  triu x = unsafePerformIO (C.casadi_triu__2 x)-  {-# NOINLINE triu #-}-  tril x = unsafePerformIO (C.casadi_tril__2 x)-  {-# NOINLINE tril #-}-  triu2symm x = unsafePerformIO (C.casadi_triu2symm__1 x)-  {-# NOINLINE triu2symm #-}-  tril2symm x = unsafePerformIO (C.casadi_tril2symm__1 x)-  {-# NOINLINE tril2symm #-}-  copy m = dmatrix__7 m-  densify x = unsafePerformIO (C.casadi_densify__1 x)-  {-# NOINLINE densify #-}-  fromDMatrix = id-  fromDVector x = unsafePerformIO (dmatrix__2 (V.singleton x) >>= dmatrix_T)-  {-# NOINLINE fromDVector #-}-  fromDouble x = unsafePerformIO (dmatrix__3 x)-  {-# NOINLINE fromDouble #-}-  allocEmpty = dmatrix__8-  reshape x s = unsafePerformIO (C.casadi_reshape__4 x s)-  {-# NOINLINE reshape #-}-  conditional x0 x1 x2 = unsafePerformIO (C.casadi_conditional__2 x0 x1 x2)-  {-# NOINLINE conditional #-}-  conditional' x0 x1 x2 x3 = unsafePerformIO (C.casadi_conditional__3 x0 x1 x2 x3)-  {-# NOINLINE conditional' #-}---instance Num DMatrix where-  (+) x y = unsafePerformIO (C.casadi_plus__1 x y)-  {-# NOINLINE (+) #-}-  (-) x y = unsafePerformIO (C.casadi_minus__1 x y)-  {-# NOINLINE (-) #-}-  (*) x y = unsafePerformIO (C.casadi_times__1 x y)-  {-# NOINLINE (*) #-}-  fromInteger x = fromDouble (fromInteger x :: Double)-  {-# NOINLINE fromInteger #-}-  abs x = unsafePerformIO (C.casadi_abs__1 x)-  {-# NOINLINE abs #-}-  signum x = unsafePerformIO (C.casadi_sign__1 x)-  {-# NOINLINE signum #-}--instance Fractional DMatrix where-  (/) x y = unsafePerformIO (C.casadi_rdivide__1 x y)-  {-# NOINLINE (/) #-}-  fromRational x = fromDouble (fromRational x :: Double)-  {-# NOINLINE fromRational #-}--instance Floating DMatrix where-  pi = fromDouble (pi :: Double)-  {-# NOINLINE pi #-}-  (**) x y = unsafePerformIO (C.casadi_power__1 x y)-  {-# NOINLINE (**) #-}-  exp x   = unsafePerformIO (C.casadi_exp__1 x)-  {-# NOINLINE exp #-}-  log x   = unsafePerformIO (C.casadi_log__1 x)-  {-# NOINLINE log #-}-  sin x   = unsafePerformIO (C.casadi_sin__1 x)-  {-# NOINLINE sin #-}-  cos x   = unsafePerformIO (C.casadi_cos__1 x)-  {-# NOINLINE cos #-}-  tan x   = unsafePerformIO (C.casadi_tan__1 x)-  {-# NOINLINE tan #-}-  asin x  = unsafePerformIO (C.casadi_asin__1 x)-  {-# NOINLINE asin #-}-  atan x  = unsafePerformIO (C.casadi_atan__1 x)-  {-# NOINLINE atan #-}-  acos x  = unsafePerformIO (C.casadi_acos__1 x)-  {-# NOINLINE acos #-}-  sinh x  = unsafePerformIO (C.casadi_sinh__1 x)-  {-# NOINLINE sinh #-}-  cosh x  = unsafePerformIO (C.casadi_cosh__1 x)-  {-# NOINLINE cosh #-}-  tanh x  = unsafePerformIO (C.casadi_tanh__1 x)-  {-# NOINLINE tanh #-}-  asinh x = unsafePerformIO (C.casadi_asinh__1 x)-  {-# NOINLINE asinh #-}-  atanh x = unsafePerformIO (C.casadi_atanh__1 x)-  {-# NOINLINE atanh #-}-  acosh x = unsafePerformIO (C.casadi_acosh__1 x)-  {-# NOINLINE acosh #-}--instance Fmod DMatrix where-  fmod x y = unsafePerformIO (C.casadi_mod__1 x y)-  {-# NOINLINE fmod #-}--instance ArcTan2 DMatrix where-  arctan2 x y = unsafePerformIO (C.casadi_atan2__1 x y)-  {-# NOINLINE arctan2 #-}--instance SymOrd DMatrix where-  x `leq` y = unsafePerformIO (C.casadi_le__1 x y)-  {-# NOINLINE leq #-}-  x `geq` y = unsafePerformIO (C.casadi_ge__1 x y)-  {-# NOINLINE geq #-}-  x  `eq` y = unsafePerformIO (C.casadi_eq__1 x y)-  {-# NOINLINE eq #-}--instance Erf DMatrix where-  erf x = unsafePerformIO (C.casadi_erf__1 x)-  {-# NOINLINE erf #-}-  erfinv x = unsafePerformIO (C.casadi_erfinv__1 x)-  {-# NOINLINE erfinv #-}
src/Casadi/Function.hs view
@@ -2,9 +2,11 @@  module Casadi.Function        ( C.Function, AlwaysInline(..), NeverInline(..)-       , callMX, callMX', callSX, callSX', evalDMatrix, evalDMatrix'+       , mxFunction, mxFunction', sxFunction, sxFunction'+       , callMX, callMX', callSX, callSX', callDM, callDM'        , jacobian, gradient, derivative-       , generateCode, externalFunction, externalFunction'+       , externalFunction, externalFunction'+       , generateCode, generateCode'        ) where  import Data.Map ( Map )@@ -12,56 +14,46 @@ import Data.Vector ( Vector ) import System.IO.Unsafe ( unsafePerformIO ) -import qualified Casadi.Core.Classes.Function as C-import qualified Casadi.Core.Classes.ExternalFunction as C import qualified Casadi.Core.Classes.CodeGenerator as C---import qualified Casadi.Core.CustomWrappers as C+import qualified Casadi.Core.Classes.Function as C+import qualified Casadi.Core.Tools as C  import Casadi.SX ( SX ) import Casadi.MX ( MX )-import Casadi.DMatrix ( DMatrix )-import Casadi.GenericC ( GenericC ( mkGeneric ), Opt, GenericType )-import Casadi.SharedObject ( castSharedObject )+import Casadi.DM ( DM )+import Casadi.GenericType ( GenericType, GType, fromGType )  newtype AlwaysInline = AlwaysInline Bool newtype NeverInline = NeverInline Bool -instance Show C.Function where-  show x = show (castSharedObject x)-  {-# NOINLINE show #-}- -- | call an MXFunction on symbolic inputs, getting symbolic outputs-callMX :: C.FunctionClass f => f -> Vector MX -> AlwaysInline -> NeverInline -> Vector MX+callMX :: C.Function -> Vector MX -> AlwaysInline -> NeverInline -> Vector MX callMX f ins (AlwaysInline alwaysInline) (NeverInline neverInline) =-  unsafePerformIO (C.function_operator_call__11 f ins alwaysInline neverInline)-{-# NOINLINE callMX #-}+  unsafePerformIO $ C.function_call__11 f ins alwaysInline neverInline  -- | call an MXFunction on symbolic inputs, getting symbolic outputs-callMX' :: C.FunctionClass f => f -> Map String MX -> AlwaysInline -> NeverInline -> Map String MX+callMX' :: C.Function -> Map String MX -> AlwaysInline -> NeverInline -> Map String MX callMX' f ins (AlwaysInline alwaysInline) (NeverInline neverInline) =-  unsafePerformIO (C.function_operator_call__2 f ins alwaysInline neverInline)-{-# NOINLINE callMX' #-}+  unsafePerformIO $ C.function_call__2 f ins alwaysInline neverInline  -- | call an SXFunction on symbolic inputs, getting symbolic outputs-callSX :: C.FunctionClass f => f -> Vector SX -> AlwaysInline -> NeverInline -> Vector SX+callSX :: C.Function -> Vector SX -> AlwaysInline -> NeverInline -> Vector SX callSX f ins (AlwaysInline alwaysInline) (NeverInline neverInline) =-  unsafePerformIO (C.function_operator_call__14 f ins alwaysInline neverInline)-{-# NOINLINE callSX #-}+  unsafePerformIO $ C.function_call__14 f ins alwaysInline neverInline  -- | call an SXFunction on symbolic inputs, getting symbolic outputs-callSX' :: C.FunctionClass f => f -> Map String SX -> AlwaysInline -> NeverInline -> Map String SX+callSX' :: C.Function -> Map String SX -> AlwaysInline -> NeverInline -> Map String SX callSX' f ins (AlwaysInline alwaysInline) (NeverInline neverInline) =-  unsafePerformIO (C.function_operator_call__5 f ins alwaysInline neverInline)-{-# NOINLINE callSX' #-}+  unsafePerformIO $ C.function_call__5 f ins alwaysInline neverInline +-- TODO(greg): expose the thread safe way -- | evaluate a Function with many inputs, many outputs-evalDMatrix :: C.FunctionClass f => f -> Vector DMatrix -> IO (Vector DMatrix)-evalDMatrix = C.function_operator_call__15+callDM :: C.Function -> Vector DM -> IO (Vector DM)+callDM f ins = C.function_call__15 f ins  -- | evaluate a Function with many inputs, many outputs-evalDMatrix' :: C.FunctionClass f =>-                f -> Map String DMatrix -> IO (Map String DMatrix)-evalDMatrix' = C.function_operator_call__6+callDM' :: C.FunctionClass f => f -> Map String DM -> IO (Map String DM)+callDM' f ins = C.function_call__6 f ins  jacobian :: C.FunctionClass a => a -> Int -> Int -> Bool -> Bool -> IO C.Function jacobian = C.function_jacobian__14@@ -70,19 +62,60 @@ gradient = C.function_gradient__6  derivative :: C.FunctionClass a => a -> Int -> Int -> IO C.Function-derivative = C.function_derivative+derivative = C.function_derivative__0 -generateCode :: C.FunctionClass a => a -> Map String Opt -> String-generateCode f opts0 = unsafePerformIO $ do-  opts <- T.mapM mkGeneric opts0 :: IO (Map String GenericType)+generateCode :: C.FunctionClass a => a -> String -> Map String GType -> IO ()+generateCode f n opts0 = do+  opts <- T.mapM fromGType opts0 :: IO (Map String GenericType)+  C.function_generate__3 (C.castFunction f) n opts++generateCode' :: C.FunctionClass a => a -> Map String GType -> IO String+generateCode' f opts0 = do+  opts <- T.mapM fromGType opts0 :: IO (Map String GenericType)   cg <- C.codeGenerator__1 opts-  C.codeGenerator_add__1 cg (C.castFunction f)+  C.codeGenerator_add cg (C.castFunction f)   C.codeGenerator_generate__0 cg-{-# NOINLINE generateCode #-}  externalFunction :: String -> Map String GenericType -> IO C.Function-externalFunction name opts = fmap C.castFunction $ C.externalFunction__5 name opts+externalFunction name opts = C.external__5 name opts  externalFunction' :: String -> String -> Map String GenericType -> IO C.Function externalFunction' name binName opts =-  fmap C.castFunction $ C.externalFunction__3 name binName opts+  fmap C.castFunction $ C.external__3 name binName opts++sxFunction :: String -> Vector SX -> Vector SX -> Map String GType+              -> IO C.Function+sxFunction n x y opts0 = do+  opts <- T.mapM fromGType opts0 :: IO (Map String GenericType)+  C.function__11 n x y opts++sxFunction' ::+  String -> (Vector SX, Vector String) -> (Vector SX, Vector String)+  -> Map String GType+  -> IO C.Function+sxFunction' n (x,nx) (y,ny) opts0 = do+  opts <- T.mapM fromGType opts0 :: IO (Map String GenericType)+  C.function__9 n x y nx ny opts++--sxFunctionFromFunction :: C.Function -> IO C.SXFunction+--sxFunctionFromFunction = C.sxFunction__8++--sxFunctionFromMXFunction :: C.MXFunction -> IO C.SXFunction+--sxFunctionFromMXFunction = C.sxFunction__9++mxFunction :: String -> Vector MX -> Vector MX -> Map String GType+              -> IO C.Function+mxFunction n x y opts0 = do+  opts <- T.mapM fromGType opts0 :: IO (Map String GenericType)+  C.function__5 n x y opts++mxFunction' ::+  String -> (Vector MX, Vector String) -> (Vector MX, Vector String)+  -> Map String GType+  -> IO C.Function+mxFunction' n (x,nx) (y,ny) opts0 = do+  opts <- T.mapM fromGType opts0 :: IO (Map String GenericType)+  C.function__3 n x y nx ny opts++--mxFunctionFromFunction :: C.Function -> IO C.MXFunction+--mxFunctionFromFunction = C.mxFunction__8
− src/Casadi/GenericC.hs 
@@ -1,91 +0,0 @@-{-# OPTIONS_GHC -Wall -fno-warn-orphans -fno-cse #-}-{-# Language GADTs #-}-{-# Language FlexibleInstances #-}-{-# Language ScopedTypeVariables #-}---- todo(greg): merge this with Casadi.Option-module Casadi.GenericC-       ( GenericC(..)-       , GenericType-       , Opt(..)-       , getDescription-       ) where--import qualified Data.Traversable as T-import Data.Vector ( Vector )-import Data.Map ( Map )-import System.IO.Unsafe ( unsafePerformIO )--import Casadi.Core.Classes.Function ( Function )-import Casadi.Core.Classes.GenericType-import Casadi.Core.Classes.DerivativeGenerator ( DerivativeGenerator )--import Casadi.SharedObject ( castSharedObject )--instance Show GenericType where-  show x = show (castSharedObject x)-  {-# NOINLINE show #-}--class GenericC a where-  mkGeneric :: a -> IO GenericType-  fromGeneric :: GenericType -> IO (Maybe a)--data Opt where-  Opt :: GenericC a => a -> Opt-instance Show Opt where-  show (Opt x) = show (unsafePerformIO (mkGeneric x))--getDescription :: GenericType -> IO String-getDescription = genericType_get_description--instance GenericC Bool where-  mkGeneric = genericType__12-  fromGeneric = ifThenGet genericType_isBool genericType_toBool-instance GenericC Int where-  mkGeneric = genericType__11-  fromGeneric = ifThenGet genericType_isInt genericType_toInt-instance GenericC Double where-  mkGeneric = genericType__10-  fromGeneric = ifThenGet genericType_isDouble genericType_toDouble-instance GenericC String where-  mkGeneric = genericType__9-  fromGeneric = ifThenGet genericType_isString genericType_toString-instance GenericC (Vector Bool) where-  mkGeneric = genericType__8-  fromGeneric = const (return Nothing)-instance GenericC (Vector Int) where-  mkGeneric = genericType__7-  fromGeneric = ifThenGet genericType_isIntVector genericType_toIntVector-instance GenericC (Vector Double) where-  mkGeneric = genericType__5-  fromGeneric = ifThenGet genericType_isDoubleVector genericType_toDoubleVector-instance GenericC (Vector String) where-  mkGeneric = genericType__4-  fromGeneric = ifThenGet genericType_isStringVector genericType_toStringVector-instance GenericC GenericType where-  mkGeneric = return-  fromGeneric = return . Just-instance GenericC Function where-  mkGeneric = genericType__3-  fromGeneric = ifThenGet genericType_isFunction genericType_toFunction-instance GenericC DerivativeGenerator where-  mkGeneric = genericType__2-  fromGeneric = const $ return $ error "no fromGeneric for DerivativeGenerator"-instance GenericC Opt where-  mkGeneric (Opt o) = mkGeneric o-  fromGeneric = const $ return $ error "no fromGeneric for Opt"-instance GenericC a => GenericC (Map String a) where-  mkGeneric dict = T.mapM mkGeneric dict >>= genericType__0-  fromGeneric gdict = do-    mDict <- ifThenGet genericType_isDict genericType_toDict gdict-    case mDict of-     Nothing -> return Nothing-     Just dict -> do-       T.sequenceA <$> T.mapM fromGeneric dict--ifThenGet :: (a -> IO Bool) -> (a -> IO b) -> a -> IO (Maybe b)-ifThenGet isOpt getOpt g = do-  isopt <- isOpt g-  if isopt-    then fmap Just (getOpt g)-    else return Nothing
+ src/Casadi/GenericType.hs view
@@ -0,0 +1,140 @@+{-# OPTIONS_GHC -Wall -fno-warn-orphans -fno-cse #-}+{-# Language GADTs #-}+{-# Language FlexibleInstances #-}+{-# Language ScopedTypeVariables #-}++-- todo(greg): merge this with Casadi.GenericC+module Casadi.GenericType+       ( GenericType+       , TypeID(..)+       , GType(..)+       , fromGType, toGType, toGType'+       , getDescription+       , getType+       ) where++import qualified Data.Traversable as T+import Data.Vector ( Vector )+import Data.Map ( Map )+import qualified Data.Map as M++import Casadi.Core.Classes.Function ( Function )+import Casadi.Core.Classes.GenericType+import Casadi.Core.Enums ( TypeID(..) )++import Casadi.SharedObject ( castSharedObject )++instance Show Function where+  show x = show (castSharedObject x)+  {-# NOINLINE show #-}++instance Show GenericType where+  show x = show (castSharedObject x)+  {-# NOINLINE show #-}++getDescription :: GenericType -> IO String+getDescription = genericType_get_description++getType :: GenericType -> IO TypeID+getType = genericType_getType+++-- | Haskell version of Casadi.GenericType+data GType+  = GBool Bool+  | GDouble Double+  | GInt Int+  | GString String+  | GBoolVec (Vector Bool)+  | GDoubleVec (Vector Double)+  | GIntVec (Vector Int)+  | GIntVecVec (Vector (Vector Int))+  | GStringVec (Vector String)+--  | GGenericType GenericType+  | GFunction Function+  | GDict (Map String GType)+  deriving Show++instance Eq GType where+  (==) (GFunction _) _ = error "can't compare GFunctions"+  (==) _ (GFunction _) = error "can't compare GFunctions"+  (==) (GBool x) (GBool y) = x == y+  (==) (GBool _) _ = False+  (==) (GDouble x) (GDouble y)+    = x == y || all isNaN [x, y]+  (==) (GDouble _) _ = False+  (==) (GInt x) (GInt y) = x == y+  (==) (GInt _) _ = False+  (==) (GString x) (GString y) = x == y+  (==) (GString _) _ = False+  (==) (GBoolVec x) (GBoolVec y) = x == y+  (==) (GBoolVec _) _ = False+  (==) (GDoubleVec x) (GDoubleVec y) = x == y+  (==) (GDoubleVec _) _ = False+  (==) (GIntVec x) (GIntVec y) = x == y+  (==) (GIntVec _) _ = False+  (==) (GIntVecVec x) (GIntVecVec y) = x == y+  (==) (GIntVecVec _) _ = False+  (==) (GStringVec x) (GStringVec y) = x == y+  (==) (GStringVec _) _ = False+  (==) (GDict x) (GDict y) = f (M.toList x) (M.toList y)+    where+      f ((nx,gx):xs) ((ny,gy):ys)+        | nx /= ny = False+        | not ((==) gx gy) = False+        | otherwise = f xs ys+      f [] [] = True+      f _ _ = False+  (==) (GDict _) _ = False++fromGType :: GType -> IO GenericType+fromGType (GBool r) = genericType__10 r+fromGType (GDouble r) = genericType__8 r+fromGType (GInt r) = genericType__9 r+fromGType (GString r) = genericType__7 r+fromGType (GBoolVec r) = do+  gt <- genericType__6 r+  gtype <- getType gt+  case gtype of+    OT_BOOLVECTOR -> error "fromGType GBoolVec got OT_BOOLVECTOR, which means a casadi issue was fixed and this special casing code should be removed"+    OT_INTVECTOR -> return gt+    other -> error $ "fromGType GBoolVec got " ++ show other ++ ", which is really weird"+fromGType (GDoubleVec r) = genericType__3 r+fromGType (GIntVec r) = genericType__5 r+fromGType (GIntVecVec r) = genericType__4 r+fromGType (GStringVec r) = genericType__2 r+fromGType (GFunction r) = genericType__1 r+fromGType (GDict r) = T.mapM fromGType r >>= genericType__0++toGType :: GenericType -> IO GType+toGType gt = do+  ego <- toGType' gt+  case ego of+    Left err -> error err+    Right r -> return r++toGType' :: GenericType -> IO (Either String GType)+toGType' gt = do+  typeID <- getType gt+  description <- getDescription gt++  let unhandledTypeMsg = "unhandled GenericType " ++ show description ++ " (" ++ show typeID ++ ")"++  case typeID of+    OT_BOOL -> Right . GBool <$> genericType_to_bool gt+    OT_BOOLVECTOR -> Right . GBoolVec <$> genericType_to_bool_vector gt+    OT_DICT -> do+      dict0 <- genericType_to_dict gt :: IO (M.Map String GenericType)+      dict1 <- T.mapM toGType' dict0 :: IO (M.Map String (Either String GType))+      return (fmap GDict (sequenceA dict1))+    OT_DOUBLE -> Right . GDouble <$> genericType_to_double gt+    OT_DOUBLEVECTOR -> Right . GDoubleVec <$> genericType_to_double_vector gt+    OT_FUNCTION -> Right . GFunction <$> genericType_to_function gt+    OT_INT -> Right . GInt <$> genericType_to_int gt+    OT_INTVECTOR -> Right . GIntVec <$> genericType_to_int_vector gt+    OT_INTVECTORVECTOR -> Right . GIntVecVec <$> genericType_to_int_vector_vector gt+    OT_STRING -> Right . GString <$> genericType_to_string gt+    OT_STRINGVECTOR -> Right . GStringVec <$> genericType_to_string_vector gt+    OT_NULL -> return $ Left unhandledTypeMsg+    OT_UNKNOWN -> return $ Left unhandledTypeMsg+    OT_VOIDPTR -> return $ Left unhandledTypeMsg
− src/Casadi/IOScheme.hs 
@@ -1,67 +0,0 @@-{-# OPTIONS_GHC -Wall #-}-{-# LANGUAGE ScopedTypeVariables #-}--module Casadi.IOScheme-       ( InputOutputScheme(..)-       , mxFunctionWithSchemes-       , sxFunctionWithSchemes-       ) where--import Control.Monad ( unless )-import qualified Data.Map as M-import qualified Data.Set as S-import Data.Vector ( Vector )-import qualified Data.Vector as V-import Text.Printf ( printf )--import Casadi.Core.Classes.SXFunction-import Casadi.Core.Classes.MXFunction-import Casadi.Core.Enums ( InputOutputScheme(..) )-import qualified Casadi.Core.Tools as C--import Casadi.MX ( MX )-import Casadi.MXFunction ( mxFunction' )-import Casadi.Option ( Opt )-import Casadi.SX ( SX )-import Casadi.SXFunction ( sxFunction' )--mxFunctionWithSchemes ::-  String-  -> (InputOutputScheme, M.Map String MX)-  -> (InputOutputScheme, M.Map String MX)-  -> M.Map String Opt-  -> IO MXFunction-mxFunctionWithSchemes name (inputScheme, inputs) (outputScheme, outputs) opts = do-  input' <- schemeToMapVec inputScheme inputs-  output' <- schemeToMapVec outputScheme outputs-  mxFunction' name input' output' opts--sxFunctionWithSchemes ::-  String-  -> (InputOutputScheme, M.Map String SX)-  -> (InputOutputScheme, M.Map String SX)-  -> M.Map String Opt-  -> IO SXFunction-sxFunctionWithSchemes name (inputScheme, inputs) (outputScheme, outputs) opts = do-  input' <- schemeToMapVec inputScheme inputs-  output' <- schemeToMapVec outputScheme outputs-  sxFunction' name input' output' opts--schemeToMapVec ::-  forall a-  . Num a-  => InputOutputScheme -> M.Map String a -> IO (M.Map String a, Vector String)-schemeToMapVec scheme symMap = do-  len <- C.getSchemeSize scheme-  let indices = take len [0..]-  -  indicesNames <- mapM (C.getSchemeEntryName scheme) indices :: IO [String]--  let namesSet = S.fromList indicesNames-      extraEntries = M.keysSet symMap S.\\ namesSet--  _ <- unless (S.null extraEntries) $ error $ printf-    "scheme %s has entries %s, but you gave keys %s\n"-    (show scheme) (show namesSet) (show extraEntries)--  return (symMap, V.fromList indicesNames)
src/Casadi/MX.hs view
@@ -15,7 +15,7 @@  import Casadi.Overloading ( Fmod(..), ArcTan2(..), SymOrd(..), Erf(..) ) import Casadi.CMatrix ( CMatrix(..) )-import Casadi.DMatrix ()+import Casadi.DM () import Casadi.Viewable ( Viewable(..) ) import Casadi.SharedObject ( castSharedObject ) @@ -23,7 +23,7 @@   conjugate = id  instance Eq MX where-  x == y = unsafePerformIO (C.casadi_isEqual__6 x y)+  x == y = unsafePerformIO (C.casadi_is_equal__8 x y)   {-# NOINLINE (==) #-}  instance Show MX where@@ -92,14 +92,14 @@   {-# NOINLINE size2 #-}   numel x = unsafePerformIO (mx_numel__1 x)   {-# NOINLINE numel #-}-  mm x y = unsafePerformIO (C.casadi_mul__7 x y)+  mm x y = unsafePerformIO (C.casadi_mtimes__7 x y)   {-# NOINLINE mm #-}-  innerProd x y = unsafePerformIO (C.casadi_inner_prod__3 x y)-  {-# NOINLINE innerProd #-}-  sumCols x = unsafePerformIO (C.casadi_sumCols__3 x)-  {-# NOINLINE sumCols #-}-  sumRows x = unsafePerformIO (C.casadi_sumRows__3 x)-  {-# NOINLINE sumRows #-}+  dot x y = unsafePerformIO (C.casadi_dot__3 x y)+  {-# NOINLINE dot #-}+  sum1 x = unsafePerformIO (C.casadi_sum1__3 x)+  {-# NOINLINE sum1 #-}+  sum2 x = unsafePerformIO (C.casadi_sum2__3 x)+  {-# NOINLINE sum2 #-}   trans x = unsafePerformIO (mx_T x)   {-# NOINLINE trans #-}   diag x = unsafePerformIO (C.casadi_diag__3 x)@@ -116,19 +116,13 @@   {-# NOINLINE solve #-}   solve' x y = unsafePerformIO (C.casadi_solve__11 x y)   {-# NOINLINE solve' #-}-  indexed m spx spy = unsafePerformIO $ do-    ret <- allocEmpty :: IO MX-    mx_get__3 m ret False spx spy-    return ret+  indexed m spx spy = unsafePerformIO (mx_get__3 m False spx spy)   {-# NOINLINE indexed #-}-  sparsity x = unsafePerformIO (mx_getSparsity x)+  sparsity x = unsafePerformIO (mx_get_sparsity x)   {-# NOINLINE sparsity #-}-  getNZ m sp = unsafePerformIO $ do-    ret <- allocEmpty :: IO MX-    mx_getNZ__1 m ret False sp-    return ret+  getNZ m sp = unsafePerformIO (mx_get_nz__1 m False sp)   {-# NOINLINE getNZ #-}-  setNZ m y s = mx_setNZ__1 m y False s+  setNZ m y s = mx_set_nz__1 m y False s   triu x = unsafePerformIO (C.casadi_triu__6 x)   {-# NOINLINE triu #-}   tril x = unsafePerformIO (C.casadi_tril__6 x)@@ -140,37 +134,46 @@   copy m = mx__2 m   densify x = unsafePerformIO (C.casadi_densify__3 x)   {-# NOINLINE densify #-}-  fromDMatrix x = unsafePerformIO (mx__0 x)-  {-# NOINLINE fromDMatrix #-}-  fromDVector x = fromDMatrix (fromDVector x)+  fromDM x = unsafePerformIO (mx__0 x)+  {-# NOINLINE fromDM #-}+  fromDVector x = fromDM (fromDVector x)   {-# NOINLINE fromDVector #-}   fromDouble x = unsafePerformIO (mx__3 x)   {-# NOINLINE fromDouble #-}-  allocEmpty = mx__7   reshape x s = unsafePerformIO (C.casadi_reshape__10 x s)   {-# NOINLINE reshape #-}   conditional x0 x1 x2 = unsafePerformIO (C.casadi_conditional__6 x0 x1 x2)   {-# NOINLINE conditional #-}   conditional' x0 x1 x2 x3 = unsafePerformIO (C.casadi_conditional__7 x0 x1 x2 x3)   {-# NOINLINE conditional' #-}+  inv x = unsafePerformIO (C.casadi_inv__3 x)+  {-# NOINLINE inv #-}+  pinv x = unsafePerformIO (C.casadi_pinv__11 x)+  {-# NOINLINE pinv #-}+  pinv' x n o = unsafePerformIO (C.casadi_pinv__10 x n o)+  {-# NOINLINE pinv' #-}+  cmax x y = unsafePerformIO (C.casadi_max__4 x y)+  {-# NOINLINE cmax #-}+  cmin x y = unsafePerformIO (C.casadi_min__4 x y)+  {-# NOINLINE cmin #-}   instance Num MX where-  (+) x y = unsafePerformIO (C.casadi_plus__3 x y)+  (+) x y = unsafePerformIO (C.casadi_plus__4 x y)   {-# NOINLINE (+) #-}-  (-) x y = unsafePerformIO (C.casadi_minus__3 x y)+  (-) x y = unsafePerformIO (C.casadi_minus__4 x y)   {-# NOINLINE (-) #-}-  (*) x y = unsafePerformIO (C.casadi_times__3 x y)+  (*) x y = unsafePerformIO (C.casadi_times__4 x y)   {-# NOINLINE (*) #-}   fromInteger x = fromDouble (fromInteger x :: Double)   {-# NOINLINE fromInteger #-}-  abs x = unsafePerformIO (C.casadi_abs__3 x)+  abs x = unsafePerformIO (C.casadi_abs__4 x)   {-# NOINLINE abs #-}-  signum x = unsafePerformIO (C.casadi_sign__3 x)+  signum x = unsafePerformIO (C.casadi_sign__4 x)   {-# NOINLINE signum #-}  instance Fractional MX where-  (/) x y = unsafePerformIO (C.casadi_rdivide__3 x y)+  (/) x y = unsafePerformIO (C.casadi_rdivide__4 x y)   {-# NOINLINE (/) #-}   fromRational x = fromDouble (fromRational x :: Double)   {-# NOINLINE fromRational #-}@@ -178,55 +181,55 @@ instance Floating MX where   pi = fromDouble (pi :: Double)   {-# NOINLINE pi #-}-  (**) x y = unsafePerformIO (C.casadi_power__3 x y)+  (**) x y = unsafePerformIO (C.casadi_power__4 x y)   {-# NOINLINE (**) #-}-  exp x   = unsafePerformIO (C.casadi_exp__3 x)+  exp x   = unsafePerformIO (C.casadi_exp__4 x)   {-# NOINLINE exp #-}-  log x   = unsafePerformIO (C.casadi_log__3 x)+  log x   = unsafePerformIO (C.casadi_log__4 x)   {-# NOINLINE log #-}-  sin x   = unsafePerformIO (C.casadi_sin__3 x)+  sin x   = unsafePerformIO (C.casadi_sin__4 x)   {-# NOINLINE sin #-}-  cos x   = unsafePerformIO (C.casadi_cos__3 x)+  cos x   = unsafePerformIO (C.casadi_cos__4 x)   {-# NOINLINE cos #-}-  tan x   = unsafePerformIO (C.casadi_tan__3 x)+  tan x   = unsafePerformIO (C.casadi_tan__4 x)   {-# NOINLINE tan #-}-  asin x  = unsafePerformIO (C.casadi_asin__3 x)+  asin x  = unsafePerformIO (C.casadi_asin__4 x)   {-# NOINLINE asin #-}-  atan x  = unsafePerformIO (C.casadi_atan__3 x)+  atan x  = unsafePerformIO (C.casadi_atan__4 x)   {-# NOINLINE atan #-}-  acos x  = unsafePerformIO (C.casadi_acos__3 x)+  acos x  = unsafePerformIO (C.casadi_acos__4 x)   {-# NOINLINE acos #-}-  sinh x  = unsafePerformIO (C.casadi_sinh__3 x)+  sinh x  = unsafePerformIO (C.casadi_sinh__4 x)   {-# NOINLINE sinh #-}-  cosh x  = unsafePerformIO (C.casadi_cosh__3 x)+  cosh x  = unsafePerformIO (C.casadi_cosh__4 x)   {-# NOINLINE cosh #-}-  tanh x  = unsafePerformIO (C.casadi_tanh__3 x)+  tanh x  = unsafePerformIO (C.casadi_tanh__4 x)   {-# NOINLINE tanh #-}-  asinh x = unsafePerformIO (C.casadi_asinh__3 x)+  asinh x = unsafePerformIO (C.casadi_asinh__4 x)   {-# NOINLINE asinh #-}-  atanh x = unsafePerformIO (C.casadi_atanh__3 x)+  atanh x = unsafePerformIO (C.casadi_atanh__4 x)   {-# NOINLINE atanh #-}-  acosh x = unsafePerformIO (C.casadi_acosh__3 x)+  acosh x = unsafePerformIO (C.casadi_acosh__4 x)   {-# NOINLINE acosh #-}  instance Fmod MX where-  fmod x y = unsafePerformIO (C.casadi_mod__3 x y)+  fmod x y = unsafePerformIO (C.casadi_mod__4 x y)   {-# NOINLINE fmod #-}  instance ArcTan2 MX where-  arctan2 x y = unsafePerformIO (C.casadi_atan2__3 x y)+  arctan2 x y = unsafePerformIO (C.casadi_atan2__4 x y)   {-# NOINLINE arctan2 #-}  instance SymOrd MX where-  x `leq` y = unsafePerformIO (C.casadi_le__3 x y)+  x `leq` y = unsafePerformIO (C.casadi_le__4 x y)   {-# NOINLINE leq #-}-  x `geq` y = unsafePerformIO (C.casadi_ge__3 x y)+  x `geq` y = unsafePerformIO (C.casadi_ge__4 x y)   {-# NOINLINE geq #-}-  x  `eq` y = unsafePerformIO (C.casadi_eq__3 x y)+  x  `eq` y = unsafePerformIO (C.casadi_eq__4 x y)   {-# NOINLINE eq #-}  instance Erf MX where-  erf x = unsafePerformIO (C.casadi_erf__3 x)+  erf x = unsafePerformIO (C.casadi_erf__4 x)   {-# NOINLINE erf #-}-  erfinv x = unsafePerformIO (C.casadi_erfinv__3 x)+  erfinv x = unsafePerformIO (C.casadi_erfinv__4 x)   {-# NOINLINE erfinv #-}
− src/Casadi/MXFunction.hs 
@@ -1,41 +0,0 @@-{-# OPTIONS_GHC -Wall -fno-warn-orphans -fno-cse #-}--module Casadi.MXFunction-       ( C.MXFunction-       , mxFunction-       , mxFunction'-       , mxFunctionFromFunction-       ) where--import qualified Data.Traversable as T-import Data.Vector ( Vector )-import Data.Map ( Map )--import qualified Casadi.Core.Classes.Function as C-import Casadi.Core.Classes.GenericType ( GenericType )-import qualified Casadi.Core.Classes.MXFunction as C--import Casadi.MX ( MX )-import Casadi.GenericC ( GenericC( mkGeneric ), Opt )-import Casadi.SharedObject ( castSharedObject )--instance Show C.MXFunction where-  show x = show (castSharedObject x)-  {-# NOINLINE show #-}--mxFunction :: String -> Vector MX -> Vector MX -> Map String Opt-              -> IO C.MXFunction-mxFunction n x y opts0 = do-  opts <- T.mapM mkGeneric opts0 :: IO (Map String GenericType)-  C.mxFunction__7 n x y opts--mxFunction' ::-  String -> (Map String MX, Vector String) -> (Map String MX, Vector String)-  -> Map String Opt-  -> IO C.MXFunction-mxFunction' n x y opts0 = do-  opts <- T.mapM mkGeneric opts0 :: IO (Map String GenericType)-  C.mxFunction__1 n x y opts--mxFunctionFromFunction :: C.Function -> IO C.MXFunction-mxFunctionFromFunction = C.mxFunction__8
− src/Casadi/Option.hs 
@@ -1,23 +0,0 @@-{-# OPTIONS_GHC -Wall #-}-{-# Language GADTs #-}---- todo(greg): merge this with Casadi.GenericC-module Casadi.Option-       ( Opt(..)-       , GenericC(..)-       , GenericType-       , getOption-       ) where--import Casadi.Core.Classes.OptionsFunctionality-  ( OptionsFunctionalityClass-  , optionsFunctionality_hasOption, optionsFunctionality_getOption-  )-import Casadi.GenericC--getOption :: (OptionsFunctionalityClass a, GenericC b) => a -> String -> IO (Maybe b)-getOption f name = do-  has <- optionsFunctionality_hasOption f name-  if has-    then optionsFunctionality_getOption f name >>= fromGeneric-    else return Nothing
src/Casadi/SX.hs view
@@ -14,7 +14,7 @@  import Casadi.Overloading ( Fmod(..), ArcTan2(..), SymOrd(..), Erf(..) ) import Casadi.CMatrix ( CMatrix(..) )-import Casadi.DMatrix ()+import Casadi.DM () import Casadi.Viewable ( Viewable(..) )  instance Show SX where@@ -22,7 +22,7 @@   {-# NOINLINE show #-}  instance Eq SX where-  x == y = unsafePerformIO (C.casadi_isEqual__0 x y)+  x == y = unsafePerformIO (C.casadi_is_equal__2 x y)   {-# NOINLINE (==) #-}  instance Conjugate SX where@@ -87,14 +87,14 @@   {-# NOINLINE size2 #-}   numel x = unsafePerformIO (sx_numel__1 x)   {-# NOINLINE numel #-}-  mm x y = unsafePerformIO (C.casadi_mul__1 x y)+  mm x y = unsafePerformIO (C.casadi_mtimes__1 x y)   {-# NOINLINE mm #-}-  innerProd x y = unsafePerformIO (C.casadi_inner_prod__0 x y)-  {-# NOINLINE innerProd #-}-  sumCols x = unsafePerformIO (C.casadi_sumCols__0 x)-  {-# NOINLINE sumCols #-}-  sumRows x = unsafePerformIO (C.casadi_sumRows__0 x)-  {-# NOINLINE sumRows #-}+  dot x y = unsafePerformIO (C.casadi_dot__0 x y)+  {-# NOINLINE dot #-}+  sum1 x = unsafePerformIO (C.casadi_sum1__0 x)+  {-# NOINLINE sum1 #-}+  sum2 x = unsafePerformIO (C.casadi_sum2__0 x)+  {-# NOINLINE sum2 #-}   trans x = unsafePerformIO (sx_T x)   {-# NOINLINE trans #-}   diag x = unsafePerformIO (C.casadi_diag__0 x)@@ -111,19 +111,13 @@   {-# NOINLINE solve #-}   solve' x y = unsafePerformIO (C.casadi_solve__2 x y)   {-# NOINLINE solve' #-}-  indexed m spx spy = unsafePerformIO $ do-    ret <- allocEmpty :: IO SX-    sx_get__3 m ret False spx spy-    return ret+  indexed m spx spy = unsafePerformIO (sx_get__3 m False spx spy)   {-# NOINLINE indexed #-}-  sparsity x = unsafePerformIO (sx_getSparsity x)+  sparsity x = unsafePerformIO (sx_get_sparsity x)   {-# NOINLINE sparsity #-}-  getNZ m sp = unsafePerformIO $ do-    ret <- allocEmpty :: IO SX-    sx_getNZ__1 m ret False sp-    return ret+  getNZ m sp = unsafePerformIO (sx_get_nz__1 m False sp)   {-# NOINLINE getNZ #-}-  setNZ m y s = sx_setNZ__1 m y False s+  setNZ m y s = sx_set_nz__1 m y False s   triu x = unsafePerformIO (C.casadi_triu__0 x)   {-# NOINLINE triu #-}   tril x = unsafePerformIO (C.casadi_tril__0 x)@@ -135,37 +129,46 @@   copy m = sx__9 m   densify x = unsafePerformIO (C.casadi_densify__0 x)   {-# NOINLINE densify #-}-  fromDMatrix x = unsafePerformIO (sx__1 x)-  {-# NOINLINE fromDMatrix #-}-  fromDVector x = fromDMatrix (fromDVector x)+  fromDM x = unsafePerformIO (sx__1 x)+  {-# NOINLINE fromDM #-}+  fromDVector x = fromDM (fromDVector x)   {-# NOINLINE fromDVector #-}   fromDouble x = unsafePerformIO (sx__5 x)   {-# NOINLINE fromDouble #-}-  allocEmpty = sx__10   reshape x s = unsafePerformIO (C.casadi_reshape__1 x s)   {-# NOINLINE reshape #-}   conditional x0 x1 x2 = unsafePerformIO (C.casadi_conditional__0 x0 x1 x2)   {-# NOINLINE conditional #-}   conditional' x0 x1 x2 x3 = unsafePerformIO (C.casadi_conditional__1 x0 x1 x2 x3)   {-# NOINLINE conditional' #-}+  inv x = unsafePerformIO (C.casadi_inv__0 x)+  {-# NOINLINE inv #-}+  pinv x = unsafePerformIO (C.casadi_pinv__2 x)+  {-# NOINLINE pinv #-}+  pinv' x n o = unsafePerformIO (C.casadi_pinv__1 x n o)+  {-# NOINLINE pinv' #-}+  cmax x y = unsafePerformIO (C.casadi_max__1 x y)+  {-# NOINLINE cmax #-}+  cmin x y = unsafePerformIO (C.casadi_min__1 x y)+  {-# NOINLINE cmin #-}   instance Num SX where-  (+) x y = unsafePerformIO (C.casadi_plus__0 x y)+  (+) x y = unsafePerformIO (C.casadi_plus__1 x y)   {-# NOINLINE (+) #-}-  (-) x y = unsafePerformIO (C.casadi_minus__0 x y)+  (-) x y = unsafePerformIO (C.casadi_minus__1 x y)   {-# NOINLINE (-) #-}-  (*) x y = unsafePerformIO (C.casadi_times__0 x y)+  (*) x y = unsafePerformIO (C.casadi_times__1 x y)   {-# NOINLINE (*) #-}   fromInteger x = fromDouble (fromInteger x :: Double)   {-# NOINLINE fromInteger #-}-  abs x = unsafePerformIO (C.casadi_abs__0 x)+  abs x = unsafePerformIO (C.casadi_abs__1 x)   {-# NOINLINE abs #-}-  signum x = unsafePerformIO (C.casadi_sign__0 x)+  signum x = unsafePerformIO (C.casadi_sign__1 x)   {-# NOINLINE signum #-}  instance Fractional SX where-  (/) x y = unsafePerformIO (C.casadi_rdivide__0 x y)+  (/) x y = unsafePerformIO (C.casadi_rdivide__1 x y)   {-# NOINLINE (/) #-}   fromRational x = fromDouble (fromRational x :: Double)   {-# NOINLINE fromRational #-}@@ -173,55 +176,55 @@ instance Floating SX where   pi = fromDouble (pi :: Double)   {-# NOINLINE pi #-}-  (**) x y = unsafePerformIO (C.casadi_power__0 x y)+  (**) x y = unsafePerformIO (C.casadi_power__1 x y)   {-# NOINLINE (**) #-}-  exp x   = unsafePerformIO (C.casadi_exp__0 x)+  exp x   = unsafePerformIO (C.casadi_exp__1 x)   {-# NOINLINE exp #-}-  log x   = unsafePerformIO (C.casadi_log__0 x)+  log x   = unsafePerformIO (C.casadi_log__1 x)   {-# NOINLINE log #-}-  sin x   = unsafePerformIO (C.casadi_sin__0 x)+  sin x   = unsafePerformIO (C.casadi_sin__1 x)   {-# NOINLINE sin #-}-  cos x   = unsafePerformIO (C.casadi_cos__0 x)+  cos x   = unsafePerformIO (C.casadi_cos__1 x)   {-# NOINLINE cos #-}-  tan x   = unsafePerformIO (C.casadi_tan__0 x)+  tan x   = unsafePerformIO (C.casadi_tan__1 x)   {-# NOINLINE tan #-}-  asin x  = unsafePerformIO (C.casadi_asin__0 x)+  asin x  = unsafePerformIO (C.casadi_asin__1 x)   {-# NOINLINE asin #-}-  atan x  = unsafePerformIO (C.casadi_atan__0 x)+  atan x  = unsafePerformIO (C.casadi_atan__1 x)   {-# NOINLINE atan #-}-  acos x  = unsafePerformIO (C.casadi_acos__0 x)+  acos x  = unsafePerformIO (C.casadi_acos__1 x)   {-# NOINLINE acos #-}-  sinh x  = unsafePerformIO (C.casadi_sinh__0 x)+  sinh x  = unsafePerformIO (C.casadi_sinh__1 x)   {-# NOINLINE sinh #-}-  cosh x  = unsafePerformIO (C.casadi_cosh__0 x)+  cosh x  = unsafePerformIO (C.casadi_cosh__1 x)   {-# NOINLINE cosh #-}-  tanh x  = unsafePerformIO (C.casadi_tanh__0 x)+  tanh x  = unsafePerformIO (C.casadi_tanh__1 x)   {-# NOINLINE tanh #-}-  asinh x = unsafePerformIO (C.casadi_asinh__0 x)+  asinh x = unsafePerformIO (C.casadi_asinh__1 x)   {-# NOINLINE asinh #-}-  atanh x = unsafePerformIO (C.casadi_atanh__0 x)+  atanh x = unsafePerformIO (C.casadi_atanh__1 x)   {-# NOINLINE atanh #-}-  acosh x = unsafePerformIO (C.casadi_acosh__0 x)+  acosh x = unsafePerformIO (C.casadi_acosh__1 x)   {-# NOINLINE acosh #-}  instance Fmod SX where-  fmod x y = unsafePerformIO (C.casadi_mod__0 x y)+  fmod x y = unsafePerformIO (C.casadi_mod__1 x y)   {-# NOINLINE fmod #-}  instance ArcTan2 SX where-  arctan2 x y = unsafePerformIO (C.casadi_atan2__0 x y)+  arctan2 x y = unsafePerformIO (C.casadi_atan2__1 x y)   {-# NOINLINE arctan2 #-}  instance SymOrd SX where-  x `leq` y = unsafePerformIO (C.casadi_le__0 x y)+  x `leq` y = unsafePerformIO (C.casadi_le__1 x y)   {-# NOINLINE leq #-}-  x `geq` y = unsafePerformIO (C.casadi_ge__0 x y)+  x `geq` y = unsafePerformIO (C.casadi_ge__1 x y)   {-# NOINLINE geq #-}-  x  `eq` y = unsafePerformIO (C.casadi_eq__0 x y)+  x  `eq` y = unsafePerformIO (C.casadi_eq__1 x y)   {-# NOINLINE eq #-}  instance Erf SX where-  erf x = unsafePerformIO (C.casadi_erf__0 x)+  erf x = unsafePerformIO (C.casadi_erf__1 x)   {-# NOINLINE erf #-}-  erfinv x = unsafePerformIO (C.casadi_erfinv__0 x)+  erfinv x = unsafePerformIO (C.casadi_erfinv__1 x)   {-# NOINLINE erfinv #-}
− src/Casadi/SXFunction.hs 
@@ -1,46 +0,0 @@-{-# OPTIONS_GHC -Wall -fno-cse -fno-warn-orphans#-}--module Casadi.SXFunction-       ( C.SXFunction-       , sxFunction-       , sxFunction'-       , sxFunctionFromFunction-       , sxFunctionFromMXFunction-       ) where--import qualified Data.Traversable as T-import Data.Vector ( Vector )-import Data.Map ( Map )--import qualified Casadi.Core.Classes.Function as C-import Casadi.Core.Classes.GenericType ( GenericType )-import qualified Casadi.Core.Classes.SXFunction as C-import qualified Casadi.Core.Classes.MXFunction as C--import Casadi.GenericC ( GenericC( mkGeneric ), Opt )-import Casadi.SharedObject ( castSharedObject )-import Casadi.SX ( SX )--instance Show C.SXFunction where-  show x = show (castSharedObject x)-  {-# NOINLINE show #-}--sxFunction :: String -> Vector SX -> Vector SX -> Map String Opt-              -> IO C.SXFunction-sxFunction n x y opts0 = do-  opts <- T.mapM mkGeneric opts0 :: IO (Map String GenericType)-  C.sxFunction__7 n x y opts--sxFunction' ::-  String -> (Map String SX, Vector String) -> (Map String SX, Vector String)-  -> Map String Opt-  -> IO C.SXFunction-sxFunction' n x y opts0 = do-  opts <- T.mapM mkGeneric opts0 :: IO (Map String GenericType)-  C.sxFunction__1 n x y opts--sxFunctionFromFunction :: C.Function -> IO C.SXFunction-sxFunctionFromFunction = C.sxFunction__8--sxFunctionFromMXFunction :: C.MXFunction -> IO C.SXFunction-sxFunctionFromMXFunction = C.sxFunction__9
src/Casadi/Slice.hs view
@@ -14,10 +14,10 @@  -- | slice start stop step slice :: Int -> Int -> Int -> Slice-slice x y z = unsafePerformIO (slice__4 x y z)+slice x y z = unsafePerformIO (slice__1 x y z) {-# NOINLINE slice #-}  -- | Slice() slice' :: Slice-slice' = unsafePerformIO slice__7+slice' = unsafePerformIO slice__4 {-# NOINLINE slice' #-}
src/Casadi/Sparsity.hs view
@@ -2,10 +2,10 @@  module Casadi.Sparsity        ( Sparsity-       , upper, lower, spy, spyMatlab+       , upper, lower, spy, spy_matlab        , dense, sparse, scalar        , compress, compressed-       , getRow, getCol+       , get_row, get_col        ) where  import qualified Data.Vector as V@@ -37,7 +37,7 @@   {-# NOINLINE show #-}  instance Eq Sparsity where-  x == y = unsafePerformIO (sparsity_isEqual__1 x y)+  x == y = unsafePerformIO (sparsity_is_equal__1 x y)   {-# NOINLINE (==) #-}  upper :: Int -> Sparsity@@ -51,20 +51,20 @@ spy :: Sparsity -> IO () spy = sparsity_spy -spyMatlab :: Sparsity -> String -> IO ()-spyMatlab = sparsity_spyMatlab+spy_matlab :: Sparsity -> String -> IO ()+spy_matlab = sparsity_spy_matlab  scalar :: Sparsity scalar = unsafePerformIO sparsity_scalar__0 {-# NOINLINE scalar #-} -getRow :: Sparsity -> V.Vector Int-getRow s = unsafePerformIO (sparsity_getRow s)-{-# NOINLINE getRow #-}+get_row :: Sparsity -> V.Vector Int+get_row s = unsafePerformIO (sparsity_get_row s)+{-# NOINLINE get_row #-} -getCol :: Sparsity -> V.Vector Int-getCol s = unsafePerformIO (sparsity_getCol s)-{-# NOINLINE getCol #-}+get_col :: Sparsity -> V.Vector Int+get_col s = unsafePerformIO (sparsity_get_col s)+{-# NOINLINE get_col #-}  sparse :: Int -> Int -> V.Vector Int -> V.Vector Int -> Sparsity sparse nr nc r c = unsafePerformIO (sparsity__0 nr nc r c)
+ tests/CallbackTests.hs view
@@ -0,0 +1,40 @@+{-# OPTIONS_GHC -Wall #-}+{-# LANGUAGE ScopedTypeVariables #-}++module CallbackTests+       ( callbackTests+       ) where++import qualified Data.Map as M+import qualified Data.Vector as V+import qualified Test.HUnit.Base as HUnit+import Test.Framework ( Test, testGroup )+import Test.Framework.Providers.HUnit ( testCase )++import Casadi.Callback ( makeCallback )+import Casadi.DM ( DM )+import Casadi.Function ( callDM )+import Casadi.GenericType ( GType )+import Casadi.Sparsity ( dense )++simpleCallbackTest :: Test+simpleCallbackTest = testCase "simple callback test" $ HUnit.assert $ do+  let cb :: V.Vector DM -> M.Map String GType -> IO (V.Vector DM)+      cb xs stats = do+        putStrLn $ "stats: " ++ show stats+        case V.toList xs of+          [x] -> return (V.singleton (x*x))+          _ -> error $ "callback got wrong number of args: " ++ show xs++  fun <- makeCallback (V.singleton (dense 1 1)) (V.singleton (dense 1 1)) cb++  putStrLn "calling callback"+  outs <- callDM fun (V.singleton 2.2)+  putStrLn "finished calling callback"+  putStrLn $ "outputs: " ++ show outs++callbackTests :: Test+callbackTests =+  testGroup "callbacks"+  [ simpleCallbackTest+  ]
+ tests/GTypeTests.hs view
@@ -0,0 +1,65 @@+{-# OPTIONS_GHC -Wall #-}+{-# LANGUAGE ScopedTypeVariables #-}++module GTypeTests+       ( gtypeTests+       ) where++import qualified Data.Map as M+import qualified Data.Vector as V+import qualified Test.HUnit.Base as HUnit+import Test.Framework ( Test, testGroup )+import Test.Framework.Providers.HUnit ( testCase )++import Casadi.GenericType ( GenericType, GType(..), fromGType, toGType' )++gtypes :: [(String, GType)]+gtypes =+  gtypes' ++ gtypes'' ++ [("deeper map lol", GDict (M.fromList (gtypes' ++ gtypes'')))]+  where+    gtypes' :: [(String, GType)]+    gtypes' = gtypes'' ++ [("a map lol", GDict (M.fromList gtypes''))]++    gtypes'' :: [(String, GType)]+    gtypes'' =+        [ ("GBool True", GBool True)+        , ("GBool False", GBool False)+        , ("GDouble 42", GDouble 42)+        , ("GDouble 0", GDouble 0)+        , ("GDouble read \"Infinity\"", GDouble (read "Infinity"))+        , ("GDouble read \"NaN\"", GDouble (read "NaN"))+        , ("GInt 42", GInt 42)+        , ("GInt 0", GInt 0)+        , ("GString \"\"", GString "")+        , ("GString \"yolo\"", GString "yolo")+          -- TODO(greg): re-enable these after "https://github.com/casadi/casadi/issues/1769" is fixed+--        , ("GBoolVec V.empty", GBoolVec V.empty)+--        , ("GBoolVec V.singleton True", GBoolVec (V.singleton True))+--        , ("GBoolVec V.fromList [True, False]", GBoolVec (V.fromList [True, False]))+        , ("GDoubleVec [42, 0, read \"Infinity\"]", GDoubleVec (V.fromList ([42, 0, read "Infinity"])))+        , ("GIntVec [42, 0]", GIntVec (V.fromList [42, 0]))+        , ("GIntVecVec", GIntVecVec (V.fromList [V.fromList [42, 0], V.singleton 2, V.empty]))+        , ("GStringVec [\"\", \"yolo\"]", GStringVec (V.fromList ["", "yolo"]))+--      --  , GFunction Function+        , ("GDict (M.fromList [])", GDict (M.fromList []))+        ]++testGType :: (String, GType) -> Test+testGType (name, gtype0) = testCase name $ HUnit.assert $ do+  gt <- fromGType gtype0 :: IO GenericType+  ego <- toGType' gt :: IO (Either String GType)+  case ego of+    Left msg -> HUnit.assertString $ "error converting from GenericType to GType: " ++ msg+    Right gtype1+      | gtype0 == gtype1 -> HUnit.assert True+      | otherwise -> HUnit.assertString $ init $ unlines+           [ "original GType doesn't equal new GType"+           , "original:"+           , show gtype0+           , "new:"+           , show gtype1+           ]++gtypeTests :: Test+gtypeTests =+  testGroup "GType conversion" (map testGType gtypes)
+ tests/UnitTests.hs view
@@ -0,0 +1,34 @@+{-# OPTIONS_GHC -Wall #-}++module Main ( main ) where++import qualified Data.Monoid as Mo+import Test.Framework+       ( Test, ColorMode(..), RunnerOptions'(..), TestOptions'(..)+       , defaultMainWithOpts )++import GTypeTests ( gtypeTests )+import CallbackTests ( callbackTests )++main :: IO ()+main = defaultMainWithOpts tests opts++tests :: [Test]+tests = +  [ gtypeTests+  , callbackTests+  ]++opts :: RunnerOptions' Maybe+opts =+  Mo.mempty+  { ropt_color_mode = Just ColorAlways+  , ropt_threads = Just 1+  , ropt_test_options = Just my_test_opts+  }++my_test_opts :: TestOptions' Maybe+my_test_opts =+  Mo.mempty+  { topt_timeout = Just (Just 15000000)+  }
tests/doctests.hs view
@@ -5,4 +5,9 @@ import Test.DocTest  main :: IO ()-main = doctest ["src/Casadi/Overloading.hs"]+main =+  doctest+  [ "-idist/build"+  , "dist/build/cbits/casadi_bindings.o"+  , "src/Casadi/Overloading.hs"+  ]