@@ -25,16 +25,46 @@ module Data.Text.Encoding.Fusion.Common
2525 , restreamUtf16BE
2626 , restreamUtf32LE
2727 , restreamUtf32BE
28+ , istreamUtf8
2829 ) where
2930
30−import Data.Bits ((.&.))
31+import Control.Monad.ST
32+import Data.Bits ((.&.), (.|.))
33+import Data.Text.Array
3134import Data.Text.Fusion (Step(..), Stream(..))
3235import Data.Text.Fusion.Internal (M(..), S(..))
33−import Data.Text.UnsafeChar (ord)
34−import Data.Text.UnsafeShift (shiftR)
35−import Data.Word (Word8)
36+import Data.Text.UnsafeChar (ord, unsafeChr32)
37+import Data.Text.UnsafeShift (shiftL, shiftR)
38+import Data.Word (Word8, Word32)
3639import qualified Data.Text.Encoding.Utf8 as U8
3740
41+accept, reject :: Word32
42+accept = 0
43+reject = 12
44+
45+data S8 s = S8 !s {-# UNPACK #-} !Word32 {-# UNPACK #-} !Word32
46+
47+istreamUtf8 :: Stream Word8 -> Stream Char
48+istreamUtf8 (Stream next0 s0 len) =
49+ Stream next (S8 s0 accept 0) len
50+ where
51+ next (S8 s state code) =
52+ case next0 s of
53+ Done -> Done
54+ Skip s' -> Skip (S8 s' state code)
55+ Yield w s'
56+ | state' == accept -> Yield (unsafeChr32 code') (S8 s' accept code')
57+ | state' /= reject -> Skip (S8 s' state' code')
58+ where
59+ word = fromIntegral w
60+ peeku :: Int -> Word32
61+ peeku n = fromIntegral (unsafeIndexWord8 utf8d n)
62+ !kind = peeku (fromIntegral word)
63+ !code' | state /= accept = (word .&. 0x3f) .|. (code `shiftL` 6)
64+ | otherwise = (0xff `shiftR` fromIntegral kind) .&. word
65+ !state' = peeku (256 + fromIntegral (state + kind))
66+
67+
3868-- | /O(n)/ Convert a Stream Char into a UTF-8 encoded Stream Word8.
3969restreamUtf8 :: Stream Char -> Stream Word8
4070restreamUtf8 (Stream next0 s0 len) =
@@ -160,3 +190,18 @@ restreamUtf32LE (Stream next0 s0 len) =
160190internalError :: String -> a
161191internalError func =
162192 error $ "Data.Text.Encoding.Fusion.Common." ++ func ++ ": internal error"
193+
194+utf8d :: Array
195+{-# NOINLINE utf8d #-}
196+utf8d = runST fill where
197+ fill = do
198+ ary <- unsafeNew . (`div` 2) . sum . map fst $ xs
199+ mapM_ (uncurry (unsafeWriteWord8 ary))
200+ (zip [0..] (concatMap (uncurry replicate) xs))
201+ unsafeFreeze ary
202+ xs = [(128,0),(16,1),(16,9),(32,7),(2,8),(30,2),(1,10),(12,3),(1,4),(2,3),
203+ (1,11),(3,6),(1,5),(11,8),(1,0),(1,12),(1,24),(1,36),(1,60),(1,96),
204+ (1,84),(3,12),(1,48),(1,72),(13,12),(1,0),(5,12),(1,0),(1,12),(1,0),
205+ (3,12),(1,24),(5,12),(1,24),(1,12),(1,24),(9,12),(1,24),(5,12),(1,24),
206+ (7,12),(1,24),(9,12),(1,36),(1,12),(1,36),(3,12),(1,36),(5,12),(1,36),
207+ (1,12),(1,36),(3,12),(1,36),(10,12)]