@@ -98,25 +98,35 @@ reverseStream (Text arr off len) = Stream next (off+len-1) (betweenSize (len `sh
9898-- | /O(n)/ Convert a 'Stream Char' into a 'Text'.
9999unstream :: Stream Char -> Text
100100unstream (Stream next0 s0 len) = runText $ \done -> do
101− let mlen = upperBound 4 len
101+ -- Before encoding each char we perform a buffer realloc check assuming
102+ -- worst case encoding size of two 16-bit units for the char. Just add an
103+ -- extra space to the buffer so that we do not end up reallocating even when
104+ -- all the chars are encoded as single unit.
105+ let mlen = upperBound 4 len + 1
102106 arr0 <- A.new mlen
103− let outer arr top = loop
107+ let outer !arr !maxi = encode
104108 where
105− loop !s !i =
106− case next0 s of
107− Done -> done arr i
108− Skip s' -> loop s' i
109− Yield x s'
110− | j >= top -> {-# SCC "unstream/resize" #-} do
111− let top' = (top + 1) `shiftL` 1
112− arr' <- A.new top'
113− A.copyM arr' 0 arr 0 top
114− outer arr' top' s i
115− | otherwise -> do d <- unsafeWrite arr i x
116− loop s' (i+d)
117− where j | ord x < 0x10000 = i
118− | otherwise = i + 1
119− outer arr0 mlen s0 0
109+ -- keep the common case loop as small as possible
110+ encode !si !di =
111+ case next0 si of
112+ Done -> done arr di
113+ Skip si' -> encode si' di
114+ Yield c si'
115+ -- simply check for the worst case
116+ | maxi < di + 1 -> realloc si di
117+ | otherwise -> do
118+ n <- unsafeWrite arr di c
119+ encode si' (di + n)
120+
121+ -- keep uncommon case separate from the common case code
122+ {-# NOINLINE realloc #-}
123+ realloc !si !di = do
124+ let newlen = (maxi + 1) * 2
125+ arr' <- A.new newlen
126+ A.copyM arr' 0 arr 0 di
127+ outer arr' (newlen - 1) si di
128+
129+ outer arr0 (mlen - 1) s0 0
120130{-# INLINE [0] unstream #-}
121131{-# RULES "STREAM stream/unstream fusion" forall s. stream (unstream s) = s #-}
122132