diff options
Diffstat (limited to 'packages/hmatrix/src/Numeric/GSL/Internal.hs')
-rw-r--r-- | packages/hmatrix/src/Numeric/GSL/Internal.hs | 62 |
1 files changed, 56 insertions, 6 deletions
diff --git a/packages/hmatrix/src/Numeric/GSL/Internal.hs b/packages/hmatrix/src/Numeric/GSL/Internal.hs index 69a9750..a1c4e0c 100644 --- a/packages/hmatrix/src/Numeric/GSL/Internal.hs +++ b/packages/hmatrix/src/Numeric/GSL/Internal.hs | |||
@@ -1,23 +1,43 @@ | |||
1 | -- | | ||
1 | -- Module : Numeric.GSL.Internal | 2 | -- Module : Numeric.GSL.Internal |
2 | -- Copyright : (c) Alberto Ruiz 2009 | 3 | -- Copyright : (c) Alberto Ruiz 2009 |
3 | -- License : GPL | 4 | -- License : GPL |
4 | -- | 5 | -- Maintainer : Alberto Ruiz |
5 | -- Maintainer : Alberto Ruiz (aruiz at um dot es) | ||
6 | -- Stability : provisional | 6 | -- Stability : provisional |
7 | -- Portability : uses ffi | 7 | -- |
8 | -- | 8 | -- |
9 | -- Auxiliary functions. | 9 | -- Auxiliary functions. |
10 | -- | 10 | -- |
11 | -- #hide | ||
12 | 11 | ||
13 | module Numeric.GSL.Internal where | ||
14 | 12 | ||
15 | import Data.Packed.Internal | 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 | ||
16 | 33 | ||
17 | import Foreign.Marshal.Array(copyArray) | 34 | import Foreign.Marshal.Array(copyArray) |
18 | import Foreign.Ptr(Ptr, FunPtr) | 35 | import Foreign.Ptr(Ptr, FunPtr) |
19 | import Foreign.C.Types | 36 | import Foreign.C.Types |
37 | import Foreign.C.String(peekCString) | ||
20 | import System.IO.Unsafe(unsafePerformIO) | 38 | import System.IO.Unsafe(unsafePerformIO) |
39 | import Data.Vector.Storable(unsafeWith) | ||
40 | import Control.Monad(when) | ||
21 | 41 | ||
22 | iv :: (Vector Double -> Double) -> (CInt -> Ptr Double -> Double) | 42 | iv :: (Vector Double -> Double) -> (CInt -> Ptr Double -> Double) |
23 | iv f n p = f (createV (fromIntegral n) copy "iv") where | 43 | iv f n p = f (createV (fromIntegral n) copy "iv") where |
@@ -74,3 +94,33 @@ createMIO r c fun msg = do | |||
74 | res <- createMatrix RowMajor r c | 94 | res <- createMatrix RowMajor r c |
75 | app1 fun mat res msg | 95 | app1 fun mat res msg |
76 | return res | 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 | |||