git.iko.soy/text
on master help sign in
Write a faster UTF-8 decoder
2189300Bryan O'Sullivan
Data/Text/Encoding.hs+48−4
compare with master
unifiedsplit
@@ -22,12 +22,14 @@ module Data.Text.Encoding
22 -- * Decoding ByteStrings to Text
22 -- * Decoding ByteStrings to Text
23 decodeASCII
23 decodeASCII
24 , decodeUtf8
24 , decodeUtf8
25+ , decodeUtf8'
25 , decodeUtf16LE
26 , decodeUtf16LE
26 , decodeUtf16BE
27 , decodeUtf16BE
27 , decodeUtf32LE
28 , decodeUtf32LE
28 , decodeUtf32BE
29 , decodeUtf32BE
29 -- ** Controllable error handling
30 -- ** Controllable error handling
30 , decodeUtf8With
31 , decodeUtf8With
32+ , decodeUtf8With'
31 , decodeUtf16LEWith
33 , decodeUtf16LEWith
32 , decodeUtf16BEWith
34 , decodeUtf16BEWith
33 , decodeUtf32LEWith
35 , decodeUtf32LEWith
@@ -44,10 +46,10 @@ module Data.Text.Encoding
44import Data.Bits ((.&.))
46import Data.Bits ((.&.))
45import Data.ByteString as B
47import Data.ByteString as B
46import Data.ByteString.Internal as B
48import Data.ByteString.Internal as B
49+import Data.ByteString.Unsafe as B
47import Data.Text.Encoding.Error (OnDecodeError, strictDecode)
50import Data.Text.Encoding.Error (OnDecodeError, strictDecode)
48−import Data.Text.Encoding.Utf16 (chr2)
51+import Data.Text.Internal (Text(..), textP)
49−import Data.Text.Internal (Text(..))
50−import Data.Text.UnsafeChar (ord)
52+import Data.Text.UnsafeChar (ord, unsafeWrite)
51import Data.Text.UnsafeShift (shiftL, shiftR)
53import Data.Text.UnsafeShift (shiftL, shiftR)
52import Data.Word (Word8)
54import Data.Word (Word8)
53import Foreign.ForeignPtr (withForeignPtr)
55import Foreign.ForeignPtr (withForeignPtr)
@@ -56,6 +58,8 @@ import Foreign.Storable (poke)
56import System.IO.Unsafe (unsafePerformIO)
58import System.IO.Unsafe (unsafePerformIO)
57import qualified Data.Text.Array as A
59import qualified Data.Text.Array as A
58import qualified Data.Text.Encoding.Fusion as E
60import qualified Data.Text.Encoding.Fusion as E
61+import qualified Data.Text.Encoding.Utf16 as U16
62+import qualified Data.Text.Encoding.Utf8 as U8
59import qualified Data.Text.Fusion as F
63import qualified Data.Text.Fusion as F
60
64
61-- | Decode a 'ByteString' containing 7-bit ASCII encoded text.
65-- | Decode a 'ByteString' containing 7-bit ASCII encoded text.
@@ -73,6 +77,46 @@ decodeUtf8 :: ByteString -> Text
73decodeUtf8 = decodeUtf8With strictDecode
77decodeUtf8 = decodeUtf8With strictDecode
74{-# INLINE decodeUtf8 #-}
78{-# INLINE decodeUtf8 #-}
75
79
80+decodeUtf8With' :: OnDecodeError -> ByteString -> Text
81+decodeUtf8With' onErr bs = textP (fst a) 0 (snd a)
82+ where
83+ a = A.run2 (A.new len >>= outer 0 0)
84+ len = B.length bs
85+ outer n0 m0 arr = go n0 m0
86+ where
87+ go !n !m = do
88+ let x1 = idx m
89+ x2 = idx (m + 1)
90+ x3 = idx (m + 2)
91+ x4 = idx (m + 3)
92+ idx = B.unsafeIndex bs
93+ case undefined of
94+ _| m >= len -> return (arr,n)
95+ | U8.validate1 x1 -> do
96+ A.unsafeWrite arr n (fromIntegral x1)
97+ go (n+1) (m+1)
98+ | m+1 < len && U8.validate2 x1 x2 -> do
99+ w <- unsafeWrite arr n (U8.chr2 x1 x2)
100+ go (n+w) (m+2)
101+ | m+2 < len && U8.validate3 x1 x2 x3 -> do
102+ w <- unsafeWrite arr n (U8.chr3 x1 x2 x3)
103+ go (n+w) (m+3)
104+ | m+3 < len && U8.validate4 x1 x2 x3 x4 -> do
105+ w <- unsafeWrite arr n (U8.chr4 x1 x2 x3 x4)
106+ go (n+w) (m+4)
107+ | otherwise -> case onErr desc (Just x1) of
108+ Nothing -> go n (m+1)
109+ Just c -> do
110+ w <- unsafeWrite arr n c
111+ go (n+w) (m+1)
112+ desc = "Data.Text.Encoding.encodeUtf8: Invalid UTF-8 stream"
113+{-# INLINE decodeUtf8With' #-}
114+
115+-- | Decode a 'ByteString' containing UTF-8 encoded text.
116+decodeUtf8' :: ByteString -> Text
117+decodeUtf8' = decodeUtf8With' strictDecode
118+{-# INLINE decodeUtf8' #-}
119+
76-- | Encode text using UTF-8 encoding.
120-- | Encode text using UTF-8 encoding.
77encodeUtf8 :: Text -> ByteString
121encodeUtf8 :: Text -> ByteString
78encodeUtf8 (Text arr off len) = unsafePerformIO $ do
122encodeUtf8 (Text arr off len) = unsafePerformIO $ do
@@ -102,7 +146,7 @@ encodeUtf8 (Text arr off len) = unsafePerformIO $ do
102 poke8 (m+1) $ (w .&. 0x3f) + 0x80
146 poke8 (m+1) $ (w .&. 0x3f) + 0x80
103 go (n+1) (m+2)
147 go (n+1) (m+2)
104 | 0xD800 <= w && w <= 0xDBFF -> do
148 | 0xD800 <= w && w <= 0xDBFF -> do
105− let c = ord $ chr2 w (A.unsafeIndex arr (n+1))
149+ let c = ord $ U16.chr2 w (A.unsafeIndex arr (n+1))
106 poke8 m $ (c `shiftR` 18) + 0xF0
150 poke8 m $ (c `shiftR` 18) + 0xF0
107 poke8 (m+1) $ ((c `shiftR` 12) .&. 0x3F) + 0x80
151 poke8 (m+1) $ ((c `shiftR` 12) .&. 0x3F) + 0x80
108 poke8 (m+2) $ ((c `shiftR` 6) .&. 0x3F) + 0x80
152 poke8 (m+2) $ ((c `shiftR` 6) .&. 0x3F) + 0x80
tests/benchmarks/DecodeUtf8.hs+5
@@ -15,6 +15,10 @@ strict h = do
15 bs <- B.hGetContents h
15 bs <- B.hGetContents h
16 rnf (T.decodeUtf8 bs) `seq` return ()
16 rnf (T.decodeUtf8 bs) `seq` return ()
17
17
18+strict_ h = do
19+ bs <- B.hGetContents h
20+ rnf (T.decodeUtf8' bs) `seq` return ()
21+
18strict_io h = do
22strict_io h = do
19 hSetEncoding h utf8
23 hSetEncoding h utf8
20 t <- T.hGetContents h
24 t <- T.hGetContents h
@@ -39,6 +43,7 @@ main = do
39 h <- openFile name ReadMode
43 h <- openFile name ReadMode
40 case kind of
44 case kind of
41 "strict" -> strict h
45 "strict" -> strict h
46+ "strict_" -> strict_ h
42 "strict_io" -> strict_io h
47 "strict_io" -> strict_io h
43 "lazy" -> lazy h
48 "lazy" -> lazy h
44 "lazy_io" -> lazy_io h
49 "lazy_io" -> lazy_io h