2 files changed, 67 insertions, 0 deletions

diff --git a/examples/devel/example/functions.c b/examples/devel/example/functions.c
new file mode 100644
index 0000000..67d3270
--- /dev/null
+++ b/examples/devel/example/functions.c
@@ -0,0 +1,22 @@
+
+typedef struct { double r, i; } doublecomplex;
+
+#define VEC(T,A) int A##n, T* A##p
+#define MAT(T,A) int A##r, int A##c, int A##Xr, int A##Xc, T* A##p
+
+#define AT(m,i,j) (m##p[(i)*m##Xr + (j)*m##Xc])
+#define TRAV(m,i,j) int i,j; for (i=0;i<m##r;i++) for (j=0;j<m##c;j++)
+
+
+int c_diag(MAT(double,m), VEC(double,y), MAT(double,z)) {
+    int k;
+    for (k=0; k<yn; k++) {
+        yp[k] = AT(m,k,k);
+    }
+    { TRAV(z,i,j) {
+        AT(z,i,j) = i==j?yp[i]:0;
+        }
+    }
+    return 0;
+}
+
diff --git a/examples/devel/example/wrappers.hs b/examples/devel/example/wrappers.hs
new file mode 100644
index 0000000..f4e0f0b
--- /dev/null
+++ b/examples/devel/example/wrappers.hs
@@ -0,0 +1,45 @@
+{-# LANGUAGE ForeignFunctionInterface #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE GADTs #-}
+
+{-
+    $ ghc -O2 wrappers.hs functions.c
+    $ ./wrappers
+-}
+
+import Numeric.LinearAlgebra
+import Numeric.LinearAlgebra.Devel
+import System.IO.Unsafe(unsafePerformIO)
+import Foreign.C.Types(CInt(..))
+import Foreign.Ptr(Ptr)
+
+
+infixl 1 #
+a # b = apply a b
+{-# INLINE (#) #-}
+
+infixr 5 :>, ::>
+type (:>)  t r = CInt -> Ptr t -> r
+type (::>) t r =  CInt -> CInt -> CInt -> CInt -> Ptr t -> r
+type Ok = IO CInt
+
+-----------------------------------------------------
+
+x = (3><5) [1..]
+
+main = do
+    print   x
+    print $ myDiag x
+    print $ myDiag (tr x)
+
+-----------------------------------------------------
+foreign import ccall unsafe "c_diag" cDiag :: Double ::> Double :> Double ::> Ok
+
+myDiag m = unsafePerformIO $ do
+    y <- createVector (min r c)
+    z <- createMatrix RowMajor r c
+    cDiag # m # y # z #| "cDiag"
+    return (y,z)
+  where
+    (r,c) = size m
+