git.iko.soy/text
on master help sign in
Factor encoding restreaming functions into another module
75c1438Bryan O'Sullivan
Data/Text/Encoding/Fusion.hs+4−145
compare with master
unifiedsplit
@@ -1,7 +1,7 @@
1{-# LANGUAGE BangPatterns #-}
1{-# LANGUAGE BangPatterns #-}
2
2
3-- |
3-- |
4−-- Module : Data.Text.Encoding
4+-- Module : Data.Text.Encoding.Fusion
5-- Copyright : (c) Tom Harper 2008-2009,
5-- Copyright : (c) Tom Harper 2008-2009,
6-- (c) Bryan O'Sullivan 2009,
6-- (c) Bryan O'Sullivan 2009,
7-- (c) Duncan Coutts 2009
7-- (c) Duncan Coutts 2009
@@ -28,23 +28,15 @@ module Data.Text.Encoding.Fusion
28 -- * Unstreaming
28 -- * Unstreaming
29 , unstream
29 , unstream
30
30
31− -- * Restreaming
31+ , module Data.Text.Encoding.Fusion.Common
32− -- Restreaming is the act of converting from one 'Stream'
33− -- representation to another.
34− , restreamUtf8
35− , restreamUtf16LE
36− , restreamUtf16BE
37− , restreamUtf32LE
38− , restreamUtf32BE
39 ) where
32 ) where
40
33
41import Control.Exception (assert)
34import Control.Exception (assert)
42−import Data.Bits (shiftL, shiftR, (.&.))
35+import Data.Bits (shiftL)
43import Data.ByteString as B
36import Data.ByteString as B
44import Data.ByteString.Internal (ByteString(..), mallocByteString, memcpy)
37import Data.ByteString.Internal (ByteString(..), mallocByteString, memcpy)
45−import Data.Char (ord)
46import Data.Text.Fusion (Step(..), Stream(..))
38import Data.Text.Fusion (Step(..), Stream(..))
47−import Data.Text.Fusion.Internal (M(..))
39+import Data.Text.Encoding.Fusion.Common
48import Data.Text.UnsafeChar (unsafeChr, unsafeChr8, unsafeChr32)
40import Data.Text.UnsafeChar (unsafeChr, unsafeChr8, unsafeChr32)
49import Data.Word (Word8, Word16, Word32)
41import Data.Word (Word8, Word16, Word32)
50import Foreign.ForeignPtr (withForeignPtr, ForeignPtr)
42import Foreign.ForeignPtr (withForeignPtr, ForeignPtr)
@@ -56,12 +48,6 @@ import qualified Data.Text.Encoding.Utf8 as U8
56import qualified Data.Text.Encoding.Utf16 as U16
48import qualified Data.Text.Encoding.Utf16 as U16
57import qualified Data.Text.Encoding.Utf32 as U32
49import qualified Data.Text.Encoding.Utf32 as U32
58
50
59−type M8 = M Word8
60−
61−-- Restreaming state.
62−data S s = S {-# UNPACK #-} !s
63− {-# UNPACK #-} !M8 {-# UNPACK #-} !M8 {-# UNPACK #-} !M8
64−
65streamASCII :: ByteString -> Stream Char
51streamASCII :: ByteString -> Stream Char
66streamASCII bs = Stream next 0 l
52streamASCII bs = Stream next 0 l
67 where
53 where
@@ -172,129 +158,6 @@ streamUtf32LE bs = Stream next 0 l
172 idx = fromIntegral . B.unsafeIndex bs :: Int -> Word32
158 idx = fromIntegral . B.unsafeIndex bs :: Int -> Word32
173{-# INLINE [0] streamUtf32LE #-}
159{-# INLINE [0] streamUtf32LE #-}
174
160
175−-- | /O(n)/ Convert a Stream Char into a UTF-8 encoded Stream Word8.
176−restreamUtf8 :: Stream Char -> Stream Word8
177−restreamUtf8 (Stream next0 s0 len) =
178− Stream next (S s0 N N N) (len*2)
179− where
180− {-# INLINE next #-}
181− next (S s N N N) = case next0 s of
182− Done -> Done
183− Skip s' -> Skip (S s' N N N)
184− Yield x xs
185− | n <= 0x7F -> Yield c (S xs N N N)
186− | n <= 0x07FF -> Yield a2 (S xs (J b2) N N)
187− | n <= 0xFFFF -> Yield a3 (S xs (J b3) (J c3) N)
188− | otherwise -> Yield a4 (S xs (J b4) (J c4) (J d4))
189− where
190− n = ord x
191− c = fromIntegral n
192− (a2,b2) = U8.ord2 x
193− (a3,b3,c3) = U8.ord3 x
194− (a4,b4,c4,d4) = U8.ord4 x
195− next (S s (J x2) N N) = Yield x2 (S s N N N)
196− next (S s (J x2) x3 N) = Yield x2 (S s x3 N N)
197− next (S s (J x2) x3 x4) = Yield x2 (S s x3 x4 N)
198− next _ = internalError "restreamUtf8"
199−{-# INLINE restreamUtf8 #-}
200−
201−restreamUtf16BE :: Stream Char -> Stream Word8
202−restreamUtf16BE (Stream next0 s0 len) =
203− Stream next (S s0 N N N) (len*2)
204− where
205− {-# INLINE next #-}
206− next (S s N N N) = case next0 s of
207− Done -> Done
208− Skip s' -> Skip (S s' N N N)
209− Yield x xs
210− | n < 0x10000 -> Yield (fromIntegral $ n `shiftR` 8) $
211− S xs (J $ fromIntegral n) N N
212− | otherwise -> Yield c1 $
213− S xs (J c2) (J c3) (J c4)
214− where
215− n = ord x
216− n1 = n - 0x10000
217− c1 = fromIntegral (n1 `shiftR` 18 + 0xD8)
218− c2 = fromIntegral (n1 `shiftR` 10)
219− n2 = n1 .&. 0x3FF
220− c3 = fromIntegral (n2 `shiftR` 8 + 0xDC)
221− c4 = fromIntegral n2
222− next (S s (J x2) N N) = Yield x2 (S s N N N)
223− next (S s (J x2) x3 N) = Yield x2 (S s x3 N N)
224− next (S s (J x2) x3 x4) = Yield x2 (S s x3 x4 N)
225− next _ = internalError "restreamUtf16BE"
226−{-# INLINE restreamUtf16BE #-}
227−
228−restreamUtf16LE :: Stream Char -> Stream Word8
229−restreamUtf16LE (Stream next0 s0 len) =
230− Stream next (S s0 N N N) (len*2)
231− where
232− {-# INLINE next #-}
233− next (S s N N N) = case next0 s of
234− Done -> Done
235− Skip s' -> Skip (S s' N N N)
236− Yield x xs
237− | n < 0x10000 -> Yield (fromIntegral n) $
238− S xs (J (fromIntegral $ shiftR n 8)) N N
239− | otherwise -> Yield c1 $
240− S xs (J c2) (J c3) (J c4)
241− where
242− n = ord x
243− n1 = n - 0x10000
244− c2 = fromIntegral (shiftR n1 18 + 0xD8)
245− c1 = fromIntegral (shiftR n1 10)
246− n2 = n1 .&. 0x3FF
247− c4 = fromIntegral (shiftR n2 8 + 0xDC)
248− c3 = fromIntegral n2
249− next (S s (J x2) N N) = Yield x2 (S s N N N)
250− next (S s (J x2) x3 N) = Yield x2 (S s x3 N N)
251− next (S s (J x2) x3 x4) = Yield x2 (S s x3 x4 N)
252− next _ = internalError "restreamUtf16LE"
253−{-# INLINE restreamUtf16LE #-}
254−
255−restreamUtf32BE :: Stream Char -> Stream Word8
256−restreamUtf32BE (Stream next0 s0 len) =
257− Stream next (S s0 N N N) (len*2)
258− where
259− {-# INLINE next #-}
260− next (S s N N N) = case next0 s of
261− Done -> Done
262− Skip s' -> Skip (S s' N N N)
263− Yield x xs -> Yield c1 (S xs (J c2) (J c3) (J c4))
264− where
265− n = ord x
266− c1 = fromIntegral $ shiftR n 24
267− c2 = fromIntegral $ shiftR n 16
268− c3 = fromIntegral $ shiftR n 8
269− c4 = fromIntegral n
270− next (S s (J x2) N N) = Yield x2 (S s N N N)
271− next (S s (J x2) x3 N) = Yield x2 (S s x3 N N)
272− next (S s (J x2) x3 x4) = Yield x2 (S s x3 x4 N)
273− next _ = internalError "restreamUtf32BE"
274−{-# INLINE restreamUtf32BE #-}
275−
276−restreamUtf32LE :: Stream Char -> Stream Word8
277−restreamUtf32LE (Stream next0 s0 len) =
278− Stream next (S s0 N N N) (len*2)
279− where
280− {-# INLINE next #-}
281− next (S s N N N) = case next0 s of
282− Done -> Done
283− Skip s' -> Skip (S s' N N N)
284− Yield x xs -> Yield c1 (S xs (J c2) (J c3) (J c4))
285− where
286− n = ord x
287− c4 = fromIntegral $ shiftR n 24
288− c3 = fromIntegral $ shiftR n 16
289− c2 = fromIntegral $ shiftR n 8
290− c1 = fromIntegral n
291− next (S s (J x2) N N) = Yield x2 (S s N N N)
292− next (S s (J x2) x3 N) = Yield x2 (S s x3 N N)
293− next (S s (J x2) x3 x4) = Yield x2 (S s x3 x4 N)
294− next _ = internalError "restreamUtf32LE"
295−{-# INLINE restreamUtf32LE #-}
296−
297−
298-- | /O(n)/ Convert a 'Stream' 'Word8' to a 'ByteString'.
161-- | /O(n)/ Convert a 'Stream' 'Word8' to a 'ByteString'.
299unstream :: Stream Word8 -> ByteString
162unstream :: Stream Word8 -> ByteString
300unstream (Stream next s0 len) = unsafePerformIO $ do
163unstream (Stream next s0 len) = unsafePerformIO $ do
@@ -325,10 +188,6 @@ unstream (Stream next s0 len) = unsafePerformIO $ do
325 memcpy dest' src' (fromIntegral destLen)
188 memcpy dest' src' (fromIntegral destLen)
326 return dest
189 return dest
327
190
328−internalError :: String -> a
329−internalError func =
330− error $ "Data.Text.Encoding.Fusion." ++ func ++ ": internal error"
331−
332encodingError :: String -> a
191encodingError :: String -> a
333encodingError encoding =
192encodingError encoding =
334 error $ "Data.Text.Encoding.Fusion: Bad " ++ encoding ++ " stream"
193 error $ "Data.Text.Encoding.Fusion: Bad " ++ encoding ++ " stream"
Data/Text/Encoding/Fusion/Common.hsnew file+167
@@ -0,0 +1,167 @@
1+{-# LANGUAGE BangPatterns #-}
2+
3+-- |
4+-- Module : Data.Text.Encoding.Fusion.Common
5+-- Copyright : (c) Tom Harper 2008-2009,
6+-- (c) Bryan O'Sullivan 2009,
7+-- (c) Duncan Coutts 2009
8+--
9+-- License : BSD-style
10+-- Maintainer : rtharper@aftereternity.co.uk, bos@serpentine.com,
11+-- duncan@haskell.org
12+-- Stability : experimental
13+-- Portability : portable
14+--
15+-- Fusible 'Stream'-oriented functions for converting between 'Text'
16+-- and several common encodings.
17+
18+module Data.Text.Encoding.Fusion.Common
19+ (
20+ -- * Restreaming
21+ -- Restreaming is the act of converting from one 'Stream'
22+ -- representation to another.
23+ restreamUtf8
24+ , restreamUtf16LE
25+ , restreamUtf16BE
26+ , restreamUtf32LE
27+ , restreamUtf32BE
28+ ) where
29+
30+import Data.Bits (shiftL, shiftR, (.&.))
31+import Data.Char (ord)
32+import Data.Text.Fusion (Step(..), Stream(..))
33+import Data.Text.Fusion.Internal (M(..))
34+import Data.Word (Word8)
35+import qualified Data.Text.Encoding.Utf8 as U8
36+
37+type M8 = M Word8
38+
39+-- Restreaming state.
40+data S s = S {-# UNPACK #-} !s
41+ {-# UNPACK #-} !M8 {-# UNPACK #-} !M8 {-# UNPACK #-} !M8
42+
43+-- | /O(n)/ Convert a Stream Char into a UTF-8 encoded Stream Word8.
44+restreamUtf8 :: Stream Char -> Stream Word8
45+restreamUtf8 (Stream next0 s0 len) =
46+ Stream next (S s0 N N N) (len*2)
47+ where
48+ {-# INLINE next #-}
49+ next (S s N N N) = case next0 s of
50+ Done -> Done
51+ Skip s' -> Skip (S s' N N N)
52+ Yield x xs
53+ | n <= 0x7F -> Yield c (S xs N N N)
54+ | n <= 0x07FF -> Yield a2 (S xs (J b2) N N)
55+ | n <= 0xFFFF -> Yield a3 (S xs (J b3) (J c3) N)
56+ | otherwise -> Yield a4 (S xs (J b4) (J c4) (J d4))
57+ where
58+ n = ord x
59+ c = fromIntegral n
60+ (a2,b2) = U8.ord2 x
61+ (a3,b3,c3) = U8.ord3 x
62+ (a4,b4,c4,d4) = U8.ord4 x
63+ next (S s (J x2) N N) = Yield x2 (S s N N N)
64+ next (S s (J x2) x3 N) = Yield x2 (S s x3 N N)
65+ next (S s (J x2) x3 x4) = Yield x2 (S s x3 x4 N)
66+ next _ = internalError "restreamUtf8"
67+{-# INLINE restreamUtf8 #-}
68+
69+restreamUtf16BE :: Stream Char -> Stream Word8
70+restreamUtf16BE (Stream next0 s0 len) =
71+ Stream next (S s0 N N N) (len*2)
72+ where
73+ {-# INLINE next #-}
74+ next (S s N N N) = case next0 s of
75+ Done -> Done
76+ Skip s' -> Skip (S s' N N N)
77+ Yield x xs
78+ | n < 0x10000 -> Yield (fromIntegral $ n `shiftR` 8) $
79+ S xs (J $ fromIntegral n) N N
80+ | otherwise -> Yield c1 $
81+ S xs (J c2) (J c3) (J c4)
82+ where
83+ n = ord x
84+ n1 = n - 0x10000
85+ c1 = fromIntegral (n1 `shiftR` 18 + 0xD8)
86+ c2 = fromIntegral (n1 `shiftR` 10)
87+ n2 = n1 .&. 0x3FF
88+ c3 = fromIntegral (n2 `shiftR` 8 + 0xDC)
89+ c4 = fromIntegral n2
90+ next (S s (J x2) N N) = Yield x2 (S s N N N)
91+ next (S s (J x2) x3 N) = Yield x2 (S s x3 N N)
92+ next (S s (J x2) x3 x4) = Yield x2 (S s x3 x4 N)
93+ next _ = internalError "restreamUtf16BE"
94+{-# INLINE restreamUtf16BE #-}
95+
96+restreamUtf16LE :: Stream Char -> Stream Word8
97+restreamUtf16LE (Stream next0 s0 len) =
98+ Stream next (S s0 N N N) (len*2)
99+ where
100+ {-# INLINE next #-}
101+ next (S s N N N) = case next0 s of
102+ Done -> Done
103+ Skip s' -> Skip (S s' N N N)
104+ Yield x xs
105+ | n < 0x10000 -> Yield (fromIntegral n) $
106+ S xs (J (fromIntegral $ shiftR n 8)) N N
107+ | otherwise -> Yield c1 $
108+ S xs (J c2) (J c3) (J c4)
109+ where
110+ n = ord x
111+ n1 = n - 0x10000
112+ c2 = fromIntegral (shiftR n1 18 + 0xD8)
113+ c1 = fromIntegral (shiftR n1 10)
114+ n2 = n1 .&. 0x3FF
115+ c4 = fromIntegral (shiftR n2 8 + 0xDC)
116+ c3 = fromIntegral n2
117+ next (S s (J x2) N N) = Yield x2 (S s N N N)
118+ next (S s (J x2) x3 N) = Yield x2 (S s x3 N N)
119+ next (S s (J x2) x3 x4) = Yield x2 (S s x3 x4 N)
120+ next _ = internalError "restreamUtf16LE"
121+{-# INLINE restreamUtf16LE #-}
122+
123+restreamUtf32BE :: Stream Char -> Stream Word8
124+restreamUtf32BE (Stream next0 s0 len) =
125+ Stream next (S s0 N N N) (len*2)
126+ where
127+ {-# INLINE next #-}
128+ next (S s N N N) = case next0 s of
129+ Done -> Done
130+ Skip s' -> Skip (S s' N N N)
131+ Yield x xs -> Yield c1 (S xs (J c2) (J c3) (J c4))
132+ where
133+ n = ord x
134+ c1 = fromIntegral $ shiftR n 24
135+ c2 = fromIntegral $ shiftR n 16
136+ c3 = fromIntegral $ shiftR n 8
137+ c4 = fromIntegral n
138+ next (S s (J x2) N N) = Yield x2 (S s N N N)
139+ next (S s (J x2) x3 N) = Yield x2 (S s x3 N N)
140+ next (S s (J x2) x3 x4) = Yield x2 (S s x3 x4 N)
141+ next _ = internalError "restreamUtf32BE"
142+{-# INLINE restreamUtf32BE #-}
143+
144+restreamUtf32LE :: Stream Char -> Stream Word8
145+restreamUtf32LE (Stream next0 s0 len) =
146+ Stream next (S s0 N N N) (len*2)
147+ where
148+ {-# INLINE next #-}
149+ next (S s N N N) = case next0 s of
150+ Done -> Done
151+ Skip s' -> Skip (S s' N N N)
152+ Yield x xs -> Yield c1 (S xs (J c2) (J c3) (J c4))
153+ where
154+ n = ord x
155+ c4 = fromIntegral $ shiftR n 24
156+ c3 = fromIntegral $ shiftR n 16
157+ c2 = fromIntegral $ shiftR n 8
158+ c1 = fromIntegral n
159+ next (S s (J x2) N N) = Yield x2 (S s N N N)
160+ next (S s (J x2) x3 N) = Yield x2 (S s x3 N N)
161+ next (S s (J x2) x3 x4) = Yield x2 (S s x3 x4 N)
162+ next _ = internalError "restreamUtf32LE"
163+{-# INLINE restreamUtf32LE #-}
164+
165+internalError :: String -> a
166+internalError func =
167+ error $ "Data.Text.Encoding.Fusion.Common." ++ func ++ ": internal error"
text.cabal+1
@@ -19,6 +19,7 @@ library
19 Data.Text
19 Data.Text
20 Data.Text.Encoding
20 Data.Text.Encoding
21 Data.Text.Encoding.Fusion
21 Data.Text.Encoding.Fusion
22+ Data.Text.Encoding.Fusion.Common
22 Data.Text.Foreign
23 Data.Text.Foreign
23 Data.Text.Fusion
24 Data.Text.Fusion
24 Data.Text.Fusion.Common
25 Data.Text.Fusion.Common