| ITlabel
| ITdynamic
| ITunsafe
+ | ITwith
+ | ITstdcallconv
+ | ITccallconv
| ITinterface -- interface keywords
| IT__export
| ITlit_lit
| ITstring_lit
| ITtypeapp
- | ITonce
- | ITmany
+ | ITusage
+ | ITfuall
| ITarity
| ITspecialise
| ITnocaf
| ITunfold InlinePragInfo
| ITstrict ([Demand], Bool)
| ITrules
+ | ITdeprecated
| ITcprinfo (CprInfo)
| IT__scc
| ITsccAllCafs
| ITinline_prag
| ITnoinline_prag
| ITrules_prag
+ | ITdeprecated_prag
| ITline_prag
| ITclose_prag
| ITqvarsym (FAST_STRING,FAST_STRING)
| ITqconsym (FAST_STRING,FAST_STRING)
+ | ITipvarid FAST_STRING -- GHC extension: implicit param: ?x
+
| ITpragma StringBuffer
| ITchar Char
( "NOTINLINE", ITnoinline_prag ),
( "LINE", ITline_prag ),
( "RULES", ITrules_prag ),
- ( "RULEZ", ITrules_prag ) -- american spelling :-)
+ ( "RULEZ", ITrules_prag ), -- american spelling :-)
+ ( "DEPRECATED", ITdeprecated_prag )
]
haskellKeywordsFM = listToUFM $
( "label", ITlabel ),
( "dynamic", ITdynamic ),
( "unsafe", ITunsafe ),
+ ( "with", ITwith ),
+ ( "stdcall", ITstdcallconv),
+ ( "ccall", ITccallconv),
("_ccall_", ITccall (False, False, False)),
("_ccall_GC_", ITccall (False, False, True)),
("_casm_", ITccall (False, True, False)),
("__litlit", ITlit_lit),
("__string", ITstring_lit),
("__a", ITtypeapp),
- ("__o", ITonce),
- ("__m", ITmany),
+ ("__u", ITusage),
+ ("__fuall", ITfuall),
("__A", ITarity),
("__P", ITspecialise),
("__C", ITnocaf),
("__R", ITrules),
- ("__u", ITunfold NoInlinePragInfo),
+ ("__D", ITdeprecated),
+ ("__U", ITunfold NoInlinePragInfo),
("__ccall", ITccall (False, False, False)),
("__ccall_GC", ITccall (False, False, True)),
})
-- first, start a new lexeme and lose all the whitespace
- = tab line bol atbol (stepOverLexeme buf)
+ = _scc_ "Lexer"
+ tab line bol atbol (stepOverLexeme buf)
where
line = srcLocLine loc
lexToken :: (Token -> P a) -> Int# -> P a
lexToken cont glaexts buf =
--trace "lexToken" $
- _scc_ "Lexer"
case currentChar# buf of
-- special symbols ----------------------------------------------------
trace "lexIface: misplaced NUL?" $
cont (ITunknown "\NUL") (stepOn buf)
+ '?'# | flag glaexts && is_lower (lookAhead# buf 1#) ->
+ lex_ip cont (stepOn buf)
c | is_digit c -> lex_num cont glaexts 0 buf
| is_symbol c -> lex_sym cont buf
| is_upper c -> lex_con cont glaexts buf
-- ignore \& in a string, deal with string gaps
'\\'# | next_ch `eqChar#` '&'#
- -> lex_string cont glaexts s (setCurrentPos# buf 2#)
+ -> lex_string cont glaexts s buf'
| is_space next_ch
- -> lex_stringgap cont glaexts s buf'
+ -> lex_stringgap cont glaexts s (incLexeme buf)
where next_ch = lookAhead# buf 1#
buf' = setCurrentPos# buf 2#
is_hexdigit c
= is_digit c
- || (c `geChar#` 'a'# && c `leChar#` 'h'#)
- || (c `geChar#` 'A'# && c `leChar#` 'H'#)
+ || (c `geChar#` 'a'# && c `leChar#` 'f'#)
+ || (c `geChar#` 'A'# && c `leChar#` 'F'#)
hex c | is_digit c = ord# c -# ord# '0'#
| otherwise = ord# (to_lower c) -# ord# 'a'# +# 10#
lex_cstring cont buf =
case expandUntilMatch (stepOverLexeme buf) "\'\'" of
- buf' -> cont (ITlitlit (lexemeToFastString
+ Just buf' -> cont (ITlitlit (lexemeToFastString
(setCurrentPos# buf' (negateInt# 2#))))
- (mergeLexemes buf buf')
+ (mergeLexemes buf buf')
+ Nothing -> lexError "unterminated ``" buf
------------------------------------------------------------------------------
-- Character Classes
is_symbol = is_ctype 2
is_any = is_ctype 4
is_space = is_ctype 8
-is_upper = is_ctype 16
-is_digit = is_ctype 32
+is_lower = is_ctype 16
+is_upper = is_ctype 32
+is_digit = is_ctype 64
-----------------------------------------------------------------------------
-- identifiers, symbols etc.
+lex_ip cont buf =
+ case expandWhile# is_ident buf of
+ buf' -> cont (ITipvarid lexeme) buf'
+ where lexeme = lexemeToFastString buf'
+
lex_id cont glaexts buf =
case expandWhile# is_ident buf of { buf1 ->