Repository : ssh://darcs.haskell.org//srv/darcs/packages/vector On branch : master
http://hackage.haskell.org/trac/ghc/changeset/676d11c47b3b6e8a6bfa29d13e4d7675c1eb30a8 >--------------------------------------------------------------- commit 676d11c47b3b6e8a6bfa29d13e4d7675c1eb30a8 Author: Bas van Dijk <[email protected]> Date: Mon Apr 18 14:28:27 2011 +0000 Use more efficient mallocPlainForeignPtrBytes when available >--------------------------------------------------------------- Data/Vector/Storable/Mutable.hs | 19 ++++++++++++++++++- 1 files changed, 18 insertions(+), 1 deletions(-) diff --git a/Data/Vector/Storable/Mutable.hs b/Data/Vector/Storable/Mutable.hs index 409885e..c1913f7 100644 --- a/Data/Vector/Storable/Mutable.hs +++ b/Data/Vector/Storable/Mutable.hs @@ -60,6 +60,11 @@ import Data.Vector.Storable.Internal import Foreign.Storable import Foreign.ForeignPtr + +#if __GLASGOW_HASKELL__ >= 605 +import GHC.ForeignPtr (mallocPlainForeignPtrBytes) +#endif + import Foreign.Ptr import Foreign.Marshal.Array ( advancePtr, copyArray ) import Foreign.C.Types ( CInt ) @@ -100,7 +105,7 @@ instance Storable a => G.MVector MVector a where basicUnsafeNew n = unsafePrimToPrim $ do - fp <- mallocForeignPtrArray n + fp <- mallocVector n withForeignPtr fp $ \p -> return $ MVector p n fp {-# INLINE basicUnsafeRead #-} @@ -120,6 +125,18 @@ instance Storable a => G.MVector MVector a where withForeignPtr fq $ \_ -> copyArray p q n +{-# INLINE mallocVector #-} +mallocVector :: Storable a => Int -> IO (ForeignPtr a) +mallocVector = +#if __GLASGOW_HASKELL__ >= 605 + doMalloc undefined + where + doMalloc :: Storable b => b -> Int -> IO (ForeignPtr b) + doMalloc dummy size = mallocPlainForeignPtrBytes (size * sizeOf dummy) +#else + mallocForeignPtrArray +#endif + -- Length information -- ------------------ _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
