Use the Addr# field in ForeignPtr for Storable vectors
authorRoman Leshchinskiy <rl@cse.unsw.edu.au>
Thu, 18 Aug 2011 22:12:06 +0000 (22:12 +0000)
committerRoman Leshchinskiy <rl@cse.unsw.edu.au>
Thu, 18 Aug 2011 22:12:06 +0000 (22:12 +0000)
Data/Vector/Storable.hs
Data/Vector/Storable/Internal.hs
Data/Vector/Storable/Mutable.hs

index 1991886..bd04166 100644 (file)
@@ -170,8 +170,7 @@ import Data.Monoid   ( Monoid(..) )
 #include "vector.h"
 
 -- | 'Storable'-based vectors
-data Vector a = Vector {-# UNPACK #-} !(Ptr a)
-                       {-# UNPACK #-} !Int
+data Vector a = Vector {-# UNPACK #-} !Int
                        {-# UNPACK #-} !(ForeignPtr a)
         deriving ( Typeable )
 
@@ -192,28 +191,28 @@ type instance G.Mutable Vector = MVector
 
 instance Storable a => G.Vector Vector a where
   {-# INLINE basicUnsafeFreeze #-}
-  basicUnsafeFreeze (MVector p n fp) = return $ Vector p n fp
+  basicUnsafeFreeze (MVector n fp) = return $ Vector n fp
 
   {-# INLINE basicUnsafeThaw #-}
-  basicUnsafeThaw (Vector p n fp) = return $ MVector p n fp
+  basicUnsafeThaw (Vector n fp) = return $ MVector n fp
 
   {-# INLINE basicLength #-}
-  basicLength (Vector n _) = n
+  basicLength (Vector n _) = n
 
   {-# INLINE basicUnsafeSlice #-}
-  basicUnsafeSlice i n (Vector p _ fp) = Vector (p `advancePtr` i) n fp
+  basicUnsafeSlice i n (Vector _ fp) = Vector n (updPtr (`advancePtr` i) fp)
 
   {-# INLINE basicUnsafeIndexM #-}
-  basicUnsafeIndexM (Vector _ fp) i = return
-                                      . unsafeInlineIO
-                                      $ withForeignPtr fp $ \_ ->
-                                        peekElemOff p i
+  basicUnsafeIndexM (Vector _ fp) i = return
+                                    . unsafeInlineIO
+                                    $ withForeignPtr fp $ \p ->
+                                      peekElemOff p i
 
   {-# INLINE basicUnsafeCopy #-}
-  basicUnsafeCopy (MVector p n fp) (Vector q _ fq)
+  basicUnsafeCopy (MVector n fp) (Vector _ fq)
     = unsafePrimToPrim
-    $ withForeignPtr fp $ \_ ->
-      withForeignPtr fq $ \_ ->
+    $ withForeignPtr fp $ \p ->
+      withForeignPtr fq $ \q ->
       copyArray p q n
 
   {-# INLINE elemseq #-}
@@ -1289,9 +1288,8 @@ fromListN = G.fromListN
 --
 unsafeCast :: forall a b. (Storable a, Storable b) => Vector a -> Vector b
 {-# INLINE unsafeCast #-}
-unsafeCast (Vector p n fp)
-  = Vector (castPtr p)
-           ((n * sizeOf (undefined :: a)) `div` sizeOf (undefined :: b))
+unsafeCast (Vector n fp)
+  = Vector ((n * sizeOf (undefined :: a)) `div` sizeOf (undefined :: b))
            (castForeignPtr fp)
 
 
@@ -1346,18 +1344,18 @@ unsafeFromForeignPtr :: Storable a
                      -> Int             -- ^ length
                      -> Vector a
 {-# INLINE unsafeFromForeignPtr #-}
-unsafeFromForeignPtr fp i n = Vector (offsetToPtr fp i) n fp
+unsafeFromForeignPtr fp i n = Vector n (updPtr (`advancePtr` i) fp)
 
 -- | /O(1)/ Yield the underlying 'ForeignPtr' together with the offset to the
 -- data and its length. The data may not be modified through the 'ForeignPtr'.
 unsafeToForeignPtr :: Storable a => Vector a -> (ForeignPtr a, Int, Int)
 {-# INLINE unsafeToForeignPtr #-}
-unsafeToForeignPtr (Vector p n fp) = (fp, ptrToOffset fp p, n)
+unsafeToForeignPtr (Vector n fp) = (fp, 0, 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 p n fp) m = withForeignPtr fp $ \_ -> m p
+unsafeWith (Vector n fp) = withForeignPtr fp
 
 
index ac2704d..73a4ff0 100644 (file)
@@ -1,5 +1,3 @@
-{-# LANGUAGE MagicHash, UnboxedTuples, ScopedTypeVariables #-}
-
 -- |
 -- Module      : Data.Vector.Storable.Internal
 -- Copyright   : (c) Roman Leshchinskiy 2009-2010
@@ -13,7 +11,7 @@
 --
 
 module Data.Vector.Storable.Internal (
-  ptrToOffset, offsetToPtr
+  getPtr, setPtr, updPtr
 ) where
 
 import Control.Monad.Primitive ( unsafeInlineIO )
@@ -22,18 +20,18 @@ import Foreign.ForeignPtr
 import Foreign.Ptr
 import Foreign.Marshal.Array ( advancePtr )
 import GHC.Base         ( quotInt )
+import GHC.ForeignPtr   ( ForeignPtr(..) )
+import GHC.Ptr          ( Ptr(..) )
 
-distance :: forall a. Storable a => Ptr a -> Ptr a -> Int
-{-# INLINE distance #-}
-distance p q = (p `minusPtr` q) `quotInt` sizeOf (undefined :: a)
+getPtr :: ForeignPtr a -> Ptr a
+{-# INLINE getPtr #-}
+getPtr (ForeignPtr addr _) = Ptr addr
 
-ptrToOffset :: Storable a => ForeignPtr a -> Ptr a -> Int
-{-# INLINE ptrToOffset #-}
-ptrToOffset fp q = unsafeInlineIO
-                 $ withForeignPtr fp $ \p -> return (distance q p)
+setPtr :: ForeignPtr a -> Ptr a -> ForeignPtr a
+{-# INLINE setPtr #-}
+setPtr (ForeignPtr _ c) (Ptr addr) = ForeignPtr addr c
 
-offsetToPtr :: Storable a => ForeignPtr a -> Int -> Ptr a
-{-# INLINE offsetToPtr #-}
-offsetToPtr fp i = unsafeInlineIO
-                 $ withForeignPtr fp $ \p -> return (advancePtr p i)
+updPtr :: (Ptr a -> Ptr a) -> ForeignPtr a -> ForeignPtr a
+{-# INLINE updPtr #-}
+updPtr f (ForeignPtr p c) = case f (Ptr p) of { Ptr q -> ForeignPtr q c }
 
index 1f3d2af..5227022 100644 (file)
@@ -79,8 +79,7 @@ import Data.Typeable ( Typeable )
 #include "vector.h"
 
 -- | Mutable 'Storable'-based vectors
-data MVector s a = MVector {-# UNPACK #-} !(Ptr a)
-                           {-# UNPACK #-} !Int
+data MVector s a = MVector {-# UNPACK #-} !Int
                            {-# UNPACK #-} !(ForeignPtr a)
         deriving ( Typeable )
 
@@ -89,47 +88,49 @@ type STVector s = MVector s
 
 instance Storable a => G.MVector MVector a where
   {-# INLINE basicLength #-}
-  basicLength (MVector n _) = n
+  basicLength (MVector n _) = n
 
   {-# INLINE basicUnsafeSlice #-}
-  basicUnsafeSlice j m (MVector p n fp) = MVector (p `advancePtr` j) m fp
+  basicUnsafeSlice j m (MVector n fp) = MVector m (updPtr (`advancePtr` j) fp)
 
   -- FIXME: this relies on non-portable pointer comparisons
   {-# INLINE basicOverlaps #-}
-  basicOverlaps (MVector p m _) (MVector q n _)
+  basicOverlaps (MVector m fp) (MVector n fq)
     = between p q (q `advancePtr` n) || between q p (p `advancePtr` m)
     where
       between x y z = x >= y && x < z
+      p = getPtr fp
+      q = getPtr fq
 
   {-# INLINE basicUnsafeNew #-}
   basicUnsafeNew n
     = unsafePrimToPrim
     $ do
         fp <- mallocVector n
-        withForeignPtr fp $ \p -> return $ MVector p n fp
+        return $ MVector n fp
 
   {-# INLINE basicUnsafeRead #-}
-  basicUnsafeRead (MVector _ fp) i
+  basicUnsafeRead (MVector _ fp) i
     = unsafePrimToPrim
-    $ withForeignPtr fp $ \_ -> peekElemOff p i
+    $ withForeignPtr fp (`peekElemOff` i)
 
   {-# INLINE basicUnsafeWrite #-}
-  basicUnsafeWrite (MVector p n fp) i x
+  basicUnsafeWrite (MVector _ fp) i x
     = unsafePrimToPrim
-    $ withForeignPtr fp $ \_ -> pokeElemOff p i x
+    $ withForeignPtr fp $ \p -> pokeElemOff p i x
 
   {-# INLINE basicUnsafeCopy #-}
-  basicUnsafeCopy (MVector p n fp) (MVector q _ fq)
+  basicUnsafeCopy (MVector n fp) (MVector _ fq)
     = unsafePrimToPrim
-    $ withForeignPtr fp $ \_ ->
-      withForeignPtr fq $ \_ ->
+    $ withForeignPtr fp $ \p ->
+      withForeignPtr fq $ \q ->
       copyArray p q n
   
   {-# INLINE basicUnsafeMove #-}
-  basicUnsafeMove (MVector p n fp) (MVector q _ fq)
+  basicUnsafeMove (MVector n fp) (MVector _ fq)
     = unsafePrimToPrim
-    $ withForeignPtr fp $ \_ ->
-      withForeignPtr fq $ \_ ->
+    $ withForeignPtr fp $ \p ->
+      withForeignPtr fq $ \q ->
       moveArray p q n
 
 {-# INLINE mallocVector #-}
@@ -377,9 +378,8 @@ unsafeMove = G.unsafeMove
 unsafeCast :: forall a b s.
               (Storable a, Storable b) => MVector s a -> MVector s b
 {-# INLINE unsafeCast #-}
-unsafeCast (MVector p n fp)
-  = MVector (castPtr p)
-            ((n * sizeOf (undefined :: a)) `div` sizeOf (undefined :: b))
+unsafeCast (MVector n fp)
+  = MVector ((n * sizeOf (undefined :: a)) `div` sizeOf (undefined :: b))
             (castForeignPtr fp)
 
 -- Raw pointers
@@ -394,19 +394,19 @@ unsafeFromForeignPtr :: Storable a
                      -> Int             -- ^ length
                      -> MVector s a
 {-# INLINE unsafeFromForeignPtr #-}
-unsafeFromForeignPtr fp i n = MVector (offsetToPtr fp i) n fp
+unsafeFromForeignPtr fp i n = MVector n (updPtr (`advancePtr` i) 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 :: Storable a => MVector s a -> (ForeignPtr a, Int, Int)
 {-# INLINE unsafeToForeignPtr #-}
-unsafeToForeignPtr (MVector p n fp) = (fp, ptrToOffset fp p, n)
+unsafeToForeignPtr (MVector n fp) = (fp, 0, 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 p n fp) m = withForeignPtr fp $ \_ -> m p
+unsafeWith (MVector n fp) = withForeignPtr fp