[project @ 2001-01-30 13:39:09 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 6c69738..8fdd6ad 100644 (file)
--- a/ghc/compiler/parser/Lex.lhs
+++ b/ghc/compiler/parser/Lex.lhs
@@ -110,7 +110,7 @@ data Token
   | ITthen
   | ITtype
   | ITwhere
-  | ITscc
+  | ITscc                      -- ToDo: remove (we use {-# SCC "..." #-} now)
 
   | ITforall                   -- GHC extension keywords
   | ITforeign
@@ -164,6 +164,7 @@ data Token
   | ITrules_prag
   | ITdeprecated_prag
   | ITline_prag
+  | ITscc_prag
   | ITclose_prag
 
   | ITdotdot                   -- reserved symbols
@@ -243,6 +244,7 @@ pragmaKeywordsFM = listToUFM $
        ( "LINE",       ITline_prag ),
        ( "RULES",      ITrules_prag ),
        ( "RULEZ",      ITrules_prag ), -- american spelling :-)
+       ( "SCC",        ITscc_prag ),
        ( "DEPRECATED", ITdeprecated_prag )
        ]
 
@@ -273,9 +275,26 @@ haskellKeywordsFM = listToUFM $
        ( "then",       ITthen ),     
        ( "type",       ITtype ),     
        ( "where",      ITwhere ),
-       ( "_scc_",      ITscc )
+       ( "_scc_",      ITscc )         -- ToDo: remove
      ]
 
+isSpecial :: Token -> Bool
+-- If we see M.x, where x is a keyword, but
+-- is special, we treat is as just plain M.x, 
+-- not as a keyword.
+isSpecial ITas         = True
+isSpecial IThiding     = True
+isSpecial ITqualified  = True
+isSpecial ITforall     = True
+isSpecial ITexport     = True
+isSpecial ITlabel      = True
+isSpecial ITdynamic    = True
+isSpecial ITunsafe     = True
+isSpecial ITwith       = True
+isSpecial ITccallconv   = True
+isSpecial ITstdcallconv = True
+isSpecial _             = False
+
 -- IMPORTANT: Keep this in synch with ParseIface.y's var_fs production! (SUP)
 ghcExtensionKeywordsFM = listToUFM $
        map (\ (x,y) -> (_PK_ x,y))
@@ -429,7 +448,11 @@ lexer cont buf s@(PState{
 
                -- special GHC extension: we grok cpp-style #line pragmas
            '#'# | lexemeIndex buf ==# bol ->   -- the '#' must be in column 0
-               line_prag next_line (stepOn buf) s'
+               case expandWhile# is_space (stepOn buf) of { buf1 ->
+               if is_digit (currentChar# buf1) 
+                       then line_prag next_line buf1 s'
+                       else is_a_token
+               }
                where
                next_line buf = lexer cont (stepOnUntilChar# buf '\n'#)
 
@@ -570,7 +593,7 @@ lexToken cont glaexts buf =
                    '#'# -> case lookAhead# buf 3# of
                                '#'# -> 
                                   let (lexeme, buf') 
-                                         = doDiscard False (stepOnBy# (stepOverLexeme buf) 4#) in
+                                         = doDiscard 0# (stepOnBy# (stepOverLexeme buf) 4#) in
                                             cont (ITpragma lexeme) buf'
                                _ -> lex_prag cont (setCurrentPos# buf 3#)
                    _    -> cont ITocurly (incLexeme buf) 
@@ -993,17 +1016,18 @@ lex_id3 cont glaexts mod buf just_a_conid
      case slurp_trailing_hashes buf1 glaexts of { buf' ->
 
      let
-      lexeme  = lexemeToFastString buf'
-      new_buf = mergeLexemes buf buf'
+      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        -> is_a_qvarid
-       -- TODO: special ids (as, qualified, hiding) shouldn't be
-       -- recognised as keywords here.  ie.  M.as is a qualified varid.
-     }}}
+           Nothing          -> is_a_qvarid ;
 
+           Just kwd_token | isSpecial kwd_token   -- special ids (as, qualified, hiding) shouldn't be
+                          -> is_a_qvarid          --  recognised as keywords here.
+                          | otherwise
+                          -> just_a_conid         -- avoid M.where etc.
+     }}}
 
 slurp_trailing_hashes buf glaexts
   | flag glaexts = expandWhile# (`eqChar#` '#'#) buf
@@ -1056,13 +1080,13 @@ lex_ubx_tuple cont mod buf back_off =
 \end{code}
 
 -----------------------------------------------------------------------------
-doDiscard rips along really fast, looking for a '#-}', 
+doDiscard rips along really fast, looking for a '##-}', 
 indicating the end of the pragma we're skipping
 
 \begin{code}
 doDiscard inStr buf =
  case currentChar# buf of
-   '#'# | not inStr ->
+   '#'# | inStr ==# 0# ->
        case lookAhead# buf 1# of { '#'# -> 
        case lookAhead# buf 2# of { '-'# ->
        case lookAhead# buf 3# of { '}'# -> 
@@ -1070,24 +1094,32 @@ doDiscard inStr buf =
        _    -> doDiscard inStr (incLexeme buf) };
         _    -> doDiscard inStr (incLexeme buf) };
         _    -> doDiscard inStr (incLexeme buf) }
+
    '"'# ->
        let
         odd_slashes buf flg i# =
           case lookAhead# buf i# of
           '\\'# -> odd_slashes buf (not flg) (i# -# 1#)
           _     -> flg
+
+       not_inStr = if inStr ==# 0# then 1# else 0#
        in
        case lookAhead# buf (negateInt# 1#) of --backwards, actually
         '\\'# -> -- escaping something..
-          if odd_slashes buf True (negateInt# 2#) then
-              -- odd number of slashes, " is escaped.
-             doDiscard inStr (incLexeme buf)
-          else
-              -- even number of slashes, \ is escaped.
-             doDiscard (not inStr) (incLexeme buf)
-         _ -> case inStr of -- forced to avoid build-up
-              True  -> doDiscard False (incLexeme buf)
-               False -> doDiscard True  (incLexeme buf)
+          if odd_slashes buf True (negateInt# 2#) 
+               then  -- odd number of slashes, " is escaped.
+                     doDiscard inStr (incLexeme buf)
+               else  -- even number of slashes, \ is escaped.
+                     doDiscard not_inStr (incLexeme buf)
+         _ -> doDiscard not_inStr (incLexeme buf)
+
+   '\''# | inStr ==# 0# ->
+       case lookAhead# buf 1# of { '"'# ->
+       case lookAhead# buf 2# of { '\''# ->
+          doDiscard inStr (setCurrentPos# buf 3#);
+       _ -> doDiscard inStr (incLexeme buf) };
+       _ -> doDiscard inStr (incLexeme buf) }
+
    _ -> doDiscard inStr (incLexeme buf)
 
 \end{code}