'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

3 files changed, 296 insertions, 330 deletions

diff --git a/compiler/parser/Lexer.x b/compiler/parser/Lexer.x
index a75566ea39..c64c0173e8 100644
--- a/compiler/parser/Lexer.x
+++ b/compiler/parser/Lexer.x
@@ -48,21 +48,14 @@
 
 module Lexer (
    Token(..), lexer, pragState, mkPState, mkPStatePure, PState(..),
-   P(..), ParseResult(..), mkParserFlags, ParserFlags(..), getRealSrcLoc,
-   getPState, extopt, withThisPackage,
+   P(..), ParseResult(..), mkParserFlags, mkParserFlags', ParserFlags,
+   getRealSrcLoc, getPState, withThisPackage,
    failLocMsgP, failSpanMsgP, srcParseFail,
    getMessages,
    popContext, pushModuleContext, setLastToken, setSrcLoc,
    activeContext, nextIsEOF,
    getLexState, popLexState, pushLexState,
-   extension, bangPatEnabled, datatypeContextsEnabled,
-   traditionalRecordSyntaxEnabled,
-   explicitForallEnabled,
-   inRulePrag,
-   explicitNamespacesEnabled,
-   patternSynonymsEnabled,
-   sccProfilingOn, hpcEnabled,
-   starIsTypeEnabled,
+   ExtBits(..), getBit,
    addWarning,
    lexTokenStream,
    addAnnotation,AddAnn,addAnnsAt,mkParensApiAnn,
@@ -235,7 +228,7 @@ $tab          { warnTab }
 
 -- Next, match Haddock comments if no -haddock flag
 
-"-- " $docsym .* / { ifExtension (not . haddockEnabled) } { lineCommentToken }
+"-- " $docsym .* / { alexNotPred (ifExtension HaddockBit) } { lineCommentToken }
 
 -- Now, when we've matched comments that begin with 2 dashes and continue
 -- with a different character, we need to match comments that begin with three
@@ -361,44 +354,41 @@ $tab          { warnTab }
 -- Haddock comments
 
 <0,option_prags> {
-  "-- " $docsym      / { ifExtension haddockEnabled } { multiline_doc_comment }
-  "{-" \ ? $docsym   / { ifExtension haddockEnabled } { nested_doc_comment }
+  "-- " $docsym      / { ifExtension HaddockBit } { multiline_doc_comment }
+  "{-" \ ? $docsym   / { ifExtension HaddockBit } { nested_doc_comment }
 }
 
 -- "special" symbols
 
 <0> {
-  "[|"        / { ifExtension thQuotesEnabled } { token (ITopenExpQuote NoE
-                                                                NormalSyntax) }
-  "[||"       / { ifExtension thQuotesEnabled } { token (ITopenTExpQuote NoE) }
-  "[e|"       / { ifExtension thQuotesEnabled } { token (ITopenExpQuote HasE
-                                                                NormalSyntax) }
-  "[e||"      / { ifExtension thQuotesEnabled } { token (ITopenTExpQuote HasE) }
-  "[p|"       / { ifExtension thQuotesEnabled } { token ITopenPatQuote }
-  "[d|"       / { ifExtension thQuotesEnabled } { layout_token ITopenDecQuote }
-  "[t|"       / { ifExtension thQuotesEnabled } { token ITopenTypQuote }
-  "|]"        / { ifExtension thQuotesEnabled } { token (ITcloseQuote
-                                                                NormalSyntax) }
-  "||]"       / { ifExtension thQuotesEnabled } { token ITcloseTExpQuote }
-  \$ @varid   / { ifExtension thEnabled } { skip_one_varid ITidEscape }
-  "$$" @varid / { ifExtension thEnabled } { skip_two_varid ITidTyEscape }
-  "$("        / { ifExtension thEnabled } { token ITparenEscape }
-  "$$("       / { ifExtension thEnabled } { token ITparenTyEscape }
-
-  "[" @varid "|"  / { ifExtension qqEnabled }
-                     { lex_quasiquote_tok }
+  "[|"        / { ifExtension ThQuotesBit } { token (ITopenExpQuote NoE NormalSyntax) }
+  "[||"       / { ifExtension ThQuotesBit } { token (ITopenTExpQuote NoE) }
+  "[e|"       / { ifExtension ThQuotesBit } { token (ITopenExpQuote HasE NormalSyntax) }
+  "[e||"      / { ifExtension ThQuotesBit } { token (ITopenTExpQuote HasE) }
+  "[p|"       / { ifExtension ThQuotesBit } { token ITopenPatQuote }
+  "[d|"       / { ifExtension ThQuotesBit } { layout_token ITopenDecQuote }
+  "[t|"       / { ifExtension ThQuotesBit } { token ITopenTypQuote }
+  "|]"        / { ifExtension ThQuotesBit } { token (ITcloseQuote NormalSyntax) }
+  "||]"       / { ifExtension ThQuotesBit } { token ITcloseTExpQuote }
+  \$ @varid   / { ifExtension ThBit }       { skip_one_varid ITidEscape }
+  "$$" @varid / { ifExtension ThBit }       { skip_two_varid ITidTyEscape }
+  "$("        / { ifExtension ThBit }       { token ITparenEscape }
+  "$$("       / { ifExtension ThBit }       { token ITparenTyEscape }
+
+  "[" @varid "|"  / { ifExtension QqBit }   { lex_quasiquote_tok }
 
   -- qualified quasi-quote (#5555)
-  "[" @qvarid "|"  / { ifExtension qqEnabled }
-                     { lex_qquasiquote_tok }
+  "[" @qvarid "|"  / { ifExtension QqBit }  { lex_qquasiquote_tok }
 
   $unigraphic -- ⟦
     / { ifCurrentChar '⟦' `alexAndPred`
-        ifExtension (\i -> unicodeSyntaxEnabled i && thQuotesEnabled i) }
+        ifExtension UnicodeSyntaxBit `alexAndPred`
+        ifExtension ThQuotesBit }
     { token (ITopenExpQuote NoE UnicodeSyntax) }
   $unigraphic -- ⟧
     / { ifCurrentChar '⟧' `alexAndPred`
-        ifExtension (\i -> unicodeSyntaxEnabled i && thQuotesEnabled i) }
+        ifExtension UnicodeSyntaxBit `alexAndPred`
+        ifExtension ThQuotesBit }
     { token (ITcloseQuote UnicodeSyntax) }
 }
 
@@ -406,38 +396,45 @@ $tab          { warnTab }
 <0> {
     [^ $idchar \) ] ^
   "@"
