Use a primitive to resize MutableByteArray

src/Data/Text/Array.hs

@@ -27,6 +27,7 @@ module Data.Text.Array
       Array(..)
     , MArray(..)
     -- * Functions
+    , resizeM
     , copyM
     , copyI
     , empty
@@ -41,6 +42,7 @@ module Data.Text.Array
     ) where
 
 #if defined(ASSERTS)
+-- TODO employ resizeMutableByteArray# instead of cropping Text
 import Control.Exception (assert)
 import GHC.Stack (HasCallStack)
 #endif
@@ -159,6 +161,12 @@ run2 k = runST (do
                  return (arr,b))
 {-# INLINE run2 #-}
 
+resizeM :: MArray s -> Int -> ST s (MArray s)
+resizeM (MutableByteArray ma) i@(I# i#) = ST $ \s1# ->
+  case resizeMutableByteArray# ma i# s1# of
+    (# s2#, newArr #) -> (# s2#, MutableByteArray newArr #)
+{-# INLINE resizeM #-}
+
 -- | Copy some elements of a mutable array.
 copyM :: MArray s               -- ^ Destination
       -> Int                    -- ^ Destination offset

src/Data/Text/Internal/Fusion.hs

@@ -157,8 +157,7 @@ unstream (Stream next0 s0 len) = runText $ \done -> do
         {-# NOINLINE realloc #-}
         realloc !si !di = do
             let newlen = (maxi + 1) * 2
-            arr' <- A.new newlen
-            A.copyM arr' 0 arr 0 di
+            arr' <- A.resizeM arr newlen
             outer arr' (newlen - 1) si di
 
   outer arr0 (mlen - 1) s0 0
@@ -299,8 +298,7 @@ mapAccumL f z0 (Stream next0 s0 len) = (nz, I.text na 0 nl)
               Yield x s'
                 | j >= top  -> {-# SCC "mapAccumL/resize" #-} do
                                let top' = (top + 1) `shiftL` 1
-                               arr' <- A.new top'
-                               A.copyM arr' 0 arr 0 top
+                               arr' <- A.resizeM arr top'
                                outer arr' top' z s i
                 | otherwise -> do d <- unsafeWrite arr i c
                                   loop z' s' (i+d)