X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fparser%2FLexer.x;h=fdbaeef3feaa773673b9bdec87c2e9d6220df075;hb=ac9c1e5de9629103a125e0515dcee2466ff898a7;hp=5015ca7059d40e00118eb1175a0dcca1cd14c422;hpb=543a890b3de87c2535072c894035996661bf106c;p=ghc-hetmet.git diff --git a/compiler/parser/Lexer.x b/compiler/parser/Lexer.x index 5015ca7..fdbaeef 100644 --- a/compiler/parser/Lexer.x +++ b/compiler/parser/Lexer.x @@ -216,6 +216,11 @@ $white_no_nl+ ; "{-#" $whitechar* (INCLUDE|include) { lex_string_prag ITinclude_prag } } +<0,option_prags,glaexts> { + -- This is to catch things like {-# OPTIONS OPTIONS_HUGS ... + "{-#" $whitechar* $idchar+ { nested_comment } +} + -- '0' state: ordinary lexemes -- 'glaexts' state: glasgow extensions (postfix '#', etc.) @@ -371,6 +376,8 @@ data Token | ITccallconv | ITdotnet | ITmdo + | ITiso + | ITfamily -- Pragmas | ITinline_prag Bool -- True <=> INLINE, False <=> NOINLINE @@ -494,6 +501,8 @@ isSpecial ITunsafe = True isSpecial ITccallconv = True isSpecial ITstdcallconv = True isSpecial ITmdo = True +isSpecial ITiso = True +isSpecial ITfamily = True isSpecial _ = False -- the bitmap provided as the third component indicates whether the @@ -534,6 +543,8 @@ reservedWordsFM = listToUFM $ ( "forall", ITforall, bit tvBit), ( "mdo", ITmdo, bit glaExtsBit), + ( "iso", ITiso, bit glaExtsBit), + ( "family", ITfamily, bit glaExtsBit), ( "foreign", ITforeign, bit ffiBit), ( "export", ITexport, bit ffiBit), @@ -583,6 +594,9 @@ reservedSymsFM = listToUFM $ ,("→", ITrarrow, bit glaExtsBit) ,("←", ITlarrow, bit glaExtsBit) ,("⋯", ITdotdot, bit glaExtsBit) + -- ToDo: ideally, → and ∷ should be "specials", so that they cannot + -- form part of a large operator. This would let us have a better + -- syntax for kinds: ɑ∷*→* would be a legal kind signature. (maybe). #endif ] @@ -1445,15 +1459,13 @@ lexToken = do span `seq` setLastToken span bytes t span buf bytes --- ToDo: Alex reports the buffer at the start of the erroneous lexeme, --- but it would be more informative to report the location where the --- error was actually discovered, especially if this is a decoding --- error. -reportLexError loc1 loc2 buf str = +reportLexError loc1 loc2 buf str + | atEnd buf = failLocMsgP loc1 loc2 (str ++ " at end of input") + | otherwise = let c = fst (nextChar buf) in if c == '\0' -- decoding errors are mapped to '\0', see utf8DecodeChar# - then failLocMsgP loc2 loc2 "UTF-8 decoding error" + then failLocMsgP loc2 loc2 (str ++ " (UTF-8 decoding error)") else failLocMsgP loc1 loc2 (str ++ " at character " ++ show c) }