diff options
Diffstat (limited to 'lib/Data/Packed/Internal')
-rw-r--r-- | lib/Data/Packed/Internal/Common.hs | 38 | ||||
-rw-r--r-- | lib/Data/Packed/Internal/Matrix.hs | 9 | ||||
-rw-r--r-- | lib/Data/Packed/Internal/Vector.hs | 5 |
3 files changed, 50 insertions, 2 deletions
diff --git a/lib/Data/Packed/Internal/Common.hs b/lib/Data/Packed/Internal/Common.hs index 2310f5f..879dade 100644 --- a/lib/Data/Packed/Internal/Common.hs +++ b/lib/Data/Packed/Internal/Common.hs | |||
@@ -60,6 +60,44 @@ ww2 w1 o1 w2 o2 f = w1 o1 $ \a1 -> w2 o2 $ \a2 -> f a1 a2 | |||
60 | ww3 w1 o1 w2 o2 w3 o3 f = w1 o1 $ \a1 -> ww2 w2 o2 w3 o3 (f a1) | 60 | ww3 w1 o1 w2 o2 w3 o3 f = w1 o1 $ \a1 -> ww2 w2 o2 w3 o3 (f a1) |
61 | ww4 w1 o1 w2 o2 w3 o3 w4 o4 f = w1 o1 $ \a1 -> ww3 w2 o2 w3 o3 w4 o4 (f a1) | 61 | ww4 w1 o1 w2 o2 w3 o3 w4 o4 f = w1 o1 $ \a1 -> ww3 w2 o2 w3 o3 w4 o4 (f a1) |
62 | 62 | ||
63 | type Adapt f t r = t -> ((f -> r) -> IO()) -> IO() | ||
64 | |||
65 | app1 :: f | ||
66 | -> Adapt f t (IO CInt) | ||
67 | -> t | ||
68 | -> String | ||
69 | -> IO() | ||
70 | |||
71 | app2 :: f | ||
72 | -> Adapt f t1 r | ||
73 | -> t1 | ||
74 | -> Adapt r t2 (IO CInt) | ||
75 | -> t2 | ||
76 | -> String | ||
77 | -> IO() | ||
78 | |||
79 | app3 :: f | ||
80 | -> Adapt f t1 r1 | ||
81 | -> t1 | ||
82 | -> Adapt r1 t2 r2 | ||
83 | -> t2 | ||
84 | -> Adapt r2 t3 (IO CInt) | ||
85 | -> t3 | ||
86 | -> String | ||
87 | -> IO() | ||
88 | |||
89 | app4 :: f | ||
90 | -> Adapt f t1 r1 | ||
91 | -> t1 | ||
92 | -> Adapt r1 t2 r2 | ||
93 | -> t2 | ||
94 | -> Adapt r2 t3 r3 | ||
95 | -> t3 | ||
96 | -> Adapt r3 t4 (IO CInt) | ||
97 | -> t4 | ||
98 | -> String | ||
99 | -> IO() | ||
100 | |||
63 | app1 f w1 o1 s = w1 o1 $ \a1 -> f // a1 // check s | 101 | app1 f w1 o1 s = w1 o1 $ \a1 -> f // a1 // check s |
64 | app2 f w1 o1 w2 o2 s = ww2 w1 o1 w2 o2 $ \a1 a2 -> f // a1 // a2 // check s | 102 | app2 f w1 o1 w2 o2 s = ww2 w1 o1 w2 o2 $ \a1 a2 -> f // a1 // a2 // check s |
65 | app3 f w1 o1 w2 o2 w3 o3 s = ww3 w1 o1 w2 o2 w3 o3 $ | 103 | app3 f w1 o1 w2 o2 w3 o3 s = ww3 w1 o1 w2 o2 w3 o3 $ |
diff --git a/lib/Data/Packed/Internal/Matrix.hs b/lib/Data/Packed/Internal/Matrix.hs index 13ffc34..8a074a6 100644 --- a/lib/Data/Packed/Internal/Matrix.hs +++ b/lib/Data/Packed/Internal/Matrix.hs | |||
@@ -74,6 +74,7 @@ data Matrix t = MC { rows :: {-# UNPACK #-} !Int | |||
74 | xdat MC {cdat = d } = d | 74 | xdat MC {cdat = d } = d |
75 | xdat MF {fdat = d } = d | 75 | xdat MF {fdat = d } = d |
76 | 76 | ||
77 | orderOf :: Matrix t -> MatrixOrder | ||
77 | orderOf MF{} = ColumnMajor | 78 | orderOf MF{} = ColumnMajor |
78 | orderOf MC{} = RowMajor | 79 | orderOf MC{} = RowMajor |
79 | 80 | ||
@@ -82,12 +83,16 @@ trans :: Matrix t -> Matrix t | |||
82 | trans MC {rows = r, cols = c, cdat = d } = MF {rows = c, cols = r, fdat = d } | 83 | trans MC {rows = r, cols = c, cdat = d } = MF {rows = c, cols = r, fdat = d } |
83 | trans MF {rows = r, cols = c, fdat = d } = MC {rows = c, cols = r, cdat = d } | 84 | trans MF {rows = r, cols = c, fdat = d } = MC {rows = c, cols = r, cdat = d } |
84 | 85 | ||
86 | cmat :: (Element t) => Matrix t -> Matrix t | ||
85 | cmat m@MC{} = m | 87 | cmat m@MC{} = m |
86 | cmat MF {rows = r, cols = c, fdat = d } = MC {rows = r, cols = c, cdat = transdata r d c} | 88 | cmat MF {rows = r, cols = c, fdat = d } = MC {rows = r, cols = c, cdat = transdata r d c} |
87 | 89 | ||
90 | fmat :: (Element t) => Matrix t -> Matrix t | ||
88 | fmat m@MF{} = m | 91 | fmat m@MF{} = m |
89 | fmat MC {rows = r, cols = c, cdat = d } = MF {rows = r, cols = c, fdat = transdata c d r} | 92 | fmat MC {rows = r, cols = c, cdat = d } = MF {rows = r, cols = c, fdat = transdata c d r} |
90 | 93 | ||
94 | -- C-Haskell matrix adapter | ||
95 | mat :: Adapt (CInt -> CInt -> Ptr t -> r) (Matrix t) r | ||
91 | mat = withMatrix | 96 | mat = withMatrix |
92 | 97 | ||
93 | withMatrix a f = | 98 | withMatrix a f = |
@@ -156,7 +161,7 @@ MF {rows = r, cols = c, fdat = v} @@> (i,j) | |||
156 | | otherwise = v `at` (j*r+i) | 161 | | otherwise = v `at` (j*r+i) |
157 | {-# INLINE (@@>) #-} | 162 | {-# INLINE (@@>) #-} |
158 | 163 | ||
159 | -- | Unsafe matrix access without range checking | 164 | -- Unsafe matrix access without range checking |
160 | atM' MC {cols = c, cdat = v} i j = v `at'` (i*c+j) | 165 | atM' MC {cols = c, cdat = v} i j = v `at'` (i*c+j) |
161 | atM' MF {rows = r, fdat = v} i j = v `at'` (j*r+i) | 166 | atM' MF {rows = r, fdat = v} i j = v `at'` (j*r+i) |
162 | {-# INLINE atM' #-} | 167 | {-# INLINE atM' #-} |
@@ -173,6 +178,8 @@ matrixFromVector ColumnMajor c v = MF { rows = r, cols = c, fdat = v } | |||
173 | r | m==0 = d | 178 | r | m==0 = d |
174 | | otherwise = error "matrixFromVector" | 179 | | otherwise = error "matrixFromVector" |
175 | 180 | ||
181 | -- allocates memory for a new matrix | ||
182 | createMatrix :: (Storable a) => MatrixOrder -> Int -> Int -> IO (Matrix a) | ||
176 | createMatrix order r c = do | 183 | createMatrix order r c = do |
177 | p <- createVector (r*c) | 184 | p <- createVector (r*c) |
178 | return (matrixFromVector order c p) | 185 | return (matrixFromVector order c p) |
diff --git a/lib/Data/Packed/Internal/Vector.hs b/lib/Data/Packed/Internal/Vector.hs index fc8a6be..1b572a5 100644 --- a/lib/Data/Packed/Internal/Vector.hs +++ b/lib/Data/Packed/Internal/Vector.hs | |||
@@ -18,6 +18,7 @@ module Data.Packed.Internal.Vector where | |||
18 | 18 | ||
19 | import Data.Packed.Internal.Common | 19 | import Data.Packed.Internal.Common |
20 | import Foreign | 20 | import Foreign |
21 | import Foreign.C.Types(CInt) | ||
21 | import Complex | 22 | import Complex |
22 | import Control.Monad(when) | 23 | import Control.Monad(when) |
23 | 24 | ||
@@ -36,6 +37,8 @@ data Vector t = | |||
36 | , fptr :: {-# UNPACK #-} !(ForeignPtr t) -- ^ foreign pointer to the memory block | 37 | , fptr :: {-# UNPACK #-} !(ForeignPtr t) -- ^ foreign pointer to the memory block |
37 | } | 38 | } |
38 | 39 | ||
40 | -- C-Haskell vector adapter | ||
41 | vec :: Adapt (CInt -> Ptr t -> r) (Vector t) r | ||
39 | vec = withVector | 42 | vec = withVector |
40 | 43 | ||
41 | withVector (V n fp) f = withForeignPtr fp $ \p -> do | 44 | withVector (V n fp) f = withForeignPtr fp $ \p -> do |
@@ -43,7 +46,7 @@ withVector (V n fp) f = withForeignPtr fp $ \p -> do | |||
43 | g (fi n) p | 46 | g (fi n) p |
44 | f v | 47 | f v |
45 | 48 | ||
46 | -- | allocates memory for a new vector | 49 | -- allocates memory for a new vector |
47 | createVector :: Storable a => Int -> IO (Vector a) | 50 | createVector :: Storable a => Int -> IO (Vector a) |
48 | createVector n = do | 51 | createVector n = do |
49 | when (n <= 0) $ error ("trying to createVector of dim "++show n) | 52 | when (n <= 0) $ error ("trying to createVector of dim "++show n) |