Support for copying immutable vectors into mutable ones
authorRoman Leshchinskiy <rl@cse.unsw.edu.au>
Wed, 14 Apr 2010 16:22:01 +0000 (16:22 +0000)
committerRoman Leshchinskiy <rl@cse.unsw.edu.au>
Wed, 14 Apr 2010 16:22:01 +0000 (16:22 +0000)
Data/Vector/Generic.hs
Data/Vector/Primitive.hs
Data/Vector/Storable.hs
Data/Vector/Unboxed/Base.hs
internal/GenUnboxTuple.hs
internal/unbox-tuple-instances

index 6d01fd2..1645048 100644 (file)
@@ -166,6 +166,19 @@ class MVector (Mutable v) a => Vector v a where
   --
   basicUnsafeIndexM  :: Monad m => v a -> Int -> m a
 
+  -- | Copy an immutable vector into a mutable one.
+  basicUnsafeCopy :: PrimMonad m => Mutable v (PrimState m) a -> v a -> m ()
+
+  basicUnsafeCopy dst src = do_copy 0
+    where
+      n = basicLength src
+
+      do_copy i | i < n = do
+                            x <- basicUnsafeIndexM src i
+                            M.basicUnsafeWrite dst i x
+                            do_copy (i+1)
+                | otherwise = return ()
+
   elemseq :: v a -> a -> b -> b
 
   {-# INLINE elemseq #-}
index 78f7e57..25ce270 100644 (file)
@@ -1,4 +1,4 @@
-{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeFamilies #-}
+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeFamilies, ScopedTypeVariables #-}
 
 -- |
 -- Module      : Data.Vector.Primitive
@@ -82,7 +82,7 @@ import qualified Data.Vector.Generic           as G
 import           Data.Vector.Primitive.Mutable ( MVector(..) )
 import qualified Data.Vector.Fusion.Stream as Stream
 import           Data.Primitive.ByteArray
-import           Data.Primitive ( Prim )
+import           Data.Primitive ( Prim, sizeOf )
 
 import Control.Monad ( liftM )
 
@@ -137,6 +137,12 @@ instance Prim a => G.Vector Vector a where
   {-# INLINE basicUnsafeIndexM #-}
   basicUnsafeIndexM (Vector i _ arr) j = return (indexByteArray arr (i+j))
 
+  {-# INLINE basicUnsafeCopy #-}
+  basicUnsafeCopy (MVector i n dst) (Vector j _ src)
+    = memcpyByteArray' dst (i * sz) src (j * sz) (n * sz)
+    where
+      sz = sizeOf (undefined :: a)
+
   {-# INLINE elemseq #-}
   elemseq _ = seq
 
index 0eb6a35..42469ca 100644 (file)
@@ -1,4 +1,4 @@
-{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, TypeFamilies #-}
+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, TypeFamilies, ScopedTypeVariables #-}
 
 -- |
 -- Module      : Data.Vector.Storable
@@ -90,6 +90,9 @@ import Foreign.Storable
 import Foreign.ForeignPtr
 import Foreign.Ptr
 import Foreign.Marshal.Array ( advancePtr )
+import Foreign.Marshal.Utils ( copyBytes )
+
+import Control.Monad.Primitive ( unsafePrimToPrim )
 
 import Prelude hiding ( length, null,
                         replicate, (++),
@@ -148,6 +151,15 @@ instance Storable a => G.Vector Vector a where
                                       $ withForeignPtr fp $ \_ ->
                                         peekElemOff p i
 
+  {-# INLINE basicUnsafeCopy #-}
+  basicUnsafeCopy (MVector p n fp) (Vector q _ fq)
+    = unsafePrimToPrim
+    $ withForeignPtr fp $ \_ ->
+      withForeignPtr fq $ \_ ->
+      do
+        copyBytes p q (fromIntegral (n * sizeOf (undefined :: a)))
+        return ()
+
   {-# INLINE elemseq #-}
   elemseq _ = seq
 
index a755542..d846330 100644 (file)
@@ -116,6 +116,9 @@ instance G.Vector Vector () where
   {-# INLINE basicUnsafeIndexM #-}
   basicUnsafeIndexM (V_Unit _) i = return ()
 
+  {-# INLINE basicUnsafeCopy #-}
+  basicUnsafeCopy (MV_Unit _) (V_Unit _) = return ()
+
   {-# INLINE elemseq #-}
   elemseq _ = seq
 
@@ -160,6 +163,7 @@ instance G.Vector Vector ty where {                                     \
 ; basicLength (con v) = G.basicLength v                                 \
 ; basicUnsafeSlice i n (con v) = con $ G.basicUnsafeSlice i n v         \
 ; basicUnsafeIndexM (con v) i = G.basicUnsafeIndexM v i                 \
+; basicUnsafeCopy (mcon mv) (con v) = G.basicUnsafeCopy mv v            \
 ; elemseq _ = seq }
 
 newtype instance MVector s Int = MV_Int (P.MVector s Int)
@@ -296,6 +300,7 @@ instance G.Vector Vector Bool where
   basicLength (V_Bool v) = G.basicLength v
   basicUnsafeSlice i n (V_Bool v) = V_Bool $ G.basicUnsafeSlice i n v
   basicUnsafeIndexM (V_Bool v) i = toBool `liftM` G.basicUnsafeIndexM v i
+  basicUnsafeCopy (MV_Bool mv) (V_Bool v) = G.basicUnsafeCopy mv v
   elemseq _ = seq
 
 -- -------
@@ -342,6 +347,8 @@ instance (RealFloat a, Unbox a) => G.Vector Vector (Complex a) where
   basicUnsafeSlice i n (V_Complex v) = V_Complex $ G.basicUnsafeSlice i n v
   basicUnsafeIndexM (V_Complex v) i
                 = uncurry (:+) `liftM` G.basicUnsafeIndexM v i
+  basicUnsafeCopy (MV_Complex mv) (V_Complex v)
+                = G.basicUnsafeCopy mv v
   elemseq _ (x :+ y) z = G.elemseq (undefined :: Vector a) x
                        $ G.elemseq (undefined :: Vector a) y z
 
index 60dc220..d863909 100644 (file)
@@ -157,9 +157,9 @@ generate n =
       = (pat "MV" <+> tuple vars,
          mk_do [qM rec <+> vs <+> v | vs <- varss | v <- vars] empty)
 
-    gen_unsafeCopy rec
-      = (patn "MV" 1 <+> patn "MV" 2,
-         mk_do [qM rec <+> vs <> char '1' <+> vs <> char '2' | vs <- varss]
+    gen_unsafeCopy c q rec
+      = (patn "MV" 1 <+> patn c 2,
+         mk_do [q rec <+> vs <> char '1' <+> vs <> char '2' | vs <- varss]
                empty)
 
     gen_unsafeGrow rec
@@ -209,11 +209,12 @@ generate n =
                       ,("basicUnsafeWrite",       gen_unsafeWrite)
                       ,("basicClear",             gen_clear)
                       ,("basicSet",               gen_set)
-                      ,("basicUnsafeCopy",        gen_unsafeCopy)
+                      ,("basicUnsafeCopy",        gen_unsafeCopy "MV" qM)
                       ,("basicUnsafeGrow",        gen_unsafeGrow)]
 
     methods_Vector  = [("unsafeFreeze",           gen_unsafeFreeze)
                       ,("basicLength",            gen_length "V")
                       ,("basicUnsafeSlice",       gen_unsafeSlice "G" "V")
                       ,("basicUnsafeIndexM",      gen_basicUnsafeIndexM)
+                      ,("basicUnsafeCopy",        gen_unsafeCopy "V" qG)
                       ,("elemseq",                gen_elemseq)]
index ef0197f..0004f0c 100644 (file)
@@ -80,6 +80,11 @@ instance (Unbox a, Unbox b) => G.Vector Vector (a, b) where
           a <- G.basicUnsafeIndexM as i_
           b <- G.basicUnsafeIndexM bs i_
           return (a, b)
+  {-# INLINE basicUnsafeCopy  #-}
+  basicUnsafeCopy (MV_2 n_1 as1 bs1) (V_2 n_2 as2 bs2)
+      = do
+          G.basicUnsafeCopy as1 as2
+          G.basicUnsafeCopy bs1 bs2
   {-# INLINE elemseq  #-}
   elemseq _ (a, b) x_
       = G.elemseq (undefined :: Vector a) a $
@@ -211,6 +216,12 @@ instance (Unbox a,
           b <- G.basicUnsafeIndexM bs i_
           c <- G.basicUnsafeIndexM cs i_
           return (a, b, c)
+  {-# INLINE basicUnsafeCopy  #-}
+  basicUnsafeCopy (MV_3 n_1 as1 bs1 cs1) (V_3 n_2 as2 bs2 cs2)
+      = do
+          G.basicUnsafeCopy as1 as2
+          G.basicUnsafeCopy bs1 bs2
+          G.basicUnsafeCopy cs1 cs2
   {-# INLINE elemseq  #-}
   elemseq _ (a, b, c) x_
       = G.elemseq (undefined :: Vector a) a $
@@ -375,6 +386,16 @@ instance (Unbox a,
           c <- G.basicUnsafeIndexM cs i_
           d <- G.basicUnsafeIndexM ds i_
           return (a, b, c, d)
+  {-# INLINE basicUnsafeCopy  #-}
+  basicUnsafeCopy (MV_4 n_1 as1 bs1 cs1 ds1) (V_4 n_2 as2
+                                                      bs2
+                                                      cs2
+                                                      ds2)
+      = do
+          G.basicUnsafeCopy as1 as2
+          G.basicUnsafeCopy bs1 bs2
+          G.basicUnsafeCopy cs1 cs2
+          G.basicUnsafeCopy ds1 ds2
   {-# INLINE elemseq  #-}
   elemseq _ (a, b, c, d) x_
       = G.elemseq (undefined :: Vector a) a $
@@ -579,6 +600,18 @@ instance (Unbox a,
           d <- G.basicUnsafeIndexM ds i_
           e <- G.basicUnsafeIndexM es i_
           return (a, b, c, d, e)
+  {-# INLINE basicUnsafeCopy  #-}
+  basicUnsafeCopy (MV_5 n_1 as1 bs1 cs1 ds1 es1) (V_5 n_2 as2
+                                                          bs2
+                                                          cs2
+                                                          ds2
+                                                          es2)
+      = do
+          G.basicUnsafeCopy as1 as2
+          G.basicUnsafeCopy bs1 bs2
+          G.basicUnsafeCopy cs1 cs2
+          G.basicUnsafeCopy ds1 ds2
+          G.basicUnsafeCopy es1 es2
   {-# INLINE elemseq  #-}
   elemseq _ (a, b, c, d, e) x_
       = G.elemseq (undefined :: Vector a) a $
@@ -833,6 +866,20 @@ instance (Unbox a,
           e <- G.basicUnsafeIndexM es i_
           f <- G.basicUnsafeIndexM fs i_
           return (a, b, c, d, e, f)
+  {-# INLINE basicUnsafeCopy  #-}
+  basicUnsafeCopy (MV_6 n_1 as1 bs1 cs1 ds1 es1 fs1) (V_6 n_2 as2
+                                                              bs2
+                                                              cs2
+                                                              ds2
+                                                              es2
+                                                              fs2)
+      = do
+          G.basicUnsafeCopy as1 as2
+          G.basicUnsafeCopy bs1 bs2
+          G.basicUnsafeCopy cs1 cs2
+          G.basicUnsafeCopy ds1 ds2
+          G.basicUnsafeCopy es1 es2
+          G.basicUnsafeCopy fs1 fs2
   {-# INLINE elemseq  #-}
   elemseq _ (a, b, c, d, e, f) x_
       = G.elemseq (undefined :: Vector a) a $