From 5c50b54a92c01218e5265413208b52321080c779 Mon Sep 17 00:00:00 2001
From: Vivian McPhail <haskell.vivian.mcphail@gmail.com>
Date: Fri, 13 Aug 2010 04:18:46 +0000
Subject: remove MonadIO constraint from mapVectorM(_)

---
 examples/vector-map.hs             |  5 ++---
 hmatrix.cabal                      |  2 +-
 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
 import Numeric.LinearAlgebra.Interface
 
 import Control.Monad.State
-import Control.Monad.Trans
 
 -------------------------------------------
 
@@ -20,7 +19,7 @@ v = fromList $ take 10 [0..]
 test1 :: Vector Int -> IO (Vector Int)
 test1 = do
         mapVectorM (\x -> do
-                          putStr $ (show) x ++ " "
+                          putStr $ (show x) ++ " "
                           return (x + 1))
                             
 -- we can have an arbitrary monad AND do IO
@@ -36,7 +35,7 @@ main = do
        v' <- test1 v
        putStrLn ""
        putStrLn $ show v'
-       evalStateT (addInitialM v) 1
+       evalStateT (addInitialM v) 0
        putStrLn ""
        return ()
 
diff --git a/hmatrix.cabal b/hmatrix.cabal
index 708bfd2..674f69d 100644
--- a/hmatrix.cabal
+++ b/hmatrix.cabal
@@ -73,7 +73,7 @@ flag vector
 library
 
     Build-Depends:      base >= 4 && < 5,
-                        array, mtl,
+                        array,
                         storable-complex,
                         process,
                         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
 import Foreign.C.Types(CInt,CChar)
 import Data.Complex
 import Control.Monad(when)
-import Control.Monad.Trans
 
 #if __GLASGOW_HASKELL__ >= 605
 import GHC.ForeignPtr           (mallocPlainForeignPtrBytes)
@@ -362,33 +361,33 @@ foldVectorG f s0 v = foldLoop g s0 (dim v)
 -------------------------------------------------------------------
 
 -- | monadic map over Vectors
-mapVectorM :: (Storable a, Storable b, MonadIO m) => (a -> m b) -> Vector a -> m (Vector b)
+mapVectorM :: (Storable a, Storable b, Monad m) => (a -> m b) -> Vector a -> m (Vector b)
 mapVectorM f v = do
-    w <- liftIO $ createVector (dim v)
+    w <- return $! unsafePerformIO $! createVector (dim v)
     mapVectorM' f v w 0 (dim v -1)
     return w
     where mapVectorM' f' v' w' !k !t
               | k == t               = do
-                                       x <- liftIO $ unsafeWith v' $ \p -> peekElemOff p k 
+                                       x <- return $! inlinePerformIO $! unsafeWith v' $! \p -> peekElemOff p k 
                                        y <- f' x
-                                       liftIO $ unsafeWith w' $ \q -> pokeElemOff q k y
+                                       return $! inlinePerformIO $! unsafeWith w' $! \q -> pokeElemOff q k y
               | otherwise            = do
-                                       x <- liftIO $ unsafeWith v' $ \p -> peekElemOff p k 
+                                       x <- return $! inlinePerformIO $! unsafeWith v' $! \p -> peekElemOff p k 
                                        y <- f' x
-                                       liftIO $ unsafeWith w' $ \q -> pokeElemOff q k y
+                                       _ <- return $! inlinePerformIO $! unsafeWith w' $! \q -> pokeElemOff q k y
                                        mapVectorM' f' v' w' (k+1) t
 {-# INLINE mapVectorM #-}
 
 -- | monadic map over Vectors
-mapVectorM_ :: (Storable a, MonadIO m) => (a -> m ()) -> Vector a -> m ()
+mapVectorM_ :: (Storable a, Monad m) => (a -> m ()) -> Vector a -> m ()
 mapVectorM_ f v = do
     mapVectorM' f v 0 (dim v -1)
     where mapVectorM' f' v' !k !t
               | k == t            = do
-                                    x <- liftIO $ unsafeWith v' $ \p -> peekElemOff p k
+                                    x <- return $! inlinePerformIO $! unsafeWith v' $! \p -> peekElemOff p k
                                     f' x
               | otherwise         = do
-                                    x <- liftIO $ unsafeWith v' $ \p -> peekElemOff p k 
+                                    x <- return $! inlinePerformIO $! unsafeWith v' $! \p -> peekElemOff p k 
                                     _ <- f' x
                                     mapVectorM' f' v' (k+1) t
 {-# INLINE mapVectorM_ #-}
-- 
cgit v1.2.3