git.iko.soy/text
on master help sign in
Add reverseStream and reverseScanr
086f118Bryan O'Sullivan
Data/Text/Fusion.hs+70−38
compare with master
unifiedsplit
@@ -23,6 +23,7 @@ module Data.Text.Fusion
23 -- * Creation and elimination
23 -- * Creation and elimination
24 , stream
24 , stream
25 , unstream
25 , unstream
26+ , reverseStream
26 , empty
27 , empty
27
28
28 -- * Basic interface
29 -- * Basic interface
@@ -63,6 +64,7 @@ module Data.Text.Fusion
63 -- * Construction
64 -- * Construction
64 -- ** Scans
65 -- ** Scans
65 , scanl
66 , scanl
67+ , reverseScanr
66
68
67 -- ** Accumulating maps
69 -- ** Accumulating maps
68 , mapAccumL
70 , mapAccumL
@@ -103,15 +105,14 @@ module Data.Text.Fusion
103import Prelude (Bool(..), Char, Either(..), Eq(..), Maybe(..), Monad(..),
105import Prelude (Bool(..), Char, Either(..), Eq(..), Maybe(..), Monad(..),
104 Num(..), Ord(..), String, ($), (++), (.), (&&), error,
106 Num(..), Ord(..), String, ($), (++), (.), (&&), error,
105 fromIntegral, fst, otherwise, snd)
107 fromIntegral, fst, otherwise, snd)
106−import Data.Char (ord)
107import Control.Monad (liftM2)
108import Control.Monad (liftM2)
108−import Control.Monad.ST (runST, ST)
109+import Control.Monad.ST (runST)
109−import Data.Bits (shiftR, (.&.))
110import qualified Data.List as L
110import qualified Data.List as L
111−import Data.Word (Word16)
112import GHC.Exts (Int(..), (+#))
111import GHC.Exts (Int(..), (+#))
112+import Data.Bits ((.&.), shiftR)
113+import Data.Char (ord)
113import Data.Text.Internal (Text(..))
114import Data.Text.Internal (Text(..))
114−import Data.Text.UnsafeChar (unsafeChr, unsafeWrite)
115+import Data.Text.UnsafeChar (unsafeChr, unsafeWrite, unsafeWriteRev)
115import qualified Data.Text.Array as A
116import qualified Data.Text.Array as A
116import qualified Data.Text.Internal as I
117import qualified Data.Text.Internal as I
117import qualified Data.Text.Utf16 as U16
118import qualified Data.Text.Utf16 as U16
@@ -129,7 +130,7 @@ data Step s a = Done
129 | Skip !s
130 | Skip !s
130 | Yield !a !s
131 | Yield !a !s
131
132
132−-- | /O(n)/ Convert a Text into a Stream Char.
133+-- | /O(n)/ Convert a 'Text' into a 'Stream Char'.
133stream :: Text -> Stream Char
134stream :: Text -> Stream Char
134stream (Text arr off len) = Stream next off len
135stream (Text arr off len) = Stream next off len
135 where
136 where
@@ -144,10 +145,26 @@ stream (Text arr off len) = Stream next off len
144 n2 = A.unsafeIndex arr (i + 1)
145 n2 = A.unsafeIndex arr (i + 1)
145{-# INLINE [0] stream #-}
146{-# INLINE [0] stream #-}
146
147
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+
147-- | /O(n)/ Convert a Stream Char into a Text.
163-- | /O(n)/ Convert a Stream Char into a Text.
148unstream :: Stream Char -> Text
164unstream :: Stream Char -> Text
149−unstream (Stream _next0 _s0 0) = I.empty
165+unstream (Stream next0 s0 len)
166+ | len == 0 = I.empty
150−unstream (Stream next0 s0 len) = Text (fst a) 0 (snd a)
167+ | otherwise = Text (fst a) 0 (snd a)
151 where
168 where
152 a = runST (A.unsafeNew len >>= (\arr -> loop arr len s0 0))
169 a = runST (A.unsafeNew len >>= (\arr -> loop arr len s0 0))
153 loop arr !top !s !i
170 loop arr !top !s !i
@@ -155,7 +172,7 @@ unstream (Stream next0 s0 len) = Text (fst a) 0 (snd a)
155 Done -> liftM2 (,) (A.unsafeFreeze arr) (return i)
172 Done -> liftM2 (,) (A.unsafeFreeze arr) (return i)
156 _ -> do
173 _ -> do
157 arr' <- A.unsafeNew (top*2)
174 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
159 | otherwise = case next0 s of
176 | otherwise = case next0 s of
160 Done -> liftM2 (,) (A.unsafeFreeze arr) (return i)
177 Done -> liftM2 (,) (A.unsafeFreeze arr) (return i)
161 Skip s' -> loop arr top s' i
178 Skip s' -> loop arr top s' i
@@ -169,15 +186,6 @@ empty = Stream next () 0
169 where next _ = Done
186 where next _ = Done
170{-# INLINE [0] empty #-}
187{-# INLINE [0] empty #-}
171
188
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−
181-- | /O(n)/ Determines if two streams are equal.
189-- | /O(n)/ Determines if two streams are equal.
182eq :: Ord a => Stream a -> Stream a -> Bool
190eq :: Ord a => Stream a -> Stream a -> Bool
183eq (Stream next1 s1 _) (Stream next2 s2 _) = cmp (next1 s1) (next2 s2)
191eq (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
369
377
370-- | /O(n)/ Reverse the characters of a string.
378-- | /O(n)/ Reverse the characters of a string.
371reverse :: Stream Char -> Text
379reverse :: 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'
373 where
383 where
374− fill marr = loop s len
384+ len0' = max len0 4
375− where
385+ (arr, (off', len')) = A.run2 (A.unsafeNew len0 >>= loop s (len0'-1) len0')
386+ loop !s0 !i !len marr =
376− loop !s0 !i = case next s0 of
387+ case next s0 of
377− Done -> return marr
388+ Done -> return (marr, (j, len-j))
389+ where j = i + 1
378− Skip s1 -> loop s1 i
390+ Skip s1 -> loop s1 i len marr
379− Yield x s1
391+ Yield x s1 | i < least -> do
380− | n < 0x10000 -> do
392+ let newLen = len * 2
381− let i' = i - 1
393+ marr' <- A.unsafeNew newLen
382− A.unsafeWrite marr i' (fromIntegral n)
394+ A.unsafeCopy marr 0 marr' (newLen-len) len
383− loop s1 i'
395+ write s1 (len+i) newLen marr'
384− | otherwise -> do
396+ | otherwise -> write s1 i len marr
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
397+ where n = ord x
398+ least | n < 0x10000 = 0
399+ | otherwise = 1
390− m = n - 0x10000
400+ m = n - 0x10000
391− l = fromIntegral $ (m `shiftR` 10) + 0xD800
401+ lo = fromIntegral $ (m `shiftR` 10) + 0xD800
392− r = fromIntegral $ (m .&. 0x3FF) + 0xDC00
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
393{-# INLINE [0] reverse #-}
411{-# INLINE [0] reverse #-}
394
412
395-- ----------------------------------------------------------------------------
413-- ----------------------------------------------------------------------------
@@ -567,6 +585,20 @@ scanl f z0 (Stream next0 s0 len) = Stream next (S1 :!: z0 :!: s0) (len+1)
567 Done -> Done
585 Done -> Done
568{-# INLINE [0] scanl #-}
586{-# INLINE [0] scanl #-}
569
587
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+
570-- -----------------------------------------------------------------------------
602-- -----------------------------------------------------------------------------
571-- ** Accumulating maps
603-- ** Accumulating maps
572
604