Commit 8ca414b8 authored by Bodigrim's avatar Bodigrim
Browse files

Shrink mutable arrays whenever possible

parent 774ac17c
......@@ -28,6 +28,7 @@ module Data.Text.Array
, MArray(..)
-- * Functions
, resizeM
, shrinkM
, copyM
, copyI
, empty
......@@ -155,6 +156,23 @@ resizeM (MutableByteArray ma) i@(I# i#) = ST $ \s1# ->
(# s2#, newArr #) -> (# s2#, MutableByteArray newArr #)
{-# INLINE resizeM #-}
shrinkM ::
#if defined(ASSERTS)
HasCallStack =>
#endif
MArray s -> Int -> ST s ()
shrinkM (MutableByteArray marr) i@(I# newSize) = do
#if defined(ASSERTS)
oldSize <- getSizeofMArray (MutableByteArray marr)
if I# newSize > oldSize
then error $ "shrinkM: shrink cannot grow " ++ show oldSize ++ " to " ++ show (I# newSize)
else return ()
#endif
ST $ \s1# ->
case shrinkMutableByteArray# marr newSize s1# of
s2# -> (# s2#, () #)
{-# INLINE shrinkM #-}
-- | Copy some elements of a mutable array.
copyM :: MArray s -- ^ Destination
-> Int -- ^ Destination offset
......
......@@ -327,8 +327,10 @@ streamDecodeUtf8With onErr = decodeChunk B.empty 0 0
n <- peek destOffPtr
codepoint <- peek codepointPtr
chunkText <- unsafeSTToIO $ do
let l = cSizeToInt n
A.shrinkM (A.MutableByteArray dest) l
arr <- A.unsafeFreeze (A.MutableByteArray dest)
return $! text arr 0 (cSizeToInt n)
return $! text arr 0 l
let left = lastPtr `minusPtr` ptr
!undecoded = case state of
UTF8_ACCEPT -> B.empty
......
......@@ -186,6 +186,7 @@ fromString str = Builder $ \k (Buffer p0 o0 u0 l0) ->
let loop !marr !o !u !l [] = k (Buffer marr o u l)
loop marr o u l s@(c:cs)
| l <= 3 = do
A.shrinkM marr (o + u)
arr <- A.unsafeFreeze marr
let !t = Text arr o u
marr' <- A.new chunkSize
......
......@@ -93,6 +93,7 @@ unstreamChunks !chunkSize (Stream next s0 len0)
Yield x s' -> do d <- unsafeWrite marr i x
inner marr len s' (i+d)
finish marr len s' = do
A.shrinkM marr len
arr <- A.unsafeFreeze marr
return (I.Text arr 0 len `Chunk` outer s')
{-# INLINE [0] unstreamChunks #-}
......
......@@ -40,6 +40,7 @@ runText ::
#endif
(forall s. (A.MArray s -> Int -> ST s Text) -> ST s Text) -> Text
runText act = runST (act $ \ !marr !len -> do
A.shrinkM marr len
arr <- A.unsafeFreeze marr
return $! text arr 0 len)
{-# INLINE runText #-}
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment