diff options
author | Alec Theriault <alec.theriault@gmail.com> | 2019-01-08 12:07:07 -0800 |
---|---|---|
committer | Ben Gamari <ben@well-typed.com> | 2019-01-17 13:39:40 -0500 |
commit | 469fe6133646df5568c9486de2202124cb734242 (patch) | |
tree | fe7458b1d7f4a64b3ad7f7dcb2c7c34bb65b51ec /compiler/parser/RdrHsSyn.hs | |
parent | d512b330f74d947ceb4d2d7c446a4e753532251b (diff) | |
download | haskell-469fe6133646df5568c9486de2202124cb734242.tar.gz |
'DynFlag'-free version of 'mkParserFlags'
Summary:
This is a fixed version of the reverted d2fbc33c4ff3074126ab71654af8bbf8a46e4e11
and 5aa29231ab7603537284eff5e4caff3a73dba6d2.
Obtaining a `DynFlags` is difficult, making using the lexer/parser
for pure parsing/lexing unreasonably difficult, even with `mkPStatePure`.
This is despite the fact that we only really need
* language extension flags
* warning flags
* a handful of boolean options
The new `mkParserFlags'` function makes is easier to directly construct a
`ParserFlags`. Furthermore, since `pExtsBitmap` is just a footgun, I've gone
ahead and made `ParserFlags` an abstract type.
Also, we now export `ExtBits` and `getBit` instead of defining/exporting a
bunch of boilerplate functions that test for a particular 'ExtBits'.
In the process, I also
* cleaned up an unneeded special case for `ITstatic`
* made `UsePosPrags` another variant of `ExtBits`
* made the logic in `reservedSymsFM` match that of `reservedWordsFM`
Test Plan: make test
Reviewers: bgamari, alanz, tdammers
Subscribers: sjakobi, tdammers, rwbarton, mpickering, carter
GHC Trac Issues: #11301
Differential Revision: https://phabricator.haskell.org/D5405
Diffstat (limited to 'compiler/parser/RdrHsSyn.hs')
-rw-r--r-- | compiler/parser/RdrHsSyn.hs | 42 |
1 files changed, 20 insertions, 22 deletions
diff --git a/compiler/parser/RdrHsSyn.hs b/compiler/parser/RdrHsSyn.hs index 4338968ecf..c1777759da 100644 --- a/compiler/parser/RdrHsSyn.hs +++ b/compiler/parser/RdrHsSyn.hs @@ -108,7 +108,6 @@ import Maybes import Util import ApiAnnotation import Data.List -import qualified GHC.LanguageExtensions as LangExt import DynFlags ( WarningFlag(..) ) import Control.Monad @@ -880,7 +879,7 @@ equalsDots = text "= ..." checkDatatypeContext :: Maybe (LHsContext GhcPs) -> P () checkDatatypeContext Nothing = return () checkDatatypeContext (Just c) - = do allowed <- extension datatypeContextsEnabled + = do allowed <- getBit DatatypeContextsBit unless allowed $ parseErrorSDoc (getLoc c) (text "Illegal datatype context (use DatatypeContexts):" @@ -918,7 +917,7 @@ checkRuleTyVarBndrNames = mapM_ (check . fmap hsTyVarName) checkRecordSyntax :: Outputable a => Located a -> P (Located a) checkRecordSyntax lr@(dL->L loc r) - = do allowed <- extension traditionalRecordSyntaxEnabled + = do allowed <- getBit TraditionalRecordSyntaxBit if allowed then return lr else parseErrorSDoc loc @@ -930,8 +929,8 @@ checkRecordSyntax lr@(dL->L loc r) checkEmptyGADTs :: Located ([AddAnn], [LConDecl GhcPs]) -> P (Located ([AddAnn], [LConDecl GhcPs])) checkEmptyGADTs gadts@(dL->L span (_, [])) -- Empty GADT declaration. - = do opts <- fmap options getPState - if LangExt.GADTSyntax `extopt` opts -- GADTs implies GADTSyntax + = do gadtSyntax <- getBit GadtSyntaxBit -- GADTs implies GADTSyntax + if gadtSyntax then return gadts else parseErrorSDoc span $ vcat [ text "Illegal keyword 'where' in data declaration" @@ -995,8 +994,8 @@ checkBlockArguments expr = case unLoc expr of _ -> return () where check element = do - pState <- getPState - unless (extopt LangExt.BlockArguments (options pState)) $ + blockArguments <- getBit BlockArgumentsBit + unless blockArguments $ parseErrorSDoc (getLoc expr) $ text "Unexpected " <> text element <> text " in function application:" $$ nest 4 (ppr expr) @@ -1082,8 +1081,7 @@ checkPat msg loc e _ checkAPat :: SDoc -> SrcSpan -> HsExpr GhcPs -> P (Pat GhcPs) checkAPat msg loc e0 = do - pState <- getPState - let opts = options pState + nPlusKPatterns <- getBit NPlusKPatternsBit case e0 of EWildPat _ -> return (WildPat noExt) HsVar _ x -> return (VarPat noExt x) @@ -1119,7 +1117,7 @@ checkAPat msg loc e0 = do OpApp _ (dL->L nloc (HsVar _ (dL->L _ n))) (dL->L _ (HsVar _ (dL->L _ plus))) (dL->L lloc (HsOverLit _ lit@(OverLit {ol_val = HsIntegral {}}))) - | extopt LangExt.NPlusKPatterns opts && (plus == plus_RDR) + | nPlusKPatterns && (plus == plus_RDR) -> return (mkNPlusKPat (cL nloc n) (cL lloc lit)) OpApp _ l (dL->L cl (HsVar _ (dL->L _ c))) r | isDataOcc (rdrNameOcc c) -> do @@ -1285,8 +1283,8 @@ checkDoAndIfThenElse :: LHsExpr GhcPs -> P () checkDoAndIfThenElse guardExpr semiThen thenExpr semiElse elseExpr | semiThen || semiElse - = do pState <- getPState - unless (extopt LangExt.DoAndIfThenElse (options pState)) $ do + = do doAndIfThenElse <- getBit DoAndIfThenElseBit + unless doAndIfThenElse $ do parseErrorSDoc (combineLocs guardExpr elseExpr) (text "Unexpected semi-colons in conditional:" $$ nest 4 expr @@ -1356,7 +1354,7 @@ isFunLhs e = go e [] [] go e@(L loc (OpApp _ l (dL->L loc' (HsVar _ (dL->L _ op))) r)) es ann | Just (e',es') <- splitBang e - = do { bang_on <- extension bangPatEnabled + = do { bang_on <- getBit BangPatBit ; if bang_on then go e' (es' ++ es) ann else return (Just (cL loc' op, Infix, (l:r:es), ann)) } -- No bangs; behave just like the next case @@ -1837,15 +1835,15 @@ mergeDataCon all_xs = nest 2 (hsep . reverse $ map ppr all_xs') --------------------------------------------------------------------------- --- Check for monad comprehensions +-- | Check for monad comprehensions -- --- If the flag MonadComprehensions is set, return a `MonadComp' context, --- otherwise use the usual `ListComp' context +-- If the flag MonadComprehensions is set, return a 'MonadComp' context, +-- otherwise use the usual 'ListComp' context checkMonadComp :: P (HsStmtContext Name) checkMonadComp = do - pState <- getPState - return $ if extopt LangExt.MonadComprehensions (options pState) + monadComprehensions <- getBit MonadComprehensionsBit + return $ if monadComprehensions then MonadComp else ListComp @@ -2168,7 +2166,7 @@ mkModuleImpExp (dL->L l specname) subs = (\newName -> IEThingWith noExt (cL l newName) NoIEWildcard (wrapped xs) []) <$> nameT ImpExpAllWith xs -> - do allowed <- extension patternSynonymsEnabled + do allowed <- getBit PatternSynonymsBit if allowed then let withs = map unLoc xs @@ -2207,7 +2205,7 @@ mkModuleImpExp (dL->L l specname) subs = mkTypeImpExp :: Located RdrName -- TcCls or Var name space -> P (Located RdrName) mkTypeImpExp name = - do allowed <- extension explicitNamespacesEnabled + do allowed <- getBit ExplicitNamespacesBit if allowed then return (fmap (`setRdrNameSpace` tcClsName) name) else parseErrorSDoc (getLoc name) @@ -2263,7 +2261,7 @@ warnStarBndr span = addWarning Opt_WarnStarBinder span msg failOpFewArgs :: Located RdrName -> P a failOpFewArgs (dL->L loc op) = - do { star_is_type <- extension starIsTypeEnabled + do { star_is_type <- getBit StarIsTypeBit ; let msg = too_few $$ starInfo star_is_type op ; parseErrorSDoc loc msg } where @@ -2295,7 +2293,7 @@ parseErrorSDoc span s = failSpanMsgP span s -- | Hint about bang patterns, assuming @BangPatterns@ is off. hintBangPat :: SrcSpan -> HsExpr GhcPs -> P () hintBangPat span e = do - bang_on <- extension bangPatEnabled + bang_on <- getBit BangPatBit unless bang_on $ parseErrorSDoc span (text "Illegal bang-pattern (use BangPatterns):" $$ ppr e) |