@@ -23,6 +23,7 @@ module Data.Text.Fusion
2323 -- * Creation and elimination
2424 , stream
2525 , unstream
26+ , reverseStream
2627 , empty
2728
2829 -- * Basic interface
@@ -63,6 +64,7 @@ module Data.Text.Fusion
6364 -- * Construction
6465 -- ** Scans
6566 , scanl
67+ , reverseScanr
6668
6769 -- ** Accumulating maps
6870 , mapAccumL
@@ -103,15 +105,14 @@ module Data.Text.Fusion
103105import Prelude (Bool(..), Char, Either(..), Eq(..), Maybe(..), Monad(..),
104106 Num(..), Ord(..), String, ($), (++), (.), (&&), error,
105107 fromIntegral, fst, otherwise, snd)
106−import Data.Char (ord)
107108import Control.Monad (liftM2)
108−import Control.Monad.ST (runST, ST)
109−import Data.Bits (shiftR, (.&.))
109+import Control.Monad.ST (runST)
110110import qualified Data.List as L
111−import Data.Word (Word16)
112111import GHC.Exts (Int(..), (+#))
112+import Data.Bits ((.&.), shiftR)
113+import Data.Char (ord)
113114import Data.Text.Internal (Text(..))
114−import Data.Text.UnsafeChar (unsafeChr, unsafeWrite)
115+import Data.Text.UnsafeChar (unsafeChr, unsafeWrite, unsafeWriteRev)
115116import qualified Data.Text.Array as A
116117import qualified Data.Text.Internal as I
117118import qualified Data.Text.Utf16 as U16
@@ -129,7 +130,7 @@ data Step s a = Done
129130 | Skip !s
130131 | Yield !a !s
131132
132−-- | /O(n)/ Convert a Text into a Stream Char.
133+-- | /O(n)/ Convert a 'Text' into a 'Stream Char'.
133134stream :: Text -> Stream Char
134135stream (Text arr off len) = Stream next off len
135136 where
@@ -144,10 +145,26 @@ stream (Text arr off len) = Stream next off len
144145 n2 = A.unsafeIndex arr (i + 1)
145146{-# INLINE [0] stream #-}
146147
148+-- | /O(n)/ Convert a 'Text' into a 'Stream Char', but iterate
149+-- backwards.
150+reverseStream :: Text -> Stream Char
151+reverseStream (Text arr off len) = Stream next (off+len-1) len
152+ where
153+ {-# INLINE next #-}
154+ next !i
155+ | i < off = Done
156+ | n >= 0xDC00 && n <= 0xDFFF = Yield (U16.chr2 n2 n) (i - 2)
157+ | otherwise = Yield (unsafeChr n) (i - 1)
158+ where
159+ n = A.unsafeIndex arr i
160+ n2 = A.unsafeIndex arr (i - 1)
161+{-# INLINE [0] reverseStream #-}
162+
147163-- | /O(n)/ Convert a Stream Char into a Text.
148164unstream :: Stream Char -> Text
149−unstream (Stream _next0 _s0 0) = I.empty
150−unstream (Stream next0 s0 len) = Text (fst a) 0 (snd a)
165+unstream (Stream next0 s0 len)
166+ | len == 0 = I.empty
167+ | otherwise = Text (fst a) 0 (snd a)
151168 where
152169 a = runST (A.unsafeNew len >>= (\arr -> loop arr len s0 0))
153170 loop arr !top !s !i
@@ -155,7 +172,7 @@ unstream (Stream next0 s0 len) = Text (fst a) 0 (snd a)
155172 Done -> liftM2 (,) (A.unsafeFreeze arr) (return i)
156173 _ -> do
157174 arr' <- A.unsafeNew (top*2)
158− copy arr arr' >> loop arr' (top*2) s i
175+ A.copy arr arr' >> loop arr' (top*2) s i
159176 | otherwise = case next0 s of
160177 Done -> liftM2 (,) (A.unsafeFreeze arr) (return i)
161178 Skip s' -> loop arr top s' i
@@ -169,15 +186,6 @@ empty = Stream next () 0
169186 where next _ = Done
170187{-# INLINE [0] empty #-}
171188
172−copy :: A.MArray s Word16 -> A.MArray s Word16 -> ST s ()
173−copy src dest = copy_loop 0
174− where
175− len = A.length src
176− copy_loop i
177− | i >= len = return ()
178− | otherwise = do A.unsafeRead src i >>= A.unsafeWrite dest i
179− copy_loop (i+1)
180−
181189-- | /O(n)/ Determines if two streams are equal.
182190eq :: Ord a => Stream a -> Stream a -> Bool
183191eq (Stream next1 s1 _) (Stream next2 s2 _) = cmp (next1 s1) (next2 s2)
@@ -369,27 +377,37 @@ intersperse c (Stream next0 s0 len) = Stream next (s0 :!: Nothing :!: S1) len
369377
370378-- | /O(n)/ Reverse the characters of a string.
371379reverse :: Stream Char -> Text
372−reverse (Stream next s len) = Text (A.run (A.unsafeNew len >>= fill)) 0 len
380+reverse (Stream next s len0)
381+ | len0 == 0 = I.empty
382+ | otherwise = Text arr off' len'
373383 where
374− fill marr = loop s len
375− where
376− loop !s0 !i = case next s0 of
377− Done -> return marr
378− Skip s1 -> loop s1 i
379− Yield x s1
380− | n < 0x10000 -> do
381− let i' = i - 1
382− A.unsafeWrite marr i' (fromIntegral n)
383− loop s1 i'
384− | otherwise -> do
385− let i' = i - 2
386− A.unsafeWrite marr i' l
387− A.unsafeWrite marr (i'+1) r
388− loop s1 i'
389− where n = ord x
390− m = n - 0x10000
391− l = fromIntegral $ (m `shiftR` 10) + 0xD800
392− r = fromIntegral $ (m .&. 0x3FF) + 0xDC00
384+ len0' = max len0 4
385+ (arr, (off', len')) = A.run2 (A.unsafeNew len0 >>= loop s (len0'-1) len0')
386+ loop !s0 !i !len marr =
387+ case next s0 of
388+ Done -> return (marr, (j, len-j))
389+ where j = i + 1
390+ Skip s1 -> loop s1 i len marr
391+ Yield x s1 | i < least -> do
392+ let newLen = len * 2
393+ marr' <- A.unsafeNew newLen
394+ A.unsafeCopy marr 0 marr' (newLen-len) len
395+ write s1 (len+i) newLen marr'
396+ | otherwise -> write s1 i len marr
397+ where n = ord x
398+ least | n < 0x10000 = 0
399+ | otherwise = 1
400+ m = n - 0x10000
401+ lo = fromIntegral $ (m `shiftR` 10) + 0xD800
402+ hi = fromIntegral $ (m .&. 0x3FF) + 0xDC00
403+ write s i len marr
404+ | n < 0x10000 = do
405+ A.unsafeWrite marr i (fromIntegral n)
406+ loop s (i-1) len marr
407+ | otherwise = do
408+ A.unsafeWrite marr (i-1) lo
409+ A.unsafeWrite marr i hi
410+ loop s (i-2) len marr
393411{-# INLINE [0] reverse #-}
394412
395413-- ----------------------------------------------------------------------------
@@ -567,6 +585,20 @@ scanl f z0 (Stream next0 s0 len) = Stream next (S1 :!: z0 :!: s0) (len+1)
567585 Done -> Done
568586{-# INLINE [0] scanl #-}
569587
588+-- | /O(n)/ Perform the equivalent of 'scanr' over a list, only with
589+-- the input and result reversed.
590+reverseScanr :: (Char -> Char -> Char) -> Char -> Stream Char -> Stream Char
591+reverseScanr f z0 (Stream next0 s0 len) = Stream next (S1 :!: z0 :!: s0) (len+1)
592+ where
593+ {-# INLINE next #-}
594+ next (S1 :!: z :!: s) = Yield z (S2 :!: z :!: s)
595+ next (S2 :!: z :!: s) = case next0 s of
596+ Yield x s' -> let !x' = f x z
597+ in Yield x' (S2 :!: x' :!: s')
598+ Skip s' -> Skip (S2 :!: z :!: s')
599+ Done -> Done
600+{-# INLINE reverseScanr #-}
601+
570602-- -----------------------------------------------------------------------------
571603-- ** Accumulating maps
572604