Commit aa13a496 authored by Ian Lynagh's avatar Ian Lynagh
Browse files

Support the MagicHash extension as a flag and LANGUAGE pragma

parent 58916f71
......@@ -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 ]
------------------
......
......@@ -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
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment