X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fparser%2FParser.y;h=52d81e76d09aba4bd8e5c14978ad5b350979779e;hb=db7041f72b7c7d0114e47b7305058fae48fb0ade;hp=dbc68a2a1776286a9a8faf8245ac2da90b545958;hpb=83eef621e4a4fbb6c1343304ec638cafd6c9dc09;p=ghc-hetmet.git

diff --git a/ghc/compiler/parser/Parser.y b/ghc/compiler/parser/Parser.y
index dbc68a2..52d81e7 100644
--- a/ghc/compiler/parser/Parser.y
+++ b/ghc/compiler/parser/Parser.y
@@ -1,6 +1,6 @@
 {-
 -----------------------------------------------------------------------------
-$Id: Parser.y,v 1.49 2000/11/24 17:02:03 simonpj Exp $
+$Id: Parser.y,v 1.54 2001/02/20 15:36:55 simonpj Exp $
 
 Haskell grammar.
 
@@ -9,18 +9,19 @@ Author(s): Simon Marlow, Sven Panne 1997, 1998, 1999
 -}
 
 {
-module Parser ( ParseStuff(..), parse ) where
+module Parser ( parseModule, parseExpr ) where
 
 import HsSyn
 import HsTypes		( mkHsTupCon )
-import HsPat            ( InPat(..) )
 
 import RdrHsSyn
 import Lex
 import ParseUtil
 import RdrName
-import PrelNames
-import OccName		( UserFS, varName, ipName, tcName, dataName, tcClsName, tvName )
+import PrelNames	( mAIN_Name, unitTyCon_RDR, funTyCon_RDR, listTyCon_RDR,
+			  tupleTyCon_RDR, unitCon_RDR, nilCon_RDR, tupleCon_RDR
+			)
+import OccName		( UserFS, varName, tcName, dataName, tcClsName, tvName )
 import SrcLoc		( SrcLoc )
 import Module
 import CallConv
@@ -89,7 +90,7 @@ Conflicts: 14 shift/reduce
  'then' 	{ ITthen }
  'type' 	{ ITtype }
  'where' 	{ ITwhere }
- '_scc_'	{ ITscc }
+ '_scc_'	{ ITscc }	      -- ToDo: remove
 
  'forall'	{ ITforall }			-- GHC extension keywords
  'foreign'	{ ITforeign }
@@ -110,11 +111,10 @@ Conflicts: 14 shift/reduce
  '{-# INLINE'      { ITinline_prag }
  '{-# NOINLINE'    { ITnoinline_prag }
  '{-# RULES'	   { ITrules_prag }
+ '{-# SCC'	   { ITscc_prag }
  '{-# DEPRECATED'  { ITdeprecated_prag }
  '#-}'		   { ITclose_prag }
 
- '__expr'	{ ITexpr }
-
 {-
  '__interface'	{ ITinterface }			-- interface keywords
  '__export'	{ IT__export }
@@ -199,18 +199,12 @@ Conflicts: 14 shift/reduce
 
 %monad { P } { thenP } { returnP }
 %lexer { lexer } { ITeof }
-%name parse
+%name parseModule module
+%name parseExpr   exp
 %tokentype { Token }
 %%
 
 -----------------------------------------------------------------------------
--- Entry points
-
-parse   :: { ParseStuff }
-	:  module				{ PModule $1 }
-	|  '__expr' exp				{ PExpr   $2 }
-
------------------------------------------------------------------------------
 -- Module Header
 
 -- The place for module deprecation is really too restrictive, but if it
@@ -543,7 +537,7 @@ inst_type :: { RdrNameHsType }
 	: ctype				{% checkInstType $1 }
 
 types0  :: { [RdrNameHsType] }
-	: types				{ $1 }
+	: types				{ reverse $1 }
 	| {- empty -}			{ [] }
 
 types	:: { [RdrNameHsType] }
@@ -706,12 +700,16 @@ exp10 :: { RdrNameHsExpr }
 	| '_casm_'     CLITLIT aexps0		{ HsCCall $2 $3 False True  cbot }
 	| '_casm_GC_'  CLITLIT aexps0		{ HsCCall $2 $3 True  True  cbot }
 
-        | '_scc_' STRING exp    		{ if opt_SccProfilingOn
-							then HsSCC $2 $3
-							else HsPar $3 }
+        | scc_annot exp		    		{ if opt_SccProfilingOn
+							then HsSCC $1 $2
+							else HsPar $2 }
 
 	| fexp					{ $1 }
 
+scc_annot :: { FAST_STRING }
+	: '_scc_' STRING			{ $2 }
+	| '{-# SCC' STRING '#-}'		{ $2 }
+
 ccallid :: { FAST_STRING }
 	:  VARID				{ $1 }
 	|  CONID				{ $1 }
@@ -741,8 +739,8 @@ aexp1	:: { RdrNameHsExpr }
 	: ipvar				{ HsIPVar $1 }
 	| var_or_con			{ $1 }
 	| literal			{ HsLit $1 }
-	| INTEGER			{ HsOverLit (HsIntegral   $1 fromInteger_RDR) }
-	| RATIONAL			{ HsOverLit (HsFractional $1 fromRational_RDR) }
+	| INTEGER			{ HsOverLit (HsIntegral   $1) }
+	| RATIONAL			{ HsOverLit (HsFractional $1) }
 	| '(' exp ')'			{ HsPar $2 }
 	| '(' exp ',' texps ')'		{ ExplicitTuple ($2 : reverse $4) Boxed}
 	| '(#' texps '#)'		{ ExplicitTuple (reverse $2)      Unboxed }
@@ -926,7 +924,7 @@ qvar 	:: { RdrName }
 -- *after* we see the close paren.
 
 ipvar	:: { RdrName }
-	: IPVARID		{ (mkUnqual ipName (tailFS $1)) }
+	: IPVARID		{ (mkUnqual varName (tailFS $1)) }
 
 qcon	:: { RdrName }
 	: qconid		{ $1 }
@@ -1105,8 +1103,6 @@ commas :: { Int }
 -----------------------------------------------------------------------------
 
 {
-data ParseStuff = PModule RdrNameHsModule | PExpr RdrNameHsExpr
-
 happyError :: P a
 happyError buf PState{ loc = loc } = PFailed (srcParseErr buf loc)
 }