Implement shrinkSmallMutableArray# and resizeSmallMutableArray#.

This is a part of GHC Proposal #25: "Offer more array resizing primitives".
Resources related to the proposal:

  - Discussion: https://github.com/ghc-proposals/ghc-proposals/pull/121
  - Proposal: https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0025-resize-boxed.rst

Only shrinkSmallMutableArray# is implemented as a primop since a
library-space implementation of resizeSmallMutableArray# (in GHC.Exts)
is no less efficient than a primop would be. This may be replaced by
a primop in the future if someone devises a strategy for growing
arrays in-place. The library-space implementation always copies the
array when growing it.

This commit also tweaks the documentation of the deprecated
sizeofMutableByteArray#, removing the mention of concurrency. That
primop is unsound even in single-threaded applications. Additionally,
the non-negativity assertion on the existing shrinkMutableByteArray#
primop has been removed since this predicate is trivially always true.

2 files changed, 18 insertions, 1 deletions

diff --git a/compiler/GHC/StgToCmm/Prim.hs b/compiler/GHC/StgToCmm/Prim.hs
index 155cdcbf80..e309d061a8 100644
--- a/compiler/GHC/StgToCmm/Prim.hs
+++ b/compiler/GHC/StgToCmm/Prim.hs
@@ -473,6 +473,7 @@ dispatchPrimop dflags = \case
         (bWord dflags))
 
   SizeofSmallMutableArrayOp -> dispatchPrimop dflags SizeofSmallArrayOp
+  GetSizeofSmallMutableArrayOp -> dispatchPrimop dflags SizeofSmallArrayOp
 
 -- IndexXXXoffAddr
 
@@ -1452,6 +1453,7 @@ dispatchPrimop dflags = \case
   ByteArrayIsPinnedOp -> alwaysExternal
   ShrinkMutableByteArrayOp_Char -> alwaysExternal
   ResizeMutableByteArrayOp_Char -> alwaysExternal
+  ShrinkSmallMutableArrayOp_Char -> alwaysExternal
   NewArrayArrayOp -> alwaysExternal
   NewMutVarOp -> alwaysExternal
   AtomicModifyMutVar2Op -> alwaysExternal
diff --git a/compiler/prelude/primops.txt.pp b/compiler/prelude/primops.txt.pp
index 47a78e2c8d..f47880b58d 100644
--- a/compiler/prelude/primops.txt.pp
+++ b/compiler/prelude/primops.txt.pp
@@ -1244,6 +1244,14 @@ primop  NewSmallArrayOp "newSmallArray#" GenPrimOp
 primop  SameSmallMutableArrayOp "sameSmallMutableArray#" GenPrimOp
    SmallMutableArray# s a -> SmallMutableArray# s a -> Int#
 
+primop  ShrinkSmallMutableArrayOp_Char "shrinkSmallMutableArray#" GenPrimOp
+   SmallMutableArray# s a -> Int# -> State# s -> State# s
+   {Shrink mutable array to new specified size, in
+    the specified state thread. The new size argument must be less than or
+    equal to the current size as reported by {\tt sizeofSmallMutableArray\#}.}
+   with out_of_line = True
+        has_side_effects = True
+
 primop  ReadSmallArrayOp "readSmallArray#" GenPrimOp
    SmallMutableArray# s a -> Int# -> State# s -> (# State# s, a #)
    {Read from specified index of mutable array. Result is not yet evaluated.}
@@ -1264,6 +1272,13 @@ primop  SizeofSmallArrayOp "sizeofSmallArray#" GenPrimOp
 
 primop  SizeofSmallMutableArrayOp "sizeofSmallMutableArray#" GenPrimOp
    SmallMutableArray# s a -> Int#
+   {Return the number of elements in the array. Note that this is deprecated
+   as it is unsafe in the presence of resize operations on the
+   same byte array.}
+   with deprecated_msg = { Use 'getSizeofSmallMutableArray#' instead }
+
+primop  GetSizeofSmallMutableArrayOp "getSizeofSmallMutableArray#" GenPrimOp
+   SmallMutableArray# s a -> State# s -> (# State# s, Int# #)
    {Return the number of elements in the array.}
 
 primop  IndexSmallArrayOp "indexSmallArray#" GenPrimOp
@@ -1463,7 +1478,7 @@ primop  SizeofByteArrayOp "sizeofByteArray#" GenPrimOp
 primop  SizeofMutableByteArrayOp "sizeofMutableByteArray#" GenPrimOp
    MutableByteArray# s -> Int#
    {Return the size of the array in bytes. Note that this is deprecated as it is
-   unsafe in the presence of concurrent resize operations on the same byte
+   unsafe in the presence of resize operations on the same byte
    array.}
    with deprecated_msg = { Use 'getSizeofMutableByteArray#' instead }