2bc2994 · text · git.iko.soy

git.iko.soy/text

on master help sign in

Test the remaining supported encodings

2bc2994Bryan O'Sullivan18 years ago

Data/Text/Encoding.hs+1−1

compare with master

unifiedsplit

@@ -85,7 +85,7 @@ decodeUtf32LE bs = F.unstream (E.streamUtf32LE bs)

86-- | Decode text from big endian UTF-32 encoding.

87decodeUtf32BE :: ByteString -> Text

88−decodeUtf32BE bs = F.unstream (E.streamUtf32LE bs)

88+decodeUtf32BE bs = F.unstream (E.streamUtf32BE bs)

89{-# INLINE decodeUtf32BE #-}

91-- | Encode text using little endian UTF-32 encoding.

Data/Text/Encoding/Fusion.hs+67−52

@@ -56,7 +56,14 @@ import qualified Data.Text.Utf16 as U16

56import qualified Data.Text.Utf32 as U32

57import qualified Data.Text.Utf8 as U8

59+-- Specialised, strict Maybe-like type.

60+data M = N

61+ | J {-# UNPACK #-} !Word8

62+ deriving (Eq, Ord, Show)

63+

64+-- Restreaming state.

65+data S s = S {-# UNPACK #-} !s

59−data T4 a b c d = T4 {-# UNPACK #-} !a {-# UNPACK #-} !b {-# UNPACK #-} !c {-# UNPACK #-} !d

66+ {-# UNPACK #-} !M {-# UNPACK #-} !M {-# UNPACK #-} !M

61streamASCII :: ByteString -> Stream Char

68streamASCII :: ByteString -> Stream Char

62streamASCII bs = Stream next 0 l

69streamASCII bs = Stream next 0 l

@@ -70,7 +77,8 @@ streamASCII bs = Stream next 0 l

70 x1 = B.unsafeIndex bs i

77 x1 = B.unsafeIndex bs i

71{-# INLINE [0] streamASCII #-}

78{-# INLINE [0] streamASCII #-}

73−-- | /O(n) Convert a ByteString into a Stream Char, using the specified encoding standard.

80+-- | /O(n) Convert a 'ByteString' into a 'Stream Char', using UTF-8

81+-- encoding.

74streamUtf8 :: ByteString -> Stream Char

82streamUtf8 :: ByteString -> Stream Char

75streamUtf8 bs = Stream next 0 l

83streamUtf8 bs = Stream next 0 l

76 where

84 where

@@ -91,6 +99,8 @@ streamUtf8 bs = Stream next 0 l

91 idx = B.unsafeIndex bs

99 idx = B.unsafeIndex bs

92{-# INLINE [0] streamUtf8 #-}

100{-# INLINE [0] streamUtf8 #-}

101

102+-- | /O(n) Convert a 'ByteString' into a 'Stream Char', using little

103+-- endian UTF-16 encoding.

94streamUtf16LE :: ByteString -> Stream Char

104streamUtf16LE :: ByteString -> Stream Char

95streamUtf16LE bs = Stream next 0 l

105streamUtf16LE bs = Stream next 0 l

96 where

106 where

@@ -102,11 +112,13 @@ streamUtf16LE bs = Stream next 0 l

102 | i+3 < l && U16.validate2 x1 x2 = Yield (U16.chr2 x1 x2) (i+4)

112 | i+3 < l && U16.validate2 x1 x2 = Yield (U16.chr2 x1 x2) (i+4)

103 | otherwise = encodingError "UTF-16LE"

113 | otherwise = encodingError "UTF-16LE"

104 where

114 where

105− x1 = (idx (i + 1) `shiftL` 8) + idx i

115+ x1 = idx i + (idx (i + 1) `shiftL` 8)

106− x2 = (idx (i + 3) `shiftL` 8) + idx (i + 2)

116+ x2 = idx (i + 2) + (idx (i + 3) `shiftL` 8)

107 idx = fromIntegral . B.unsafeIndex bs :: Int -> Word16

117 idx = fromIntegral . B.unsafeIndex bs :: Int -> Word16

108{-# INLINE [0] streamUtf16LE #-}

118{-# INLINE [0] streamUtf16LE #-}

109

119

120+-- | /O(n) Convert a 'ByteString' into a 'Stream Char', using big

121+-- endian UTF-16 encoding.

110streamUtf16BE :: ByteString -> Stream Char

122streamUtf16BE :: ByteString -> Stream Char

111streamUtf16BE bs = Stream next 0 l

123streamUtf16BE bs = Stream next 0 l

112 where

124 where

@@ -118,11 +130,13 @@ streamUtf16BE bs = Stream next 0 l

118 | i+3 < l && U16.validate2 x1 x2 = Yield (U16.chr2 x1 x2) (i+4)

130 | i+3 < l && U16.validate2 x1 x2 = Yield (U16.chr2 x1 x2) (i+4)

119 | otherwise = encodingError "UTF16-BE"

131 | otherwise = encodingError "UTF16-BE"

120 where

132 where

121− x1 = (shiftL (idx i) 8) + (idx (i + 1))

133+ x1 = (idx i `shiftL` 8) + idx (i + 1)

122− x2 = (shiftL (idx (i + 2)) 8) + (idx (i + 3))

134+ x2 = (idx (i + 2) `shiftL` 8) + idx (i + 3)

123 idx = fromIntegral . B.unsafeIndex bs :: Int -> Word16

135 idx = fromIntegral . B.unsafeIndex bs :: Int -> Word16

124{-# INLINE [0] streamUtf16BE #-}

136{-# INLINE [0] streamUtf16BE #-}

125

137

138+-- | /O(n) Convert a 'ByteString' into a 'Stream Char', using big

139+-- endian UTF-32 encoding.

126streamUtf32BE :: ByteString -> Stream Char

140streamUtf32BE :: ByteString -> Stream Char

127streamUtf32BE bs = Stream next 0 l

141streamUtf32BE bs = Stream next 0 l

128 where

142 where

@@ -141,6 +155,8 @@ streamUtf32BE bs = Stream next 0 l

141 idx = fromIntegral . B.unsafeIndex bs :: Int -> Word32

155 idx = fromIntegral . B.unsafeIndex bs :: Int -> Word32

142{-# INLINE [0] streamUtf32BE #-}

156{-# INLINE [0] streamUtf32BE #-}

143

157

158+-- | /O(n) Convert a 'ByteString' into a 'Stream Char', using little

159+-- endian UTF-32 encoding.

144streamUtf32LE :: ByteString -> Stream Char

160streamUtf32LE :: ByteString -> Stream Char

145streamUtf32LE bs = Stream next 0 l

161streamUtf32LE bs = Stream next 0 l

146 where

162 where

@@ -169,73 +185,72 @@ restreamASCII (Stream next0 s0 len) = Stream next s0 (len*2)

169 where x' = fromIntegral (ord x) :: Word8

185 where x' = fromIntegral (ord x) :: Word8

170{-# INLINE restreamASCII #-}

186{-# INLINE restreamASCII #-}

171

187

172−data M = N | J {-# UNPACK #-} !Word8

173− deriving (Eq, Ord, Show)

174−

175-- | /O(n)/ Convert a Stream Char into a UTF-8 encoded Stream Word8.

188-- | /O(n)/ Convert a Stream Char into a UTF-8 encoded Stream Word8.

176restreamUtf8 :: Stream Char -> Stream Word8

189restreamUtf8 :: Stream Char -> Stream Word8

177restreamUtf8 (Stream next0 s0 len) =

190restreamUtf8 (Stream next0 s0 len) =

178− Stream next (T4 s0 N N N) (len*2)

191+ Stream next (S s0 N N N) (len*2)

179 where

192 where

180 {-# INLINE next #-}

193 {-# INLINE next #-}

181− next (T4 s N N N) = case next0 s of

194+ next (S s N N N) = case next0 s of

182 Done -> Done

195 Done -> Done

183− Skip s' -> Skip (T4 s' N N N)

196+ Skip s' -> Skip (S s' N N N)

184 Yield x xs

197 Yield x xs

185− | n <= 0x7F -> Yield c (T4 xs N N N)

198+ | n <= 0x7F -> Yield c (S xs N N N)

186− | n <= 0x07FF -> Yield a2 (T4 xs (J b2) N N)

199+ | n <= 0x07FF -> Yield a2 (S xs (J b2) N N)

187− | n <= 0xFFFF -> Yield a3 (T4 xs (J b3) (J c3) N)

200+ | n <= 0xFFFF -> Yield a3 (S xs (J b3) (J c3) N)

188− | otherwise -> Yield a4 (T4 xs (J b4) (J c4) (J d4))

201+ | otherwise -> Yield a4 (S xs (J b4) (J c4) (J d4))

189 where

202 where

190 n = ord x

203 n = ord x

191 c = fromIntegral n

204 c = fromIntegral n

192 (a2,b2) = U8.ord2 x

205 (a2,b2) = U8.ord2 x

193 (a3,b3,c3) = U8.ord3 x

206 (a3,b3,c3) = U8.ord3 x

194 (a4,b4,c4,d4) = U8.ord4 x

207 (a4,b4,c4,d4) = U8.ord4 x

195− next (T4 s (J x2) N N) = Yield x2 (T4 s N N N)

208+ next (S s (J x2) N N) = Yield x2 (S s N N N)

196− next (T4 s (J x2) x3 N) = Yield x2 (T4 s x3 N N)

209+ next (S s (J x2) x3 N) = Yield x2 (S s x3 N N)

197− next (T4 s (J x2) x3 x4) = Yield x2 (T4 s x3 x4 N)

210+ next (S s (J x2) x3 x4) = Yield x2 (S s x3 x4 N)

198 next _ = internalError "restreamUtf8"

211 next _ = internalError "restreamUtf8"

199{-# INLINE restreamUtf8 #-}

212{-# INLINE restreamUtf8 #-}

200

213

201restreamUtf16BE :: Stream Char -> Stream Word8

214restreamUtf16BE :: Stream Char -> Stream Word8

202restreamUtf16BE (Stream next0 s0 len) =

215restreamUtf16BE (Stream next0 s0 len) =

203− Stream next (T4 s0 N N N) (len*2)

216+ Stream next (S s0 N N N) (len*2)

204 where

217 where

205 {-# INLINE next #-}

218 {-# INLINE next #-}

206− next (T4 s N N N) = case next0 s of

219+ next (S s N N N) = case next0 s of

207 Done -> Done

220 Done -> Done

208− Skip s' -> Skip (T4 s' N N N)

221+ Skip s' -> Skip (S s' N N N)

209 Yield x xs

222 Yield x xs

210− | n < 0x10000 -> Yield (fromIntegral $ shiftR n 8) (T4 xs (J (fromIntegral n)) N N)

223+ | n < 0x10000 -> Yield (fromIntegral $ n `shiftR` 8) $

224+ S xs (J $ fromIntegral n) N N

211− | otherwise -> Yield c1 (T4 xs (J c2) (J c3) (J c4))

225+ | otherwise -> Yield c1 $

226+ S xs (J c2) (J c3) (J c4)

212 where

227 where

213 n = ord x

228 n = ord x

214 n1 = n - 0x10000

229 n1 = n - 0x10000

215− c1 = fromIntegral (shiftR n1 18 + 0xD8)

230+ c1 = fromIntegral (n1 `shiftR` 18 + 0xD8)

216− c2 = fromIntegral (shiftR n1 10)

231+ c2 = fromIntegral (n1 `shiftR` 10)

217 n2 = n1 .&. 0x3FF

232 n2 = n1 .&. 0x3FF

218− c3 = fromIntegral (shiftR n2 8 + 0xDC)

233+ c3 = fromIntegral (n2 `shiftR` 8 + 0xDC)

219 c4 = fromIntegral n2

234 c4 = fromIntegral n2

220− next (T4 s (J x2) N N) = Yield x2 (T4 s N N N)

235+ next (S s (J x2) N N) = Yield x2 (S s N N N)

221− next (T4 s (J x2) x3 N) = Yield x2 (T4 s x3 N N)

236+ next (S s (J x2) x3 N) = Yield x2 (S s x3 N N)

222− next (T4 s (J x2) x3 x4) = Yield x2 (T4 s x3 x4 N)

237+ next (S s (J x2) x3 x4) = Yield x2 (S s x3 x4 N)

223 next _ = internalError "restreamUtf16BE"

238 next _ = internalError "restreamUtf16BE"

224{-# INLINE restreamUtf16BE #-}

239{-# INLINE restreamUtf16BE #-}

225

240

226restreamUtf16LE :: Stream Char -> Stream Word8

241restreamUtf16LE :: Stream Char -> Stream Word8

227restreamUtf16LE (Stream next0 s0 len) =

242restreamUtf16LE (Stream next0 s0 len) =

228− Stream next (T4 s0 N N N) (len*2)

243+ Stream next (S s0 N N N) (len*2)

229 where

244 where

230 {-# INLINE next #-}

245 {-# INLINE next #-}

231− next (T4 s N N N) = case next0 s of

246+ next (S s N N N) = case next0 s of

232 Done -> Done

247 Done -> Done

233− Skip s' -> Skip (T4 s' N N N)

248+ Skip s' -> Skip (S s' N N N)

234 Yield x xs

249 Yield x xs

235 | n < 0x10000 -> Yield (fromIntegral n) $

250 | n < 0x10000 -> Yield (fromIntegral n) $

236− T4 xs (J (fromIntegral $ shiftR n 8)) N N

251+ S xs (J (fromIntegral $ shiftR n 8)) N N

237 | otherwise -> Yield c1 $

252 | otherwise -> Yield c1 $

238− T4 xs (J c2) (J c3) (J c4)

253+ S xs (J c2) (J c3) (J c4)

239 where

254 where

240 n = ord x

255 n = ord x

241 n1 = n - 0x10000

256 n1 = n - 0x10000

@@ -244,51 +259,51 @@ restreamUtf16LE (Stream next0 s0 len) =

244 n2 = n1 .&. 0x3FF

259 n2 = n1 .&. 0x3FF

245 c4 = fromIntegral (shiftR n2 8 + 0xDC)

260 c4 = fromIntegral (shiftR n2 8 + 0xDC)

246 c3 = fromIntegral n2

261 c3 = fromIntegral n2

247− next (T4 s (J x2) N N) = Yield x2 (T4 s N N N)

262+ next (S s (J x2) N N) = Yield x2 (S s N N N)

248− next (T4 s (J x2) x3 N) = Yield x2 (T4 s x3 N N)

263+ next (S s (J x2) x3 N) = Yield x2 (S s x3 N N)

249− next (T4 s (J x2) x3 x4) = Yield x2 (T4 s x3 x4 N)

264+ next (S s (J x2) x3 x4) = Yield x2 (S s x3 x4 N)

250 next _ = internalError "restreamUtf16LE"

265 next _ = internalError "restreamUtf16LE"

251{-# INLINE restreamUtf16LE #-}

266{-# INLINE restreamUtf16LE #-}

252

267

253restreamUtf32BE :: Stream Char -> Stream Word8

268restreamUtf32BE :: Stream Char -> Stream Word8

254restreamUtf32BE (Stream next0 s0 len) =

269restreamUtf32BE (Stream next0 s0 len) =

255− Stream next (T4 (Just s0) Nothing Nothing Nothing) (len*2)

270+ Stream next (S s0 N N N) (len*2)

256 where

271 where

257 {-# INLINE next #-}

272 {-# INLINE next #-}

258− next (T4 (Just s) Nothing Nothing Nothing) = case next0 s of

273+ next (S s N N N) = case next0 s of

259 Done -> Done

274 Done -> Done

260− Skip s' -> Skip (T4 (Just s') Nothing Nothing Nothing)

275+ Skip s' -> Skip (S s' N N N)

261− Yield x xs -> Yield c1 (T4 (Just xs) (Just c2) (Just c3) (Just c4))

276+ Yield x xs -> Yield c1 (S xs (J c2) (J c3) (J c4))

262 where

277 where

263 n = ord x

278 n = ord x

264 c1 = fromIntegral $ shiftR n 24

279 c1 = fromIntegral $ shiftR n 24

265 c2 = fromIntegral $ shiftR n 16

280 c2 = fromIntegral $ shiftR n 16

266 c3 = fromIntegral $ shiftR n 8

281 c3 = fromIntegral $ shiftR n 8

267 c4 = fromIntegral n

282 c4 = fromIntegral n

268− next (T4 (Just s) (Just x2) Nothing Nothing) = Yield x2 (T4 (Just s) Nothing Nothing Nothing)

283+ next (S s (J x2) N N) = Yield x2 (S s N N N)

269− next (T4 (Just s) (Just x2) x3 Nothing) = Yield x2 (T4 (Just s) x3 Nothing Nothing)

284+ next (S s (J x2) x3 N) = Yield x2 (S s x3 N N)

270− next (T4 (Just s) (Just x2) x3 x4) = Yield x2 (T4 (Just s) x3 x4 Nothing)

285+ next (S s (J x2) x3 x4) = Yield x2 (S s x3 x4 N)

271 next _ = internalError "restreamUtf32BE"

286 next _ = internalError "restreamUtf32BE"

272{-# INLINE restreamUtf32BE #-}

287{-# INLINE restreamUtf32BE #-}

273

288

274restreamUtf32LE :: Stream Char -> Stream Word8

289restreamUtf32LE :: Stream Char -> Stream Word8

275restreamUtf32LE (Stream next0 s0 len) =

290restreamUtf32LE (Stream next0 s0 len) =

276− Stream next (T4 (Just s0) Nothing Nothing Nothing) (len*2)

291+ Stream next (S s0 N N N) (len*2)

277 where

292 where

278 {-# INLINE next #-}

293 {-# INLINE next #-}

279− next (T4 (Just s) Nothing Nothing Nothing) = case next0 s of

294+ next (S s N N N) = case next0 s of

280 Done -> Done

295 Done -> Done

281− Skip s' -> Skip (T4 (Just s') Nothing Nothing Nothing)

296+ Skip s' -> Skip (S s' N N N)

282− Yield x xs -> Yield c1 (T4 (Just xs) (Just c2) (Just c3) (Just c4))

297+ Yield x xs -> Yield c1 (S xs (J c2) (J c3) (J c4))

283 where

298 where

284 n = ord x

299 n = ord x

285 c4 = fromIntegral $ shiftR n 24

300 c4 = fromIntegral $ shiftR n 24

286 c3 = fromIntegral $ shiftR n 16

301 c3 = fromIntegral $ shiftR n 16

287 c2 = fromIntegral $ shiftR n 8

302 c2 = fromIntegral $ shiftR n 8

288 c1 = fromIntegral n

303 c1 = fromIntegral n

289− next (T4 (Just s) (Just x2) Nothing Nothing) = Yield x2 (T4 (Just s) Nothing Nothing Nothing)

304+ next (S s (J x2) N N) = Yield x2 (S s N N N)

290− next (T4 (Just s) (Just x2) x3 Nothing) = Yield x2 (T4 (Just s) x3 Nothing Nothing)

305+ next (S s (J x2) x3 N) = Yield x2 (S s x3 N N)

291− next (T4 (Just s) (Just x2) x3 x4) = Yield x2 (T4 (Just s) x3 x4 Nothing)

306+ next (S s (J x2) x3 x4) = Yield x2 (S s x3 x4 N)

292 next _ = internalError "restreamUtf32LE"

307 next _ = internalError "restreamUtf32LE"

293{-# INLINE restreamUtf32LE #-}

308{-# INLINE restreamUtf32LE #-}

294

309

tests/Properties.hs+4

@@ -43,6 +43,8 @@ prop_ascii t = E.decodeASCII (E.encodeASCII a) == a

43prop_utf8 = (E.decodeUtf8 . E.encodeUtf8) `eq` id

44prop_utf16LE = (E.decodeUtf16LE . E.encodeUtf16LE) `eq` id

45prop_utf16BE = (E.decodeUtf16BE . E.encodeUtf16BE) `eq` id

46+prop_utf32LE = (E.decodeUtf32LE . E.encodeUtf32LE) `eq` id

47+prop_utf32BE = (E.decodeUtf32BE . E.encodeUtf32BE) `eq` id

47-- Do two functions give the same answer?

49-- Do two functions give the same answer?

48eq :: (Eq a) => (t -> a) -> (t -> a) -> t -> Bool

50eq :: (Eq a) => (t -> a) -> (t -> a) -> t -> Bool

@@ -235,6 +237,8 @@ tests = [

235 ("prop_utf8", mytest prop_utf8),

237 ("prop_utf8", mytest prop_utf8),

236 ("prop_utf16LE", mytest prop_utf16LE),

238 ("prop_utf16LE", mytest prop_utf16LE),

237 ("prop_utf16BE", mytest prop_utf16BE),

239 ("prop_utf16BE", mytest prop_utf16BE),

240+ ("prop_utf32LE", mytest prop_utf32LE),

241+ ("prop_utf32BE", mytest prop_utf32BE),

238

242

239 ("prop_cons", mytest prop_cons),

243 ("prop_cons", mytest prop_cons),

240 ("prop_snoc", mytest prop_snoc),

244 ("prop_snoc", mytest prop_snoc),