Add new primtypes 'ArrayArray#' and 'MutableArrayArray#'

The primitive array types, such as 'ByteArray#', have kind #, but are represented by pointers. They are boxed, but unpointed types (i.e., they cannot be 'undefined').

The two categories of array types —[Mutable]Array# and [Mutable]ByteArray#— are containers for unboxed (and unpointed) as well as for boxed and pointed types.  So far, we lacked support for containers for boxed, unpointed types (i.e., containers for the primitive arrays themselves).  This is what the new primtypes provide.

Containers for boxed, unpointed types are crucial for the efficient implementation of scattered nested arrays, which are central to the new DPH backend library dph-lifted-vseg.  Without such containers, we cannot eliminate all unboxing from the inner loops of traversals processing scattered nested arrays.

9 files changed, 227 insertions, 34 deletions

diff --git a/compiler/codeGen/CgPrimOp.hs b/compiler/codeGen/CgPrimOp.hs
index e912a08b6e..3b11054efe 100644
--- a/compiler/codeGen/CgPrimOp.hs
+++ b/compiler/codeGen/CgPrimOp.hs
@@ -241,7 +241,10 @@ emitPrimOp [res] DataToTagOp [arg] _
 --	}
 emitPrimOp [res] UnsafeFreezeArrayOp [arg] _
    = stmtsC [ setInfo arg (CmmLit (CmmLabel mkMAP_FROZEN_infoLabel)),
-	     CmmAssign (CmmLocal res) arg ]
+       CmmAssign (CmmLocal res) arg ]
+emitPrimOp [res] UnsafeFreezeArrayArrayOp [arg] _
+   = stmtsC [ setInfo arg (CmmLit (CmmLabel mkMAP_FROZEN_infoLabel)),
+       CmmAssign (CmmLocal res) arg ]
 
 --  #define unsafeFreezzeByteArrayzh(r,a)	r=(a)
 emitPrimOp [res] UnsafeFreezeByteArrayOp [arg] _
@@ -260,16 +263,37 @@ emitPrimOp [res] FreezeArrayOp [src,src_off,n] live =
 emitPrimOp [res] ThawArrayOp [src,src_off,n] live =
     emitCloneArray mkMAP_DIRTY_infoLabel res src src_off n live
 
+emitPrimOp [] CopyArrayArrayOp [src,src_off,dst,dst_off,n] live =
+    doCopyArrayOp src src_off dst dst_off n live
+emitPrimOp [] CopyMutableArrayArrayOp [src,src_off,dst,dst_off,n] live =
+    doCopyMutableArrayOp src src_off dst dst_off n live
+
 -- Reading/writing pointer arrays
 
 emitPrimOp [r] ReadArrayOp  [obj,ix]   _  = doReadPtrArrayOp r obj ix
 emitPrimOp [r] IndexArrayOp [obj,ix]   _  = doReadPtrArrayOp r obj ix
 emitPrimOp []  WriteArrayOp [obj,ix,v] _  = doWritePtrArrayOp obj ix v
 
+emitPrimOp [r] IndexArrayArrayOp_ByteArray         [obj,ix]   _  = doReadPtrArrayOp r obj ix
+emitPrimOp [r] IndexArrayArrayOp_ArrayArray        [obj,ix]   _  = doReadPtrArrayOp r obj ix
+emitPrimOp [r] ReadArrayArrayOp_ByteArray          [obj,ix]   _  = doReadPtrArrayOp r obj ix
+emitPrimOp [r] ReadArrayArrayOp_MutableByteArray   [obj,ix]   _  = doReadPtrArrayOp r obj ix
+emitPrimOp [r] ReadArrayArrayOp_ArrayArray         [obj,ix]   _  = doReadPtrArrayOp r obj ix
+emitPrimOp [r] ReadArrayArrayOp_MutableArrayArray  [obj,ix]   _  = doReadPtrArrayOp r obj ix
+emitPrimOp []  WriteArrayArrayOp_ByteArray         [obj,ix,v] _  = doWritePtrArrayOp obj ix v
+emitPrimOp []  WriteArrayArrayOp_MutableByteArray  [obj,ix,v] _  = doWritePtrArrayOp obj ix v
+emitPrimOp []  WriteArrayArrayOp_ArrayArray        [obj,ix,v] _  = doWritePtrArrayOp obj ix v
+emitPrimOp []  WriteArrayArrayOp_MutableArrayArray [obj,ix,v] _  = doWritePtrArrayOp obj ix v
+
 emitPrimOp [res] SizeofArrayOp [arg] _
