git.iko.soy/text
on master help sign in
Split encoding support out into new modules
a70e3a0Bryan O'Sullivan
Data/Text.hs+3−27
compare with master
unifiedsplit
@@ -29,15 +29,12 @@ module Data.Text
29
29
30 -- * Types
30 -- * Types
31 Text
31 Text
32− , Encoding(..)
33
32
34 -- * Creation and elimination
33 -- * Creation and elimination
35 , pack
34 , pack
36 , unpack
35 , unpack
37 , singleton
36 , singleton
38 , empty
37 , empty
39− , encode
40− , decode
41
38
42 -- * Basic interface
39 -- * Basic interface
43 , cons
40 , cons
@@ -98,31 +95,24 @@ module Data.Text
98
95
99 -- * Zipping and unzipping
96 -- * Zipping and unzipping
100 , zipWith
97 , zipWith
101−
102− -- * I/O
103− , readFile
104 ) where
98 ) where
105
99
106import Prelude (Char, Bool, Int, Maybe, String,
100import Prelude (Char, Bool, Int, Maybe, String,
107 Eq, (==), (++), error,
101 Eq, (==), (++), error,
108 Show, showsPrec,
102 Show, showsPrec,
109 Read, readsPrec,
103 Read, readsPrec,
110− (&&), (||), (+), (-), (<), (>), (<=), (>=), (.), (>>=),
104+ (&&), (||), (+), (-), (<), (>), (<=), (>=), (.),
111− return, otherwise,
105+ return, otherwise)
112− IO, FilePath)
113import Data.Char (isSpace)
106import Data.Char (isSpace)
114import Control.Monad.ST (ST)
107import Control.Monad.ST (ST)
115import qualified Data.Text.Array as A
108import qualified Data.Text.Array as A
116−import qualified Data.ByteString as B
117−import Data.ByteString (ByteString)
118import qualified Data.List as L
109import qualified Data.List as L
119import Data.Monoid (Monoid(..))
110import Data.Monoid (Monoid(..))
120import Data.Word (Word16)
111import Data.Word (Word16)
121import Data.String (IsString(..))
112import Data.String (IsString(..))
122
113
123import qualified Data.Text.Fusion as S
114import qualified Data.Text.Fusion as S
124−import Data.Text.Fusion (Stream(..), Step(..), Encoding(..),
115+import Data.Text.Fusion (Stream(..), Step(..), stream, unstream)
125− stream, unstream, stream_bs, unstream_bs, restream)
126import Data.Text.Internal (Text(..), empty)
116import Data.Text.Internal (Text(..), empty)
127import qualified Prelude as P
117import qualified Prelude as P
128import Data.Text.UnsafeChar (unsafeChr)
118import Data.Text.UnsafeChar (unsafeChr)
@@ -190,14 +180,6 @@ singleton c = unstream (Stream next (c:[]) 1)
190 next [] = Done
180 next [] = Done
191{-# INLINE [1] singleton #-}
181{-# INLINE [1] singleton #-}
192
182
193−decode :: Encoding -> ByteString -> Text
194−decode enc bs = unstream (stream_bs enc bs)
195−{-# INLINE decode #-}
196−
197−encode :: Encoding -> Text -> ByteString
198−encode enc txt = unstream_bs (restream enc (stream txt))
199−{-# INLINE encode #-}
200−
201-- -----------------------------------------------------------------------------
183-- -----------------------------------------------------------------------------
202-- * Basic functions
184-- * Basic functions
203
185
@@ -561,12 +543,6 @@ elemIndex c t = S.elemIndex c (stream t)
561zipWith :: (Char -> Char -> Char) -> Text -> Text -> Text
543zipWith :: (Char -> Char -> Char) -> Text -> Text -> Text
562zipWith f t1 t2 = unstream (S.zipWith f (stream t1) (stream t2))
544zipWith f t1 t2 = unstream (S.zipWith f (stream t1) (stream t2))
563
545
564−-- File I/O
565−
566−readFile :: Encoding -> FilePath -> IO Text
567−readFile enc f = B.readFile f >>= return . unstream . stream_bs enc
568−{-# INLINE [1] readFile #-}
569−
570words :: Text -> [Text]
546words :: Text -> [Text]
571words (Text arr off len) = loop0 off off
547words (Text arr off len) = loop0 off off
572 where
548 where
Data/Text/Encoding.hsnew file+99
@@ -0,0 +1,99 @@
1+-- |
2+-- Module : Data.Text.Encoding
3+-- Copyright : (c) Tom Harper 2008-2009,
4+-- (c) Bryan O'Sullivan 2009,
5+-- (c) Duncan Coutts 2009
6+--
7+-- License : BSD-style
8+-- Maintainer : rtharper@aftereternity.co.uk, bos@serpentine.com,
9+-- duncan@haskell.org
10+-- Stability : experimental
11+-- Portability : portable
12+--
13+-- Functions for converting 'Text' values to and from 'ByteString',
14+-- using several common encodings.
15+
16+module Data.Text.Encoding
17+ (
18+ -- * Decoding ByteStrings to Text
19+ decodeASCII
20+ , decodeUtf8
21+ , decodeUtf16LE
22+ , decodeUtf16BE
23+ , decodeUtf32LE
24+ , decodeUtf32BE
25+
26+ -- * Encoding Text to ByteStrings
27+ , encodeASCII
28+ , encodeUtf8
29+ , encodeUtf16LE
30+ , encodeUtf16BE
31+ , encodeUtf32LE
32+ , encodeUtf32BE
33+ ) where
34+
35+import Data.ByteString (ByteString)
36+import qualified Data.Text.Fusion as F
37+import qualified Data.Text.Encoding.Fusion as E
38+import Data.Text.Internal (Text)
39+
40+-- | Decode a 'ByteString' containing 7-bit ASCII encoded text.
41+decodeASCII :: ByteString -> Text
42+decodeASCII bs = F.unstream (E.streamASCII bs)
43+{-# INLINE decodeASCII #-}
44+
45+-- | Decode a 'ByteString' containing UTF-8 encoded text.
46+decodeUtf8 :: ByteString -> Text
47+decodeUtf8 bs = F.unstream (E.streamUtf8 bs)
48+{-# INLINE decodeUtf8 #-}
49+
50+-- | Encode text using a 7-bit ASCII representation. /Note/: non-ASCII
51+-- characters in the input 'Text' will be /truncated/.
52+encodeASCII :: Text -> ByteString
53+encodeASCII txt = E.unstream (E.restreamASCII (F.stream txt))
54+{-# INLINE encodeASCII #-}
55+
56+-- | Encode text using UTF-8 encoding.
57+encodeUtf8 :: Text -> ByteString
58+encodeUtf8 txt = E.unstream (E.restreamUtf8 (F.stream txt))
59+{-# INLINE encodeUtf8 #-}
60+
61+-- | Decode text from little endian UTF-16 encoding.
62+decodeUtf16LE :: ByteString -> Text
63+decodeUtf16LE bs = F.unstream (E.streamUtf16LE bs)
64+{-# INLINE decodeUtf16LE #-}
65+
66+-- | Decode text from big endian UTF-16 encoding.
67+decodeUtf16BE :: ByteString -> Text
68+decodeUtf16BE bs = F.unstream (E.streamUtf16BE bs)
69+{-# INLINE decodeUtf16BE #-}
70+
71+-- | Encode text using little endian UTF-16 encoding.
72+encodeUtf16LE :: Text -> ByteString
73+encodeUtf16LE txt = E.unstream (E.restreamUtf16LE (F.stream txt))
74+{-# INLINE encodeUtf16LE #-}
75+
76+-- | Encode text using big endian UTF-16 encoding.
77+encodeUtf16BE :: Text -> ByteString
78+encodeUtf16BE txt = E.unstream (E.restreamUtf16BE (F.stream txt))
79+{-# INLINE encodeUtf16BE #-}
80+
81+-- | Decode text from little endian UTF-32 encoding.
82+decodeUtf32LE :: ByteString -> Text
83+decodeUtf32LE bs = F.unstream (E.streamUtf32LE bs)
84+{-# INLINE decodeUtf32LE #-}
85+
86+-- | Decode text from big endian UTF-32 encoding.
87+decodeUtf32BE :: ByteString -> Text
88+decodeUtf32BE bs = F.unstream (E.streamUtf32LE bs)
89+{-# INLINE decodeUtf32BE #-}
90+
91+-- | Encode text using little endian UTF-32 encoding.
92+encodeUtf32LE :: Text -> ByteString
93+encodeUtf32LE txt = E.unstream (E.restreamUtf32LE (F.stream txt))
94+{-# INLINE encodeUtf32LE #-}
95+
96+-- | Encode text using big endian UTF-32 encoding.
97+encodeUtf32BE :: Text -> ByteString
98+encodeUtf32BE txt = E.unstream (E.restreamUtf32BE (F.stream txt))
99+{-# INLINE encodeUtf32BE #-}
Data/Text/Encoding/Fusion.hsnew file+330
@@ -0,0 +1,330 @@
1+{-# LANGUAGE BangPatterns #-}
2+
3+-- |
4+-- Module : Data.Text.Encoding
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
19+ (
20+ -- * Streaming
21+ streamASCII
22+ , streamUtf8
23+ , streamUtf16LE
24+ , streamUtf16BE
25+ , streamUtf32LE
26+ , streamUtf32BE
27+
28+ -- * Unstreaming
29+ , unstream
30+
31+ -- * Restreaming
32+ -- Restreaming is the act of converting from one 'Stream'
33+ -- representation to another.
34+ , restreamASCII
35+ , restreamUtf8
36+ , restreamUtf16LE
37+ , restreamUtf16BE
38+ , restreamUtf32LE
39+ , restreamUtf32BE
40+ ) where
41+
42+import Control.Exception (assert)
43+import Data.Bits (shiftL, shiftR, (.&.))
44+import Data.ByteString as B
45+import Data.ByteString.Internal (ByteString(..), mallocByteString, memcpy)
46+import Data.Char (ord)
47+import Data.Text.Fusion (Step(..), Stream(..))
48+import Data.Text.UnsafeChar (unsafeChr, unsafeChr8, unsafeChr32)
49+import Data.Word (Word8, Word16, Word32)
50+import Foreign.ForeignPtr (withForeignPtr, ForeignPtr)
51+import Foreign.Storable (pokeByteOff)
52+import System.IO.Unsafe (unsafePerformIO)
53+import qualified Data.ByteString as B
54+import qualified Data.ByteString.Unsafe as B
55+import qualified Data.Text.Utf16 as U16
56+import qualified Data.Text.Utf32 as U32
57+import qualified Data.Text.Utf8 as U8
58+
59+data T4 a b c d = T4 !a !b !c !d
60+
61+streamASCII :: ByteString -> Stream Char
62+streamASCII bs = Stream next 0 l
63+ where
64+ l = B.length bs
65+ {-# INLINE next #-}
66+ next i
67+ | i >= l = Done
68+ | otherwise = Yield (unsafeChr8 x1) (i+1)
69+ where
70+ x1 = B.unsafeIndex bs i
71+{-# INLINE [0] streamASCII #-}
72+
73+-- | /O(n) Convert a ByteString into a Stream Char, using the specified encoding standard.
74+streamUtf8 :: ByteString -> Stream Char
75+streamUtf8 bs = Stream next 0 l
76+ where
77+ l = B.length bs
78+ {-# INLINE next #-}
79+ next i
80+ | i >= l = Done
81+ | U8.validate1 x1 = Yield (unsafeChr8 x1) (i+1)
82+ | i+1 < l && U8.validate2 x1 x2 = Yield (U8.chr2 x1 x2) (i+2)
83+ | i+2 < l && U8.validate3 x1 x2 x3 = Yield (U8.chr3 x1 x2 x3) (i+3)
84+ | i+3 < l && U8.validate4 x1 x2 x3 x4 = Yield (U8.chr4 x1 x2 x3 x4) (i+4)
85+ | otherwise = error "bsStream: bad UTF-8 stream"
86+ where
87+ x1 = idx i
88+ x2 = idx (i + 1)
89+ x3 = idx (i + 2)
90+ x4 = idx (i + 3)
91+ idx = B.unsafeIndex bs
92+{-# INLINE [0] streamUtf8 #-}
93+
94+streamUtf16LE :: ByteString -> Stream Char
95+streamUtf16LE bs = Stream next 0 l
96+ where
97+ l = B.length bs
98+ {-# INLINE next #-}
99+ next i
100+ | i >= l = Done
101+ | i+1 < l && U16.validate1 x1 = Yield (unsafeChr x1) (i+2)
102+ | i+3 < l && U16.validate2 x1 x2 = Yield (U16.chr2 x1 x2) (i+4)
103+ | otherwise = error $ "bsStream: bad UTF-16LE stream"
104+ where
105+ x1 = (shiftL (idx (i + 1)) 8) + (idx i)
106+ x2 = (shiftL (idx (i + 3)) 8) + (idx (i + 2))
107+ idx = fromIntegral . B.unsafeIndex bs :: Int -> Word16
108+{-# INLINE [0] streamUtf16LE #-}
109+
110+streamUtf16BE :: ByteString -> Stream Char
111+streamUtf16BE bs = Stream next 0 l
112+ where
113+ l = B.length bs
114+ {-# INLINE next #-}
115+ next i
116+ | i >= l = Done
117+ | i+1 < l && U16.validate1 x1 = Yield (unsafeChr x1) (i+2)
118+ | i+3 < l && U16.validate2 x1 x2 = Yield (U16.chr2 x1 x2) (i+4)
119+ | otherwise = error $ "bsStream: bad UTF16-BE stream "
120+ where
121+ x1 = (shiftL (idx i) 8) + (idx (i + 1))
122+ x2 = (shiftL (idx (i + 2)) 8) + (idx (i + 3))
123+ idx = fromIntegral . B.unsafeIndex bs :: Int -> Word16
124+{-# INLINE [0] streamUtf16BE #-}
125+
126+streamUtf32BE :: ByteString -> Stream Char
127+streamUtf32BE bs = Stream next 0 l
128+ where
129+ l = B.length bs
130+ {-# INLINE next #-}
131+ next i
132+ | i >= l = Done
133+ | i+3 < l && U32.validate x = Yield (unsafeChr32 x) (i+4)
134+ | otherwise = error "bsStream: bad UTF-32BE stream"
135+ where
136+ x = shiftL x1 24 + shiftL x2 16 + shiftL x3 8 + x4
137+ x1 = idx i
138+ x2 = idx (i+1)
139+ x3 = idx (i+2)
140+ x4 = idx (i+3)
141+ idx = fromIntegral . B.unsafeIndex bs :: Int -> Word32
142+{-# INLINE [0] streamUtf32BE #-}
143+
144+streamUtf32LE :: ByteString -> Stream Char
145+streamUtf32LE bs = Stream next 0 l
146+ where
147+ l = B.length bs
148+ {-# INLINE next #-}
149+ next i
150+ | i >= l = Done
151+ | i+3 < l && U32.validate x = Yield (unsafeChr32 x) (i+4)
152+ | otherwise = error "bsStream: bad UTF-32LE stream"
153+ where
154+ x = shiftL x4 24 + shiftL x3 16 + shiftL x2 8 + x1
155+ x1 = idx i
156+ x2 = idx $ i+1
157+ x3 = idx $ i+2
158+ x4 = idx $ i+3
159+ idx = fromIntegral . B.unsafeIndex bs :: Int -> Word32
160+{-# INLINE [0] streamUtf32LE #-}
161+
162+restreamASCII :: Stream Char -> Stream Word8
163+restreamASCII (Stream next0 s0 len) = Stream next s0 (len*2)
164+ where
165+ next !s = case next0 s of
166+ Done -> Done
167+ Skip s' -> Skip s'
168+ Yield x xs -> Yield x' xs
169+ where x' = fromIntegral (ord x) :: Word8
170+{-# INLINE restreamASCII #-}
171+
172+-- | /O(n)/ Convert a Stream Char into a UTF-8 encoded Stream Word8.
173+restreamUtf8 :: Stream Char -> Stream Word8
174+restreamUtf8 (Stream next0 s0 len) =
175+ Stream next (T4 (Just s0) Nothing Nothing Nothing) (len*2)
176+ where
177+ {-# INLINE next #-}
178+ next (T4 (Just s) Nothing Nothing Nothing) = case next0 s of
179+ Done -> Done
180+ Skip s' -> Skip (T4 (Just s') Nothing Nothing Nothing)
181+ Yield x xs
182+ | n <= 0x7F -> Yield c (T4 (Just xs) Nothing Nothing Nothing)
183+ | n <= 0x07FF -> Yield (fst c2) (T4 (Just xs) (Just $ snd c2) Nothing Nothing)
184+ | n <= 0xFFFF -> Yield (fst3 c3) (T4 (Just xs) (Just $ snd3 c3) (Just $ trd3 c3) Nothing)
185+ | otherwise -> Yield (fst4 c4) (T4 (Just xs) (Just $ snd4 c4) (Just $ trd4 c4) (Just $ fth4 c4))
186+ where
187+ n = ord x
188+ c = fromIntegral n
189+ c2 = U8.ord2 x
190+ c3 = U8.ord3 x
191+ c4 = U8.ord4 x
192+ fst3 (x1,_,_) = x1
193+ snd3 (_,x2,_) = x2
194+ trd3 (_,_,x3) = x3
195+ fst4 (x1,_,_,_) = x1
196+ snd4 (_,x2,_,_) = x2
197+ trd4 (_,_,x3,_) = x3
198+ fth4 (_,_,_,x4) = x4
199+ next (T4 (Just s) (Just x2) Nothing Nothing) = Yield x2 (T4 (Just s) Nothing Nothing Nothing)
200+ next (T4 (Just s) (Just x2) x3 Nothing) = Yield x2 (T4 (Just s) x3 Nothing Nothing)
201+ next (T4 (Just s) (Just x2) x3 x4) = Yield x2 (T4 (Just s) x3 x4 Nothing)
202+ next _ = internalError "restreamUtf8"
203+{-# INLINE restreamUtf8 #-}
204+
205+restreamUtf16BE :: Stream Char -> Stream Word8
206+restreamUtf16BE (Stream next0 s0 len) =
207+ Stream next (T4 (Just s0) Nothing Nothing Nothing) (len*2)
208+ where
209+ {-# INLINE next #-}
210+ next (T4 (Just s) Nothing Nothing Nothing) = case next0 s of
211+ Done -> Done
212+ Skip s' -> Skip (T4 (Just s') Nothing Nothing Nothing)
213+ Yield x xs
214+ | n < 0x10000 -> Yield (fromIntegral $ shiftR n 8) (T4 (Just xs) (Just (fromIntegral n)) Nothing Nothing)
215+ | otherwise -> Yield c1 (T4 (Just xs) (Just c2) (Just c3) (Just c4))
216+ where
217+ n = ord x
218+ n1 = n - 0x10000
219+ c1 = fromIntegral (shiftR n1 18 + 0xD8)
220+ c2 = fromIntegral (shiftR n1 10)
221+ n2 = n1 .&. 0x3FF
222+ c3 = fromIntegral (shiftR n2 8 + 0xDC)
223+ c4 = fromIntegral n2
224+ next (T4 (Just s) (Just x2) Nothing Nothing) = Yield x2 (T4 (Just s) Nothing Nothing Nothing)
225+ next (T4 (Just s) (Just x2) x3 Nothing) = Yield x2 (T4 (Just s) x3 Nothing Nothing)
226+ next (T4 (Just s) (Just x2) x3 x4) = Yield x2 (T4 (Just s) x3 x4 Nothing)
227+ next _ = internalError "restreamUtf16BE"
228+{-# INLINE restreamUtf16BE #-}
229+
230+restreamUtf16LE :: Stream Char -> Stream Word8
231+restreamUtf16LE (Stream next0 s0 len) =
232+ Stream next (T4 (Just s0) Nothing Nothing Nothing) (len*2)
233+ where
234+ {-# INLINE next #-}
235+ next (T4 (Just s) Nothing Nothing Nothing) = case next0 s of
236+ Done -> Done
237+ Skip s' -> Skip (T4 (Just s') Nothing Nothing Nothing)
238+ Yield x xs
239+ | n < 0x10000 -> Yield (fromIntegral n) (T4 (Just xs) (Just (fromIntegral $ shiftR n 8)) Nothing Nothing)
240+ | otherwise -> Yield c1 (T4 (Just xs) (Just c2) (Just c3) (Just 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 (T4 (Just s) (Just x2) Nothing Nothing) = Yield x2 (T4 (Just s) Nothing Nothing Nothing)
250+ next (T4 (Just s) (Just x2) x3 Nothing) = Yield x2 (T4 (Just s) x3 Nothing Nothing)
251+ next (T4 (Just s) (Just x2) x3 x4) = Yield x2 (T4 (Just s) x3 x4 Nothing)
252+ next _ = internalError "restreamUtf16LE"
253+{-# INLINE restreamUtf16LE #-}
254+
255+restreamUtf32BE :: Stream Char -> Stream Word8
256+restreamUtf32BE (Stream next0 s0 len) =
257+ Stream next (T4 (Just s0) Nothing Nothing Nothing) (len*2)
258+ where
259+ {-# INLINE next #-}
260+ next (T4 (Just s) Nothing Nothing Nothing) = case next0 s of
261+ Done -> Done
262+ Skip s' -> Skip (T4 (Just s') Nothing Nothing Nothing)
263+ Yield x xs -> Yield c1 (T4 (Just xs) (Just c2) (Just c3) (Just 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 (T4 (Just s) (Just x2) Nothing Nothing) = Yield x2 (T4 (Just s) Nothing Nothing Nothing)
271+ next (T4 (Just s) (Just x2) x3 Nothing) = Yield x2 (T4 (Just s) x3 Nothing Nothing)
272+ next (T4 (Just s) (Just x2) x3 x4) = Yield x2 (T4 (Just s) x3 x4 Nothing)
273+ next _ = internalError "restreamUtf32BE"
274+{-# INLINE restreamUtf32BE #-}
275+
276+restreamUtf32LE :: Stream Char -> Stream Word8
277+restreamUtf32LE (Stream next0 s0 len) =
278+ Stream next (T4 (Just s0) Nothing Nothing Nothing) (len*2)
279+ where
280+ {-# INLINE next #-}
281+ next (T4 (Just s) Nothing Nothing Nothing) = case next0 s of
282+ Done -> Done
283+ Skip s' -> Skip (T4 (Just s') Nothing Nothing Nothing)
284+ Yield x xs -> Yield c1 (T4 (Just xs) (Just c2) (Just c3) (Just 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 (T4 (Just s) (Just x2) Nothing Nothing) = Yield x2 (T4 (Just s) Nothing Nothing Nothing)
292+ next (T4 (Just s) (Just x2) x3 Nothing) = Yield x2 (T4 (Just s) x3 Nothing Nothing)
293+ next (T4 (Just s) (Just x2) x3 x4) = Yield x2 (T4 (Just s) x3 x4 Nothing)
294+ next _ = internalError "restreamUtf32LE"
295+{-# INLINE restreamUtf32LE #-}
296+
297+
298+-- | /O(n)/ Convert a 'Stream' 'Word8' to a 'ByteString'.
299+unstream :: Stream Word8 -> ByteString
300+unstream (Stream next s0 len) = unsafePerformIO $ do
301+ fp0 <- mallocByteString len
302+ loop fp0 len 0 s0
303+ where
304+ loop !fp !n !off !s = case next s of
305+ Done -> trimUp fp n off
306+ Skip s' -> loop fp n off s'
307+ Yield x s'
308+ | n == off -> realloc fp n off s' x
309+ | otherwise -> do
310+ withForeignPtr fp $ \p -> pokeByteOff p off x
311+ loop fp n (off+1) s'
312+ {-# NOINLINE realloc #-}
313+ realloc fp n off s x = do
314+ let n' = n+n
315+ fp' <- copy0 fp n n'
316+ withForeignPtr fp' $ \p -> pokeByteOff p off x
317+ loop fp' n' (off+1) s
318+ {-# NOINLINE trimUp #-}
319+ trimUp fp _ off = return $! PS fp 0 off
320+ copy0 :: ForeignPtr Word8 -> Int -> Int -> IO (ForeignPtr Word8)
321+ copy0 !src !srcLen !destLen = assert (srcLen <= destLen) $ do
322+ dest <- mallocByteString destLen
323+ withForeignPtr src $ \src' ->
324+ withForeignPtr dest $ \dest' ->
325+ memcpy dest' src' (fromIntegral destLen)
326+ return dest
327+
328+internalError :: String -> a
329+internalError func =
330+ error $ "Data.Text.Encoding.Fusion." ++ func ++ ": internal error"
Data/Text/Fusion.hs+4−259
@@ -19,14 +19,10 @@ module Data.Text.Fusion
19 -- * Types
19 -- * Types
20 Stream(..)
20 Stream(..)
21 , Step(..)
21 , Step(..)
22− , Encoding(..)
23
22
24 -- * Creation and elimination
23 -- * Creation and elimination
25 , stream
24 , stream
26 , unstream
25 , unstream
27− , stream_bs
28− , unstream_bs
29− , restream
30
26
31 -- * Basic interface
27 -- * Basic interface
32 , cons
28 , cons
@@ -90,33 +86,22 @@ import Prelude hiding
90 foldl1, foldr1, concatMap, any, all, maximum, minimum, take, drop,
86 foldl1, foldr1, concatMap, any, all, maximum, minimum, take, drop,
91 takeWhile, dropWhile, elem, zipWith)
87 takeWhile, dropWhile, elem, zipWith)
92import Data.Char (ord)
88import Data.Char (ord)
93−import Control.Exception (assert)
94import Control.Monad (liftM2)
89import Control.Monad (liftM2)
95import Control.Monad.ST (runST, ST)
90import Control.Monad.ST (runST, ST)
96−import Data.Bits (shiftL, shiftR, (.&.))
91+import Data.Bits (shiftR, (.&.))
97−import qualified Data.ByteString as B
98−import qualified Data.ByteString.Unsafe as B
99−import Data.ByteString.Internal (ByteString(..), mallocByteString, memcpy)
100import qualified Data.List as L
92import qualified Data.List as L
101−import Data.Word (Word8, Word16, Word32)
93+import Data.Word (Word16)
102−import Foreign.ForeignPtr (withForeignPtr, ForeignPtr)
103−import Foreign.Storable (pokeByteOff)
104import GHC.Exts (Int(..), (+#))
94import GHC.Exts (Int(..), (+#))
105−import System.IO.Unsafe (unsafePerformIO)
106import Data.Text.Internal (Text(..), empty)
95import Data.Text.Internal (Text(..), empty)
107−import Data.Text.UnsafeChar (unsafeChr, unsafeChr8, unsafeChr32)
96+import Data.Text.UnsafeChar (unsafeChr)
108import qualified Data.Text.Array as A
97import qualified Data.Text.Array as A
109−import qualified Data.Text.Utf8 as U8
110import qualified Data.Text.Utf16 as U16
98import qualified Data.Text.Utf16 as U16
111−import qualified Data.Text.Utf32 as U32
112
99
113default(Int)
100default(Int)
114
101
115infixl 2 :!:
102infixl 2 :!:
116data PairS a b = !a :!: !b
103data PairS a b = !a :!: !b
117
104
118−data T4 a b c d = T4 !a !b !c !d
119−
120data Switch = S1 | S2
105data Switch = S1 | S2
121
106
122data Stream a = forall s. Stream (s -> Step s a) !s {-# UNPACK #-}!Int
107data Stream a = forall s. Stream (s -> Step s a) !s {-# UNPACK #-}!Int
@@ -125,9 +110,6 @@ data Step s a = Done
125 | Skip !s
110 | Skip !s
126 | Yield !a !s
111 | Yield !a !s
127
112
128−data Encoding = ASCII | Utf8 | Utf16BE | Utf16LE | Utf32BE | Utf32LE
129− deriving (Read, Show, Eq)
130−
131-- | /O(n)/ Convert a Text into a Stream Char.
113-- | /O(n)/ Convert a Text into a Stream Char.
132stream :: Text -> Stream Char
114stream :: Text -> Stream Char
133stream (Text arr off len) = Stream next off len
115stream (Text arr off len) = Stream next off len
@@ -176,6 +158,7 @@ unstream (Stream next0 s0 len) = Text (fst a) 0 (snd a)
176 r :: Word16
158 r :: Word16
177 r = fromIntegral $ (m .&. (0x3FF :: Int)) + (0xDC00 :: Int)
159 r = fromIntegral $ (m .&. (0x3FF :: Int)) + (0xDC00 :: Int)
178{-# INLINE [0] unstream #-}
160{-# INLINE [0] unstream #-}
161+{-# RULES "STREAM stream/unstream fusion" forall s. stream (unstream s) = s #-}
179
162
180
163
181copy :: A.MArray s Word16 -> A.MArray s Word16 -> ST s ()
164copy :: A.MArray s Word16 -> A.MArray s Word16 -> ST s ()
@@ -201,247 +184,9 @@ eq (Stream next1 s1 _) (Stream next2 s2 _) = cmp (next1 s1) (next2 s2)
201 cmp (next1 s1') (next2 s2')
184 cmp (next1 s1') (next2 s2')
202{-# SPECIALISE eq :: Stream Char -> Stream Char -> Bool #-}
185{-# SPECIALISE eq :: Stream Char -> Stream Char -> Bool #-}
203
186
204−-- | /O(n) Convert a ByteString into a Stream Char, using the specified encoding standard.
205−stream_bs :: Encoding -> ByteString -> Stream Char
206−stream_bs ASCII bs = Stream next 0 l
207− where
208− l = B.length bs
209− {-# INLINE next #-}
210− next i
211− | i >= l = Done
212− | otherwise = Yield (unsafeChr8 x1) (i+1)
213− where
214− x1 = B.unsafeIndex bs i
215−stream_bs Utf8 bs = Stream next 0 l
216− where
217− l = B.length bs
218− {-# INLINE next #-}
219− next i
220− | i >= l = Done
221− | U8.validate1 x1 = Yield (unsafeChr8 x1) (i+1)
222− | i+1 < l && U8.validate2 x1 x2 = Yield (U8.chr2 x1 x2) (i+2)
223− | i+2 < l && U8.validate3 x1 x2 x3 = Yield (U8.chr3 x1 x2 x3) (i+3)
224− | i+3 < l && U8.validate4 x1 x2 x3 x4 = Yield (U8.chr4 x1 x2 x3 x4) (i+4)
225− | otherwise = error "bsStream: bad UTF-8 stream"
226− where
227− x1 = idx i
228− x2 = idx (i + 1)
229− x3 = idx (i + 2)
230− x4 = idx (i + 3)
231− idx = B.unsafeIndex bs
232−stream_bs Utf16LE bs = Stream next 0 l
233− where
234− l = B.length bs
235− {-# INLINE next #-}
236− next i
237− | i >= l = Done
238− | i+1 < l && U16.validate1 x1 = Yield (unsafeChr x1) (i+2)
239− | i+3 < l && U16.validate2 x1 x2 = Yield (U16.chr2 x1 x2) (i+4)
240− | otherwise = error $ "bsStream: bad UTF-16LE stream"
241− where
242− x1 = (shiftL (idx (i + 1)) 8) + (idx i)
243− x2 = (shiftL (idx (i + 3)) 8) + (idx (i + 2))
244− idx = fromIntegral . B.unsafeIndex bs :: Int -> Word16
245−stream_bs Utf16BE bs = Stream next 0 l
246− where
247− l = B.length bs
248− {-# INLINE next #-}
249− next i
250− | i >= l = Done
251− | i+1 < l && U16.validate1 x1 = Yield (unsafeChr x1) (i+2)
252− | i+3 < l && U16.validate2 x1 x2 = Yield (U16.chr2 x1 x2) (i+4)
253− | otherwise = error $ "bsStream: bad UTF16-BE stream "
254− where
255− x1 = (shiftL (idx i) 8) + (idx (i + 1))
256− x2 = (shiftL (idx (i + 2)) 8) + (idx (i + 3))
257− idx = fromIntegral . B.unsafeIndex bs :: Int -> Word16
258−stream_bs Utf32BE bs = Stream next 0 l
259− where
260− l = B.length bs
261− {-# INLINE next #-}
262− next i
263− | i >= l = Done
264− | i+3 < l && U32.validate x = Yield (unsafeChr32 x) (i+4)
265− | otherwise = error "bsStream: bad UTF-32BE stream"
266− where
267− x = shiftL x1 24 + shiftL x2 16 + shiftL x3 8 + x4
268− x1 = idx i
269− x2 = idx (i+1)
270− x3 = idx (i+2)
271− x4 = idx (i+3)
272− idx = fromIntegral . B.unsafeIndex bs :: Int -> Word32
273−stream_bs Utf32LE bs = Stream next 0 l
274− where
275− l = B.length bs
276− {-# INLINE next #-}
277− next i
278− | i >= l = Done
279− | i+3 < l && U32.validate x = Yield (unsafeChr32 x) (i+4)
280− | otherwise = error "bsStream: bad UTF-32LE stream"
281− where
282− x = shiftL x4 24 + shiftL x3 16 + shiftL x2 8 + x1
283− x1 = idx i
284− x2 = idx $ i+1
285− x3 = idx $ i+2
286− x4 = idx $ i+3
287− idx = fromIntegral . B.unsafeIndex bs :: Int -> Word32
288−{-# INLINE [0] stream_bs #-}
289−
290internalError :: String -> a
187internalError :: String -> a
291internalError func = error $ "Data.Text.Fusion." ++ func ++ ": internal error"
188internalError func = error $ "Data.Text.Fusion." ++ func ++ ": internal error"
292
189
293−-- | /O(n)/ Convert a Stream Char into a Stream Word8 using the specified encoding standard.
294−restream :: Encoding -> Stream Char -> Stream Word8
295−restream ASCII (Stream next0 s0 len) = Stream next s0 (len*2)
296− where
297− next !s = case next0 s of
298− Done -> Done
299− Skip s' -> Skip s'
300− Yield x xs -> Yield x' xs
301− where x' = fromIntegral (ord x) :: Word8
302−restream Utf8 (Stream next0 s0 len) =
303− Stream next (T4 (Just s0) Nothing Nothing Nothing) (len*2)
304− where
305− {-# INLINE next #-}
306− next (T4 (Just s) Nothing Nothing Nothing) = case next0 s of
307− Done -> Done
308− Skip s' -> Skip (T4 (Just s') Nothing Nothing Nothing)
309− Yield x xs
310− | n <= 0x7F -> Yield c (T4 (Just xs) Nothing Nothing Nothing)
311− | n <= 0x07FF -> Yield (fst c2) (T4 (Just xs) (Just $ snd c2) Nothing Nothing)
312− | n <= 0xFFFF -> Yield (fst3 c3) (T4 (Just xs) (Just $ snd3 c3) (Just $ trd3 c3) Nothing)
313− | otherwise -> Yield (fst4 c4) (T4 (Just xs) (Just $ snd4 c4) (Just $ trd4 c4) (Just $ fth4 c4))
314− where
315− n = ord x
316− c = fromIntegral n
317− c2 = U8.ord2 x
318− c3 = U8.ord3 x
319− c4 = U8.ord4 x
320− fst3 (x1,_,_) = x1
321− snd3 (_,x2,_) = x2
322− trd3 (_,_,x3) = x3
323− fst4 (x1,_,_,_) = x1
324− snd4 (_,x2,_,_) = x2
325− trd4 (_,_,x3,_) = x3
326− fth4 (_,_,_,x4) = x4
327− next (T4 (Just s) (Just x2) Nothing Nothing) = Yield x2 (T4 (Just s) Nothing Nothing Nothing)
328− next (T4 (Just s) (Just x2) x3 Nothing) = Yield x2 (T4 (Just s) x3 Nothing Nothing)
329− next (T4 (Just s) (Just x2) x3 x4) = Yield x2 (T4 (Just s) x3 x4 Nothing)
330− next _ = internalError "restream Utf8"
331−restream Utf16BE (Stream next0 s0 len) =
332− Stream next (T4 (Just s0) Nothing Nothing Nothing) (len*2)
333− where
334− {-# INLINE next #-}
335− next (T4 (Just s) Nothing Nothing Nothing) = case next0 s of
336− Done -> Done
337− Skip s' -> Skip (T4 (Just s') Nothing Nothing Nothing)
338− Yield x xs
339− | n < 0x10000 -> Yield (fromIntegral $ shiftR n 8) (T4 (Just xs) (Just (fromIntegral n)) Nothing Nothing)
340− | otherwise -> Yield c1 (T4 (Just xs) (Just c2) (Just c3) (Just c4))
341− where
342− n = ord x
343− n1 = n - 0x10000
344− c1 = fromIntegral (shiftR n1 18 + 0xD8)
345− c2 = fromIntegral (shiftR n1 10)
346− n2 = n1 .&. 0x3FF
347− c3 = fromIntegral (shiftR n2 8 + 0xDC)
348− c4 = fromIntegral n2
349− next (T4 (Just s) (Just x2) Nothing Nothing) = Yield x2 (T4 (Just s) Nothing Nothing Nothing)
350− next (T4 (Just s) (Just x2) x3 Nothing) = Yield x2 (T4 (Just s) x3 Nothing Nothing)
351− next (T4 (Just s) (Just x2) x3 x4) = Yield x2 (T4 (Just s) x3 x4 Nothing)
352− next _ = internalError "restream Utf16BE"
353−restream Utf16LE (Stream next0 s0 len) =
354− Stream next (T4 (Just s0) Nothing Nothing Nothing) (len*2)
355− where
356− {-# INLINE next #-}
357− next (T4 (Just s) Nothing Nothing Nothing) = case next0 s of
358− Done -> Done
359− Skip s' -> Skip (T4 (Just s') Nothing Nothing Nothing)
360− Yield x xs
361− | n < 0x10000 -> Yield (fromIntegral n) (T4 (Just xs) (Just (fromIntegral $ shiftR n 8)) Nothing Nothing)
362− | otherwise -> Yield c1 (T4 (Just xs) (Just c2) (Just c3) (Just c4))
363− where
364− n = ord x
365− n1 = n - 0x10000
366− c2 = fromIntegral (shiftR n1 18 + 0xD8)
367− c1 = fromIntegral (shiftR n1 10)
368− n2 = n1 .&. 0x3FF
369− c4 = fromIntegral (shiftR n2 8 + 0xDC)
370− c3 = fromIntegral n2
371− next (T4 (Just s) (Just x2) Nothing Nothing) = Yield x2 (T4 (Just s) Nothing Nothing Nothing)
372− next (T4 (Just s) (Just x2) x3 Nothing) = Yield x2 (T4 (Just s) x3 Nothing Nothing)
373− next (T4 (Just s) (Just x2) x3 x4) = Yield x2 (T4 (Just s) x3 x4 Nothing)
374− next _ = internalError "restream Utf16LE"
375−restream Utf32BE (Stream next0 s0 len) =
376− Stream next (T4 (Just s0) Nothing Nothing Nothing) (len*2)
377− where
378− {-# INLINE next #-}
379− next (T4 (Just s) Nothing Nothing Nothing) = case next0 s of
380− Done -> Done
381− Skip s' -> Skip (T4 (Just s') Nothing Nothing Nothing)
382− Yield x xs -> Yield c1 (T4 (Just xs) (Just c2) (Just c3) (Just c4))
383− where
384− n = ord x
385− c1 = fromIntegral $ shiftR n 24
386− c2 = fromIntegral $ shiftR n 16
387− c3 = fromIntegral $ shiftR n 8
388− c4 = fromIntegral n
389− next (T4 (Just s) (Just x2) Nothing Nothing) = Yield x2 (T4 (Just s) Nothing Nothing Nothing)
390− next (T4 (Just s) (Just x2) x3 Nothing) = Yield x2 (T4 (Just s) x3 Nothing Nothing)
391− next (T4 (Just s) (Just x2) x3 x4) = Yield x2 (T4 (Just s) x3 x4 Nothing)
392− next _ = internalError "restream Utf32BE"
393−restream Utf32LE (Stream next0 s0 len) =
394− Stream next (T4 (Just s0) Nothing Nothing Nothing) (len*2)
395− where
396− {-# INLINE next #-}
397− next (T4 (Just s) Nothing Nothing Nothing) = case next0 s of
398− Done -> Done
399− Skip s' -> Skip (T4 (Just s') Nothing Nothing Nothing)
400− Yield x xs -> Yield c1 (T4 (Just xs) (Just c2) (Just c3) (Just c4))
401− where
402− n = ord x
403− c4 = fromIntegral $ shiftR n 24
404− c3 = fromIntegral $ shiftR n 16
405− c2 = fromIntegral $ shiftR n 8
406− c1 = fromIntegral n
407− next (T4 (Just s) (Just x2) Nothing Nothing) = Yield x2 (T4 (Just s) Nothing Nothing Nothing)
408− next (T4 (Just s) (Just x2) x3 Nothing) = Yield x2 (T4 (Just s) x3 Nothing Nothing)
409− next (T4 (Just s) (Just x2) x3 x4) = Yield x2 (T4 (Just s) x3 x4 Nothing)
410− next _ = internalError "restream Utf32LE"
411−{-# INLINE restream #-}
412−
413−
414−-- | /O(n)/ Convert a Stream Word8 to a ByteString
415−unstream_bs :: Stream Word8 -> ByteString
416−unstream_bs (Stream next s0 len) = unsafePerformIO $ do
417− fp0 <- mallocByteString len
418− loop fp0 len 0 s0
419− where
420− loop !fp !n !off !s = case next s of
421− Done -> trimUp fp n off
422− Skip s' -> loop fp n off s'
423− Yield x s'
424− | n == off -> realloc fp n off s' x
425− | otherwise -> do
426− withForeignPtr fp $ \p -> pokeByteOff p off x
427− loop fp n (off+1) s'
428− {-# NOINLINE realloc #-}
429− realloc fp n off s x = do
430− let n' = n+n
431− fp' <- copy0 fp n n'
432− withForeignPtr fp' $ \p -> pokeByteOff p off x
433− loop fp' n' (off+1) s
434− {-# NOINLINE trimUp #-}
435− trimUp fp _ off = return $! PS fp 0 off
436− copy0 :: ForeignPtr Word8 -> Int -> Int -> IO (ForeignPtr Word8)
437− copy0 !src !srcLen !destLen = assert (srcLen <= destLen) $ do
438− dest <- mallocByteString destLen
439− withForeignPtr src $ \src' ->
440− withForeignPtr dest $ \dest' ->
441− memcpy dest' src' (fromIntegral destLen)
442− return dest
443−{-# RULES "STREAM stream/unstream fusion" forall s. stream (unstream s) = s #-}
444−
445-- ----------------------------------------------------------------------------
190-- ----------------------------------------------------------------------------
446-- * Basic stream functions
191-- * Basic stream functions
447
192
tests/Bench.hs+2−2
@@ -12,9 +12,9 @@ import Text.Printf
12import Control.Exception
12import Control.Exception
13
13
14import qualified Data.Text as T
14import qualified Data.Text as T
15+import qualified Data.Text.Encoding as E
15import Data.Text.Internal
16import Data.Text.Internal
16import qualified Data.Text.Fusion as S
17import qualified Data.Text.Fusion as S
17−import Data.Text.Fusion (Encoding(..))
18
18
19import qualified Data.List as L
19import qualified Data.List as L
20import qualified Data.ByteString.Char8 as B
20import qualified Data.ByteString.Char8 as B
@@ -24,7 +24,7 @@ import Data.Word
24import qualified System.IO.UTF8 as UTF8
24import qualified System.IO.UTF8 as UTF8
25
25
26main = do ascii_bs <- B.readFile "text/test/ascii.txt"
26main = do ascii_bs <- B.readFile "text/test/ascii.txt"
27− let ascii_txt = T.decode ASCII ascii_bs
27+ let ascii_txt = E.decodeASCII ascii_bs
28 let ascii_str = T.unpack ascii_txt
28 let ascii_str = T.unpack ascii_txt
29 force (ascii_txt,ascii_str,ascii_bs)
29 force (ascii_txt,ascii_str,ascii_bs)
30 printf " # Text\t\tString\tByteString\n"
30 printf " # Text\t\tString\tByteString\n"
text.cabal+2
@@ -18,6 +18,8 @@ library
18 exposed-modules:
18 exposed-modules:
19 Data.Text
19 Data.Text
20 Data.Text.Array
20 Data.Text.Array
21+ Data.Text.Encoding
22+ Data.Text.Encoding.Fusion
21 Data.Text.UnsafeChar
23 Data.Text.UnsafeChar
22 Data.Text.Internal
24 Data.Text.Internal
23 Data.Text.Fusion
25 Data.Text.Fusion