diff --git a/Control/Monad/Primitive.hs b/Control/Monad/Primitive.hs --- a/Control/Monad/Primitive.hs +++ b/Control/Monad/Primitive.hs @@ -21,7 +21,11 @@ import GHC.Prim ( State#, RealWorld, touch# ) import GHC.Base ( unsafeCoerce#, realWorld# ) +#if MIN_VERSION_base(4,2,0) +import GHC.IO ( IO(..) ) +#else import GHC.IOBase ( IO(..) ) +#endif import GHC.ST ( ST(..) ) -- | Class of primitive state-transformer monads diff --git a/Data/Primitive/Addr.hs b/Data/Primitive/Addr.hs --- a/Data/Primitive/Addr.hs +++ b/Data/Primitive/Addr.hs @@ -16,7 +16,7 @@ nullAddr, plusAddr, minusAddr, remAddr, indexOffAddr, readOffAddr, writeOffAddr, - memcpyAddr + copyAddr, moveAddr, memcpyAddr ) where import Control.Monad.Primitive @@ -45,6 +45,7 @@ minusAddr :: Addr -> Addr -> Int minusAddr (Addr a#) (Addr b#) = I# (minusAddr# a# b#) +-- | The remainder of the address and the integer. remAddr :: Addr -> Int -> Int remAddr (Addr a#) (I# i#) = I# (remAddr# a# i#) @@ -67,7 +68,28 @@ {-# 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 diff --git a/Data/Primitive/Array.hs b/Data/Primitive/Array.hs --- a/Data/Primitive/Array.hs +++ b/Data/Primitive/Array.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE MagicHash, UnboxedTuples, DeriveDataTypeable #-} +{-# LANGUAGE MagicHash, UnboxedTuples, DeriveDataTypeable, BangPatterns #-} -- | -- Module : Data.Primitive.Array @@ -15,7 +15,8 @@ Array(..), MutableArray(..), newArray, readArray, writeArray, indexArray, indexArrayM, - unsafeFreezeArray, unsafeThawArray, sameMutableArray + unsafeFreezeArray, unsafeThawArray, sameMutableArray, + copyArray, copyMutableArray ) where import Control.Monad.Primitive @@ -24,7 +25,8 @@ import GHC.Prim import Data.Typeable ( Typeable ) -import Data.Data ( Data(..), mkNorepType ) +import Data.Data ( Data(..) ) +import Data.Primitive.Internal.Compat ( mkNoRepType ) -- | Boxed arrays data Array a = Array (Array# a) deriving ( Typeable ) @@ -106,13 +108,59 @@ sameMutableArray (MutableArray arr#) (MutableArray brr#) = sameMutableArray# arr# brr# +-- | Copy a slice of an immutable array to a mutable array. +copyArray :: PrimMonad m + => MutableArray (PrimState m) a -- ^ destination array + -> Int -- ^ offset into destination array + -> Array a -- ^ source array + -> Int -- ^ offset into source array + -> Int -- ^ number of elements to copy + -> m () +{-# INLINE copyArray #-} +#if __GLASGOW_HASKELL__ >= 702 +copyArray (MutableArray dst#) (I# doff#) (Array src#) (I# soff#) (I# len#) + = primitive_ (copyArray# src# soff# dst# doff# len#) +#else +copyArray !dst !doff !src !soff !len = go 0 + where + go i | i < len = do + x <- indexArrayM src (soff+i) + writeArray dst (doff+i) x + go (i+1) + | otherwise = return () +#endif + +-- | Copy a slice of a mutable array to another array. The two arrays may +-- not be the same. +copyMutableArray :: PrimMonad m + => MutableArray (PrimState m) a -- ^ destination array + -> Int -- ^ offset into destination array + -> MutableArray (PrimState m) a -- ^ source array + -> Int -- ^ offset into source array + -> Int -- ^ number of elements to copy + -> m () +{-# INLINE copyMutableArray #-} +#if __GLASGOW_HASKELL__ >= 702 +copyMutableArray (MutableArray dst#) (I# doff#) + (MutableArray src#) (I# soff#) (I# len#) + = primitive_ (copyMutableArray# src# soff# dst# doff# len#) +#else +copyMutableArray !dst !doff !src !soff !len = go 0 + where + go i | i < len = do + x <- readArray src (soff+i) + writeArray dst (doff+i) x + go (i+1) + | otherwise = return () +#endif + instance Typeable a => Data (Array a) where toConstr _ = error "toConstr" gunfold _ _ = error "gunfold" - dataTypeOf _ = mkNorepType "Data.Primitive.Array.Array" + dataTypeOf _ = mkNoRepType "Data.Primitive.Array.Array" instance (Typeable s, Typeable a) => Data (MutableArray s a) where toConstr _ = error "toConstr" gunfold _ _ = error "gunfold" - dataTypeOf _ = mkNorepType "Data.Primitive.Array.MutableArray" + dataTypeOf _ = mkNoRepType "Data.Primitive.Array.MutableArray" diff --git a/Data/Primitive/ByteArray.hs b/Data/Primitive/ByteArray.hs --- a/Data/Primitive/ByteArray.hs +++ b/Data/Primitive/ByteArray.hs @@ -20,7 +20,9 @@ unsafeFreezeByteArray, unsafeThawByteArray, sizeofByteArray, sizeofMutableByteArray, sameMutableByteArray, byteArrayContents, mutableByteArrayContents, + copyByteArray, copyMutableByteArray, moveByteArray, fillByteArray, + -- * Deprecated operations memcpyByteArray, memcpyByteArray', memmoveByteArray, memsetByteArray ) where @@ -33,7 +35,8 @@ import GHC.Prim import Data.Typeable ( Typeable ) -import Data.Data ( Data(..), mkNorepType ) +import Data.Data ( Data(..) ) +import Data.Primitive.Internal.Compat ( mkNoRepType ) -- | Byte arrays data ByteArray = ByteArray ByteArray# deriving ( Typeable ) @@ -136,47 +139,115 @@ writeByteArray (MutableByteArray arr#) (I# i#) x = primitive_ (writeByteArray# arr# i# x) +#if __GLASGOW_HASKELL__ >= 702 +i# :: Int -> Int# +i# (I# n#) = n# +#endif + +-- | Copy a slice of an immutable byte array to a mutable byte array. +copyByteArray + :: PrimMonad m => MutableByteArray (PrimState m) + -- ^ destination array + -> Int -- ^ offset into destination array + -> ByteArray -- ^ source array + -> Int -- ^ offset into source array + -> Int -- ^ number of bytes to copy + -> m () +{-# INLINE copyByteArray #-} +copyByteArray (MutableByteArray dst#) doff (ByteArray src#) soff sz +#if __GLASGOW_HASKELL__ >= 702 + = primitive_ (copyByteArray# src# (i# soff) dst# (i# doff) (i# sz)) +#else + = unsafePrimToPrim + $ memcpy_ba dst# (fromIntegral doff) src# (fromIntegral soff) + (fromIntegral sz) +#endif + +-- | Copy a slice of a mutable byte array into another array. The two slices +-- may not overlap. +copyMutableByteArray + :: PrimMonad m => MutableByteArray (PrimState m) + -- ^ destination array + -> Int -- ^ offset into destination array + -> MutableByteArray (PrimState m) + -- ^ source array + -> Int -- ^ offset into source array + -> Int -- ^ number of bytes to copy + -> m () +{-# INLINE copyMutableByteArray #-} +copyMutableByteArray (MutableByteArray dst#) doff + (MutableByteArray src#) soff sz +#if __GLASGOW_HASKELL__ >= 702 + = primitive_ (copyMutableByteArray# src# (i# soff) dst# (i# doff) (i# sz)) +#else + = unsafePrimToPrim + $ memcpy_mba dst# (fromIntegral doff) src# (fromIntegral soff) + (fromIntegral sz) +#endif + +-- | Copy a slice of a mutable byte array into another, potentially +-- overlapping array. +moveByteArray + :: PrimMonad m => MutableByteArray (PrimState m) + -- ^ destination array + -> Int -- ^ offset into destination array + -> MutableByteArray (PrimState m) + -- ^ source array + -> Int -- ^ offset into source array + -> Int -- ^ number of bytes to copy + -> m () +{-# INLINE moveByteArray #-} +moveByteArray (MutableByteArray dst#) doff + (MutableByteArray src#) soff sz + = unsafePrimToPrim + $ memmove_mba dst# (fromIntegral doff) src# (fromIntegral soff) + (fromIntegral sz) + +-- | Fill a slice of a mutable byte array with a value. +fillByteArray + :: PrimMonad m => MutableByteArray (PrimState m) + -- ^ array to fill + -> Int -- ^ offset into array + -> Int -- ^ number of bytes to fill + -> Word8 -- ^ value to fill with + -> m () +{-# INLINE fillByteArray #-} +fillByteArray (MutableByteArray dst#) doff c sz + = unsafePrimToPrim + $ memset_mba dst# (fromIntegral doff) (fromIntegral c) (fromIntegral sz) + + + memcpyByteArray :: PrimMonad m => MutableByteArray (PrimState m) -> Int -> MutableByteArray (PrimState m) -> Int -> Int -> m () +{-# DEPRECATED memcpyByteArray "Use copyMutableByteArray instead" #-} {-# INLINE memcpyByteArray #-} -memcpyByteArray (MutableByteArray dst#) doff - (MutableByteArray src#) soff sz - = unsafePrimToPrim - $ memcpy_mba dst# (fromIntegral doff) src# (fromIntegral soff) - (fromIntegral sz) +memcpyByteArray = copyMutableByteArray memcpyByteArray' :: PrimMonad m => MutableByteArray (PrimState m) -> Int -> ByteArray -> Int -> Int -> m () +{-# DEPRECATED memcpyByteArray' "Use copyByteArray instead" #-} {-# INLINE memcpyByteArray' #-} -memcpyByteArray' (MutableByteArray dst#) doff - (ByteArray src#) soff sz - = unsafePrimToPrim - $ memcpy_ba dst# (fromIntegral doff) src# (fromIntegral soff) - (fromIntegral sz) +memcpyByteArray' = copyByteArray memmoveByteArray :: PrimMonad m => MutableByteArray (PrimState m) -> Int -> MutableByteArray (PrimState m) -> Int -> Int -> m () +{-# DEPRECATED memmoveByteArray "Use moveByteArray instead" #-} {-# INLINE memmoveByteArray #-} -memmoveByteArray (MutableByteArray dst#) doff - (MutableByteArray src#) soff sz - = unsafePrimToPrim - $ memmove_mba dst# (fromIntegral doff) src# (fromIntegral soff) - (fromIntegral sz) +memmoveByteArray = moveByteArray memsetByteArray :: PrimMonad m => MutableByteArray (PrimState m) -> Int -> Word8 -> Int -> m () +{-# DEPRECATED memsetByteArray "Use fillByteArray instead (WARNING: order of arguments is different)" #-} {-# INLINE memsetByteArray #-} -memsetByteArray (MutableByteArray dst#) doff c sz - = unsafePrimToPrim - $ memset_mba dst# (fromIntegral doff) (fromIntegral c) (fromIntegral sz) - +memsetByteArray dst off x sz = fillByteArray dst off sz x foreign import ccall unsafe "primitive-memops.h memcpy_off" @@ -200,10 +271,10 @@ instance Data ByteArray where toConstr _ = error "toConstr" gunfold _ _ = error "gunfold" - dataTypeOf _ = mkNorepType "Data.Primitive.ByteArray.ByteArray" + dataTypeOf _ = mkNoRepType "Data.Primitive.ByteArray.ByteArray" instance Typeable s => Data (MutableByteArray s) where toConstr _ = error "toConstr" gunfold _ _ = error "gunfold" - dataTypeOf _ = mkNorepType "Data.Primitive.ByteArray.MutableByteArray" + dataTypeOf _ = mkNoRepType "Data.Primitive.ByteArray.MutableByteArray" diff --git a/Data/Primitive/Internal/Compat.hs b/Data/Primitive/Internal/Compat.hs new file mode 100644 --- /dev/null +++ b/Data/Primitive/Internal/Compat.hs @@ -0,0 +1,10 @@ +module Data.Primitive.Internal.Compat (mkNoRepType) where + +#if MIN_VERSION_base(4,2,0) +import Data.Data (mkNoRepType) +#else +import Data.Data (mkNorepType) + +mkNoRepType = mkNorepType +#endif + diff --git a/Data/Primitive/MachDeps.hs b/Data/Primitive/MachDeps.hs --- a/Data/Primitive/MachDeps.hs +++ b/Data/Primitive/MachDeps.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE CPP #-} - -- | -- Module : Data.Primitive.MachDeps -- Copyright : (c) Roman Leshchinskiy 2009 diff --git a/Data/Primitive/Types.hs b/Data/Primitive/Types.hs --- a/Data/Primitive/Types.hs +++ b/Data/Primitive/Types.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE UnboxedTuples, MagicHash, CPP, DeriveDataTypeable #-} +{-# LANGUAGE UnboxedTuples, MagicHash, DeriveDataTypeable #-} -- | -- Module : Data.Primitive.Types @@ -36,7 +36,8 @@ import GHC.Prim import Data.Typeable ( Typeable ) -import Data.Data ( Data(..), mkNorepType ) +import Data.Data ( Data(..) ) +import Data.Primitive.Internal.Compat ( mkNoRepType ) -- | A machine address data Addr = Addr Addr# deriving ( Typeable ) @@ -54,7 +55,7 @@ instance Data Addr where toConstr _ = error "toConstr" gunfold _ _ = error "gunfold" - dataTypeOf _ = mkNorepType "Data.Primitive.Types.Addr" + dataTypeOf _ = mkNoRepType "Data.Primitive.Types.Addr" -- | Class of types supporting primitive array operations diff --git a/primitive.cabal b/primitive.cabal --- a/primitive.cabal +++ b/primitive.cabal @@ -1,5 +1,5 @@ Name: primitive -Version: 0.3.1 +Version: 0.4 License: BSD3 License-File: LICENSE Author: Roman Leshchinskiy @@ -13,11 +13,28 @@ This package provides wrappers for primitive array operations from GHC.Prim. . + Changes in version 0.4 + . + * Support for GHC 7.2 array copying primitives + . + * New in "Data.Primitive.ByteArray": @copyByteArray@, + @copyMutableByteArray@, @moveByteArray@, @fillByteArray@ + . + * Deprecated in "Data.Primitive.ByteArray": @memcpyByteArray@, + @memcpyByteArray'@, @memmoveByteArray@, @memsetByteArray@ + . + * New in "Data.Primitive.Array": @copyArray@, @copyMutableByteArray@ + . + * New in "Data.Primitive.Addr": @copyAddr@, @moveAddr@ + . + * Deprecated in "Data.Primitive.Addr": @memcpyAddr@ + . Cabal-Version: >= 1.2 Build-Type: Simple Library + Extensions: CPP Exposed-Modules: Control.Monad.Primitive Data.Primitive @@ -26,6 +43,9 @@ Data.Primitive.Array Data.Primitive.ByteArray Data.Primitive.Addr + + Other-Modules: + Data.Primitive.Internal.Compat Build-Depends: base >= 4 && < 5, ghc-prim