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

3 files changed, 238 insertions, 306 deletions

diff --git a/compiler/parser/Lexer.x b/compiler/parser/Lexer.x
index 4572e6d9af..89ddfea3ce 100644
--- a/compiler/parser/Lexer.x
+++ b/compiler/parser/Lexer.x
@@ -55,15 +55,7 @@ module Lexer (
    popContext, pushModuleContext, setLastToken, setSrcLoc,
    activeContext, nextIsEOF,
    getLexState, popLexState, pushLexState,
-   extension, bangPatEnabled, datatypeContextsEnabled,
-   traditionalRecordSyntaxEnabled,
-   explicitForallEnabled,
-   inRulePrag,
-   explicitNamespacesEnabled,
-   patternSynonymsEnabled,
-   starIsTypeEnabled, monadComprehensionsEnabled, doAndIfThenElseEnabled,
-   nPlusKPatternsEnabled, blockArgumentsEnabled, gadtSyntaxEnabled,
-   multiWayIfEnabled, thQuotesEnabled,
+   ExtBits(..), getBit,
    addWarning,
    lexTokenStream,
    addAnnotation,AddAnn,addAnnsAt,mkParensApiAnn,
@@ -236,7 +228,7 @@ $tab          { warnTab }
 
 -- Next, match Haddock comments if no -haddock flag
 
-"-- " $docsym .* / { ifExtension (not . haddockEnabled) } { lineCommentToken }
+"-- " $docsym .* / { alexNotPred (ifBit 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
@@ -362,44 +354,41 @@ $tab          { warnTab }
 -- Haddock comments
 
 <0,option_prags> {
-  "-- " $docsym      / { ifExtension haddockEnabled } { multiline_doc_comment }
-  "{-" \ ? $docsym   / { ifExtension haddockEnabled } { nested_doc_comment }
+  "-- " $docsym      / { ifBit HaddockBit } { multiline_doc_comment }
+  "{-" \ ? $docsym   / { ifBit 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 }
+  "[|"        / { ifBit ThQuotesBit } { token (ITopenExpQuote NoE NormalSyntax) }
+  "[||"       / { ifBit ThQuotesBit } { token (ITopenTExpQuote NoE) }
+  "[e|"       / { ifBit ThQuotesBit } { token (ITopenExpQuote HasE NormalSyntax) }
+  "[e||"      / { ifBit ThQuotesBit } { token (ITopenTExpQuote HasE) }
+  "[p|"       / { ifBit ThQuotesBit } { token ITopenPatQuote }
+  "[d|"       / { ifBit ThQuotesBit } { layout_token ITopenDecQuote }
+  "[t|"       / { ifBit ThQuotesBit } { token ITopenTypQuote }
+  "|]"        / { ifBit ThQuotesBit } { token (ITcloseQuote NormalSyntax) }
+  "||]"       / { ifBit ThQuotesBit } { token ITcloseTExpQuote }
+  \$ @varid   / { ifBit ThBit }       { skip_one_varid ITidEscape }
+  "$$" @varid / { ifBit ThBit }       { skip_two_varid ITidTyEscape }
+  "$("        / { ifBit ThBit }       { token ITparenEscape }
+  "$$("       / { ifBit ThBit }       { token ITparenTyEscape }
+
+  "[" @varid "|"  / { ifBit QqBit }   { lex_quasiquote_tok }
 
   -- qualified quasi-quote (#5555)
-  "[" @qvarid "|"  / { ifExtension qqEnabled }
-                     { lex_qquasiquote_tok }
+  "[" @qvarid "|"  / { ifBit QqBit }  { lex_qquasiquote_tok }
 
   $unigraphic -- ⟦
     / { ifCurrentChar '⟦' `alexAndPred`
-        ifExtension (\i -> unicodeSyntaxEnabled i && thQuotesEnabled i) }
+        ifBit UnicodeSyntaxBit `alexAndPred`
+        ifBit ThQuotesBit }
     { token (ITopenExpQuote NoE UnicodeSyntax) }
   $unigraphic -- ⟧
     / { ifCurrentChar '⟧' `alexAndPred`
-        ifExtension (\i -> unicodeSyntaxEnabled i && thQuotesEnabled i) }
+        ifBit UnicodeSyntaxBit `alexAndPred`
+        ifBit ThQuotesBit }
     { token (ITcloseQuote UnicodeSyntax) }
 }
 
@@ -407,38 +396,45 @@ $tab          { warnTab }
 <0> {
     [^ $idchar \) ] ^
   "@"
-    / { ifExtension typeApplicationEnabled `alexAndPred` notFollowedBySymbol }
+    / { ifBit TypeApplicationsBit `alexAndPred` notFollowedBySymbol }
     { token ITtypeApp }
 }
 
 <0> {
-  "(|" / { ifExtension arrowsEnabled `alexAndPred` notFollowedBySymbol }
-                                        { special (IToparenbar NormalSyntax) }
-  "|)" / { ifExtension arrowsEnabled }  { special (ITcparenbar NormalSyntax) }
+  "(|"
+    / { ifBit ArrowsBit `alexAndPred`
+        notFollowedBySymbol }
+    { special (IToparenbar NormalSyntax) }
+  "|)"
+    / { ifBit ArrowsBit }
+    { special (ITcparenbar NormalSyntax) }
 
   $unigraphic -- ⦇
     / { ifCurrentChar '⦇' `alexAndPred`
-        ifExtension (\i -> unicodeSyntaxEnabled i && arrowsEnabled i) }
+        ifBit UnicodeSyntaxBit `alexAndPred`
+        ifBit ArrowsBit }
     { special (IToparenbar UnicodeSyntax) }
   $unigraphic -- ⦈
     / { ifCurrentChar '⦈' `alexAndPred`
-        ifExtension (\i -> unicodeSyntaxEnabled i && arrowsEnabled i) }
+        ifBit UnicodeSyntaxBit `alexAndPred`
+        ifBit ArrowsBit }
     { special (ITcparenbar UnicodeSyntax) }
 }
 
 <0> {
-  \? @varid / { ifExtension ipEnabled } { skip_one_varid ITdupipvarid }
+  \? @varid / { ifBit IpBit } { skip_one_varid ITdupipvarid }
 }
 
 <0> {
-  "#" @varid / { ifExtension overloadedLabelsEnabled }
-               { skip_one_varid ITlabelvarid }
+  "#" @varid / { ifBit OverloadedLabelsBit } { skip_one_varid ITlabelvarid }
 }
 
 <0> {
-  "(#" / { orExtensions unboxedTuplesEnabled unboxedSumsEnabled }
+  "(#" / { ifBit UnboxedTuplesBit `alexOrPred`
+           ifBit UnboxedSumsBit }
          { token IToubxparen }
-  "#)" / { orExtensions unboxedTuplesEnabled unboxedSumsEnabled }
+  "#)" / { ifBit UnboxedTuplesBit `alexOrPred`
+           ifBit UnboxedSumsBit }
          { token ITcubxparen }
 }
 
