@@ -98,25 +98,35 @@ reverseStream (Text arr off len) = Stream next (off+len-1) (betweenSize (len `sh
98-- | /O(n)/ Convert a 'Stream Char' into a 'Text'.
98-- | /O(n)/ Convert a 'Stream Char' into a 'Text'.
99unstream :: Stream Char -> Text
99unstream :: Stream Char -> Text
100unstream (Stream next0 s0 len) = runText $ \done -> do
100unstream (Stream next0 s0 len) = runText $ \done -> do
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.
101− let mlen = upperBound 4 len
105+ let mlen = upperBound 4 len + 1
102 arr0 <- A.new mlen
106 arr0 <- A.new mlen
103− let outer arr top = loop
107+ let outer !arr !maxi = encode
105− loop !s !i =
109+ -- keep the common case loop as small as possible
106− case next0 s of
111+ case next0 si of
107− Done -> done arr i
112+ Done -> done arr di
108− Skip s' -> loop s' i
113+ Skip si' -> encode si' di
109− Yield x s'
114+ Yield c si'
110− | j >= top -> {-# SCC "unstream/resize" #-} do
115+ -- simply check for the worst case
111− let top' = (top + 1) `shiftL` 1
116+ | maxi < di + 1 -> realloc si di
118+ n <- unsafeWrite arr di c
121+ -- keep uncommon case separate from the common case code
122+ {-# NOINLINE realloc #-}
123+ realloc !si !di = do
124+ let newlen = (maxi + 1) * 2
112− arr' <- A.new top'
125+ arr' <- A.new newlen
113− A.copyM arr' 0 arr 0 top
126+ A.copyM arr' 0 arr 0 di
114− outer arr' top' s i
127+ outer arr' (newlen - 1) si di
115− | otherwise -> do d <- unsafeWrite arr i x
128+
117− where j | ord x < 0x10000 = i
119− outer arr0 mlen s0 0
129+ outer arr0 (mlen - 1) s0 0
120{-# INLINE [0] unstream #-}
130{-# INLINE [0] unstream #-}
121{-# RULES "STREAM stream/unstream fusion" forall s. stream (unstream s) = s #-}
131{-# RULES "STREAM stream/unstream fusion" forall s. stream (unstream s) = s #-}