summaryrefslogtreecommitdiff
path: root/examples/devel/ej2
diff options
context:
space:
mode:
Diffstat (limited to 'examples/devel/ej2')
-rw-r--r--examples/devel/ej2/functions.c24
-rw-r--r--examples/devel/ej2/wrappers.hs32
2 files changed, 56 insertions, 0 deletions
diff --git a/examples/devel/ej2/functions.c b/examples/devel/ej2/functions.c
new file mode 100644
index 0000000..4dcd377
--- /dev/null
+++ b/examples/devel/ej2/functions.c
@@ -0,0 +1,24 @@
1/* general element order */
2
3typedef struct { double r, i; } doublecomplex;
4
5#define DVEC(A) int A##n, double*A##p
6#define CVEC(A) int A##n, doublecomplex*A##p
7#define DMAT(A) int A##r, int A##c, double*A##p
8#define CMAT(A) int A##r, int A##c, doublecomplex*A##p
9
10#define AT(M,r,c) (M##p[(r)*sr+(c)*sc])
11
12int c_diag(int ro, DMAT(m),DVEC(y),DMAT(z)) {
13 int i,j,sr,sc;
14 if (ro==1) { sr = mc; sc = 1;} else { sr = 1; sc = mr;}
15 for (j=0; j<yn; j++) {
16 yp[j] = AT(m,j,j);
17 }
18 for (i=0; i<mr; i++) {
19 for (j=0; j<mc; j++) {
20 AT(z,i,j) = i==j?yp[i]:0;
21 }
22 }
23 return 0;
24}
diff --git a/examples/devel/ej2/wrappers.hs b/examples/devel/ej2/wrappers.hs
new file mode 100644
index 0000000..399c5a9
--- /dev/null
+++ b/examples/devel/ej2/wrappers.hs
@@ -0,0 +1,32 @@
1{-# LANGUAGE ForeignFunctionInterface #-}
2
3-- $ ghc -O2 --make wrappers.hs functions.c
4
5import Numeric.LinearAlgebra
6import Data.Packed.Development
7import Foreign(Ptr,unsafePerformIO)
8import Foreign.C.Types(CInt)
9
10-----------------------------------------------------
11
12main = do
13 print $ myDiag $ (3><5) [1..]
14
15-----------------------------------------------------
16-- arbitrary data order
17
18foreign import ccall "c_diag"
19 cDiag :: CInt -- matrix order
20 -> CInt -> CInt -> Ptr Double -- argument
21 -> CInt -> Ptr Double -- result1
22 -> CInt -> CInt -> Ptr Double -- result2
23 -> IO CInt -- exit code
24
25myDiag m = unsafePerformIO $ do
26 y <- createVector (min r c)
27 z <- createMatrix (orderOf m) r c
28 app3 (cDiag o) mat m vec y mat z "cDiag"
29 return (y,z)
30 where r = rows m
31 c = cols m
32 o = if orderOf m == RowMajor then 1 else 0