Add SmallArray# and SmallMutableArray# types

These array types are smaller than Array# and MutableArray# and are
faster when the array size is small, as they don't have the overhead
of a card table. Having no card table reduces the closure size with 2
words in the typical small array case and leads to less work when
updating or GC:ing the array.

Reduces both the runtime and memory allocation by 8.8% on my insert
benchmark for the HashMap type in the unordered-containers package,
which makes use of lots of small arrays. With tuned GC settings
(i.e. `+RTS -A6M`) the runtime reduction is 15%.

Fixes #8923.

3 files changed, 172 insertions, 7 deletions

diff --git a/compiler/prelude/PrelNames.lhs b/compiler/prelude/PrelNames.lhs
index 0512607109..86f8d29229 100644
--- a/compiler/prelude/PrelNames.lhs
+++ b/compiler/prelude/PrelNames.lhs
@@ -1304,7 +1304,8 @@ addrPrimTyConKey, arrayPrimTyConKey, arrayArrayPrimTyConKey, boolTyConKey, byteA
     mutableArrayPrimTyConKey, mutableArrayArrayPrimTyConKey, mutableByteArrayPrimTyConKey,
     orderingTyConKey, mVarPrimTyConKey, ratioTyConKey, rationalTyConKey,
     realWorldTyConKey, stablePtrPrimTyConKey, stablePtrTyConKey,
-    anyTyConKey, eqTyConKey :: Unique
+    anyTyConKey, eqTyConKey, smallArrayPrimTyConKey,
+    smallMutableArrayPrimTyConKey :: Unique
 addrPrimTyConKey                        = mkPreludeTyConUnique  1
 arrayPrimTyConKey                       = mkPreludeTyConUnique  3
 boolTyConKey                            = mkPreludeTyConUnique  4
@@ -1494,6 +1495,9 @@ proxyPrimTyConKey = mkPreludeTyConUnique 176
 specTyConKey :: Unique
 specTyConKey = mkPreludeTyConUnique 177
 
+smallArrayPrimTyConKey        = mkPreludeTyConUnique  178
+smallMutableArrayPrimTyConKey = mkPreludeTyConUnique  179
+
 ---------------- Template Haskell -------------------
 --      USES TyConUniques 200-299
 -----------------------------------------------------
