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