diff options
author | Alberto Ruiz <aruiz@um.es> | 2014-05-21 10:30:55 +0200 |
---|---|---|
committer | Alberto Ruiz <aruiz@um.es> | 2014-05-21 10:30:55 +0200 |
commit | 197e88c3b56d28840217010a2871c6ea3a4dd1a4 (patch) | |
tree | 825be9d6c9d87d23f7e5497c0133d11d52c63535 /packages/hmatrix/src/Numeric/GSL/Internal.hs | |
parent | e07c3dee7235496b71a89233106d93f6cc94ada1 (diff) |
update dependencies, move examples etc
Diffstat (limited to 'packages/hmatrix/src/Numeric/GSL/Internal.hs')
-rw-r--r-- | packages/hmatrix/src/Numeric/GSL/Internal.hs | 126 |
1 files changed, 0 insertions, 126 deletions
diff --git a/packages/hmatrix/src/Numeric/GSL/Internal.hs b/packages/hmatrix/src/Numeric/GSL/Internal.hs deleted file mode 100644 index a1c4e0c..0000000 --- a/packages/hmatrix/src/Numeric/GSL/Internal.hs +++ /dev/null | |||
@@ -1,126 +0,0 @@ | |||
1 | -- | | ||
2 | -- Module : Numeric.GSL.Internal | ||
3 | -- Copyright : (c) Alberto Ruiz 2009 | ||
4 | -- License : GPL | ||
5 | -- Maintainer : Alberto Ruiz | ||
6 | -- Stability : provisional | ||
7 | -- | ||
8 | -- | ||
9 | -- Auxiliary functions. | ||
10 | -- | ||
11 | |||
12 | |||
13 | module Numeric.GSL.Internal( | ||
14 | iv, | ||
15 | mkVecfun, | ||
16 | mkVecVecfun, | ||
17 | mkDoubleVecVecfun, | ||
18 | mkDoublefun, | ||
19 | aux_vTov, | ||
20 | mkVecMatfun, | ||
21 | mkDoubleVecMatfun, | ||
22 | aux_vTom, | ||
23 | createV, | ||
24 | createMIO, | ||
25 | module Data.Packed.Development, | ||
26 | check, | ||
27 | Res,TV,TM,TCV,TCM | ||
28 | ) where | ||
29 | |||
30 | import Data.Packed | ||
31 | import Data.Packed.Development hiding (check) | ||
32 | import Data.Complex | ||
33 | |||
34 | import Foreign.Marshal.Array(copyArray) | ||
35 | import Foreign.Ptr(Ptr, FunPtr) | ||
36 | import Foreign.C.Types | ||
37 | import Foreign.C.String(peekCString) | ||
38 | import System.IO.Unsafe(unsafePerformIO) | ||
39 | import Data.Vector.Storable(unsafeWith) | ||
40 | import Control.Monad(when) | ||
41 | |||
42 | iv :: (Vector Double -> Double) -> (CInt -> Ptr Double -> Double) | ||
43 | iv f n p = f (createV (fromIntegral n) copy "iv") where | ||
44 | copy n' q = do | ||
45 | copyArray q p (fromIntegral n') | ||
46 | return 0 | ||
47 | |||
48 | -- | conversion of Haskell functions into function pointers that can be used in the C side | ||
49 | foreign import ccall safe "wrapper" | ||
50 | mkVecfun :: (CInt -> Ptr Double -> Double) | ||
51 | -> IO( FunPtr (CInt -> Ptr Double -> Double)) | ||
52 | |||
53 | foreign import ccall safe "wrapper" | ||
54 | mkVecVecfun :: TVV -> IO (FunPtr TVV) | ||
55 | |||
56 | foreign import ccall safe "wrapper" | ||
57 | mkDoubleVecVecfun :: (Double -> TVV) -> IO (FunPtr (Double -> TVV)) | ||
58 | |||
59 | foreign import ccall safe "wrapper" | ||
60 | mkDoublefun :: (Double -> Double) -> IO (FunPtr (Double -> Double)) | ||
61 | |||
62 | aux_vTov :: (Vector Double -> Vector Double) -> TVV | ||
63 | aux_vTov f n p nr r = g where | ||
64 | v = f x | ||
65 | x = createV (fromIntegral n) copy "aux_vTov" | ||
66 | copy n' q = do | ||
67 | copyArray q p (fromIntegral n') | ||
68 | return 0 | ||
69 | g = do unsafeWith v $ \p' -> copyArray r p' (fromIntegral nr) | ||
70 | return 0 | ||
71 | |||
72 | foreign import ccall safe "wrapper" | ||
73 | mkVecMatfun :: TVM -> IO (FunPtr TVM) | ||
74 | |||
75 | foreign import ccall safe "wrapper" | ||
76 | mkDoubleVecMatfun :: (Double -> TVM) -> IO (FunPtr (Double -> TVM)) | ||
77 | |||
78 | aux_vTom :: (Vector Double -> Matrix Double) -> TVM | ||
79 | aux_vTom f n p rr cr r = g where | ||
80 | v = flatten $ f x | ||
81 | x = createV (fromIntegral n) copy "aux_vTov" | ||
82 | copy n' q = do | ||
83 | copyArray q p (fromIntegral n') | ||
84 | return 0 | ||
85 | g = do unsafeWith v $ \p' -> copyArray r p' (fromIntegral $ rr*cr) | ||
86 | return 0 | ||
87 | |||
88 | createV n fun msg = unsafePerformIO $ do | ||
89 | r <- createVector n | ||
90 | app1 fun vec r msg | ||
91 | return r | ||
92 | |||
93 | createMIO r c fun msg = do | ||
94 | res <- createMatrix RowMajor r c | ||
95 | app1 fun mat res msg | ||
96 | return res | ||
97 | |||
98 | -------------------------------------------------------------------------------- | ||
99 | |||
100 | -- | check the error code | ||
101 | check :: String -> IO CInt -> IO () | ||
102 | check msg f = do | ||
103 | err <- f | ||
104 | when (err/=0) $ do | ||
105 | ps <- gsl_strerror err | ||
106 | s <- peekCString ps | ||
107 | error (msg++": "++s) | ||
108 | return () | ||
109 | |||
110 | -- | description of GSL error codes | ||
111 | foreign import ccall unsafe "gsl_strerror" gsl_strerror :: CInt -> IO (Ptr CChar) | ||
112 | |||
113 | type PF = Ptr Float | ||
114 | type PD = Ptr Double | ||
115 | type PQ = Ptr (Complex Float) | ||
116 | type PC = Ptr (Complex Double) | ||
117 | |||
118 | type Res = IO CInt | ||
119 | type TV x = CInt -> PD -> x | ||
120 | type TM x = CInt -> CInt -> PD -> x | ||
121 | type TCV x = CInt -> PC -> x | ||
122 | type TCM x = CInt -> CInt -> PC -> x | ||
123 | |||
124 | type TVV = TV (TV Res) | ||
125 | type TVM = TV (TM Res) | ||
126 | |||