Use memcpy for copying vectors where appropriate
authorRoman Leshchinskiy <rl@cse.unsw.edu.au>
Sun, 21 Feb 2010 12:26:02 +0000 (12:26 +0000)
committerRoman Leshchinskiy <rl@cse.unsw.edu.au>
Sun, 21 Feb 2010 12:26:02 +0000 (12:26 +0000)
Data/Vector/Generic/Mutable.hs
Data/Vector/Primitive/Mutable.hs
Data/Vector/Storable/Mutable.hs
cbits/memops.c [new file with mode: 0644]
cbits/memops.h [new file with mode: 0644]
vector.cabal

index f9a620d..57888d9 100644 (file)
@@ -530,7 +530,7 @@ unsafeCopy dst src = UNSAFE_CHECK(check) "unsafeCopy" "length mismatch"
                                          (length dst == length src)
                    $ UNSAFE_CHECK(check) "unsafeCopy" "overlapping vectors"
                                          (not (dst `overlaps` src))
-                   $ basicUnsafeCopy dst src
+                   $ (dst `seq` src `seq` basicUnsafeCopy dst src)
 
 -- Subvectors
 -- ----------
index c87477f..17b2b96 100644 (file)
@@ -1,5 +1,6 @@
 {-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, ScopedTypeVariables,
-             FlexibleContexts #-}
+             FlexibleContexts, ForeignFunctionInterface, UnliftedFFITypes,
+             MagicHash #-}
 
 -- |
 -- Module      : Data.Vector.Primitive.Mutable
@@ -33,6 +34,8 @@ import           Control.Monad.Primitive
 import           Control.Monad.ST ( ST )
 import           Control.Monad ( liftM )
 
+import Foreign.C.Types ( CInt )
+
 import Prelude hiding( length, read )
 
 #include "vector.h"
@@ -67,6 +70,16 @@ instance Prim a => G.MVector MVector a where
   {-# INLINE basicUnsafeWrite #-}
   basicUnsafeWrite (MVector i n arr) j x = writeByteArray arr (i+j) x
 
+  {-# INLINE basicUnsafeCopy #-}
+  basicUnsafeCopy (MVector i n (MutableByteArray dst))
+                  (MVector j _ (MutableByteArray src))
+    = unsafePrimToPrim
+    $ memcpy_off dst (fromIntegral (i * sz))
+                 src (fromIntegral (j * sz))
+                 (fromIntegral (n * sz))
+    where
+      sz = sizeOf (undefined :: a)
+
 -- | Yield a part of the mutable vector without copying it. No bounds checks
 -- are performed.
 unsafeSlice :: Prim a => Int  -- ^ starting index
@@ -188,3 +201,8 @@ grow :: (PrimMonad m, Prim a)
 {-# INLINE grow #-}
 grow = G.grow
 
+foreign import ccall unsafe "memops.h memcpy_off"
+  memcpy_off :: MutableByteArray# s -> CInt
+             -> MutableByteArray# s -> CInt -> CInt -> IO ()
+
+
index 67c1e22..09370b5 100644 (file)
@@ -1,4 +1,5 @@
-{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances,
+             ScopedTypeVariables, ForeignFunctionInterface #-}
 
 -- |
 -- Module      : Data.Vector.Storable.Mutable
@@ -34,6 +35,7 @@ import Foreign.Storable
 import Foreign.ForeignPtr
 import Foreign.Ptr
 import Foreign.Marshal.Array ( advancePtr )
+import Foreign.C.Types ( CInt )
 
 import Control.Monad.Primitive
 
@@ -75,6 +77,16 @@ instance Storable a => G.MVector MVector a where
     = unsafePrimToPrim
     $ withForeignPtr p $ \ptr -> pokeElemOff ptr (i+j) x
 
+  {-# INLINE basicUnsafeCopy #-}
+  basicUnsafeCopy (MVector i n p) (MVector j _ q)
+    = unsafePrimToPrim
+    $ withForeignPtr p $ \dst ->
+      withForeignPtr q $ \src ->
+      do
+        memcpy (dst `advancePtr` i) (src `advancePtr` j)
+               (fromIntegral (n * sizeOf (undefined :: a)))
+        return ()
+
 -- | Create a mutable vector from a 'ForeignPtr' with an offset and a length.
 -- Modifying data through the 'ForeignPtr' afterwards is unsafe if the vector
 -- could have been frozen before the modification.
@@ -223,3 +235,7 @@ grow :: (PrimMonad m, Storable a)
 {-# INLINE grow #-}
 grow = G.grow
 
+foreign import ccall unsafe "string.h memcpy"
+  memcpy :: Ptr a -> Ptr a -> CInt -> IO (Ptr a)
+
+
diff --git a/cbits/memops.c b/cbits/memops.c
new file mode 100644 (file)
index 0000000..c7dbfac
--- /dev/null
@@ -0,0 +1,7 @@
+#include <string.h>
+
+void memcpy_off( char *dst, int doff, char *src, int soff, int len )
+{
+  memcpy( dst + doff, src + soff, len );
+}
+
diff --git a/cbits/memops.h b/cbits/memops.h
new file mode 100644 (file)
index 0000000..e7ff349
--- /dev/null
@@ -0,0 +1,7 @@
+#ifndef haskell_vector_memops_h
+#define haskell_vector_memops_h
+
+void memcpy_off( char *dst, int doff, char *src, int soff, int len );
+
+#endif
+
index 9c24be3..8abba11 100644 (file)
@@ -103,10 +103,11 @@ Library
         Data.Vector
 
   Include-Dirs:
-        include, internal
+        include, internal, cbits
 
   Install-Includes:
         vector.h
+        memops.h
 
   Build-Depends: base >= 2 && < 5, ghc >= 6.9, primitive >= 0.3 && < 0.4
 
@@ -124,3 +125,6 @@ Library
   if flag(InternalChecks)
     cpp-options: -DVECTOR_INTERNAL_CHECKS
 
+  includes: memops.h
+  c-sources: cbits/memops.c
+