'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

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)