git.iko.soy/text
on master help sign in
Merge pull request #9 from jaspervdj/master
730a33fBryan O'Sullivan
Data/Text/Encoding/Fusion/Common.hs+83−98
compare with master
unifiedsplit
@@ -4,7 +4,8 @@
4-- Module : Data.Text.Encoding.Fusion.Common
4-- Module : Data.Text.Encoding.Fusion.Common
5-- Copyright : (c) Tom Harper 2008-2009,
5-- Copyright : (c) Tom Harper 2008-2009,
6-- (c) Bryan O'Sullivan 2009,
6-- (c) Bryan O'Sullivan 2009,
7−-- (c) Duncan Coutts 2009
7+-- (c) Duncan Coutts 2009,
8+-- (c) Jasper Van der Jeugt 2011
8--
9--
9-- License : BSD-style
10-- License : BSD-style
10-- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,
11-- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,
@@ -29,7 +30,7 @@ module Data.Text.Encoding.Fusion.Common
29
30
30import Data.Bits ((.&.))
31import Data.Bits ((.&.))
31import Data.Text.Fusion (Step(..), Stream(..))
32import Data.Text.Fusion (Step(..), Stream(..))
32−import Data.Text.Fusion.Internal (M(..), S(..))
33+import Data.Text.Fusion.Internal (RS(..))
33import Data.Text.UnsafeChar (ord)
34import Data.Text.UnsafeChar (ord)
34import Data.Text.UnsafeShift (shiftR)
35import Data.Text.UnsafeShift (shiftR)
35import Data.Word (Word8)
36import Data.Word (Word8)
@@ -37,126 +38,110 @@ import qualified Data.Text.Encoding.Utf8 as U8
37
38
38-- | /O(n)/ Convert a Stream Char into a UTF-8 encoded Stream Word8.
39-- | /O(n)/ Convert a Stream Char into a UTF-8 encoded Stream Word8.
39restreamUtf8 :: Stream Char -> Stream Word8
40restreamUtf8 :: Stream Char -> Stream Word8
40−restreamUtf8 (Stream next0 s0 len) =
41+restreamUtf8 (Stream next0 s0 len) = Stream next (RS0 s0) (len * 2)
41− Stream next (S s0 N N N) (len*2)
42− where
42+ where
43− {-# INLINE next #-}
44− next (S s N N N) = case next0 s of
43+ next (RS0 s) = case next0 s of
45− Done -> Done
44+ Done -> Done
46− Skip s' -> Skip (S s' N N N)
45+ Skip s' -> Skip (RS0 s')
47− Yield x xs
46+ Yield x s'
48− | n <= 0x7F -> Yield c (S xs N N N)
47+ | n <= 0x7F -> Yield c (RS0 s')
49− | n <= 0x07FF -> Yield a2 (S xs (J b2) N N)
48+ | n <= 0x07FF -> Yield a2 (RS1 s' b2)
50− | n <= 0xFFFF -> Yield a3 (S xs (J b3) (J c3) N)
49+ | n <= 0xFFFF -> Yield a3 (RS2 s' b3 c3)
51− | otherwise -> Yield a4 (S xs (J b4) (J c4) (J d4))
50+ | otherwise -> Yield a4 (RS3 s' b4 c4 d4)
52− where
51+ where
53− n = ord x
52+ n = ord x
54− c = fromIntegral n
53+ c = fromIntegral n
55− (a2,b2) = U8.ord2 x
54+ (a2,b2) = U8.ord2 x
56− (a3,b3,c3) = U8.ord3 x
55+ (a3,b3,c3) = U8.ord3 x
57− (a4,b4,c4,d4) = U8.ord4 x
56+ (a4,b4,c4,d4) = U8.ord4 x
58− next (S s (J x2) N N) = Yield x2 (S s N N N)
57+ next (RS1 s x2) = Yield x2 (RS0 s)
59− next (S s (J x2) x3 N) = Yield x2 (S s x3 N N)
58+ next (RS2 s x2 x3) = Yield x2 (RS1 s x3)
60− next (S s (J x2) x3 x4) = Yield x2 (S s x3 x4 N)
59+ next (RS3 s x2 x3 x4) = Yield x2 (RS2 s x3 x4)
61− next _ = internalError "restreamUtf8"
60+ {-# INLINE next #-}
62{-# INLINE restreamUtf8 #-}
61{-# INLINE restreamUtf8 #-}
63
62
64restreamUtf16BE :: Stream Char -> Stream Word8
63restreamUtf16BE :: Stream Char -> Stream Word8
65−restreamUtf16BE (Stream next0 s0 len) =
64+restreamUtf16BE (Stream next0 s0 len) = Stream next (RS0 s0) (len * 2)
66− Stream next (S s0 N N N) (len*2)
67− where
65+ where
68− {-# INLINE next #-}
69− next (S s N N N) = case next0 s of
66+ next (RS0 s) = case next0 s of
70− Done -> Done
67+ Done -> Done
71− Skip s' -> Skip (S s' N N N)
68+ Skip s' -> Skip (RS0 s')
72− Yield x xs
69+ Yield x s'
73− | n < 0x10000 -> Yield (fromIntegral $ n `shiftR` 8) $
70+ | n < 0x10000 -> Yield (fromIntegral $ n `shiftR` 8) $
74− S xs (J $ fromIntegral n) N N
71+ RS1 s' (fromIntegral n)
75− | otherwise -> Yield c1 $
72+ | otherwise -> Yield c1 $ RS3 s' c2 c3 c4
76− S xs (J c2) (J c3) (J c4)
77− where
73+ where
78− n = ord x
74+ n = ord x
79− n1 = n - 0x10000
75+ n1 = n - 0x10000
80− c1 = fromIntegral (n1 `shiftR` 18 + 0xD8)
76+ c1 = fromIntegral (n1 `shiftR` 18 + 0xD8)
81− c2 = fromIntegral (n1 `shiftR` 10)
77+ c2 = fromIntegral (n1 `shiftR` 10)
82− n2 = n1 .&. 0x3FF
78+ n2 = n1 .&. 0x3FF
83− c3 = fromIntegral (n2 `shiftR` 8 + 0xDC)
79+ c3 = fromIntegral (n2 `shiftR` 8 + 0xDC)
84− c4 = fromIntegral n2
80+ c4 = fromIntegral n2
85− next (S s (J x2) N N) = Yield x2 (S s N N N)
81+ next (RS1 s x2) = Yield x2 (RS0 s)
86− next (S s (J x2) x3 N) = Yield x2 (S s x3 N N)
82+ next (RS2 s x2 x3) = Yield x2 (RS1 s x3)
87− next (S s (J x2) x3 x4) = Yield x2 (S s x3 x4 N)
83+ next (RS3 s x2 x3 x4) = Yield x2 (RS2 s x3 x4)
88− next _ = internalError "restreamUtf16BE"
84+ {-# INLINE next #-}
89{-# INLINE restreamUtf16BE #-}
85{-# INLINE restreamUtf16BE #-}
90
86
91restreamUtf16LE :: Stream Char -> Stream Word8
87restreamUtf16LE :: Stream Char -> Stream Word8
92−restreamUtf16LE (Stream next0 s0 len) =
88+restreamUtf16LE (Stream next0 s0 len) = Stream next (RS0 s0) (len * 2)
93− Stream next (S s0 N N N) (len*2)
94− where
89+ where
95− {-# INLINE next #-}
96− next (S s N N N) = case next0 s of
90+ next (RS0 s) = case next0 s of
97− Done -> Done
91+ Done -> Done
98− Skip s' -> Skip (S s' N N N)
92+ Skip s' -> Skip (RS0 s')
99− Yield x xs
93+ Yield x s'
100− | n < 0x10000 -> Yield (fromIntegral n) $
94+ | n < 0x10000 -> Yield (fromIntegral n) $
101− S xs (J (fromIntegral $ shiftR n 8)) N N
95+ RS1 s' (fromIntegral $ shiftR n 8)
102− | otherwise -> Yield c1 $
96+ | otherwise -> Yield c1 $ RS3 s' c2 c3 c4
103− S xs (J c2) (J c3) (J c4)
104− where
97+ where
105− n = ord x
98+ n = ord x
106− n1 = n - 0x10000
99+ n1 = n - 0x10000
107− c2 = fromIntegral (shiftR n1 18 + 0xD8)
100+ c2 = fromIntegral (shiftR n1 18 + 0xD8)
108− c1 = fromIntegral (shiftR n1 10)
101+ c1 = fromIntegral (shiftR n1 10)
109− n2 = n1 .&. 0x3FF
102+ n2 = n1 .&. 0x3FF
110− c4 = fromIntegral (shiftR n2 8 + 0xDC)
103+ c4 = fromIntegral (shiftR n2 8 + 0xDC)
111− c3 = fromIntegral n2
104+ c3 = fromIntegral n2
112− next (S s (J x2) N N) = Yield x2 (S s N N N)
105+ next (RS1 s x2) = Yield x2 (RS0 s)
113− next (S s (J x2) x3 N) = Yield x2 (S s x3 N N)
106+ next (RS2 s x2 x3) = Yield x2 (RS1 s x3)
114− next (S s (J x2) x3 x4) = Yield x2 (S s x3 x4 N)
107+ next (RS3 s x2 x3 x4) = Yield x2 (RS2 s x3 x4)
115− next _ = internalError "restreamUtf16LE"
108+ {-# INLINE next #-}
116{-# INLINE restreamUtf16LE #-}
109{-# INLINE restreamUtf16LE #-}
117
110
118restreamUtf32BE :: Stream Char -> Stream Word8
111restreamUtf32BE :: Stream Char -> Stream Word8
119−restreamUtf32BE (Stream next0 s0 len) =
112+restreamUtf32BE (Stream next0 s0 len) = Stream next (RS0 s0) (len * 2)
120− Stream next (S s0 N N N) (len*2)
121− where
113+ where
122− {-# INLINE next #-}
123− next (S s N N N) = case next0 s of
114+ next (RS0 s) = case next0 s of
124 Done -> Done
115 Done -> Done
125− Skip s' -> Skip (S s' N N N)
116+ Skip s' -> Skip (RS0 s')
126− Yield x xs -> Yield c1 (S xs (J c2) (J c3) (J c4))
117+ Yield x s' -> Yield c1 (RS3 s' c2 c3 c4)
127 where
118 where
128 n = ord x
119 n = ord x
129 c1 = fromIntegral $ shiftR n 24
120 c1 = fromIntegral $ shiftR n 24
130 c2 = fromIntegral $ shiftR n 16
121 c2 = fromIntegral $ shiftR n 16
131 c3 = fromIntegral $ shiftR n 8
122 c3 = fromIntegral $ shiftR n 8
132 c4 = fromIntegral n
123 c4 = fromIntegral n
133− next (S s (J x2) N N) = Yield x2 (S s N N N)
124+ next (RS1 s x2) = Yield x2 (RS0 s)
134− next (S s (J x2) x3 N) = Yield x2 (S s x3 N N)
125+ next (RS2 s x2 x3) = Yield x2 (RS1 s x3)
135− next (S s (J x2) x3 x4) = Yield x2 (S s x3 x4 N)
126+ next (RS3 s x2 x3 x4) = Yield x2 (RS2 s x3 x4)
136− next _ = internalError "restreamUtf32BE"
127+ {-# INLINE next #-}
137{-# INLINE restreamUtf32BE #-}
128{-# INLINE restreamUtf32BE #-}
138
129
139restreamUtf32LE :: Stream Char -> Stream Word8
130restreamUtf32LE :: Stream Char -> Stream Word8
140−restreamUtf32LE (Stream next0 s0 len) =
131+restreamUtf32LE (Stream next0 s0 len) = Stream next (RS0 s0) (len * 2)
141− Stream next (S s0 N N N) (len*2)
142− where
132+ where
143− {-# INLINE next #-}
144− next (S s N N N) = case next0 s of
133+ next (RS0 s) = case next0 s of
145 Done -> Done
134 Done -> Done
146− Skip s' -> Skip (S s' N N N)
135+ Skip s' -> Skip (RS0 s')
147− Yield x xs -> Yield c1 (S xs (J c2) (J c3) (J c4))
136+ Yield x s' -> Yield c1 (RS3 s' c2 c3 c4)
148 where
137 where
149 n = ord x
138 n = ord x
150 c4 = fromIntegral $ shiftR n 24
139 c4 = fromIntegral $ shiftR n 24
151 c3 = fromIntegral $ shiftR n 16
140 c3 = fromIntegral $ shiftR n 16
152 c2 = fromIntegral $ shiftR n 8
141 c2 = fromIntegral $ shiftR n 8
153 c1 = fromIntegral n
142 c1 = fromIntegral n
154− next (S s (J x2) N N) = Yield x2 (S s N N N)
143+ next (RS1 s x2) = Yield x2 (RS0 s)
155− next (S s (J x2) x3 N) = Yield x2 (S s x3 N N)
144+ next (RS2 s x2 x3) = Yield x2 (RS1 s x3)
156− next (S s (J x2) x3 x4) = Yield x2 (S s x3 x4 N)
145+ next (RS3 s x2 x3 x4) = Yield x2 (RS2 s x3 x4)
157− next _ = internalError "restreamUtf32LE"
146+ {-# INLINE next #-}
158{-# INLINE restreamUtf32LE #-}
147{-# INLINE restreamUtf32LE #-}
159−
160−internalError :: String -> a
161−internalError func =
162− error $ "Data.Text.Encoding.Fusion.Common." ++ func ++ ": internal error"
Data/Text/Fusion/Internal.hs+8−3
@@ -3,7 +3,8 @@
3-- Module : Data.Text.Fusion.Internal
3-- Module : Data.Text.Fusion.Internal
4-- Copyright : (c) Tom Harper 2008-2009,
4-- Copyright : (c) Tom Harper 2008-2009,
5-- (c) Bryan O'Sullivan 2009,
5-- (c) Bryan O'Sullivan 2009,
6−-- (c) Duncan Coutts 2009
6+-- (c) Duncan Coutts 2009,
7+-- (c) Jasper Van der Jeugt 2011
7--
8--
8-- License : BSD-style
9-- License : BSD-style
9-- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,
10-- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,
@@ -19,7 +20,7 @@ module Data.Text.Fusion.Internal
19 , M(..)
20 , M(..)
20 , M8
21 , M8
21 , PairS(..)
22 , PairS(..)
22− , S(..)
23+ , RS(..)
23 , Step(..)
24 , Step(..)
24 , Stream(..)
25 , Stream(..)
25 , Switch(..)
26 , Switch(..)
@@ -39,7 +40,11 @@ data M a = N
39type M8 = M Word8
40type M8 = M Word8
40
41
41-- Restreaming state.
42-- Restreaming state.
42−data S s = S !s !M8 !M8 !M8
43+data RS s
44+ = RS0 !s
45+ | RS1 !s {-# UNPACK #-} !Word8
46+ | RS2 !s {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8
47+ | RS3 !s {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8
43
48
44infixl 2 :*:
49infixl 2 :*:
45data PairS a b = !a :*: !b
50data PairS a b = !a :*: !b