diff options
author | Alberto Ruiz <aruiz@um.es> | 2015-10-04 19:46:43 +0200 |
---|---|---|
committer | Alberto Ruiz <aruiz@um.es> | 2015-10-04 19:46:43 +0200 |
commit | c84a485f148063f6d0c23f016fe348ec94fb6b19 (patch) | |
tree | 2ac1755695a42d3964208e0029e74d446f5c3bd8 /examples/devel/example/wrappers.hs | |
parent | 0500032a1d954058b94cf9a0fa2a662e5666a526 (diff) |
updated devel example
Diffstat (limited to 'examples/devel/example/wrappers.hs')
-rw-r--r-- | examples/devel/example/wrappers.hs | 45 |
1 files changed, 45 insertions, 0 deletions
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 @@ | |||
1 | {-# LANGUAGE ForeignFunctionInterface #-} | ||
2 | {-# LANGUAGE TypeOperators #-} | ||
3 | {-# LANGUAGE GADTs #-} | ||
4 | |||
5 | {- | ||
6 | $ ghc -O2 wrappers.hs functions.c | ||
7 | $ ./wrappers | ||
8 | -} | ||
9 | |||
10 | import Numeric.LinearAlgebra | ||
11 | import Numeric.LinearAlgebra.Devel | ||
12 | import System.IO.Unsafe(unsafePerformIO) | ||
13 | import Foreign.C.Types(CInt(..)) | ||
14 | import Foreign.Ptr(Ptr) | ||
15 | |||
16 | |||
17 | infixl 1 # | ||
18 | a # b = apply a b | ||
19 | {-# INLINE (#) #-} | ||
20 | |||
21 | infixr 5 :>, ::> | ||
22 | type (:>) t r = CInt -> Ptr t -> r | ||
23 | type (::>) t r = CInt -> CInt -> CInt -> CInt -> Ptr t -> r | ||
24 | type Ok = IO CInt | ||
25 | |||
26 | ----------------------------------------------------- | ||
27 | |||
28 | x = (3><5) [1..] | ||
29 | |||
30 | main = do | ||
31 | print x | ||
32 | print $ myDiag x | ||
33 | print $ myDiag (tr x) | ||
34 | |||
35 | ----------------------------------------------------- | ||
36 | foreign import ccall unsafe "c_diag" cDiag :: Double ::> Double :> Double ::> Ok | ||
37 | |||
38 | myDiag m = unsafePerformIO $ do | ||
39 | y <- createVector (min r c) | ||
40 | z <- createMatrix RowMajor r c | ||
41 | cDiag # m # y # z #| "cDiag" | ||
42 | return (y,z) | ||
43 | where | ||
44 | (r,c) = size m | ||
45 | |||