Repository : ssh://darcs.haskell.org//srv/darcs/packages/vector On branch : master
http://hackage.haskell.org/trac/ghc/changeset/ca066b0383a756f723f6c1c390cebf612f90a7e6 >--------------------------------------------------------------- commit ca066b0383a756f723f6c1c390cebf612f90a7e6 Author: Roman Leshchinskiy <[email protected]> Date: Fri Jun 17 23:11:45 2011 +0000 Add unsafeCast for Storable vectors (based on a patch by Bas van Dijk) >--------------------------------------------------------------- Data/Vector/Storable.hs | 22 ++++++++++++++++++++-- Data/Vector/Storable/Mutable.hs | 23 ++++++++++++++++++++++- 2 files changed, 42 insertions(+), 3 deletions(-) diff --git a/Data/Vector/Storable.hs b/Data/Vector/Storable.hs index 0b8d0cb..1991886 100644 --- a/Data/Vector/Storable.hs +++ b/Data/Vector/Storable.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, TypeFamilies, Rank2Types #-} +{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, TypeFamilies, Rank2Types, ScopedTypeVariables #-} -- | -- Module : Data.Vector.Storable @@ -124,7 +124,7 @@ module Data.Vector.Storable ( toList, fromList, fromListN, -- ** Other vector types - G.convert, + G.convert, unsafeCast, -- ** Mutable vectors freeze, thaw, copy, unsafeFreeze, unsafeThaw, unsafeCopy, @@ -1277,6 +1277,24 @@ fromListN :: Storable a => Int -> [a] -> Vector a {-# INLINE fromListN #-} fromListN = G.fromListN +-- Conversions - Unsafe casts +-- -------------------------- + +-- | /O(1)/ Unsafely cast a vector from one element type to another. +-- The operation just changes the type of the underlying pointer and does not +-- modify the elements. +-- +-- The resulting vector contains as many elements as can fit into the +-- underlying memory block. +-- +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)) + (castForeignPtr fp) + + -- Conversions - Mutable vectors -- ----------------------------- diff --git a/Data/Vector/Storable/Mutable.hs b/Data/Vector/Storable/Mutable.hs index 991f003..6d0dc0a 100644 --- a/Data/Vector/Storable/Mutable.hs +++ b/Data/Vector/Storable/Mutable.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, ScopedTypeVariables #-} -- | -- Module : Data.Vector.Storable.Mutable @@ -48,6 +48,9 @@ module Data.Vector.Storable.Mutable( -- ** Filling and copying set, copy, move, unsafeCopy, unsafeMove, + -- * Unsafe conversions + unsafeCast, + -- * Raw pointers unsafeFromForeignPtr, unsafeToForeignPtr, unsafeWith, @@ -364,6 +367,24 @@ unsafeMove :: (PrimMonad m, Storable a) {-# INLINE unsafeMove #-} unsafeMove = G.unsafeMove +-- Unsafe conversions +-- ------------------ + +-- | /O(1)/ Unsafely cast a mutable vector from one element type to another. +-- The operation just changes the type of the underlying pointer and does not +-- modify the elements. +-- +-- The resulting vector contains as many elements as can fit into the +-- underlying memory block. +-- +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)) + (castForeignPtr fp) + -- Raw pointers -- ------------ _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
