git.iko.soy/text
on builder help sign in
text/Data/Text/Fusion.hs
231 lines 8.3 kB history raw
1{-# LANGUAGE BangPatterns, MagicHash #-}
3-- |
4-- Module : Data.Text.Fusion
5-- Copyright : (c) Tom Harper 2008-2009,
6-- (c) Bryan O'Sullivan 2009-2010,
7-- (c) Duncan Coutts 2009
8--
9-- License : BSD-style
10-- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,
11-- duncan@haskell.org
12-- Stability : experimental
13-- Portability : GHC
14--
15-- Text manipulation functions represented as fusible operations over
16-- streams.
17module Data.Text.Fusion
18 (
19 -- * Types
20 Stream(..)
21 , Step(..)
23 -- * Creation and elimination
24 , stream
25 , unstream
26 , reverseStream
28 , length
30 -- * Transformations
31 , reverse
33 -- * Construction
34 -- ** Scans
35 , reverseScanr
37 -- ** Accumulating maps
38 , mapAccumL
40 -- ** Generation and unfolding
41 , unfoldrN
43 -- * Indexing
44 , index
45 , findIndex
46 , countChar
47 ) where
49import Prelude (Bool(..), Char, Maybe(..), Monad(..), Int,
50 Num(..), Ord(..), ($), (&&),
51 fromIntegral, otherwise)
52import Data.Bits ((.&.))
53import Data.Text.Internal (Text(..))
54import Data.Text.UnsafeChar (ord, unsafeChr, unsafeWrite)
55import Data.Text.UnsafeShift (shiftL, shiftR)
56import qualified Data.Text.Array as A
57import qualified Data.Text.Fusion.Common as S
58import Data.Text.Fusion.Internal
59import Data.Text.Fusion.Size
60import qualified Data.Text.Internal as I
61import qualified Data.Text.Encoding.Utf16 as U16
62import qualified Prelude as P
64default(Int)
66-- | /O(n)/ Convert a 'Text' into a 'Stream Char'.
67stream :: Text -> Stream Char
68stream (Text arr off len) = Stream next off (maxSize len)
69 where
70 !end = off+len
71 next !i
72 | i >= end = Done
73 | n >= 0xD800 && n <= 0xDBFF = Yield (U16.chr2 n n2) (i + 2)
74 | otherwise = Yield (unsafeChr n) (i + 1)
75 where
76 n = A.unsafeIndex arr i
77 n2 = A.unsafeIndex arr (i + 1)
78{-# INLINE [0] stream #-}
80-- | /O(n)/ Convert a 'Text' into a 'Stream Char', but iterate
81-- backwards.
82reverseStream :: Text -> Stream Char
83reverseStream (Text arr off len) = Stream next (off+len-1) (maxSize len)
84 where
85 {-# INLINE next #-}
86 next !i
87 | i < off = Done
88 | n >= 0xDC00 && n <= 0xDFFF = Yield (U16.chr2 n2 n) (i - 2)
89 | otherwise = Yield (unsafeChr n) (i - 1)
90 where
91 n = A.unsafeIndex arr i
92 n2 = A.unsafeIndex arr (i - 1)
93{-# INLINE [0] reverseStream #-}
95-- | /O(n)/ Convert a 'Stream Char' into a 'Text'.
96unstream :: Stream Char -> Text
97unstream (Stream next0 s0 len) = I.textP (P.fst a) 0 (P.snd a)
98 where
99 a = A.run2 (A.new mlen >>= \arr -> outer arr mlen s0 0)
100 where mlen = upperBound 4 len
101 outer arr top = loop
102 where
103 loop !s !i =
104 case next0 s of
105 Done -> return (arr, i)
106 Skip s' -> loop s' i
107 Yield x s'
108 | j >= top -> {-# SCC "unstream/resize" #-} do
109 let top' = (top + 1) `shiftL` 1
110 arr' <- A.new top'
111 A.copyM arr' 0 arr 0 top
112 outer arr' top' s i
113 | otherwise -> do d <- unsafeWrite arr i x
114 loop s' (i+d)
115 where j | ord x < 0x10000 = i
116 | otherwise = i + 1
117{-# INLINE [0] unstream #-}
118{-# RULES "STREAM stream/unstream fusion" forall s. stream (unstream s) = s #-}
121-- ----------------------------------------------------------------------------
122-- * Basic stream functions
124length :: Stream Char -> Int
125length = S.lengthI
126{-# INLINE[0] length #-}
128-- | /O(n)/ Reverse the characters of a string.
129reverse :: Stream Char -> Text
130reverse (Stream next s len0)
131 | isEmpty len0 = I.empty
132 | otherwise = I.textP arr off' len'
133 where
134 len0' = upperBound 4 (larger len0 4)
135 (arr, (off', len')) = A.run2 (A.new len0' >>= loop s (len0'-1) len0')
136 loop !s0 !i !len marr =
137 case next s0 of
138 Done -> return (marr, (j, len-j))
139 where j = i + 1
140 Skip s1 -> loop s1 i len marr
141 Yield x s1 | i < least -> {-# SCC "reverse/resize" #-} do
142 let newLen = len `shiftL` 1
143 marr' <- A.new newLen
144 A.copyM marr' (newLen-len) marr 0 len
145 write s1 (len+i) newLen marr'
146 | otherwise -> write s1 i len marr
147 where n = ord x
148 least | n < 0x10000 = 0
149 | otherwise = 1
150 m = n - 0x10000
151 lo = fromIntegral $ (m `shiftR` 10) + 0xD800
152 hi = fromIntegral $ (m .&. 0x3FF) + 0xDC00
153 write t j l mar
154 | n < 0x10000 = do
155 A.unsafeWrite mar j (fromIntegral n)
156 loop t (j-1) l mar
157 | otherwise = do
158 A.unsafeWrite mar (j-1) lo
159 A.unsafeWrite mar j hi
160 loop t (j-2) l mar
161{-# INLINE [0] reverse #-}
163-- | /O(n)/ Perform the equivalent of 'scanr' over a list, only with
164-- the input and result reversed.
165reverseScanr :: (Char -> Char -> Char) -> Char -> Stream Char -> Stream Char
166reverseScanr f z0 (Stream next0 s0 len) = Stream next (S1 :*: z0 :*: s0) (len+1) -- HINT maybe too low
167 where
168 {-# INLINE next #-}
169 next (S1 :*: z :*: s) = Yield z (S2 :*: z :*: s)
170 next (S2 :*: z :*: s) = case next0 s of
171 Yield x s' -> let !x' = f x z
172 in Yield x' (S2 :*: x' :*: s')
173 Skip s' -> Skip (S2 :*: z :*: s')
174 Done -> Done
175{-# INLINE reverseScanr #-}
177-- | /O(n)/ Like 'unfoldr', 'unfoldrN' builds a stream from a seed
178-- value. However, the length of the result is limited by the
179-- first argument to 'unfoldrN'. This function is more efficient than
180-- 'unfoldr' when the length of the result is known.
181unfoldrN :: Int -> (a -> Maybe (Char,a)) -> a -> Stream Char
182unfoldrN n = S.unfoldrNI n
183{-# INLINE [0] unfoldrN #-}
185-------------------------------------------------------------------------------
186-- ** Indexing streams
188-- | /O(n)/ stream index (subscript) operator, starting from 0.
189index :: Stream Char -> Int -> Char
190index = S.indexI
191{-# INLINE [0] index #-}
193-- | The 'findIndex' function takes a predicate and a stream and
194-- returns the index of the first element in the stream
195-- satisfying the predicate.
196findIndex :: (Char -> Bool) -> Stream Char -> Maybe Int
197findIndex = S.findIndexI
198{-# INLINE [0] findIndex #-}
200-- | /O(n)/ The 'count' function returns the number of times the query
201-- element appears in the given stream.
202countChar :: Char -> Stream Char -> Int
203countChar = S.countCharI
204{-# INLINE [0] countChar #-}
206-- | /O(n)/ Like a combination of 'map' and 'foldl''. Applies a
207-- function to each element of a 'Text', passing an accumulating
208-- parameter from left to right, and returns a final 'Text'.
209mapAccumL :: (a -> Char -> (a,Char)) -> a -> Stream Char -> (a, Text)
210mapAccumL f z0 (Stream next0 s0 len) = (nz,I.textP na 0 nl)
211 where
212 (na,(nz,nl)) = A.run2 (A.new mlen >>= \arr -> outer arr mlen z0 s0 0)
213 where mlen = upperBound 4 len
214 outer arr top = loop
215 where
216 loop !z !s !i =
217 case next0 s of
218 Done -> return (arr, (z,i))
219 Skip s' -> loop z s' i
220 Yield x s'
221 | j >= top -> {-# SCC "mapAccumL/resize" #-} do
222 let top' = (top + 1) `shiftL` 1
223 arr' <- A.new top'
224 A.copyM arr' 0 arr 0 top
225 outer arr' top' z s i
226 | otherwise -> do let (z',c) = f z x
227 d <- unsafeWrite arr i c
228 loop z' s' (i+d)
229 where j | ord x < 0x10000 = i
230 | otherwise = i + 1
231{-# INLINE [0] mapAccumL #-}