summaryrefslogtreecommitdiff
path: root/lib/Data/Packed/Internal
diff options
context:
space:
mode:
Diffstat (limited to 'lib/Data/Packed/Internal')
-rw-r--r--lib/Data/Packed/Internal/Common.hs39
-rw-r--r--lib/Data/Packed/Internal/Matrix.hs25
-rw-r--r--lib/Data/Packed/Internal/Vector.hs9
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-}
88foreign import ccall "wrapper" mkfun:: (Double -> Ptr() -> Double) -> IO( FunPtr (Double -> Ptr() -> Double)) 88foreign 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------------------------------------------------
96type PD = Ptr Double --
97type PC = Ptr (Complex Double) --
98type TV = Int -> PD -> IO Int --
99type TVV = Int -> PD -> TV --
100type TVVV = Int -> PD -> TVV --
101type TM = Int -> Int -> PD -> IO Int --
102type TMM = Int -> Int -> PD -> TM --
103type TMMM = Int -> Int -> PD -> TMM --
104type TVM = Int -> PD -> TM --
105type TVVM = Int -> PD -> TVM --
106type TMV = Int -> Int -> PD -> TV --
107type TMVM = Int -> Int -> PD -> TVM --
108type TMMVM = Int -> Int -> PD -> TMVM --
109type TCM = Int -> Int -> PC -> IO Int --
110type TCVCM = Int -> PC -> TCM --
111type TCMCVCM = Int -> Int -> PC -> TCVCM --
112type TMCMCVCM = Int -> Int -> PD -> TCMCVCM --
113type TCMCMCVCM = Int -> Int -> PC -> TCMCVCM --
114type TCMCM = Int -> Int -> PC -> TCM --
115type TVCM = Int -> PD -> TCM --
116type TCMVCM = Int -> Int -> PC -> TVCM --
117type TCMCMVCM = Int -> Int -> PC -> TCMVCM --
118type TCMCMCM = Int -> Int -> PC -> TCMCM --
119type TCV = Int -> PC -> IO Int --
120type TCVCV = Int -> PC -> TCV --
121type TCVCVCV = Int -> PC -> TCVCV --
122type TCMCV = Int -> Int -> PC -> TCV --
123type TVCV = Int -> PD -> TCV --
124type TCVM = Int -> PC -> TM --
125type TMCVM = Int -> Int -> PD -> TCVM --
126type 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
52type Mt t s = Int -> Int -> Ptr t -> s 52type Mt t s = Int -> Int -> Ptr t -> s
53infixr 6 ::> 53-- not yet admitted by my haddock version
54type t ::> s = Mt t s 54-- infixr 6 ::>
55-- type t ::> s = Mt t s
55 56
56mat d m f = f (rows m) (cols m) (ptr (d m)) 57mat 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
119foreign import ccall safe "aux.h transR" 120foreign import ccall safe "aux.h transR"
120 ctransR :: Double ::> Double ::> IO Int 121 ctransR :: TMM -- Double ::> Double ::> IO Int
121foreign import ccall safe "aux.h transC" 122foreign 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
124transdata :: Field a => Int -> Vector a -> Int -> Vector a 125transdata :: Field a => Int -> Vector a -> Int -> Vector a
125transdata c1 d c2 | isReal baseOf d = scast $ transdataR c1 (scast d) c2 126transdata 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
172foreign import ccall safe "aux.h multiplyR" 173foreign 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
175foreign import ccall safe "aux.h multiplyC" 179foreign 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
178multiply :: (Num a, Field a) => MatrixOrder -> Matrix a -> Matrix a -> Matrix a 185multiply :: (Num a, Field a) => MatrixOrder -> Matrix a -> Matrix a -> Matrix a
179multiply RowMajor a b = multiplyD RowMajor a b 186multiply 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
208foreign import ccall "aux.h submatrixR" 215foreign 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
212subMatrixC :: (Int,Int) -- ^ (r0,c0) starting position 219subMatrixC :: (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
240diagR :: Vector Double -> Matrix Double 247diagR :: Vector Double -> Matrix Double
241diagR = diagAux c_diagR "diagR" 248diagR = diagAux c_diagR "diagR"
242foreign import ccall "aux.h diagR" c_diagR :: Double :> Double ::> IO Int 249foreign import ccall "aux.h diagR" c_diagR :: TVM
243 250
244-- | diagonal matrix from a real vector 251-- | diagonal matrix from a real vector
245diagC :: Vector (Complex Double) -> Matrix (Complex Double) 252diagC :: Vector (Complex Double) -> Matrix (Complex Double)
246diagC = diagAux c_diagC "diagC" 253diagC = diagAux c_diagC "diagC"
247foreign import ccall "aux.h diagC" c_diagC :: (Complex Double) :> (Complex Double) ::> IO Int 254foreign import ccall "aux.h diagC" c_diagC :: TCVCM
248 255
249-- | diagonal matrix from a vector 256-- | diagonal matrix from a vector
250diag :: (Num a, Field a) => Vector a -> Matrix a 257diag :: (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
21import Control.Monad(when) 21import Control.Monad(when)
22 22
23type Vc t s = Int -> Ptr t -> s 23type Vc t s = Int -> Ptr t -> s
24infixr 5 :> 24-- not yet admitted by my haddock version
25type t :> s = Vc t s 25-- infixr 5 :>
26-- type t :> s = Vc t s
26 27
27vec :: Vector t -> (Vc t s) -> s 28vec :: Vector t -> (Vc t s) -> s
28vec v f = f (dim v) (ptr v) 29vec 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
120foreign import ccall safe "aux.h constantR" 121foreign import ccall safe "aux.h constantR"
121 cconstantR :: Ptr Double -> Double :> IO Int 122 cconstantR :: Ptr Double -> TV -- Double :> IO Int
122 123
123foreign import ccall safe "aux.h constantC" 124foreign 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
126constant :: Field a => Int -> a -> Vector a 127constant :: Field a => Int -> a -> Vector a
127constant n x | isReal id x = scast $ constantR n (scast x) 128constant n x | isReal id x = scast $ constantR n (scast x)