-    / { ifExtension typeApplicationEnabled `alexAndPred` notFollowedBySymbol }
+    / { ifExtension TypeApplicationsBit `alexAndPred` notFollowedBySymbol }
     { token ITtypeApp }
 }
 
 <0> {
-  "(|" / { ifExtension arrowsEnabled `alexAndPred` notFollowedBySymbol }
-                                        { special (IToparenbar NormalSyntax) }
-  "|)" / { ifExtension arrowsEnabled }  { special (ITcparenbar NormalSyntax) }
+  "(|"
+    / { ifExtension ArrowsBit `alexAndPred`
+        notFollowedBySymbol }
+    { special (IToparenbar NormalSyntax) }
+  "|)"
+    / { ifExtension ArrowsBit }
+    { special (ITcparenbar NormalSyntax) }
 
   $unigraphic -- ⦇
     / { ifCurrentChar '⦇' `alexAndPred`
-        ifExtension (\i -> unicodeSyntaxEnabled i && arrowsEnabled i) }
+        ifExtension UnicodeSyntaxBit `alexAndPred`
+        ifExtension ArrowsBit }
     { special (IToparenbar UnicodeSyntax) }
   $unigraphic -- ⦈
     / { ifCurrentChar '⦈' `alexAndPred`
-        ifExtension (\i -> unicodeSyntaxEnabled i && arrowsEnabled i) }
+        ifExtension UnicodeSyntaxBit `alexAndPred`
+        ifExtension ArrowsBit }
     { special (ITcparenbar UnicodeSyntax) }
 }
 
 <0> {
-  \? @varid / { ifExtension ipEnabled } { skip_one_varid ITdupipvarid }
+  \? @varid / { ifExtension IpBit } { skip_one_varid ITdupipvarid }
 }
 
 <0> {
-  "#" @varid / { ifExtension overloadedLabelsEnabled }
-               { skip_one_varid ITlabelvarid }
+  "#" @varid / { ifExtension OverloadedLabelsBit } { skip_one_varid ITlabelvarid }
 }
 
 <0> {
-  "(#" / { orExtensions unboxedTuplesEnabled unboxedSumsEnabled }
+  "(#" / { ifExtension UnboxedTuplesBit `alexOrPred`
+           ifExtension UnboxedSumsBit }
          { token IToubxparen }
-  "#)" / { orExtensions unboxedTuplesEnabled unboxedSumsEnabled }
+  "#)" / { ifExtension UnboxedTuplesBit `alexOrPred`
+           ifExtension UnboxedSumsBit }
          { token ITcubxparen }
 }
 
@@ -462,10 +459,10 @@ $tab          { warnTab }
 }
 
 <0> {
-  @qvarid "#"+      / { ifExtension magicHashEnabled } { idtoken qvarid }
-  @qconid "#"+      / { ifExtension magicHashEnabled } { idtoken qconid }
-  @varid "#"+       / { ifExtension magicHashEnabled } { varid }
-  @conid "#"+       / { ifExtension magicHashEnabled } { idtoken conid }
+  @qvarid "#"+      / { ifExtension MagicHashBit } { idtoken qvarid }
+  @qconid "#"+      / { ifExtension MagicHashBit } { idtoken qconid }
+  @varid "#"+       / { ifExtension MagicHashBit } { varid }
+  @conid "#"+       / { ifExtension MagicHashBit } { idtoken conid }
 }
 
 -- ToDo: - move `var` and (sym) into lexical syntax?
@@ -491,49 +488,51 @@ $tab          { warnTab }
 --
 <0> {
   -- Normal integral literals (:: Num a => a, from Integer)
-  @decimal                                                               { tok_num positive 0 0 decimal }
-  0[bB] @numspc @binary        / { ifExtension binaryLiteralsEnabled }   { tok_num positive 2 2 binary }
-  0[oO] @numspc @octal                                                   { tok_num positive 2 2 octal }
-  0[xX] @numspc @hexadecimal                                             { tok_num positive 2 2 hexadecimal }
-  @negative @decimal           / { ifExtension negativeLiteralsEnabled } { tok_num negative 1 1 decimal }
-  @negative 0[bB] @numspc @binary  / { ifExtension negativeLiteralsEnabled `alexAndPred`
-                                       ifExtension binaryLiteralsEnabled }   { tok_num negative 3 3 binary }
-  @negative 0[oO] @numspc @octal   / { ifExtension negativeLiteralsEnabled } { tok_num negative 3 3 octal }
-  @negative 0[xX] @numspc @hexadecimal / { ifExtension negativeLiteralsEnabled } { tok_num negative 3 3 hexadecimal }
+  @decimal                                                                   { tok_num positive 0 0 decimal }
+  0[bB] @numspc @binary                / { ifExtension BinaryLiteralsBit }   { tok_num positive 2 2 binary }
+  0[oO] @numspc @octal                                                       { tok_num positive 2 2 octal }
+  0[xX] @numspc @hexadecimal                                                 { tok_num positive 2 2 hexadecimal }
+  @negative @decimal                   / { ifExtension NegativeLiteralsBit } { tok_num negative 1 1 decimal }
+  @negative 0[bB] @numspc @binary      / { ifExtension NegativeLiteralsBit `alexAndPred`
+                                           ifExtension BinaryLiteralsBit }   { tok_num negative 3 3 binary }
+  @negative 0[oO] @numspc @octal       / { ifExtension NegativeLiteralsBit } { tok_num negative 3 3 octal }
+  @negative 0[xX] @numspc @hexadecimal / { ifExtension NegativeLiteralsBit } { tok_num negative 3 3 hexadecimal }
 
   -- Normal rational literals (:: Fractional a => a, from Rational)
-  @floating_point                                                        { tok_frac 0 tok_float }
-  @negative @floating_point    / { ifExtension negativeLiteralsEnabled } { tok_frac 0 tok_float }
-  0[xX] @numspc @hex_floating_point     / { ifExtension hexFloatLiteralsEnabled } { tok_frac 0 tok_hex_float }
-  @negative 0[xX] @numspc @hex_floating_point / { ifExtension hexFloatLiteralsEnabled `alexAndPred`
-                                                  ifExtension negativeLiteralsEnabled } { tok_frac 0 tok_hex_float }
+  @floating_point                                                            { tok_frac 0 tok_float }
+  @negative @floating_point            / { ifExtension NegativeLiteralsBit } { tok_frac 0 tok_float }
+  0[xX] @numspc @hex_floating_point    / { ifExtension HexFloatLiteralsBit } { tok_frac 0 tok_hex_float }
+  @negative 0[xX] @numspc @hex_floating_point
+                                       / { ifExtension HexFloatLiteralsBit `alexAndPred`
+                                           ifExtension NegativeLiteralsBit } { tok_frac 0 tok_hex_float }
 }
 
 <0> {
   -- Unboxed ints (:: Int#) and words (:: Word#)
   -- It's simpler (and faster?) to give separate cases to the negatives,
   -- especially considering octal/hexadecimal prefixes.
-  @decimal                     \# / { ifExtension magicHashEnabled } { tok_primint positive 0 1 decimal }
-  0[bB] @numspc @binary        \# / { ifExtension magicHashEnabled `alexAndPred`
-                                      ifExtension binaryLiteralsEnabled } { tok_primint positive 2 3 binary }
-  0[oO] @numspc @octal         \# / { ifExtension magicHashEnabled } { tok_primint positive 2 3 octal }
-  0[xX] @numspc @hexadecimal   \# / { ifExtension magicHashEnabled } { tok_primint positive 2 3 hexadecimal }
-  @negative @decimal           \# / { ifExtension magicHashEnabled } { tok_primint negative 1 2 decimal }
-  @negative 0[bB] @numspc @binary  \# / { ifExtension magicHashEnabled `alexAndPred`
-                                          ifExtension binaryLiteralsEnabled } { tok_primint negative 3 4 binary }
-  @negative 0[oO] @numspc @octal   \# / { ifExtension magicHashEnabled } { tok_primint negative 3 4 octal }
-  @negative 0[xX] @numspc @hexadecimal \# / { ifExtension magicHashEnabled } { tok_primint negative 3 4 hexadecimal }
-
-  @decimal                     \# \# / { ifExtension magicHashEnabled } { tok_primword 0 2 decimal }
-  0[bB] @numspc @binary        \# \# / { ifExtension magicHashEnabled `alexAndPred`
-                                         ifExtension binaryLiteralsEnabled } { tok_primword 2 4 binary }
-  0[oO] @numspc @octal         \# \# / { ifExtension magicHashEnabled } { tok_primword 2 4 octal }
-  0[xX] @numspc @hexadecimal   \# \# / { ifExtension magicHashEnabled } { tok_primword 2 4 hexadecimal }
+  @decimal                          \# / { ifExtension MagicHashBit }        { tok_primint positive 0 1 decimal }
+  0[bB] @numspc @binary             \# / { ifExtension MagicHashBit `alexAndPred`
+                                           ifExtension BinaryLiteralsBit }   { tok_primint positive 2 3 binary }
+  0[oO] @numspc @octal              \# / { ifExtension MagicHashBit }        { tok_primint positive 2 3 octal }
+  0[xX] @numspc @hexadecimal        \# / { ifExtension MagicHashBit }        { tok_primint positive 2 3 hexadecimal }
+  @negative @decimal                \# / { ifExtension MagicHashBit }        { tok_primint negative 1 2 decimal }
+  @negative 0[bB] @numspc @binary   \# / { ifExtension MagicHashBit `alexAndPred`
+                                           ifExtension BinaryLiteralsBit }   { tok_primint negative 3 4 binary }
+  @negative 0[oO] @numspc @octal    \# / { ifExtension MagicHashBit }        { tok_primint negative 3 4 octal }
+  @negative 0[xX] @numspc @hexadecimal \#
+                                       / { ifExtension MagicHashBit }        { tok_primint negative 3 4 hexadecimal }
+
+  @decimal                       \# \# / { ifExtension MagicHashBit }        { tok_primword 0 2 decimal }
+  0[bB] @numspc @binary          \# \# / { ifExtension MagicHashBit `alexAndPred`
+                                           ifExtension BinaryLiteralsBit }   { tok_primword 2 4 binary }
+  0[oO] @numspc @octal           \# \# / { ifExtension MagicHashBit }        { tok_primword 2 4 octal }
+  0[xX] @numspc @hexadecimal     \# \# / { ifExtension MagicHashBit }        { tok_primword 2 4 hexadecimal }
 
   -- Unboxed floats and doubles (:: Float#, :: Double#)
   -- prim_{float,double} work with signed literals
-  @signed @floating_point \# / { ifExtension magicHashEnabled } { tok_frac 1 tok_primfloat }
-  @signed @floating_point \# \# / { ifExtension magicHashEnabled } { tok_frac 2 tok_primdouble }
+  @signed @floating_point           \# / { ifExtension MagicHashBit }        { tok_frac 1 tok_primfloat }
+  @signed @floating_point        \# \# / { ifExtension MagicHashBit }        { tok_frac 2 tok_primdouble }
 }
 
 -- Strings and chars are lexed by hand-written code.  The reason is
