Cleanup in parser/Ctype.hs
[ghc.git] / compiler / parser / Ctype.hs
1 -- Character classification
2 {-# LANGUAGE CPP #-}
3 module Ctype
4 ( is_ident -- Char# -> Bool
5 , is_symbol -- Char# -> Bool
6 , is_any -- Char# -> Bool
7 , is_space -- Char# -> Bool
8 , is_lower -- Char# -> Bool
9 , is_upper -- Char# -> Bool
10 , is_digit -- Char# -> Bool
11 , is_alphanum -- Char# -> Bool
12
13 , is_decdigit, is_hexdigit, is_octdigit, is_bindigit
14 , hexDigit, octDecDigit
15 ) where
16
17 #include "HsVersions.h"
18
19 import GhcPrelude
20
21 import Data.Bits ( Bits((.&.),(.|.)) )
22 import Data.Char ( ord, chr )
23 import Data.Word
24 import Panic
25
26 -- Bit masks
27
28 cIdent, cSymbol, cAny, cSpace, cLower, cUpper, cDigit :: Word8
29 cIdent = 1
30 cSymbol = 2
31 cAny = 4
32 cSpace = 8
33 cLower = 16
34 cUpper = 32
35 cDigit = 64
36
37 -- | The predicates below look costly, but aren't, GHC+GCC do a great job
38 -- at the big case below.
39
40 {-# INLINABLE is_ctype #-}
41 is_ctype :: Word8 -> Char -> Bool
42 is_ctype mask c = (charType c .&. mask) /= 0
43
44 is_ident, is_symbol, is_any, is_space, is_lower, is_upper, is_digit,
45 is_alphanum :: Char -> Bool
46 is_ident = is_ctype cIdent
47 is_symbol = is_ctype cSymbol
48 is_any = is_ctype cAny
49 is_space = is_ctype cSpace
50 is_lower = is_ctype cLower
51 is_upper = is_ctype cUpper
52 is_digit = is_ctype cDigit
53 is_alphanum = is_ctype (cLower+cUpper+cDigit)
54
55 -- Utils
56
57 hexDigit :: Char -> Int
58 hexDigit c | is_decdigit c = ord c - ord '0'
59 | otherwise = ord (to_lower c) - ord 'a' + 10
60
61 octDecDigit :: Char -> Int
62 octDecDigit c = ord c - ord '0'
63
64 is_decdigit :: Char -> Bool
65 is_decdigit c
66 = c >= '0' && c <= '9'
67
68 is_hexdigit :: Char -> Bool
69 is_hexdigit c
70 = is_decdigit c
71 || (c >= 'a' && c <= 'f')
72 || (c >= 'A' && c <= 'F')
73
74 is_octdigit :: Char -> Bool
75 is_octdigit c = c >= '0' && c <= '7'
76
77 is_bindigit :: Char -> Bool
78 is_bindigit c = c == '0' || c == '1'
79
80 to_lower :: Char -> Char
81 to_lower c
82 | c >= 'A' && c <= 'Z' = chr (ord c - (ord 'A' - ord 'a'))
83 | otherwise = c
84
85 charType :: Char -> Word8
86 charType c = case c of
87 '\0' -> 0 -- \000
88 '\1' -> 0 -- \001
89 '\2' -> 0 -- \002
90 '\3' -> 0 -- \003
91 '\4' -> 0 -- \004
92 '\5' -> 0 -- \005
93 '\6' -> 0 -- \006
94 '\7' -> 0 -- \007
95 '\8' -> 0 -- \010
96 '\9' -> cSpace -- \t (not allowed in strings, so !cAny)
97 '\10' -> cSpace -- \n (ditto)
98 '\11' -> cSpace -- \v (ditto)
99 '\12' -> cSpace -- \f (ditto)
100 '\13' -> cSpace -- ^M (ditto)
101 '\14' -> 0 -- \016
102 '\15' -> 0 -- \017
103 '\16' -> 0 -- \020
104 '\17' -> 0 -- \021
105 '\18' -> 0 -- \022
106 '\19' -> 0 -- \023
107 '\20' -> 0 -- \024
108 '\21' -> 0 -- \025
109 '\22' -> 0 -- \026
110 '\23' -> 0 -- \027
111 '\24' -> 0 -- \030
112 '\25' -> 0 -- \031
113 '\26' -> 0 -- \032
114 '\27' -> 0 -- \033
115 '\28' -> 0 -- \034
116 '\29' -> 0 -- \035
117 '\30' -> 0 -- \036
118 '\31' -> 0 -- \037
119 '\32' -> cAny .|. cSpace --
120 '\33' -> cAny .|. cSymbol -- !
121 '\34' -> cAny -- "
122 '\35' -> cAny .|. cSymbol -- #
123 '\36' -> cAny .|. cSymbol -- $
124 '\37' -> cAny .|. cSymbol -- %
125 '\38' -> cAny .|. cSymbol -- &
126 '\39' -> cAny .|. cIdent -- '
127 '\40' -> cAny -- (
128 '\41' -> cAny -- )
129 '\42' -> cAny .|. cSymbol -- *
130 '\43' -> cAny .|. cSymbol -- +
131 '\44' -> cAny -- ,
132 '\45' -> cAny .|. cSymbol -- -
133 '\46' -> cAny .|. cSymbol -- .
134 '\47' -> cAny .|. cSymbol -- /
135 '\48' -> cAny .|. cIdent .|. cDigit -- 0
136 '\49' -> cAny .|. cIdent .|. cDigit -- 1
137 '\50' -> cAny .|. cIdent .|. cDigit -- 2
138 '\51' -> cAny .|. cIdent .|. cDigit -- 3
139 '\52' -> cAny .|. cIdent .|. cDigit -- 4
140 '\53' -> cAny .|. cIdent .|. cDigit -- 5
141 '\54' -> cAny .|. cIdent .|. cDigit -- 6
142 '\55' -> cAny .|. cIdent .|. cDigit -- 7
143 '\56' -> cAny .|. cIdent .|. cDigit -- 8
144 '\57' -> cAny .|. cIdent .|. cDigit -- 9
145 '\58' -> cAny .|. cSymbol -- :
146 '\59' -> cAny -- ;
147 '\60' -> cAny .|. cSymbol -- <
148 '\61' -> cAny .|. cSymbol -- =
149 '\62' -> cAny .|. cSymbol -- >
150 '\63' -> cAny .|. cSymbol -- ?
151 '\64' -> cAny .|. cSymbol -- @
152 '\65' -> cAny .|. cIdent .|. cUpper -- A
153 '\66' -> cAny .|. cIdent .|. cUpper -- B
154 '\67' -> cAny .|. cIdent .|. cUpper -- C
155 '\68' -> cAny .|. cIdent .|. cUpper -- D
156 '\69' -> cAny .|. cIdent .|. cUpper -- E
157 '\70' -> cAny .|. cIdent .|. cUpper -- F
158 '\71' -> cAny .|. cIdent .|. cUpper -- G
159 '\72' -> cAny .|. cIdent .|. cUpper -- H
160 '\73' -> cAny .|. cIdent .|. cUpper -- I
161 '\74' -> cAny .|. cIdent .|. cUpper -- J
162 '\75' -> cAny .|. cIdent .|. cUpper -- K
163 '\76' -> cAny .|. cIdent .|. cUpper -- L
164 '\77' -> cAny .|. cIdent .|. cUpper -- M
165 '\78' -> cAny .|. cIdent .|. cUpper -- N
166 '\79' -> cAny .|. cIdent .|. cUpper -- O
167 '\80' -> cAny .|. cIdent .|. cUpper -- P
168 '\81' -> cAny .|. cIdent .|. cUpper -- Q
169 '\82' -> cAny .|. cIdent .|. cUpper -- R
170 '\83' -> cAny .|. cIdent .|. cUpper -- S
171 '\84' -> cAny .|. cIdent .|. cUpper -- T
172 '\85' -> cAny .|. cIdent .|. cUpper -- U
173 '\86' -> cAny .|. cIdent .|. cUpper -- V
174 '\87' -> cAny .|. cIdent .|. cUpper -- W
175 '\88' -> cAny .|. cIdent .|. cUpper -- X
176 '\89' -> cAny .|. cIdent .|. cUpper -- Y
177 '\90' -> cAny .|. cIdent .|. cUpper -- Z
178 '\91' -> cAny -- [
179 '\92' -> cAny .|. cSymbol -- backslash
180 '\93' -> cAny -- ]
181 '\94' -> cAny .|. cSymbol -- ^
182 '\95' -> cAny .|. cIdent .|. cLower -- _
183 '\96' -> cAny -- `
184 '\97' -> cAny .|. cIdent .|. cLower -- a
185 '\98' -> cAny .|. cIdent .|. cLower -- b
186 '\99' -> cAny .|. cIdent .|. cLower -- c
187 '\100' -> cAny .|. cIdent .|. cLower -- d
188 '\101' -> cAny .|. cIdent .|. cLower -- e
189 '\102' -> cAny .|. cIdent .|. cLower -- f
190 '\103' -> cAny .|. cIdent .|. cLower -- g
191 '\104' -> cAny .|. cIdent .|. cLower -- h
192 '\105' -> cAny .|. cIdent .|. cLower -- i
193 '\106' -> cAny .|. cIdent .|. cLower -- j
194 '\107' -> cAny .|. cIdent .|. cLower -- k
195 '\108' -> cAny .|. cIdent .|. cLower -- l
196 '\109' -> cAny .|. cIdent .|. cLower -- m
197 '\110' -> cAny .|. cIdent .|. cLower -- n
198 '\111' -> cAny .|. cIdent .|. cLower -- o
199 '\112' -> cAny .|. cIdent .|. cLower -- p
200 '\113' -> cAny .|. cIdent .|. cLower -- q
201 '\114' -> cAny .|. cIdent .|. cLower -- r
202 '\115' -> cAny .|. cIdent .|. cLower -- s
203 '\116' -> cAny .|. cIdent .|. cLower -- t
204 '\117' -> cAny .|. cIdent .|. cLower -- u
205 '\118' -> cAny .|. cIdent .|. cLower -- v
206 '\119' -> cAny .|. cIdent .|. cLower -- w
207 '\120' -> cAny .|. cIdent .|. cLower -- x
208 '\121' -> cAny .|. cIdent .|. cLower -- y
209 '\122' -> cAny .|. cIdent .|. cLower -- z
210 '\123' -> cAny -- {
211 '\124' -> cAny .|. cSymbol -- |
212 '\125' -> cAny -- }
213 '\126' -> cAny .|. cSymbol -- ~
214 '\127' -> 0 -- \177
215 _ -> panic ("charType: " ++ show c)