@@ -463,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 "#"+      / { ifBit MagicHashBit } { idtoken qvarid }
+  @qconid "#"+      / { ifBit MagicHashBit } { idtoken qconid }
+  @varid "#"+       / { ifBit MagicHashBit } { varid }
+  @conid "#"+       / { ifBit MagicHashBit } { idtoken conid }
 }
 
 -- ToDo: - move `var` and (sym) into lexical syntax?
@@ -492,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                / { ifBit 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                   / { ifBit NegativeLiteralsBit } { tok_num negative 1 1 decimal }
+  @negative 0[bB] @numspc @binary      / { ifBit NegativeLiteralsBit `alexAndPred`
+                                           ifBit BinaryLiteralsBit }   { tok_num negative 3 3 binary }
+  @negative 0[oO] @numspc @octal       / { ifBit NegativeLiteralsBit } { tok_num negative 3 3 octal }
+  @negative 0[xX] @numspc @hexadecimal / { ifBit 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            / { ifBit NegativeLiteralsBit } { tok_frac 0 tok_float }
+  0[xX] @numspc @hex_floating_point    / { ifBit HexFloatLiteralsBit } { tok_frac 0 tok_hex_float }
+  @negative 0[xX] @numspc @hex_floating_point
+                                       / { ifBit HexFloatLiteralsBit `alexAndPred`
+                                           ifBit 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                          \# / { ifBit MagicHashBit }        { tok_primint positive 0 1 decimal }
+  0[bB] @numspc @binary             \# / { ifBit MagicHashBit `alexAndPred`
+                                           ifBit BinaryLiteralsBit }   { tok_primint positive 2 3 binary }
+  0[oO] @numspc @octal              \# / { ifBit MagicHashBit }        { tok_primint positive 2 3 octal }
+  0[xX] @numspc @hexadecimal        \# / { ifBit MagicHashBit }        { tok_primint positive 2 3 hexadecimal }
+  @negative @decimal                \# / { ifBit MagicHashBit }        { tok_primint negative 1 2 decimal }
+  @negative 0[bB] @numspc @binary   \# / { ifBit MagicHashBit `alexAndPred`
+                                           ifBit BinaryLiteralsBit }   { tok_primint negative 3 4 binary }
+  @negative 0[oO] @numspc @octal    \# / { ifBit MagicHashBit }        { tok_primint negative 3 4 octal }
+  @negative 0[xX] @numspc @hexadecimal \#
+                                       / { ifBit MagicHashBit }        { tok_primint negative 3 4 hexadecimal }
+
+  @decimal                       \# \# / { ifBit MagicHashBit }        { tok_primword 0 2 decimal }
+  0[bB] @numspc @binary          \# \# / { ifBit MagicHashBit `alexAndPred`
+                                           ifBit BinaryLiteralsBit }   { tok_primword 2 4 binary }
+  0[oO] @numspc @octal           \# \# / { ifBit MagicHashBit }        { tok_primword 2 4 octal }
+  0[xX] @numspc @hexadecimal     \# \# / { ifBit 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           \# / { ifBit MagicHashBit }        { tok_frac 1 tok_primfloat }
+  @signed @floating_point        \# \# / { ifBit MagicHashBit }        { tok_frac 2 tok_primdouble }
 }
 
 -- Strings and chars are lexed by hand-written code.  The reason is
