[project @ 1999-06-28 16:42:22 by simonmar]

[ghc-hetmet.git] / ghc / compiler / parser / Lex.lhs

diff --git a/ghc/compiler/parser/Lex.lhs b/ghc/compiler/parser/Lex.lhs
index f10d653..d705043 100644 (file)
--- a/ghc/compiler/parser/Lex.lhs
+++ b/ghc/compiler/parser/Lex.lhs
@@ -34,7 +34,7 @@ module Lex (
 
 #include "HsVersions.h"
 
-import Char            ( ord, isSpace )
+import Char            ( ord, isSpace, toUpper )
 import List             ( isSuffixOf )
 
 import IdInfo          ( InlinePragInfo(..), CprInfo(..) )
@@ -236,6 +236,7 @@ pragmaKeywordsFM = listToUFM $
        ( "SOURCE",     ITsource_prag ),
        ( "INLINE",     ITinline_prag ),
        ( "NOINLINE",   ITnoinline_prag ),
+       ( "NOTINLINE",  ITnoinline_prag ),
        ( "LINE",       ITline_prag ),
        ( "RULES",      ITrules_prag ),
        ( "RULEZ",      ITrules_prag )  -- american spelling :-)
@@ -271,7 +272,6 @@ haskellKeywordsFM = listToUFM $
        ( "_scc_",      ITscc )
      ]
 
-
 ghcExtensionKeywordsFM = listToUFM $
        map (\ (x,y) -> (_PK_ x,y))
      [ ( "forall",     ITforall ),
@@ -402,7 +402,8 @@ lexer cont buf s@(PState{
                  if lookAhead# buf 3# `eqChar#` '#'# then is_a_token else
                  case expandWhile# is_space (setCurrentPos# buf 3#) of { buf1->
                  case expandWhile# is_ident (stepOverLexeme buf1)   of { buf2->
-                 let lexeme = lexemeToFastString buf2 in
+                 let lexeme = mkFastString -- ToDo: too slow
+                                 (map toUpper (lexemeToString buf2)) in
                  case lookupUFM pragmaKeywordsFM lexeme of
                        Just ITline_prag -> line_prag (lexer cont) buf2 s'
                        Just other -> is_a_token
@@ -524,9 +525,8 @@ lexToken cont glaexts buf =
                (_:ctx') -> cont ITccurly (incLexeme buf) s{context=ctx'}
                _ -> lexError "too many '}'s" buf s
 
-    '#'# | flag glaexts 
-        -> case lookAhead# buf 1# of
-               ')'# -> cont ITcubxparen (setCurrentPos# buf 2#)
+    '#'# -> case lookAhead# buf 1# of
+               ')'#  | flag glaexts -> cont ITcubxparen (setCurrentPos# buf 2#)
                '-'# -> case lookAhead# buf 2# of
                           '}'# -> cont ITclose_prag (setCurrentPos# buf 3#)
                           _    -> lex_sym cont (incLexeme buf)
@@ -604,7 +604,7 @@ flag _  = True
 lex_prag cont buf
   = case expandWhile# is_space buf of { buf1 ->
     case expandWhile# is_ident (stepOverLexeme buf1) of { buf2 -> 
-    let lexeme = lexemeToFastString buf2 in
+    let lexeme = mkFastString (map toUpper (lexemeToString buf2)) in
     case lookupUFM pragmaKeywordsFM lexeme of
        Just kw -> cont kw (mergeLexemes buf buf2)
        Nothing -> panic "lex_prag"
@@ -979,10 +979,9 @@ lex_id3 cont glaexts mod buf just_a_conid
        -- real lexeme is M.<sym>
        new_buf = mergeLexemes buf buf'
      in
-     case lookupUFM haskellKeySymsFM lexeme of {
-       Just kwd_token -> just_a_conid; -- avoid M.:: etc.
-       Nothing        -> cont (mk_qvar_token mod lexeme) new_buf
-     }}
+     cont (mk_qvar_token mod lexeme) new_buf
+       -- wrong, but arguably morally right: M... is now a qvarsym
+     }
 
   | otherwise   =
      let 
@@ -998,15 +997,13 @@ lex_id3 cont glaexts mod buf just_a_conid
      let
       lexeme  = lexemeToFastString buf'
       new_buf = mergeLexemes buf buf'
+      is_a_qvarid = cont (mk_qvar_token mod lexeme) new_buf
      in
      case _scc_ "Lex.haskellKeyword" lookupUFM haskellKeywordsFM lexeme of {
            Just kwd_token -> just_a_conid; -- avoid M.where etc.
-           Nothing        -> 
-     if flag glaexts
-       then case lookupUFM ghcExtensionKeywordsFM lexeme of {
-           Just kwd_token -> just_a_conid;
-           Nothing        -> cont (mk_qvar_token mod lexeme) new_buf }
-       else just_a_conid
+           Nothing        -> is_a_qvarid
+       -- TODO: special ids (as, qualified, hiding) shouldn't be
+       -- recognised as keywords here.  ie.  M.as is a qualified varid.
      }}}