summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorVivian McPhail <haskell.vivian.mcphail@gmail.com>2010-08-13 04:18:46 +0000
committerVivian McPhail <haskell.vivian.mcphail@gmail.com>2010-08-13 04:18:46 +0000
commit5c50b54a92c01218e5265413208b52321080c779 (patch)
treec90cd3e4943fe01a6c6d71689422931d1108873e
parent91510a3d127d8d9bb10daec9a9ec22d3ad2c199e (diff)
remove MonadIO constraint from mapVectorM(_)
-rw-r--r--examples/vector-map.hs5
-rw-r--r--hmatrix.cabal2
-rw-r--r--lib/Data/Packed/Internal/Vector.hs19
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
7import Numeric.LinearAlgebra.Interface 7import Numeric.LinearAlgebra.Interface
8 8
9import Control.Monad.State 9import Control.Monad.State
10import Control.Monad.Trans
11 10
12------------------------------------------- 11-------------------------------------------
13 12
@@ -20,7 +19,7 @@ v = fromList $ take 10 [0..]
20test1 :: Vector Int -> IO (Vector Int) 19test1 :: Vector Int -> IO (Vector Int)
21test1 = do 20test1 = 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
73library 73library
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
36import Foreign.C.Types(CInt,CChar) 36import Foreign.C.Types(CInt,CChar)
37import Data.Complex 37import Data.Complex
38import Control.Monad(when) 38import Control.Monad(when)
39import Control.Monad.Trans
40 39
41#if __GLASGOW_HASKELL__ >= 605 40#if __GLASGOW_HASKELL__ >= 605
42import GHC.ForeignPtr (mallocPlainForeignPtrBytes) 41import 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
365mapVectorM :: (Storable a, Storable b, MonadIO m) => (a -> m b) -> Vector a -> m (Vector b) 364mapVectorM :: (Storable a, Storable b, Monad m) => (a -> m b) -> Vector a -> m (Vector b)
366mapVectorM f v = do 365mapVectorM 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
383mapVectorM_ :: (Storable a, MonadIO m) => (a -> m ()) -> Vector a -> m () 382mapVectorM_ :: (Storable a, Monad m) => (a -> m ()) -> Vector a -> m ()
384mapVectorM_ f v = do 383mapVectorM_ 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_ #-}