diff options
author | Alberto Ruiz <aruiz@um.es> | 2008-01-22 13:06:13 +0000 |
---|---|---|
committer | Alberto Ruiz <aruiz@um.es> | 2008-01-22 13:06:13 +0000 |
commit | baeb3890896e424e57582b108f7419f4ae479c42 (patch) | |
tree | 09d805dc1460e0530f9e55c31707c65cecb54aa9 /lib/Data/Packed | |
parent | e92696514c8861e7bed7abb434ca24527861c05c (diff) |
CInt in all imports
Diffstat (limited to 'lib/Data/Packed')
-rw-r--r-- | lib/Data/Packed/Internal/Common.hs | 80 | ||||
-rw-r--r-- | lib/Data/Packed/Internal/Matrix.hs | 38 | ||||
-rw-r--r-- | lib/Data/Packed/Internal/Vector.hs | 11 |
3 files changed, 60 insertions, 69 deletions
diff --git a/lib/Data/Packed/Internal/Common.hs b/lib/Data/Packed/Internal/Common.hs index 8930cbb..5ac4f5a 100644 --- a/lib/Data/Packed/Internal/Common.hs +++ b/lib/Data/Packed/Internal/Common.hs | |||
@@ -59,6 +59,10 @@ common f = commonval . map f where | |||
59 | infixl 0 // | 59 | infixl 0 // |
60 | (//) = flip ($) | 60 | (//) = flip ($) |
61 | 61 | ||
62 | -- | specialized fromIntegral | ||
63 | fi :: Int -> CInt | ||
64 | fi = fromIntegral | ||
65 | |||
62 | -- hmm.. | 66 | -- hmm.. |
63 | ww2 w1 o1 w2 o2 f = w1 o1 $ \a1 -> w2 o2 $ \a2 -> f a1 a2 | 67 | ww2 w1 o1 w2 o2 f = w1 o1 $ \a1 -> w2 o2 $ \a2 -> f a1 a2 |
64 | ww3 w1 o1 w2 o2 w3 o3 f = w1 o1 $ \a1 -> ww2 w2 o2 w3 o3 (f a1) | 68 | ww3 w1 o1 w2 o2 w3 o3 f = w1 o1 $ \a1 -> ww2 w2 o2 w3 o3 (f a1) |
@@ -103,37 +107,45 @@ foreign import ccall "auxi.h gsl_strerror" gsl_strerror :: CInt -> IO (Ptr CChar | |||
103 | -- ugly, but my haddock version doesn't understand | 107 | -- ugly, but my haddock version doesn't understand |
104 | -- yet infix type constructors | 108 | -- yet infix type constructors |
105 | --------------------------------------------------- | 109 | --------------------------------------------------- |
106 | ---------- signatures of the C functions ------- | 110 | ---------- signatures of the C functions --------- |
107 | ------------------------------------------------ | 111 | -------------------------------------------------- |
108 | type PD = Ptr Double -- | 112 | type PD = Ptr Double -- |
109 | type PC = Ptr (Complex Double) -- | 113 | type PC = Ptr (Complex Double) -- |
110 | type TV = Int -> PD -> IO CInt -- | 114 | type TV = CInt -> PD -> IO CInt -- |
111 | type TVV = Int -> PD -> TV -- | 115 | type TVV = CInt -> PD -> TV -- |
112 | type TVVV = Int -> PD -> TVV -- | 116 | type TVVV = CInt -> PD -> TVV -- |
113 | type TM = Int -> Int -> PD -> IO CInt -- | 117 | type TM = CInt -> CInt -> PD -> IO CInt -- |
114 | type TMM = Int -> Int -> PD -> TM -- | 118 | type TMM = CInt -> CInt -> PD -> TM -- |
115 | type TMMM = Int -> Int -> PD -> TMM -- | 119 | type TVMM = CInt -> PD -> TMM -- |
116 | type TVM = Int -> PD -> TM -- | 120 | type TMVMM = CInt -> CInt -> PD -> TVMM -- |
117 | type TVVM = Int -> PD -> TVM -- | 121 | type TMMM = CInt -> CInt -> PD -> TMM -- |
118 | type TMV = Int -> Int -> PD -> TV -- | 122 | type TVM = CInt -> PD -> TM -- |
119 | type TMVM = Int -> Int -> PD -> TVM -- | 123 | type TVVM = CInt -> PD -> TVM -- |
120 | type TMMVM = Int -> Int -> PD -> TMVM -- | 124 | type TMV = CInt -> CInt -> PD -> TV -- |
121 | type TCM = Int -> Int -> PC -> IO CInt -- | 125 | type TMMV = CInt -> CInt -> PD -> TMV -- |
122 | type TCVCM = Int -> PC -> TCM -- | 126 | type TMVM = CInt -> CInt -> PD -> TVM -- |
123 | type TCMCVCM = Int -> Int -> PC -> TCVCM -- | 127 | type TMMVM = CInt -> CInt -> PD -> TMVM -- |
124 | type TMCMCVCM = Int -> Int -> PD -> TCMCVCM -- | 128 | type TCM = CInt -> CInt -> PC -> IO CInt -- |
125 | type TCMCMCVCM = Int -> Int -> PC -> TCMCVCM -- | 129 | type TCVCM = CInt -> PC -> TCM -- |
126 | type TCMCM = Int -> Int -> PC -> TCM -- | 130 | type TCMCVCM = CInt -> CInt -> PC -> TCVCM -- |
127 | type TVCM = Int -> PD -> TCM -- | 131 | type TMCMCVCM = CInt -> CInt -> PD -> TCMCVCM -- |
128 | type TCMVCM = Int -> Int -> PC -> TVCM -- | 132 | type TCMCMCVCM = CInt -> CInt -> PC -> TCMCVCM -- |
129 | type TCMCMVCM = Int -> Int -> PC -> TCMVCM -- | 133 | type TCMCM = CInt -> CInt -> PC -> TCM -- |
130 | type TCMCMCM = Int -> Int -> PC -> TCMCM -- | 134 | type TVCM = CInt -> PD -> TCM -- |
131 | type TCV = Int -> PC -> IO CInt -- | 135 | type TCMVCM = CInt -> CInt -> PC -> TVCM -- |
132 | type TCVCV = Int -> PC -> TCV -- | 136 | type TCMCMVCM = CInt -> CInt -> PC -> TCMVCM -- |
133 | type TCVCVCV = Int -> PC -> TCVCV -- | 137 | type TCMCMCM = CInt -> CInt -> PC -> TCMCM -- |
134 | type TCMCV = Int -> Int -> PC -> TCV -- | 138 | type TCV = CInt -> PC -> IO CInt -- |
135 | type TVCV = Int -> PD -> TCV -- | 139 | type TCVCV = CInt -> PC -> TCV -- |
136 | type TCVM = Int -> PC -> TM -- | 140 | type TCVCVCV = CInt -> PC -> TCVCV -- |
137 | type TMCVM = Int -> Int -> PD -> TCVM -- | 141 | type TCMCV = CInt -> CInt -> PC -> TCV -- |
138 | type TMMCVM = Int -> Int -> PD -> TMCVM -- | 142 | type TVCV = CInt -> PD -> TCV -- |
139 | ------------------------------------------------ | 143 | type TCVM = CInt -> PC -> TM -- |
144 | type TMCVM = CInt -> CInt -> PD -> TCVM -- | ||
145 | type TMMCVM = CInt -> CInt -> PD -> TMCVM -- | ||
146 | -------------------------------------------------- | ||
147 | |||
148 | type TauxMul a = CInt -> CInt -> CInt -> Ptr a | ||
149 | -> CInt -> CInt -> CInt -> Ptr a | ||
150 | -> CInt -> CInt -> Ptr a | ||
151 | -> IO CInt | ||
diff --git a/lib/Data/Packed/Internal/Matrix.hs b/lib/Data/Packed/Internal/Matrix.hs index c20726b..86c5915 100644 --- a/lib/Data/Packed/Internal/Matrix.hs +++ b/lib/Data/Packed/Internal/Matrix.hs | |||
@@ -83,13 +83,13 @@ mat = withMatrix | |||
83 | withMatrix MC {rows = r, cols = c, cdat = d } f = | 83 | withMatrix MC {rows = r, cols = c, cdat = d } f = |
84 | withForeignPtr (fptr d) $ \p -> do | 84 | withForeignPtr (fptr d) $ \p -> do |
85 | let m g = do | 85 | let m g = do |
86 | g r c p | 86 | g (fi r) (fi c) p |
87 | f m | 87 | f m |
88 | 88 | ||
89 | withMatrix MF {rows = r, cols = c, fdat = d } f = | 89 | withMatrix MF {rows = r, cols = c, fdat = d } f = |
90 | withForeignPtr (fptr d) $ \p -> do | 90 | withForeignPtr (fptr d) $ \p -> do |
91 | let m g = do | 91 | let m g = do |
92 | g r c p | 92 | g (fi r) (fi c) p |
93 | f m | 93 | f m |
94 | 94 | ||
95 | {- | Creates a vector by concatenation of rows | 95 | {- | Creates a vector by concatenation of rows |
@@ -247,22 +247,20 @@ transdataAux fun c1 d c2 = | |||
247 | v <- createVector (dim d) | 247 | v <- createVector (dim d) |
248 | withForeignPtr (fptr d) $ \pd -> | 248 | withForeignPtr (fptr d) $ \pd -> |
249 | withForeignPtr (fptr v) $ \pv -> | 249 | withForeignPtr (fptr v) $ \pv -> |
250 | fun r1 c1 pd r2 c2 pv // check "transdataAux" | 250 | fun (fi r1) (fi c1) pd (fi r2) (fi c2) pv // check "transdataAux" |
251 | -- putStrLn $ "---> transdataAux" ++ show (toList d) ++ show (toList v) | 251 | -- putStrLn $ "---> transdataAux" ++ show (toList d) ++ show (toList v) |
252 | return v | 252 | return v |
253 | where r1 = dim d `div` c1 | 253 | where r1 = dim d `div` c1 |
254 | r2 = dim d `div` c2 | 254 | r2 = dim d `div` c2 |
255 | noneed = r1 == 1 || c1 == 1 | 255 | noneed = r1 == 1 || c1 == 1 |
256 | 256 | ||
257 | foreign import ccall unsafe "auxi.h transR" | 257 | foreign import ccall unsafe "auxi.h transR" ctransR :: TMM |
258 | ctransR :: TMM -- Double ::> Double ::> IO Int | 258 | foreign import ccall unsafe "auxi.h transC" ctransC :: TCMCM |
259 | foreign import ccall unsafe "auxi.h transC" | ||
260 | ctransC :: TCMCM -- Complex Double ::> Complex Double ::> IO Int | ||
261 | 259 | ||
262 | ------------------------------------------------------------------ | 260 | ------------------------------------------------------------------ |
263 | 261 | ||
264 | gmatC MF { rows = r, cols = c } p f = f 1 c r p | 262 | gmatC MF { rows = r, cols = c } p f = f 1 (fi c) (fi r) p |
265 | gmatC MC { rows = r, cols = c } p f = f 0 r c p | 263 | gmatC MC { rows = r, cols = c } p f = f 0 (fi r) (fi c) p |
266 | 264 | ||
267 | dtt MC { cdat = d } = d | 265 | dtt MC { cdat = d } = d |
268 | dtt MF { fdat = d } = d | 266 | dtt MF { fdat = d } = d |
@@ -277,18 +275,10 @@ multiplyAux fun a b = unsafePerformIO $ do | |||
277 | return r | 275 | return r |
278 | 276 | ||
279 | multiplyR = multiplyAux cmultiplyR | 277 | multiplyR = multiplyAux cmultiplyR |
280 | foreign import ccall unsafe "auxi.h multiplyR" | 278 | foreign import ccall unsafe "auxi.h multiplyR" cmultiplyR :: TauxMul Double |
281 | cmultiplyR :: Int -> Int -> Int -> Ptr Double | ||
282 | -> Int -> Int -> Int -> Ptr Double | ||
283 | -> Int -> Int -> Ptr Double | ||
284 | -> IO CInt | ||
285 | 279 | ||
286 | multiplyC = multiplyAux cmultiplyC | 280 | multiplyC = multiplyAux cmultiplyC |
287 | foreign import ccall unsafe "auxi.h multiplyC" | 281 | foreign import ccall unsafe "auxi.h multiplyC" cmultiplyC :: TauxMul (Complex Double) |
288 | cmultiplyC :: Int -> Int -> Int -> Ptr (Complex Double) | ||
289 | -> Int -> Int -> Int -> Ptr (Complex Double) | ||
290 | -> Int -> Int -> Ptr (Complex Double) | ||
291 | -> IO CInt | ||
292 | 282 | ||
293 | -- | matrix product | 283 | -- | matrix product |
294 | multiply :: (Element a) => Matrix a -> Matrix a -> Matrix a | 284 | multiply :: (Element a) => Matrix a -> Matrix a -> Matrix a |
@@ -301,9 +291,9 @@ subMatrixR :: (Int,Int) -> (Int,Int) -> Matrix Double -> Matrix Double | |||
301 | subMatrixR (r0,c0) (rt,ct) x' = unsafePerformIO $ do | 291 | subMatrixR (r0,c0) (rt,ct) x' = unsafePerformIO $ do |
302 | r <- createMatrix RowMajor rt ct | 292 | r <- createMatrix RowMajor rt ct |
303 | let x = cmat x' | 293 | let x = cmat x' |
304 | app2 (c_submatrixR r0 (r0+rt-1) c0 (c0+ct-1)) mat x mat r "subMatrixR" | 294 | app2 (c_submatrixR (fi r0) (fi $ r0+rt-1) (fi c0) (fi $ c0+ct-1)) mat x mat r "subMatrixR" |
305 | return r | 295 | return r |
306 | foreign import ccall "auxi.h submatrixR" c_submatrixR :: Int -> Int -> Int -> Int -> TMM | 296 | foreign import ccall "auxi.h submatrixR" c_submatrixR :: CInt -> CInt -> CInt -> CInt -> TMM |
307 | 297 | ||
308 | -- | extraction of a submatrix from a complex matrix | 298 | -- | extraction of a submatrix from a complex matrix |
309 | subMatrixC :: (Int,Int) -> (Int,Int) -> Matrix (Complex Double) -> Matrix (Complex Double) | 299 | subMatrixC :: (Int,Int) -> (Int,Int) -> Matrix (Complex Double) -> Matrix (Complex Double) |
@@ -353,13 +343,11 @@ constantAux fun x n = unsafePerformIO $ do | |||
353 | 343 | ||
354 | constantR :: Double -> Int -> Vector Double | 344 | constantR :: Double -> Int -> Vector Double |
355 | constantR = constantAux cconstantR | 345 | constantR = constantAux cconstantR |
356 | foreign import ccall "auxi.h constantR" | 346 | foreign import ccall "auxi.h constantR" cconstantR :: Ptr Double -> TV |
357 | cconstantR :: Ptr Double -> TV -- Double :> IO Int | ||
358 | 347 | ||
359 | constantC :: Complex Double -> Int -> Vector (Complex Double) | 348 | constantC :: Complex Double -> Int -> Vector (Complex Double) |
360 | constantC = constantAux cconstantC | 349 | constantC = constantAux cconstantC |
361 | foreign import ccall "auxi.h constantC" | 350 | foreign import ccall "auxi.h constantC" cconstantC :: Ptr (Complex Double) -> TCV |
362 | cconstantC :: Ptr (Complex Double) -> TCV -- Complex Double :> IO Int | ||
363 | 351 | ||
364 | {- | creates a vector with a given number of equal components: | 352 | {- | creates a vector with a given number of equal components: |
365 | 353 | ||
diff --git a/lib/Data/Packed/Internal/Vector.hs b/lib/Data/Packed/Internal/Vector.hs index ac6588b..1075e64 100644 --- a/lib/Data/Packed/Internal/Vector.hs +++ b/lib/Data/Packed/Internal/Vector.hs | |||
@@ -26,20 +26,11 @@ data Vector t = V { dim :: Int -- ^ number of elements | |||
26 | , fptr :: ForeignPtr t -- ^ foreign pointer to the memory block | 26 | , fptr :: ForeignPtr t -- ^ foreign pointer to the memory block |
27 | } | 27 | } |
28 | 28 | ||
29 | --ptr (V _ fptr) = unsafeForeignPtrToPtr fptr | ||
30 | |||
31 | -- | signature of foreign functions admitting C-style vectors | ||
32 | type Vc t s = Int -> Ptr t -> s | ||
33 | -- not yet admitted by my haddock version | ||
34 | -- infixr 5 :> | ||
35 | -- type t :> s = Vc t s | ||
36 | |||
37 | |||
38 | vec = withVector | 29 | vec = withVector |
39 | 30 | ||
40 | withVector (V n fp) f = withForeignPtr fp $ \p -> do | 31 | withVector (V n fp) f = withForeignPtr fp $ \p -> do |
41 | let v g = do | 32 | let v g = do |
42 | g n p | 33 | g (fi n) p |
43 | f v | 34 | f v |
44 | 35 | ||
45 | -- | allocates memory for a new vector | 36 | -- | allocates memory for a new vector |