primitive 0.7.4.0 → 0.8.0.0
raw patch · 9 files changed
+328/−248 lines, 9 filesdep +data-array-bytedep ~basedep ~deepseq
Dependencies added: data-array-byte
Dependency ranges changed: base, deepseq
Files
- Control/Monad/Primitive.hs +15/−1
- Data/Primitive/Array.hs +1/−1
- Data/Primitive/ByteArray.hs +50/−229
- Data/Primitive/PrimArray.hs +13/−2
- Data/Primitive/PrimVar.hs +167/−0
- Data/Primitive/SmallArray.hs +24/−4
- Data/Primitive/Types.hs +16/−4
- changelog.md +23/−0
- primitive.cabal +19/−7
Control/Monad/Primitive.hs view
@@ -22,15 +22,20 @@ liftPrim, primToPrim, primToIO, primToST, ioToPrim, stToPrim, unsafePrimToPrim, unsafePrimToIO, unsafePrimToST, unsafeIOToPrim, unsafeSTToPrim, unsafeInlinePrim, unsafeInlineIO, unsafeInlineST,- touch, evalPrim, unsafeInterleave, unsafeDupableInterleave, noDuplicate+ touch, keepAlive, evalPrim, unsafeInterleave, unsafeDupableInterleave, noDuplicate ) where import GHC.Exts ( State#, RealWorld, noDuplicate#, touch#+#if defined(HAVE_KEEPALIVE)+ , keepAlive#+#endif , unsafeCoerce#, realWorld#, seq# ) import GHC.IO ( IO(..) ) import GHC.ST ( ST(..) ) +#if __GLASGOW_HASKELL__ >= 802 import qualified Control.Monad.ST.Lazy as L+#endif import Control.Monad.Trans.Class (lift) @@ -334,6 +339,15 @@ {-# INLINE touch #-} touch x = unsafePrimToPrim $ (primitive (\s -> case touch# x s of { s' -> (# s', () #) }) :: IO ())++keepAlive :: PrimBase m => a -> (a -> m r) -> m r+#if defined(HAVE_KEEPALIVE)+{-# INLINE keepAlive #-}+keepAlive x k = unsafeIOToPrim $ primitive $ \s0 -> keepAlive# x s0 $ internal $ unsafePrimToIO $ k x+#else+{-# NOINLINE keepAlive #-}+keepAlive x k = k x <* touch x+#endif -- | Create an action to force a value; generalizes 'Control.Exception.evaluate' --
Data/Primitive/Array.hs view
@@ -762,7 +762,7 @@ instance Monoid (Array a) where mempty = empty #if !(MIN_VERSION_base(4,11,0))- mappend = (<|>)+ mappend = (<>) #endif mconcat l = createArray sz (die "mconcat" "impossible") $ \ma -> let go !_ [ ] = return ()
Data/Primitive/ByteArray.hs view
@@ -29,6 +29,9 @@ -- * Element access readByteArray, writeByteArray, indexByteArray,+ -- * Char Element Access+ -- $charElementAccess+ readCharArray, writeCharArray, indexCharArray, -- * Constructing emptyByteArray,@@ -65,94 +68,24 @@ import Control.Monad.Primitive import Control.Monad.ST-import Control.DeepSeq import Data.Primitive.Types +#if MIN_VERSION_base(4,10,0) import qualified GHC.ST as GHCST+#endif import Foreign.C.Types import Data.Word ( Word8 )-import Data.Bits ( (.&.), unsafeShiftR )-import GHC.Show ( intToDigit )+#if __GLASGOW_HASKELL__ >= 802 import qualified GHC.Exts as Exts+#endif import GHC.Exts hiding (setByteArray#) -import Data.Typeable ( Typeable )-import Data.Data ( Data(..), mkNoRepType )-import qualified Language.Haskell.TH.Syntax as TH-import qualified Language.Haskell.TH.Lib as TH--import qualified Data.Semigroup as SG-import qualified Data.Foldable as F--import System.IO.Unsafe (unsafePerformIO, unsafeDupablePerformIO)---- | Byte arrays.-data ByteArray = ByteArray ByteArray# deriving ( Typeable )---- | Mutable byte arrays associated with a primitive state token.-data MutableByteArray s = MutableByteArray (MutableByteArray# s)- deriving ( Typeable )---- | Respects array pinnedness for GHC >= 8.2-instance TH.Lift ByteArray where-#if MIN_VERSION_template_haskell(2,17,0)- liftTyped ba = TH.unsafeCodeCoerce (TH.lift ba)-#elif MIN_VERSION_template_haskell(2,16,0)- liftTyped ba = TH.unsafeTExpCoerce (TH.lift ba)+#if __GLASGOW_HASKELL__ < 804+import System.IO.Unsafe (unsafeDupablePerformIO) #endif - lift ba =- TH.appE- (if small- then [| fromLitAddrSmall# pinned len |]- else [| fromLitAddrLarge# pinned len |])- (TH.litE (TH.stringPrimL (toList ba)))- where- -- Pin it if the original was pinned; otherwise don't. This seems more- -- logical to me than the alternatives. Anyone who wants a different- -- pinnedness can just copy the compile-time byte array to one that- -- matches what they want at run-time.-#if __GLASGOW_HASKELL__ >= 802- pinned = isByteArrayPinned ba-#else- pinned = True-#endif- len = sizeofByteArray ba- small = len <= 2048---- I don't think inlining these can be very helpful, so let's not--- do it.-{-# NOINLINE fromLitAddrSmall# #-}-fromLitAddrSmall# :: Bool -> Int -> Addr# -> ByteArray-fromLitAddrSmall# pinned len ptr = inline (fromLitAddr# True pinned len ptr)--{-# NOINLINE fromLitAddrLarge# #-}-fromLitAddrLarge# :: Bool -> Int -> Addr# -> ByteArray-fromLitAddrLarge# pinned len ptr = inline (fromLitAddr# False pinned len ptr)--fromLitAddr# :: Bool -> Bool -> Int -> Addr# -> ByteArray-fromLitAddr# small pinned !len !ptr = upIO $ do- mba <- if pinned- then newPinnedByteArray len- else newByteArray len- copyPtrToMutableByteArray mba 0 (Ptr ptr :: Ptr Word8) len- unsafeFreezeByteArray mba- where- -- We don't care too much about duplication if the byte arrays are- -- small. If they're large, we do. Since we don't allocate while- -- we copy (we do it with a primop!), I don't believe the thunk- -- deduplication mechanism can help us if two threads just happen- -- to try to build the ByteArray at the same time.- upIO- | small = unsafeDupablePerformIO- | otherwise = unsafePerformIO--instance NFData ByteArray where- rnf (ByteArray _) = ()--instance NFData (MutableByteArray s) where- rnf (MutableByteArray _) = ()+import Data.Array.Byte (ByteArray(..), MutableByteArray(..)) -- | Create a new mutable byte array of the specified size in bytes. --@@ -461,7 +394,7 @@ -> m () {-# INLINE copyByteArrayToPtr #-} copyByteArrayToPtr (Ptr dst#) (ByteArray src#) soff sz- = primitive_ (copyByteArrayToAddr# src# (unI# soff *# siz# ) dst# (unI# sz))+ = primitive_ (copyByteArrayToAddr# src# (unI# soff *# siz#) dst# (unI# sz *# siz#)) where siz# = sizeOf# (undefined :: a) @@ -498,7 +431,7 @@ -> m () {-# INLINE copyMutableByteArrayToPtr #-} copyMutableByteArrayToPtr (Ptr dst#) (MutableByteArray src#) soff sz- = primitive_ (copyMutableByteArrayToAddr# src# (unI# soff *# siz# ) dst# (unI# sz))+ = primitive_ (copyMutableByteArrayToAddr# src# (unI# soff *# siz#) dst# (unI# sz *# siz#)) where siz# = sizeOf# (undefined :: a) @@ -590,62 +523,6 @@ -> MutableByteArray# s -> CPtrdiff -> CSize -> IO () -instance Eq (MutableByteArray s) where- (==) = sameMutableByteArray--instance Data ByteArray where- toConstr _ = error "toConstr"- gunfold _ _ = error "gunfold"- 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"---- | @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 . showW8 (indexByteArray ba i :: Word8) . go (i+1)- | otherwise = showChar ']'- where- comma | i == 0 = id- | otherwise = showString ", "----- Only used internally-compareByteArraysFromBeginning :: ByteArray -> ByteArray -> Int -> Ordering-{-# INLINE compareByteArraysFromBeginning #-}-#if __GLASGOW_HASKELL__ >= 804-compareByteArraysFromBeginning (ByteArray ba1#) (ByteArray ba2#) (I# n#)- = compare (I# (compareByteArrays# ba1# 0# ba2# 0# n#)) 0-#else--- Emulate GHC 8.4's 'GHC.Prim.compareByteArrays#'-compareByteArraysFromBeginning (ByteArray ba1#) (ByteArray ba2#) (I# n#)- = compare (fromCInt (unsafeDupablePerformIO (memcmp_ba ba1# ba2# n))) 0- where- n = fromIntegral (I# n#) :: CSize- fromCInt = fromIntegral :: CInt -> Int--foreign import ccall unsafe "primitive-memops.h hsprimitive_memcmp"- memcmp_ba :: ByteArray# -> ByteArray# -> CSize -> IO CInt-#endif- -- | Lexicographic comparison of equal-length slices into two byte arrays. -- This wraps the @compareByteArrays#@ primop, which wraps @memcmp@. compareByteArrays@@ -671,105 +548,11 @@ memcmp_ba_offs :: ByteArray# -> Int# -> ByteArray# -> Int# -> CSize -> IO CInt #endif --sameByteArray :: ByteArray# -> ByteArray# -> Bool-sameByteArray ba1 ba2 =- case reallyUnsafePtrEquality# (unsafeCoerce# ba1 :: ()) (unsafeCoerce# ba2 :: ()) of- r -> isTrue# r---- | @since 0.6.3.0-instance Eq ByteArray where- ba1@(ByteArray ba1#) == ba2@(ByteArray ba2#)- | sameByteArray ba1# ba2# = True- | n1 /= n2 = False- | otherwise = compareByteArraysFromBeginning ba1 ba2 n1 == EQ- where- n1 = sizeofByteArray ba1- n2 = sizeofByteArray ba2---- | Non-lexicographic ordering. This compares the lengths of--- the byte arrays first and uses a lexicographic ordering if--- the lengths are equal. Subject to change between major versions.------ @since 0.6.3.0-instance Ord ByteArray where- ba1@(ByteArray ba1#) `compare` ba2@(ByteArray ba2#)- | sameByteArray ba1# ba2# = EQ- | n1 /= n2 = n1 `compare` n2- | otherwise = compareByteArraysFromBeginning ba1 ba2 n1- where- n1 = sizeofByteArray ba1- n2 = sizeofByteArray ba2--- Note: On GHC 8.4, the primop compareByteArrays# performs a check for pointer--- equality as a shortcut, so the check here is actually redundant. However, it--- is included here because it is likely better to check for pointer equality--- before checking for length equality. Getting the length requires deferencing--- the pointers, which could cause accesses to memory that is not in the cache.--- By contrast, a pointer equality check is always extremely cheap.--appendByteArray :: ByteArray -> ByteArray -> ByteArray-appendByteArray a b = runST $ do- marr <- newByteArray (sizeofByteArray a + sizeofByteArray b)- copyByteArray marr 0 a 0 (sizeofByteArray a)- copyByteArray marr (sizeofByteArray a) b 0 (sizeofByteArray b)- unsafeFreezeByteArray marr--concatByteArray :: [ByteArray] -> ByteArray-concatByteArray arrs = runST $ do- let len = calcLength arrs 0- marr <- newByteArray len- pasteByteArrays marr 0 arrs- unsafeFreezeByteArray marr--pasteByteArrays :: MutableByteArray s -> Int -> [ByteArray] -> ST s ()-pasteByteArrays !_ !_ [] = return ()-pasteByteArrays !marr !ix (x : xs) = do- copyByteArray marr ix x 0 (sizeofByteArray x)- pasteByteArrays marr (ix + sizeofByteArray x) xs--calcLength :: [ByteArray] -> Int -> Int-calcLength [] !n = n-calcLength (x : xs) !n = calcLength xs (sizeofByteArray x + n)- -- | The empty 'ByteArray'. emptyByteArray :: ByteArray {-# NOINLINE emptyByteArray #-} emptyByteArray = runST (newByteArray 0 >>= unsafeFreezeByteArray) -replicateByteArray :: Int -> ByteArray -> ByteArray-replicateByteArray n arr = runST $ do- marr <- newByteArray (n * sizeofByteArray arr)- let go i = if i < n- then do- copyByteArray marr (i * sizeofByteArray arr) arr 0 (sizeofByteArray arr)- go (i + 1)- else return ()- go 0- unsafeFreezeByteArray marr--instance SG.Semigroup ByteArray where- (<>) = appendByteArray- sconcat = mconcat . F.toList- stimes n arr = case compare n 0 of- LT -> die "stimes" "negative multiplier"- EQ -> emptyByteArray- GT -> replicateByteArray (fromIntegral n) arr--instance Monoid ByteArray where- mempty = emptyByteArray-#if !(MIN_VERSION_base(4,11,0))- mappend = appendByteArray-#endif- mconcat = concatByteArray---- | @since 0.6.3.0-instance Exts.IsList ByteArray where- type Item ByteArray = Word8-- toList = foldrByteArray (:) []- fromList xs = byteArrayFromListN (length xs) xs- fromListN = byteArrayFromListN- die :: String -> String -> a die fun problem = error $ "Data.Primitive.ByteArray." ++ fun ++ ": " ++ problem @@ -822,3 +605,41 @@ #else /* In older GHCs, runRW# is not available. */ runByteArray m = runST $ m >>= unsafeFreezeByteArray #endif++{- $charElementAccess+GHC provides two sets of element accessors for 'Char'. One set faithfully+represents 'Char' as 32-bit words using UTF-32. The other set represents+'Char' as 8-bit words using Latin-1 (ISO-8859-1), and the write operation+has undefined behavior for codepoints outside of the ASCII and Latin-1+blocks. The 'Prim' instance for 'Char' uses the UTF-32 set of operators.+-}++-- | Read an 8-bit element from the byte array, interpreting it as a+-- Latin-1-encoded character. The offset is given in bytes.+--+-- /Note:/ this function does not do bounds checking.+readCharArray :: PrimMonad m => MutableByteArray (PrimState m) -> Int -> m Char+{-# INLINE readCharArray #-}+readCharArray (MutableByteArray arr#) (I# i#) = primitive+ (\s0 -> case readCharArray# arr# i# s0 of+ (# s1, c #) -> (# s1, C# c #)+ )++-- | Write a character to the byte array, encoding it with Latin-1 as+-- a single byte. Behavior is undefined for codepoints outside of the+-- ASCII and Latin-1 blocks. The offset is given in bytes.+--+-- /Note:/ this function does not do bounds checking.+writeCharArray+ :: PrimMonad m => MutableByteArray (PrimState m) -> Int -> Char -> m ()+{-# INLINE writeCharArray #-}+writeCharArray (MutableByteArray arr#) (I# i#) (C# c)+ = primitive_ (writeCharArray# arr# i# c)++-- | Read an 8-bit element from the byte array, interpreting it as a+-- Latin-1-encoded character. The offset is given in bytes.+--+-- /Note:/ this function does not do bounds checking.+indexCharArray :: ByteArray -> Int -> Char+{-# INLINE indexCharArray #-}+indexCharArray (ByteArray arr#) (I# i#) = C# (indexCharArray# arr# i#)
Data/Primitive/PrimArray.hs view
@@ -6,6 +6,7 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UnboxedTuples #-} {-# LANGUAGE TemplateHaskellQuotes #-}+{-# LANGUAGE RoleAnnotations #-} -- | -- Module : Data.Primitive.PrimArray@@ -21,7 +22,7 @@ -- However, the type constructors 'PrimArray' and 'MutablePrimArray' take one additional -- argument compared to their respective counterparts 'ByteArray' and 'Data.Primitive.ByteArray.MutableByteArray'. -- This argument is used to designate the type of element in the array.--- Consequently, all functions in this module accept length and incides in+-- Consequently, all functions in this module accept length and indices in -- terms of elements, not bytes. -- -- @since 0.6.4.0@@ -109,18 +110,26 @@ import GHC.Exts import Data.Primitive.Types import Data.Primitive.ByteArray (ByteArray(..))+#if !MIN_VERSION_base(4,11,0) import Data.Monoid ((<>))-import Control.Applicative+#endif+#if !MIN_VERSION_base(4,18,0)+import Control.Applicative (liftA2)+#endif import Control.DeepSeq import Control.Monad.Primitive import Control.Monad.ST import qualified Data.List as L import qualified Data.Primitive.ByteArray as PB import qualified Data.Primitive.Types as PT+#if MIN_VERSION_base(4,10,0) import qualified GHC.ST as GHCST+#endif import Language.Haskell.TH.Syntax (Lift (..)) +#if !MIN_VERSION_base(4,11,0) import Data.Semigroup (Semigroup)+#endif import qualified Data.Semigroup as SG #if __GLASGOW_HASKELL__ >= 802@@ -133,6 +142,8 @@ -- in its elements. This differs from the behavior of 'Data.Primitive.Array.Array', -- which is lazy in its elements. data PrimArray a = PrimArray ByteArray#++type role PrimArray nominal instance Lift (PrimArray a) where #if MIN_VERSION_template_haskell(2,16,0)
+ Data/Primitive/PrimVar.hs view
@@ -0,0 +1,167 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE RoleAnnotations #-}+{-# LANGUAGE UnboxedTuples #-}+{-# LANGUAGE Unsafe #-}++-- | Variant of @MutVar@ that has one less indirection for primitive types.+-- The difference is illustrated by comparing @MutVar Int@ and @PrimVar Int@:+--+-- * @MutVar Int@: @MutVar# --> I#@+-- * @PrimVar Int@: @MutableByteArray#@+--+-- This module is adapted from a module in Edward Kmett\'s @prim-ref@ library.+module Data.Primitive.PrimVar+ (+ -- * Primitive References+ PrimVar(..)+ , newPrimVar+ , newPinnedPrimVar+ , newAlignedPinnedPrimVar+ , readPrimVar+ , writePrimVar+ , modifyPrimVar+ , primVarContents+ , primVarToMutablePrimArray+ -- * Atomic Operations+ -- $atomic+ , casInt+ , fetchAddInt+ , fetchSubInt+ , fetchAndInt+ , fetchNandInt+ , fetchOrInt+ , fetchXorInt+ , atomicReadInt+ , atomicWriteInt+ ) where++import Control.Monad.Primitive+import Data.Primitive+import GHC.Exts+import GHC.Ptr (castPtr)++--------------------------------------------------------------------------------+-- * Primitive References+--------------------------------------------------------------------------------++-- | A 'PrimVar' behaves like a single-element mutable primitive array.+newtype PrimVar s a = PrimVar (MutablePrimArray s a)++type role PrimVar nominal nominal++-- | Create a primitive reference.+newPrimVar :: (PrimMonad m, Prim a) => a -> m (PrimVar (PrimState m) a)+newPrimVar a = do+ m <- newPrimArray 1+ writePrimArray m 0 a+ return (PrimVar m)+{-# INLINE newPrimVar #-}++-- | Create a pinned primitive reference.+newPinnedPrimVar :: (PrimMonad m, Prim a) => a -> m (PrimVar (PrimState m) a)+newPinnedPrimVar a = do+ m <- newPinnedPrimArray 1+ writePrimArray m 0 a+ return (PrimVar m)+{-# INLINE newPinnedPrimVar #-}++-- | Create a pinned primitive reference with the appropriate alignment for its contents.+newAlignedPinnedPrimVar :: (PrimMonad m, Prim a) => a -> m (PrimVar (PrimState m) a)+newAlignedPinnedPrimVar a = do+ m <- newAlignedPinnedPrimArray 1+ writePrimArray m 0 a+ return (PrimVar m)+{-# INLINE newAlignedPinnedPrimVar #-}++-- | Read a value from the 'PrimVar'.+readPrimVar :: (PrimMonad m, Prim a) => PrimVar (PrimState m) a -> m a+readPrimVar (PrimVar m) = readPrimArray m 0+{-# INLINE readPrimVar #-}++-- | Write a value to the 'PrimVar'.+writePrimVar :: (PrimMonad m, Prim a) => PrimVar (PrimState m) a -> a -> m ()+writePrimVar (PrimVar m) a = writePrimArray m 0 a+{-# INLINE writePrimVar #-}++-- | Mutate the contents of a 'PrimVar'.+modifyPrimVar :: (PrimMonad m, Prim a) => PrimVar (PrimState m) a -> (a -> a) -> m ()+modifyPrimVar pv f = do+ x <- readPrimVar pv+ writePrimVar pv (f x)+{-# INLINE modifyPrimVar #-}++instance Eq (PrimVar s a) where+ PrimVar m == PrimVar n = sameMutablePrimArray m n+ {-# INLINE (==) #-}++-- | Yield a pointer to the data of a 'PrimVar'. This operation is only safe on pinned byte arrays allocated by+-- 'newPinnedPrimVar' or 'newAlignedPinnedPrimVar'.+primVarContents :: PrimVar s a -> Ptr a+primVarContents (PrimVar m) = castPtr $ mutablePrimArrayContents m+{-# INLINE primVarContents #-}++-- | Convert a 'PrimVar' to a one-elment 'MutablePrimArray'.+primVarToMutablePrimArray :: PrimVar s a -> MutablePrimArray s a+primVarToMutablePrimArray (PrimVar m) = m+{-# INLINE primVarToMutablePrimArray #-}++--------------------------------------------------------------------------------+-- * Atomic Operations+--------------------------------------------------------------------------------++-- $atomic+-- Atomic operations on `PrimVar s Int`. All atomic operations imply a full memory barrier.++-- | Given a primitive reference, the expected old value, and the new value, perform an atomic compare and swap i.e. write the new value if the current value matches the provided old value. Returns the value of the element before the operation.+casInt :: PrimMonad m => PrimVar (PrimState m) Int -> Int -> Int -> m Int+casInt (PrimVar (MutablePrimArray m)) (I# old) (I# new) = primitive $ \s -> case casIntArray# m 0# old new s of+ (# s', result #) -> (# s', I# result #)+{-# INLINE casInt #-}++-- | Given a reference, and a value to add, atomically add the value to the element. Returns the value of the element before the operation.+fetchAddInt :: PrimMonad m => PrimVar (PrimState m) Int -> Int -> m Int+fetchAddInt (PrimVar (MutablePrimArray m)) (I# x) = primitive $ \s -> case fetchAddIntArray# m 0# x s of+ (# s', result #) -> (# s', I# result #)+{-# INLINE fetchAddInt #-}++-- | Given a reference, and a value to subtract, atomically subtract the value from the element. Returns the value of the element before the operation.+fetchSubInt :: PrimMonad m => PrimVar (PrimState m) Int -> Int -> m Int+fetchSubInt (PrimVar (MutablePrimArray m)) (I# x) = primitive $ \s -> case fetchSubIntArray# m 0# x s of+ (# s', result #) -> (# s', I# result #)+{-# INLINE fetchSubInt #-}++-- | Given a reference, and a value to bitwise and, atomically and the value with the element. Returns the value of the element before the operation.+fetchAndInt :: PrimMonad m => PrimVar (PrimState m) Int -> Int -> m Int+fetchAndInt (PrimVar (MutablePrimArray m)) (I# x) = primitive $ \s -> case fetchAndIntArray# m 0# x s of+ (# s', result #) -> (# s', I# result #)+{-# INLINE fetchAndInt #-}++-- | Given a reference, and a value to bitwise nand, atomically nand the value with the element. Returns the value of the element before the operation.+fetchNandInt :: PrimMonad m => PrimVar (PrimState m) Int -> Int -> m Int+fetchNandInt (PrimVar (MutablePrimArray m)) (I# x) = primitive $ \s -> case fetchNandIntArray# m 0# x s of+ (# s', result #) -> (# s', I# result #)+{-# INLINE fetchNandInt #-}++-- | Given a reference, and a value to bitwise or, atomically or the value with the element. Returns the value of the element before the operation.+fetchOrInt :: PrimMonad m => PrimVar (PrimState m) Int -> Int -> m Int+fetchOrInt (PrimVar (MutablePrimArray m)) (I# x) = primitive $ \s -> case fetchOrIntArray# m 0# x s of+ (# s', result #) -> (# s', I# result #)+{-# INLINE fetchOrInt #-}++-- | Given a reference, and a value to bitwise xor, atomically xor the value with the element. Returns the value of the element before the operation.+fetchXorInt :: PrimMonad m => PrimVar (PrimState m) Int -> Int -> m Int+fetchXorInt (PrimVar (MutablePrimArray m)) (I# x) = primitive $ \s -> case fetchXorIntArray# m 0# x s of+ (# s', result #) -> (# s', I# result #)+{-# INLINE fetchXorInt #-}++-- | Given a reference, atomically read an element.+atomicReadInt :: PrimMonad m => PrimVar (PrimState m) Int -> m Int+atomicReadInt (PrimVar (MutablePrimArray m)) = primitive $ \s -> case atomicReadIntArray# m 0# s of+ (# s', result #) -> (# s', I# result #)+{-# INLINE atomicReadInt #-}++-- | Given a reference, atomically write an element.+atomicWriteInt :: PrimMonad m => PrimVar (PrimState m) Int -> Int -> m ()+atomicWriteInt (PrimVar (MutablePrimArray m)) (I# x) = primitive_ $ \s -> atomicWriteIntArray# m 0# x s+{-# INLINE atomicWriteInt #-}
Data/Primitive/SmallArray.hs view
@@ -57,6 +57,7 @@ , sizeofSmallMutableArray #if MIN_VERSION_base(4,14,0) , shrinkSmallMutableArray+ , resizeSmallMutableArray #endif , emptySmallArray , smallArrayFromList@@ -79,9 +80,6 @@ import Data.Data import Data.Foldable as Foldable import Data.Functor.Identity-#if !(MIN_VERSION_base(4,10,0))-import Data.Monoid-#endif import qualified GHC.ST as GHCST import qualified Data.Semigroup as Sem import Text.ParserCombinators.ReadP@@ -797,7 +795,7 @@ instance Monoid (SmallArray a) where mempty = empty #if !(MIN_VERSION_base(4,11,0))- mappend = (<|>)+ mappend = (Sem.<>) #endif mconcat l = createSmallArray n (die "mconcat" "impossible") $ \ma -> let go !_ [ ] = return ()@@ -898,4 +896,26 @@ (\s0 -> case GHC.Exts.shrinkSmallMutableArray# x n s0 of s1 -> (# s1, () #) )++-- | Resize a mutable array to new specified size. The returned+-- 'SmallMutableArray' is either the original 'SmallMutableArray'+-- resized in-place or, if not possible, a newly allocated+-- 'SmallMutableArray' with the original content copied over.+--+-- To avoid undefined behaviour, the original 'SmallMutableArray'+-- shall not be accessed anymore after a 'resizeSmallMutableArray' has+-- been performed. Moreover, no reference to the old one should be+-- kept in order to allow garbage collection of the original+-- 'SmallMutableArray' in case a new 'SmallMutableArray' had to be+-- allocated.+resizeSmallMutableArray :: PrimMonad m+ => SmallMutableArray (PrimState m) a+ -> Int -- ^ New size+ -> a -- ^ Newly created slots initialized to this element. Only used when array is grown.+ -> m (SmallMutableArray (PrimState m) a)+resizeSmallMutableArray (SmallMutableArray arr) (I# n) x = primitive+ (\s0 -> case GHC.Exts.resizeSmallMutableArray# arr n x s0 of+ (# s1, arr' #) -> (# s1, SmallMutableArray arr' #)+ )+{-# INLINE resizeSmallMutableArray #-} #endif
Data/Primitive/Types.hs view
@@ -1,9 +1,18 @@-{-# LANGUAGE CPP, UnboxedTuples, MagicHash, DeriveDataTypeable #-}-{-# LANGUAGE GeneralizedNewtypeDeriving, StandaloneDeriving #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE UnboxedTuples #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeInType #-} {-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE PolyKinds #-} +#if __GLASGOW_HASKELL__ < 906+{-# LANGUAGE TypeInType #-}+#endif+ #include "HsBaseConfig.h" -- |@@ -49,8 +58,11 @@ import Control.Applicative (Const(..)) import Data.Functor.Identity (Identity(..)) import qualified Data.Monoid as Monoid-import Data.Ord (Down(..)) import qualified Data.Semigroup as Semigroup++#if !MIN_VERSION_base(4,13,0)+import Data.Ord (Down(..))+#endif -- | Class of types supporting primitive array operations. This includes -- interfacing with GC-managed memory (functions suffixed with @ByteArray#@)
changelog.md view
@@ -1,3 +1,26 @@+## Changes in version 0.8.0.0++ * Add `resizeSmallMutableArray` that wraps `resizeSmallMutableArray#` from+ `GHC.Exts`.++ * New module `Data.Primitive.PrimVar`. This is essentially `PrimArray` with+ element length 1. For types with `Prim` instances, this is a drop-in+ replacement for `MutVar` with fewer indirections.++ * `PrimArray`'s type argument has been given a nominal role instead of a phantom role.+ This is a breaking change.++ * Add `readCharArray`, `writeCharArray`, `indexCharArray` for operating on+ 8-bit characters in a byte array.++ * When building with `base-4.17` and newer, re-export the `ByteArray` and+ `MutableByteArray` types from `base` instead of defining them in this+ library. This does not change the user-facing interface of+ `Data.Primitive.ByteArray`.++ * Add `keepAlive` that wraps `keepAlive#` for GHC 9.2 and newer. It+ falls back to using `touch` for older GHCs.+ ## Changes in version 0.7.4.0 * Add Lift instances (#332)
primitive.cabal view
@@ -1,6 +1,6 @@ Cabal-Version: 2.0 Name: primitive-Version: 0.7.4.0+Version: 0.8.0.0 License: BSD3 License-File: LICENSE @@ -19,15 +19,20 @@ test/LICENSE Tested-With:- GHC == 8.0.2,- GHC == 8.2.2,- GHC == 8.4.4,- GHC == 8.6.5,- GHC == 8.8.4,+ GHC == 8.0.2+ GHC == 8.2.2+ GHC == 8.4.4+ GHC == 8.6.5+ GHC == 8.8.4 GHC == 8.10.7+ GHC == 9.0.2+ GHC == 9.2.5+ GHC == 9.4.4 Library Default-Language: Haskell2010+ Default-Extensions:+ TypeOperators Other-Extensions: BangPatterns, CPP, DeriveDataTypeable, MagicHash, TypeFamilies, UnboxedTuples, UnliftedFFITypes@@ -44,14 +49,21 @@ Data.Primitive.Ptr Data.Primitive.MutVar Data.Primitive.MVar+ Data.Primitive.PrimVar Other-Modules: Data.Primitive.Internal.Operations - Build-Depends: base >= 4.9 && < 4.18+ Build-Depends: base >= 4.9 && < 4.19 , deepseq >= 1.1 && < 1.5 , transformers >= 0.5 && < 0.7 , template-haskell >= 2.11++ if impl(ghc >= 9.2)+ cpp-options: -DHAVE_KEEPALIVE++ if impl(ghc < 9.4)+ build-depends: data-array-byte >= 0.1 && < 0.1.1 Ghc-Options: -O2