X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fparser%2FLexer.x;h=520e6825c5643564c4df08bd2fbba9ab3e9beb9e;hb=7345a096d5d3c24dae0b3ef480c2f16ad0e83629;hp=c4cd0aa3842b4d26a9959faed549d0d924fc0ba6;hpb=cdd7fdacaafc36de12e8d703904667aada6bbe31;p=ghc-hetmet.git

diff --git a/compiler/parser/Lexer.x b/compiler/parser/Lexer.x
index c4cd0aa..520e682 100644
--- a/compiler/parser/Lexer.x
+++ b/compiler/parser/Lexer.x
@@ -220,13 +220,14 @@ $tab+         { warn Opt_WarnTabs (text "Tab character") }
    -- 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.
 -- (ToDo: we should really emit a warning when ignoring pragmas)
-<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) }
@@ -315,9 +316,9 @@ $tab+         { warn Opt_WarnTabs (text "Tab character") }
          { token ITcubxparen }
 }
 
-<glaexts> {
-  "{|"					{ token ITocurlybar }
-  "|}"					{ token ITccurlybar }
+<0,glaexts> {
+  "{|" / { ifExtension genericsEnabled } { token ITocurlybar }
+  "|}" / { ifExtension genericsEnabled } { token ITccurlybar }
 }
 
 <0,option_prags,glaexts> {
@@ -375,21 +376,21 @@ $tab+         { warn Opt_WarnTabs (text "Tab character") }
   @floating_point		{ strtoken tok_float }
 }
 
-<glaexts> {
+<0,glaexts> {
   -- Unboxed ints (:: Int#)
   -- It's simpler (and faster?) to give separate cases to the negatives,
   -- especially considering octal/hexadecimal prefixes.
-  @decimal \#			{ tok_primint positive 0 1 decimal }
-  0[oO] @octal \#		{ tok_primint positive 2 3 octal }
-  0[xX] @hexadecimal \#		{ tok_primint positive 2 3 hexadecimal }
-  @negative @decimal \#			{ tok_primint negative 1 2 decimal }
-  @negative 0[oO] @octal \#		{ tok_primint negative 3 4 octal }
-  @negative 0[xX] @hexadecimal \#	{ tok_primint negative 3 4 hexadecimal }
+  @decimal \# / { ifExtension magicHashEnabled } { tok_primint positive 0 1 decimal }
+  0[oO] @octal \# / { ifExtension magicHashEnabled } { tok_primint positive 2 3 octal }
+  0[xX] @hexadecimal \# / { ifExtension magicHashEnabled } { tok_primint positive 2 3 hexadecimal }
+  @negative @decimal \# / { ifExtension magicHashEnabled } { tok_primint negative 1 2 decimal }
+  @negative 0[oO] @octal \# / { ifExtension magicHashEnabled } { tok_primint negative 3 4 octal }
+  @negative 0[xX] @hexadecimal \# / { ifExtension magicHashEnabled } { tok_primint negative 3 4 hexadecimal }
 
   -- Unboxed floats and doubles (:: Float#, :: Double#)
   -- prim_{float,double} work with signed literals
-  @signed @floating_point \#		{ init_strtoken 1 tok_primfloat }
-  @signed @floating_point \# \#		{ init_strtoken 2 tok_primdouble }
+  @signed @floating_point \# / { ifExtension magicHashEnabled } { init_strtoken 1 tok_primfloat }
+  @signed @floating_point \# \# / { ifExtension magicHashEnabled } { init_strtoken 2 tok_primdouble }
 }
 
 -- Strings and chars are lexed by hand-written code.  The reason is
@@ -1111,8 +1112,8 @@ lex_string s = do
 
     Just ('"',i)  -> do
 	setInput i
-	glaexts <- extension glaExtsEnabled
-	if glaexts
+	magicHash <- extension magicHashEnabled
+	if magicHash
 	  then do
 	    i <- getInput
 	    case alexGetChar' i of
@@ -1196,9 +1197,9 @@ lex_char_tok span buf len = do	-- We've seen '
 finish_char_tok :: SrcLoc -> Char -> P (Located Token)
 finish_char_tok loc ch	-- We've already seen the closing quote
 			-- Just need to check for trailing #
-  = do	glaexts <- extension glaExtsEnabled
+  = do	magicHash <- extension magicHashEnabled
 	i@(AI end _ _) <- getInput
-	if glaexts then do
+	if magicHash then do
 		case alexGetChar' i of
 			Just ('#',i@(AI end _ _)) -> do
 				setInput i
@@ -1531,6 +1532,7 @@ kindSigsBit = 12 -- Kind signatures on type variables
 recursiveDoBit = 13 -- mdo
 unicodeSyntaxBit = 14 -- the forall symbol, arrow symbols, etc
 unboxedTuplesBit = 15 -- (# and #)
+genericsBit = 16 -- {| and |}
 
 glaExtsEnabled, ffiEnabled, parrEnabled :: Int -> Bool
 always           _     = True
@@ -1549,6 +1551,7 @@ kindSigsEnabled  flags = testBit flags kindSigsBit
 recursiveDoEnabled flags = testBit flags recursiveDoBit
 unicodeSyntaxEnabled flags = testBit flags unicodeSyntaxBit
 unboxedTuplesEnabled flags = testBit flags unboxedTuplesBit
+genericsEnabled      flags = testBit flags genericsBit
 
 -- PState for parsing options pragmas
 --
@@ -1599,6 +1602,8 @@ mkPState buf loc 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
@@ -1607,6 +1612,7 @@ mkPState buf loc flags  =
 	       .|. recursiveDoBit `setBitIf` dopt Opt_RecursiveDo flags
 	       .|. unicodeSyntaxBit `setBitIf` dopt Opt_UnicodeSyntax flags
 	       .|. unboxedTuplesBit `setBitIf` dopt Opt_UnboxedTuples flags
+	       .|. genericsBit `setBitIf` dopt Opt_Generics flags
       --
       setBitIf :: Int -> Bool -> Int
       b `setBitIf` cond | cond      = bit b