diff options
-rw-r--r-- | examples/vector-map.hs | 5 | ||||
-rw-r--r-- | hmatrix.cabal | 2 | ||||
-rw-r--r-- | lib/Data/Packed/Internal/Vector.hs | 19 |
3 files changed, 12 insertions, 14 deletions
diff --git a/examples/vector-map.hs b/examples/vector-map.hs index d778358..f116946 100644 --- a/examples/vector-map.hs +++ b/examples/vector-map.hs | |||
@@ -7,7 +7,6 @@ import Data.Packed.Vector | |||
7 | import Numeric.LinearAlgebra.Interface | 7 | import Numeric.LinearAlgebra.Interface |
8 | 8 | ||
9 | import Control.Monad.State | 9 | import Control.Monad.State |
10 | import Control.Monad.Trans | ||
11 | 10 | ||
12 | ------------------------------------------- | 11 | ------------------------------------------- |
13 | 12 | ||
@@ -20,7 +19,7 @@ v = fromList $ take 10 [0..] | |||
20 | test1 :: Vector Int -> IO (Vector Int) | 19 | test1 :: Vector Int -> IO (Vector Int) |
21 | test1 = do | 20 | test1 = do |
22 | mapVectorM (\x -> do | 21 | mapVectorM (\x -> do |
23 | putStr $ (show) x ++ " " | 22 | putStr $ (show x) ++ " " |
24 | return (x + 1)) | 23 | return (x + 1)) |
25 | 24 | ||
26 | -- we can have an arbitrary monad AND do IO | 25 | -- we can have an arbitrary monad AND do IO |
@@ -36,7 +35,7 @@ main = do | |||
36 | v' <- test1 v | 35 | v' <- test1 v |
37 | putStrLn "" | 36 | putStrLn "" |
38 | putStrLn $ show v' | 37 | putStrLn $ show v' |
39 | evalStateT (addInitialM v) 1 | 38 | evalStateT (addInitialM v) 0 |
40 | putStrLn "" | 39 | putStrLn "" |
41 | return () | 40 | return () |
42 | 41 | ||
diff --git a/hmatrix.cabal b/hmatrix.cabal index 708bfd2..674f69d 100644 --- a/hmatrix.cabal +++ b/hmatrix.cabal | |||
@@ -73,7 +73,7 @@ flag vector | |||
73 | library | 73 | library |
74 | 74 | ||
75 | Build-Depends: base >= 4 && < 5, | 75 | Build-Depends: base >= 4 && < 5, |
76 | array, mtl, | 76 | array, |
77 | storable-complex, | 77 | storable-complex, |
78 | process, | 78 | process, |
79 | binary | 79 | binary |
diff --git a/lib/Data/Packed/Internal/Vector.hs b/lib/Data/Packed/Internal/Vector.hs index 2900149..652b980 100644 --- a/lib/Data/Packed/Internal/Vector.hs +++ b/lib/Data/Packed/Internal/Vector.hs | |||
@@ -36,7 +36,6 @@ import Foreign.C.String | |||
36 | import Foreign.C.Types(CInt,CChar) | 36 | import Foreign.C.Types(CInt,CChar) |
37 | import Data.Complex | 37 | import Data.Complex |
38 | import Control.Monad(when) | 38 | import Control.Monad(when) |
39 | import Control.Monad.Trans | ||
40 | 39 | ||
41 | #if __GLASGOW_HASKELL__ >= 605 | 40 | #if __GLASGOW_HASKELL__ >= 605 |
42 | import GHC.ForeignPtr (mallocPlainForeignPtrBytes) | 41 | import GHC.ForeignPtr (mallocPlainForeignPtrBytes) |
@@ -362,33 +361,33 @@ foldVectorG f s0 v = foldLoop g s0 (dim v) | |||
362 | ------------------------------------------------------------------- | 361 | ------------------------------------------------------------------- |
363 | 362 | ||
364 | -- | monadic map over Vectors | 363 | -- | monadic map over Vectors |
365 | mapVectorM :: (Storable a, Storable b, MonadIO m) => (a -> m b) -> Vector a -> m (Vector b) | 364 | mapVectorM :: (Storable a, Storable b, Monad m) => (a -> m b) -> Vector a -> m (Vector b) |
366 | mapVectorM f v = do | 365 | mapVectorM f v = do |
367 | w <- liftIO $ createVector (dim v) | 366 | w <- return $! unsafePerformIO $! createVector (dim v) |
368 | mapVectorM' f v w 0 (dim v -1) | 367 | mapVectorM' f v w 0 (dim v -1) |
369 | return w | 368 | return w |
370 | where mapVectorM' f' v' w' !k !t | 369 | where mapVectorM' f' v' w' !k !t |
371 | | k == t = do | 370 | | k == t = do |
372 | x <- liftIO $ unsafeWith v' $ \p -> peekElemOff p k | 371 | x <- return $! inlinePerformIO $! unsafeWith v' $! \p -> peekElemOff p k |
373 | y <- f' x | 372 | y <- f' x |
374 | liftIO $ unsafeWith w' $ \q -> pokeElemOff q k y | 373 | return $! inlinePerformIO $! unsafeWith w' $! \q -> pokeElemOff q k y |
375 | | otherwise = do | 374 | | otherwise = do |
376 | x <- liftIO $ unsafeWith v' $ \p -> peekElemOff p k | 375 | x <- return $! inlinePerformIO $! unsafeWith v' $! \p -> peekElemOff p k |
377 | y <- f' x | 376 | y <- f' x |
378 | liftIO $ unsafeWith w' $ \q -> pokeElemOff q k y | 377 | _ <- return $! inlinePerformIO $! unsafeWith w' $! \q -> pokeElemOff q k y |
379 | mapVectorM' f' v' w' (k+1) t | 378 | mapVectorM' f' v' w' (k+1) t |
380 | {-# INLINE mapVectorM #-} | 379 | {-# INLINE mapVectorM #-} |
381 | 380 | ||
382 | -- | monadic map over Vectors | 381 | -- | monadic map over Vectors |
383 | mapVectorM_ :: (Storable a, MonadIO m) => (a -> m ()) -> Vector a -> m () | 382 | mapVectorM_ :: (Storable a, Monad m) => (a -> m ()) -> Vector a -> m () |
384 | mapVectorM_ f v = do | 383 | mapVectorM_ f v = do |
385 | mapVectorM' f v 0 (dim v -1) | 384 | mapVectorM' f v 0 (dim v -1) |
386 | where mapVectorM' f' v' !k !t | 385 | where mapVectorM' f' v' !k !t |
387 | | k == t = do | 386 | | k == t = do |
388 | x <- liftIO $ unsafeWith v' $ \p -> peekElemOff p k | 387 | x <- return $! inlinePerformIO $! unsafeWith v' $! \p -> peekElemOff p k |
389 | f' x | 388 | f' x |
390 | | otherwise = do | 389 | | otherwise = do |
391 | x <- liftIO $ unsafeWith v' $ \p -> peekElemOff p k | 390 | x <- return $! inlinePerformIO $! unsafeWith v' $! \p -> peekElemOff p k |
392 | _ <- f' x | 391 | _ <- f' x |
393 | mapVectorM' f' v' (k+1) t | 392 | mapVectorM' f' v' (k+1) t |
394 | {-# INLINE mapVectorM_ #-} | 393 | {-# INLINE mapVectorM_ #-} |