P(..), ParseResult(..), getSrcLoc,
failLocMsgP, failSpanMsgP, srcParseFail,
popContext, pushCurrentContext, setLastToken, setSrcLoc,
- getLexState, popLexState, pushLexState
+ getLexState, popLexState, pushLexState,
+ extension, bangPatEnabled
) where
#include "HsVersions.h"
,(">>-", ITRarrowtail, bit arrowsBit)
#if __GLASGOW_HASKELL__ >= 605
- ,("∀", ITforall, bit tvBit)
- ,("→", ITrarrow, 0)
- ,("←", ITlarrow, 0)
- ,("⋯", ITdotdot, 0)
+ ,("λ", ITlam, bit glaExtsBit)
+ ,("∷", ITdcolon, bit glaExtsBit)
+ ,("⇒", ITdarrow, bit glaExtsBit)
+ ,("∀", ITforall, bit glaExtsBit)
+ ,("→", ITrarrow, bit glaExtsBit)
+ ,("←", ITlarrow, bit glaExtsBit)
+ ,("⋯", ITdotdot, bit glaExtsBit)
#endif
]
#if __GLASGOW_HASKELL__ < 605
= c -- no Unicode support
#else
- | c <= '\x04' = non_graphic
+ | c <= '\x06' = non_graphic
| c <= '\xff' = c
| otherwise =
case generalCategory c of
thBit = 5
ipBit = 6
tvBit = 7 -- Scoped type variables enables 'forall' keyword
+bangPatBit = 8 -- Tells the parser to understand bang-patterns
+ -- (doesn't affect the lexer)
glaExtsEnabled, ffiEnabled, parrEnabled :: Int -> Bool
glaExtsEnabled flags = testBit flags glaExtsBit
thEnabled flags = testBit flags thBit
ipEnabled flags = testBit flags ipBit
tvEnabled flags = testBit flags tvBit
+bangPatEnabled flags = testBit flags bangPatBit
-- create a parse state
--
.|. thBit `setBitIf` dopt Opt_TH flags
.|. ipBit `setBitIf` dopt Opt_ImplicitParams flags
.|. tvBit `setBitIf` dopt Opt_ScopedTypeVariables flags
+ .|. bangPatBit `setBitIf` dopt Opt_BangPatterns flags
--
setBitIf :: Int -> Bool -> Int
b `setBitIf` cond | cond = bit b
lexError str = do
loc <- getSrcLoc
i@(AI end _ buf) <- getInput
- reportLexError loc end buf False str
+ reportLexError loc end buf str
-- -----------------------------------------------------------------------------
-- This is the top-level function: called from the parser each time a
setLastToken span 0
return (L span ITeof)
AlexError (AI loc2 _ buf) -> do
- reportLexError loc1 loc2 buf True "lexical error"
+ reportLexError loc1 loc2 buf "lexical error"
AlexSkip inp2 _ -> do
setInput inp2
lexToken
span `seq` setLastToken span bytes
t span buf bytes
-reportLexError loc1 loc2 buf is_prev str =
+-- 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 =
let
- c | is_prev = prevChar buf '\0'
- | otherwise = fst (nextChar buf)
+ c = fst (nextChar buf)
in
if c == '\0' -- decoding errors are mapped to '\0', see utf8DecodeChar#
then failLocMsgP loc2 loc2 "UTF-8 decoding error"