[project @ 1999-06-02 15:50:25 by simonmar]

- parse _scc_ expressions
- give a proper error on illegal characters in the lexer.

diff --git a/ghc/compiler/parser/Lex.lhs b/ghc/compiler/parser/Lex.lhs
index b484bcc..f10d653 100644 (file)
--- a/ghc/compiler/parser/Lex.lhs
+++ b/ghc/compiler/parser/Lex.lhs
@@ -120,6 +120,7 @@ data Token
   | ITthen
   | ITtype
   | ITwhere
+  | ITscc
 
   | ITforall                   -- GHC extension keywords
   | ITforeign
@@ -155,7 +156,7 @@ data Token
   | ITstrict ([Demand], Bool)
   | ITrules
   | ITcprinfo (CprInfo)
-  | ITscc
+  | IT__scc
   | ITsccAllCafs
 
   | ITspecialise_prag          -- Pragmas
@@ -266,7 +267,8 @@ haskellKeywordsFM = listToUFM $
        ( "qualified",  ITqualified ),
        ( "then",       ITthen ),     
        ( "type",       ITtype ),     
-       ( "where",      ITwhere )
+       ( "where",      ITwhere ),
+       ( "_scc_",      ITscc )
      ]
 
 
@@ -588,6 +590,7 @@ lexToken cont glaexts buf =
       | is_symbol c -> lex_sym cont buf
       | is_upper  c -> lex_con cont glaexts buf
       | is_ident  c -> lex_id  cont glaexts buf
+      | otherwise   -> lexError "illegal character" buf
 
 -- Int# is unlifted, and therefore faster than Bool for flags.
 {-# INLINE flag #-}

diff --git a/ghc/compiler/parser/Parser.y b/ghc/compiler/parser/Parser.y
index 23f50d2..2e7eac9 100644 (file)
--- a/ghc/compiler/parser/Parser.y
+++ b/ghc/compiler/parser/Parser.y
@@ -1,6 +1,6 @@
 {-
 -----------------------------------------------------------------------------
-$Id: Parser.y,v 1.2 1999/06/02 14:42:43 simonmar Exp $
+$Id: Parser.y,v 1.3 1999/06/02 15:50:25 simonmar Exp $
 
 Haskell grammar.
 
@@ -23,6 +23,7 @@ import OccName                ( varName, dataName, tcClsName, tvName )
 import SrcLoc          ( SrcLoc )
 import Module
 import CallConv
+import CmdLineOpts     ( opt_SccProfilingOn )
 import BasicTypes      ( Fixity(..), FixityDirection(..), NewOrData(..) )
 import Panic
 
@@ -80,6 +81,7 @@ Conflicts: 13 shift/reduce
  'then'        { ITthen }
  'type'        { ITtype }
  'where'       { ITwhere }
+ '_scc_'       { ITscc }
 
  'forall'      { ITforall }                    -- GHC extension keywords
  'foreign'     { ITforeign }
@@ -117,7 +119,7 @@ Conflicts: 13 shift/reduce
  '__litlit'    { ITlit_lit }
  '__string'    { ITstring_lit }
  '__ccall'     { ITccall $$ }
- '__scc'       { ITscc }
+ '__scc'       { IT__scc }
  '__sccC'       { ITsccAllCafs }
 
  '__A'         { ITarity }
@@ -625,6 +627,10 @@ exp10 :: { RdrNameHsExpr }
        | '_casm_'     CLITLIT aexps0           { CCall $2 $3 False True  cbot }
        | '_casm_GC_'  CLITLIT aexps0           { CCall $2 $3 True  True  cbot }
 
+        | '_scc_' STRING exp                   { if opt_SccProfilingOn
+                                                       then HsSCC $2 $3
+                                                       else $3 }
+
        | fexp                                  { $1 }
 
 ccallid :: { FAST_STRING }