@@ -19,14 +19,10 @@ module Data.Text.Fusion
1919 -- * Types
2020 Stream(..)
2121 , Step(..)
22− , Encoding(..)
2322
2423 -- * Creation and elimination
2524 , stream
2625 , unstream
27− , stream_bs
28− , unstream_bs
29− , restream
3026
3127 -- * Basic interface
3228 , cons
@@ -90,33 +86,22 @@ import Prelude hiding
9086 foldl1, foldr1, concatMap, any, all, maximum, minimum, take, drop,
9187 takeWhile, dropWhile, elem, zipWith)
9288import Data.Char (ord)
93−import Control.Exception (assert)
9489import Control.Monad (liftM2)
9590import Control.Monad.ST (runST, ST)
96−import Data.Bits (shiftL, shiftR, (.&.))
97−import qualified Data.ByteString as B
98−import qualified Data.ByteString.Unsafe as B
99−import Data.ByteString.Internal (ByteString(..), mallocByteString, memcpy)
91+import Data.Bits (shiftR, (.&.))
10092import qualified Data.List as L
101−import Data.Word (Word8, Word16, Word32)
102−import Foreign.ForeignPtr (withForeignPtr, ForeignPtr)
103−import Foreign.Storable (pokeByteOff)
93+import Data.Word (Word16)
10494import GHC.Exts (Int(..), (+#))
105−import System.IO.Unsafe (unsafePerformIO)
10695import Data.Text.Internal (Text(..), empty)
107−import Data.Text.UnsafeChar (unsafeChr, unsafeChr8, unsafeChr32)
96+import Data.Text.UnsafeChar (unsafeChr)
10897import qualified Data.Text.Array as A
109−import qualified Data.Text.Utf8 as U8
11098import qualified Data.Text.Utf16 as U16
111−import qualified Data.Text.Utf32 as U32
11299
113100default(Int)
114101
115102infixl 2 :!:
116103data PairS a b = !a :!: !b
117104
118−data T4 a b c d = T4 !a !b !c !d
119−
120105data Switch = S1 | S2
121106
122107data Stream a = forall s. Stream (s -> Step s a) !s {-# UNPACK #-}!Int
@@ -125,9 +110,6 @@ data Step s a = Done
125110 | Skip !s
126111 | Yield !a !s
127112
128−data Encoding = ASCII | Utf8 | Utf16BE | Utf16LE | Utf32BE | Utf32LE
129− deriving (Read, Show, Eq)
130−
131113-- | /O(n)/ Convert a Text into a Stream Char.
132114stream :: Text -> Stream Char
133115stream (Text arr off len) = Stream next off len
@@ -176,6 +158,7 @@ unstream (Stream next0 s0 len) = Text (fst a) 0 (snd a)
176158 r :: Word16
177159 r = fromIntegral $ (m .&. (0x3FF :: Int)) + (0xDC00 :: Int)
178160{-# INLINE [0] unstream #-}
161+{-# RULES "STREAM stream/unstream fusion" forall s. stream (unstream s) = s #-}
179162
180163
181164copy :: 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)
201184 cmp (next1 s1') (next2 s2')
202185{-# SPECIALISE eq :: Stream Char -> Stream Char -> Bool #-}
203186
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−
290187internalError :: String -> a
291188internalError func = error $ "Data.Text.Fusion." ++ func ++ ": internal error"
292189
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−
445190-- ----------------------------------------------------------------------------
446191-- * Basic stream functions
447192