diff --git a/Data/Primitive/ByteArray.hs b/Data/Primitive/ByteArray.hs
index 0d19895d5c0cd342ae4e620d62c898bb9b995fcf..90f1b09411bed59c270c6b8e0dae988ec231c3c8 100644
--- a/Data/Primitive/ByteArray.hs
+++ b/Data/Primitive/ByteArray.hs
@@ -63,6 +63,7 @@ module Data.Primitive.ByteArray (
isByteArrayPinned, isMutableByteArrayPinned,
#endif
byteArrayAsForeignPtr,
+ mutableByteArrayAsForeignPtr,
byteArrayContents,
withByteArrayContents,
mutableByteArrayContents,
@@ -130,11 +131,21 @@ newAlignedPinnedByteArray (I# n#) (I# k#)
-- | 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.
+-- 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 (mutableByteArrayContents# 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
diff --git a/changelog.md b/changelog.md
index bdcd77dc9140963aaa07cfc2e5fd116f0da8fa4e..e97ecf4446534bd9bbbfbb9d3298207b4958a159 100644
--- a/changelog.md
+++ b/changelog.md
@@ -1,5 +1,21 @@
## Changes in version 0.9.1.0
- * Add `byteArrayAsForeignPtr`.
+
+ * 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