Repository : ssh://darcs.haskell.org//srv/darcs/packages/primitive On branch : master
http://hackage.haskell.org/trac/ghc/changeset/43b49de526e120c512999f7329c82e9020bbe850 >--------------------------------------------------------------- commit 43b49de526e120c512999f7329c82e9020bbe850 Author: Roman Leshchinskiy <[email protected]> Date: Sun Aug 28 23:04:25 2011 +0000 Add copyAddr and moveAddr and deprecate memcpyAddr >--------------------------------------------------------------- Data/Primitive/Addr.hs | 27 ++++++++++++++++++++++++--- 1 files changed, 24 insertions(+), 3 deletions(-) diff --git a/Data/Primitive/Addr.hs b/Data/Primitive/Addr.hs index df996c5..fb0fd84 100644 --- a/Data/Primitive/Addr.hs +++ b/Data/Primitive/Addr.hs @@ -16,7 +16,7 @@ module Data.Primitive.Addr ( nullAddr, plusAddr, minusAddr, remAddr, indexOffAddr, readOffAddr, writeOffAddr, - memcpyAddr + copyAddr, moveAddr, memcpyAddr ) where import Control.Monad.Primitive @@ -68,7 +68,28 @@ writeOffAddr :: (Prim a, PrimMonad m) => Addr -> Int -> a -> m () {-# INLINE writeOffAddr #-} writeOffAddr (Addr addr#) (I# i#) x = primitive_ (writeOffAddr# addr# i# x) -memcpyAddr :: PrimMonad m => Addr -> Addr -> Int -> m () -memcpyAddr (Addr dst#) (Addr src#) n +-- | Copy the given number of bytes from the second 'Addr' to the first. The +-- areas may not overlap. +copyAddr :: PrimMonad m => Addr -- ^ destination address + -> Addr -- ^ source address + -> Int -- ^ number of bytes + -> m () +{-# INLINE copyAddr #-} +copyAddr (Addr dst#) (Addr src#) n = unsafePrimToPrim $ copyBytes (Ptr dst#) (Ptr src#) n +-- | Copy the given number of bytes from the second 'Addr' to the first. The +-- areas may overlap. +moveAddr :: PrimMonad m => Addr -- ^ destination address + -> Addr -- ^ source address + -> Int -- ^ number of bytes + -> m () +{-# INLINE moveAddr #-} +moveAddr (Addr dst#) (Addr src#) n + = unsafePrimToPrim $ moveBytes (Ptr dst#) (Ptr src#) n + +memcpyAddr :: PrimMonad m => Addr -> Addr -> Int -> m () +{-# INLINE memcpyAddr #-} +{-# DEPRECATED memcpyAddr "Use copyAddr instead" #-} +memcpyAddr = copyAddr + _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
