X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fparser%2FLexer.x;h=e008456e7a4f7f0af5299039f9d94392be63a4e6;hb=c0cc5433a24d5b30de7d6ec6e03480dc9a0958e1;hp=db48dbe7c6967fdaf42c54c45d0bc91cf881500b;hpb=78d145815572a7b28d6fb9169a5567a604e38846;p=ghc-hetmet.git

diff --git a/compiler/parser/Lexer.x b/compiler/parser/Lexer.x
index db48dbe..e008456 100644
--- a/compiler/parser/Lexer.x
+++ b/compiler/parser/Lexer.x
@@ -342,11 +342,11 @@ $tab+         { warn Opt_WarnTabs (text "Tab character") }
   @qual @conid			{ pop_and (idtoken qconid) }
 }
 
-<glaexts> {
-  @qual @varid "#"+		{ idtoken qvarid }
-  @qual @conid "#"+		{ idtoken qconid }
-  @varid "#"+			{ varid }
-  @conid "#"+			{ idtoken conid }
+<0,glaexts> {
+  @qual @varid "#"+ / { ifExtension magicHashEnabled } { idtoken qvarid }
+  @qual @conid "#"+ / { ifExtension magicHashEnabled } { idtoken qconid }
+  @varid "#"+       / { ifExtension magicHashEnabled } { varid }
+  @conid "#"+       / { ifExtension magicHashEnabled } { idtoken conid }
 }
 
 -- ToDo: M.(,,,)
@@ -649,7 +649,7 @@ reservedSymsFM = listToUFM $
        ,("-",	ITminus, 	0)
        ,("!",	ITbang, 	0)
 
-       ,("*",	ITstar,		bit glaExtsBit .|. 
+       ,("*",	ITstar,		bit glaExtsBit .|. bit kindSigsBit .|.
 				bit tyFamBit)	    -- For data T (a::*) = MkT
        ,(".",	ITdot,		bit tvBit)	    -- For 'forall a . t'
 
@@ -1517,18 +1517,22 @@ bangPatBit = 8	-- Tells the parser to understand bang-patterns
 		-- (doesn't affect the lexer)
 tyFamBit   = 9	-- indexed type families: 'family' keyword and kind sigs
 haddockBit = 10 -- Lex and parse Haddock comments
+magicHashBit = 11 -- # in both functions and operators
+kindSigsBit = 12 -- # in both functions and operators
 
 glaExtsEnabled, ffiEnabled, parrEnabled :: Int -> Bool
-glaExtsEnabled flags = testBit flags glaExtsBit
-ffiEnabled     flags = testBit flags ffiBit
-parrEnabled    flags = testBit flags parrBit
-arrowsEnabled  flags = testBit flags arrowsBit
-thEnabled      flags = testBit flags thBit
-ipEnabled      flags = testBit flags ipBit
-tvEnabled      flags = testBit flags tvBit
-bangPatEnabled flags = testBit flags bangPatBit
-tyFamEnabled   flags = testBit flags tyFamBit
-haddockEnabled flags = testBit flags haddockBit
+glaExtsEnabled   flags = testBit flags glaExtsBit
+ffiEnabled       flags = testBit flags ffiBit
+parrEnabled      flags = testBit flags parrBit
+arrowsEnabled    flags = testBit flags arrowsBit
+thEnabled        flags = testBit flags thBit
+ipEnabled        flags = testBit flags ipBit
+tvEnabled        flags = testBit flags tvBit
+bangPatEnabled   flags = testBit flags bangPatBit
+tyFamEnabled     flags = testBit flags tyFamBit
+haddockEnabled   flags = testBit flags haddockBit
+magicHashEnabled flags = testBit flags magicHashBit
+kindSigsEnabled  flags = testBit flags kindSigsBit
 
 -- PState for parsing options pragmas
 --
@@ -1571,15 +1575,17 @@ mkPState buf loc flags  =
     }
     where
       bitmap =     glaExtsBit `setBitIf` dopt Opt_GlasgowExts  flags
-	       .|. ffiBit     `setBitIf` dopt Opt_FFI          flags
-	       .|. parrBit    `setBitIf` dopt Opt_PArr         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
-	       .|. bangPatBit `setBitIf` dopt Opt_BangPatterns flags
-	       .|. tyFamBit   `setBitIf` dopt Opt_TypeFamilies flags
-	       .|. haddockBit `setBitIf` dopt Opt_Haddock      flags
+	       .|. ffiBit       `setBitIf` dopt Opt_FFI          flags
+	       .|. parrBit      `setBitIf` dopt Opt_PArr         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
+	       .|. bangPatBit   `setBitIf` dopt Opt_BangPatterns flags
+	       .|. tyFamBit     `setBitIf` dopt Opt_TypeFamilies flags
+	       .|. haddockBit   `setBitIf` dopt Opt_Haddock      flags
+	       .|. magicHashBit `setBitIf` dopt Opt_MagicHash    flags
+	       .|. kindSigsBit  `setBitIf` dopt Opt_KindSignatures flags
       --
       setBitIf :: Int -> Bool -> Int
       b `setBitIf` cond | cond      = bit b