@@ -645,8 +644,8 @@ data Token
   | ITrules_prag        SourceText
   | ITwarning_prag      SourceText
   | ITdeprecated_prag   SourceText
-  | ITline_prag         SourceText  -- not usually produced, see 'use_pos_prags'
-  | ITcolumn_prag       SourceText  -- not usually produced, see 'use_pos_prags'
+  | ITline_prag         SourceText  -- not usually produced, see 'UsePosPragsBit'
+  | ITcolumn_prag       SourceText  -- not usually produced, see 'UsePosPragsBit'
   | ITscc_prag          SourceText
   | ITgenerated_prag    SourceText
   | ITcore_prag         SourceText         -- hdaume: core annotations
@@ -752,29 +751,29 @@ data Token
   -- Arrow notation extension
   | ITproc
   | ITrec
-  | IToparenbar  IsUnicodeSyntax --  (|
-  | ITcparenbar  IsUnicodeSyntax --  |)
-  | ITlarrowtail IsUnicodeSyntax --  -<
-  | ITrarrowtail IsUnicodeSyntax --  >-
-  | ITLarrowtail IsUnicodeSyntax --  -<<
-  | ITRarrowtail IsUnicodeSyntax --  >>-
-
-  -- type application '@' (lexed differently than as-pattern '@',
+  | IToparenbar  IsUnicodeSyntax -- ^ @(|@
+  | ITcparenbar  IsUnicodeSyntax -- ^ @|)@
+  | ITlarrowtail IsUnicodeSyntax -- ^ @-<@
+  | ITrarrowtail IsUnicodeSyntax -- ^ @>-@
+  | ITLarrowtail IsUnicodeSyntax -- ^ @-<<@
+  | ITRarrowtail IsUnicodeSyntax -- ^ @>>-@
+
+  -- | Type application '@' (lexed differently than as-pattern '@',
   -- due to checking for preceding whitespace)
   | ITtypeApp
 
 
-  | ITunknown String            -- Used when the lexer can't make sense of it
-  | ITeof                       -- end of file token
+  | ITunknown String             -- ^ Used when the lexer can't make sense of it
+  | ITeof                        -- ^ end of file token
 
   -- Documentation annotations
-  | ITdocCommentNext  String     -- something beginning '-- |'
-  | ITdocCommentPrev  String     -- something beginning '-- ^'
-  | ITdocCommentNamed String     -- something beginning '-- $'
-  | ITdocSection      Int String -- a section heading
-  | ITdocOptions      String     -- doc options (prune, ignore-exports, etc)
-  | ITlineComment     String     -- comment starting by "--"
-  | ITblockComment    String     -- comment in {- -}
+  | ITdocCommentNext  String     -- ^ something beginning @-- |@
+  | ITdocCommentPrev  String     -- ^ something beginning @-- ^@
+  | ITdocCommentNamed String     -- ^ something beginning @-- $@
+  | ITdocSection      Int String -- ^ a section heading
+  | ITdocOptions      String     -- ^ doc options (prune, ignore-exports, etc)
+  | ITlineComment     String     -- ^ comment starting by "--"
+  | ITblockComment    String     -- ^ comment in {- -}
 
   deriving Show
 
@@ -826,7 +825,7 @@ reservedWordsFM = listToUFM $
          ( "family",         ITfamily,        0 ),
          ( "role",           ITrole,          0 ),
          ( "pattern",        ITpattern,       xbit PatternSynonymsBit),
-         ( "static",         ITstatic,        0 ),
+         ( "static",         ITstatic,        xbit StaticPointersBit ),
          ( "stock",          ITstock,         0 ),
          ( "anyclass",       ITanyclass,      0 ),
          ( "via",            ITvia,           0 ),
@@ -874,50 +873,46 @@ Also, note that these are included in the `varid` production in the parser --
 a key detail to make all this work.
 -------------------------------------}
 
-reservedSymsFM :: UniqFM (Token, ExtsBitmap -> Bool)
+reservedSymsFM :: UniqFM (Token, IsUnicodeSyntax, ExtsBitmap)
 reservedSymsFM = listToUFM $
