author Roman Leshchinskiy Thu, 18 Aug 2011 22:12:06 +0000 (22:12 +0000) committer Roman Leshchinskiy Thu, 18 Aug 2011 22:12:06 +0000 (22:12 +0000)

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

@@ -22,18 +20,18 @@ import Foreign.ForeignPtr
import Foreign.Ptr
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 #-}

-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 #-}

-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

-  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