diff --git a/compiler/prelude/TysPrim.lhs b/compiler/prelude/TysPrim.lhs
index bbe5aba119..789d121519 100644
--- a/compiler/prelude/TysPrim.lhs
+++ b/compiler/prelude/TysPrim.lhs
@@ -54,9 +54,11 @@ module TysPrim(
 	arrayPrimTyCon,	mkArrayPrimTy, 
 	byteArrayPrimTyCon,	byteArrayPrimTy,
 	arrayArrayPrimTyCon, mkArrayArrayPrimTy, 
+	smallArrayPrimTyCon, mkSmallArrayPrimTy,
 	mutableArrayPrimTyCon, mkMutableArrayPrimTy,
 	mutableByteArrayPrimTyCon, mkMutableByteArrayPrimTy,
 	mutableArrayArrayPrimTyCon, mkMutableArrayArrayPrimTy,
+	smallMutableArrayPrimTyCon, mkSmallMutableArrayPrimTy,
 	mutVarPrimTyCon, mkMutVarPrimTy,
 
 	mVarPrimTyCon,			mkMVarPrimTy,	
@@ -111,6 +113,7 @@ primTyCons
     , arrayPrimTyCon
     , byteArrayPrimTyCon
     , arrayArrayPrimTyCon
+    , smallArrayPrimTyCon
     , charPrimTyCon
     , doublePrimTyCon
     , floatPrimTyCon
@@ -122,6 +125,7 @@ primTyCons
     , mutableArrayPrimTyCon
     , mutableByteArrayPrimTyCon
     , mutableArrayArrayPrimTyCon
+    , smallMutableArrayPrimTyCon
     , mVarPrimTyCon
     , tVarPrimTyCon
     , mutVarPrimTyCon
@@ -156,7 +160,7 @@ mkPrimTc fs unique tycon
 		  (ATyCon tycon)	-- Relevant TyCon
 		  UserSyntax		-- None are built-in syntax
 
-charPrimTyConName, intPrimTyConName, int32PrimTyConName, int64PrimTyConName, wordPrimTyConName, word32PrimTyConName, word64PrimTyConName, addrPrimTyConName, floatPrimTyConName, doublePrimTyConName, statePrimTyConName, proxyPrimTyConName, realWorldTyConName, arrayPrimTyConName, arrayArrayPrimTyConName, byteArrayPrimTyConName, mutableArrayPrimTyConName, mutableByteArrayPrimTyConName, mutableArrayArrayPrimTyConName, mutVarPrimTyConName, mVarPrimTyConName, tVarPrimTyConName, stablePtrPrimTyConName, stableNamePrimTyConName, bcoPrimTyConName, weakPrimTyConName, threadIdPrimTyConName, eqPrimTyConName, eqReprPrimTyConName, voidPrimTyConName :: Name
+charPrimTyConName, intPrimTyConName, int32PrimTyConName, int64PrimTyConName, wordPrimTyConName, word32PrimTyConName, word64PrimTyConName, addrPrimTyConName, floatPrimTyConName, doublePrimTyConName, statePrimTyConName, proxyPrimTyConName, realWorldTyConName, arrayPrimTyConName, arrayArrayPrimTyConName, smallArrayPrimTyConName, byteArrayPrimTyConName, mutableArrayPrimTyConName, mutableByteArrayPrimTyConName, mutableArrayArrayPrimTyConName, smallMutableArrayPrimTyConName, mutVarPrimTyConName, mVarPrimTyConName, tVarPrimTyConName, stablePtrPrimTyConName, stableNamePrimTyConName, bcoPrimTyConName, weakPrimTyConName, threadIdPrimTyConName, eqPrimTyConName, eqReprPrimTyConName, voidPrimTyConName :: Name
 charPrimTyConName    	      = mkPrimTc (fsLit "Char#") charPrimTyConKey charPrimTyCon
 intPrimTyConName     	      = mkPrimTc (fsLit "Int#") intPrimTyConKey  intPrimTyCon
 int32PrimTyConName	      = mkPrimTc (fsLit "Int32#") int32PrimTyConKey int32PrimTyCon
@@ -176,9 +180,11 @@ realWorldTyConName            = mkPrimTc (fsLit "RealWorld") realWorldTyConKey r
 arrayPrimTyConName   	      = mkPrimTc (fsLit "Array#") arrayPrimTyConKey arrayPrimTyCon
 byteArrayPrimTyConName	      = mkPrimTc (fsLit "ByteArray#") byteArrayPrimTyConKey byteArrayPrimTyCon
 arrayArrayPrimTyConName   	  = mkPrimTc (fsLit "ArrayArray#") arrayArrayPrimTyConKey arrayArrayPrimTyCon
+smallArrayPrimTyConName       = mkPrimTc (fsLit "SmallArray#") smallArrayPrimTyConKey smallArrayPrimTyCon
 mutableArrayPrimTyConName     = mkPrimTc (fsLit "MutableArray#") mutableArrayPrimTyConKey mutableArrayPrimTyCon
 mutableByteArrayPrimTyConName = mkPrimTc (fsLit "MutableByteArray#") mutableByteArrayPrimTyConKey mutableByteArrayPrimTyCon
 mutableArrayArrayPrimTyConName= mkPrimTc (fsLit "MutableArrayArray#") mutableArrayArrayPrimTyConKey mutableArrayArrayPrimTyCon
+smallMutableArrayPrimTyConName= mkPrimTc (fsLit "SmallMutableArray#") smallMutableArrayPrimTyConKey smallMutableArrayPrimTyCon
 mutVarPrimTyConName	      = mkPrimTc (fsLit "MutVar#") mutVarPrimTyConKey mutVarPrimTyCon
 mVarPrimTyConName	      = mkPrimTc (fsLit "MVar#") mVarPrimTyConKey mVarPrimTyCon
 tVarPrimTyConName	      = mkPrimTc (fsLit "TVar#") tVarPrimTyConKey tVarPrimTyCon
@@ -538,13 +544,16 @@ defined in \tr{TysWiredIn.lhs}, not here.
 
 \begin{code}
 arrayPrimTyCon, mutableArrayPrimTyCon, mutableByteArrayPrimTyCon,
-    byteArrayPrimTyCon, arrayArrayPrimTyCon, mutableArrayArrayPrimTyCon :: TyCon
+    byteArrayPrimTyCon, arrayArrayPrimTyCon, mutableArrayArrayPrimTyCon,
+    smallArrayPrimTyCon, smallMutableArrayPrimTyCon :: TyCon
 arrayPrimTyCon             = pcPrimTyCon arrayPrimTyConName             [Representational] PtrRep
 mutableArrayPrimTyCon      = pcPrimTyCon  mutableArrayPrimTyConName     [Nominal, Representational] PtrRep
 mutableByteArrayPrimTyCon  = pcPrimTyCon mutableByteArrayPrimTyConName  [Nominal] PtrRep
 byteArrayPrimTyCon         = pcPrimTyCon0 byteArrayPrimTyConName        PtrRep
 arrayArrayPrimTyCon        = pcPrimTyCon0 arrayArrayPrimTyConName       PtrRep
 mutableArrayArrayPrimTyCon = pcPrimTyCon mutableArrayArrayPrimTyConName [Nominal] PtrRep
+smallArrayPrimTyCon        = pcPrimTyCon smallArrayPrimTyConName        [Representational] PtrRep
+smallMutableArrayPrimTyCon = pcPrimTyCon smallMutableArrayPrimTyConName [Nominal, Representational] PtrRep
 
 mkArrayPrimTy :: Type -> Type
 mkArrayPrimTy elt    	    = TyConApp arrayPrimTyCon [elt]
@@ -552,12 +561,16 @@ byteArrayPrimTy :: Type
 byteArrayPrimTy	    	    = mkTyConTy byteArrayPrimTyCon
 mkArrayArrayPrimTy :: Type
 mkArrayArrayPrimTy = mkTyConTy arrayArrayPrimTyCon
+mkSmallArrayPrimTy :: Type -> Type
+mkSmallArrayPrimTy elt = TyConApp smallArrayPrimTyCon [elt]
 mkMutableArrayPrimTy :: Type -> Type -> Type
 mkMutableArrayPrimTy s elt  = TyConApp mutableArrayPrimTyCon [s, elt]
 mkMutableByteArrayPrimTy :: Type -> Type
 mkMutableByteArrayPrimTy s  = TyConApp mutableByteArrayPrimTyCon [s]
 mkMutableArrayArrayPrimTy :: Type -> Type
 mkMutableArrayArrayPrimTy s = TyConApp mutableArrayArrayPrimTyCon [s]
+mkSmallMutableArrayPrimTy :: Type -> Type -> Type
+mkSmallMutableArrayPrimTy s elt = TyConApp smallMutableArrayPrimTyCon [s, elt]
 \end{code}
 
 %************************************************************************
diff --git a/compiler/prelude/primops.txt.pp b/compiler/prelude/primops.txt.pp
index 553163b0af..10dd19d4bb 100644
--- a/compiler/prelude/primops.txt.pp
+++ b/compiler/prelude/primops.txt.pp
@@ -796,7 +796,7 @@ primop  CloneArrayOp "cloneArray#" GenPrimOp
   with
   out_of_line      = True
   has_side_effects = True
-  code_size = { primOpCodeSizeForeignCall + 4 }
+  can_fail         = True
 
 primop  CloneMutableArrayOp "cloneMutableArray#" GenPrimOp
   MutableArray# s a -> Int# -> Int# -> State# s -> (# State# s, MutableArray# s a #)
@@ -807,7 +807,7 @@ primop  CloneMutableArrayOp "cloneMutableArray#" GenPrimOp
   with
   out_of_line      = True
   has_side_effects = True
-  code_size = { primOpCodeSizeForeignCall + 4 }
+  can_fail         = True
 
 primop  FreezeArrayOp "freezeArray#" GenPrimOp
   MutableArray# s a -> Int# -> Int# -> State# s -> (# State# s, Array# a #)
@@ -818,7 +818,7 @@ primop  FreezeArrayOp "freezeArray#" GenPrimOp
   with
   out_of_line      = True
   has_side_effects = True
-  code_size = { primOpCodeSizeForeignCall + 4 }
+  can_fail         = True
 
 primop  ThawArrayOp "thawArray#" GenPrimOp
   Array# a -> Int# -> Int# -> State# s -> (# State# s, MutableArray# s a #)
@@ -829,7 +829,7 @@ primop  ThawArrayOp "thawArray#" GenPrimOp
   with
   out_of_line      = True
   has_side_effects = True
-  code_size = { primOpCodeSizeForeignCall + 4 }
+  can_fail         = True
 
 primop CasArrayOp  "casArray#" GenPrimOp
    MutableArray# s a -> Int# -> a -> a -> State# s -> (# State# s, Int#, a #)
@@ -840,6 +840,154 @@ primop CasArrayOp  "casArray#" GenPrimOp
 
 
 ------------------------------------------------------------------------
+section "Small Arrays"
+
+	{Operations on {\tt SmallArray\#}. A {\tt SmallArray\#} works
+         just like an {\tt Array\#}, except that its implementation is
+         optimized for small arrays (i.e. no more than 128 elements.)}
+
+------------------------------------------------------------------------
+
+primtype SmallArray# a
+
+primtype SmallMutableArray# s a
+
+primop  NewSmallArrayOp "newSmallArray#" GenPrimOp
+   Int# -> a -> State# s -> (# State# s, SmallMutableArray# s a #)
+   {Create a new mutable array with the specified number of elements,
+    in the specified state thread,
+    with each element containing the specified initial value.}
+   with
+   out_of_line = True
+   has_side_effects = True
+
+primop  SameSmallMutableArrayOp "sameSmallMutableArray#" GenPrimOp
+   SmallMutableArray# s a -> SmallMutableArray# s a -> Int#
+
+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.}
+   with
+   has_side_effects = True
+   can_fail         = True
+
+primop  WriteSmallArrayOp "writeSmallArray#" GenPrimOp
+   SmallMutableArray# s a -> Int# -> a -> State# s -> State# s
+   {Write to specified index of mutable array.}
+   with
+   has_side_effects = True
+   can_fail         = True
+
+primop  SizeofSmallArrayOp "sizeofSmallArray#" GenPrimOp
+   SmallArray# a -> Int#
+   {Return the number of elements in the array.}
+
+primop  SizeofSmallMutableArrayOp "sizeofSmallMutableArray#" GenPrimOp
+   SmallMutableArray# s a -> Int#
+   {Return the number of elements in the array.}
+
+primop  IndexSmallArrayOp "indexSmallArray#" GenPrimOp
+   SmallArray# a -> Int# -> (# a #)
+   {Read from specified index of immutable array. Result is packaged into
+    an unboxed singleton; the result itself is not yet evaluated.}
+   with
+   can_fail         = True
+
+primop  UnsafeFreezeSmallArrayOp "unsafeFreezeSmallArray#" GenPrimOp
+   SmallMutableArray# s a -> State# s -> (# State# s, SmallArray# a #)
+   {Make a mutable array immutable, without copying.}
+   with
+   has_side_effects = True
+
+primop  UnsafeThawSmallArrayOp  "unsafeThawSmallArray#" GenPrimOp
+   SmallArray# a -> State# s -> (# State# s, SmallMutableArray# s a #)
+   {Make an immutable array mutable, without copying.}
+   with
+   out_of_line = True
+   has_side_effects = True
+
+-- The code_size is only correct for the case when the copy family of
+-- primops aren't inlined. It would be nice to keep track of both.
+
+primop  CopySmallArrayOp "copySmallArray#" GenPrimOp
+  SmallArray# a -> Int# -> SmallMutableArray# s a -> Int# -> Int# -> State# s -> State# s
+  {Given a source array, an offset into the source array, a
+   destination array, an offset into the destination array, and a
+   number of elements to copy, copy the elements from the source array
+   to the destination array. Both arrays must fully contain the
+   specified ranges, but this is not checked. The two arrays must not
+   be the same array in different states, but this is not checked
+   either.}
+  with
+  out_of_line      = True
+  has_side_effects = True
+  can_fail         = True
+
+primop  CopySmallMutableArrayOp "copySmallMutableArray#" GenPrimOp
+  SmallMutableArray# s a -> Int# -> SmallMutableArray# s a -> Int# -> Int# -> State# s -> State# s
+  {Given a source array, an offset into the source array, a
+   destination array, an offset into the destination array, and a
+   number of elements to copy, copy the elements from the source array
+   to the destination array. The source and destination arrays can
+   refer to the same array. Both arrays must fully contain the
+   specified ranges, but this is not checked.}
+  with
+  out_of_line      = True
+  has_side_effects = True
+  can_fail         = True
+
+primop  CloneSmallArrayOp "cloneSmallArray#" GenPrimOp
+  SmallArray# a -> Int# -> Int# -> SmallArray# a
+  {Given a source array, an offset into the source array, and a number
+   of elements to copy, create a new array with the elements from the
+   source array. The provided array must fully contain the specified
+   range, but this is not checked.}
+  with
+  out_of_line      = True
+  has_side_effects = True
+  can_fail         = True
+
+primop  CloneSmallMutableArrayOp "cloneSmallMutableArray#" GenPrimOp
+  SmallMutableArray# s a -> Int# -> Int# -> State# s -> (# State# s, SmallMutableArray# s a #)
+  {Given a source array, an offset into the source array, and a number
+   of elements to copy, create a new array with the elements from the
+   source array. The provided array must fully contain the specified
+   range, but this is not checked.}
+  with
+  out_of_line      = True
+  has_side_effects = True
+  can_fail         = True
+
+primop  FreezeSmallArrayOp "freezeSmallArray#" GenPrimOp
+  SmallMutableArray# s a -> Int# -> Int# -> State# s -> (# State# s, SmallArray# a #)
+  {Given a source array, an offset into the source array, and a number
+   of elements to copy, create a new array with the elements from the
+   source array. The provided array must fully contain the specified
+   range, but this is not checked.}
+  with
+  out_of_line      = True
+  has_side_effects = True
+  can_fail         = True
+
+primop  ThawSmallArrayOp "thawSmallArray#" GenPrimOp
+  SmallArray# a -> Int# -> Int# -> State# s -> (# State# s, SmallMutableArray# s a #)
+  {Given a source array, an offset into the source array, and a number
+   of elements to copy, create a new array with the elements from the
+   source array. The provided array must fully contain the specified
+   range, but this is not checked.}
+  with
+  out_of_line      = True
+  has_side_effects = True
+  can_fail         = True
+
+primop CasSmallArrayOp  "casSmallArray#" GenPrimOp
+   SmallMutableArray# s a -> Int# -> a -> a -> State# s -> (# State# s, Int#, a #)
+   {Unsafe, machine-level atomic compare and swap on an element within an array.}
+   with
+   out_of_line = True
+   has_side_effects = True
+
+------------------------------------------------------------------------
 section "Byte Arrays"
 	{Operations on {\tt ByteArray\#}. A {\tt ByteArray\#} is a just a region of
          raw memory in the garbage-collected heap, which is not