@@ -646,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
@@ -753,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
 
@@ -827,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 ),
@@ -875,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
@@ -961,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
@@ -1021,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` "|^*$#"))
@@ -1036,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
+ifBit :: ExtBits -> AlexAccPred ExtsBitmap
+ifBit 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 "")
@@ -1083,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
 
 {-
@@ -1097,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
@@ -1216,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)))
@@ -1315,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
@@ -1357,11 +1349,18 @@ 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, 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
@@ -1374,7 +1373,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"
@@ -1414,7 +1413,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"
@@ -1446,7 +1445,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
@@ -1473,7 +1472,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
@@ -1499,7 +1498,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 _ : _  |
@@ -1615,7 +1614,7 @@ lex_string s = do
 
     Just ('"',i)  -> do
         setInput i
-        magicHash <- extension magicHashEnabled
+        magicHash <- getBit MagicHashBit
         if magicHash
           then do
             i <- getInput
@@ -1702,7 +1701,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
@@ -1978,10 +1977,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.
@@ -2055,9 +2050,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)
 
@@ -2242,9 +2234,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 = extension alternativeLayoutTransitionalRule
-
 getJustClosedExplicitLetBlock :: P Bool
 getJustClosedExplicitLetBlock
  = P $ \s@(PState {alr_justClosedExplicitLetBlock = b}) -> POk s b
@@ -2279,19 +2268,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)
 
--- | Subset of the language extensions that impact lexing and parsing.
+-- | 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
@@ -2313,8 +2309,6 @@ data ExtBits
   | DatatypeContextsBit
   | TransformComprehensionsBit
   | QqBit -- enable quasiquoting
-  | InRulePragBit
-  | InNestedCommentBit -- See Note [Nested comment line pragmas]
   | RawTokenStreamBit -- producing a token stream with all comments included
   | AlternativeLayoutRuleBit
   | ALRTransitionalBit
@@ -2336,87 +2330,17 @@ data ExtBits
   | 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
-monadComprehensionsEnabled :: ExtsBitmap -> Bool
-monadComprehensionsEnabled = xtest TransformComprehensionsBit
-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
-alternativeLayoutTransitionalRule :: ExtsBitmap -> Bool
-alternativeLayoutTransitionalRule = xtest ALRTransitionalBit
-relaxedLayout :: ExtsBitmap -> Bool
-relaxedLayout = xtest RelaxedLayoutBit
-nondecreasingIndentation :: ExtsBitmap -> Bool
-nondecreasingIndentation = xtest NondecreasingIndentationBit
-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
-blockArgumentsEnabled :: ExtsBitmap -> Bool
-blockArgumentsEnabled = xtest BlockArgumentsBit
-nPlusKPatternsEnabled :: ExtsBitmap -> Bool
-nPlusKPatternsEnabled = xtest NPlusKPatternsBit
-doAndIfThenElseEnabled :: ExtsBitmap -> Bool
-doAndIfThenElseEnabled = xtest DoAndIfThenElseBit
-multiWayIfEnabled :: ExtsBitmap -> Bool
-multiWayIfEnabled = xtest MultiWayIfBit
-gadtSyntaxEnabled :: ExtsBitmap -> Bool
-gadtSyntaxEnabled = xtest GadtSyntaxBit
+
 
 
 
@@ -2435,10 +2359,16 @@ mkParserFlags'
   -> 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 =
+  safeImports isHaddock rawTokStream usePosPrags =
     ParserFlags {
       pWarningFlags = warningFlags
     , pThisPackage = thisPackage
@@ -2489,6 +2419,7 @@ mkParserFlags' warningFlags extensionFlags thisPackage
     optBits =
           HaddockBit        `setBitIf` isHaddock
       .|. RawTokenStreamBit `setBitIf` rawTokStream
+      .|. UsePosPragsBit    `setBitIf` usePosPrags
 
     xoptBit bit ext = bit `setBitIf` EnumSet.member ext extensionFlags
 
@@ -2506,6 +2437,7 @@ mkParserFlags =
     <*> safeImportsOn
     <*> gopt Opt_Haddock
     <*> gopt Opt_KeepRawTokenStream
+    <*> const True
 
 -- | Creates a parse state from a 'DynFlags' value
 mkPState :: DynFlags -> StringBuffer -> RealSrcLoc -> PState
@@ -2533,7 +2465,6 @@ mkPStatePure options buf loc =
       alr_context = [],
       alr_expecting_ocurly = Nothing,
       alr_justClosedExplicitLetBlock = False,
-      use_pos_prags = True,
       annotations = [],
       comment_q = [],
       annotations_comments = []
@@ -2643,8 +2574,8 @@ srcParseErr options buf len
         pattern = decodePrevNChars 8 buf
         last100 = decodePrevNChars 100 buf
         mdoInLast100 = "mdo" `isInfixOf` last100
-        th_enabled = thEnabled (pExtsBitmap options)
-        ps_enabled = patternSynonymsEnabled (pExtsBitmap 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
@@ -2668,7 +2599,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
@@ -2713,7 +2644,7 @@ alternativeLayoutRuleToken t
     = do context <- getALRContext
          lastLoc <- getAlrLastLoc
          mExpectingOCurly <- getAlrExpectingOCurly
-         transitional <- getALRTransitional
+         transitional <- getBit ALRTransitionalBit
          justClosedExplicitLetBlock <- getJustClosedExplicitLetBlock
          setJustClosedExplicitLetBlock False
          let thisLoc = getLoc t
@@ -2944,9 +2875,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 4c2e3e7660..4821e28421 100644
--- a/compiler/parser/Parser.y
+++ b/compiler/parser/Parser.y
@@ -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 `''`"
diff --git a/compiler/parser/RdrHsSyn.hs b/compiler/parser/RdrHsSyn.hs
index 94b1dfafb2..2faa58b09e 100644
--- a/compiler/parser/RdrHsSyn.hs
+++ b/compiler/parser/RdrHsSyn.hs
@@ -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
@@ -2066,8 +2066,8 @@ mkModuleImpExp (L l specname) subs =
     ImpExpList xs        ->
       (\newName -> IEThingWith noExt (L l newName) NoIEWildcard (wrapped xs) [])
         <$> nameT
-    ImpExpAllWith xs                       ->
-      do allowed <- extension patternSynonymsEnabled
+    ImpExpAllWith xs     ->
+      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)