From 80641460dfa3a1c91bed4acf4a6391af4196b194 Mon Sep 17 00:00:00 2001 From: Andrew Martin Date: Wed, 24 Apr 2024 09:30:36 -0400 Subject: [PATCH 01/11] Use functions from newer primitive and primitive-unlifted The implementation UnliftedArray in primitive-unlifted-2.1 penalizes the creation of an uninitialized unlifted array. When shrinking and resizing unlifted arrays, there are primitives that we can use to avoid this. Also, primitive itself now has shims for common operations on PrimArray, so this commit also cleans up the Shim module. --- contiguous.cabal | 2 +- src/Data/Primitive/Contiguous.hs | 2 +- src/Data/Primitive/Contiguous/Class.hs | 43 ++++++++++++++---- src/Data/Primitive/Contiguous/Shim.hs | 63 ++++---------------------- 4 files changed, 47 insertions(+), 63 deletions(-) diff --git a/contiguous.cabal b/contiguous.cabal index 8d62ed0..2d52791 100644 --- a/contiguous.cabal +++ b/contiguous.cabal @@ -38,7 +38,7 @@ library build-depends: , base >=4.14 && <5 , deepseq >=1.4 - , primitive >=0.7.2 && <0.10 + , primitive >=0.9 && <0.10 , primitive-unlifted >=2.1 , run-st >=0.1.3.2 diff --git a/src/Data/Primitive/Contiguous.hs b/src/Data/Primitive/Contiguous.hs index 37d99f1..3d01464 100644 --- a/src/Data/Primitive/Contiguous.hs +++ b/src/Data/Primitive/Contiguous.hs @@ -273,7 +273,7 @@ module Data.Primitive.Contiguous ) where import Control.Monad.Primitive -import Data.Primitive hiding (fromList, fromListN) +import Data.Primitive import Data.Primitive.Unlifted.Array import Prelude hiding (Foldable (..), all, any, filter, map, mapM, mapM_, read, replicate, reverse, scanl, sequence, sequence_, traverse, zip, zipWith, (<$)) diff --git a/src/Data/Primitive/Contiguous/Class.hs b/src/Data/Primitive/Contiguous/Class.hs index 675ea3f..a742281 100644 --- a/src/Data/Primitive/Contiguous/Class.hs +++ b/src/Data/Primitive/Contiguous/Class.hs @@ -27,7 +27,7 @@ module Data.Primitive.Contiguous.Class , Always ) where -import Data.Primitive hiding (fromList, fromListN) +import Data.Primitive import Data.Primitive.Contiguous.Shim import Data.Primitive.Unlifted.Array import Prelude hiding @@ -569,7 +569,12 @@ class (Contiguous arr) => ContiguousU arr where -- | The unifted version of the mutable array type (i.e. eliminates an indirection through a thunk). type UnliftedMut arr = (r :: Type -> Type -> TYPE UnliftedRep) | r -> arr - -- | Resize an array into one with the given size. + -- | Resize an array into one with the given size. If the array is grown, + -- then reading from any newly introduced element before writing to it is undefined behavior. + -- The current behavior is that anything backed by @MutableByteArray#@ ends + -- uninitialized memory at these indices. But for @SmallMutableArray@, these + -- are set to an error thunk, so reading from them and forcing the result + -- causes the program to crash. resize :: (PrimMonad m, Element arr b) => Mutable arr (PrimState m) b -> @@ -807,7 +812,7 @@ instance Contiguous SmallArray where {-# INLINE size #-} size = sizeofSmallArray {-# INLINE sizeMut #-} - sizeMut = (\x -> pure $! sizeofSmallMutableArray x) + sizeMut = getSizeofSmallMutableArray {-# INLINE thaw_ #-} thaw_ = thawSmallArray {-# INLINE equals #-} @@ -872,15 +877,19 @@ instance Contiguous SmallArray where {-# INLINE copyMut_ #-} copyMut_ = copySmallMutableArray {-# INLINE replicateMut #-} - replicateMut = replicateSmallMutableArray + replicateMut = newSmallArray {-# INLINE run #-} run = runSmallArrayST + {-# INLINE shrink #-} + shrink !arr !n = do + shrinkSmallMutableArray arr n + pure arr instance ContiguousU SmallArray where type Unlifted SmallArray = SmallArray# type UnliftedMut SmallArray = SmallMutableArray# {-# INLINE resize #-} - resize = resizeSmallArray + resize !arr !n = resizeSmallMutableArray arr n resizeSmallMutableArrayUninitializedElement {-# INLINE unlift #-} unlift (SmallArray x) = x {-# INLINE unliftMut #-} @@ -926,7 +935,7 @@ instance Contiguous PrimArray where lengthMut <- sizeMut baseMut pure MutableSlice {offsetMut = 0, lengthMut, baseMut = unliftMut baseMut} {-# INLINE freeze_ #-} - freeze_ = freezePrimArrayShim + freeze_ = freezePrimArray {-# INLINE unsafeFreeze #-} unsafeFreeze = unsafeFreezePrimArray {-# INLINE thaw_ #-} @@ -936,9 +945,9 @@ instance Contiguous PrimArray where {-# INLINE copyMut_ #-} copyMut_ = copyMutablePrimArray {-# INLINE clone_ #-} - clone_ = clonePrimArrayShim + clone_ = clonePrimArray {-# INLINE cloneMut_ #-} - cloneMut_ = cloneMutablePrimArrayShim + cloneMut_ = cloneMutablePrimArray {-# INLINE equals #-} equals = (==) {-# INLINE null #-} @@ -1250,6 +1259,20 @@ instance Contiguous (UnliftedArray_ unlifted_a) where unsafeFreezeUnliftedArray m {-# INLINE run #-} run = runUnliftedArrayST + {-# INLINE shrink #-} + shrink !arr !n = do + -- See Note [Shrinking Unlifted Arrays] + cloneMutableUnliftedArray arr 0 n + {-# INLINE unsafeShrinkAndFreeze #-} + unsafeShrinkAndFreeze !arr !n = + -- See Note [Shrinking Unlifted Arrays] + freezeUnliftedArray arr 0 n + +-- Note [Shrinking Unlifted Arrays] +-- ================================ +-- This implementation copies the array rather than freezing it in place. +-- But at least it is able to avoid assigning all of the elements to +-- a nonsense value before replacing them with memcpy. newtype UnliftedArray## (u :: TYPE UnliftedRep) (a :: Type) = UnliftedArray## (Exts.Array# u) @@ -1269,3 +1292,7 @@ instance ContiguousU (UnliftedArray_ unlifted_a) where lift (UnliftedArray## x) = UnliftedArray (UnliftedArray# x) {-# INLINE liftMut #-} liftMut (MutableUnliftedArray## x) = MutableUnliftedArray (MutableUnliftedArray# x) + +resizeSmallMutableArrayUninitializedElement :: a +{-# noinline resizeSmallMutableArrayUninitializedElement #-} +resizeSmallMutableArrayUninitializedElement = errorWithoutStackTrace "uninitialized element of resizeSmallMutableArray" diff --git a/src/Data/Primitive/Contiguous/Shim.hs b/src/Data/Primitive/Contiguous/Shim.hs index 961f60a..bb49682 100644 --- a/src/Data/Primitive/Contiguous/Shim.hs +++ b/src/Data/Primitive/Contiguous/Shim.hs @@ -4,18 +4,12 @@ module Data.Primitive.Contiguous.Shim ( errorThunk , resizeArray - , resizeSmallArray - , replicateSmallMutableArray , resizeUnliftedArray , replicateMutablePrimArray - , clonePrimArrayShim - , cloneMutablePrimArrayShim - , freezePrimArrayShim ) where import Control.Monad (when) -import Control.Monad.ST.Run (runPrimArrayST) -import Data.Primitive hiding (fromList, fromListN) +import Data.Primitive import Data.Primitive.Unlifted.Array import Prelude hiding (all, any, elem, filter, foldMap, foldl, foldr, map, mapM, mapM_, maximum, minimum, null, read, replicate, reverse, scanl, sequence, sequence_, traverse, zip, zipWith, (<$)) @@ -33,32 +27,16 @@ resizeArray !src !sz = do pure dst {-# INLINE resizeArray #-} -resizeSmallArray :: (PrimMonad m) => SmallMutableArray (PrimState m) a -> Int -> m (SmallMutableArray (PrimState m) a) -resizeSmallArray !src !sz = do - dst <- newSmallArray sz errorThunk - copySmallMutableArray dst 0 src 0 (min sz (sizeofSmallMutableArray src)) - pure dst -{-# INLINE resizeSmallArray #-} - -replicateSmallMutableArray :: - (PrimMonad m) => - Int -> - a -> - m (SmallMutableArray (PrimState m) a) -replicateSmallMutableArray len a = do - marr <- newSmallArray len errorThunk - let go !ix = when (ix < len) $ do - writeSmallArray marr ix a - go (ix + 1) - go 0 - pure marr -{-# INLINE replicateSmallMutableArray #-} - resizeUnliftedArray :: (PrimMonad m, PrimUnlifted a) => MutableUnliftedArray (PrimState m) a -> Int -> m (MutableUnliftedArray (PrimState m) a) -resizeUnliftedArray !src !sz = do - dst <- unsafeNewUnliftedArray sz - copyMutableUnliftedArray dst 0 src 0 (min sz (sizeofMutableUnliftedArray src)) - pure dst +resizeUnliftedArray !src !sz = + let !srcSz = sizeofMutableUnliftedArray src in + case compare sz srcSz of + EQ -> pure src + LT -> cloneMutableUnliftedArray src 0 sz + GT -> do + dst <- unsafeNewUnliftedArray sz + copyMutableUnliftedArray dst 0 src 0 (min sz (sizeofMutableUnliftedArray src)) + pure dst {-# INLINE resizeUnliftedArray #-} replicateMutablePrimArray :: @@ -73,24 +51,3 @@ replicateMutablePrimArray len a = do setPrimArray marr 0 len a pure marr {-# INLINE replicateMutablePrimArray #-} - -clonePrimArrayShim :: (Prim a) => PrimArray a -> Int -> Int -> PrimArray a -clonePrimArrayShim !arr !off !len = runPrimArrayST $ do - marr <- newPrimArray len - copyPrimArray marr 0 arr off len - unsafeFreezePrimArray marr -{-# INLINE clonePrimArrayShim #-} - -cloneMutablePrimArrayShim :: (PrimMonad m, Prim a) => MutablePrimArray (PrimState m) a -> Int -> Int -> m (MutablePrimArray (PrimState m) a) -cloneMutablePrimArrayShim !arr !off !len = do - marr <- newPrimArray len - copyMutablePrimArray marr 0 arr off len - pure marr -{-# INLINE cloneMutablePrimArrayShim #-} - -freezePrimArrayShim :: (PrimMonad m, Prim a) => MutablePrimArray (PrimState m) a -> Int -> Int -> m (PrimArray a) -freezePrimArrayShim !src !off !len = do - dst <- newPrimArray len - copyMutablePrimArray dst 0 src off len - unsafeFreezePrimArray dst -{-# INLINE freezePrimArrayShim #-} From ae9cc11ccb2c620ec6e15de071d0d679340b2572 Mon Sep 17 00:00:00 2001 From: Andrew Martin Date: Thu, 25 Apr 2024 07:49:43 -0400 Subject: [PATCH 02/11] Update src/Data/Primitive/Contiguous/Class.hs Co-authored-by: Dave Barton --- src/Data/Primitive/Contiguous/Class.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Data/Primitive/Contiguous/Class.hs b/src/Data/Primitive/Contiguous/Class.hs index a742281..5f77fde 100644 --- a/src/Data/Primitive/Contiguous/Class.hs +++ b/src/Data/Primitive/Contiguous/Class.hs @@ -572,7 +572,7 @@ class (Contiguous arr) => ContiguousU arr where -- | Resize an array into one with the given size. If the array is grown, -- then reading from any newly introduced element before writing to it is undefined behavior. -- The current behavior is that anything backed by @MutableByteArray#@ ends - -- uninitialized memory at these indices. But for @SmallMutableArray@, these + -- uninitialized memory at these indices. But for @SmallMutableArray@ or @Array@, these -- are set to an error thunk, so reading from them and forcing the result -- causes the program to crash. resize :: From 2569284267b4702a6be4ce2ee2abeb11034592a1 Mon Sep 17 00:00:00 2001 From: Andrew Martin Date: Thu, 25 Apr 2024 07:50:50 -0400 Subject: [PATCH 03/11] Update src/Data/Primitive/Contiguous/Class.hs Co-authored-by: Dave Barton --- src/Data/Primitive/Contiguous/Class.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Data/Primitive/Contiguous/Class.hs b/src/Data/Primitive/Contiguous/Class.hs index 5f77fde..4941e72 100644 --- a/src/Data/Primitive/Contiguous/Class.hs +++ b/src/Data/Primitive/Contiguous/Class.hs @@ -574,7 +574,7 @@ class (Contiguous arr) => ContiguousU arr where -- The current behavior is that anything backed by @MutableByteArray#@ ends -- uninitialized memory at these indices. But for @SmallMutableArray@ or @Array@, these -- are set to an error thunk, so reading from them and forcing the result - -- causes the program to crash. + -- causes the program to crash. For @UnliftedArray@, the new elements have undefined values of an unknown type. resize :: (PrimMonad m, Element arr b) => Mutable arr (PrimState m) b -> From 5ea2ed07f2526416118d5a5917b5ad6782810270 Mon Sep 17 00:00:00 2001 From: Andrew Martin Date: Thu, 25 Apr 2024 07:51:10 -0400 Subject: [PATCH 04/11] Update src/Data/Primitive/Contiguous/Class.hs Co-authored-by: Dave Barton --- src/Data/Primitive/Contiguous/Class.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/src/Data/Primitive/Contiguous/Class.hs b/src/Data/Primitive/Contiguous/Class.hs index 4941e72..15dbeca 100644 --- a/src/Data/Primitive/Contiguous/Class.hs +++ b/src/Data/Primitive/Contiguous/Class.hs @@ -575,6 +575,7 @@ class (Contiguous arr) => ContiguousU arr where -- uninitialized memory at these indices. But for @SmallMutableArray@ or @Array@, these -- are set to an error thunk, so reading from them and forcing the result -- causes the program to crash. For @UnliftedArray@, the new elements have undefined values of an unknown type. + -- If the array is not grown, it may (or may not) be modified in place. resize :: (PrimMonad m, Element arr b) => Mutable arr (PrimState m) b -> From 95e48d02855bcd8eaf7e55d4340f3f138fc7a35e Mon Sep 17 00:00:00 2001 From: Andrew Martin Date: Thu, 25 Apr 2024 08:19:42 -0400 Subject: [PATCH 05/11] Remove several defaults, improve shrinking and resizing --- src/Data/Primitive/Contiguous/Class.hs | 62 +++++++++++++------------- src/Data/Primitive/Contiguous/Shim.hs | 18 +++++--- 2 files changed, 43 insertions(+), 37 deletions(-) diff --git a/src/Data/Primitive/Contiguous/Class.hs b/src/Data/Primitive/Contiguous/Class.hs index 15dbeca..21a948e 100644 --- a/src/Data/Primitive/Contiguous/Class.hs +++ b/src/Data/Primitive/Contiguous/Class.hs @@ -148,16 +148,6 @@ class Contiguous (arr :: Type -> Type) where -- | new length Int -> m (Mutable arr (PrimState m) a) - default shrink :: - ( ContiguousU arr - , PrimMonad m - , Element arr a - ) => - Mutable arr (PrimState m) a -> - Int -> - m (Mutable arr (PrimState m) a) - {-# INLINE shrink #-} - shrink = resize -- | The empty array. empty :: arr a @@ -380,8 +370,6 @@ class Contiguous (arr :: Type -> Type) where (PrimMonad m, Element arr b) => Mutable arr (PrimState m) b -> m (arr b) - unsafeFreeze xs = unsafeShrinkAndFreeze xs =<< sizeMut xs - {-# INLINE unsafeFreeze #-} unsafeShrinkAndFreeze :: (PrimMonad m, Element arr a) => @@ -389,17 +377,6 @@ class Contiguous (arr :: Type -> Type) where -- | final size Int -> m (arr a) - default unsafeShrinkAndFreeze :: - ( ContiguousU arr - , PrimMonad m - , Element arr a - ) => - Mutable arr (PrimState m) a -> - Int -> - m (arr a) - {-# INLINE unsafeShrinkAndFreeze #-} - unsafeShrinkAndFreeze arr0 len' = - resize arr0 len' >>= unsafeFreeze -- | Copy a slice of an immutable array into a new mutable array. thaw :: @@ -624,6 +601,10 @@ instance (ContiguousU arr) => Contiguous (Slice arr) where replicateMut len x = do baseMut <- replicateMut len x pure MutableSlice {offsetMut = 0, lengthMut = len, baseMut = unliftMut baseMut} + {-# INLINE unsafeFreeze #-} + unsafeFreeze (MutableSlice off len base) = do + base' <- unsafeFreeze (liftMut base) + pure (Slice off len (unlift base')) {-# INLINE shrink #-} shrink xs len' = pure $ case compare len' (lengthMut xs) of LT -> xs {lengthMut = len'} @@ -885,6 +866,9 @@ instance Contiguous SmallArray where shrink !arr !n = do shrinkSmallMutableArray arr n pure arr + unsafeShrinkAndFreeze !arr !n = do + shrinkSmallMutableArray arr n + unsafeFreezeSmallArray arr instance ContiguousU SmallArray where type Unlifted SmallArray = SmallArray# @@ -1013,6 +997,14 @@ instance Contiguous PrimArray where unsafeFreeze dst {-# INLINE run #-} run = runPrimArrayST + {-# INLINE shrink #-} + shrink !arr !n = do + shrinkMutablePrimArray arr n + pure arr + {-# INLINE unsafeShrinkAndFreeze #-} + unsafeShrinkAndFreeze !arr !n = do + shrinkMutablePrimArray arr n + unsafeFreezePrimArray arr newtype PrimArray# a = PrimArray# ByteArray# newtype MutablePrimArray# s a = MutablePrimArray# (MutableByteArray# s) @@ -1137,6 +1129,14 @@ instance Contiguous Array where unsafeFreezeArray m {-# INLINE run #-} run = runArrayST + {-# INLINE shrink #-} + shrink !arr !n = do + -- See Note [Shrinking Arrays Without a Shrink Primop] + cloneMutableArray arr 0 n + {-# INLINE unsafeShrinkAndFreeze #-} + unsafeShrinkAndFreeze !arr !n = + -- See Note [Shrinking Arrays Without a Shrink Primop] + freezeArray arr 0 n instance ContiguousU Array where type Unlifted Array = Array# @@ -1262,18 +1262,20 @@ instance Contiguous (UnliftedArray_ unlifted_a) where run = runUnliftedArrayST {-# INLINE shrink #-} shrink !arr !n = do - -- See Note [Shrinking Unlifted Arrays] + -- See Note [Shrinking Arrays Without a Shrink Primop] cloneMutableUnliftedArray arr 0 n {-# INLINE unsafeShrinkAndFreeze #-} unsafeShrinkAndFreeze !arr !n = - -- See Note [Shrinking Unlifted Arrays] + -- See Note [Shrinking Arrays Without a Shrink Primop] freezeUnliftedArray arr 0 n --- Note [Shrinking Unlifted Arrays] --- ================================ --- This implementation copies the array rather than freezing it in place. --- But at least it is able to avoid assigning all of the elements to --- a nonsense value before replacing them with memcpy. +-- Note [Shrinking Arrays Without a Shrink Primop] +-- =============================================== +-- GHC's Array# type has a card table and cannot currently be shrunk in place. +-- (SmallArray#, however, can be shrunk in place). These implementations copy +-- the array rather than freezing it in place. But at least they are able to +-- avoid assigning all of the elements to a nonsense value before replacing +-- them with memcpy. newtype UnliftedArray## (u :: TYPE UnliftedRep) (a :: Type) = UnliftedArray## (Exts.Array# u) diff --git a/src/Data/Primitive/Contiguous/Shim.hs b/src/Data/Primitive/Contiguous/Shim.hs index bb49682..20dfc88 100644 --- a/src/Data/Primitive/Contiguous/Shim.hs +++ b/src/Data/Primitive/Contiguous/Shim.hs @@ -8,7 +8,6 @@ module Data.Primitive.Contiguous.Shim , replicateMutablePrimArray ) where -import Control.Monad (when) import Data.Primitive import Data.Primitive.Unlifted.Array import Prelude hiding (all, any, elem, filter, foldMap, foldl, foldr, map, mapM, mapM_, maximum, minimum, null, read, replicate, reverse, scanl, sequence, sequence_, traverse, zip, zipWith, (<$)) @@ -22,20 +21,25 @@ errorThunk = error "Contiguous typeclass: unitialized element" resizeArray :: (PrimMonad m) => MutableArray (PrimState m) a -> Int -> m (MutableArray (PrimState m) a) resizeArray !src !sz = do - dst <- newArray sz errorThunk - copyMutableArray dst 0 src 0 (min sz (sizeofMutableArray src)) - pure dst + let !srcSz = sizeofMutableArray src + case compare sz srcSz of + EQ -> pure src + LT -> cloneMutableArray src 0 sz + GT -> do + dst <- newArray sz errorThunk + copyMutableArray dst 0 src 0 sz + pure dst {-# INLINE resizeArray #-} resizeUnliftedArray :: (PrimMonad m, PrimUnlifted a) => MutableUnliftedArray (PrimState m) a -> Int -> m (MutableUnliftedArray (PrimState m) a) -resizeUnliftedArray !src !sz = - let !srcSz = sizeofMutableUnliftedArray src in +resizeUnliftedArray !src !sz = do + let !srcSz = sizeofMutableUnliftedArray src case compare sz srcSz of EQ -> pure src LT -> cloneMutableUnliftedArray src 0 sz GT -> do dst <- unsafeNewUnliftedArray sz - copyMutableUnliftedArray dst 0 src 0 (min sz (sizeofMutableUnliftedArray src)) + copyMutableUnliftedArray dst 0 src 0 sz pure dst {-# INLINE resizeUnliftedArray #-} From 6c4e8a5d84b33db708359d9ed1180742b81db2e8 Mon Sep 17 00:00:00 2001 From: Andrew Martin Date: Tue, 7 May 2024 09:18:52 -0400 Subject: [PATCH 06/11] Update src/Data/Primitive/Contiguous/Class.hs Co-authored-by: Dave Barton --- src/Data/Primitive/Contiguous/Class.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Data/Primitive/Contiguous/Class.hs b/src/Data/Primitive/Contiguous/Class.hs index 21a948e..57765ed 100644 --- a/src/Data/Primitive/Contiguous/Class.hs +++ b/src/Data/Primitive/Contiguous/Class.hs @@ -548,7 +548,7 @@ class (Contiguous arr) => ContiguousU arr where -- | Resize an array into one with the given size. If the array is grown, -- then reading from any newly introduced element before writing to it is undefined behavior. - -- The current behavior is that anything backed by @MutableByteArray#@ ends + -- The current behavior is that anything backed by @MutableByteArray#@ ends with -- uninitialized memory at these indices. But for @SmallMutableArray@ or @Array@, these -- are set to an error thunk, so reading from them and forcing the result -- causes the program to crash. For @UnliftedArray@, the new elements have undefined values of an unknown type. From 709735dafeba7cdeb75a01df221a41c841889af6 Mon Sep 17 00:00:00 2001 From: Andrew Martin Date: Tue, 7 May 2024 09:19:05 -0400 Subject: [PATCH 07/11] Update src/Data/Primitive/Contiguous/Class.hs Co-authored-by: Dave Barton --- src/Data/Primitive/Contiguous/Class.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/src/Data/Primitive/Contiguous/Class.hs b/src/Data/Primitive/Contiguous/Class.hs index 57765ed..95aba2f 100644 --- a/src/Data/Primitive/Contiguous/Class.hs +++ b/src/Data/Primitive/Contiguous/Class.hs @@ -866,6 +866,7 @@ instance Contiguous SmallArray where shrink !arr !n = do shrinkSmallMutableArray arr n pure arr + {-# INLINE unsafeShrinkAndFreeze #-} unsafeShrinkAndFreeze !arr !n = do shrinkSmallMutableArray arr n unsafeFreezeSmallArray arr From 08eebb6f9a28afa4c648d0cb3936ed9720ea3aa7 Mon Sep 17 00:00:00 2001 From: Andrew Martin Date: Tue, 7 May 2024 09:19:25 -0400 Subject: [PATCH 08/11] Update src/Data/Primitive/Contiguous/Class.hs Co-authored-by: Dave Barton --- src/Data/Primitive/Contiguous/Class.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Data/Primitive/Contiguous/Class.hs b/src/Data/Primitive/Contiguous/Class.hs index 95aba2f..694bcf6 100644 --- a/src/Data/Primitive/Contiguous/Class.hs +++ b/src/Data/Primitive/Contiguous/Class.hs @@ -1273,7 +1273,7 @@ instance Contiguous (UnliftedArray_ unlifted_a) where -- Note [Shrinking Arrays Without a Shrink Primop] -- =============================================== -- GHC's Array# type has a card table and cannot currently be shrunk in place. --- (SmallArray#, however, can be shrunk in place). These implementations copy +-- (SmallArray#, however, can be shrunk in place.) These implementations copy -- the array rather than freezing it in place. But at least they are able to -- avoid assigning all of the elements to a nonsense value before replacing -- them with memcpy. From a8b1607ddec6898f806b7f2335efa804147141aa Mon Sep 17 00:00:00 2001 From: Andrew Martin Date: Tue, 7 May 2024 09:19:56 -0400 Subject: [PATCH 09/11] Update src/Data/Primitive/Contiguous/Shim.hs Co-authored-by: Dave Barton --- src/Data/Primitive/Contiguous/Shim.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Data/Primitive/Contiguous/Shim.hs b/src/Data/Primitive/Contiguous/Shim.hs index 20dfc88..d2dc0b4 100644 --- a/src/Data/Primitive/Contiguous/Shim.hs +++ b/src/Data/Primitive/Contiguous/Shim.hs @@ -39,7 +39,7 @@ resizeUnliftedArray !src !sz = do LT -> cloneMutableUnliftedArray src 0 sz GT -> do dst <- unsafeNewUnliftedArray sz - copyMutableUnliftedArray dst 0 src 0 sz + copyMutableUnliftedArray dst 0 src 0 srcSz pure dst {-# INLINE resizeUnliftedArray #-} From 3e43cce9aed381e46ecc9287c0319fcfc0bc160f Mon Sep 17 00:00:00 2001 From: Andrew Martin Date: Tue, 7 May 2024 09:20:29 -0400 Subject: [PATCH 10/11] Update src/Data/Primitive/Contiguous/Shim.hs Co-authored-by: Dave Barton --- src/Data/Primitive/Contiguous/Shim.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Data/Primitive/Contiguous/Shim.hs b/src/Data/Primitive/Contiguous/Shim.hs index d2dc0b4..9d705ca 100644 --- a/src/Data/Primitive/Contiguous/Shim.hs +++ b/src/Data/Primitive/Contiguous/Shim.hs @@ -27,7 +27,7 @@ resizeArray !src !sz = do LT -> cloneMutableArray src 0 sz GT -> do dst <- newArray sz errorThunk - copyMutableArray dst 0 src 0 sz + copyMutableArray dst 0 src 0 srcSz pure dst {-# INLINE resizeArray #-} From 546847a2211596a5c16c67dc92c85cba89b08266 Mon Sep 17 00:00:00 2001 From: Andrew Martin Date: Thu, 9 May 2024 15:30:19 -0400 Subject: [PATCH 11/11] Add "it may be shrunk in place" --- src/Data/Primitive/Contiguous/Class.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Data/Primitive/Contiguous/Class.hs b/src/Data/Primitive/Contiguous/Class.hs index 694bcf6..f4d16b1 100644 --- a/src/Data/Primitive/Contiguous/Class.hs +++ b/src/Data/Primitive/Contiguous/Class.hs @@ -139,7 +139,7 @@ class Contiguous (arr :: Type -> Type) where b -> -- fill element m (Mutable arr (PrimState m) b) - -- | Resize an array without growing it. + -- | Resize an array without growing it. It may be shrunk in place. -- -- @since 0.6.0 shrink ::