-   = stmtC $ CmmAssign (CmmLocal res) (cmmLoadIndexW arg (fixedHdrSize + oFFSET_StgMutArrPtrs_ptrs) bWord)
+   = stmtC $ 
+       CmmAssign (CmmLocal res) (cmmLoadIndexW arg (fixedHdrSize + oFFSET_StgMutArrPtrs_ptrs) bWord)
 emitPrimOp [res] SizeofMutableArrayOp [arg] live
    = emitPrimOp [res] SizeofArrayOp [arg] live
+emitPrimOp [res] SizeofArrayArrayOp [arg] live
+   = emitPrimOp [res] SizeofArrayOp [arg] live
+emitPrimOp [res] SizeofMutableArrayArrayOp [arg] live
+   = emitPrimOp [res] SizeofArrayOp [arg] live
 
 -- IndexXXXoffAddr
 
@@ -565,6 +589,7 @@ translateOp SameMutVarOp           = Just mo_wordEq
 translateOp SameMVarOp             = Just mo_wordEq
 translateOp SameMutableArrayOp     = Just mo_wordEq
 translateOp SameMutableByteArrayOp = Just mo_wordEq
+translateOp SameMutableArrayArrayOp= Just mo_wordEq
 translateOp SameTVarOp             = Just mo_wordEq
 translateOp EqStablePtrOp          = Just mo_wordEq
 
diff --git a/compiler/codeGen/StgCmmPrim.hs b/compiler/codeGen/StgCmmPrim.hs
index 1795b55165..1d5a5b3cda 100644
--- a/compiler/codeGen/StgCmmPrim.hs
+++ b/compiler/codeGen/StgCmmPrim.hs
@@ -307,8 +307,12 @@ emitPrimOp [res] DataToTagOp [arg]
 --	}
 emitPrimOp [res] UnsafeFreezeArrayOp [arg]
    = emit $ catAGraphs
-	 [ setInfo arg (CmmLit (CmmLabel mkMAP_FROZEN_infoLabel)),
-	   mkAssign (CmmLocal res) arg ]
+   [ setInfo arg (CmmLit (CmmLabel mkMAP_FROZEN_infoLabel)),
+     mkAssign (CmmLocal res) arg ]
+emitPrimOp [res] UnsafeFreezeArrayArrayOp [arg]
+   = emit $ catAGraphs
+   [ setInfo arg (CmmLit (CmmLabel mkMAP_FROZEN_infoLabel)),
+     mkAssign (CmmLocal res) arg ]
 
 --  #define unsafeFreezzeByteArrayzh(r,a)	r=(a)
 emitPrimOp [res] UnsafeFreezeByteArrayOp [arg]
@@ -626,6 +630,7 @@ translateOp SameMutVarOp           = Just mo_wordEq
 translateOp SameMVarOp             = Just mo_wordEq
 translateOp SameMutableArrayOp     = Just mo_wordEq
 translateOp SameMutableByteArrayOp = Just mo_wordEq
+translateOp SameMutableArrayArrayOp= Just mo_wordEq
 translateOp SameTVarOp             = Just mo_wordEq
 translateOp EqStablePtrOp          = Just mo_wordEq
 
