X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fparser%2FLexer.x;h=15745d5620f27080eca1620a7ca8a651dc044171;hb=3ad8f84f6a75f240383e62a14472d14eb372dcd1;hp=fdbaeef3feaa773673b9bdec87c2e9d6220df075;hpb=ac9c1e5de9629103a125e0515dcee2466ff898a7;p=ghc-hetmet.git

diff --git a/compiler/parser/Lexer.x b/compiler/parser/Lexer.x
index fdbaeef..15745d5 100644
--- a/compiler/parser/Lexer.x
+++ b/compiler/parser/Lexer.x
@@ -27,7 +27,7 @@ module Lexer (
    failLocMsgP, failSpanMsgP, srcParseFail,
    popContext, pushCurrentContext, setLastToken, setSrcLoc,
    getLexState, popLexState, pushLexState,
-   extension, bangPatEnabled
+   extension, glaExtsEnabled, bangPatEnabled
   ) where
 
 #include "HsVersions.h"
@@ -250,7 +250,6 @@ $white_no_nl+ 				;
 
 <0,glaexts> {
   \? @varid / { ifExtension ipEnabled }	{ skip_one_varid ITdupipvarid }
-  \% @varid / { ifExtension ipEnabled } { skip_one_varid ITsplitipvarid }
 }
 
 <glaexts> {
@@ -346,6 +345,7 @@ data Token
   | ITderiving
   | ITdo
   | ITelse
+  | ITfor
   | IThiding
   | ITif
   | ITimport
@@ -442,7 +442,6 @@ data Token
   | ITqconsym (FastString,FastString)
 
   | ITdupipvarid   FastString	-- GHC extension: implicit param: ?x
-  | ITsplitipvarid FastString	-- GHC extension: implicit param: %x
 
   | ITpragma StringBuffer
 
@@ -490,6 +489,7 @@ isSpecial :: Token -> Bool
 -- not as a keyword.
 isSpecial ITas        	= True
 isSpecial IThiding    	= True
+isSpecial ITfor    	= True
 isSpecial ITqualified 	= True
 isSpecial ITforall    	= True
 isSpecial ITexport    	= True
@@ -523,6 +523,7 @@ reservedWordsFM = listToUFM $
 	( "deriving",	ITderiving, 	0 ), 
 	( "do",		ITdo, 		0 ),       
 	( "else",	ITelse, 	0 ),     
+	( "for",	ITfor, 		0 ),
 	( "hiding",	IThiding, 	0 ),
 	( "if",		ITif, 		0 ),       
 	( "import",	ITimport, 	0 ),   
@@ -543,8 +544,7 @@ reservedWordsFM = listToUFM $
 
       	( "forall",	ITforall,	 bit tvBit),
 	( "mdo",	ITmdo,		 bit glaExtsBit),
-	( "iso",	ITiso,		 bit glaExtsBit),
-	( "family",	ITfamily,	 bit glaExtsBit),
+	( "family",	ITfamily,	 bit idxTysBit),
 
 	( "foreign",	ITforeign,	 bit ffiBit),
 	( "export",	ITexport,	 bit ffiBit),
@@ -578,8 +578,9 @@ reservedSymsFM = listToUFM $
        ,("-",	ITminus, 	0)
        ,("!",	ITbang, 	0)
 
-       ,("*",	ITstar,		bit glaExtsBit)	-- For data T (a::*) = MkT
-       ,(".",	ITdot,		bit tvBit)	-- For 'forall a . t'
+       ,("*",	ITstar,		bit glaExtsBit .|. 
+				bit idxTysBit)	    -- For data T (a::*) = MkT
+       ,(".",	ITdot,		bit tvBit)	    -- For 'forall a . t'
 
        ,("-<",	ITlarrowtail,	bit arrowsBit)
        ,(">-",	ITrarrowtail,	bit arrowsBit)
@@ -1314,6 +1315,7 @@ ipBit      = 6
 tvBit	   = 7	-- Scoped type variables enables 'forall' keyword
 bangPatBit = 8	-- Tells the parser to understand bang-patterns
 		-- (doesn't affect the lexer)
+idxTysBit  = 9	-- indexed type families: 'family' keyword and kind sigs
 
 glaExtsEnabled, ffiEnabled, parrEnabled :: Int -> Bool
 glaExtsEnabled flags = testBit flags glaExtsBit
@@ -1324,6 +1326,7 @@ thEnabled      flags = testBit flags thBit
 ipEnabled      flags = testBit flags ipBit
 tvEnabled      flags = testBit flags tvBit
 bangPatEnabled flags = testBit flags bangPatBit
+idxTysEnabled  flags = testBit flags idxTysBit
 
 -- PState for parsing options pragmas
 --
@@ -1365,6 +1368,7 @@ mkPState buf loc flags  =
 	       .|. ipBit      `setBitIf` dopt Opt_ImplicitParams flags
 	       .|. tvBit      `setBitIf` dopt Opt_ScopedTypeVariables flags
 	       .|. bangPatBit `setBitIf` dopt Opt_BangPatterns flags
+	       .|. idxTysBit  `setBitIf` dopt Opt_IndexedTypes flags
       --
       setBitIf :: Int -> Bool -> Int
       b `setBitIf` cond | cond      = bit b