[project @ 2000-02-15 22:18:16 by panne]

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

diff --git a/ghc/compiler/parser/Lex.lhs b/ghc/compiler/parser/Lex.lhs
index ba2ed1f..13ace2b 100644 (file)
--- a/ghc/compiler/parser/Lex.lhs
+++ b/ghc/compiler/parser/Lex.lhs
@@ -128,6 +128,7 @@ data Token
   | ITlabel
   | ITdynamic
   | ITunsafe
+  | ITwith
   | ITstdcallconv
   | ITccallconv
 
@@ -157,6 +158,7 @@ data Token
   | ITunfold InlinePragInfo
   | ITstrict ([Demand], Bool)
   | ITrules
+  | ITdeprecated
   | ITcprinfo (CprInfo)
   | IT__scc
   | ITsccAllCafs
@@ -166,6 +168,7 @@ data Token
   | ITinline_prag
   | ITnoinline_prag
   | ITrules_prag
+  | ITdeprecated_prag
   | ITline_prag
   | ITclose_prag
 
@@ -208,6 +211,8 @@ data Token
   | ITqvarsym (FAST_STRING,FAST_STRING)
   | ITqconsym (FAST_STRING,FAST_STRING)
 
+  | ITipvarid FAST_STRING      -- GHC extension: implicit param: ?x
+
   | ITpragma StringBuffer
 
   | ITchar       Char 
@@ -241,7 +246,8 @@ pragmaKeywordsFM = listToUFM $
        ( "NOTINLINE",  ITnoinline_prag ),
        ( "LINE",       ITline_prag ),
        ( "RULES",      ITrules_prag ),
-       ( "RULEZ",      ITrules_prag )  -- american spelling :-)
+       ( "RULEZ",      ITrules_prag ), -- american spelling :-)
+       ( "DEPRECATED", ITdeprecated_prag )
        ]
 
 haskellKeywordsFM = listToUFM $
@@ -282,6 +288,7 @@ ghcExtensionKeywordsFM = listToUFM $
        ( "label",      ITlabel ),
        ( "dynamic",    ITdynamic ),
        ( "unsafe",     ITunsafe ),
+       ( "with",       ITwith ),
        ( "stdcall",    ITstdcallconv),
        ( "ccall",      ITccallconv),
         ("_ccall_",    ITccall (False, False, False)),
@@ -314,6 +321,7 @@ ghcExtensionKeywordsFM = listToUFM $
        ("__P",                 ITspecialise),
        ("__C",                 ITnocaf),
        ("__R",                 ITrules),
+        ("__D",                        ITdeprecated),
         ("__U",                        ITunfold NoInlinePragInfo),
        
         ("__ccall",            ITccall (False, False, False)),
@@ -369,7 +377,8 @@ lexer cont buf s@(PState{
                })
 
        -- first, start a new lexeme and lose all the whitespace
-  = tab line bol atbol (stepOverLexeme buf)
+  =  _scc_ "Lexer" 
+  tab line bol atbol (stepOverLexeme buf)
   where
        line = srcLocLine loc
 
@@ -509,7 +518,6 @@ lexBOL cont buf s@(PState{
 lexToken :: (Token -> P a) -> Int# -> P a
 lexToken cont glaexts buf =
  --trace "lexToken" $
- _scc_ "Lexer" 
   case currentChar# buf of
 
     -- special symbols ----------------------------------------------------
@@ -590,6 +598,8 @@ lexToken cont glaexts buf =
               trace "lexIface: misplaced NUL?" $ 
               cont (ITunknown "\NUL") (stepOn buf)
 
+    '?'# | flag glaexts && is_lower (lookAhead# buf 1#) ->
+           lex_ip cont (stepOn buf)
     c | is_digit  c -> lex_num cont glaexts 0 buf
       | is_symbol c -> lex_sym cont buf
       | is_upper  c -> lex_con cont glaexts buf
@@ -864,9 +874,10 @@ after_lexnum cont glaexts i buf
 
 lex_cstring cont buf =
  case expandUntilMatch (stepOverLexeme buf) "\'\'" of
-   buf' -> cont (ITlitlit (lexemeToFastString 
+   Just buf' -> cont (ITlitlit (lexemeToFastString 
                                (setCurrentPos# buf' (negateInt# 2#))))
-               (mergeLexemes buf buf')
+                  (mergeLexemes buf buf')
+   Nothing   -> lexError "unterminated ``" buf
 
 ------------------------------------------------------------------------------
 -- Character Classes
@@ -891,12 +902,18 @@ is_ident  = is_ctype 1
 is_symbol = is_ctype 2
 is_any    = is_ctype 4
 is_space  = is_ctype 8
-is_upper  = is_ctype 16
-is_digit  = is_ctype 32
+is_lower  = is_ctype 16
+is_upper  = is_ctype 32
+is_digit  = is_ctype 64
 
 -----------------------------------------------------------------------------
 -- identifiers, symbols etc.
 
+lex_ip cont buf =
+ case expandWhile# is_ident buf of
+   buf' -> cont (ITipvarid lexeme) buf'
+          where lexeme = lexemeToFastString buf'
+
 lex_id cont glaexts buf =
  case expandWhile# is_ident buf of { buf1 ->