@@ -1,3 +1,5 @@
1+{-# LANGUAGE BangPatterns #-}
2+
13-- |
24-- Module : Data.Text.Lazy.Encoding.Fusion
35-- Copyright : (c) Bryan O'Sullivan 2009
@@ -22,46 +24,107 @@ module Data.Text.Lazy.Encoding.Fusion
2224 --, streamUtf32BE
2325
2426 -- * Unstreaming
25− --, unstream
27+ , unstream
2628
2729 , module Data.Text.Encoding.Fusion.Common
2830 ) where
2931
30−import Data.ByteString.Lazy.Internal (ByteString(..))
32+import Data.ByteString.Lazy.Internal (ByteString(..), defaultChunkSize)
3133import qualified Data.ByteString as B
3234import qualified Data.ByteString.Unsafe as B
3335import Data.Text.Encoding.Fusion.Common
3436import Data.Text.Fusion (Step(..), Stream(..))
35−import Data.Text.Fusion.Internal (PairS(..))
37+import Data.Text.Fusion.Internal (M(..), PairS(..), S(..))
3638import Data.Text.UnsafeChar (unsafeChr, unsafeChr8, unsafeChr32)
39+import Data.Word (Word8)
3740import qualified Data.Text.Encoding.Utf8 as U8
41+import System.IO.Unsafe (unsafePerformIO)
42+import Foreign.ForeignPtr (withForeignPtr, ForeignPtr)
43+import Foreign.Storable (pokeByteOff)
44+import Data.ByteString.Internal (mallocByteString, memcpy)
45+import Control.Exception (assert)
46+import qualified Data.ByteString.Internal as B
3847
3948unknownLength :: Int
4049unknownLength = 4
4150
42−-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using UTF-8
43−-- encoding.
51+-- | /O(n)/ Convert a lazy 'ByteString' into a 'Stream Char', using
52+-- UTF-8 encoding.
4453streamUtf8 :: ByteString -> Stream Char
45−streamUtf8 bs0 = Stream next (bs0 :!: 0) unknownLength
54+streamUtf8 bs0 = Stream next (bs0 :!: S N N N N :!: 0) unknownLength
4655 where
4756 {-# INLINE next #-}
48− next (c@(Chunk bs rest) :!: i)
49− | i >= l = next (rest :!: 0)
50− | U8.validate1 x1 = Yield (unsafeChr8 x1) (c :!: i+1)
51− | i+1 < l && U8.validate2 x1 x2 = Yield (U8.chr2 x1 x2) (c :!: i+2)
52− | i+2 < l && U8.validate3 x1 x2 x3 = Yield (U8.chr3 x1 x2 x3) (c :!: i+3)
53− | i+3 < l && U8.validate4 x1 x2 x3 x4 = Yield (U8.chr4 x1 x2 x3 x4) (c :!: i+4)
54− | otherwise = encodingError "UTF-8"
55− where
56− x1 = idx i
57− x2 = idx (i + 1)
58− x3 = idx (i + 2)
59− x4 = idx (i + 3)
60− idx = B.unsafeIndex bs
61− l = B.length bs
62− next (Empty :!: _) = Done
57+ next st@(bs :!: s :!: i) =
58+ case s of
59+ S (J a) N N N | U8.validate1 a ->
60+ Yield (unsafeChr8 a) es
61+ S (J a) (J b) N N | U8.validate2 a b ->
62+ Yield (U8.chr2 a b) es
63+ S (J a) (J b) (J c) N | U8.validate3 a b c ->
64+ Yield (U8.chr3 a b c) es
65+ S (J a) (J b) (J c) (J d) | U8.validate4 a b c d ->
66+ Yield (U8.chr4 a b c d) es
67+ _ -> consume st
68+ where es = bs :!: S N N N N :!: i
69+ {-# INLINE consume #-}
70+ consume (c@(Chunk bs rest) :!: s :!: i)
71+ | i >= len = consume (rest :!: s :!: 0)
72+ | otherwise = next (c :!: s' :!: i+1)
73+ where s' = case s of
74+ S N _ _ _ -> S x N N N
75+ S a N _ _ -> S a x N N
76+ S a b N _ -> S a b x N
77+ S a b c N -> S a b c x
78+ _ -> encodingError "streamUtf8" "UTF-8"
79+ x = J (B.unsafeIndex bs i)
80+ len = B.length bs
81+ consume (Empty :!: S N _ _ _ :!: _) = Done
82+ consume _ = encodingError "streamUtf8" "UTF-8"
6383{-# INLINE [0] streamUtf8 #-}
6484
65−encodingError :: String -> a
66−encodingError encoding =
67− error $ "Data.Text.Lazy.Encoding.Fusion: Bad " ++ encoding ++ " stream"
85+-- | /O(n)/ Convert a 'Stream' 'Word8' to a lazy 'ByteString'.
86+unstreamChunks :: Int -> Stream Word8 -> ByteString
87+unstreamChunks chunkSize (Stream next s0 len) = chunk s0 len
88+ where chunk s0 len = unsafePerformIO $ do
89+ let safeLen = min (max len unknownLength) chunkSize
90+ fp0 <- mallocByteString safeLen
91+ loop fp0 safeLen 0 s0
92+ where
93+ loop !fp !n !off !s = case next s of
94+ Done | off == 0 -> return Empty
95+ | otherwise -> do
96+ bs <- trimUp fp off
97+ return $! Chunk bs Empty
98+ Skip s' -> loop fp n off s'
99+ Yield x s'
100+ | off == chunkSize -> do
101+ bs <- trimUp fp off
102+ return (Chunk bs (chunk s (len - B.length bs)))
103+ | off == n -> realloc fp n off s' x
104+ | otherwise -> do
105+ withForeignPtr fp $ \p -> pokeByteOff p off x
106+ loop fp n (off+1) s'
107+ {-# NOINLINE realloc #-}
108+ realloc fp n off s x = do
109+ let n' = min (n+n) chunkSize
110+ fp' <- copy0 fp n n'
111+ withForeignPtr fp' $ \p -> pokeByteOff p off x
112+ loop fp' n' (off+1) s
113+ {-# NOINLINE trimUp #-}
114+ trimUp fp off = return $! B.PS fp 0 off
115+ copy0 :: ForeignPtr Word8 -> Int -> Int -> IO (ForeignPtr Word8)
116+ copy0 !src !srcLen !destLen = assert (srcLen <= destLen) $ do
117+ dest <- mallocByteString destLen
118+ withForeignPtr src $ \src' ->
119+ withForeignPtr dest $ \dest' ->
120+ memcpy dest' src' (fromIntegral srcLen)
121+ return dest
122+
123+-- | /O(n)/ Convert a 'Stream' 'Word8' to a lazy 'ByteString'.
124+unstream :: Stream Word8 -> ByteString
125+unstream = unstreamChunks 64
126+
127+encodingError :: String -> String -> a
128+encodingError func encoding =
129+ error $ "Data.Text.Lazy.Encoding.Fusion." ++ func ++ ": Bad " ++
130+ encoding ++ " stream"