Store Ptr to data instead of offset in storable vectors
authorRoman Leshchinskiy <rl@cse.unsw.edu.au>
Sun, 4 Apr 2010 13:20:17 +0000 (13:20 +0000)
committerRoman Leshchinskiy <rl@cse.unsw.edu.au>
Sun, 4 Apr 2010 13:20:17 +0000 (13:20 +0000)
Data/Vector/Storable.hs
Data/Vector/Storable/Internal.hs
Data/Vector/Storable/Mutable.hs

index b4583c0..b9e3b3f 100644 (file)
@@ -111,7 +111,7 @@ import qualified Prelude
 #include "vector.h"
 
 -- | 'Storable'-based vectors
-data Vector a = Vector {-# UNPACK #-} !Int
+data Vector a = Vector {-# UNPACK #-} !(Ptr a)
                        {-# UNPACK #-} !Int
                        {-# UNPACK #-} !(ForeignPtr a)
 
@@ -125,18 +125,19 @@ type instance G.Mutable Vector = MVector
 
 instance Storable a => G.Vector Vector a where
   {-# INLINE unsafeFreeze #-}
-  unsafeFreeze (MVector i n p) = return $ Vector i n p
+  unsafeFreeze (MVector p n fp) = return $ Vector p n fp
 
   {-# INLINE basicLength #-}
   basicLength (Vector _ n _) = n
 
   {-# INLINE basicUnsafeSlice #-}
-  basicUnsafeSlice j n (Vector i _ p) = Vector (i+j) n p
+  basicUnsafeSlice i n (Vector p _ fp) = Vector (p `advancePtr` i) n fp
 
   {-# INLINE basicUnsafeIndexM #-}
-  basicUnsafeIndexM (Vector i _ p) j = return
-                                     . inlinePerformIO
-                                     $ withForeignPtr p (`peekElemOff` (i+j))
+  basicUnsafeIndexM (Vector p _ fp) i = return
+                                      . inlinePerformIO
+                                      $ withForeignPtr fp $ \_ ->
+                                        peekElemOff p i
 
   {-# INLINE elemseq #-}
   elemseq _ = seq
@@ -889,23 +890,23 @@ fromListN = G.fromListN
 
 -- | Create a vector from a 'ForeignPtr' with an offset and a length. The data
 -- may not be modified through the 'ForeignPtr' afterwards.
-unsafeFromForeignPtr :: ForeignPtr a    -- ^ pointer
+unsafeFromForeignPtr :: Storable a
+                     => ForeignPtr a    -- ^ pointer
                      -> Int             -- ^ offset
                      -> Int             -- ^ length
                      -> Vector a
 {-# INLINE unsafeFromForeignPtr #-}
-unsafeFromForeignPtr p i n = Vector i n p
+unsafeFromForeignPtr fp i n = Vector (offsetToPtr fp i) n fp
 
 -- | Yield the underlying 'ForeignPtr' together with the offset to the data
 -- and its length. The data may not be modified through the 'ForeignPtr'.
-unsafeToForeignPtr :: Vector a -> (ForeignPtr a, Int, Int)
+unsafeToForeignPtr :: Storable a => Vector a -> (ForeignPtr a, Int, Int)
 {-# INLINE unsafeToForeignPtr #-}
-unsafeToForeignPtr (Vector i n p) = (p,i,n)
+unsafeToForeignPtr (Vector p n fp) = (fp, ptrToOffset fp p, n)
 
 -- | Pass a pointer to the vector's data to the IO action. The data may not be
 -- modified through the 'Ptr.
 unsafeWith :: Storable a => Vector a -> (Ptr a -> IO b) -> IO b
 {-# INLINE unsafeWith #-}
-unsafeWith (Vector i n fp) m
-  = withForeignPtr fp $ \p -> m (p `advancePtr` i)
+unsafeWith (Vector p n fp) m = withForeignPtr fp $ \_ -> m p
 
index a64b99e..da388bd 100644 (file)
@@ -1,4 +1,4 @@
-{-# LANGUAGE MagicHash, UnboxedTuples #-}
+{-# LANGUAGE MagicHash, UnboxedTuples, ScopedTypeVariables #-}
 
 -- |
 -- Module      : Data.Vector.Storable.Internal
 -- Ugly internal utility functions for implementing 'Storable'-based vectors.
 --
 
-module Data.Vector.Storable.Internal
-where
+module Data.Vector.Storable.Internal (
+  inlinePerformIO,
 
-import GHC.Base         ( realWorld# )
+  ptrToOffset, offsetToPtr
+) where
+
+import Foreign.Storable
+import Foreign.ForeignPtr
+import Foreign.Ptr
+import Foreign.Marshal.Array ( advancePtr )
+import GHC.Base         ( realWorld#, quotInt )
 import GHC.IOBase       ( IO(..) )
 
 -- Stolen from the ByteString library
@@ -23,3 +30,17 @@ inlinePerformIO :: IO a -> a
 {-# INLINE inlinePerformIO #-}
 inlinePerformIO (IO m) = case m realWorld# of (# _, r #) -> r
 
+distance :: forall a. Storable a => Ptr a -> Ptr a -> Int
+{-# INLINE distance #-}
+distance p q = (p `minusPtr` q) `quotInt` sizeOf (undefined :: a)
+
+ptrToOffset :: Storable a => ForeignPtr a -> Ptr a -> Int
+{-# INLINE ptrToOffset #-}
+ptrToOffset fp q = inlinePerformIO
+                 $ withForeignPtr fp $ \p -> return (distance p q)
+
+offsetToPtr :: Storable a => ForeignPtr a -> Int -> Ptr a
+{-# INLINE offsetToPtr #-}
+offsetToPtr fp i = inlinePerformIO
+                 $ withForeignPtr fp $ \p -> return (advancePtr p i)
+
index 09370b5..a745328 100644 (file)
@@ -30,6 +30,7 @@ module Data.Vector.Storable.Mutable(
 ) where
 
 import qualified Data.Vector.Generic.Mutable as G
+import Data.Vector.Storable.Internal
 
 import Foreign.Storable
 import Foreign.ForeignPtr
@@ -44,7 +45,7 @@ import Prelude hiding( length, read )
 #include "vector.h"
 
 -- | Mutable 'Storable'-based vectors
-data MVector s a = MVector {-# UNPACK #-} !Int
+data MVector s a = MVector {-# UNPACK #-} !(Ptr a)
                            {-# UNPACK #-} !Int
                            {-# UNPACK #-} !(ForeignPtr a)
 
@@ -56,61 +57,62 @@ instance Storable a => G.MVector MVector a where
   basicLength (MVector _ n _) = n
 
   {-# INLINE basicUnsafeSlice #-}
-  basicUnsafeSlice j m (MVector i n p) = MVector (i+j) m p
+  basicUnsafeSlice j m (MVector p n fp) = MVector (p `advancePtr` j) m fp
 
   -- FIXME: implement this properly
   {-# INLINE basicOverlaps #-}
-  basicOverlaps (MVector i m p) (MVector j n q) = True
+  basicOverlaps (MVector _ _ _) (MVector _ _ _) = True
 
   {-# INLINE basicUnsafeNew #-}
   basicUnsafeNew n
     = unsafePrimToPrim
-    $ MVector 0 n `fmap` mallocForeignPtrArray n
+    $ do
+        fp <- mallocForeignPtrArray n
+        withForeignPtr fp $ \p -> return $ MVector p n fp
 
   {-# INLINE basicUnsafeRead #-}
-  basicUnsafeRead (MVector i n p) j
+  basicUnsafeRead (MVector p _ fp) i
     = unsafePrimToPrim
-    $ withForeignPtr p $ \ptr -> peekElemOff ptr (i+j)
+    $ withForeignPtr fp $ \_ -> peekElemOff p i
 
   {-# INLINE basicUnsafeWrite #-}
-  basicUnsafeWrite (MVector i n p) j x
+  basicUnsafeWrite (MVector p n fp) i x
     = unsafePrimToPrim
-    $ withForeignPtr p $ \ptr -> pokeElemOff ptr (i+j) x
+    $ withForeignPtr fp $ \_ -> pokeElemOff p i x
 
   {-# INLINE basicUnsafeCopy #-}
-  basicUnsafeCopy (MVector i n p) (MVector j _ q)
+  basicUnsafeCopy (MVector p n fp) (MVector q _ fq)
     = unsafePrimToPrim
-    $ withForeignPtr p $ \dst ->
-      withForeignPtr q $ \src ->
+    $ withForeignPtr fp $ \_ ->
+      withForeignPtr fq $ \_ ->
       do
-        memcpy (dst `advancePtr` i) (src `advancePtr` j)
-               (fromIntegral (n * sizeOf (undefined :: a)))
+        memcpy p q (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.
-unsafeFromForeignPtr :: ForeignPtr a    -- ^ pointer
+unsafeFromForeignPtr :: Storable a
+                     => ForeignPtr a    -- ^ pointer
                      -> Int             -- ^ offset
                      -> Int             -- ^ length
                      -> MVector s a
 {-# INLINE unsafeFromForeignPtr #-}
-unsafeFromForeignPtr p i n = MVector i n p
+unsafeFromForeignPtr fp i n = MVector (offsetToPtr fp i) n fp
 
 -- | Yield the underlying 'ForeignPtr' together with the offset to the data
 -- and its length. Modifying the data through the 'ForeignPtr' is
 -- unsafe if the vector could have frozen before the modification.
-unsafeToForeignPtr :: MVector s a -> (ForeignPtr a, Int, Int)
+unsafeToForeignPtr :: Storable a => MVector s a -> (ForeignPtr a, Int, Int)
 {-# INLINE unsafeToForeignPtr #-}
-unsafeToForeignPtr (MVector i n p) = (p,i,n)
+unsafeToForeignPtr (MVector p n fp) = (fp, ptrToOffset fp p, n)
 
 -- | Pass a pointer to the vector's data to the IO action. Modifying data
 -- through the pointer is unsafe if the vector could have been frozen before
 -- the modification.
 unsafeWith :: Storable a => IOVector a -> (Ptr a -> IO b) -> IO b
 {-# INLINE unsafeWith #-}
-unsafeWith (MVector i n fp) m
-  = withForeignPtr fp $ \p -> m (p `advancePtr` i)
+unsafeWith (MVector p n fp) m = withForeignPtr fp $ \_ -> m p
 
 -- | Yield a part of the mutable vector without copying it. No bounds checks
 -- are performed.