diff options
author | Vladislav Zavialov <vlad.z.4096@gmail.com> | 2019-03-25 13:33:32 +0300 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2019-04-25 14:28:56 -0400 |
commit | 0fc69416f5ed7186ce68c7a758cdd4c52fbf98f6 (patch) | |
tree | fb63a7331096829254b3ce43c732c55cd43d1d31 /compiler/parser/Lexer.x | |
parent | 465f8f48c8f196a7b696a360c2f3c636cc88321a (diff) | |
download | haskell-0fc69416f5ed7186ce68c7a758cdd4c52fbf98f6.tar.gz |
Introduce MonadP, make PV a newtype
Previously we defined type PV = P,
this had the downside that if we wanted to change PV,
we would have to modify P as well.
Now PV is free to evolve independently from P.
The common operations addError, addFatalError, getBit, addAnnsAt,
were abstracted into a class called MonadP.
Diffstat (limited to 'compiler/parser/Lexer.x')
-rw-r--r-- | compiler/parser/Lexer.x | 86 |
1 files changed, 48 insertions, 38 deletions
diff --git a/compiler/parser/Lexer.x b/compiler/parser/Lexer.x index 6feb06b586..0f3997e168 100644 --- a/compiler/parser/Lexer.x +++ b/compiler/parser/Lexer.x @@ -50,16 +50,17 @@ module Lexer ( Token(..), lexer, pragState, mkPState, mkPStatePure, PState(..), P(..), ParseResult(..), mkParserFlags, mkParserFlags', ParserFlags, + MonadP(..), getRealSrcLoc, getPState, withThisPackage, failLocMsgP, srcParseFail, getErrorMessages, getMessages, popContext, pushModuleContext, setLastToken, setSrcLoc, activeContext, nextIsEOF, getLexState, popLexState, pushLexState, - ExtBits(..), getBit, - addWarning, addError, addFatalError, + ExtBits(..), + addWarning, lexTokenStream, - addAnnotation,AddAnn,addAnnsAt,mkParensApiAnn, + addAnnotation,AddAnn,mkParensApiAnn, commentToAnnotation ) where @@ -2276,11 +2277,6 @@ setAlrExpectingOCurly b = P $ \s -> POk (s {alr_expecting_ocurly = b}) () -- stored in a @Word64@. type ExtsBitmap = Word64 --- | Check if a given flag is currently set in the bitmap. -getBit :: ExtBits -> P Bool -getBit ext = P $ \s -> let b = ext `xtest` pExtsBitmap (options s) - in b `seq` POk s b - xbit :: ExtBits -> ExtsBitmap xbit = bit . fromEnum @@ -2474,34 +2470,52 @@ mkPStatePure options buf loc = annotations_comments = [] } --- | Add a non-fatal error. Use this when the parser can produce a result --- despite the error. --- --- For example, when GHC encounters a @forall@ in a type, --- but @-XExplicitForAll@ is disabled, the parser constructs @ForAllTy@ --- as if @-XExplicitForAll@ was enabled, adding a non-fatal error to --- the accumulator. +-- | An mtl-style class for monads that support parsing-related operations. +-- For example, sometimes we make a second pass over the parsing results to validate, +-- disambiguate, or rearrange them, and we do so in the PV monad which cannot consume +-- input but can report parsing errors, check for extension bits, and accumulate +-- parsing annotations. Both P and PV are instances of MonadP. -- --- Control flow wise, non-fatal errors act like warnings: they are added --- to the accumulator and parsing continues. This allows GHC to report --- more than one parse error per file. +-- MonadP grants us convenient overloading. The other option is to have separate operations +-- for each monad: addErrorP vs addErrorPV, getBitP vs getBitPV, and so on. -- -addError :: SrcSpan -> SDoc -> P () -addError srcspan msg - = P $ \s@PState{messages=m} -> - let - m' d = - let (ws, es) = m d - errormsg = mkErrMsg d srcspan alwaysQualify msg - es' = es `snocBag` errormsg - in (ws, es') - in POk s{messages=m'} () - --- | Add a fatal error. This will be the last error reported by the parser, and --- the parser will not produce any result, ending in a 'PFailed' state. -addFatalError :: SrcSpan -> SDoc -> P a -addFatalError span msg = - addError span msg >> P PFailed +class Monad m => MonadP m where + -- | Add a non-fatal error. Use this when the parser can produce a result + -- despite the error. + -- + -- For example, when GHC encounters a @forall@ in a type, + -- but @-XExplicitForAll@ is disabled, the parser constructs @ForAllTy@ + -- as if @-XExplicitForAll@ was enabled, adding a non-fatal error to + -- the accumulator. + -- + -- Control flow wise, non-fatal errors act like warnings: they are added + -- to the accumulator and parsing continues. This allows GHC to report + -- more than one parse error per file. + -- + addError :: SrcSpan -> SDoc -> m () + -- | Add a fatal error. This will be the last error reported by the parser, and + -- the parser will not produce any result, ending in a 'PFailed' state. + addFatalError :: SrcSpan -> SDoc -> m a + -- | Check if a given flag is currently set in the bitmap. + getBit :: ExtBits -> m Bool + -- | Given a location and a list of AddAnn, apply them all to the location. + addAnnsAt :: SrcSpan -> [AddAnn] -> m () + +instance MonadP P where + addError srcspan msg + = P $ \s@PState{messages=m} -> + let + m' d = + let (ws, es) = m d + errormsg = mkErrMsg d srcspan alwaysQualify msg + es' = es `snocBag` errormsg + in (ws, es') + in POk s{messages=m'} () + addFatalError span msg = + addError span msg >> P PFailed + getBit ext = P $ \s -> let b = ext `xtest` pExtsBitmap (options s) + in b `seq` POk s b + addAnnsAt loc anns = mapM_ (\a -> a loc) anns -- | Add a warning to the accumulator. -- Use 'getMessages' to get the accumulated warnings. @@ -3055,10 +3069,6 @@ addAnnotationOnly l a v = P $ \s -> POk s { annotations = ((l,a), [v]) : annotations s } () --- |Given a location and a list of AddAnn, apply them all to the location. -addAnnsAt :: SrcSpan -> [AddAnn] -> P () -addAnnsAt loc anns = mapM_ (\a -> a loc) anns - -- |Given a 'SrcSpan' that surrounds a 'HsPar' or 'HsParTy', generate -- 'AddAnn' values for the opening and closing bordering on the start -- and end of the span |