diff --git a/compiler/prelude/PrelNames.lhs b/compiler/prelude/PrelNames.lhs
index 319227ba37..f95b21dae2 100644
--- a/compiler/prelude/PrelNames.lhs
+++ b/compiler/prelude/PrelNames.lhs
@@ -1145,14 +1145,14 @@ selectorClassKey    = mkPreludeClassUnique 41
 %************************************************************************
 
 \begin{code}
-addrPrimTyConKey, arrayPrimTyConKey, boolTyConKey, byteArrayPrimTyConKey,
+addrPrimTyConKey, arrayPrimTyConKey, arrayArrayPrimTyConKey, boolTyConKey, byteArrayPrimTyConKey,
     charPrimTyConKey, charTyConKey, doublePrimTyConKey, doubleTyConKey,
     floatPrimTyConKey, floatTyConKey, funTyConKey, intPrimTyConKey,
     intTyConKey, int8TyConKey, int16TyConKey, int32PrimTyConKey,
     int32TyConKey, int64PrimTyConKey, int64TyConKey,
     integerTyConKey, digitsTyConKey,
     listTyConKey, foreignObjPrimTyConKey, weakPrimTyConKey,
-    mutableArrayPrimTyConKey, mutableByteArrayPrimTyConKey,
+    mutableArrayPrimTyConKey, mutableArrayArrayPrimTyConKey, mutableByteArrayPrimTyConKey,
     orderingTyConKey, mVarPrimTyConKey, ratioTyConKey, rationalTyConKey,
     realWorldTyConKey, stablePtrPrimTyConKey, stablePtrTyConKey,
     anyTyConKey, eqTyConKey :: Unique
@@ -1191,6 +1191,8 @@ stablePtrPrimTyConKey                   = mkPreludeTyConUnique 35
 stablePtrTyConKey                       = mkPreludeTyConUnique 36
 anyTyConKey                             = mkPreludeTyConUnique 37
 eqTyConKey                              = mkPreludeTyConUnique 38
+arrayArrayPrimTyConKey                  = mkPreludeTyConUnique 39
+mutableArrayArrayPrimTyConKey           = mkPreludeTyConUnique 40
 
 statePrimTyConKey, stableNamePrimTyConKey, stableNameTyConKey,
     mutVarPrimTyConKey, ioTyConKey,
