summaryrefslogtreecommitdiff
path: root/lib/Data/Packed/Internal/Vector.hs
diff options
context:
space:
mode:
Diffstat (limited to 'lib/Data/Packed/Internal/Vector.hs')
-rw-r--r--lib/Data/Packed/Internal/Vector.hs36
1 files changed, 15 insertions, 21 deletions
diff --git a/lib/Data/Packed/Internal/Vector.hs b/lib/Data/Packed/Internal/Vector.hs
index 082e09d..dc86484 100644
--- a/lib/Data/Packed/Internal/Vector.hs
+++ b/lib/Data/Packed/Internal/Vector.hs
@@ -27,11 +27,12 @@ import Foreign.C.Types
27import Data.Monoid 27import Data.Monoid
28 28
29-- | A one-dimensional array of objects stored in a contiguous memory block. 29-- | A one-dimensional array of objects stored in a contiguous memory block.
30data Vector t = V { dim :: Int -- ^ number of elements 30data Vector t = V { dim :: Int -- ^ number of elements
31 , fptr :: ForeignPtr t -- ^ foreign pointer to the memory block 31 , fptr :: ForeignPtr t -- ^ foreign pointer to the memory block
32 , ptr :: Ptr t -- ^ ordinary pointer to the actual starting address (usually the same)
33 } 32 }
34 33
34ptr (V _ fptr) = unsafeForeignPtrToPtr fptr
35
35-- | check the error code and touch foreign ptr of vector arguments (if any) 36-- | check the error code and touch foreign ptr of vector arguments (if any)
36check :: String -> [Vector a] -> IO Int -> IO () 37check :: String -> [Vector a] -> IO Int -> IO ()
37check msg ls f = do 38check msg ls f = do
@@ -63,9 +64,7 @@ createVector :: Storable a => Int -> IO (Vector a)
63createVector n = do 64createVector n = do
64 when (n <= 0) $ error ("trying to createVector of dim "++show n) 65 when (n <= 0) $ error ("trying to createVector of dim "++show n)
65 fp <- mallocForeignPtrArray n 66 fp <- mallocForeignPtrArray n
66 let p = unsafeForeignPtrToPtr fp 67 return $ V n fp
67 --putStrLn ("\n---------> V"++show n)
68 return $ V n fp p
69 68
70{- | creates a Vector from a list: 69{- | creates a Vector from a list:
71 70
@@ -80,7 +79,7 @@ fromList l = unsafePerformIO $ do
80 f // vec v // check "fromList" [] 79 f // vec v // check "fromList" []
81 return v 80 return v
82 81
83safeRead v f = unsafePerformIO $ withForeignPtr (fptr v) $ const $ f (ptr v) 82safeRead v = unsafePerformIO . withForeignPtr (fptr v)
84 83
85{- | extracts the Vector elements to a list 84{- | extracts the Vector elements to a list
86 85
@@ -115,19 +114,14 @@ subVector :: Storable t => Int -- ^ index of the starting element
115 -> Int -- ^ number of elements to extract 114 -> Int -- ^ number of elements to extract
116 -> Vector t -- ^ source 115 -> Vector t -- ^ source
117 -> Vector t -- ^ result 116 -> Vector t -- ^ result
118subVector k l (v@V {dim=n, ptr=p, fptr=fp}) 117subVector k l (v@V {dim=n})
119 | k<0 || k >= n || k+l > n || l < 0 = error "subVector out of range" 118 | k<0 || k >= n || k+l > n || l < 0 = error "subVector out of range"
120 | otherwise = unsafePerformIO $ do 119 | otherwise = unsafePerformIO $ do
121 r <- createVector l 120 r <- createVector l
122 let f = copyArray (ptr r) (advancePtr p k) l >> return 0 121 let f = copyArray (ptr r) (advancePtr (ptr v) k) l >> return 0
123 f // check "subVector" [v] 122 f // check "subVector" [v,r]
124 return r 123 return r
125 124
126subVector' k l (v@V {dim=n, ptr=p, fptr=fp})
127 | k<0 || k >= n || k+l > n || l < 0 = error "subVector out of range"
128 | otherwise = v {dim=l, ptr=advancePtr p k}
129
130
131{- | Reads a vector position: 125{- | Reads a vector position:
132 126
133@> fromList [0..9] \@\> 7 127@> fromList [0..9] \@\> 7
@@ -149,23 +143,23 @@ join :: Storable t => [Vector t] -> Vector t
149join [] = error "joining zero vectors" 143join [] = error "joining zero vectors"
150join as = unsafePerformIO $ do 144join as = unsafePerformIO $ do
151 let tot = sum (map dim as) 145 let tot = sum (map dim as)
152 r@V {fptr = p, ptr = p'} <- createVector tot 146 r@V {fptr = p} <- createVector tot
153 withForeignPtr p $ \_ -> 147 withForeignPtr p $ \_ ->
154 joiner as tot p' 148 joiner as tot (ptr r)
155 return r 149 return r
156 where joiner [] _ _ = return () 150 where joiner [] _ _ = return ()
157 joiner (V {dim = n, fptr = b, ptr = q} : cs) _ p = do 151 joiner (r@V {dim = n, fptr = b} : cs) _ p = do
158 withForeignPtr b $ \_ -> copyArray p q n 152 withForeignPtr b $ \_ -> copyArray p (ptr r) n
159 joiner cs 0 (advancePtr p n) 153 joiner cs 0 (advancePtr p n)
160 154
161 155
162-- | transforms a complex vector into a real vector with alternating real and imaginary parts 156-- | transforms a complex vector into a real vector with alternating real and imaginary parts
163asReal :: Vector (Complex Double) -> Vector Double 157asReal :: Vector (Complex Double) -> Vector Double
164asReal v = V { dim = 2*dim v, fptr = castForeignPtr (fptr v), ptr = castPtr (ptr v) } 158asReal v = V { dim = 2*dim v, fptr = castForeignPtr (fptr v) }
165 159
166-- | transforms a real vector into a complex vector with alternating real and imaginary parts 160-- | transforms a real vector into a complex vector with alternating real and imaginary parts
167asComplex :: Vector Double -> Vector (Complex Double) 161asComplex :: Vector Double -> Vector (Complex Double)
168asComplex v = V { dim = dim v `div` 2, fptr = castForeignPtr (fptr v), ptr = castPtr (ptr v) } 162asComplex v = V { dim = dim v `div` 2, fptr = castForeignPtr (fptr v) }
169 163
170---------------------------------------------------------------- 164----------------------------------------------------------------
171 165