Support the MagicHash extension as a flag and LANGUAGE pragma

compiler/main/DynFlags.hs

@@ -183,6 +183,7 @@ data DynFlag
    | Opt_RecordPuns
    | Opt_GADTs
    | Opt_RelaxedPolyRec			-- -X=RelaxedPolyRec
+   | Opt_MagicHash
 
    -- optimisation opts
    | Opt_Strictness
@@ -1092,6 +1093,7 @@ fFlags = [
 -- These -X<blah> flags can all be reversed with -Xno-<blah>
 xFlags :: [(String, DynFlag)]
 xFlags = [
+  ( "MagicHash",                        Opt_MagicHash ),
   ( "FI",				Opt_FFI ),  -- support `-ffi'...
   ( "FFI",				Opt_FFI ),  -- ...and also `-fffi'
   ( "ForeignFunctionInterface",		Opt_FFI ),
@@ -1135,6 +1137,7 @@ glasgowExtsFlags = [ Opt_GlasgowExts
 		   , Opt_GADTs
 		   , Opt_ImplicitParams 
 		   , Opt_ScopedTypeVariables
+		   , Opt_MagicHash
 		   , Opt_TypeFamilies ]
 
 ------------------

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.(,,,)
@@ -1517,18 +1517,20 @@ 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
 
 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
 
 -- PState for parsing options pragmas
 --
@@ -1571,15 +1573,16 @@ 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
       --
       setBitIf :: Int -> Bool -> Int
       b `setBitIf` cond | cond      = bit b