diff --git a/compiler/prelude/TysPrim.lhs b/compiler/prelude/TysPrim.lhs
index 98ee6c426d..a3c2c6bb83 100644
--- a/compiler/prelude/TysPrim.lhs
+++ b/compiler/prelude/TysPrim.lhs
@@ -52,11 +52,13 @@ module TysPrim(
 	statePrimTyCon,		mkStatePrimTy,
 	realWorldTyCon,		realWorldTy, realWorldStatePrimTy,
 
-	arrayPrimTyCon,			mkArrayPrimTy, 
-	byteArrayPrimTyCon,		byteArrayPrimTy,
-	mutableArrayPrimTyCon,		mkMutableArrayPrimTy,
-	mutableByteArrayPrimTyCon,	mkMutableByteArrayPrimTy,
-	mutVarPrimTyCon,		mkMutVarPrimTy,
+	arrayPrimTyCon,	mkArrayPrimTy, 
+	byteArrayPrimTyCon,	byteArrayPrimTy,
+	arrayArrayPrimTyCon, mkArrayArrayPrimTy, 
+	mutableArrayPrimTyCon, mkMutableArrayPrimTy,
+	mutableByteArrayPrimTyCon, mkMutableByteArrayPrimTy,
+	mutableArrayArrayPrimTyCon, mkMutableArrayArrayPrimTy,
+	mutVarPrimTyCon, mkMutVarPrimTy,
 
 	mVarPrimTyCon,			mkMVarPrimTy,	
         tVarPrimTyCon,                  mkTVarPrimTy,
@@ -105,6 +107,7 @@ primTyCons
   = [ addrPrimTyCon
     , arrayPrimTyCon
     , byteArrayPrimTyCon
+    , arrayArrayPrimTyCon
     , charPrimTyCon
     , doublePrimTyCon
     , floatPrimTyCon
@@ -115,6 +118,7 @@ primTyCons
     , weakPrimTyCon
     , mutableArrayPrimTyCon
     , mutableByteArrayPrimTyCon
+    , mutableArrayArrayPrimTyCon
     , mVarPrimTyCon
     , tVarPrimTyCon
     , mutVarPrimTyCon
@@ -145,7 +149,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, realWorldTyConName, arrayPrimTyConName, byteArrayPrimTyConName, mutableArrayPrimTyConName, mutableByteArrayPrimTyConName, mutVarPrimTyConName, mVarPrimTyConName, tVarPrimTyConName, stablePtrPrimTyConName, stableNamePrimTyConName, bcoPrimTyConName, weakPrimTyConName, threadIdPrimTyConName, eqPrimTyConName :: Name
+charPrimTyConName, intPrimTyConName, int32PrimTyConName, int64PrimTyConName, wordPrimTyConName, word32PrimTyConName, word64PrimTyConName, addrPrimTyConName, floatPrimTyConName, doublePrimTyConName, statePrimTyConName, realWorldTyConName, arrayPrimTyConName, arrayArrayPrimTyConName, byteArrayPrimTyConName, mutableArrayPrimTyConName, mutableByteArrayPrimTyConName, mutableArrayArrayPrimTyConName, mutVarPrimTyConName, mVarPrimTyConName, tVarPrimTyConName, stablePtrPrimTyConName, stableNamePrimTyConName, bcoPrimTyConName, weakPrimTyConName, threadIdPrimTyConName, eqPrimTyConName :: Name
 charPrimTyConName    	      = mkPrimTc (fsLit "Char#") charPrimTyConKey charPrimTyCon
 intPrimTyConName     	      = mkPrimTc (fsLit "Int#") intPrimTyConKey  intPrimTyCon
 int32PrimTyConName	      = mkPrimTc (fsLit "Int32#") int32PrimTyConKey int32PrimTyCon
@@ -161,8 +165,10 @@ eqPrimTyConName               = mkPrimTc (fsLit "~#") eqPrimTyConKey eqPrimTyCon
 realWorldTyConName            = mkPrimTc (fsLit "RealWorld") realWorldTyConKey realWorldTyCon
 arrayPrimTyConName   	      = mkPrimTc (fsLit "Array#") arrayPrimTyConKey arrayPrimTyCon
 byteArrayPrimTyConName	      = mkPrimTc (fsLit "ByteArray#") byteArrayPrimTyConKey byteArrayPrimTyCon
+arrayArrayPrimTyConName   	  = mkPrimTc (fsLit "ArrayArray#") arrayArrayPrimTyConKey arrayArrayPrimTyCon
 mutableArrayPrimTyConName     = mkPrimTc (fsLit "MutableArray#") mutableArrayPrimTyConKey mutableArrayPrimTyCon
 mutableByteArrayPrimTyConName = mkPrimTc (fsLit "MutableByteArray#") mutableByteArrayPrimTyConKey mutableByteArrayPrimTyCon
+mutableArrayArrayPrimTyConName= mkPrimTc (fsLit "MutableArrayArray#") mutableArrayArrayPrimTyConKey mutableArrayArrayPrimTyCon
 mutVarPrimTyConName	      = mkPrimTc (fsLit "MutVar#") mutVarPrimTyConKey mutVarPrimTyCon
 mVarPrimTyConName	      = mkPrimTc (fsLit "MVar#") mVarPrimTyConKey mVarPrimTyCon
 tVarPrimTyConName	      = mkPrimTc (fsLit "TVar#") tVarPrimTyConKey tVarPrimTyCon
@@ -488,20 +494,26 @@ defined in \tr{TysWiredIn.lhs}, not here.
 
 \begin{code}
 arrayPrimTyCon, mutableArrayPrimTyCon, mutableByteArrayPrimTyCon,
-    byteArrayPrimTyCon :: TyCon
-arrayPrimTyCon		  = pcPrimTyCon  arrayPrimTyConName	       1 PtrRep
-mutableArrayPrimTyCon	  = pcPrimTyCon  mutableArrayPrimTyConName     2 PtrRep
-mutableByteArrayPrimTyCon = pcPrimTyCon  mutableByteArrayPrimTyConName 1 PtrRep
-byteArrayPrimTyCon	  = pcPrimTyCon0 byteArrayPrimTyConName	         PtrRep
+    byteArrayPrimTyCon, arrayArrayPrimTyCon, mutableArrayArrayPrimTyCon :: TyCon
+arrayPrimTyCon             = pcPrimTyCon  arrayPrimTyConName             1 PtrRep
+mutableArrayPrimTyCon      = pcPrimTyCon  mutableArrayPrimTyConName      2 PtrRep
+mutableByteArrayPrimTyCon  = pcPrimTyCon  mutableByteArrayPrimTyConName  1 PtrRep
+byteArrayPrimTyCon         = pcPrimTyCon0 byteArrayPrimTyConName           PtrRep
+arrayArrayPrimTyCon        = pcPrimTyCon0 arrayArrayPrimTyConName          PtrRep
+mutableArrayArrayPrimTyCon = pcPrimTyCon  mutableArrayArrayPrimTyConName 1 PtrRep
 
 mkArrayPrimTy :: Type -> Type
 mkArrayPrimTy elt    	    = mkTyConApp arrayPrimTyCon [elt]
 byteArrayPrimTy :: Type
 byteArrayPrimTy	    	    = mkTyConTy byteArrayPrimTyCon
+mkArrayArrayPrimTy :: Type
+mkArrayArrayPrimTy = mkTyConTy arrayArrayPrimTyCon
 mkMutableArrayPrimTy :: Type -> Type -> Type
 mkMutableArrayPrimTy s elt  = mkTyConApp mutableArrayPrimTyCon [s, elt]
 mkMutableByteArrayPrimTy :: Type -> Type
 mkMutableByteArrayPrimTy s  = mkTyConApp mutableByteArrayPrimTyCon [s]
+mkMutableArrayArrayPrimTy :: Type -> Type
+mkMutableArrayArrayPrimTy s = mkTyConApp mutableArrayArrayPrimTyCon [s]
 \end{code}
 
 %************************************************************************
diff --git a/compiler/prelude/primops.txt.pp b/compiler/prelude/primops.txt.pp
index 1d67b584c6..a695344225 100644
--- a/compiler/prelude/primops.txt.pp
+++ b/compiler/prelude/primops.txt.pp
@@ -733,7 +733,7 @@ section "Byte Arrays"
          index for reading from immutable byte arrays, and read/write
          for mutable byte arrays.  Each set contains operations for a
          range of useful primitive data types.  Each operation takes
-         an offset measured in terms of the size fo the primitive type
+         an offset measured in terms of the size of the primitive type
          being read or written.}
 
 ------------------------------------------------------------------------
@@ -1019,7 +1019,7 @@ primop  CopyByteArrayOp "copyByteArray#" GenPrimOp
    The two arrays must not be the same array in different states, but this is not checked either.}
   with
   has_side_effects = True
