Script 'mail_helper' called by obssrc
Hello community,
here is the log from the commit of package ghc-primitive for openSUSE:Factory
checked in at 2025-04-08 17:51:43
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Comparing /work/SRC/openSUSE:Factory/ghc-primitive (Old)
and /work/SRC/openSUSE:Factory/.ghc-primitive.new.1907 (New)
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-primitive"
Tue Apr 8 17:51:43 2025 rev:33 rq:1267799 version:0.9.1.0
Changes:
--------
--- /work/SRC/openSUSE:Factory/ghc-primitive/ghc-primitive.changes
2024-10-28 15:21:41.686885503 +0100
+++ /work/SRC/openSUSE:Factory/.ghc-primitive.new.1907/ghc-primitive.changes
2025-04-08 17:52:36.829973064 +0200
@@ -1,0 +2,23 @@
+Mon Mar 31 14:42:00 UTC 2025 - Peter Simons <psim...@suse.com>
+
+- Update primitive to version 0.9.1.0.
+ ## Changes in version 0.9.1.0
+
+ * Make fromListN functions good consumers for list fusion.
+
+ * Add functions to improve `MutVar`'s interoperability with `IORef` and
`STRef`.
+
+ * Add `createPrimArray` and `createByteArray`.
+
+ * Add `byteArrayAsForeignPtr` and `mutableByteArrayAsForeignPtr`.
+
+ * Use `copyMutableByteArrayNonOverlapping#` in the implementation of
`copyMutableByteArray`
+ on sufficiently new GHCs. This does not change the contract for
`copyMutableByteArray`.
+ This function has always been documented as having undefined behavior
when the slices
+ overlap. However, overlaps previously were handled gracefully (with the
semantics
+ of C's `memmove`). Going forward, users who do not uphold
`copyMutableByteArray`'s
+ precondition will be met with unpredictable results.
+
+ * Drop support for GHC 8.0.
+
+-------------------------------------------------------------------
Old:
----
primitive-0.9.0.0.tar.gz
primitive.cabal
New:
----
primitive-0.9.1.0.tar.gz
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Other differences:
------------------
++++++ ghc-primitive.spec ++++++
--- /var/tmp/diff_new_pack.3ZIMFP/_old 2025-04-08 17:52:37.285992193 +0200
+++ /var/tmp/diff_new_pack.3ZIMFP/_new 2025-04-08 17:52:37.285992193 +0200
@@ -1,7 +1,7 @@
#
# spec file for package ghc-primitive
#
-# Copyright (c) 2024 SUSE LLC
+# Copyright (c) 2025 SUSE LLC
#
# All modifications and additions to the file contributed by third parties
# remain the property of their copyright owners, unless otherwise agreed
@@ -20,13 +20,12 @@
%global pkgver %{pkg_name}-%{version}
%bcond_with tests
Name: ghc-%{pkg_name}
-Version: 0.9.0.0
+Version: 0.9.1.0
Release: 0
Summary: Primitive memory-related operations
License: BSD-3-Clause
URL: https://hackage.haskell.org/package/%{pkg_name}
Source0:
https://hackage.haskell.org/package/%{pkg_name}-%{version}/%{pkg_name}-%{version}.tar.gz
-Source1:
https://hackage.haskell.org/package/%{pkg_name}-%{version}/revision/2.cabal#/%{pkg_name}.cabal
BuildRequires: ghc-Cabal-devel
BuildRequires: ghc-base-devel
BuildRequires: ghc-base-prof
@@ -86,7 +85,6 @@
%prep
%autosetup -n %{pkg_name}-%{version}
-cp -p %{SOURCE1} %{pkg_name}.cabal
%build
%ghc_lib_build
++++++ primitive-0.9.0.0.tar.gz -> primitive-0.9.1.0.tar.gz ++++++
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/primitive-0.9.0.0/Control/Monad/Primitive.hs
new/primitive-0.9.1.0/Control/Monad/Primitive.hs
--- old/primitive-0.9.0.0/Control/Monad/Primitive.hs 2001-09-09
03:46:40.000000000 +0200
+++ new/primitive-0.9.1.0/Control/Monad/Primitive.hs 2001-09-09
03:46:40.000000000 +0200
@@ -239,14 +239,14 @@
{-# INLINE internal #-}
#endif
--- | 'PrimMonad''s state token type can be annoying to handle
+-- | 'PrimMonad'\'s state token type can be annoying to handle
-- in constraints. This typeclass lets users (visually) notice
-- 'PrimState' equality constraints less, by witnessing that
-- @s ~ 'PrimState' m@.
class (PrimMonad m, s ~ PrimState m) => MonadPrim s m
instance (PrimMonad m, s ~ PrimState m) => MonadPrim s m
--- | 'PrimBase''s state token type can be annoying to handle
+-- | 'PrimBase'\'s state token type can be annoying to handle
-- in constraints. This typeclass lets users (visually) notice
-- 'PrimState' equality constraints less, by witnessing that
-- @s ~ 'PrimState' m@.
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/primitive-0.9.0.0/Data/Primitive/Array.hs
new/primitive-0.9.1.0/Data/Primitive/Array.hs
--- old/primitive-0.9.0.0/Data/Primitive/Array.hs 2001-09-09
03:46:40.000000000 +0200
+++ new/primitive-0.9.1.0/Data/Primitive/Array.hs 2001-09-09
03:46:40.000000000 +0200
@@ -52,9 +52,6 @@
import qualified Data.Foldable as F
import Data.Semigroup
import Data.Functor.Identity
-#if !MIN_VERSION_base(4,10,0)
-import GHC.Base (runRW#)
-#endif
import Text.Read (Read (..), parens, prec)
import Text.ParserCombinators.ReadPrec (ReadPrec)
@@ -586,18 +583,28 @@
-- | Create an array from a list of a known length. If the length
-- of the list does not match the given length, this throws an exception.
+
+-- Note [fromListN]
+-- ~~~~~~~~~~~~~~~~
+-- We want arrayFromListN to be a "good consumer" in list fusion, so we define
+-- the function using foldr and inline it to help fire fusion rules.
+-- If fusion occurs with a "good producer", it may reduce to a fold on some
+-- structure. In certain cases (such as for Data.Set) GHC is not be able to
+-- optimize the index to an unboxed Int# (see GHC #24628), so we explicitly use
+-- an Int# here.
arrayFromListN :: Int -> [a] -> Array a
+{-# INLINE arrayFromListN #-}
arrayFromListN n l =
createArray n (die "fromListN" "uninitialized element") $ \sma ->
- let go !ix [] = if ix == n
+ let z ix# = if I# ix# == n
then return ()
else die "fromListN" "list length less than specified size"
- go !ix (x : xs) = if ix < n
+ f x k = GHC.Exts.oneShot $ \ix# -> if I# ix# < n
then do
- writeArray sma ix x
- go (ix+1) xs
+ writeArray sma (I# ix#) x
+ k (ix# +# 1#)
else die "fromListN" "list length greater than specified size"
- in go 0 l
+ in foldr f z l 0#
-- | Create an array from a list.
arrayFromList :: [a] -> Array a
@@ -789,14 +796,7 @@
-- | @since 0.6.4.0
instance Read1 Array where
-#if MIN_VERSION_base(4,10,0)
liftReadPrec = arrayLiftReadPrec
-#else
- -- This is just the default implementation of liftReadsPrec, but
- -- it is not present in older versions of base.
- liftReadsPrec rp rl = RdPrc.readPrec_to_S $
- arrayLiftReadPrec (RdPrc.readS_to_Prec rp) (RdPrc.readS_to_Prec (const rl))
-#endif
-- Note [Forgiving Array Read Instance]
-- We're really forgiving here. We accept
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/primitive-0.9.0.0/Data/Primitive/ByteArray.hs
new/primitive-0.9.1.0/Data/Primitive/ByteArray.hs
--- old/primitive-0.9.0.0/Data/Primitive/ByteArray.hs 2001-09-09
03:46:40.000000000 +0200
+++ new/primitive-0.9.1.0/Data/Primitive/ByteArray.hs 2001-09-09
03:46:40.000000000 +0200
@@ -44,7 +44,7 @@
compareByteArrays,
-- * Freezing and thawing
- freezeByteArray, thawByteArray, runByteArray,
+ freezeByteArray, thawByteArray, runByteArray, createByteArray,
unsafeFreezeByteArray, unsafeThawByteArray,
-- * Block operations
@@ -62,6 +62,8 @@
#if __GLASGOW_HASKELL__ >= 802
isByteArrayPinned, isMutableByteArrayPinned,
#endif
+ byteArrayAsForeignPtr,
+ mutableByteArrayAsForeignPtr,
byteArrayContents,
withByteArrayContents,
mutableByteArrayContents,
@@ -74,18 +76,17 @@
import Data.Primitive.Types
import Data.Proxy
-#if MIN_VERSION_base(4,10,0)
import qualified GHC.ST as GHCST
-#endif
-import Foreign.C.Types
import Data.Word ( Word8 )
#if __GLASGOW_HASKELL__ >= 802
import qualified GHC.Exts as Exts
#endif
import GHC.Exts hiding (setByteArray#)
+import GHC.ForeignPtr (ForeignPtr(..), ForeignPtrContents(..))
#if __GLASGOW_HASKELL__ < 804
+import Foreign.C.Types
import System.IO.Unsafe (unsafeDupablePerformIO)
#endif
@@ -128,6 +129,23 @@
= primitive (\s# -> case newAlignedPinnedByteArray# n# k# s# of
(# s'#, arr# #) -> (# s'#, MutableByteArray arr# #))
+-- | Create a foreign pointer that points to the array's data. This operation
+-- is only safe on /pinned/ byte arrays. The array's data is not garbage
+-- collected while references to the foreign pointer exist. Writing to the
+-- array through the foreign pointer results in undefined behavior.
+byteArrayAsForeignPtr :: ByteArray -> ForeignPtr Word8
+{-# INLINE byteArrayAsForeignPtr #-}
+byteArrayAsForeignPtr (ByteArray arr#) = ForeignPtr (byteArrayContents# arr#)
(PlainPtr (unsafeCoerce# arr#))
+
+
+-- | Variant of 'byteArrayAsForeignPtr' for mutable byte arrays. Similarly,
this
+-- is only safe on /pinned/ mutable byte arrays. This function differs from the
+-- variant for immutable arrays in that it is safe to write to the array though
+-- the foreign pointer.
+mutableByteArrayAsForeignPtr :: MutableByteArray RealWorld -> ForeignPtr Word8
+{-# INLINE mutableByteArrayAsForeignPtr #-}
+mutableByteArrayAsForeignPtr (MutableByteArray arr#) = ForeignPtr
(mutableByteArrayContentsShim arr#) (PlainPtr arr#)
+
-- | Yield a pointer to the array's data. This operation is only safe on
-- /pinned/ byte arrays. Byte arrays allocated by 'newPinnedByteArray' and
-- 'newAlignedPinnedByteArray' are guaranteed to be pinned. Byte arrays
@@ -369,19 +387,20 @@
-- | Create a 'ByteArray' from a list of a known length. If the length
-- of the list does not match the given length, this throws an exception.
+
+-- See Note [fromListN] in Data.Primitive.Array
byteArrayFromListN :: forall a. Prim a => Int -> [a] -> ByteArray
-byteArrayFromListN n ys = runST $ do
- marr <- newByteArray (n * sizeOfType @a)
- let go !ix [] = if ix == n
- then return ()
- else die "byteArrayFromListN" "list length less than specified size"
- go !ix (x : xs) = if ix < n
- then do
- writeByteArray marr ix x
- go (ix + 1) xs
- else die "byteArrayFromListN" "list length greater than specified
size"
- go 0 ys
- unsafeFreezeByteArray marr
+{-# INLINE byteArrayFromListN #-}
+byteArrayFromListN n ys = createByteArray (n * sizeOfType @a) $ \marr ->
+ let z ix# = if I# ix# == n
+ then return ()
+ else die "byteArrayFromListN" "list length less than specified size"
+ f x k = GHC.Exts.oneShot $ \ix# -> if I# ix# < n
+ then do
+ writeByteArray marr (I# ix#) x
+ k (ix# +# 1#)
+ else die "byteArrayFromListN" "list length greater than specified size"
+ in foldr f z ys 0#
unI# :: Int -> Int#
unI# (I# n#) = n#
@@ -416,7 +435,13 @@
{-# INLINE copyMutableByteArray #-}
copyMutableByteArray (MutableByteArray dst#) doff
(MutableByteArray src#) soff sz
- = primitive_ (copyMutableByteArray# src# (unI# soff) dst# (unI# doff) (unI#
sz))
+ = primitive_ (op src# (unI# soff) dst# (unI# doff) (unI# sz))
+ where
+#if MIN_VERSION_base(4,19,0)
+ op = copyMutableByteArrayNonOverlapping#
+#else
+ op = copyMutableByteArray#
+#endif
-- | Copy a slice of a byte array to an unmanaged pointer address. These must
not
-- overlap. The offset and length are given in elements, not in bytes.
@@ -525,9 +550,7 @@
{-# INLINE moveByteArray #-}
moveByteArray (MutableByteArray dst#) doff
(MutableByteArray src#) soff sz
- = unsafePrimToPrim
- $ memmove_mba dst# (fromIntegral doff) src# (fromIntegral soff)
- (fromIntegral sz)
+ = primitive_ (copyMutableByteArray# src# (unI# soff) dst# (unI# doff) (unI#
sz))
-- | Fill a slice of a mutable byte array with a value. The offset and length
-- are given in elements of type @a@ rather than in bytes.
@@ -557,11 +580,6 @@
{-# INLINE fillByteArray #-}
fillByteArray = setByteArray
-foreign import ccall unsafe "primitive-memops.h hsprimitive_memmove"
- memmove_mba :: MutableByteArray# s -> CPtrdiff
- -> MutableByteArray# s -> CPtrdiff
- -> CSize -> IO ()
-
-- | Lexicographic comparison of equal-length slices into two byte arrays.
-- This wraps the @compareByteArrays#@ primop, which wraps @memcmp@.
compareByteArrays
@@ -592,6 +610,10 @@
{-# NOINLINE emptyByteArray #-}
emptyByteArray = runST (newByteArray 0 >>= unsafeFreezeByteArray)
+emptyByteArray# :: (# #) -> ByteArray#
+{-# NOINLINE emptyByteArray# #-}
+emptyByteArray# _ = case emptyByteArray of ByteArray arr# -> arr#
+
die :: String -> String -> a
die fun problem = error $ "Data.Primitive.ByteArray." ++ fun ++ ": " ++ problem
@@ -604,10 +626,8 @@
-> Int -- ^ number of bytes to copy
-> ByteArray
{-# INLINE cloneByteArray #-}
-cloneByteArray src off n = runByteArray $ do
- dst <- newByteArray n
+cloneByteArray src off n = createByteArray n $ \dst ->
copyByteArray dst 0 src off n
- return dst
-- | Return a newly allocated mutable array with the specified subrange of
-- the provided mutable array. The provided mutable array should contain the
@@ -629,7 +649,6 @@
runByteArray
:: (forall s. ST s (MutableByteArray s))
-> ByteArray
-#if MIN_VERSION_base(4,10,0) /* In new GHCs, runRW# is available. */
runByteArray m = ByteArray (runByteArray# m)
runByteArray#
@@ -641,9 +660,20 @@
unST :: ST s a -> State# s -> (# State# s, a #)
unST (GHCST.ST f) = f
-#else /* In older GHCs, runRW# is not available. */
-runByteArray m = runST $ m >>= unsafeFreezeByteArray
-#endif
+
+-- Create an uninitialized array of the given size in bytes, apply the function
+-- to it, and freeze the result.
+--
+-- /Note:/ this function does not check if the input is non-negative.
+--
+-- @since FIXME
+createByteArray :: Int -> (forall s. MutableByteArray s -> ST s ()) ->
ByteArray
+{-# INLINE createByteArray #-}
+createByteArray 0 _ = ByteArray (emptyByteArray# (# #))
+createByteArray n f = runByteArray $ do
+ marr <- newByteArray n
+ f marr
+ pure marr
{- $charElementAccess
GHC provides two sets of element accessors for 'Char'. One set faithfully
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/primitive-0.9.0.0/Data/Primitive/MutVar.hs
new/primitive-0.9.1.0/Data/Primitive/MutVar.hs
--- old/primitive-0.9.0.0/Data/Primitive/MutVar.hs 2001-09-09
03:46:40.000000000 +0200
+++ new/primitive-0.9.1.0/Data/Primitive/MutVar.hs 2001-09-09
03:46:40.000000000 +0200
@@ -19,16 +19,24 @@
readMutVar,
writeMutVar,
+ -- * Modify
atomicModifyMutVar,
atomicModifyMutVar',
modifyMutVar,
- modifyMutVar'
+ modifyMutVar',
+ -- * Interop with STRef and IORef
+ mutVarFromIORef,
+ mutVarToIORef,
+ mutVarFromSTRef,
+ mutVarToSTRef
) where
import Control.Monad.Primitive ( PrimMonad(..), primitive_ )
+import GHC.IORef (IORef(IORef))
+import GHC.STRef (STRef(STRef))
import GHC.Exts ( MutVar#, sameMutVar#, newMutVar#
, readMutVar#, writeMutVar#, atomicModifyMutVar#
- , isTrue# )
+ , isTrue#, RealWorld)
import Data.Typeable ( Typeable )
-- | A 'MutVar' behaves like a single-element mutable array associated
@@ -103,3 +111,23 @@
modifyMutVar' (MutVar mv#) g = primitive_ $ \s# ->
case readMutVar# mv# s# of
(# s'#, a #) -> let a' = g a in a' `seq` writeMutVar# mv# a' s'#
+
+-- | Convert 'MutVar' to 'IORef'
+mutVarToIORef :: MutVar RealWorld a -> IORef a
+{-# INLINE mutVarToIORef #-}
+mutVarToIORef (MutVar mv#) = IORef (STRef mv#)
+
+-- | Convert 'MutVar' to 'IORef'
+mutVarFromIORef :: IORef a -> MutVar RealWorld a
+{-# INLINE mutVarFromIORef #-}
+mutVarFromIORef (IORef (STRef mv#)) = MutVar mv#
+
+-- | Convert 'MutVar' to 'STRef'
+mutVarToSTRef :: MutVar s a -> STRef s a
+{-# INLINE mutVarToSTRef #-}
+mutVarToSTRef (MutVar mv#) = STRef mv#
+
+-- | Convert 'MutVar' to 'STRef'
+mutVarFromSTRef :: STRef s a -> MutVar s a
+{-# INLINE mutVarFromSTRef #-}
+mutVarFromSTRef (STRef mv#) = MutVar mv#
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/primitive-0.9.0.0/Data/Primitive/PrimArray.hs
new/primitive-0.9.1.0/Data/Primitive/PrimArray.hs
--- old/primitive-0.9.0.0/Data/Primitive/PrimArray.hs 2001-09-09
03:46:40.000000000 +0200
+++ new/primitive-0.9.1.0/Data/Primitive/PrimArray.hs 2001-09-09
03:46:40.000000000 +0200
@@ -46,6 +46,7 @@
, freezePrimArray
, thawPrimArray
, runPrimArray
+ , createPrimArray
, unsafeFreezePrimArray
, unsafeThawPrimArray
-- * Block Operations
@@ -124,9 +125,7 @@
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 (..))
import Data.Semigroup
@@ -138,10 +137,10 @@
import Data.Primitive.Internal.Operations (mutableByteArrayContentsShim)
-- | Arrays of unboxed elements. This accepts types like 'Double', 'Char',
--- 'Int' and 'Word', as well as their fixed-length variants ('Word8',
--- 'Word16', etc.). Since the elements are unboxed, a 'PrimArray' is strict
--- in its elements. This differs from the behavior of
'Data.Primitive.Array.Array',
--- which is lazy in its elements.
+-- 'Int' and 'Word', as well as their fixed-length variants ('Data.Word.Word8',
+-- 'Data.Word.Word16', etc.). Since the elements are unboxed, a 'PrimArray' is
+-- strict 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
@@ -233,22 +232,20 @@
-- | Create a 'PrimArray' from a list of a known length. If the length
-- of the list does not match the given length, this throws an exception.
+
+-- See Note [fromListN] in Data.Primitive.Array
primArrayFromListN :: forall a. Prim a => Int -> [a] -> PrimArray a
-primArrayFromListN len vs = runST run where
- run :: forall s. ST s (PrimArray a)
- run = do
- arr <- newPrimArray len
- let go :: [a] -> Int -> ST s ()
- go [] !ix = if ix == len
- then return ()
- else die "fromListN" "list length less than specified size"
- go (a : as) !ix = if ix < len
- then do
- writePrimArray arr ix a
- go as (ix + 1)
- else die "fromListN" "list length greater than specified size"
- go vs 0
- unsafeFreezePrimArray arr
+{-# INLINE primArrayFromListN #-}
+primArrayFromListN len vs = createPrimArray len $ \arr ->
+ let z ix# = if I# ix# == len
+ then return ()
+ else die "fromListN" "list length less than specified size"
+ f a k = GHC.Exts.oneShot $ \ix# -> if I# ix# < len
+ then do
+ writePrimArray arr (I# ix#) a
+ k (ix# +# 1#)
+ else die "fromListN" "list length greater than specified size"
+ in foldr f z vs 0#
-- | Convert a 'PrimArray' to a list.
{-# INLINE primArrayToList #-}
@@ -282,6 +279,10 @@
(# s1#, arr# #) -> case unsafeFreezeByteArray# arr# s1# of
(# s2#, arr'# #) -> (# s2#, PrimArray arr'# #)
+emptyPrimArray# :: (# #) -> ByteArray#
+{-# NOINLINE emptyPrimArray# #-}
+emptyPrimArray# _ = case emptyPrimArray of PrimArray arr# -> arr#
+
-- | Create a new mutable primitive array of the given length. The
-- underlying memory is left uninitialized.
--
@@ -391,7 +392,7 @@
-- | Copy a slice of an immutable primitive array to a pointer.
-- The offset and length are given in elements of type @a@.
-- This function assumes that the 'Prim' instance of @a@
--- agrees with the 'Storable' instance.
+-- agrees with the 'Foreign.Storable.Storable' instance.
--
-- /Note:/ this function does not do bounds or overlap checking.
copyPrimArrayToPtr :: forall m a. (PrimMonad m, Prim a)
@@ -410,7 +411,7 @@
-- | Copy a slice of a mutable primitive array to a pointer.
-- The offset and length are given in elements of type @a@.
-- This function assumes that the 'Prim' instance of @a@
--- agrees with the 'Storable' instance.
+-- agrees with the 'Foreign.Storable.Storable' instance.
--
-- /Note:/ this function does not do bounds or overlap checking.
copyMutablePrimArrayToPtr :: forall m a. (PrimMonad m, Prim a)
@@ -429,7 +430,7 @@
-- | Copy from a pointer to a mutable primitive array.
-- The offset and length are given in elements of type @a@.
-- This function assumes that the 'Prim' instance of @a@
--- agrees with the 'Storable' instance.
+-- agrees with the 'Foreign.Storable.Storable' instance.
--
-- /Note:/ this function does not do bounds or overlap checking.
copyPtrToMutablePrimArray :: forall m a. (PrimMonad m, Prim a)
@@ -764,15 +765,14 @@
=> (a -> b)
-> PrimArray a
-> PrimArray b
-mapPrimArray f arr = runST $ do
- let !sz = sizeofPrimArray arr
- marr <- newPrimArray sz
+mapPrimArray f arr = createPrimArray sz $ \marr ->
let go !ix = when (ix < sz) $ do
let b = f (indexPrimArray arr ix)
writePrimArray marr ix b
go (ix + 1)
- go 0
- unsafeFreezePrimArray marr
+ in go 0
+ where
+ !sz = sizeofPrimArray arr
-- | Indexed map over the elements of a primitive array.
{-# INLINE imapPrimArray #-}
@@ -780,15 +780,14 @@
=> (Int -> a -> b)
-> PrimArray a
-> PrimArray b
-imapPrimArray f arr = runST $ do
- let !sz = sizeofPrimArray arr
- marr <- newPrimArray sz
+imapPrimArray f arr = createPrimArray sz $ \marr ->
let go !ix = when (ix < sz) $ do
let b = f ix (indexPrimArray arr ix)
writePrimArray marr ix b
go (ix + 1)
- go 0
- unsafeFreezePrimArray marr
+ in go 0
+ where
+ !sz = sizeofPrimArray arr
-- | Filter elements of a primitive array according to a predicate.
{-# INLINE filterPrimArray #-}
@@ -958,13 +957,11 @@
=> Int -- ^ length
-> (Int -> a) -- ^ element from index
-> PrimArray a
-generatePrimArray len f = runST $ do
- marr <- newPrimArray len
+generatePrimArray len f = createPrimArray len $ \marr ->
let go !ix = when (ix < len) $ do
writePrimArray marr ix (f ix)
go (ix + 1)
- go 0
- unsafeFreezePrimArray marr
+ in go 0
-- | Create a primitive array by copying the element the given
-- number of times.
@@ -973,10 +970,8 @@
=> Int -- ^ length
-> a -- ^ element
-> PrimArray a
-replicatePrimArray len a = runST $ do
- marr <- newPrimArray len
+replicatePrimArray len a = createPrimArray len $ \marr ->
setPrimArray marr 0 len a
- unsafeFreezePrimArray marr
-- | Generate a primitive array by evaluating the applicative generator
-- function at each index.
@@ -1095,8 +1090,9 @@
(# s'#, arr# #) -> (# s'#, MutablePrimArray arr# #))
-- | Yield a pointer to the array's data. This operation is only safe on
--- /pinned/ prim arrays allocated by 'newPinnedByteArray' or
--- 'newAlignedPinnedByteArray'.
+-- /pinned/ prim arrays allocated by
+-- 'Data.Primitive.ByteArray.newPinnedByteArray' or
+-- 'Data.Primitive.ByteArray.newAlignedPinnedByteArray'.
--
-- @since 0.7.1.0
primArrayContents :: PrimArray a -> Ptr a
@@ -1104,8 +1100,9 @@
primArrayContents (PrimArray arr#) = Ptr (byteArrayContents# arr#)
-- | Yield a pointer to the array's data. This operation is only safe on
--- /pinned/ byte arrays allocated by 'newPinnedByteArray' or
--- 'newAlignedPinnedByteArray'.
+-- /pinned/ byte arrays allocated by
+-- 'Data.Primitive.ByteArray.newPinnedByteArray' or
+-- 'Data.Primitive.ByteArray.newAlignedPinnedByteArray'.
--
-- @since 0.7.1.0
mutablePrimArrayContents :: MutablePrimArray s a -> Ptr a
@@ -1122,10 +1119,8 @@
-> Int -- ^ number of elements to copy
-> PrimArray a
{-# INLINE clonePrimArray #-}
-clonePrimArray src off n = runPrimArray $ do
- dst <- newPrimArray n
+clonePrimArray src off n = createPrimArray n $ \dst ->
copyPrimArray dst 0 src off n
- return dst
-- | Return a newly allocated mutable array with the specified subrange of
-- the provided mutable array. The provided mutable array should contain the
@@ -1147,7 +1142,6 @@
runPrimArray
:: (forall s. ST s (MutablePrimArray s a))
-> PrimArray a
-#if MIN_VERSION_base(4,10,0) /* In new GHCs, runRW# is available. */
runPrimArray m = PrimArray (runPrimArray# m)
runPrimArray#
@@ -1159,9 +1153,21 @@
unST :: ST s a -> State# s -> (# State# s, a #)
unST (GHCST.ST f) = f
-#else /* In older GHCs, runRW# is not available. */
-runPrimArray m = runST $ m >>= unsafeFreezePrimArray
-#endif
+
+-- | Create an uninitialized array of the given length, apply the function to
+-- it, and freeze the result.
+--
+-- /Note:/ this function does not check if the input is non-negative.
+--
+-- @since FIXME
+createPrimArray
+ :: Prim a => Int -> (forall s. MutablePrimArray s a -> ST s ()) -> PrimArray
a
+{-# INLINE createPrimArray #-}
+createPrimArray 0 _ = PrimArray (emptyPrimArray# (# #))
+createPrimArray n f = runPrimArray $ do
+ marr <- newPrimArray n
+ f marr
+ pure marr
-- | A composition of 'primArrayContents' and 'keepAliveUnlifted'.
-- The callback function must not return the pointer. The argument
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/primitive-0.9.0.0/Data/Primitive/SmallArray.hs
new/primitive-0.9.1.0/Data/Primitive/SmallArray.hs
--- old/primitive-0.9.0.0/Data/Primitive/SmallArray.hs 2001-09-09
03:46:40.000000000 +0200
+++ new/primitive-0.9.1.0/Data/Primitive/SmallArray.hs 2001-09-09
03:46:40.000000000 +0200
@@ -88,9 +88,6 @@
import Text.ParserCombinators.ReadP
import Text.ParserCombinators.ReadPrec (ReadPrec)
import qualified Text.ParserCombinators.ReadPrec as RdPrc
-#if !MIN_VERSION_base(4,10,0)
-import GHC.Base (runRW#)
-#endif
import Data.Functor.Classes (Eq1(..), Ord1(..), Show1(..), Read1(..))
import Language.Haskell.TH.Syntax (Lift(..))
@@ -191,12 +188,12 @@
-- > f sa = case indexSmallArrayM sa 0 of
-- > Box x -> ...
--
--- 'x' is not a closure that references 'sa' as it would be if we instead
+-- @x@ is not a closure that references @sa@ as it would be if we instead
-- wrote:
--
-- > let x = indexSmallArray sa 0
--
--- It also does not prevent 'sa' from being garbage collected.
+-- It also does not prevent @sa@ from being garbage collected.
--
-- Note that 'Identity' is not adequate for this use, as it is a newtype, and
-- cannot be evaluated without evaluating the element.
@@ -892,14 +889,7 @@
-- | @since 0.6.4.0
instance Read1 SmallArray where
-#if MIN_VERSION_base(4,10,0)
liftReadPrec = smallArrayLiftReadPrec
-#else
- -- This is just the default implementation of liftReadsPrec, but
- -- it is not present in older versions of base.
- liftReadsPrec rp rl = RdPrc.readPrec_to_S $
- smallArrayLiftReadPrec (RdPrc.readS_to_Prec rp) (RdPrc.readS_to_Prec
(const rl))
-#endif
smallArrayDataType :: DataType
smallArrayDataType =
@@ -924,18 +914,19 @@
-- | Create a 'SmallArray' from a list of a known length. If the length
-- of the list does not match the given length, this throws an exception.
smallArrayFromListN :: Int -> [a] -> SmallArray a
+{-# INLINE smallArrayFromListN #-}
smallArrayFromListN n l =
createSmallArray n
(die "smallArrayFromListN" "uninitialized element") $ \sma ->
- let go !ix [] = if ix == n
+ let z ix# = if I# ix# == n
then return ()
else die "smallArrayFromListN" "list length less than specified size"
- go !ix (x : xs) = if ix < n
+ f x k = GHC.Exts.oneShot $ \ix# -> if I# ix# < n
then do
- writeSmallArray sma ix x
- go (ix + 1) xs
+ writeSmallArray sma (I# ix#) x
+ k (ix# +# 1#)
else die "smallArrayFromListN" "list length greater than specified
size"
- in go 0 l
+ in foldr f z l 0#
-- | Create a 'SmallArray' from a list.
smallArrayFromList :: [a] -> SmallArray a
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/primitive-0.9.0.0/Data/Primitive/Types.hs
new/primitive-0.9.1.0/Data/Primitive/Types.hs
--- old/primitive-0.9.0.0/Data/Primitive/Types.hs 2001-09-09
03:46:40.000000000 +0200
+++ new/primitive-0.9.1.0/Data/Primitive/Types.hs 2001-09-09
03:46:40.000000000 +0200
@@ -410,9 +410,7 @@
deriving instance Prim CSigAtomic
deriving instance Prim CLLong
deriving instance Prim CULLong
-#if MIN_VERSION_base(4,10,0)
deriving instance Prim CBool
-#endif
deriving instance Prim CIntPtr
deriving instance Prim CUIntPtr
deriving instance Prim CIntMax
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/primitive-0.9.0.0/Data/Primitive.hs
new/primitive-0.9.1.0/Data/Primitive.hs
--- old/primitive-0.9.0.0/Data/Primitive.hs 2001-09-09 03:46:40.000000000
+0200
+++ new/primitive-0.9.1.0/Data/Primitive.hs 2001-09-09 03:46:40.000000000
+0200
@@ -65,9 +65,11 @@
variants produce the same results and differ only in their strictness.
Monads that are sufficiently affine include:
-* 'IO' and 'ST'
-* Any combination of 'MaybeT', 'ExceptT', 'StateT' and 'Writer' on top
- of another sufficiently affine monad.
+* 'IO' and 'Control.Monad.ST'
+* Any combination of 'Control.Monad.Trans.Maybe.MaybeT',
+ 'Control.Monad.Trans.Except.ExceptT', 'Control.Monad.Trans.State.Lazy.StateT'
+ and 'Control.Monad.Trans.Writer.Lazy.WriterT' on top of another sufficiently
+ affine monad.
* Any Monad which does not include backtracking or other mechanisms where an
effect can
happen more than once is an affine Monad in the sense we care about.
@ContT@, @LogicT@, @ListT@ are all
examples of search/control monads which are NOT affine: they can run a sub
computation more than once.
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/primitive-0.9.0.0/bench/main.hs
new/primitive-0.9.1.0/bench/main.hs
--- old/primitive-0.9.0.0/bench/main.hs 2001-09-09 03:46:40.000000000 +0200
+++ new/primitive-0.9.1.0/bench/main.hs 2001-09-09 03:46:40.000000000 +0200
@@ -9,6 +9,7 @@
import Control.Monad.ST
import Data.Primitive
import Control.Monad.Trans.State.Strict
+import Data.Set (Set)
-- These are fixed implementations of certain operations. In the event
-- that primitive changes its implementation of a function, these
@@ -25,6 +26,8 @@
import qualified PrimArray.Compare
import qualified PrimArray.Traverse
+import qualified Data.Set as Set
+
main :: IO ()
main = defaultMain
[ bgroup "Array"
@@ -34,6 +37,9 @@
, bench "unsafe" (nf (\x -> runST (runStateT
(Array.Traverse.Unsafe.traversePoly cheap x) 0)) numbers)
]
]
+ , bgroup "arrayFromListN"
+ [ bench "set-to-list-to-array" (whnf arrayFromSet setOfIntegers1024)
+ ]
]
, bgroup "ByteArray"
[ bgroup "compare"
@@ -62,6 +68,16 @@
]
]
+setOfIntegers1024 :: Set Integer
+{-# noinline setOfIntegers1024 #-}
+setOfIntegers1024 = Set.fromList [1..1024]
+
+-- The performance of this is used to confirm whether or not arrayFromListN is
+-- actining as a good consumer for list fusion.
+arrayFromSet :: Set Integer -> Array Integer
+{-# noinline arrayFromSet #-}
+arrayFromSet s = arrayFromListN (Set.size s) (Set.toList s)
+
cheap :: Int -> StateT Int (ST s) Int
cheap i = modify (\x -> x + i) >> return (i * i)
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/primitive-0.9.0.0/changelog.md
new/primitive-0.9.1.0/changelog.md
--- old/primitive-0.9.0.0/changelog.md 2001-09-09 03:46:40.000000000 +0200
+++ new/primitive-0.9.1.0/changelog.md 2001-09-09 03:46:40.000000000 +0200
@@ -1,3 +1,22 @@
+## Changes in version 0.9.1.0
+
+ * Make fromListN functions good consumers for list fusion.
+
+ * Add functions to improve `MutVar`'s interoperability with `IORef` and
`STRef`.
+
+ * Add `createPrimArray` and `createByteArray`.
+
+ * Add `byteArrayAsForeignPtr` and `mutableByteArrayAsForeignPtr`.
+
+ * Use `copyMutableByteArrayNonOverlapping#` in the implementation of
`copyMutableByteArray`
+ on sufficiently new GHCs. This does not change the contract for
`copyMutableByteArray`.
+ This function has always been documented as having undefined behavior when
the slices
+ overlap. However, overlaps previously were handled gracefully (with the
semantics
+ of C's `memmove`). Going forward, users who do not uphold
`copyMutableByteArray`'s
+ precondition will be met with unpredictable results.
+
+ * Drop support for GHC 8.0.
+
## Changes in version 0.9.0.0
* Add `withByteArrayContents`, `withMutableByteArrayContents`,
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/primitive-0.9.0.0/primitive.cabal
new/primitive-0.9.1.0/primitive.cabal
--- old/primitive-0.9.0.0/primitive.cabal 2001-09-09 03:46:40.000000000
+0200
+++ new/primitive-0.9.1.0/primitive.cabal 2001-09-09 03:46:40.000000000
+0200
@@ -1,6 +1,6 @@
Cabal-Version: 2.0
Name: primitive
-Version: 0.9.0.0
+Version: 0.9.1.0
License: BSD3
License-File: LICENSE
@@ -19,15 +19,17 @@
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.10.7
GHC == 9.0.2
- GHC == 9.2.5
- GHC == 9.4.4
+ GHC == 9.2.8
+ GHC == 9.4.8
+ GHC == 9.6.6
+ GHC == 9.8.2
+ GHC == 9.10.1
Library
Default-Language: Haskell2010
@@ -55,7 +57,7 @@
Data.Primitive.Internal.Operations
Data.Primitive.Internal.Read
- Build-Depends: base >= 4.9 && < 4.20
+ Build-Depends: base >= 4.10 && < 4.22
, deepseq >= 1.1 && < 1.6
, transformers >= 0.5 && < 0.7
, template-haskell >= 2.11
@@ -70,7 +72,6 @@
Include-Dirs: cbits
Install-Includes: primitive-memops.h
- includes: primitive-memops.h
c-sources: cbits/primitive-memops.c
if !os(solaris)
cc-options: -ftree-vectorize
@@ -86,11 +87,10 @@
type: exitcode-stdio-1.0
build-depends: base
, base-orphans
- , ghc-prim
, primitive
, quickcheck-classes-base >= 0.6 && <0.7
- , QuickCheck >= 2.13 && < 2.15
- , tasty ^>= 1.2 || ^>= 1.3 || ^>= 1.4
+ , QuickCheck >= 2.13 && < 2.16
+ , tasty >= 1.2 && < 1.6
, tasty-quickcheck
, tagged
, transformers >= 0.5
@@ -113,6 +113,7 @@
PrimArray.Traverse
build-depends:
base
+ , containers
, primitive
, deepseq
, tasty-bench
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/primitive-0.9.0.0/test/Main.hs
new/primitive-0.9.1.0/test/Main.hs
--- old/primitive-0.9.0.0/test/Main.hs 2001-09-09 03:46:40.000000000 +0200
+++ new/primitive-0.9.1.0/test/Main.hs 2001-09-09 03:46:40.000000000 +0200
@@ -32,7 +32,6 @@
import Data.Functor.Identity (Identity(..))
import qualified Data.Monoid as Monoid
-import Data.Ord (Down(..))
import Data.Semigroup (stimes, stimesMonoid)
import qualified Data.Semigroup as Semigroup
#if !(MIN_VERSION_base(4,11,0))
