on 47be150 help sign in
152 lines 4.6 kB history raw
1{-# LANGUAGE MagicHash #-}
3-- |
4-- Module : Data.Text.Encoding.Utf16
5-- Copyright : (c) Tom Harper 2008-2009,
6-- (c) Bryan O'Sullivan 2009,
7-- (c) Duncan Coutts 2009
8--
9-- License : BSD-style
10-- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,
11-- duncan@haskell.org
12-- Stability : experimental
13-- Portability : GHC
14--
15-- Basic UTF-8 validation and character manipulation.
16module Data.Text.Encoding.Utf8
17 (
18 -- Decomposition
19 ord2
20 , ord3
21 , ord4
22 -- Construction
23 , chr2
24 , chr3
25 , chr4
26 -- * Validation
27 , validate1
28 , validate2
29 , validate3
30 , validate4
31 ) where
33import Control.Exception (assert)
34import Data.Char (ord)
35import Data.Bits ((.&.))
36import Data.Text.UnsafeShift (shiftR)
37import GHC.Exts
38import GHC.Word (Word8(..))
40default(Int)
42between :: Word8 -- ^ byte to check
43 -> Word8 -- ^ lower bound
44 -> Word8 -- ^ upper bound
45 -> Bool
46between x y z = x >= y && x <= z
47{-# INLINE between #-}
49ord2 :: Char -> (Word8,Word8)
50ord2 c = assert (n >= 0x80 && n <= 0x07ff) (x1,x2)
51 where
52 n = ord c
53 x1 = fromIntegral $ (n `shiftR` 6) + 0xC0
54 x2 = fromIntegral $ (n .&. 0x3F) + 0x80
56ord3 :: Char -> (Word8,Word8,Word8)
57ord3 c = assert (n >= 0x0800 && n <= 0xffff) (x1,x2,x3)
58 where
59 n = ord c
60 x1 = fromIntegral $ (n `shiftR` 12) + 0xE0
61 x2 = fromIntegral $ ((n `shiftR` 6) .&. 0x3F) + 0x80
62 x3 = fromIntegral $ (n .&. 0x3F) + 0x80
64ord4 :: Char -> (Word8,Word8,Word8,Word8)
65ord4 c = assert (n >= 0x10000) (x1,x2,x3,x4)
66 where
67 n = ord c
68 x1 = fromIntegral $ (n `shiftR` 18) + 0xF0
69 x2 = fromIntegral $ ((n `shiftR` 12) .&. 0x3F) + 0x80
70 x3 = fromIntegral $ ((n `shiftR` 6) .&. 0x3F) + 0x80
71 x4 = fromIntegral $ (n .&. 0x3F) + 0x80
73chr2 :: Word8 -> Word8 -> Char
74chr2 (W8# x1#) (W8# x2#) = C# (chr# (z1# +# z2#))
75 where
76 !y1# = word2Int# x1#
77 !y2# = word2Int# x2#
78 !z1# = uncheckedIShiftL# (y1# -# 0xC0#) 6#
79 !z2# = y2# -# 0x80#
80{-# INLINE chr2 #-}
82chr3 :: Word8 -> Word8 -> Word8 -> Char
83chr3 (W8# x1#) (W8# x2#) (W8# x3#) = C# (chr# (z1# +# z2# +# z3#))
84 where
85 !y1# = word2Int# x1#
86 !y2# = word2Int# x2#
87 !y3# = word2Int# x3#
88 !z1# = uncheckedIShiftL# (y1# -# 0xE0#) 12#
89 !z2# = uncheckedIShiftL# (y2# -# 0x80#) 6#
90 !z3# = y3# -# 0x80#
91{-# INLINE chr3 #-}
93chr4 :: Word8 -> Word8 -> Word8 -> Word8 -> Char
94chr4 (W8# x1#) (W8# x2#) (W8# x3#) (W8# x4#) =
95 C# (chr# (z1# +# z2# +# z3# +# z4#))
96 where
97 !y1# = word2Int# x1#
98 !y2# = word2Int# x2#
99 !y3# = word2Int# x3#
100 !y4# = word2Int# x4#
101 !z1# = uncheckedIShiftL# (y1# -# 0xF0#) 18#
102 !z2# = uncheckedIShiftL# (y2# -# 0x80#) 12#
103 !z3# = uncheckedIShiftL# (y3# -# 0x80#) 6#
104 !z4# = y4# -# 0x80#
105{-# INLINE chr4 #-}
107validate1 :: Word8 -> Bool
108validate1 x1 = between x1 0x00 0x7F
109{-# INLINE validate1 #-}
111validate2 :: Word8 -> Word8 -> Bool
112validate2 x1 x2 = between x1 0xC2 0xDF && between x2 0x80 0xBF
113{-# INLINE validate2 #-}
115validate3 :: Word8 -> Word8 -> Word8 -> Bool
116{-# INLINE validate3 #-}
117validate3 x1 x2 x3 = validate3_1 ||
118 validate3_2 ||
119 validate3_3 ||
120 validate3_4
121 where
122 validate3_1 = (x1 == 0xE0) &&
123 between x2 0xA0 0xBF &&
124 between x3 0x80 0xBF
125 validate3_2 = between x1 0xE1 0xEC &&
126 between x2 0x80 0xBF &&
127 between x3 0x80 0xBF
128 validate3_3 = x1 == 0xED &&
129 between x2 0x80 0x9F &&
130 between x3 0x80 0xBF
131 validate3_4 = between x1 0xEE 0xEF &&
132 between x2 0x80 0xBF &&
133 between x3 0x80 0xBF
135validate4 :: Word8 -> Word8 -> Word8 -> Word8 -> Bool
136{-# INLINE validate4 #-}
137validate4 x1 x2 x3 x4 = validate4_1 ||
138 validate4_2 ||
139 validate4_3
140 where
141 validate4_1 = x1 == 0xF0 &&
142 between x2 0x90 0xBF &&
143 between x3 0x80 0xBF &&
144 between x4 0x80 0xBF
145 validate4_2 = between x1 0xF1 0xF3 &&
146 between x2 0x80 0xBF &&
147 between x3 0x80 0xBF &&
148 between x4 0x80 0xBF
149 validate4_3 = x1 == 0xF4 &&
150 between x2 0x80 0x8F &&
151 between x3 0x80 0xBF &&
152 between x4 0x80 0xBF