primitive 0.7.1.0 → 0.7.2.0
raw patch · 10 files changed
+153/−32 lines, 10 filesdep ~basedep ~tastydep ~transformers
Dependency ranges changed: base, tasty, transformers
Files
- Control/Monad/Primitive.hs +11/−6
- Data/Primitive/ByteArray.hs +35/−2
- Data/Primitive/Internal/Operations.hs +46/−1
- Data/Primitive/PrimArray.hs +24/−4
- Data/Primitive/Types.hs +13/−6
- cbits/primitive-memops.c +3/−3
- cbits/primitive-memops.h +3/−3
- changelog.md +7/−0
- primitive.cabal +8/−7
- test/main.hs +3/−0
Control/Monad/Primitive.hs view
@@ -40,14 +40,17 @@ import Control.Monad.Trans.Cont ( ContT ) import Control.Monad.Trans.Identity ( IdentityT (IdentityT) )-import Control.Monad.Trans.List ( ListT ) import Control.Monad.Trans.Maybe ( MaybeT )-import Control.Monad.Trans.Error ( ErrorT, Error) import Control.Monad.Trans.Reader ( ReaderT ) import Control.Monad.Trans.State ( StateT ) import Control.Monad.Trans.Writer ( WriterT ) import Control.Monad.Trans.RWS ( RWST ) +#if !MIN_VERSION_transformers(0,6,0)+import Control.Monad.Trans.List ( ListT )+import Control.Monad.Trans.Error ( ErrorT, Error)+#endif+ #if MIN_VERSION_transformers(0,4,0) import Control.Monad.Trans.Except ( ExceptT ) #endif@@ -117,18 +120,20 @@ internal (IdentityT m) = internal m {-# INLINE internal #-} +#if !MIN_VERSION_transformers(0,6,0) instance PrimMonad m => PrimMonad (ListT m) where type PrimState (ListT m) = PrimState m primitive = lift . primitive {-# INLINE primitive #-} -instance PrimMonad m => PrimMonad (MaybeT m) where- type PrimState (MaybeT m) = PrimState m+instance (Error e, PrimMonad m) => PrimMonad (ErrorT e m) where+ type PrimState (ErrorT e m) = PrimState m primitive = lift . primitive {-# INLINE primitive #-}+#endif -instance (Error e, PrimMonad m) => PrimMonad (ErrorT e m) where- type PrimState (ErrorT e m) = PrimState m+instance PrimMonad m => PrimMonad (MaybeT m) where+ type PrimState (MaybeT m) = PrimState m primitive = lift . primitive {-# INLINE primitive #-}
Data/Primitive/ByteArray.hs view
@@ -41,7 +41,7 @@ compareByteArrays, -- * Freezing and thawing- freezeByteArray,+ freezeByteArray, thawByteArray, unsafeFreezeByteArray, unsafeThawByteArray, -- * Block operations@@ -74,6 +74,8 @@ import Foreign.C.Types import Data.Word ( Word8 )+import Data.Bits ( (.&.), unsafeShiftR )+import GHC.Show ( intToDigit ) import GHC.Base ( Int(..) ) #if __GLASGOW_HASKELL__ >= 708 import qualified GHC.Exts as Exts ( IsList(..) )@@ -232,6 +234,25 @@ copyMutableByteArray dst 0 src off len unsafeFreezeByteArray dst +-- | Create a mutable byte array from a slice of an immutable byte array.+-- The offset and length are given in bytes.+--+-- This operation makes a copy of the specified slice, so it is safe to+-- use the immutable array afterward.+--+-- @since 0.7.2.0+thawByteArray+ :: PrimMonad m+ => ByteArray -- ^ source+ -> Int -- ^ offset in bytes+ -> Int -- ^ length in bytes+ -> m (MutableByteArray (PrimState m))+{-# INLINE thawByteArray #-}+thawByteArray !src !off !len = do+ dst <- newByteArray len+ copyByteArray dst 0 src off len+ return dst+ -- | Convert a mutable byte array to an immutable one without copying. The -- array should not be modified after the conversion. unsafeFreezeByteArray@@ -543,12 +564,24 @@ dataTypeOf _ = mkNoRepType "Data.Primitive.ByteArray.MutableByteArray" -- | @since 0.6.3.0+--+-- Behavior changed in 0.7.2.0. Before 0.7.2.0, this instance rendered+-- 8-bit words less than 16 as a single hexadecimal digit (e.g. 13 was @0xD@).+-- Starting with 0.7.2.0, all 8-bit words are represented as two digits+-- (e.g. 13 is @0x0D@). instance Show ByteArray where showsPrec _ ba = showString "[" . go 0 where+ showW8 :: Word8 -> String -> String+ showW8 !w s =+ '0'+ : 'x'+ : intToDigit (fromIntegral (unsafeShiftR w 4))+ : intToDigit (fromIntegral (w .&. 0x0F))+ : s go i- | i < sizeofByteArray ba = comma . showString "0x" . showHex (indexByteArray ba i :: Word8) . go (i+1)+ | i < sizeofByteArray ba = comma . showW8 (indexByteArray ba i :: Word8) . go (i+1) | otherwise = showChar ']' where comma | i == 0 = id
Data/Primitive/Internal/Operations.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE MagicHash, UnliftedFFITypes #-}+{-# LANGUAGE CPP, MagicHash, UnliftedFFITypes #-} -- | -- Module : Data.Primitive.Internal.Operations@@ -32,26 +32,49 @@ import Foreign.C.Types import GHC.Exts ++#if __GLASGOW_HASKELL__ >= 902 foreign import ccall unsafe "primitive-memops.h hsprimitive_memset_Word8"+ setWord8Array# :: MutableByteArray# s -> CPtrdiff -> CSize -> Word8# -> IO ()+foreign import ccall unsafe "primitive-memops.h hsprimitive_memset_Word16"+ setWord16Array# :: MutableByteArray# s -> CPtrdiff -> CSize -> Word16# -> IO ()+foreign import ccall unsafe "primitive-memops.h hsprimitive_memset_Word32"+ setWord32Array# :: MutableByteArray# s -> CPtrdiff -> CSize -> Word32# -> IO ()+#else+foreign import ccall unsafe "primitive-memops.h hsprimitive_memset_Word8" setWord8Array# :: MutableByteArray# s -> CPtrdiff -> CSize -> Word# -> IO () foreign import ccall unsafe "primitive-memops.h hsprimitive_memset_Word16" setWord16Array# :: MutableByteArray# s -> CPtrdiff -> CSize -> Word# -> IO () foreign import ccall unsafe "primitive-memops.h hsprimitive_memset_Word32" setWord32Array# :: MutableByteArray# s -> CPtrdiff -> CSize -> Word# -> IO ()+#endif+ foreign import ccall unsafe "primitive-memops.h hsprimitive_memset_Word64" setWord64Array# :: MutableByteArray# s -> CPtrdiff -> CSize -> Word64_# -> IO () foreign import ccall unsafe "primitive-memops.h hsprimitive_memset_Word" setWordArray# :: MutableByteArray# s -> CPtrdiff -> CSize -> Word# -> IO ()++#if __GLASGOW_HASKELL__ >= 902 foreign import ccall unsafe "primitive-memops.h hsprimitive_memset_Word8"+ setInt8Array# :: MutableByteArray# s -> CPtrdiff -> CSize -> Int8# -> IO ()+foreign import ccall unsafe "primitive-memops.h hsprimitive_memset_Word16"+ setInt16Array# :: MutableByteArray# s -> CPtrdiff -> CSize -> Int16# -> IO ()+foreign import ccall unsafe "primitive-memops.h hsprimitive_memset_Word32"+ setInt32Array# :: MutableByteArray# s -> CPtrdiff -> CSize -> Int32# -> IO ()+#else+foreign import ccall unsafe "primitive-memops.h hsprimitive_memset_Word8" setInt8Array# :: MutableByteArray# s -> CPtrdiff -> CSize -> Int# -> IO () foreign import ccall unsafe "primitive-memops.h hsprimitive_memset_Word16" setInt16Array# :: MutableByteArray# s -> CPtrdiff -> CSize -> Int# -> IO () foreign import ccall unsafe "primitive-memops.h hsprimitive_memset_Word32" setInt32Array# :: MutableByteArray# s -> CPtrdiff -> CSize -> Int# -> IO ()+#endif+ foreign import ccall unsafe "primitive-memops.h hsprimitive_memset_Word64" setInt64Array# :: MutableByteArray# s -> CPtrdiff -> CSize -> Int64_# -> IO () foreign import ccall unsafe "primitive-memops.h hsprimitive_memset_Word" setIntArray# :: MutableByteArray# s -> CPtrdiff -> CSize -> Int# -> IO ()+ foreign import ccall unsafe "primitive-memops.h hsprimitive_memset_Ptr" setAddrArray# :: MutableByteArray# s -> CPtrdiff -> CSize -> Addr# -> IO () foreign import ccall unsafe "primitive-memops.h hsprimitive_memset_Ptr"@@ -63,26 +86,48 @@ foreign import ccall unsafe "primitive-memops.h hsprimitive_memset_Char" setWideCharArray# :: MutableByteArray# s -> CPtrdiff -> CSize -> Char# -> IO () +#if __GLASGOW_HASKELL__ >= 902 foreign import ccall unsafe "primitive-memops.h hsprimitive_memset_Word8"+ setWord8OffAddr# :: Addr# -> CPtrdiff -> CSize -> Word8# -> IO ()+foreign import ccall unsafe "primitive-memops.h hsprimitive_memset_Word16"+ setWord16OffAddr# :: Addr# -> CPtrdiff -> CSize -> Word16# -> IO ()+foreign import ccall unsafe "primitive-memops.h hsprimitive_memset_Word32"+ setWord32OffAddr# :: Addr# -> CPtrdiff -> CSize -> Word32# -> IO ()+#else+foreign import ccall unsafe "primitive-memops.h hsprimitive_memset_Word8" setWord8OffAddr# :: Addr# -> CPtrdiff -> CSize -> Word# -> IO () foreign import ccall unsafe "primitive-memops.h hsprimitive_memset_Word16" setWord16OffAddr# :: Addr# -> CPtrdiff -> CSize -> Word# -> IO () foreign import ccall unsafe "primitive-memops.h hsprimitive_memset_Word32" setWord32OffAddr# :: Addr# -> CPtrdiff -> CSize -> Word# -> IO ()+#endif+ foreign import ccall unsafe "primitive-memops.h hsprimitive_memset_Word64" setWord64OffAddr# :: Addr# -> CPtrdiff -> CSize -> Word64_# -> IO () foreign import ccall unsafe "primitive-memops.h hsprimitive_memset_Word" setWordOffAddr# :: Addr# -> CPtrdiff -> CSize -> Word# -> IO ()++#if __GLASGOW_HASKELL__ >= 902 foreign import ccall unsafe "primitive-memops.h hsprimitive_memset_Word8"+ setInt8OffAddr# :: Addr# -> CPtrdiff -> CSize -> Int8# -> IO ()+foreign import ccall unsafe "primitive-memops.h hsprimitive_memset_Word16"+ setInt16OffAddr# :: Addr# -> CPtrdiff -> CSize -> Int16# -> IO ()+foreign import ccall unsafe "primitive-memops.h hsprimitive_memset_Word32"+ setInt32OffAddr# :: Addr# -> CPtrdiff -> CSize -> Int32# -> IO ()+#else+foreign import ccall unsafe "primitive-memops.h hsprimitive_memset_Word8" setInt8OffAddr# :: Addr# -> CPtrdiff -> CSize -> Int# -> IO () foreign import ccall unsafe "primitive-memops.h hsprimitive_memset_Word16" setInt16OffAddr# :: Addr# -> CPtrdiff -> CSize -> Int# -> IO () foreign import ccall unsafe "primitive-memops.h hsprimitive_memset_Word32" setInt32OffAddr# :: Addr# -> CPtrdiff -> CSize -> Int# -> IO ()+#endif+ foreign import ccall unsafe "primitive-memops.h hsprimitive_memset_Word64" setInt64OffAddr# :: Addr# -> CPtrdiff -> CSize -> Int64_# -> IO () foreign import ccall unsafe "primitive-memops.h hsprimitive_memset_Word" setIntOffAddr# :: Addr# -> CPtrdiff -> CSize -> Int# -> IO ()+ foreign import ccall unsafe "primitive-memops.h hsprimitive_memset_Ptr" setAddrOffAddr# :: Addr# -> CPtrdiff -> CSize -> Addr# -> IO () foreign import ccall unsafe "primitive-memops.h hsprimitive_memset_Ptr"
Data/Primitive/PrimArray.hs view
@@ -43,6 +43,7 @@ , indexPrimArray -- * Freezing and Thawing , freezePrimArray+ , thawPrimArray , unsafeFreezePrimArray , unsafeThawPrimArray -- * Block Operations@@ -220,7 +221,7 @@ -- | Create a 'PrimArray' from a list. ----- @primArrayFromList vs = `byteArrayFromListN` (length vs) vs@+-- @primArrayFromList vs = `primArrayFromListN` (length vs) vs@ primArrayFromList :: Prim a => [a] -> PrimArray a primArrayFromList vs = primArrayFromListN (L.length vs) vs @@ -502,7 +503,26 @@ copyMutablePrimArray dst 0 src off len unsafeFreezePrimArray dst --- | Convert a mutable byte array to an immutable one without copying. The+-- | Create a mutable primitive array from a slice of an immutable primitive array.+-- The offset and length are given in elements.+--+-- This operation makes a copy of the specified slice, so it is safe to+-- use the immutable array afterward.+--+-- @since 0.7.2.0+thawPrimArray+ :: (PrimMonad m, Prim a)+ => PrimArray a -- ^ source+ -> Int -- ^ offset in elements+ -> Int -- ^ length in elements+ -> m (MutablePrimArray (PrimState m) a)+{-# INLINE thawPrimArray #-}+thawPrimArray !src !off !len = do+ dst <- newPrimArray len+ copyPrimArray dst 0 src off len+ return dst++-- | Convert a mutable primitive array to an immutable one without copying. The -- array should not be modified after the conversion. unsafeFreezePrimArray :: PrimMonad m => MutablePrimArray (PrimState m) a -> m (PrimArray a)@@ -532,9 +552,9 @@ sizeofPrimArray (PrimArray arr#) = I# (quotInt# (sizeofByteArray# arr#) (sizeOf# (undefined :: a))) #if __GLASGOW_HASKELL__ >= 802--- | Check whether or not the byte array is pinned. Pinned primitive arrays cannot+-- | Check whether or not the primitive array is pinned. Pinned primitive arrays cannot -- be moved by the garbage collector. It is safe to use 'primArrayContents'--- on such byte arrays. This function is only available when compiling with+-- on such arrays. This function is only available when compiling with -- GHC 8.2 or newer. -- -- @since 0.7.1.0
Data/Primitive/Types.hs view
@@ -250,9 +250,16 @@ ; {-# INLINE setOffAddr# #-} \ } -#if __GLASGOW_HASKELL__ >= 710+#if __GLASGOW_HASKELL__ >= 902 liberate# :: State# s -> State# r liberate# = unsafeCoerce#+shimmedSetWord8Array# :: MutableByteArray# s -> Int -> Int -> Word8# -> IO ()+shimmedSetWord8Array# m (I# off) (I# len) w = IO (\s -> (# liberate# (GHC.Exts.setByteArray# m off len (GHC.Exts.word2Int# (GHC.Exts.word8ToWord# w)) (liberate# s)), () #))+shimmedSetInt8Array# :: MutableByteArray# s -> Int -> Int -> Int8# -> IO ()+shimmedSetInt8Array# m (I# off) (I# len) i = IO (\s -> (# liberate# (GHC.Exts.setByteArray# m off len (GHC.Exts.int8ToInt# i) (liberate# s)), () #))+#elif __GLASGOW_HASKELL__ >= 710+liberate# :: State# s -> State# r+liberate# = unsafeCoerce# shimmedSetWord8Array# :: MutableByteArray# s -> Int -> Int -> Word# -> IO () shimmedSetWord8Array# m (I# off) (I# len) w = IO (\s -> (# liberate# (GHC.Exts.setByteArray# m off len (GHC.Exts.word2Int# w) (liberate# s)), () #)) shimmedSetInt8Array# :: MutableByteArray# s -> Int -> Int -> Int# -> IO ()@@ -421,8 +428,8 @@ -- | @since 0.7.1.0 instance Prim WordPtr where- sizeOf# _ = sizeOf# (undefined :: Ptr ()) - alignment# _ = alignment# (undefined :: Ptr ()) + sizeOf# _ = sizeOf# (undefined :: Ptr ())+ alignment# _ = alignment# (undefined :: Ptr ()) indexByteArray# a i = ptrToWordPtr (indexByteArray# a i) readByteArray# a i s0 = case readByteArray# a i s0 of (# s1, p #) -> (# s1, ptrToWordPtr p #)@@ -433,11 +440,11 @@ (# s1, p #) -> (# s1, ptrToWordPtr p #) writeOffAddr# a i wp = writeOffAddr# a i (wordPtrToPtr wp) setOffAddr# a i n wp = setOffAddr# a i n (wordPtrToPtr wp)- + -- | @since 0.7.1.0 instance Prim IntPtr where- sizeOf# _ = sizeOf# (undefined :: Ptr ()) - alignment# _ = alignment# (undefined :: Ptr ()) + sizeOf# _ = sizeOf# (undefined :: Ptr ())+ alignment# _ = alignment# (undefined :: Ptr ()) indexByteArray# a i = ptrToIntPtr (indexByteArray# a i) readByteArray# a i s0 = case readByteArray# a i s0 of (# s1, p #) -> (# s1, ptrToIntPtr p #)
cbits/primitive-memops.c view
@@ -45,14 +45,14 @@ return memcmp( s1 + off1, s2 + off2, n ); } -void hsprimitive_memset_Word8 (HsWord8 *p, ptrdiff_t off, size_t n, HsWord x)+void hsprimitive_memset_Word8 (HsWord8 *p, ptrdiff_t off, size_t n, HsWord8 x) { memset( (char *)(p+off), x, n ); } /* MEMSET(HsWord8, HsWord) */-MEMSET(Word16, HsWord)-MEMSET(Word32, HsWord)+MEMSET(Word16, HsWord16)+MEMSET(Word32, HsWord32) MEMSET(Word64, HsWord64) MEMSET(Word, HsWord) MEMSET(Ptr, HsPtr)
cbits/primitive-memops.h view
@@ -12,9 +12,9 @@ int hsprimitive_memcmp( HsWord8 *s1, HsWord8 *s2, size_t n ); int hsprimitive_memcmp_offset( HsWord8 *s1, HsInt off1, HsWord8 *s2, HsInt off2, size_t n ); -void hsprimitive_memset_Word8 (HsWord8 *, ptrdiff_t, size_t, HsWord);-void hsprimitive_memset_Word16 (HsWord16 *, ptrdiff_t, size_t, HsWord);-void hsprimitive_memset_Word32 (HsWord32 *, ptrdiff_t, size_t, HsWord);+void hsprimitive_memset_Word8 (HsWord8 *, ptrdiff_t, size_t, HsWord8);+void hsprimitive_memset_Word16 (HsWord16 *, ptrdiff_t, size_t, HsWord16);+void hsprimitive_memset_Word32 (HsWord32 *, ptrdiff_t, size_t, HsWord32); void hsprimitive_memset_Word64 (HsWord64 *, ptrdiff_t, size_t, HsWord64); void hsprimitive_memset_Word (HsWord *, ptrdiff_t, size_t, HsWord); void hsprimitive_memset_Ptr (HsPtr *, ptrdiff_t, size_t, HsPtr);
changelog.md view
@@ -1,3 +1,10 @@+## Changes in version 0.7.2.0++ * Add `thawByteArray` and `thawPrimArray`.++ * Changed the `Show` instance of `ByteArray`, so that all 8-bit words+ are rendered as two digits. For example, display `0x0D` instead of `0xD`.+ ## Changes in version 0.7.1.0 * Introduce convenience class `MonadPrim` and `MonadPrimBase`.
primitive.cabal view
@@ -1,6 +1,6 @@ Cabal-Version: 2.2 Name: primitive-Version: 0.7.1.0+Version: 0.7.2.0 License: BSD-3-Clause License-File: LICENSE @@ -27,7 +27,7 @@ GHC == 8.2.2, GHC == 8.4.4, GHC == 8.6.5,- GHC == 8.8.2,+ GHC == 8.8.3, GHC == 8.10.1 Library@@ -53,9 +53,9 @@ Data.Primitive.Internal.Compat Data.Primitive.Internal.Operations - Build-Depends: base >= 4.5 && < 4.15+ Build-Depends: base >= 4.5 && < 4.17 , deepseq >= 1.1 && < 1.5- , transformers >= 0.2 && < 0.6+ , transformers >= 0.2 && < 0.7 if !impl(ghc >= 8.0) Build-Depends: fail == 4.9.* @@ -82,13 +82,14 @@ , ghc-prim , primitive , quickcheck-classes-base >=0.6 && <0.7- , QuickCheck ^>= 2.13- , tasty ^>= 1.2+ , QuickCheck >= 2.13 && < 2.15+ , tasty ^>= 1.2 || ^>= 1.3 || ^>= 1.4 , tasty-quickcheck , tagged , transformers >=0.4 , transformers-compat- , semigroups+ if !impl(ghc >= 8.0)+ build-depends: semigroups cpp-options: -DHAVE_UNARY_LAWS ghc-options: -O2
test/main.hs view
@@ -357,8 +357,11 @@ arr3 = mkByteArray ([0xde, 0xad, 0xbe, 0xee] :: [Word8]) arr4 = mkByteArray ([0xde, 0xad, 0xbe, 0xdd] :: [Word8]) arr5 = mkByteArray ([0xde, 0xad, 0xbe, 0xef, 0xde, 0xad, 0xbe, 0xdd] :: [Word8])+ arr6 = mkByteArray ([0xde, 0xad, 0x00, 0x01, 0xb0] :: [Word8]) when (show arr1 /= "[0xde, 0xad, 0xbe, 0xef]") $ fail $ "ByteArray Show incorrect: "++show arr1+ when (show arr6 /= "[0xde, 0xad, 0x00, 0x01, 0xb0]") $+ fail $ "ByteArray Show incorrect: "++ show arr6 when (compareByteArrays arr3 1 arr4 1 3 /= GT) $ fail $ "arr3[1,3] should be greater than arr4[1,3]" when (compareByteArrays arr3 0 arr4 1 3 /= GT) $