-    map (\ (x,y,z) -> (mkFastString x,(y,z)))
-      [ ("..",  ITdotdot,              always)
+    map (\ (x,w,y,z) -> (mkFastString x,(w,y,z)))
+      [ ("..",  ITdotdot,                   NormalSyntax,  0 )
         -- (:) is a reserved op, meaning only list cons
-       ,(":",   ITcolon,               always)
-       ,("::",  ITdcolon NormalSyntax, always)
-       ,("=",   ITequal,               always)
-       ,("\\",  ITlam,                 always)
-       ,("|",   ITvbar,                always)
-       ,("<-",  ITlarrow NormalSyntax, always)
-       ,("->",  ITrarrow NormalSyntax, always)
-       ,("@",   ITat,                  always)
-       ,("~",   ITtilde,               always)
-       ,("=>",  ITdarrow NormalSyntax, always)
-       ,("-",   ITminus,               always)
-       ,("!",   ITbang,                always)
-
-       ,("*", ITstar NormalSyntax, starIsTypeEnabled)
+       ,(":",   ITcolon,                    NormalSyntax,  0 )
+       ,("::",  ITdcolon NormalSyntax,      NormalSyntax,  0 )
+       ,("=",   ITequal,                    NormalSyntax,  0 )
+       ,("\\",  ITlam,                      NormalSyntax,  0 )
+       ,("|",   ITvbar,                     NormalSyntax,  0 )
+       ,("<-",  ITlarrow NormalSyntax,      NormalSyntax,  0 )
+       ,("->",  ITrarrow NormalSyntax,      NormalSyntax,  0 )
+       ,("@",   ITat,                       NormalSyntax,  0 )
+       ,("~",   ITtilde,                    NormalSyntax,  0 )
+       ,("=>",  ITdarrow NormalSyntax,      NormalSyntax,  0 )
+       ,("-",   ITminus,                    NormalSyntax,  0 )
+       ,("!",   ITbang,                     NormalSyntax,  0 )
+
+       ,("*",   ITstar NormalSyntax,        NormalSyntax,  xbit StarIsTypeBit)
 
         -- For 'forall a . t'
-       ,(".", ITdot,  always) -- \i -> explicitForallEnabled i || inRulePrag i)
-
-       ,("-<",  ITlarrowtail NormalSyntax, arrowsEnabled)
-       ,(">-",  ITrarrowtail NormalSyntax, arrowsEnabled)
-       ,("-<<", ITLarrowtail NormalSyntax, arrowsEnabled)
-       ,(">>-", ITRarrowtail NormalSyntax, arrowsEnabled)
-
-       ,("∷",   ITdcolon UnicodeSyntax, unicodeSyntaxEnabled)
-       ,("⇒",   ITdarrow UnicodeSyntax, unicodeSyntaxEnabled)
-       ,("∀",   ITforall UnicodeSyntax, unicodeSyntaxEnabled)
-       ,("→",   ITrarrow UnicodeSyntax, unicodeSyntaxEnabled)
-       ,("←",   ITlarrow UnicodeSyntax, unicodeSyntaxEnabled)
-
-       ,("⤙",   ITlarrowtail UnicodeSyntax,
-                                \i -> unicodeSyntaxEnabled i && arrowsEnabled i)
-       ,("⤚",   ITrarrowtail UnicodeSyntax,
-                                \i -> unicodeSyntaxEnabled i && arrowsEnabled i)
-       ,("⤛",   ITLarrowtail UnicodeSyntax,
-                                \i -> unicodeSyntaxEnabled i && arrowsEnabled i)
-       ,("⤜",   ITRarrowtail UnicodeSyntax,
-                                \i -> unicodeSyntaxEnabled i && arrowsEnabled i)
-       ,("★",   ITstar UnicodeSyntax,
-                  \i -> unicodeSyntaxEnabled i && starIsTypeEnabled i)
+       ,(".",   ITdot,                      NormalSyntax,  0 )
+
+       ,("-<",  ITlarrowtail NormalSyntax,  NormalSyntax,  xbit ArrowsBit)
+       ,(">-",  ITrarrowtail NormalSyntax,  NormalSyntax,  xbit ArrowsBit)
+       ,("-<<", ITLarrowtail NormalSyntax,  NormalSyntax,  xbit ArrowsBit)
+       ,(">>-", ITRarrowtail NormalSyntax,  NormalSyntax,  xbit ArrowsBit)
+
+       ,("∷",   ITdcolon UnicodeSyntax,     UnicodeSyntax, 0 )
+       ,("⇒",   ITdarrow UnicodeSyntax,     UnicodeSyntax, 0 )
+       ,("∀",   ITforall UnicodeSyntax,     UnicodeSyntax, 0 )
+       ,("→",   ITrarrow UnicodeSyntax,     UnicodeSyntax, 0 )
+       ,("←",   ITlarrow UnicodeSyntax,     UnicodeSyntax, 0 )
+
+       ,("⤙",   ITlarrowtail UnicodeSyntax, UnicodeSyntax, xbit ArrowsBit)
+       ,("⤚",   ITrarrowtail UnicodeSyntax, UnicodeSyntax, xbit ArrowsBit)
+       ,("⤛",   ITLarrowtail UnicodeSyntax, UnicodeSyntax, xbit ArrowsBit)
+       ,("⤜",   ITRarrowtail UnicodeSyntax, UnicodeSyntax, xbit ArrowsBit)
+
+       ,("★",   ITstar UnicodeSyntax,       UnicodeSyntax, xbit StarIsTypeBit)
 
         -- ToDo: ideally, → and ∷ should be "specials", so that they cannot
         -- form part of a large operator.  This would let us have a better
@@ -960,21 +955,21 @@ pop _span _buf _len = do _ <- popLexState
 -- See Note [Nested comment line pragmas]
 failLinePrag1 :: Action
 failLinePrag1 span _buf _len = do
-  b <- extension inNestedComment
+  b <- getBit InNestedCommentBit
   if b then return (L span ITcomment_line_prag)
        else lexError "lexical error in pragma"
 
 -- See Note [Nested comment line pragmas]
 popLinePrag1 :: Action
 popLinePrag1 span _buf _len = do
-  b <- extension inNestedComment
+  b <- getBit InNestedCommentBit
   if b then return (L span ITcomment_line_prag) else do
     _ <- popLexState
     lexToken
 
 hopefully_open_brace :: Action
 hopefully_open_brace span buf len
- = do relaxed <- extension relaxedLayout
+ = do relaxed <- getBit RelaxedLayoutBit
       ctx <- getContext
       (AI l _) <- getInput
       let offset = srcLocCol l
@@ -1020,8 +1015,8 @@ ifCurrentChar char _ (AI _ buf) _ _
 -- the non-layout states.
 isNormalComment :: AlexAccPred ExtsBitmap
 isNormalComment bits _ _ (AI _ buf)
-  | haddockEnabled bits = notFollowedByDocOrPragma
-  | otherwise           = nextCharIsNot buf (== '#')
+  | HaddockBit `xtest` bits = notFollowedByDocOrPragma
+  | otherwise               = nextCharIsNot buf (== '#')
   where
     notFollowedByDocOrPragma
        = afterOptionalSpace buf (\b -> nextCharIsNot b (`elem` "|^*$#"))
@@ -1035,11 +1030,14 @@ afterOptionalSpace buf p
 atEOL :: AlexAccPred ExtsBitmap
 atEOL _ _ _ (AI _ buf) = atEnd buf || currentChar buf == '\n'
 
-ifExtension :: (ExtsBitmap -> Bool) -> AlexAccPred ExtsBitmap
-ifExtension pred bits _ _ _ = pred bits
+ifExtension :: ExtBits -> AlexAccPred ExtsBitmap
+ifExtension extBits bits _ _ _ = extBits `xtest` bits
+
+alexNotPred p userState in1 len in2
+  = not (p userState in1 len in2)
 
-orExtensions :: (ExtsBitmap -> Bool) -> (ExtsBitmap -> Bool) -> AlexAccPred ExtsBitmap
-orExtensions pred1 pred2 bits _ _ _ = pred1 bits || pred2 bits
+alexOrPred p1 p2 userState in1 len in2
+  = p1 userState in1 len in2 || p2 userState in1 len in2
 
 multiline_doc_comment :: Action
 multiline_doc_comment span buf _len = withLexedDocType (worker "")
@@ -1082,7 +1080,7 @@ multiline_doc_comment span buf _len = withLexedDocType (worker "")
 
 lineCommentToken :: Action
 lineCommentToken span buf len = do
-  b <- extension rawTokenStreamEnabled
+  b <- getBit RawTokenStreamBit
   if b then strtoken ITlineComment span buf len else lexToken
 
 {-
@@ -1096,7 +1094,7 @@ nested_comment cont span buf len = do
   where
     go commentAcc 0 input = do
       setInput input
-      b <- extension rawTokenStreamEnabled
+      b <- getBit RawTokenStreamBit
       if b
         then docCommentEnd input commentAcc ITblockComment buf span
         else cont
@@ -1215,23 +1213,23 @@ rulePrag span buf len = do
   let !src = lexemeToString buf len
   return (L span (ITrules_prag (SourceText src)))
 
--- When 'use_pos_prags' is not set, it is expected that we emit a token instead
+-- When 'UsePosPragsBit' is not set, it is expected that we emit a token instead
 -- of updating the position in 'PState'
 linePrag :: Action
 linePrag span buf len = do
-  ps <- getPState
-  if use_pos_prags ps
+  usePosPrags <- getBit UsePosPragsBit
+  if usePosPrags
     then begin line_prag2 span buf len
     else let !src = lexemeToString buf len
          in return (L span (ITline_prag (SourceText src)))
 
--- When 'use_pos_prags' is not set, it is expected that we emit a token instead
+-- When 'UsePosPragsBit' is not set, it is expected that we emit a token instead
 -- of updating the position in 'PState'
 columnPrag :: Action
 columnPrag span buf len = do
-  ps <- getPState
+  usePosPrags <- getBit UsePosPragsBit
   let !src = lexemeToString buf len
-  if use_pos_prags ps
+  if usePosPrags
     then begin column_prag span buf len
     else let !src = lexemeToString buf len
          in return (L span (ITcolumn_prag (SourceText src)))
@@ -1314,24 +1312,19 @@ varid span buf len =
       lastTk <- getLastTk
       keyword <- case lastTk of
         Just ITlam -> do
-          lambdaCase <- extension lambdaCaseEnabled
+          lambdaCase <- getBit LambdaCaseBit
           if lambdaCase
             then return ITlcase
             else failMsgP "Illegal lambda-case (use -XLambdaCase)"
         _ -> return ITcase
       maybe_layout keyword
       return $ L span keyword
-    Just (ITstatic, _) -> do
-      staticPointers <- extension staticPointersEnabled
-      if staticPointers
-        then return $ L span ITstatic
-        else return $ L span $ ITvarid fs
     Just (keyword, 0) -> do
       maybe_layout keyword
       return $ L span keyword
-    Just (keyword, exts) -> do
-      extsEnabled <- extension $ \i -> exts .&. i /= 0
-      if extsEnabled
+    Just (keyword, i) -> do
+      exts <- getExts
+      if exts .&. i /= 0
         then do
           maybe_layout keyword
           return $ L span keyword
@@ -1356,11 +1349,23 @@ consym = sym ITconsym
 sym :: (FastString -> Token) -> Action
 sym con span buf len =
   case lookupUFM reservedSymsFM fs of
-    Just (keyword, exts) -> do
-      extsEnabled <- extension exts
-      let !tk | extsEnabled = keyword
-              | otherwise   = con fs
-      return $ L span tk
+    Just (keyword, NormalSyntax, 0) ->
+      return $ L span keyword
+    Just (keyword, NormalSyntax, i) -> do
+      exts <- getExts
+      if exts .&. i /= 0
+        then return $ L span keyword
+        else return $ L span (con fs)
+    Just (keyword, UnicodeSyntax, 0) -> do
+      exts <- getExts
+      if xtest UnicodeSyntaxBit exts
+        then return $ L span keyword
+        else return $ L span (con fs)
+    Just (keyword, UnicodeSyntax, i) -> do
+      exts <- getExts
+      if exts .&. i /= 0 && xtest UnicodeSyntaxBit exts
+        then return $ L span keyword
+        else return $ L span (con fs)
     Nothing ->
       return $ L span $! con fs
   where
@@ -1373,7 +1378,7 @@ tok_integral :: (SourceText -> Integer -> Token)
              -> (Integer, (Char -> Int))
              -> Action
 tok_integral itint transint transbuf translen (radix,char_to_int) span buf len = do
-  numericUnderscores <- extension numericUnderscoresEnabled  -- #14473
+  numericUnderscores <- getBit NumericUnderscoresBit  -- #14473
   let src = lexemeToString buf len
   if (not numericUnderscores) && ('_' `elem` src)
     then failMsgP "Use NumericUnderscores to allow underscores in integer literals"
@@ -1413,7 +1418,7 @@ hexadecimal = (16,hexDigit)
 -- readRational can understand negative rationals, exponents, everything.
 tok_frac :: Int -> (String -> Token) -> Action
 tok_frac drop f span buf len = do
-  numericUnderscores <- extension numericUnderscoresEnabled  -- #14473
+  numericUnderscores <- getBit NumericUnderscoresBit  -- #14473
   let src = lexemeToString buf (len-drop)
   if (not numericUnderscores) && ('_' `elem` src)
     then failMsgP "Use NumericUnderscores to allow underscores in floating literals"
@@ -1445,7 +1450,7 @@ readHexFractionalLit str =
 do_bol :: Action
 do_bol span _str _len = do
         -- See Note [Nested comment line pragmas]
-        b <- extension inNestedComment
+        b <- getBit InNestedCommentBit
         if b then return (L span ITcomment_line_prag) else do
           (pos, gen_semic) <- getOffside
           case pos of
@@ -1472,7 +1477,7 @@ maybe_layout t = do -- If the alternative layout rule is enabled then
                     -- inserting implicit semi-colons, is therefore
                     -- irrelevant as it only applies in an implicit
                     -- context.
-                    alr <- extension alternativeLayoutRule
+                    alr <- getBit AlternativeLayoutRuleBit
                     unless alr $ f t
     where f ITdo    = pushLexState layout_do
           f ITmdo   = pushLexState layout_do
@@ -1498,7 +1503,7 @@ new_layout_context strict gen_semic tok span _buf len = do
     (AI l _) <- getInput
     let offset = srcLocCol l - len
     ctx <- getContext
-    nondecreasing <- extension nondecreasingIndentation
+    nondecreasing <- getBit NondecreasingIndentationBit
     let strict' = strict || not nondecreasing
     case ctx of
         Layout prev_off _ : _  |
@@ -1614,7 +1619,7 @@ lex_string s = do
 
     Just ('"',i)  -> do
         setInput i
-        magicHash <- extension magicHashEnabled
+        magicHash <- getBit MagicHashBit
         if magicHash
           then do
             i <- getInput
@@ -1701,7 +1706,7 @@ lex_char_tok span buf _len = do        -- We've seen '
 finish_char_tok :: StringBuffer -> RealSrcLoc -> Char -> P (RealLocated Token)
 finish_char_tok buf loc ch  -- We've already seen the closing quote
                         -- Just need to check for trailing #
-  = do  magicHash <- extension magicHashEnabled
+  = do  magicHash <- getBit MagicHashBit
         i@(AI end bufEnd) <- getInput
         let src = lexemeToString buf (cur bufEnd - cur buf)
         if magicHash then do
@@ -1935,14 +1940,10 @@ data ParseResult a
 warnopt :: WarningFlag -> ParserFlags -> Bool
 warnopt f options = f `EnumSet.member` pWarningFlags options
 
--- | Test whether a 'LangExt.Extension' is set
-extopt :: LangExt.Extension -> ParserFlags -> Bool
-extopt f options = f `EnumSet.member` pExtensionFlags options
-
--- | The subset of the 'DynFlags' used by the parser
+-- | The subset of the 'DynFlags' used by the parser.
+-- See 'mkParserFlags' or 'mkParserFlags'' for ways to construct this.
 data ParserFlags = ParserFlags {
     pWarningFlags   :: EnumSet WarningFlag
-  , pExtensionFlags :: EnumSet LangExt.Extension
   , pThisPackage    :: UnitId      -- ^ key of package currently being compiled
   , pExtsBitmap     :: !ExtsBitmap -- ^ bitmap of permitted extensions
   }
@@ -1981,10 +1982,6 @@ data PState = PState {
         -- token doesn't need to close anything:
         alr_justClosedExplicitLetBlock :: Bool,
 
-        -- If this is enabled, '{-# LINE ... -#}' and '{-# COLUMN ... #-}'
-        -- update the 'loc' field. Otherwise, those pragmas are lexed as tokens.
-        use_pos_prags :: Bool,
-
         -- The next three are used to implement Annotations giving the
         -- locations of 'noise' tokens in the source, so that users of
         -- the GHC API can do source to source conversions.
@@ -2058,9 +2055,6 @@ getPState = P $ \s -> POk s s
 withThisPackage :: (UnitId -> a) -> P a
 withThisPackage f = P $ \s@(PState{options = o}) -> POk s (f (pThisPackage o))
 
-extension :: (ExtsBitmap -> Bool) -> P Bool
-extension p = P $ \s -> POk s (p $! (pExtsBitmap . options) s)
-
 getExts :: P ExtsBitmap
 getExts = P $ \s -> POk s (pExtsBitmap . options $ s)
 
@@ -2245,10 +2239,6 @@ getALRContext = P $ \s@(PState {alr_context = cs}) -> POk s cs
 setALRContext :: [ALRContext] -> P ()
 setALRContext cs = P $ \s -> POk (s {alr_context = cs}) ()
 
-getALRTransitional :: P Bool
-getALRTransitional = P $ \s@PState {options = o} ->
-  POk s (extopt LangExt.AlternativeLayoutRuleTransitional o)
-
 getJustClosedExplicitLetBlock :: P Bool
 getJustClosedExplicitLetBlock
  = P $ \s@(PState {alr_justClosedExplicitLetBlock = b}) -> POk s b
@@ -2283,18 +2273,26 @@ getAlrExpectingOCurly = P $ \s@(PState {alr_expecting_ocurly = b}) -> POk s b
 setAlrExpectingOCurly :: Maybe ALRLayout -> P ()
 setAlrExpectingOCurly b = P $ \s -> POk (s {alr_expecting_ocurly = b}) ()
 
--- for reasons of efficiency, flags indicating language extensions (eg,
--- -fglasgow-exts or -XParallelArrays) are represented by a bitmap
--- stored in an unboxed Word64
+-- | For reasons of efficiency, boolean parsing flags (eg, language extensions
+-- or whether we are currently in a @RULE@ pragma) are represented by a bitmap
+-- 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
 
 xtest :: ExtBits -> ExtsBitmap -> Bool
 xtest ext xmap = testBit xmap (fromEnum ext)
 
+-- | Various boolean flags, mostly language extensions, that impact lexing and
+-- parsing. Note that a handful of these can change during lexing/parsing.
 data ExtBits
+  -- Flags that are constant once parsing starts
   = FfiBit
   | InterruptibleFfiBit
   | CApiFfiBit
@@ -2314,14 +2312,12 @@ data ExtBits
   | UnboxedTuplesBit -- (# and #)
   | UnboxedSumsBit -- (# and #)
   | DatatypeContextsBit
+  | MonadComprehensionsBit
   | TransformComprehensionsBit
   | QqBit -- enable quasiquoting
-  | InRulePragBit
-  | InNestedCommentBit -- See Note [Nested comment line pragmas]
   | RawTokenStreamBit -- producing a token stream with all comments included
-  | SccProfilingOnBit
-  | HpcBit
   | AlternativeLayoutRuleBit
+  | ALRTransitionalBit
   | RelaxedLayoutBit
   | NondecreasingIndentationBit
   | SafeHaskellBit
@@ -2335,78 +2331,24 @@ data ExtBits
   | StaticPointersBit
   | NumericUnderscoresBit
   | StarIsTypeBit
+  | BlockArgumentsBit
+  | NPlusKPatternsBit
+  | DoAndIfThenElseBit
+  | MultiWayIfBit
+  | GadtSyntaxBit
+
+  -- Flags that are updated once parsing starts
+  | InRulePragBit
+  | InNestedCommentBit -- See Note [Nested comment line pragmas]
+  | UsePosPragsBit
+    -- ^ If this is enabled, '{-# LINE ... -#}' and '{-# COLUMN ... #-}'
+    -- update the internal position. Otherwise, those pragmas are lexed as
+    -- tokens of their own.
   deriving Enum
 
 
-always :: ExtsBitmap -> Bool
-always           _     = True
-arrowsEnabled :: ExtsBitmap -> Bool
-arrowsEnabled = xtest ArrowsBit
-thEnabled :: ExtsBitmap -> Bool
-thEnabled = xtest ThBit
-thQuotesEnabled :: ExtsBitmap -> Bool
-thQuotesEnabled = xtest ThQuotesBit
-ipEnabled :: ExtsBitmap -> Bool
-ipEnabled = xtest IpBit
-overloadedLabelsEnabled :: ExtsBitmap -> Bool
-overloadedLabelsEnabled = xtest OverloadedLabelsBit
-explicitForallEnabled :: ExtsBitmap -> Bool
-explicitForallEnabled = xtest ExplicitForallBit
-bangPatEnabled :: ExtsBitmap -> Bool
-bangPatEnabled = xtest BangPatBit
-haddockEnabled :: ExtsBitmap -> Bool
-haddockEnabled = xtest HaddockBit
-magicHashEnabled :: ExtsBitmap -> Bool
-magicHashEnabled = xtest MagicHashBit
-unicodeSyntaxEnabled :: ExtsBitmap -> Bool
-unicodeSyntaxEnabled = xtest UnicodeSyntaxBit
-unboxedTuplesEnabled :: ExtsBitmap -> Bool
-unboxedTuplesEnabled = xtest UnboxedTuplesBit
-unboxedSumsEnabled :: ExtsBitmap -> Bool
-unboxedSumsEnabled = xtest UnboxedSumsBit
-datatypeContextsEnabled :: ExtsBitmap -> Bool
-datatypeContextsEnabled = xtest DatatypeContextsBit
-qqEnabled :: ExtsBitmap -> Bool
-qqEnabled = xtest QqBit
-inRulePrag :: ExtsBitmap -> Bool
-inRulePrag = xtest InRulePragBit
-inNestedComment :: ExtsBitmap -> Bool
-inNestedComment = xtest InNestedCommentBit
-rawTokenStreamEnabled :: ExtsBitmap -> Bool
-rawTokenStreamEnabled = xtest RawTokenStreamBit
-alternativeLayoutRule :: ExtsBitmap -> Bool
-alternativeLayoutRule = xtest AlternativeLayoutRuleBit
-hpcEnabled :: ExtsBitmap -> Bool
-hpcEnabled = xtest HpcBit
-relaxedLayout :: ExtsBitmap -> Bool
-relaxedLayout = xtest RelaxedLayoutBit
-nondecreasingIndentation :: ExtsBitmap -> Bool
-nondecreasingIndentation = xtest NondecreasingIndentationBit
-sccProfilingOn :: ExtsBitmap -> Bool
-sccProfilingOn = xtest SccProfilingOnBit
-traditionalRecordSyntaxEnabled :: ExtsBitmap -> Bool
-traditionalRecordSyntaxEnabled = xtest TraditionalRecordSyntaxBit
-
-explicitNamespacesEnabled :: ExtsBitmap -> Bool
-explicitNamespacesEnabled = xtest ExplicitNamespacesBit
-lambdaCaseEnabled :: ExtsBitmap -> Bool
-lambdaCaseEnabled = xtest LambdaCaseBit
-binaryLiteralsEnabled :: ExtsBitmap -> Bool
-binaryLiteralsEnabled = xtest BinaryLiteralsBit
-negativeLiteralsEnabled :: ExtsBitmap -> Bool
-negativeLiteralsEnabled = xtest NegativeLiteralsBit
-hexFloatLiteralsEnabled :: ExtsBitmap -> Bool
-hexFloatLiteralsEnabled = xtest HexFloatLiteralsBit
-patternSynonymsEnabled :: ExtsBitmap -> Bool
-patternSynonymsEnabled = xtest PatternSynonymsBit
-typeApplicationEnabled :: ExtsBitmap -> Bool
-typeApplicationEnabled = xtest TypeApplicationsBit
-staticPointersEnabled :: ExtsBitmap -> Bool
-staticPointersEnabled = xtest StaticPointersBit
-numericUnderscoresEnabled :: ExtsBitmap -> Bool
-numericUnderscoresEnabled = xtest NumericUnderscoresBit
-starIsTypeEnabled :: ExtsBitmap -> Bool
-starIsTypeEnabled = xtest StarIsTypeBit
+
+
 
 -- PState for parsing options pragmas
 --
@@ -2415,19 +2357,31 @@ pragState dynflags buf loc = (mkPState dynflags buf loc) {
                                  lex_state = [bol, option_prags, 0]
                              }
 
--- | Extracts the flag information needed for parsing
-mkParserFlags :: DynFlags -> ParserFlags
-mkParserFlags flags =
+{-# INLINE mkParserFlags' #-}
+mkParserFlags'
+  :: EnumSet WarningFlag        -- ^ warnings flags enabled
+  -> EnumSet LangExt.Extension  -- ^ permitted language extensions enabled
+  -> UnitId                     -- ^ key of package currently being compiled
+  -> Bool                       -- ^ are safe imports on?
+  -> Bool                       -- ^ keeping Haddock comment tokens
+  -> Bool                       -- ^ keep regular comment tokens
+
+  -> Bool
+  -- ^ If this is enabled, '{-# LINE ... -#}' and '{-# COLUMN ... #-}' update
+  -- the internal position kept by the parser. Otherwise, those pragmas are
+  -- lexed as 'ITline_prag' and 'ITcolumn_prag' tokens.
+
+  -> ParserFlags
+-- ^ Given exactly the information needed, set up the 'ParserFlags'
+mkParserFlags' warningFlags extensionFlags thisPackage
+  safeImports isHaddock rawTokStream usePosPrags =
     ParserFlags {
-      pWarningFlags = DynFlags.warningFlags flags
-    , pExtensionFlags = DynFlags.extensionFlags flags
-    , pThisPackage = DynFlags.thisPackage flags
-    , pExtsBitmap = bitmap
+      pWarningFlags = warningFlags
+    , pThisPackage = thisPackage
+    , pExtsBitmap = safeHaskellBit .|. langExtBits .|. optBits
     }
   where
-    bitmap = safeHaskellBit .|. langExtBits .|. optBits
-    safeHaskellBit =
-          SafeHaskellBit `setBitIf` safeImportsOn flags
+    safeHaskellBit = SafeHaskellBit `setBitIf` safeImports
     langExtBits =
           FfiBit                      `xoptBit` LangExt.ForeignFunctionInterface
       .|. InterruptibleFfiBit         `xoptBit` LangExt.InterruptibleFFI
@@ -2447,8 +2401,9 @@ mkParserFlags flags =
       .|. UnboxedSumsBit              `xoptBit` LangExt.UnboxedSums
       .|. DatatypeContextsBit         `xoptBit` LangExt.DatatypeContexts
       .|. TransformComprehensionsBit  `xoptBit` LangExt.TransformListComp
-      .|. TransformComprehensionsBit  `xoptBit` LangExt.MonadComprehensions
+      .|. MonadComprehensionsBit      `xoptBit` LangExt.MonadComprehensions
       .|. AlternativeLayoutRuleBit    `xoptBit` LangExt.AlternativeLayoutRule
+      .|. ALRTransitionalBit          `xoptBit` LangExt.AlternativeLayoutRuleTransitional
       .|. RelaxedLayoutBit            `xoptBit` LangExt.RelaxedLayout
       .|. NondecreasingIndentationBit `xoptBit` LangExt.NondecreasingIndentation
       .|. TraditionalRecordSyntaxBit  `xoptBit` LangExt.TraditionalRecordSyntax
@@ -2462,19 +2417,34 @@ mkParserFlags flags =
       .|. StaticPointersBit           `xoptBit` LangExt.StaticPointers
       .|. NumericUnderscoresBit       `xoptBit` LangExt.NumericUnderscores
       .|. StarIsTypeBit               `xoptBit` LangExt.StarIsType
+      .|. BlockArgumentsBit           `xoptBit` LangExt.BlockArguments
+      .|. NPlusKPatternsBit           `xoptBit` LangExt.NPlusKPatterns
+      .|. DoAndIfThenElseBit          `xoptBit` LangExt.DoAndIfThenElse
+      .|. MultiWayIfBit               `xoptBit` LangExt.MultiWayIf
+      .|. GadtSyntaxBit               `xoptBit` LangExt.GADTSyntax
     optBits =
-          HaddockBit        `goptBit` Opt_Haddock
-      .|. RawTokenStreamBit `goptBit` Opt_KeepRawTokenStream
-      .|. HpcBit            `goptBit` Opt_Hpc
-      .|. SccProfilingOnBit `goptBit` Opt_SccProfilingOn
+          HaddockBit        `setBitIf` isHaddock
+      .|. RawTokenStreamBit `setBitIf` rawTokStream
+      .|. UsePosPragsBit    `setBitIf` usePosPrags
 
-    xoptBit bit ext = bit `setBitIf` xopt ext flags
-    goptBit bit opt = bit `setBitIf` gopt opt flags
+    xoptBit bit ext = bit `setBitIf` EnumSet.member ext extensionFlags
 
     setBitIf :: ExtBits -> Bool -> ExtsBitmap
     b `setBitIf` cond | cond      = xbit b
                       | otherwise = 0
 
+-- | Extracts the flag information needed for parsing
+mkParserFlags :: DynFlags -> ParserFlags
+mkParserFlags =
+  mkParserFlags'
+    <$> DynFlags.warningFlags
+    <*> DynFlags.extensionFlags
+    <*> DynFlags.thisPackage
+    <*> safeImportsOn
+    <*> gopt Opt_Haddock
+    <*> gopt Opt_KeepRawTokenStream
+    <*> const True
+
 -- | Creates a parse state from a 'DynFlags' value
 mkPState :: DynFlags -> StringBuffer -> RealSrcLoc -> PState
 mkPState flags = mkPStatePure (mkParserFlags flags)
@@ -2501,7 +2471,6 @@ mkPStatePure options buf loc =
       alr_context = [],
       alr_expecting_ocurly = Nothing,
       alr_justClosedExplicitLetBlock = False,
-      use_pos_prags = True,
       annotations = [],
       comment_q = [],
       annotations_comments = []
@@ -2611,8 +2580,8 @@ srcParseErr options buf len
         pattern = decodePrevNChars 8 buf
         last100 = decodePrevNChars 100 buf
         mdoInLast100 = "mdo" `isInfixOf` last100
-        th_enabled = extopt LangExt.TemplateHaskell options
-        ps_enabled = extopt LangExt.PatternSynonyms options
+        th_enabled = ThBit `xtest` pExtsBitmap options
+        ps_enabled = PatternSynonymsBit `xtest` pExtsBitmap options
 
 -- Report a parse failure, giving the span of the previous token as
 -- the location of the error.  This is the entry point for errors
@@ -2636,7 +2605,7 @@ lexError str = do
 
 lexer :: Bool -> (Located Token -> P a) -> P a
 lexer queueComments cont = do
-  alr <- extension alternativeLayoutRule
+  alr <- getBit AlternativeLayoutRuleBit
   let lexTokenFun = if alr then lexTokenAlr else lexToken
   (L span tok) <- lexTokenFun
   --trace ("token: " ++ show tok) $ do
@@ -2681,7 +2650,7 @@ alternativeLayoutRuleToken t
     = do context <- getALRContext
          lastLoc <- getAlrLastLoc
          mExpectingOCurly <- getAlrExpectingOCurly
-         transitional <- getALRTransitional
+         transitional <- getBit ALRTransitionalBit
          justClosedExplicitLetBlock <- getJustClosedExplicitLetBlock
          setJustClosedExplicitLetBlock False
          let thisLoc = getRealSrcSpan t
@@ -2912,9 +2881,10 @@ reportLexError loc1 loc2 buf str
      else failLocMsgP loc1 loc2 (str ++ " at character " ++ show c)
 
 lexTokenStream :: StringBuffer -> RealSrcLoc -> DynFlags -> ParseResult [Located Token]
-lexTokenStream buf loc dflags = unP go initState
+lexTokenStream buf loc dflags = unP go initState{ options = opts' }
     where dflags' = gopt_set (gopt_unset dflags Opt_Haddock) Opt_KeepRawTokenStream
-          initState = (mkPState dflags' buf loc) { use_pos_prags = False }
+          initState@PState{ options = opts } = mkPState dflags' buf loc
+          opts' = opts{ pExtsBitmap = xbit UsePosPragsBit .|. pExtsBitmap opts }
           go = do
             ltok <- lexer False return
             case ltok of
diff --git a/compiler/parser/Parser.y b/compiler/parser/Parser.y
index 685b2d451d..07515679b1 100644
--- a/compiler/parser/Parser.y
+++ b/compiler/parser/Parser.y
@@ -87,8 +87,6 @@ import TysWiredIn       ( unitTyCon, unitDataCon, tupleTyCon, tupleDataCon, nilD
 -- compiler/utils
 import Util             ( looksLikePackageName, fstOf3, sndOf3, thdOf3 )
 import GhcPrelude
-
-import qualified GHC.LanguageExtensions as LangExt
 }
 
 %expect 237 -- shift/reduce conflicts
@@ -3755,14 +3753,14 @@ fileSrcSpan = do
 -- Hint about the MultiWayIf extension
 hintMultiWayIf :: SrcSpan -> P ()
 hintMultiWayIf span = do
-  mwiEnabled <- liftM ((LangExt.MultiWayIf `extopt`) . options) getPState
+  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 <- liftM ((LangExt.MultiWayIf `extopt`) . options) getPState
+  mwiEnabled <- getBit MultiWayIfBit
   if mwiEnabled
     then parseErrorSDoc span $ text $ "parse error in if statement"
     else parseErrorSDoc span $ text $ "parse error in if statement: "++msg
@@ -3770,8 +3768,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"
@@ -3781,7 +3779,7 @@ hintExplicitForall span = do
 -- Hint about explicit-forall, assuming UnicodeSyntax is off
 hintExplicitForall' :: SrcSpan -> P (Located RdrName)
 hintExplicitForall' span = do
-    forall    <- extension explicitForallEnabled
+    forall <- getBit ExplicitForallBit
     let illegalDot = "Illegal symbol '.' in type"
     if forall
       then parseErrorSDoc span $ vcat
@@ -3801,7 +3799,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
@@ -3814,8 +3812,8 @@ warnSpaceAfterBang span = do
 -- variable or constructor. See Trac #13450.
 reportEmptyDoubleQuotes :: SrcSpan -> P (Located (HsExpr GhcPs))
 reportEmptyDoubleQuotes span = do
-    thEnabled <- liftM ((LangExt.TemplateHaskellQuotes `extopt`) . options) getPState
-    if thEnabled
+    thQuotes <- getBit ThQuotesBit
+    if thQuotes
       then parseErrorSDoc span $ vcat
         [ text "Parser error on `''`"
         , text "Character literals may not be empty"
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)