[project @ 1999-01-18 19:04:55 by sof]

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

diff --git a/ghc/compiler/reader/Lex.lhs b/ghc/compiler/reader/Lex.lhs
index 116f6bd..11d5774 100644 (file)
--- a/ghc/compiler/reader/Lex.lhs
+++ b/ghc/compiler/reader/Lex.lhs
@@ -47,7 +47,7 @@ import BasicTypes     ( NewOrData(..), IfaceFlavour(..) )
 import SrcLoc          ( SrcLoc, incSrcLine, srcLocFile )
 
 import Maybes          ( MaybeErr(..) )
-import ErrUtils                ( ErrMsg )
+import ErrUtils                ( Message )
 import Outputable
 
 import FastString
@@ -127,7 +127,7 @@ data IfaceToken
   | ITletrec 
   | ITcoerce
   | ITinline
-  | ITccall (Bool,Bool)        -- (is_casm, may_gc)
+  | ITccall (Bool,Bool,Bool)   -- (is_dyn, is_casm, may_gc)
   | ITdefaultbranch
   | ITbottom
   | ITinteger_lit 
@@ -217,7 +217,7 @@ lexIface cont buf =
 -- Numbers and comments
     '-'#  ->
       case lookAhead# buf 1# of
-        '-'# -> lex_comment cont (stepOnBy# buf 2#)
+--        '-'# -> lex_comment cont (stepOnBy# buf 2#)
         c    -> 
          if is_digit c
           then lex_num cont (negate) (ord# c -# ord# '0'#) (incLexeme (incLexeme buf))
@@ -486,7 +486,10 @@ lex_id cont buf =
 
 lex_sym cont buf =
  case expandWhile# is_symbol buf of
-   buf' -> case lookupUFM haskellKeySymsFM lexeme of {
+   buf'
+     | is_comment lexeme -> lex_comment cont new_buf
+     | otherwise         ->
+          case lookupUFM haskellKeySymsFM lexeme of {
                Just kwd_token -> --trace ("keysym: "++unpackFS lexeme) $
                                  cont kwd_token new_buf ;
                Nothing        -> --trace ("sym: "++unpackFS lexeme) $
@@ -495,6 +498,15 @@ lex_sym cont buf =
        where lexeme = lexemeToFastString buf'
              new_buf = stepOverLexeme buf'
 
+             is_comment fs 
+               | len < 2   = False
+               | otherwise = trundle 0
+                 where
+                  len = lengthFS fs
+                  
+                  trundle n | n == len  = True
+                            | otherwise = indexFS fs n == '-' && trundle (n+1)
+
 lex_con cont buf = 
  case expandWhile# is_ident buf of       { buf1 ->
  case expandWhile# (eqChar# '#'#) buf1 of { buf' ->
@@ -644,10 +656,13 @@ ifaceKeywordsFM = listToUFM $
         ("__Unot",             ITunfold IMustNotBeINLINEd),
         ("__Ux",               ITunfold IAmALoopBreaker),
        
-        ("__ccall",            ITccall (False, False)),
-        ("__ccall_GC",         ITccall (False, True)),
-        ("__casm",             ITccall (True,  False)),
-        ("__casm_GC",          ITccall (True,  True)),
+        ("__ccall",            ITccall (False, False, False)),
+        ("__dyn_ccall",                ITccall (True,  False, False)),
+        ("__dyn_ccall_GC",     ITccall (True,  False, True)),
+        ("__casm",             ITccall (False, True,  False)),
+        ("__dyn_casm",         ITccall (True,  True,  False)),
+        ("__casm_GC",          ITccall (False, True,  True)),
+        ("__dyn_casm_GC",      ITccall (True,  True,  True)),
 
         ("/\\",                        ITbiglam)
        ]
@@ -743,7 +758,7 @@ doDiscard inStr buf =
 \begin{code}
 type IfM a = StringBuffer      -- Input string
          -> SrcLoc
-         -> MaybeErr a ErrMsg
+         -> MaybeErr a {-error-}Message
 
 returnIf   :: a -> IfM a
 returnIf a s l = Succeeded a
@@ -786,7 +801,7 @@ checkVersion mb@Nothing  s l
 
 -----------------------------------------------------------------
 
-ifaceParseErr :: StringBuffer -> SrcLoc -> ErrMsg
+ifaceParseErr :: StringBuffer -> SrcLoc -> Message
 ifaceParseErr s l
   = hsep [ppr l, ptext SLIT("Interface-file parse error;"),
           ptext SLIT("current input ="), text first_bit]