Repository : ssh://darcs.haskell.org//srv/darcs/packages/vector On branch : master
http://hackage.haskell.org/trac/ghc/changeset/7a3c18aa40f4acb4a5c91b1a12035964f5d388d7 >--------------------------------------------------------------- commit 7a3c18aa40f4acb4a5c91b1a12035964f5d388d7 Author: Bas van Dijk <[email protected]> Date: Fri Sep 30 08:21:25 2011 +0000 Add unsafeFromForeignPtr0 and unsafeToForeignPtr0 to Data.Vector.Storable.Mutable >--------------------------------------------------------------- Data/Vector/Storable/Mutable.hs | 35 +++++++++++++++++++++++++++++++++-- 1 files changed, 33 insertions(+), 2 deletions(-) diff --git a/Data/Vector/Storable/Mutable.hs b/Data/Vector/Storable/Mutable.hs index 5227022..8c3e284 100644 --- a/Data/Vector/Storable/Mutable.hs +++ b/Data/Vector/Storable/Mutable.hs @@ -52,7 +52,9 @@ module Data.Vector.Storable.Mutable( unsafeCast, -- * Raw pointers - unsafeFromForeignPtr, unsafeToForeignPtr, unsafeWith + unsafeFromForeignPtr, unsafeFromForeignPtr0, + unsafeToForeignPtr, unsafeToForeignPtr0, + unsafeWith ) where import qualified Data.Vector.Generic.Mutable as G @@ -386,15 +388,34 @@ unsafeCast (MVector n fp) -- ------------ -- | 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. +-- +-- If your offset is 0 it is more efficient to use 'unsafeFromForeignPtr0'. unsafeFromForeignPtr :: Storable a => ForeignPtr a -- ^ pointer -> Int -- ^ offset -> Int -- ^ length -> MVector s a {-# INLINE unsafeFromForeignPtr #-} -unsafeFromForeignPtr fp i n = MVector n (updPtr (`advancePtr` i) fp) +unsafeFromForeignPtr fp i n = unsafeFromForeignPtr0 fp' n + where + fp' = updPtr (`advancePtr` i) fp + +-- | /O(1)/ Create a mutable vector from a 'ForeignPtr' and a length. +-- +-- It is assumed the pointer points directly to the data (no offset). +-- Use `unsafeFromForeignPtr` if you need to specify an offset. +-- +-- Modifying data through the 'ForeignPtr' afterwards is unsafe if the vector +-- could have been frozen before the modification. +unsafeFromForeignPtr0 :: Storable a + => ForeignPtr a -- ^ pointer + -> Int -- ^ length + -> MVector s a +{-# INLINE unsafeFromForeignPtr0 #-} +unsafeFromForeignPtr0 fp n = MVector n fp -- | Yield the underlying 'ForeignPtr' together with the offset to the data -- and its length. Modifying the data through the 'ForeignPtr' is @@ -403,6 +424,16 @@ unsafeToForeignPtr :: Storable a => MVector s a -> (ForeignPtr a, Int, Int) {-# INLINE unsafeToForeignPtr #-} unsafeToForeignPtr (MVector n fp) = (fp, 0, n) +-- | /O(1)/ Yield the underlying 'ForeignPtr' together with its length. +-- +-- You can assume the pointer points directly to the data (no offset). +-- +-- Modifying the data through the 'ForeignPtr' is unsafe if the vector could +-- have frozen before the modification. +unsafeToForeignPtr0 :: Storable a => MVector s a -> (ForeignPtr a, Int) +{-# INLINE unsafeToForeignPtr0 #-} +unsafeToForeignPtr0 (MVector n fp) = (fp, 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. _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
