[project @ 1999-08-02 09:47:18 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 18a2549..e1de35a 100644 (file)
--- a/ghc/compiler/parser/Lex.lhs
+++ b/ghc/compiler/parser/Lex.lhs
@@ -147,8 +147,8 @@ data Token
   | ITlit_lit
   | ITstring_lit
   | ITtypeapp
-  | ITonce
-  | ITmany
+  | ITusage
+  | ITfuall
   | ITarity 
   | ITspecialise
   | ITnocaf
@@ -272,7 +272,6 @@ haskellKeywordsFM = listToUFM $
        ( "_scc_",      ITscc )
      ]
 
-
 ghcExtensionKeywordsFM = listToUFM $
        map (\ (x,y) -> (_PK_ x,y))
      [ ( "forall",     ITforall ),
@@ -305,13 +304,13 @@ ghcExtensionKeywordsFM = listToUFM $
        ("__litlit",            ITlit_lit),
        ("__string",            ITstring_lit),
        ("__a",                 ITtypeapp),
-       ("__o",                 ITonce),
-       ("__m",                 ITmany),
+       ("__u",                 ITusage),
+       ("__fuall",             ITfuall),
        ("__A",                 ITarity),
        ("__P",                 ITspecialise),
        ("__C",                 ITnocaf),
        ("__R",                 ITrules),
-        ("__u",                        ITunfold NoInlinePragInfo),
+        ("__U",                        ITunfold NoInlinePragInfo),
        
         ("__ccall",            ITccall (False, False, False)),
         ("__ccall_GC",         ITccall (False, False, True)),
@@ -524,11 +523,10 @@ lexToken cont glaexts buf =
     '}'# -> \ s@PState{context = ctx} ->
            case ctx of 
                (_:ctx') -> cont ITccurly (incLexeme buf) s{context=ctx'}
-               _ -> lexError "too many '}'s" buf s
+               _        -> 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)
@@ -606,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"
@@ -705,8 +703,8 @@ readNum cont buf is_digit base conv = read buf 0
 
 is_hexdigit c 
        =  is_digit c 
-       || (c `geChar#` 'a'# && c `leChar#` 'h'#)
-       || (c `geChar#` 'A'# && c `leChar#` 'H'#)
+       || (c `geChar#` 'a'# && c `leChar#` 'f'#)
+       || (c `geChar#` 'A'# && c `leChar#` 'F'#)
 
 hex c | is_digit c = ord# c -# ord# '0'#
       | otherwise  = ord# (to_lower c) -# ord# 'a'# +# 10#
@@ -981,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 
@@ -1000,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.
      }}}
 
 
@@ -1203,13 +1198,25 @@ h = h
        - we still need to insert another '}' followed by a ';',
          hence the atbol trick.
 
+There's also a special hack in here to deal with
+
+       do
+          ....
+          e $ do
+          blah
+
+i.e. the inner context is at the same indentation level as the outer
+context.  This is strictly illegal according to Haskell 98, but
+there's a lot of existing code using this style and it doesn't make
+any sense to disallow it, since empty 'do' lists don't make sense.
 -}
 
-layoutOn :: P ()
-layoutOn buf s@(PState{ bol = bol, context = ctx }) =
+layoutOn :: Bool -> P ()
+layoutOn strict buf s@(PState{ bol = bol, context = ctx }) =
     let offset = lexemeIndex buf -# bol in
     case ctx of
-       Layout prev_off : _ | prev_off >=# offset ->
+       Layout prev_off : _ 
+          | if strict then prev_off >=# offset else prev_off ># offset ->
                --trace ("layout on, column: " ++  show (I# offset)) $
                POk s{ context = Layout (offset +# 1#) : ctx, atbol = 1# } ()
        other ->