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.hs38
-rw-r--r--lib/Data/Packed/Internal/Matrix.hs9
-rw-r--r--lib/Data/Packed/Internal/Vector.hs5
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
60ww3 w1 o1 w2 o2 w3 o3 f = w1 o1 $ \a1 -> ww2 w2 o2 w3 o3 (f a1) 60ww3 w1 o1 w2 o2 w3 o3 f = w1 o1 $ \a1 -> ww2 w2 o2 w3 o3 (f a1)
61ww4 w1 o1 w2 o2 w3 o3 w4 o4 f = w1 o1 $ \a1 -> ww3 w2 o2 w3 o3 w4 o4 (f a1) 61ww4 w1 o1 w2 o2 w3 o3 w4 o4 f = w1 o1 $ \a1 -> ww3 w2 o2 w3 o3 w4 o4 (f a1)
62 62
63type Adapt f t r = t -> ((f -> r) -> IO()) -> IO()
64
65app1 :: f
66 -> Adapt f t (IO CInt)
67 -> t
68 -> String
69 -> IO()
70
71app2 :: f
72 -> Adapt f t1 r
73 -> t1
74 -> Adapt r t2 (IO CInt)
75 -> t2
76 -> String
77 -> IO()
78
79app3 :: 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
89app4 :: 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
63app1 f w1 o1 s = w1 o1 $ \a1 -> f // a1 // check s 101app1 f w1 o1 s = w1 o1 $ \a1 -> f // a1 // check s
64app2 f w1 o1 w2 o2 s = ww2 w1 o1 w2 o2 $ \a1 a2 -> f // a1 // a2 // check s 102app2 f w1 o1 w2 o2 s = ww2 w1 o1 w2 o2 $ \a1 a2 -> f // a1 // a2 // check s
65app3 f w1 o1 w2 o2 w3 o3 s = ww3 w1 o1 w2 o2 w3 o3 $ 103app3 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
74xdat MC {cdat = d } = d 74xdat MC {cdat = d } = d
75xdat MF {fdat = d } = d 75xdat MF {fdat = d } = d
76 76
77orderOf :: Matrix t -> MatrixOrder
77orderOf MF{} = ColumnMajor 78orderOf MF{} = ColumnMajor
78orderOf MC{} = RowMajor 79orderOf MC{} = RowMajor
79 80
@@ -82,12 +83,16 @@ trans :: Matrix t -> Matrix t
82trans MC {rows = r, cols = c, cdat = d } = MF {rows = c, cols = r, fdat = d } 83trans MC {rows = r, cols = c, cdat = d } = MF {rows = c, cols = r, fdat = d }
83trans MF {rows = r, cols = c, fdat = d } = MC {rows = c, cols = r, cdat = d } 84trans MF {rows = r, cols = c, fdat = d } = MC {rows = c, cols = r, cdat = d }
84 85
86cmat :: (Element t) => Matrix t -> Matrix t
85cmat m@MC{} = m 87cmat m@MC{} = m
86cmat MF {rows = r, cols = c, fdat = d } = MC {rows = r, cols = c, cdat = transdata r d c} 88cmat MF {rows = r, cols = c, fdat = d } = MC {rows = r, cols = c, cdat = transdata r d c}
87 89
90fmat :: (Element t) => Matrix t -> Matrix t
88fmat m@MF{} = m 91fmat m@MF{} = m
89fmat MC {rows = r, cols = c, cdat = d } = MF {rows = r, cols = c, fdat = transdata c d r} 92fmat MC {rows = r, cols = c, cdat = d } = MF {rows = r, cols = c, fdat = transdata c d r}
90 93
94-- C-Haskell matrix adapter
95mat :: Adapt (CInt -> CInt -> Ptr t -> r) (Matrix t) r
91mat = withMatrix 96mat = withMatrix
92 97
93withMatrix a f = 98withMatrix 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
160atM' MC {cols = c, cdat = v} i j = v `at'` (i*c+j) 165atM' MC {cols = c, cdat = v} i j = v `at'` (i*c+j)
161atM' MF {rows = r, fdat = v} i j = v `at'` (j*r+i) 166atM' 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
182createMatrix :: (Storable a) => MatrixOrder -> Int -> Int -> IO (Matrix a)
176createMatrix order r c = do 183createMatrix 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
19import Data.Packed.Internal.Common 19import Data.Packed.Internal.Common
20import Foreign 20import Foreign
21import Foreign.C.Types(CInt)
21import Complex 22import Complex
22import Control.Monad(when) 23import 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
41vec :: Adapt (CInt -> Ptr t -> r) (Vector t) r
39vec = withVector 42vec = withVector
40 43
41withVector (V n fp) f = withForeignPtr fp $ \p -> do 44withVector (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
47createVector :: Storable a => Int -> IO (Vector a) 50createVector :: Storable a => Int -> IO (Vector a)
48createVector n = do 51createVector 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)