@@ -1,84 +0,0 @@
1−{-# LANGUAGE BangPatterns #-}
2−
3−module Data.Text.Utf8.Fusion where
4−
5−import Data.Array.Base
6−import Data.Word
7−import Control.Monad.ST
8−import Data.Text.UnsafeChar
9−import Control.Monad
10−import Data.Char
11−
12−import Data.Text.Utf8
13−import Data.Text.Utf8.Internal
14−import Data.Text.Fusion hiding (stream,unstream)
15−
16−stream :: Text -> Stream Char
17−stream (Text arr off len) = Stream next off len
18− where
19− end = off+len
20− {-# INLINE next #-}
21− next !i
22− | i >= end = Done
23− | n <= 0x7F = Yield (unsafeChr8 n) (i + 1)
24− | n <= 0xDF = Yield (chr2 n n2) (i + 2)
25− | n <= 0xEF = Yield (chr3 n n2 n3) (i + 3)
26− | otherwise = Yield (chr4 n n2 n3 n4) (i + 4)
27− where
28− n = arr `unsafeAt` i
29− n2 = arr `unsafeAt` (i + 1)
30− n3 = arr `unsafeAt` (i + 2)
31− n4 = arr `unsafeAt` (i + 3)
32−{-# INLINE [0] stream #-}
33−
34−
35−unstream :: Stream Char -> Text
36−unstream (Stream next0 s0 len) = x `seq` (Text (fst x) 0 (snd x))
37− where
38− x :: ((UArray Int Word8), Int)
39− x = runST ((unsafeNewArray_ (0,len+4) :: ST s (STUArray s Int Word8))
40− >>= (\arr -> loop arr 0 (len+4) s0))
41− loop !arr !i !max !s
42− | i + 4 > max = do arr' <- unsafeNewArray_ (0,max*2)
43− copy arr arr'
44− loop arr' i (max*2) s
45− | otherwise = case next0 s of
46− Done -> liftM2 (,) (unsafeFreezeSTUArray arr) (return i)
47− Skip s' -> loop arr i max s'
48− Yield x s'
49− | n <= 0x7F -> do
50− unsafeWrite arr i n
51− loop arr (i+1) max s'
52− | n <= 0x07FF -> do
53− unsafeWrite arr i (fst n2)
54− unsafeWrite arr (i+1) (snd n2)
55− loop arr (i+2) max s'
56− | n <= 0xFFFF -> do
57− unsafeWrite arr i (fst3 n3)
58− unsafeWrite arr (i+1) (snd3 n3)
59− unsafeWrite arr (i+2) (trd3 n3)
60− loop arr (i+3) max s'
61− | otherwise -> do
62− unsafeWrite arr i (fst4 n4)
63− unsafeWrite arr (i+1) (snd4 n4)
64− unsafeWrite arr (i+2) (trd4 n4)
65− unsafeWrite arr (i+3) (fth4 n4)
66− loop arr (i+4) max s'
67− where
68− n = (fromIntegral . ord) x :: Word8
69− n2 = ord2 x
70− n3 = ord3 x
71− n4 = ord4 x
72− fst3 !x = let (x1,_,_) = x in x1
73− snd3 !x = let (_,x2,_) = x in x2
74− trd3 !x = let (_,_,x3) = x in x3
75− fst4 !x = let (x1,_,_,_) = x in x1
76− snd4 !x = let (_,x2,_,_) = x in x2
77− trd4 !x = let (_,_,x3,_) = x in x3
78− fth4 !x = let (_,_,_,x4) = x in x4
79−{-# INLINE [0] unstream #-}
80−
81−{-# RULES
82−"STREAM stream/unstream fusion" forall s.
83− stream (unstream s) = s
84− #-}