summaryrefslogtreecommitdiff
path: root/packages/base/src/Internal/Vector.hs
diff options
context:
space:
mode:
Diffstat (limited to 'packages/base/src/Internal/Vector.hs')
-rw-r--r--packages/base/src/Internal/Vector.hs24
1 files changed, 11 insertions, 13 deletions
diff --git a/packages/base/src/Internal/Vector.hs b/packages/base/src/Internal/Vector.hs
index b4e235c..c4a310d 100644
--- a/packages/base/src/Internal/Vector.hs
+++ b/packages/base/src/Internal/Vector.hs
@@ -66,9 +66,8 @@ dim = Vector.length
66 66
67-- C-Haskell vector adapter 67-- C-Haskell vector adapter
68{-# INLINE avec #-} 68{-# INLINE avec #-}
69avec :: Storable a => (CInt -> Ptr a -> b) -> Vector a -> b 69avec :: Storable a => Vector a -> (f -> IO r) -> ((CInt -> Ptr a -> f) -> IO r)
70avec f v = inlinePerformIO (unsafeWith v (return . f (fromIntegral (Vector.length v)))) 70avec v f g = unsafeWith v $ \ptr -> f (g (fromIntegral (Vector.length v)) ptr)
71infixl 1 `avec`
72 71
73-- allocates memory for a new vector 72-- allocates memory for a new vector
74createVector :: Storable a => Int -> IO (Vector a) 73createVector :: Storable a => Int -> IO (Vector a)
@@ -199,7 +198,7 @@ takesV ms w | sum ms > dim w = error $ "takesV " ++ show ms ++ " on dim = " ++ (
199 198
200--------------------------------------------------------------- 199---------------------------------------------------------------
201 200
202-- | transforms a complex vector into a real vector with alternating real and imaginary parts 201-- | transforms a complex vector into a real vector with alternating real and imaginary parts
203asReal :: (RealFloat a, Storable a) => Vector (Complex a) -> Vector a 202asReal :: (RealFloat a, Storable a) => Vector (Complex a) -> Vector a
204asReal v = unsafeFromForeignPtr (castForeignPtr fp) (2*i) (2*n) 203asReal v = unsafeFromForeignPtr (castForeignPtr fp) (2*i) (2*n)
205 where (fp,i,n) = unsafeToForeignPtr v 204 where (fp,i,n) = unsafeToForeignPtr v
@@ -244,7 +243,7 @@ zipVectorWith f u v = unsafePerformIO $ do
244{-# INLINE zipVectorWith #-} 243{-# INLINE zipVectorWith #-}
245 244
246-- | unzipWith for Vectors 245-- | unzipWith for Vectors
247unzipVectorWith :: (Storable (a,b), Storable c, Storable d) 246unzipVectorWith :: (Storable (a,b), Storable c, Storable d)
248 => ((a,b) -> (c,d)) -> Vector (a,b) -> (Vector c,Vector d) 247 => ((a,b) -> (c,d)) -> Vector (a,b) -> (Vector c,Vector d)
249unzipVectorWith f u = unsafePerformIO $ do 248unzipVectorWith f u = unsafePerformIO $ do
250 let n = dim u 249 let n = dim u
@@ -255,7 +254,7 @@ unzipVectorWith f u = unsafePerformIO $ do
255 unsafeWith w $ \pw -> do 254 unsafeWith w $ \pw -> do
256 let go (-1) = return () 255 let go (-1) = return ()
257 go !k = do z <- peekElemOff pu k 256 go !k = do z <- peekElemOff pu k
258 let (x,y) = f z 257 let (x,y) = f z
259 pokeElemOff pv k x 258 pokeElemOff pv k x
260 pokeElemOff pw k y 259 pokeElemOff pw k y
261 go (k-1) 260 go (k-1)
@@ -303,11 +302,11 @@ mapVectorM f v = do
303 return w 302 return w
304 where mapVectorM' w' !k !t 303 where mapVectorM' w' !k !t
305 | k == t = do 304 | k == t = do
306 x <- return $! inlinePerformIO $! unsafeWith v $! \p -> peekElemOff p k 305 x <- return $! inlinePerformIO $! unsafeWith v $! \p -> peekElemOff p k
307 y <- f x 306 y <- f x
308 return $! inlinePerformIO $! unsafeWith w' $! \q -> pokeElemOff q k y 307 return $! inlinePerformIO $! unsafeWith w' $! \q -> pokeElemOff q k y
309 | otherwise = do 308 | otherwise = do
310 x <- return $! inlinePerformIO $! unsafeWith v $! \p -> peekElemOff p k 309 x <- return $! inlinePerformIO $! unsafeWith v $! \p -> peekElemOff p k
311 y <- f x 310 y <- f x
312 _ <- return $! inlinePerformIO $! unsafeWith w' $! \q -> pokeElemOff q k y 311 _ <- return $! inlinePerformIO $! unsafeWith w' $! \q -> pokeElemOff q k y
313 mapVectorM' w' (k+1) t 312 mapVectorM' w' (k+1) t
@@ -322,7 +321,7 @@ mapVectorM_ f v = do
322 x <- return $! inlinePerformIO $! unsafeWith v $! \p -> peekElemOff p k 321 x <- return $! inlinePerformIO $! unsafeWith v $! \p -> peekElemOff p k
323 f x 322 f x
324 | otherwise = do 323 | otherwise = do
325 x <- return $! inlinePerformIO $! unsafeWith v $! \p -> peekElemOff p k 324 x <- return $! inlinePerformIO $! unsafeWith v $! \p -> peekElemOff p k
326 _ <- f x 325 _ <- f x
327 mapVectorM' (k+1) t 326 mapVectorM' (k+1) t
328{-# INLINE mapVectorM_ #-} 327{-# INLINE mapVectorM_ #-}
@@ -336,11 +335,11 @@ mapVectorWithIndexM f v = do
336 return w 335 return w
337 where mapVectorM' w' !k !t 336 where mapVectorM' w' !k !t
338 | k == t = do 337 | k == t = do
339 x <- return $! inlinePerformIO $! unsafeWith v $! \p -> peekElemOff p k 338 x <- return $! inlinePerformIO $! unsafeWith v $! \p -> peekElemOff p k
340 y <- f k x 339 y <- f k x
341 return $! inlinePerformIO $! unsafeWith w' $! \q -> pokeElemOff q k y 340 return $! inlinePerformIO $! unsafeWith w' $! \q -> pokeElemOff q k y
342 | otherwise = do 341 | otherwise = do
343 x <- return $! inlinePerformIO $! unsafeWith v $! \p -> peekElemOff p k 342 x <- return $! inlinePerformIO $! unsafeWith v $! \p -> peekElemOff p k
344 y <- f k x 343 y <- f k x
345 _ <- return $! inlinePerformIO $! unsafeWith w' $! \q -> pokeElemOff q k y 344 _ <- return $! inlinePerformIO $! unsafeWith w' $! \q -> pokeElemOff q k y
346 mapVectorM' w' (k+1) t 345 mapVectorM' w' (k+1) t
@@ -355,7 +354,7 @@ mapVectorWithIndexM_ f v = do
355 x <- return $! inlinePerformIO $! unsafeWith v $! \p -> peekElemOff p k 354 x <- return $! inlinePerformIO $! unsafeWith v $! \p -> peekElemOff p k
356 f k x 355 f k x
357 | otherwise = do 356 | otherwise = do
358 x <- return $! inlinePerformIO $! unsafeWith v $! \p -> peekElemOff p k 357 x <- return $! inlinePerformIO $! unsafeWith v $! \p -> peekElemOff p k
359 _ <- f k x 358 _ <- f k x
360 mapVectorM' (k+1) t 359 mapVectorM' (k+1) t
361{-# INLINE mapVectorWithIndexM_ #-} 360{-# INLINE mapVectorWithIndexM_ #-}
@@ -454,4 +453,3 @@ unzipVector :: (Storable a, Storable b, Storable (a,b)) => Vector (a,b) -> (Vect
454unzipVector = unzipVectorWith id 453unzipVector = unzipVectorWith id
455 454
456------------------------------------------------------------------- 455-------------------------------------------------------------------
457