From 9adf5ded237339dbe41db6c486993c4547396a22 Mon Sep 17 00:00:00 2001 From: Alberto Ruiz Date: Mon, 15 Oct 2007 10:31:45 +0000 Subject: some windows support --- lib/Data/Packed/Internal/Common.hs | 1 + lib/Data/Packed/Internal/Matrix.hs | 20 ++--- lib/Data/Packed/Internal/Vector.hs | 2 +- lib/Data/Packed/Internal/aux.c | 180 ------------------------------------- lib/Data/Packed/Internal/aux.h | 30 ------- lib/Data/Packed/Internal/auxi.c | 180 +++++++++++++++++++++++++++++++++++++ lib/Data/Packed/Internal/auxi.h | 30 +++++++ 7 files changed, 222 insertions(+), 221 deletions(-) delete mode 100644 lib/Data/Packed/Internal/aux.c delete mode 100644 lib/Data/Packed/Internal/aux.h create mode 100644 lib/Data/Packed/Internal/auxi.c create mode 100644 lib/Data/Packed/Internal/auxi.h (limited to 'lib/Data') diff --git a/lib/Data/Packed/Internal/Common.hs b/lib/Data/Packed/Internal/Common.hs index 75a5b1e..2b3ec28 100644 --- a/lib/Data/Packed/Internal/Common.hs +++ b/lib/Data/Packed/Internal/Common.hs @@ -70,6 +70,7 @@ errorCode 2003 = "bad file" errorCode 2004 = "singular" errorCode 2005 = "didn't converge" errorCode 2006 = "the input matrix is not positive definite" +errorCode 2007 = "not yet supported in this OS" errorCode n = "code "++show n {- | conversion of Haskell functions into function pointers that can be used in the C side diff --git a/lib/Data/Packed/Internal/Matrix.hs b/lib/Data/Packed/Internal/Matrix.hs index e76500b..bf7f0ec 100644 --- a/lib/Data/Packed/Internal/Matrix.hs +++ b/lib/Data/Packed/Internal/Matrix.hs @@ -240,9 +240,9 @@ transdataAux fun c1 d c2 = r2 = dim d `div` c2 noneed = r1 == 1 || c1 == 1 -foreign import ccall safe "aux.h transR" +foreign import ccall safe "auxi.h transR" ctransR :: TMM -- Double ::> Double ::> IO Int -foreign import ccall safe "aux.h transC" +foreign import ccall safe "auxi.h transC" ctransC :: TCMCM -- Complex Double ::> Complex Double ::> IO Int ------------------------------------------------------------------ @@ -258,14 +258,14 @@ multiplyAux fun a b = unsafePerformIO $ do return r multiplyR = multiplyAux cmultiplyR -foreign import ccall safe "aux.h multiplyR" +foreign import ccall safe "auxi.h multiplyR" cmultiplyR :: Int -> Int -> Int -> Ptr Double -> Int -> Int -> Int -> Ptr Double -> Int -> Int -> Ptr Double -> IO Int multiplyC = multiplyAux cmultiplyC -foreign import ccall safe "aux.h multiplyC" +foreign import ccall safe "auxi.h multiplyC" cmultiplyC :: Int -> Int -> Int -> Ptr (Complex Double) -> Int -> Int -> Int -> Ptr (Complex Double) -> Int -> Int -> Ptr (Complex Double) @@ -288,7 +288,7 @@ subMatrixR (r0,c0) (rt,ct) x = unsafePerformIO $ do r <- createMatrix RowMajor rt ct c_submatrixR r0 (r0+rt-1) c0 (c0+ct-1) // mat cdat x // mat dat r // check "subMatrixR" [dat r] return r -foreign import ccall "aux.h submatrixR" c_submatrixR :: Int -> Int -> Int -> Int -> TMM +foreign import ccall "auxi.h submatrixR" c_submatrixR :: Int -> Int -> Int -> Int -> TMM -- | extraction of a submatrix from a complex matrix subMatrixC :: (Int,Int) -> (Int,Int) -> Matrix (Complex Double) -> Matrix (Complex Double) @@ -316,12 +316,12 @@ diagAux fun msg (v@V {dim = n}) = unsafePerformIO $ do -- | diagonal matrix from a real vector diagR :: Vector Double -> Matrix Double diagR = diagAux c_diagR "diagR" -foreign import ccall "aux.h diagR" c_diagR :: TVM +foreign import ccall "auxi.h diagR" c_diagR :: TVM -- | diagonal matrix from a real vector diagC :: Vector (Complex Double) -> Matrix (Complex Double) diagC = diagAux c_diagC "diagC" -foreign import ccall "aux.h diagC" c_diagC :: TCVCM +foreign import ccall "auxi.h diagC" c_diagC :: TCVCM -- | creates a square matrix with the given diagonal diag :: Field a => Vector a -> Matrix a @@ -338,12 +338,12 @@ constantAux fun x n = unsafePerformIO $ do constantR :: Double -> Int -> Vector Double constantR = constantAux cconstantR -foreign import ccall safe "aux.h constantR" +foreign import ccall safe "auxi.h constantR" cconstantR :: Ptr Double -> TV -- Double :> IO Int constantC :: Complex Double -> Int -> Vector (Complex Double) constantC = constantAux cconstantC -foreign import ccall safe "aux.h constantC" +foreign import ccall safe "auxi.h constantC" cconstantC :: Ptr (Complex Double) -> TCV -- Complex Double :> IO Int {- | creates a vector with a given number of equal components: @@ -381,7 +381,7 @@ fromFile filename (r,c) = do c_gslReadMatrix charname // mat dat res // check "gslReadMatrix" [] --free charname -- TO DO: free the auxiliary CString return res -foreign import ccall "aux.h matrix_fscanf" c_gslReadMatrix:: Ptr CChar -> TM +foreign import ccall "auxi.h matrix_fscanf" c_gslReadMatrix:: Ptr CChar -> TM ------------------------------------------------------------------------- diff --git a/lib/Data/Packed/Internal/Vector.hs b/lib/Data/Packed/Internal/Vector.hs index ebe6371..9557206 100644 --- a/lib/Data/Packed/Internal/Vector.hs +++ b/lib/Data/Packed/Internal/Vector.hs @@ -46,7 +46,7 @@ check msg ls f = do return () -- | description of GSL error codes -foreign import ccall "aux.h gsl_strerror" gsl_strerror :: Int -> IO (Ptr CChar) +foreign import ccall "auxi.h gsl_strerror" gsl_strerror :: Int -> IO (Ptr CChar) -- | signature of foreign functions admitting C-style vectors type Vc t s = Int -> Ptr t -> s diff --git a/lib/Data/Packed/Internal/aux.c b/lib/Data/Packed/Internal/aux.c deleted file mode 100644 index 3db3535..0000000 --- a/lib/Data/Packed/Internal/aux.c +++ /dev/null @@ -1,180 +0,0 @@ -#include "aux.h" -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include - -#define MACRO(B) do {B} while (0) -#define ERROR(CODE) MACRO(return CODE;) -#define REQUIRES(COND, CODE) MACRO(if(!(COND)) {ERROR(CODE);}) -#define OK return 0; - -#define MIN(A,B) ((A)<(B)?(A):(B)) -#define MAX(A,B) ((A)>(B)?(A):(B)) - -#ifdef DBG -#define DEBUGMSG(M) printf("*** calling aux C function: %s\n",M); -#else -#define DEBUGMSG(M) -#endif - -#define CHECK(RES,CODE) MACRO(if(RES) return CODE;) - -#ifdef DBG -#define DEBUGMAT(MSG,X) printf(MSG" = \n"); gsl_matrix_fprintf(stdout,X,"%f"); printf("\n"); -#else -#define DEBUGMAT(MSG,X) -#endif - -#ifdef DBG -#define DEBUGVEC(MSG,X) printf(MSG" = \n"); gsl_vector_fprintf(stdout,X,"%f"); printf("\n"); -#else -#define DEBUGVEC(MSG,X) -#endif - -#define DVVIEW(A) gsl_vector_view A = gsl_vector_view_array(A##p,A##n) -#define DMVIEW(A) gsl_matrix_view A = gsl_matrix_view_array(A##p,A##r,A##c) -#define CVVIEW(A) gsl_vector_complex_view A = gsl_vector_complex_view_array((double*)A##p,A##n) -#define CMVIEW(A) gsl_matrix_complex_view A = gsl_matrix_complex_view_array((double*)A##p,A##r,A##c) -#define KDVVIEW(A) gsl_vector_const_view A = gsl_vector_const_view_array(A##p,A##n) -#define KDMVIEW(A) gsl_matrix_const_view A = gsl_matrix_const_view_array(A##p,A##r,A##c) -#define KCVVIEW(A) gsl_vector_complex_const_view A = gsl_vector_complex_const_view_array((double*)A##p,A##n) -#define KCMVIEW(A) gsl_matrix_complex_const_view A = gsl_matrix_complex_const_view_array((double*)A##p,A##r,A##c) - -#define V(a) (&a.vector) -#define M(a) (&a.matrix) - -#define GCVEC(A) int A##n, gsl_complex*A##p -#define KGCVEC(A) int A##n, const gsl_complex*A##p - -#define BAD_SIZE 2000 -#define BAD_CODE 2001 -#define MEM 2002 -#define BAD_FILE 2003 - -int transR(KRMAT(x),RMAT(t)) { - REQUIRES(xr==tc && xc==tr,BAD_SIZE); - DEBUGMSG("transR"); - KDMVIEW(x); - DMVIEW(t); - int res = gsl_matrix_transpose_memcpy(M(t),M(x)); - CHECK(res,res); - OK -} - -int transC(KCMAT(x),CMAT(t)) { - REQUIRES(xr==tc && xc==tr,BAD_SIZE); - DEBUGMSG("transC"); - KCMVIEW(x); - CMVIEW(t); - int res = gsl_matrix_complex_transpose_memcpy(M(t),M(x)); - CHECK(res,res); - OK -} - - -int submatrixR(int r1, int r2, int c1, int c2, KRMAT(x),RMAT(r)) { - REQUIRES(0<=r1 && r1<=r2 && r2 - -#define RVEC(A) int A##n, double*A##p -#define RMAT(A) int A##r, int A##c, double* A##p -#define KRVEC(A) int A##n, const double*A##p -#define KRMAT(A) int A##r, int A##c, const double* A##p - -#define CVEC(A) int A##n, gsl_complex*A##p -#define CMAT(A) int A##r, int A##c, gsl_complex* A##p -#define KCVEC(A) int A##n, const gsl_complex*A##p -#define KCMAT(A) int A##r, int A##c, const gsl_complex* A##p - - -int transR(KRMAT(x),RMAT(t)); -int transC(KCMAT(x),CMAT(t)); - -int constantR(double *val , RVEC(r)); -int constantC(gsl_complex *val, CVEC(r)); - -int multiplyR(int ta, KRMAT(a), int tb, KRMAT(b),RMAT(r)); -int multiplyC(int ta, KCMAT(a), int tb, KCMAT(b),CMAT(r)); - -int submatrixR(int r1, int r2, int c1, int c2, KRMAT(x),RMAT(r)); - -int diagR(KRVEC(d),RMAT(r)); -int diagC(KCVEC(d),CMAT(r)); - -const char * gsl_strerror (const int gsl_errno); - -int matrix_fscanf(char*filename, RMAT(a)); diff --git a/lib/Data/Packed/Internal/auxi.c b/lib/Data/Packed/Internal/auxi.c new file mode 100644 index 0000000..b53d9b7 --- /dev/null +++ b/lib/Data/Packed/Internal/auxi.c @@ -0,0 +1,180 @@ +#include "auxi.h" +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include + +#define MACRO(B) do {B} while (0) +#define ERROR(CODE) MACRO(return CODE;) +#define REQUIRES(COND, CODE) MACRO(if(!(COND)) {ERROR(CODE);}) +#define OK return 0; + +#define MIN(A,B) ((A)<(B)?(A):(B)) +#define MAX(A,B) ((A)>(B)?(A):(B)) + +#ifdef DBG +#define DEBUGMSG(M) printf("*** calling aux C function: %s\n",M); +#else +#define DEBUGMSG(M) +#endif + +#define CHECK(RES,CODE) MACRO(if(RES) return CODE;) + +#ifdef DBG +#define DEBUGMAT(MSG,X) printf(MSG" = \n"); gsl_matrix_fprintf(stdout,X,"%f"); printf("\n"); +#else +#define DEBUGMAT(MSG,X) +#endif + +#ifdef DBG +#define DEBUGVEC(MSG,X) printf(MSG" = \n"); gsl_vector_fprintf(stdout,X,"%f"); printf("\n"); +#else +#define DEBUGVEC(MSG,X) +#endif + +#define DVVIEW(A) gsl_vector_view A = gsl_vector_view_array(A##p,A##n) +#define DMVIEW(A) gsl_matrix_view A = gsl_matrix_view_array(A##p,A##r,A##c) +#define CVVIEW(A) gsl_vector_complex_view A = gsl_vector_complex_view_array((double*)A##p,A##n) +#define CMVIEW(A) gsl_matrix_complex_view A = gsl_matrix_complex_view_array((double*)A##p,A##r,A##c) +#define KDVVIEW(A) gsl_vector_const_view A = gsl_vector_const_view_array(A##p,A##n) +#define KDMVIEW(A) gsl_matrix_const_view A = gsl_matrix_const_view_array(A##p,A##r,A##c) +#define KCVVIEW(A) gsl_vector_complex_const_view A = gsl_vector_complex_const_view_array((double*)A##p,A##n) +#define KCMVIEW(A) gsl_matrix_complex_const_view A = gsl_matrix_complex_const_view_array((double*)A##p,A##r,A##c) + +#define V(a) (&a.vector) +#define M(a) (&a.matrix) + +#define GCVEC(A) int A##n, gsl_complex*A##p +#define KGCVEC(A) int A##n, const gsl_complex*A##p + +#define BAD_SIZE 2000 +#define BAD_CODE 2001 +#define MEM 2002 +#define BAD_FILE 2003 + +int transR(KRMAT(x),RMAT(t)) { + REQUIRES(xr==tc && xc==tr,BAD_SIZE); + DEBUGMSG("transR"); + KDMVIEW(x); + DMVIEW(t); + int res = gsl_matrix_transpose_memcpy(M(t),M(x)); + CHECK(res,res); + OK +} + +int transC(KCMAT(x),CMAT(t)) { + REQUIRES(xr==tc && xc==tr,BAD_SIZE); + DEBUGMSG("transC"); + KCMVIEW(x); + CMVIEW(t); + int res = gsl_matrix_complex_transpose_memcpy(M(t),M(x)); + CHECK(res,res); + OK +} + + +int submatrixR(int r1, int r2, int c1, int c2, KRMAT(x),RMAT(r)) { + REQUIRES(0<=r1 && r1<=r2 && r2 + +#define RVEC(A) int A##n, double*A##p +#define RMAT(A) int A##r, int A##c, double* A##p +#define KRVEC(A) int A##n, const double*A##p +#define KRMAT(A) int A##r, int A##c, const double* A##p + +#define CVEC(A) int A##n, gsl_complex*A##p +#define CMAT(A) int A##r, int A##c, gsl_complex* A##p +#define KCVEC(A) int A##n, const gsl_complex*A##p +#define KCMAT(A) int A##r, int A##c, const gsl_complex* A##p + + +int transR(KRMAT(x),RMAT(t)); +int transC(KCMAT(x),CMAT(t)); + +int constantR(double *val , RVEC(r)); +int constantC(gsl_complex *val, CVEC(r)); + +int multiplyR(int ta, KRMAT(a), int tb, KRMAT(b),RMAT(r)); +int multiplyC(int ta, KCMAT(a), int tb, KCMAT(b),CMAT(r)); + +int submatrixR(int r1, int r2, int c1, int c2, KRMAT(x),RMAT(r)); + +int diagR(KRVEC(d),RMAT(r)); +int diagC(KCVEC(d),CMAT(r)); + +const char * gsl_strerror (const int gsl_errno); + +int matrix_fscanf(char*filename, RMAT(a)); -- cgit v1.2.3