diff options
Diffstat (limited to 'lib/Data/Packed/Internal')
-rw-r--r-- | lib/Data/Packed/Internal/Common.hs | 39 | ||||
-rw-r--r-- | lib/Data/Packed/Internal/Matrix.hs | 25 | ||||
-rw-r--r-- | lib/Data/Packed/Internal/Vector.hs | 9 |
3 files changed, 60 insertions, 13 deletions
diff --git a/lib/Data/Packed/Internal/Common.hs b/lib/Data/Packed/Internal/Common.hs index 91985f7..bdd7f34 100644 --- a/lib/Data/Packed/Internal/Common.hs +++ b/lib/Data/Packed/Internal/Common.hs | |||
@@ -86,3 +86,42 @@ scast = fromJust . cast | |||
86 | {- | conversion of Haskell functions into function pointers that can be used in the C side | 86 | {- | conversion of Haskell functions into function pointers that can be used in the C side |
87 | -} | 87 | -} |
88 | foreign import ccall "wrapper" mkfun:: (Double -> Ptr() -> Double) -> IO( FunPtr (Double -> Ptr() -> Double)) | 88 | foreign import ccall "wrapper" mkfun:: (Double -> Ptr() -> Double) -> IO( FunPtr (Double -> Ptr() -> Double)) |
89 | |||
90 | --------------------------------------------------- | ||
91 | -- ugly, but my haddock version doesn't understand | ||
92 | -- yet infix type constructors | ||
93 | --------------------------------------------------- | ||
94 | ---------- signatures of the C functions ------- | ||
95 | ------------------------------------------------ | ||
96 | type PD = Ptr Double -- | ||
97 | type PC = Ptr (Complex Double) -- | ||
98 | type TV = Int -> PD -> IO Int -- | ||
99 | type TVV = Int -> PD -> TV -- | ||
100 | type TVVV = Int -> PD -> TVV -- | ||
101 | type TM = Int -> Int -> PD -> IO Int -- | ||
102 | type TMM = Int -> Int -> PD -> TM -- | ||
103 | type TMMM = Int -> Int -> PD -> TMM -- | ||
104 | type TVM = Int -> PD -> TM -- | ||
105 | type TVVM = Int -> PD -> TVM -- | ||
106 | type TMV = Int -> Int -> PD -> TV -- | ||
107 | type TMVM = Int -> Int -> PD -> TVM -- | ||
108 | type TMMVM = Int -> Int -> PD -> TMVM -- | ||
109 | type TCM = Int -> Int -> PC -> IO Int -- | ||
110 | type TCVCM = Int -> PC -> TCM -- | ||
111 | type TCMCVCM = Int -> Int -> PC -> TCVCM -- | ||
112 | type TMCMCVCM = Int -> Int -> PD -> TCMCVCM -- | ||
113 | type TCMCMCVCM = Int -> Int -> PC -> TCMCVCM -- | ||
114 | type TCMCM = Int -> Int -> PC -> TCM -- | ||
115 | type TVCM = Int -> PD -> TCM -- | ||
116 | type TCMVCM = Int -> Int -> PC -> TVCM -- | ||
117 | type TCMCMVCM = Int -> Int -> PC -> TCMVCM -- | ||
118 | type TCMCMCM = Int -> Int -> PC -> TCMCM -- | ||
119 | type TCV = Int -> PC -> IO Int -- | ||
120 | type TCVCV = Int -> PC -> TCV -- | ||
121 | type TCVCVCV = Int -> PC -> TCVCV -- | ||
122 | type TCMCV = Int -> Int -> PC -> TCV -- | ||
123 | type TVCV = Int -> PD -> TCV -- | ||
124 | type TCVM = Int -> PC -> TM -- | ||
125 | type TMCVM = Int -> Int -> PD -> TCVM -- | ||
126 | type TMMCVM = Int -> Int -> PD -> TMCVM -- | ||
127 | ------------------------------------------------ | ||
diff --git a/lib/Data/Packed/Internal/Matrix.hs b/lib/Data/Packed/Internal/Matrix.hs index fccf8bb..2925fc0 100644 --- a/lib/Data/Packed/Internal/Matrix.hs +++ b/lib/Data/Packed/Internal/Matrix.hs | |||
@@ -50,8 +50,9 @@ trans m = m { rows = cols m | |||
50 | } | 50 | } |
51 | 51 | ||
52 | type Mt t s = Int -> Int -> Ptr t -> s | 52 | type Mt t s = Int -> Int -> Ptr t -> s |
53 | infixr 6 ::> | 53 | -- not yet admitted by my haddock version |
54 | type t ::> s = Mt t s | 54 | -- infixr 6 ::> |
55 | -- type t ::> s = Mt t s | ||
55 | 56 | ||
56 | mat d m f = f (rows m) (cols m) (ptr (d m)) | 57 | mat d m f = f (rows m) (cols m) (ptr (d m)) |
57 | 58 | ||
@@ -117,9 +118,9 @@ transdataAux fun c1 d c2 = | |||
117 | noneed = r1 == 1 || c1 == 1 | 118 | noneed = r1 == 1 || c1 == 1 |
118 | 119 | ||
119 | foreign import ccall safe "aux.h transR" | 120 | foreign import ccall safe "aux.h transR" |
120 | ctransR :: Double ::> Double ::> IO Int | 121 | ctransR :: TMM -- Double ::> Double ::> IO Int |
121 | foreign import ccall safe "aux.h transC" | 122 | foreign import ccall safe "aux.h transC" |
122 | ctransC :: Complex Double ::> Complex Double ::> IO Int | 123 | ctransC :: TCMCM -- Complex Double ::> Complex Double ::> IO Int |
123 | 124 | ||
124 | transdata :: Field a => Int -> Vector a -> Int -> Vector a | 125 | transdata :: Field a => Int -> Vector a -> Int -> Vector a |
125 | transdata c1 d c2 | isReal baseOf d = scast $ transdataR c1 (scast d) c2 | 126 | transdata c1 d c2 | isReal baseOf d = scast $ transdataR c1 (scast d) c2 |
@@ -170,10 +171,16 @@ multiplyAux order fun a b = unsafePerformIO $ do | |||
170 | return r | 171 | return r |
171 | 172 | ||
172 | foreign import ccall safe "aux.h multiplyR" | 173 | foreign import ccall safe "aux.h multiplyR" |
173 | cmultiplyR :: Int -> Double ::> (Int -> Double ::> (Double ::> IO Int)) | 174 | cmultiplyR :: Int -> Int -> Int -> Ptr Double |
175 | -> Int -> Int -> Int -> Ptr Double | ||
176 | -> Int -> Int -> Ptr Double | ||
177 | -> IO Int | ||
174 | 178 | ||
175 | foreign import ccall safe "aux.h multiplyC" | 179 | foreign import ccall safe "aux.h multiplyC" |
176 | cmultiplyC :: Int -> Complex Double ::> (Int -> Complex Double ::> (Complex Double ::> IO Int)) | 180 | cmultiplyC :: Int -> Int -> Int -> Ptr (Complex Double) |
181 | -> Int -> Int -> Int -> Ptr (Complex Double) | ||
182 | -> Int -> Int -> Ptr (Complex Double) | ||
183 | -> IO Int | ||
177 | 184 | ||
178 | multiply :: (Num a, Field a) => MatrixOrder -> Matrix a -> Matrix a -> Matrix a | 185 | multiply :: (Num a, Field a) => MatrixOrder -> Matrix a -> Matrix a -> Matrix a |
179 | multiply RowMajor a b = multiplyD RowMajor a b | 186 | multiply RowMajor a b = multiplyD RowMajor a b |
@@ -206,7 +213,7 @@ subMatrixR (r0,c0) (rt,ct) x = unsafePerformIO $ do | |||
206 | c_submatrixR r0 (r0+rt-1) c0 (c0+ct-1) // mat cdat x // mat cdat r // check "subMatrixR" [dat r] | 213 | c_submatrixR r0 (r0+rt-1) c0 (c0+ct-1) // mat cdat x // mat cdat r // check "subMatrixR" [dat r] |
207 | return r | 214 | return r |
208 | foreign import ccall "aux.h submatrixR" | 215 | foreign import ccall "aux.h submatrixR" |
209 | c_submatrixR :: Int -> Int -> Int -> Int -> Double ::> Double ::> IO Int | 216 | c_submatrixR :: Int -> Int -> Int -> Int -> TMM |
210 | 217 | ||
211 | -- | extraction of a submatrix of a complex matrix | 218 | -- | extraction of a submatrix of a complex matrix |
212 | subMatrixC :: (Int,Int) -- ^ (r0,c0) starting position | 219 | subMatrixC :: (Int,Int) -- ^ (r0,c0) starting position |
@@ -239,12 +246,12 @@ diagAux fun msg (v@V {dim = n}) = unsafePerformIO $ do | |||
239 | -- | diagonal matrix from a real vector | 246 | -- | diagonal matrix from a real vector |
240 | diagR :: Vector Double -> Matrix Double | 247 | diagR :: Vector Double -> Matrix Double |
241 | diagR = diagAux c_diagR "diagR" | 248 | diagR = diagAux c_diagR "diagR" |
242 | foreign import ccall "aux.h diagR" c_diagR :: Double :> Double ::> IO Int | 249 | foreign import ccall "aux.h diagR" c_diagR :: TVM |
243 | 250 | ||
244 | -- | diagonal matrix from a real vector | 251 | -- | diagonal matrix from a real vector |
245 | diagC :: Vector (Complex Double) -> Matrix (Complex Double) | 252 | diagC :: Vector (Complex Double) -> Matrix (Complex Double) |
246 | diagC = diagAux c_diagC "diagC" | 253 | diagC = diagAux c_diagC "diagC" |
247 | foreign import ccall "aux.h diagC" c_diagC :: (Complex Double) :> (Complex Double) ::> IO Int | 254 | foreign import ccall "aux.h diagC" c_diagC :: TCVCM |
248 | 255 | ||
249 | -- | diagonal matrix from a vector | 256 | -- | diagonal matrix from a vector |
250 | diag :: (Num a, Field a) => Vector a -> Matrix a | 257 | diag :: (Num a, Field a) => Vector a -> Matrix a |
diff --git a/lib/Data/Packed/Internal/Vector.hs b/lib/Data/Packed/Internal/Vector.hs index 125df1e..8848062 100644 --- a/lib/Data/Packed/Internal/Vector.hs +++ b/lib/Data/Packed/Internal/Vector.hs | |||
@@ -21,8 +21,9 @@ import Complex | |||
21 | import Control.Monad(when) | 21 | import Control.Monad(when) |
22 | 22 | ||
23 | type Vc t s = Int -> Ptr t -> s | 23 | type Vc t s = Int -> Ptr t -> s |
24 | infixr 5 :> | 24 | -- not yet admitted by my haddock version |
25 | type t :> s = Vc t s | 25 | -- infixr 5 :> |
26 | -- type t :> s = Vc t s | ||
26 | 27 | ||
27 | vec :: Vector t -> (Vc t s) -> s | 28 | vec :: Vector t -> (Vc t s) -> s |
28 | vec v f = f (dim v) (ptr v) | 29 | vec v f = f (dim v) (ptr v) |
@@ -118,10 +119,10 @@ constantAux fun n x = unsafePerformIO $ do | |||
118 | return v | 119 | return v |
119 | 120 | ||
120 | foreign import ccall safe "aux.h constantR" | 121 | foreign import ccall safe "aux.h constantR" |
121 | cconstantR :: Ptr Double -> Double :> IO Int | 122 | cconstantR :: Ptr Double -> TV -- Double :> IO Int |
122 | 123 | ||
123 | foreign import ccall safe "aux.h constantC" | 124 | foreign import ccall safe "aux.h constantC" |
124 | cconstantC :: Ptr (Complex Double) -> Complex Double :> IO Int | 125 | cconstantC :: Ptr (Complex Double) -> TCV -- Complex Double :> IO Int |
125 | 126 | ||
126 | constant :: Field a => Int -> a -> Vector a | 127 | constant :: Field a => Int -> a -> Vector a |
127 | constant n x | isReal id x = scast $ constantR n (scast x) | 128 | constant n x | isReal id x = scast $ constantR n (scast x) |