From aa13a496c2f4d027355002c7103bc38486497b75 Mon Sep 17 00:00:00 2001 From: Ian Lynagh Date: Sun, 8 Jul 2007 11:10:41 +0000 Subject: [PATCH] Support the MagicHash extension as a flag and LANGUAGE pragma --- compiler/main/DynFlags.hs | 3 +++ compiler/parser/Lexer.x | 51 ++++++++++++++++++++++++--------------------- 2 files changed, 30 insertions(+), 24 deletions(-) diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index 4aea083..e0aca33 100644 --- a/compiler/main/DynFlags.hs +++ b/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 flags can all be reversed with -Xno- 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 ] ------------------ diff --git a/compiler/parser/Lexer.x b/compiler/parser/Lexer.x index db48dbe..d1a9bb7 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) } } - { - @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 -- 1.7.10.4