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

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

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 #-}

ghc/compiler/parser/Parser.y

 {-
 -----------------------------------------------------------------------------
-$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 }