- parse _scc_ expressions
- give a proper error on illegal characters in the lexer.
| ITthen
| ITtype
| ITwhere
| ITthen
| ITtype
| ITwhere
| ITforall -- GHC extension keywords
| ITforeign
| ITforall -- GHC extension keywords
| ITforeign
| ITstrict ([Demand], Bool)
| ITrules
| ITcprinfo (CprInfo)
| ITstrict ([Demand], Bool)
| ITrules
| ITcprinfo (CprInfo)
| ITsccAllCafs
| ITspecialise_prag -- Pragmas
| ITsccAllCafs
| ITspecialise_prag -- Pragmas
( "qualified", ITqualified ),
( "then", ITthen ),
( "type", ITtype ),
( "qualified", ITqualified ),
( "then", ITthen ),
( "type", ITtype ),
+ ( "where", ITwhere ),
+ ( "_scc_", ITscc )
| is_symbol c -> lex_sym cont buf
| is_upper c -> lex_con cont glaexts buf
| is_ident c -> lex_id 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 #-}
-- Int# is unlifted, and therefore faster than Bool for flags.
{-# INLINE flag #-}
{-
-----------------------------------------------------------------------------
{-
-----------------------------------------------------------------------------
-$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 $
import SrcLoc ( SrcLoc )
import Module
import CallConv
import SrcLoc ( SrcLoc )
import Module
import CallConv
+import CmdLineOpts ( opt_SccProfilingOn )
import BasicTypes ( Fixity(..), FixityDirection(..), NewOrData(..) )
import Panic
import BasicTypes ( Fixity(..), FixityDirection(..), NewOrData(..) )
import Panic
'then' { ITthen }
'type' { ITtype }
'where' { ITwhere }
'then' { ITthen }
'type' { ITtype }
'where' { ITwhere }
'forall' { ITforall } -- GHC extension keywords
'foreign' { ITforeign }
'forall' { ITforall } -- GHC extension keywords
'foreign' { ITforeign }
'__litlit' { ITlit_lit }
'__string' { ITstring_lit }
'__ccall' { ITccall $$ }
'__litlit' { ITlit_lit }
'__string' { ITstring_lit }
'__ccall' { ITccall $$ }
'__sccC' { ITsccAllCafs }
'__A' { ITarity }
'__sccC' { ITsccAllCafs }
'__A' { ITarity }
| '_casm_' CLITLIT aexps0 { CCall $2 $3 False True cbot }
| '_casm_GC_' CLITLIT aexps0 { CCall $2 $3 True True cbot }
| '_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 }
| fexp { $1 }
ccallid :: { FAST_STRING }