[project @ 1999-06-30 11:29:53 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 43e35b5..efcda1b 100644 (file)
--- a/ghc/compiler/parser/Lex.lhs
+++ b/ghc/compiler/parser/Lex.lhs
@@ -272,7 +272,6 @@ haskellKeywordsFM = listToUFM $
        ( "_scc_",      ITscc )
      ]
 
-
 ghcExtensionKeywordsFM = listToUFM $
        map (\ (x,y) -> (_PK_ x,y))
      [ ( "forall",     ITforall ),
@@ -526,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)
@@ -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"
@@ -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 
@@ -1004,12 +1001,9 @@ lex_id3 cont glaexts mod buf just_a_conid
      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        -> is_a_qvarid }
-       else is_a_qvarid
+           Nothing        -> is_a_qvarid
+       -- TODO: special ids (as, qualified, hiding) shouldn't be
+       -- recognised as keywords here.  ie.  M.as is a qualified varid.
      }}}
 
 
@@ -1204,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 ->