From 62b87d583573a8d42b51159bf931bdcbe5078b22 Mon Sep 17 00:00:00 2001
From: simonmar <unknown>
Date: Wed, 2 Jun 1999 15:50:25 +0000
Subject: [PATCH] [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 | 7 +++++--
ghc/compiler/parser/Parser.y | 10 ++++++++--
2 files changed, 13 insertions(+), 4 deletions(-)
diff --git a/ghc/compiler/parser/Lex.lhs b/ghc/compiler/parser/Lex.lhs
index b484bcc38992..f10d653834d3 100644
--- 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 23f50d236734..2e7eac9766a2 100644
--- 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 }
--
GitLab