-- NOTE: accept -} at the end of a LINE pragma, for compatibility
-- with older versions of GHC which generated these.
-- NOTE: accept -} at the end of a LINE pragma, for compatibility
-- with older versions of GHC which generated these.
--- We only want RULES pragmas to be picked up when -fglasgow-exts
--- is on, because the contents of the pragma is always written using
--- glasgow-exts syntax (using forall etc.), so if glasgow exts are not
--- enabled, we're sure to get a parse error.
+-- We only want RULES pragmas to be picked up when explicit forall
+-- syntax is enabled is on, because the contents of the pragma always
+-- uses it. If it's not on then we're sure to get a parse error.
-<glaexts>
- "{-#" $whitechar* (RULES|rules) { token ITrules_prag }
+-- XXX Now that we can enable this without the -fglasgow-exts hammer,
+-- is it better just to let the parse error happen?
+<0,glaexts>
+ "{-#" $whitechar* (RULES|rules) / { ifExtension explicitForallEnabled } { token ITrules_prag }
<0,option_prags,glaexts> {
"{-#" $whitechar* (INLINE|inline) { token (ITinline_prag True) }
<0,option_prags,glaexts> {
"{-#" $whitechar* (INLINE|inline) { token (ITinline_prag True) }
( "where", ITwhere, 0 ),
( "_scc_", ITscc, 0 ), -- ToDo: remove
( "where", ITwhere, 0 ),
( "_scc_", ITscc, 0 ), -- ToDo: remove
- ( "forall", ITforall, bit tvBit),
+ ( "forall", ITforall, bit explicitForallBit),
( "mdo", ITmdo, bit recursiveDoBit),
( "family", ITfamily, bit tyFamBit),
( "mdo", ITmdo, bit recursiveDoBit),
( "family", ITfamily, bit tyFamBit),
- ,(".", ITdot, tvEnabled)
+ ,(".", ITdot, explicitForallEnabled)
,("-<", ITlarrowtail, arrowsEnabled)
,(">-", ITrarrowtail, arrowsEnabled)
,("-<", ITlarrowtail, arrowsEnabled)
,(">-", ITrarrowtail, arrowsEnabled)
#if __GLASGOW_HASKELL__ >= 605
,("∷", ITdcolon, unicodeSyntaxEnabled)
,("⇒", ITdarrow, unicodeSyntaxEnabled)
#if __GLASGOW_HASKELL__ >= 605
,("∷", ITdcolon, unicodeSyntaxEnabled)
,("⇒", ITdarrow, unicodeSyntaxEnabled)
- ,("∀", ITforall, \i -> unicodeSyntaxEnabled i && tvEnabled i)
+ ,("∀", ITforall, \i -> unicodeSyntaxEnabled i &&
+ explicitForallEnabled i)
,("→", ITrarrow, unicodeSyntaxEnabled)
,("←", ITlarrow, unicodeSyntaxEnabled)
,("⋯", ITdotdot, unicodeSyntaxEnabled)
,("→", ITrarrow, unicodeSyntaxEnabled)
,("←", ITlarrow, unicodeSyntaxEnabled)
,("⋯", ITdotdot, unicodeSyntaxEnabled)
bangPatBit = 8 -- Tells the parser to understand bang-patterns
-- (doesn't affect the lexer)
tyFamBit = 9 -- indexed type families: 'family' keyword and kind sigs
bangPatBit = 8 -- Tells the parser to understand bang-patterns
-- (doesn't affect the lexer)
tyFamBit = 9 -- indexed type families: 'family' keyword and kind sigs
kindSigsBit = 12 -- Kind signatures on type variables
recursiveDoBit = 13 -- mdo
unicodeSyntaxBit = 14 -- the forall symbol, arrow symbols, etc
kindSigsBit = 12 -- Kind signatures on type variables
recursiveDoBit = 13 -- mdo
unicodeSyntaxBit = 14 -- the forall symbol, arrow symbols, etc
arrowsEnabled flags = testBit flags arrowsBit
thEnabled flags = testBit flags thBit
ipEnabled flags = testBit flags ipBit
arrowsEnabled flags = testBit flags arrowsBit
thEnabled flags = testBit flags thBit
ipEnabled flags = testBit flags ipBit
bangPatEnabled flags = testBit flags bangPatBit
tyFamEnabled flags = testBit flags tyFamBit
haddockEnabled flags = testBit flags haddockBit
bangPatEnabled flags = testBit flags bangPatBit
tyFamEnabled flags = testBit flags tyFamBit
haddockEnabled flags = testBit flags haddockBit
kindSigsEnabled flags = testBit flags kindSigsBit
recursiveDoEnabled flags = testBit flags recursiveDoBit
unicodeSyntaxEnabled flags = testBit flags unicodeSyntaxBit
kindSigsEnabled flags = testBit flags kindSigsBit
recursiveDoEnabled flags = testBit flags recursiveDoBit
unicodeSyntaxEnabled flags = testBit flags unicodeSyntaxBit
.|. arrowsBit `setBitIf` dopt Opt_Arrows flags
.|. thBit `setBitIf` dopt Opt_TH flags
.|. ipBit `setBitIf` dopt Opt_ImplicitParams flags
.|. arrowsBit `setBitIf` dopt Opt_Arrows flags
.|. thBit `setBitIf` dopt Opt_TH flags
.|. ipBit `setBitIf` dopt Opt_ImplicitParams flags
- .|. tvBit `setBitIf` dopt Opt_ScopedTypeVariables flags
+ .|. explicitForallBit `setBitIf` dopt Opt_ScopedTypeVariables flags
+ .|. explicitForallBit `setBitIf` dopt Opt_PolymorphicComponents flags
+ .|. explicitForallBit `setBitIf` dopt Opt_ExistentialQuantification flags
+ .|. explicitForallBit `setBitIf` dopt Opt_Rank2Types flags
+ .|. explicitForallBit `setBitIf` dopt Opt_RankNTypes flags
.|. bangPatBit `setBitIf` dopt Opt_BangPatterns flags
.|. tyFamBit `setBitIf` dopt Opt_TypeFamilies flags
.|. haddockBit `setBitIf` dopt Opt_Haddock flags
.|. bangPatBit `setBitIf` dopt Opt_BangPatterns flags
.|. tyFamBit `setBitIf` dopt Opt_TypeFamilies flags
.|. haddockBit `setBitIf` dopt Opt_Haddock flags
.|. kindSigsBit `setBitIf` dopt Opt_KindSignatures flags
.|. recursiveDoBit `setBitIf` dopt Opt_RecursiveDo flags
.|. unicodeSyntaxBit `setBitIf` dopt Opt_UnicodeSyntax flags
.|. kindSigsBit `setBitIf` dopt Opt_KindSignatures flags
.|. recursiveDoBit `setBitIf` dopt Opt_RecursiveDo flags
.|. unicodeSyntaxBit `setBitIf` dopt Opt_UnicodeSyntax flags