[project @ 2005-02-23 13:46:43 by simonpj]

[ghc-hetmet.git] / ghc / compiler / parser / Lexer.x

diff --git a/ghc/compiler/parser/Lexer.x b/ghc/compiler/parser/Lexer.x
index 8304918..0a2f3c5 100644 (file)
--- a/ghc/compiler/parser/Lexer.x
+++ b/ghc/compiler/parser/Lexer.x
@@ -166,6 +166,14 @@ $white_no_nl+                              ;
    -- NOTE: accept -} at the end of a LINE pragma, for compatibility
    -- with older versions of GHC which generated these.
 
+-- We only want RULES pragmas to be picked up when -fglasgow-exts
+-- is on, because the contents of the pragma is always written using
+-- glasgow-exts syntax (using forall etc.), so if glasgow exts are not
+-- enabled, we're sure to get a parse error.
+-- (ToDo: we should really emit a warning when ignoring pragmas)
+<glaexts>
+  "{-#" $whitechar* (RULES|rules)      { token ITrules_prag }
+
 <0,glaexts> {
   "{-#" $whitechar* (SPECIALI[SZ]E|speciali[sz]e)
                                        { token ITspecialise_prag }
@@ -173,7 +181,6 @@ $white_no_nl+                               ;
   "{-#" $whitechar* (INLINE|inline)    { token ITinline_prag }
   "{-#" $whitechar* (NO(T?)INLINE|no(t?)inline)
                                        { token ITnoinline_prag }
-  "{-#" $whitechar* (RULES|rules)      { token ITrules_prag }
   "{-#" $whitechar* (DEPRECATED|deprecated)
                                        { token ITdeprecated_prag }
   "{-#" $whitechar* (SCC|scc)          { token ITscc_prag }
@@ -499,7 +506,7 @@ reservedWordsFM = listToUFM $
        ( "where",      ITwhere,        0 ),
        ( "_scc_",      ITscc,          0 ),            -- ToDo: remove
 
-       ( "forall",     ITforall,        bit glaExtsBit),
+       ( "forall",     ITforall,        bit tvBit),
        ( "mdo",        ITmdo,           bit glaExtsBit),
 
        ( "foreign",    ITforeign,       bit ffiBit),
@@ -535,7 +542,7 @@ reservedSymsFM = listToUFM $
        ,("!",  ITbang,         0)
 
        ,("*",  ITstar,         bit glaExtsBit) -- For data T (a::*) = MkT
-       ,(".",  ITdot,          bit glaExtsBit) -- For 'forall a . t'
+       ,(".",  ITdot,          bit tvBit)      -- For 'forall a . t'
 
        ,("-<", ITlarrowtail,   bit arrowsBit)
        ,(">-", ITrarrowtail,   bit arrowsBit)
@@ -1153,6 +1160,7 @@ parrBit      = 2
 arrowsBit  = 4
 thBit     = 5
 ipBit      = 6
+tvBit     = 7  -- Scoped type variables enables 'forall' keyword
 
 glaExtsEnabled, ffiEnabled, parrEnabled :: Int -> Bool
 glaExtsEnabled flags = testBit flags glaExtsBit
@@ -1161,6 +1169,7 @@ 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
 
 -- create a parse state
 --
@@ -1183,6 +1192,7 @@ mkPState buf loc 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
       --
       setBitIf :: Int -> Bool -> Int
       b `setBitIf` cond | cond      = bit b