summaryrefslogtreecommitdiff
path: root/lib/Data
diff options
context:
space:
mode:
Diffstat (limited to 'lib/Data')
-rw-r--r--lib/Data/Packed/Internal/Common.hs80
-rw-r--r--lib/Data/Packed/Internal/Matrix.hs38
-rw-r--r--lib/Data/Packed/Internal/Vector.hs11
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
59infixl 0 // 59infixl 0 //
60(//) = flip ($) 60(//) = flip ($)
61 61
62-- | specialized fromIntegral
63fi :: Int -> CInt
64fi = fromIntegral
65
62-- hmm.. 66-- hmm..
63ww2 w1 o1 w2 o2 f = w1 o1 $ \a1 -> w2 o2 $ \a2 -> f a1 a2 67ww2 w1 o1 w2 o2 f = w1 o1 $ \a1 -> w2 o2 $ \a2 -> f a1 a2
64ww3 w1 o1 w2 o2 w3 o3 f = w1 o1 $ \a1 -> ww2 w2 o2 w3 o3 (f a1) 68ww3 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--------------------------------------------------
108type PD = Ptr Double -- 112type PD = Ptr Double --
109type PC = Ptr (Complex Double) -- 113type PC = Ptr (Complex Double) --
110type TV = Int -> PD -> IO CInt -- 114type TV = CInt -> PD -> IO CInt --
111type TVV = Int -> PD -> TV -- 115type TVV = CInt -> PD -> TV --
112type TVVV = Int -> PD -> TVV -- 116type TVVV = CInt -> PD -> TVV --
113type TM = Int -> Int -> PD -> IO CInt -- 117type TM = CInt -> CInt -> PD -> IO CInt --
114type TMM = Int -> Int -> PD -> TM -- 118type TMM = CInt -> CInt -> PD -> TM --
115type TMMM = Int -> Int -> PD -> TMM -- 119type TVMM = CInt -> PD -> TMM --
116type TVM = Int -> PD -> TM -- 120type TMVMM = CInt -> CInt -> PD -> TVMM --
117type TVVM = Int -> PD -> TVM -- 121type TMMM = CInt -> CInt -> PD -> TMM --
118type TMV = Int -> Int -> PD -> TV -- 122type TVM = CInt -> PD -> TM --
119type TMVM = Int -> Int -> PD -> TVM -- 123type TVVM = CInt -> PD -> TVM --
120type TMMVM = Int -> Int -> PD -> TMVM -- 124type TMV = CInt -> CInt -> PD -> TV --
121type TCM = Int -> Int -> PC -> IO CInt -- 125type TMMV = CInt -> CInt -> PD -> TMV --
122type TCVCM = Int -> PC -> TCM -- 126type TMVM = CInt -> CInt -> PD -> TVM --
123type TCMCVCM = Int -> Int -> PC -> TCVCM -- 127type TMMVM = CInt -> CInt -> PD -> TMVM --
124type TMCMCVCM = Int -> Int -> PD -> TCMCVCM -- 128type TCM = CInt -> CInt -> PC -> IO CInt --
125type TCMCMCVCM = Int -> Int -> PC -> TCMCVCM -- 129type TCVCM = CInt -> PC -> TCM --
126type TCMCM = Int -> Int -> PC -> TCM -- 130type TCMCVCM = CInt -> CInt -> PC -> TCVCM --
127type TVCM = Int -> PD -> TCM -- 131type TMCMCVCM = CInt -> CInt -> PD -> TCMCVCM --
128type TCMVCM = Int -> Int -> PC -> TVCM -- 132type TCMCMCVCM = CInt -> CInt -> PC -> TCMCVCM --
129type TCMCMVCM = Int -> Int -> PC -> TCMVCM -- 133type TCMCM = CInt -> CInt -> PC -> TCM --
130type TCMCMCM = Int -> Int -> PC -> TCMCM -- 134type TVCM = CInt -> PD -> TCM --
131type TCV = Int -> PC -> IO CInt -- 135type TCMVCM = CInt -> CInt -> PC -> TVCM --
132type TCVCV = Int -> PC -> TCV -- 136type TCMCMVCM = CInt -> CInt -> PC -> TCMVCM --
133type TCVCVCV = Int -> PC -> TCVCV -- 137type TCMCMCM = CInt -> CInt -> PC -> TCMCM --
134type TCMCV = Int -> Int -> PC -> TCV -- 138type TCV = CInt -> PC -> IO CInt --
135type TVCV = Int -> PD -> TCV -- 139type TCVCV = CInt -> PC -> TCV --
136type TCVM = Int -> PC -> TM -- 140type TCVCVCV = CInt -> PC -> TCVCV --
137type TMCVM = Int -> Int -> PD -> TCVM -- 141type TCMCV = CInt -> CInt -> PC -> TCV --
138type TMMCVM = Int -> Int -> PD -> TMCVM -- 142type TVCV = CInt -> PD -> TCV --
139------------------------------------------------ 143type TCVM = CInt -> PC -> TM --
144type TMCVM = CInt -> CInt -> PD -> TCVM --
145type TMMCVM = CInt -> CInt -> PD -> TMCVM --
146--------------------------------------------------
147
148type 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
83withMatrix MC {rows = r, cols = c, cdat = d } f = 83withMatrix 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
89withMatrix MF {rows = r, cols = c, fdat = d } f = 89withMatrix 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
257foreign import ccall unsafe "auxi.h transR" 257foreign import ccall unsafe "auxi.h transR" ctransR :: TMM
258 ctransR :: TMM -- Double ::> Double ::> IO Int 258foreign import ccall unsafe "auxi.h transC" ctransC :: TCMCM
259foreign import ccall unsafe "auxi.h transC"
260 ctransC :: TCMCM -- Complex Double ::> Complex Double ::> IO Int
261 259
262------------------------------------------------------------------ 260------------------------------------------------------------------
263 261
264gmatC MF { rows = r, cols = c } p f = f 1 c r p 262gmatC MF { rows = r, cols = c } p f = f 1 (fi c) (fi r) p
265gmatC MC { rows = r, cols = c } p f = f 0 r c p 263gmatC MC { rows = r, cols = c } p f = f 0 (fi r) (fi c) p
266 264
267dtt MC { cdat = d } = d 265dtt MC { cdat = d } = d
268dtt MF { fdat = d } = d 266dtt MF { fdat = d } = d
@@ -277,18 +275,10 @@ multiplyAux fun a b = unsafePerformIO $ do
277 return r 275 return r
278 276
279multiplyR = multiplyAux cmultiplyR 277multiplyR = multiplyAux cmultiplyR
280foreign import ccall unsafe "auxi.h multiplyR" 278foreign 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
286multiplyC = multiplyAux cmultiplyC 280multiplyC = multiplyAux cmultiplyC
287foreign import ccall unsafe "auxi.h multiplyC" 281foreign 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
294multiply :: (Element a) => Matrix a -> Matrix a -> Matrix a 284multiply :: (Element a) => Matrix a -> Matrix a -> Matrix a
@@ -301,9 +291,9 @@ subMatrixR :: (Int,Int) -> (Int,Int) -> Matrix Double -> Matrix Double
301subMatrixR (r0,c0) (rt,ct) x' = unsafePerformIO $ do 291subMatrixR (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
306foreign import ccall "auxi.h submatrixR" c_submatrixR :: Int -> Int -> Int -> Int -> TMM 296foreign 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
309subMatrixC :: (Int,Int) -> (Int,Int) -> Matrix (Complex Double) -> Matrix (Complex Double) 299subMatrixC :: (Int,Int) -> (Int,Int) -> Matrix (Complex Double) -> Matrix (Complex Double)
@@ -353,13 +343,11 @@ constantAux fun x n = unsafePerformIO $ do
353 343
354constantR :: Double -> Int -> Vector Double 344constantR :: Double -> Int -> Vector Double
355constantR = constantAux cconstantR 345constantR = constantAux cconstantR
356foreign import ccall "auxi.h constantR" 346foreign import ccall "auxi.h constantR" cconstantR :: Ptr Double -> TV
357 cconstantR :: Ptr Double -> TV -- Double :> IO Int
358 347
359constantC :: Complex Double -> Int -> Vector (Complex Double) 348constantC :: Complex Double -> Int -> Vector (Complex Double)
360constantC = constantAux cconstantC 349constantC = constantAux cconstantC
361foreign import ccall "auxi.h constantC" 350foreign 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
32type 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
38vec = withVector 29vec = withVector
39 30
40withVector (V n fp) f = withForeignPtr fp $ \p -> do 31withVector (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
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-09 21:06:54 +0000