-  code_size = { primOpCodeSizeForeignCall }
+  code_size = { primOpCodeSizeForeignCall + 4}
   can_fail = True
 
 primop  CopyMutableByteArrayOp "copyMutableByteArray#" GenPrimOp
@@ -1028,6 +1028,113 @@ primop  CopyMutableByteArrayOp "copyMutableByteArray#" GenPrimOp
    Both arrays must fully contain the specified ranges, but this is not checked.}
   with
   has_side_effects = True
+  code_size = { primOpCodeSizeForeignCall + 4 }
+  can_fail = True
+
+------------------------------------------------------------------------
+section "Arrays of arrays"
+	{Operations on {\tt ArrayArray\#}. An {\tt ArrayArray\#} contains references to {\em unpointed}
+	 arrays, such as {\tt ByteArray\#s}. Hence, it is not parameterised by the element types,
+	 just like a {\tt ByteArray\#}, but it needs to be scanned during GC, just like an {\tt Array#}.
+	 We represent an {\tt ArrayArray\#} exactly as a {\tt Array\#}, but provide element-type-specific
+	 indexing, reading, and writing.}
+------------------------------------------------------------------------
+
+primtype ArrayArray#
+
+primtype MutableArrayArray# s
+
+primop  NewArrayArrayOp "newArrayArray#" GenPrimOp
+   Int# -> State# s -> (# State# s, MutableArrayArray# s #)
+   {Create a new mutable array of arrays with the specified number of elements,
+    in the specified state thread, with each element recursively referring to the
+    newly created array.}
+   with
+   out_of_line = True
+   has_side_effects = True
+
+primop  SameMutableArrayArrayOp "sameMutableArrayArray#" GenPrimOp
+   MutableArrayArray# s -> MutableArrayArray# s -> Bool
+
+primop  UnsafeFreezeArrayArrayOp "unsafeFreezeArrayArray#" GenPrimOp
+   MutableArrayArray# s -> State# s -> (# State# s, ArrayArray# #)
+   {Make a mutable array of arrays immutable, without copying.}
+   with
+   has_side_effects = True
+
+primop  SizeofArrayArrayOp "sizeofArrayArray#" GenPrimOp
+   ArrayArray# -> Int#
+   {Return the number of elements in the array.}
+
+primop  SizeofMutableArrayArrayOp "sizeofMutableArrayArray#" GenPrimOp
+   MutableArrayArray# s -> Int#
+   {Return the number of elements in the array.}
+
+primop IndexArrayArrayOp_ByteArray "indexByteArrayArray#" GenPrimOp
+   ArrayArray# -> Int# -> ByteArray#
+   with can_fail = True
+
+primop IndexArrayArrayOp_ArrayArray "indexArrayArrayArray#" GenPrimOp
+   ArrayArray# -> Int# -> ArrayArray#
+   with can_fail = True
+
+primop  ReadArrayArrayOp_ByteArray "readByteArrayArray#" GenPrimOp
+   MutableArrayArray# s -> Int# -> State# s -> (# State# s, ByteArray# #)
+   with has_side_effects = True
+        can_fail = True
+
+primop  ReadArrayArrayOp_MutableByteArray "readMutableByteArrayArray#" GenPrimOp
+   MutableArrayArray# s -> Int# -> State# s -> (# State# s, MutableByteArray# s #)
+   with has_side_effects = True
+        can_fail = True
+
+primop  ReadArrayArrayOp_ArrayArray "readArrayArrayArray#" GenPrimOp
+   MutableArrayArray# s -> Int# -> State# s -> (# State# s, ArrayArray# #)
+   with has_side_effects = True
+        can_fail = True
+
+primop  ReadArrayArrayOp_MutableArrayArray "readMutableArrayArrayArray#" GenPrimOp
+   MutableArrayArray# s -> Int# -> State# s -> (# State# s, MutableArrayArray# s #)
+   with has_side_effects = True
+        can_fail = True
+
+primop  WriteArrayArrayOp_ByteArray "writeByteArrayArray#" GenPrimOp
+   MutableArrayArray# s -> Int# -> ByteArray# -> State# s -> State# s
+   with has_side_effects = True
+        can_fail = True
+
+primop  WriteArrayArrayOp_MutableByteArray "writeMutableByteArrayArray#" GenPrimOp
+   MutableArrayArray# s -> Int# -> MutableByteArray# s -> State# s -> State# s
+   with has_side_effects = True
+        can_fail = True
+
+primop  WriteArrayArrayOp_ArrayArray "writeArrayArrayArray#" GenPrimOp
+   MutableArrayArray# s -> Int# -> ArrayArray# -> State# s -> State# s
+   with has_side_effects = True
+        can_fail = True
+
+primop  WriteArrayArrayOp_MutableArrayArray "writeMutableArrayArrayArray#" GenPrimOp
+   MutableArrayArray# s -> Int# -> MutableArrayArray# s -> State# s -> State# s
+   with has_side_effects = True
+        can_fail = True
+
+primop  CopyArrayArrayOp "copyArrayArray#" GenPrimOp
+  ArrayArray# -> Int# -> MutableArrayArray# s -> Int# -> Int# -> State# s -> State# s
+  {Copy a range of the ArrayArray# to the specified region in the MutableArrayArray#.
+   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
+  has_side_effects = True
+  can_fail = True
+  code_size = { primOpCodeSizeForeignCall }
+
+primop  CopyMutableArrayArrayOp "copyMutableArrayArray#" GenPrimOp
+  MutableArrayArray# s -> Int# -> MutableArrayArray# s -> Int# -> Int# -> State# s -> State# s
+  {Copy a range of the first MutableArrayArray# to the specified region in the second
+   MutableArrayArray#.
+   Both arrays must fully contain the specified ranges, but this is not checked.}
+  with
+  has_side_effects = True
   code_size = { primOpCodeSizeForeignCall }
   can_fail = True
 
diff --git a/includes/stg/MiscClosures.h b/includes/stg/MiscClosures.h
index fcfdede2ff..da3b07b978 100644
--- a/includes/stg/MiscClosures.h
+++ b/includes/stg/MiscClosures.h
@@ -381,6 +381,7 @@ RTS_FUN_DECL(stg_newByteArrayzh);
 RTS_FUN_DECL(stg_newPinnedByteArrayzh);
 RTS_FUN_DECL(stg_newAlignedPinnedByteArrayzh);
 RTS_FUN_DECL(stg_newArrayzh);
+RTS_FUN_DECL(stg_newArrayArrayzh);
 
 RTS_FUN_DECL(stg_newMutVarzh);
 RTS_FUN_DECL(stg_atomicModifyMutVarzh);
diff --git a/rts/Linker.c b/rts/Linker.c
index c1ea0dd206..f45c105bdc 100644
--- a/rts/Linker.c
+++ b/rts/Linker.c
@@ -826,6 +826,7 @@ typedef struct _RtsSymbolVal {
       SymI_HasProto(stg_myThreadIdzh)                   \
       SymI_HasProto(stg_labelThreadzh)                  \
       SymI_HasProto(stg_newArrayzh)                     \
+      SymI_HasProto(stg_newArrayArrayzh)                     \
       SymI_HasProto(stg_newBCOzh)                       \
       SymI_HasProto(stg_newByteArrayzh)                 \
       SymI_HasProto_redirect(newCAF, newDynCAF)         \
diff --git a/rts/PrimOps.cmm b/rts/PrimOps.cmm
index 2ca347e803..21ac05f3c3 100644
--- a/rts/PrimOps.cmm
+++ b/rts/PrimOps.cmm
@@ -212,6 +212,45 @@ stg_unsafeThawArrayzh
   }
 }
 
+stg_newArrayArrayzh
+{
+    W_ words, n, arr, p, size;
+    /* Args: R1 = words */
+
+    n = R1;
+    MAYBE_GC(NO_PTRS,stg_newArrayArrayzh);
+
+    // the mark area contains one byte for each 2^MUT_ARR_PTRS_CARD_BITS words
+    // in the array, making sure we round up, and then rounding up to a whole
+    // number of words.
+    size = n + mutArrPtrsCardWords(n);
+    words = BYTES_TO_WDS(SIZEOF_StgMutArrPtrs) + size;
+    ("ptr" arr) = foreign "C" allocate(MyCapability() "ptr",words) [];
+    TICK_ALLOC_PRIM(SIZEOF_StgMutArrPtrs, WDS(n), 0);
+
+    SET_HDR(arr, stg_MUT_ARR_PTRS_DIRTY_info, W_[CCCS]);
+    StgMutArrPtrs_ptrs(arr) = n;
+    StgMutArrPtrs_size(arr) = size;
+
+    // Initialise all elements of the array with a pointer to the new array
+    p = arr + SIZEOF_StgMutArrPtrs;
+  for:
+    if (p < arr + WDS(words)) {
+	W_[p] = arr;
+	p = p + WDS(1);
+	goto for;
+    }
+    // Initialise the mark bits with 0
+  for2:
+    if (p < arr + WDS(size)) {
+	W_[p] = 0;
+	p = p + WDS(1);
+	goto for2;
+    }
+
+    RET_P(arr);
+}
+
 
 /* -----------------------------------------------------------------------------
    MutVar primitives
diff --git a/utils/genprimopcode/Main.hs b/utils/genprimopcode/Main.hs
index da15c2532c..7ac32f6124 100644
--- a/utils/genprimopcode/Main.hs
+++ b/utils/genprimopcode/Main.hs
@@ -648,21 +648,22 @@ ppType (TyApp "ForeignObj#" []) = "foreignObjPrimTy"
 ppType (TyApp "BCO#"        []) = "bcoPrimTy"
 ppType (TyApp "()"          []) = "unitTy" 	-- unitTy is TysWiredIn's name for ()
 
-ppType (TyVar "a")               = "alphaTy"
-ppType (TyVar "b")               = "betaTy"
-ppType (TyVar "c")               = "gammaTy"
-ppType (TyVar "s")               = "deltaTy"
-ppType (TyVar "o")               = "openAlphaTy"
-ppType (TyApp "State#" [x])      = "mkStatePrimTy " ++ ppType x
-ppType (TyApp "MutVar#" [x,y])   = "mkMutVarPrimTy " ++ ppType x 
-                                   ++ " " ++ ppType y
-ppType (TyApp "MutableArray#" [x,y]) = "mkMutableArrayPrimTy " ++ ppType x
-                                    ++ " " ++ ppType y
-
-ppType (TyApp "MutableByteArray#" [x]) = "mkMutableByteArrayPrimTy " 
-                                   ++ ppType x
-
-ppType (TyApp "Array#" [x])      = "mkArrayPrimTy " ++ ppType x
+ppType (TyVar "a")                      = "alphaTy"
+ppType (TyVar "b")                      = "betaTy"
+ppType (TyVar "c")                      = "gammaTy"
+ppType (TyVar "s")                      = "deltaTy"
+ppType (TyVar "o")                      = "openAlphaTy"
+
+ppType (TyApp "State#" [x])             = "mkStatePrimTy " ++ ppType x
+ppType (TyApp "MutVar#" [x,y])          = "mkMutVarPrimTy " ++ ppType x 
+                                          ++ " " ++ ppType y
+ppType (TyApp "MutableArray#" [x,y])    = "mkMutableArrayPrimTy " ++ ppType x
+                                           ++ " " ++ ppType y
+ppType (TyApp "MutableArrayArray#" [x]) = "mkMutableArrayArrayPrimTy " ++ ppType x
+ppType (TyApp "MutableByteArray#" [x])  = "mkMutableByteArrayPrimTy " 
+                                          ++ ppType x
+ppType (TyApp "Array#" [x])             = "mkArrayPrimTy " ++ ppType x
+ppType (TyApp "ArrayArray#" [])         = "mkArrayArrayPrimTy"
 
 
 ppType (TyApp "Weak#"  [x])      = "mkWeakPrimTy " ++ ppType x