[project @ 2001-02-20 15:36:55 by simonpj]

[ghc-hetmet.git] / ghc / compiler / parser / Parser.y

diff --git a/ghc/compiler/parser/Parser.y b/ghc/compiler/parser/Parser.y
index dbc68a2..52d81e7 100644 (file)
--- 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)
 }