Commit d2fbc33c authored by Alec Theriault's avatar Alec Theriault Committed by Ben Gamari

Simplify 'ExtBits' in the lexer

The main change is to export 'ExtBits' 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

Subscribers: sjakobi, rwbarton, mpickering, carter

Differential Revision: https://phabricator.haskell.org/D5332
parent 5aa29231
This diff is collapsed.
...@@ -3744,14 +3744,14 @@ fileSrcSpan = do ...@@ -3744,14 +3744,14 @@ fileSrcSpan = do
-- Hint about the MultiWayIf extension -- Hint about the MultiWayIf extension
hintMultiWayIf :: SrcSpan -> P () hintMultiWayIf :: SrcSpan -> P ()
hintMultiWayIf span = do hintMultiWayIf span = do
mwiEnabled <- extension multiWayIfEnabled mwiEnabled <- getBit MultiWayIfBit
unless mwiEnabled $ parseErrorSDoc span $ unless mwiEnabled $ parseErrorSDoc span $
text "Multi-way if-expressions need MultiWayIf turned on" text "Multi-way if-expressions need MultiWayIf turned on"
-- Hint about if usage for beginners -- Hint about if usage for beginners
hintIf :: SrcSpan -> String -> P (LHsExpr GhcPs) hintIf :: SrcSpan -> String -> P (LHsExpr GhcPs)
hintIf span msg = do hintIf span msg = do
mwiEnabled <- extension multiWayIfEnabled mwiEnabled <- getBit MultiWayIfBit
if mwiEnabled if mwiEnabled
then parseErrorSDoc span $ text $ "parse error in if statement" then parseErrorSDoc span $ text $ "parse error in if statement"
else parseErrorSDoc span $ text $ "parse error in if statement: "++msg else parseErrorSDoc span $ text $ "parse error in if statement: "++msg
...@@ -3759,8 +3759,8 @@ hintIf span msg = do ...@@ -3759,8 +3759,8 @@ hintIf span msg = do
-- Hint about explicit-forall, assuming UnicodeSyntax is on -- Hint about explicit-forall, assuming UnicodeSyntax is on
hintExplicitForall :: SrcSpan -> P () hintExplicitForall :: SrcSpan -> P ()
hintExplicitForall span = do hintExplicitForall span = do
forall <- extension explicitForallEnabled forall <- getBit ExplicitForallBit
rulePrag <- extension inRulePrag rulePrag <- getBit InRulePragBit
unless (forall || rulePrag) $ parseErrorSDoc span $ vcat unless (forall || rulePrag) $ parseErrorSDoc span $ vcat
[ text "Illegal symbol '\x2200' in type" -- U+2200 FOR ALL [ text "Illegal symbol '\x2200' in type" -- U+2200 FOR ALL
, text "Perhaps you intended to use RankNTypes or a similar language" , text "Perhaps you intended to use RankNTypes or a similar language"
...@@ -3770,7 +3770,7 @@ hintExplicitForall span = do ...@@ -3770,7 +3770,7 @@ hintExplicitForall span = do
-- Hint about explicit-forall, assuming UnicodeSyntax is off -- Hint about explicit-forall, assuming UnicodeSyntax is off
hintExplicitForall' :: SrcSpan -> P (GenLocated SrcSpan RdrName) hintExplicitForall' :: SrcSpan -> P (GenLocated SrcSpan RdrName)
hintExplicitForall' span = do hintExplicitForall' span = do
forall <- extension explicitForallEnabled forall <- getBit ExplicitForallBit
let illegalDot = "Illegal symbol '.' in type" let illegalDot = "Illegal symbol '.' in type"
if forall if forall
then parseErrorSDoc span $ vcat then parseErrorSDoc span $ vcat
...@@ -3790,7 +3790,7 @@ checkIfBang _ = False ...@@ -3790,7 +3790,7 @@ checkIfBang _ = False
-- | Warn about missing space after bang -- | Warn about missing space after bang
warnSpaceAfterBang :: SrcSpan -> P () warnSpaceAfterBang :: SrcSpan -> P ()
warnSpaceAfterBang span = do warnSpaceAfterBang span = do
bang_on <- extension bangPatEnabled bang_on <- getBit BangPatBit
unless bang_on $ unless bang_on $
addWarning Opt_WarnSpaceAfterBang span msg addWarning Opt_WarnSpaceAfterBang span msg
where where
...@@ -3803,7 +3803,7 @@ warnSpaceAfterBang span = do ...@@ -3803,7 +3803,7 @@ warnSpaceAfterBang span = do
-- variable or constructor. See Trac #13450. -- variable or constructor. See Trac #13450.
reportEmptyDoubleQuotes :: SrcSpan -> P (GenLocated SrcSpan (HsExpr GhcPs)) reportEmptyDoubleQuotes :: SrcSpan -> P (GenLocated SrcSpan (HsExpr GhcPs))
reportEmptyDoubleQuotes span = do reportEmptyDoubleQuotes span = do
thQuotes <- extension thQuotesEnabled thQuotes <- getBit ThQuotesBit
if thQuotes if thQuotes
then parseErrorSDoc span $ vcat then parseErrorSDoc span $ vcat
[ text "Parser error on `''`" [ text "Parser error on `''`"
......
...@@ -845,7 +845,7 @@ equalsDots = text "= ..." ...@@ -845,7 +845,7 @@ equalsDots = text "= ..."
checkDatatypeContext :: Maybe (LHsContext GhcPs) -> P () checkDatatypeContext :: Maybe (LHsContext GhcPs) -> P ()
checkDatatypeContext Nothing = return () checkDatatypeContext Nothing = return ()
checkDatatypeContext (Just (L loc c)) checkDatatypeContext (Just (L loc c))
= do allowed <- extension datatypeContextsEnabled = do allowed <- getBit DatatypeContextsBit
unless allowed $ unless allowed $
parseErrorSDoc loc parseErrorSDoc loc
(text "Illegal datatype context (use DatatypeContexts):" <+> (text "Illegal datatype context (use DatatypeContexts):" <+>
...@@ -880,7 +880,7 @@ checkRuleTyVarBndrNames = mapM_ (check . fmap hsTyVarName) ...@@ -880,7 +880,7 @@ checkRuleTyVarBndrNames = mapM_ (check . fmap hsTyVarName)
checkRecordSyntax :: Outputable a => Located a -> P (Located a) checkRecordSyntax :: Outputable a => Located a -> P (Located a)
checkRecordSyntax lr@(L loc r) checkRecordSyntax lr@(L loc r)
= do allowed <- extension traditionalRecordSyntaxEnabled = do allowed <- getBit TraditionalRecordSyntaxBit
if allowed if allowed
then return lr then return lr
else parseErrorSDoc loc else parseErrorSDoc loc
...@@ -892,7 +892,7 @@ checkRecordSyntax lr@(L loc r) ...@@ -892,7 +892,7 @@ checkRecordSyntax lr@(L loc r)
checkEmptyGADTs :: Located ([AddAnn], [LConDecl GhcPs]) checkEmptyGADTs :: Located ([AddAnn], [LConDecl GhcPs])
-> P (Located ([AddAnn], [LConDecl GhcPs])) -> P (Located ([AddAnn], [LConDecl GhcPs]))
checkEmptyGADTs gadts@(L span (_, [])) -- Empty GADT declaration. checkEmptyGADTs gadts@(L span (_, [])) -- Empty GADT declaration.
= do gadtSyntax <- extension gadtSyntaxEnabled -- GADTs implies GADTSyntax = do gadtSyntax <- getBit GadtSyntaxBit -- GADTs implies GADTSyntax
if gadtSyntax if gadtSyntax
then return gadts then return gadts
else parseErrorSDoc span $ vcat else parseErrorSDoc span $ vcat
...@@ -957,7 +957,7 @@ checkBlockArguments expr = case unLoc expr of ...@@ -957,7 +957,7 @@ checkBlockArguments expr = case unLoc expr of
_ -> return () _ -> return ()
where where
check element = do check element = do
blockArguments <- extension blockArgumentsEnabled blockArguments <- getBit BlockArgumentsBit
unless blockArguments $ unless blockArguments $
parseErrorSDoc (getLoc expr) $ parseErrorSDoc (getLoc expr) $
text "Unexpected " <> text element <> text " in function application:" text "Unexpected " <> text element <> text " in function application:"
...@@ -1043,7 +1043,7 @@ checkPat msg loc e _ ...@@ -1043,7 +1043,7 @@ checkPat msg loc e _
checkAPat :: SDoc -> SrcSpan -> HsExpr GhcPs -> P (Pat GhcPs) checkAPat :: SDoc -> SrcSpan -> HsExpr GhcPs -> P (Pat GhcPs)
checkAPat msg loc e0 = do checkAPat msg loc e0 = do
nPlusKPatterns <- extension nPlusKPatternsEnabled nPlusKPatterns <- getBit NPlusKPatternsBit
case e0 of case e0 of
EWildPat _ -> return (WildPat noExt) EWildPat _ -> return (WildPat noExt)
HsVar _ x -> return (VarPat noExt x) HsVar _ x -> return (VarPat noExt x)
...@@ -1240,7 +1240,7 @@ checkDoAndIfThenElse :: LHsExpr GhcPs ...@@ -1240,7 +1240,7 @@ checkDoAndIfThenElse :: LHsExpr GhcPs
-> P () -> P ()
checkDoAndIfThenElse guardExpr semiThen thenExpr semiElse elseExpr checkDoAndIfThenElse guardExpr semiThen thenExpr semiElse elseExpr
| semiThen || semiElse | semiThen || semiElse
= do doAndIfThenElse <- extension doAndIfThenElseEnabled = do doAndIfThenElse <- getBit DoAndIfThenElseBit
unless doAndIfThenElse $ do unless doAndIfThenElse $ do
parseErrorSDoc (combineLocs guardExpr elseExpr) parseErrorSDoc (combineLocs guardExpr elseExpr)
(text "Unexpected semi-colons in conditional:" (text "Unexpected semi-colons in conditional:"
...@@ -1311,7 +1311,7 @@ isFunLhs e = go e [] [] ...@@ -1311,7 +1311,7 @@ isFunLhs e = go e [] []
go e@(L loc (OpApp _ l (L loc' (HsVar _ (L _ op))) r)) es ann go e@(L loc (OpApp _ l (L loc' (HsVar _ (L _ op))) r)) es ann
| Just (e',es') <- splitBang e | Just (e',es') <- splitBang e
= do { bang_on <- extension bangPatEnabled = do { bang_on <- getBit BangPatBit
; if bang_on then go e' (es' ++ es) ann ; if bang_on then go e' (es' ++ es) ann
else return (Just (L loc' op, Infix, (l:r:es), ann)) } else return (Just (L loc' op, Infix, (l:r:es), ann)) }
-- No bangs; behave just like the next case -- No bangs; behave just like the next case
...@@ -1741,14 +1741,14 @@ mergeDataCon all_xs = ...@@ -1741,14 +1741,14 @@ mergeDataCon all_xs =
nest 2 (hsep . reverse $ map ppr 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, -- If the flag MonadComprehensions is set, return a 'MonadComp' context,
-- otherwise use the usual `ListComp' context -- otherwise use the usual 'ListComp' context
checkMonadComp :: P (HsStmtContext Name) checkMonadComp :: P (HsStmtContext Name)
checkMonadComp = do checkMonadComp = do
monadComprehensions <- extension monadComprehensionsEnabled monadComprehensions <- getBit TransformComprehensionsBit
return $ if monadComprehensions return $ if monadComprehensions
then MonadComp then MonadComp
else ListComp else ListComp
...@@ -2066,8 +2066,8 @@ mkModuleImpExp (L l specname) subs = ...@@ -2066,8 +2066,8 @@ mkModuleImpExp (L l specname) subs =
ImpExpList xs -> ImpExpList xs ->
(\newName -> IEThingWith noExt (L l newName) NoIEWildcard (wrapped xs) []) (\newName -> IEThingWith noExt (L l newName) NoIEWildcard (wrapped xs) [])
<$> nameT <$> nameT
ImpExpAllWith xs -> ImpExpAllWith xs ->
do allowed <- extension patternSynonymsEnabled do allowed <- getBit PatternSynonymsBit
if allowed if allowed
then then
let withs = map unLoc xs let withs = map unLoc xs
...@@ -2104,7 +2104,7 @@ mkModuleImpExp (L l specname) subs = ...@@ -2104,7 +2104,7 @@ mkModuleImpExp (L l specname) subs =
mkTypeImpExp :: Located RdrName -- TcCls or Var name space mkTypeImpExp :: Located RdrName -- TcCls or Var name space
-> P (Located RdrName) -> P (Located RdrName)
mkTypeImpExp name = mkTypeImpExp name =
do allowed <- extension explicitNamespacesEnabled do allowed <- getBit ExplicitNamespacesBit
if allowed if allowed
then return (fmap (`setRdrNameSpace` tcClsName) name) then return (fmap (`setRdrNameSpace` tcClsName) name)
else parseErrorSDoc (getLoc name) else parseErrorSDoc (getLoc name)
...@@ -2160,7 +2160,7 @@ warnStarBndr span = addWarning Opt_WarnStarBinder span msg ...@@ -2160,7 +2160,7 @@ warnStarBndr span = addWarning Opt_WarnStarBinder span msg
failOpFewArgs :: Located RdrName -> P a failOpFewArgs :: Located RdrName -> P a
failOpFewArgs (L loc op) = failOpFewArgs (L loc op) =
do { star_is_type <- extension starIsTypeEnabled do { star_is_type <- getBit StarIsTypeBit
; let msg = too_few $$ starInfo star_is_type op ; let msg = too_few $$ starInfo star_is_type op
; parseErrorSDoc loc msg } ; parseErrorSDoc loc msg }
where where
...@@ -2192,7 +2192,7 @@ parseErrorSDoc span s = failSpanMsgP span s ...@@ -2192,7 +2192,7 @@ parseErrorSDoc span s = failSpanMsgP span s
-- | Hint about bang patterns, assuming @BangPatterns@ is off. -- | Hint about bang patterns, assuming @BangPatterns@ is off.
hintBangPat :: SrcSpan -> HsExpr GhcPs -> P () hintBangPat :: SrcSpan -> HsExpr GhcPs -> P ()
hintBangPat span e = do hintBangPat span e = do
bang_on <- extension bangPatEnabled bang_on <- getBit BangPatBit
unless bang_on $ unless bang_on $
parseErrorSDoc span parseErrorSDoc span
(text "Illegal bang-pattern (use BangPatterns):" $$ ppr e) (text "Illegal bang-pattern (use BangPatterns):" $$ ppr e)
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment