[project @ 2000-12-15 15:58:51 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 d182ce1..def163d 100644 (file)
--- a/ghc/compiler/parser/Lex.lhs
+++ b/ghc/compiler/parser/Lex.lhs
@@ -52,7 +52,7 @@ import FastString
 import StringBuffer
 import GlaExts
 import Ctype
-import Char            ( chr, ord )
+import Char            ( ord )
 import PrelRead        ( readRational__ ) -- Glasgow non-std
 \end{code}
 
@@ -123,6 +123,7 @@ data Token
   | ITccallconv
 
   | ITinterface                        -- interface keywords
+  | ITexpr
   | IT__export
   | ITdepends
   | IT__forall
@@ -276,6 +277,23 @@ haskellKeywordsFM = listToUFM $
        ( "_scc_",      ITscc )
      ]
 
+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))
@@ -295,6 +313,7 @@ ghcExtensionKeywordsFM = listToUFM $
 
        -- interface keywords
         ("__interface",                ITinterface),
+        ("__expr",             ITexpr),
        ("__export",            IT__export),
        ("__depends",           ITdepends),
        ("__forall",            IT__forall),
@@ -570,7 +589,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 +1012,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 +1076,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 +1090,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}