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
-- Hint about the MultiWayIf extension
hintMultiWayIf :: SrcSpan -> P ()
hintMultiWayIf span = do
mwiEnabled <- extension multiWayIfEnabled
mwiEnabled <- getBit MultiWayIfBit
unless mwiEnabled $ parseErrorSDoc span $
text "Multi-way if-expressions need MultiWayIf turned on"
-- Hint about if usage for beginners
hintIf :: SrcSpan -> String -> P (LHsExpr GhcPs)
hintIf span msg = do
mwiEnabled <- extension multiWayIfEnabled
mwiEnabled <- getBit MultiWayIfBit
if mwiEnabled
then parseErrorSDoc span $ text $ "parse error in if statement"
else parseErrorSDoc span $ text $ "parse error in if statement: "++msg
......@@ -3759,8 +3759,8 @@ hintIf span msg = do
-- Hint about explicit-forall, assuming UnicodeSyntax is on
hintExplicitForall :: SrcSpan -> P ()
hintExplicitForall span = do
forall <- extension explicitForallEnabled
rulePrag <- extension inRulePrag
forall <- getBit ExplicitForallBit
rulePrag <- getBit InRulePragBit
unless (forall || rulePrag) $ parseErrorSDoc span $ vcat
[ text "Illegal symbol '\x2200' in type" -- U+2200 FOR ALL
, text "Perhaps you intended to use RankNTypes or a similar language"
......@@ -3770,7 +3770,7 @@ hintExplicitForall span = do
-- Hint about explicit-forall, assuming UnicodeSyntax is off
hintExplicitForall' :: SrcSpan -> P (GenLocated SrcSpan RdrName)
hintExplicitForall' span = do
forall <- extension explicitForallEnabled
forall <- getBit ExplicitForallBit
let illegalDot = "Illegal symbol '.' in type"
if forall
then parseErrorSDoc span $ vcat
......@@ -3790,7 +3790,7 @@ checkIfBang _ = False
-- | Warn about missing space after bang
warnSpaceAfterBang :: SrcSpan -> P ()
warnSpaceAfterBang span = do
bang_on <- extension bangPatEnabled
bang_on <- getBit BangPatBit
unless bang_on $
addWarning Opt_WarnSpaceAfterBang span msg
where
......@@ -3803,7 +3803,7 @@ warnSpaceAfterBang span = do
-- variable or constructor. See Trac #13450.
reportEmptyDoubleQuotes :: SrcSpan -> P (GenLocated SrcSpan (HsExpr GhcPs))
reportEmptyDoubleQuotes span = do
thQuotes <- extension thQuotesEnabled
thQuotes <- getBit ThQuotesBit
if thQuotes
then parseErrorSDoc span $ vcat
[ text "Parser error on `''`"
......
......@@ -845,7 +845,7 @@ equalsDots = text "= ..."
checkDatatypeContext :: Maybe (LHsContext GhcPs) -> P ()
checkDatatypeContext Nothing = return ()
checkDatatypeContext (Just (L loc c))
= do allowed <- extension datatypeContextsEnabled
= do allowed <- getBit DatatypeContextsBit
unless allowed $
parseErrorSDoc loc
(text "Illegal datatype context (use DatatypeContexts):" <+>
......@@ -880,7 +880,7 @@ checkRuleTyVarBndrNames = mapM_ (check . fmap hsTyVarName)
checkRecordSyntax :: Outputable a => Located a -> P (Located a)
checkRecordSyntax lr@(L loc r)
= do allowed <- extension traditionalRecordSyntaxEnabled
= do allowed <- getBit TraditionalRecordSyntaxBit
if allowed
then return lr
else parseErrorSDoc loc
......@@ -892,7 +892,7 @@ checkRecordSyntax lr@(L loc r)
checkEmptyGADTs :: Located ([AddAnn], [LConDecl GhcPs])
-> P (Located ([AddAnn], [LConDecl GhcPs]))
checkEmptyGADTs gadts@(L span (_, [])) -- Empty GADT declaration.
= do gadtSyntax <- extension gadtSyntaxEnabled -- GADTs implies GADTSyntax
= do gadtSyntax <- getBit GadtSyntaxBit -- GADTs implies GADTSyntax
if gadtSyntax
then return gadts
else parseErrorSDoc span $ vcat
......@@ -957,7 +957,7 @@ checkBlockArguments expr = case unLoc expr of
_ -> return ()
where
check element = do
blockArguments <- extension blockArgumentsEnabled
blockArguments <- getBit BlockArgumentsBit
unless blockArguments $
parseErrorSDoc (getLoc expr) $
text "Unexpected " <> text element <> text " in function application:"
......@@ -1043,7 +1043,7 @@ checkPat msg loc e _
checkAPat :: SDoc -> SrcSpan -> HsExpr GhcPs -> P (Pat GhcPs)
checkAPat msg loc e0 = do
nPlusKPatterns <- extension nPlusKPatternsEnabled
nPlusKPatterns <- getBit NPlusKPatternsBit
case e0 of
EWildPat _ -> return (WildPat noExt)
HsVar _ x -> return (VarPat noExt x)
......@@ -1240,7 +1240,7 @@ checkDoAndIfThenElse :: LHsExpr GhcPs
-> P ()
checkDoAndIfThenElse guardExpr semiThen thenExpr semiElse elseExpr
| semiThen || semiElse
= do doAndIfThenElse <- extension doAndIfThenElseEnabled
= do doAndIfThenElse <- getBit DoAndIfThenElseBit
unless doAndIfThenElse $ do
parseErrorSDoc (combineLocs guardExpr elseExpr)
(text "Unexpected semi-colons in conditional:"
......@@ -1311,7 +1311,7 @@ isFunLhs e = go e [] []
go e@(L loc (OpApp _ l (L loc' (HsVar _ (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 (L loc' op, Infix, (l:r:es), ann)) }
-- No bangs; behave just like the next case
......@@ -1741,14 +1741,14 @@ 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
monadComprehensions <- extension monadComprehensionsEnabled
monadComprehensions <- getBit TransformComprehensionsBit
return $ if monadComprehensions
then MonadComp
else ListComp
......@@ -2067,7 +2067,7 @@ mkModuleImpExp (L l specname) subs =
(\newName -> IEThingWith noExt (L l newName) NoIEWildcard (wrapped xs) [])
<$> nameT
ImpExpAllWith xs ->
do allowed <- extension patternSynonymsEnabled
do allowed <- getBit PatternSynonymsBit
if allowed
then
let withs = map unLoc xs
......@@ -2104,7 +2104,7 @@ mkModuleImpExp (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)
......@@ -2160,7 +2160,7 @@ warnStarBndr span = addWarning Opt_WarnStarBinder span msg
failOpFewArgs :: Located RdrName -> P a
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
; parseErrorSDoc loc msg }
where
......@@ -2192,7 +2192,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)
......
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