[project @ 2003-06-23 10:35:15 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 907c929..11dc6dc 100644 (file)
--- a/ghc/compiler/parser/Parser.y
+++ b/ghc/compiler/parser/Parser.y
@@ -1,6 +1,6 @@
 {-                                                             -*-haskell-*-
 -----------------------------------------------------------------------------
-$Id: Parser.y,v 1.114 2002/12/10 16:28:48 igloo Exp $
+$Id: Parser.y,v 1.119 2003/06/23 10:35:22 simonpj Exp $
 
 Haskell grammar.
 
@@ -21,13 +21,14 @@ import HscTypes             ( ParsedIface(..), IsBootInterface, noDependencies )
 import Lex
 import RdrName
 import PrelNames       ( mAIN_Name, funTyConName, listTyConName, 
-                         parrTyConName, consDataConName, nilDataConName )
-import TysWiredIn      ( unitTyCon, unitDataCon, tupleTyCon, tupleCon )
+                         parrTyConName, consDataConName )
+import TysWiredIn      ( unitTyCon, unitDataCon, tupleTyCon, tupleCon, nilDataCon )
 import ForeignCall     ( Safety(..), CExportSpec(..), 
                          CCallConv(..), CCallTarget(..), defaultCCallConv,
                        )
 import OccName         ( UserFS, varName, tcName, dataName, tcClsName, tvName )
 import TyCon           ( DataConDetails(..) )
+import DataCon         ( DataCon, dataConName )
 import SrcLoc          ( SrcLoc )
 import Module
 import CmdLineOpts     ( opt_SccProfilingOn, opt_InPackage )
@@ -139,6 +140,7 @@ Conflicts: 29 shift/reduce, [SDM 19/9/2002]
  '{-# INLINE'      { ITinline_prag }
  '{-# NOINLINE'    { ITnoinline_prag }
  '{-# RULES'      { ITrules_prag }
+ '{-# CORE'        { ITcore_prag }              -- hdaume: annotated core
  '{-# SCC'        { ITscc_prag }
  '{-# DEPRECATED'  { ITdeprecated_prag }
  '#-}'            { ITclose_prag }
@@ -263,10 +265,9 @@ REIFY_FIXITY       { ITreifyFixity }
 
 module         :: { RdrNameHsModule }
        : srcloc 'module' modid maybemoddeprec maybeexports 'where' body 
-               { HsModule (mkHomeModule $3) Nothing $5 (fst $7) (snd $7) $4 $1 }
+               { HsModule (Just (mkHomeModule $3)) $5 (fst $7) (snd $7) $4 $1 }
        | srcloc body
-               { HsModule (mkHomeModule mAIN_Name) Nothing Nothing 
-                          (fst $2) (snd $2) Nothing $1 }
+               { HsModule Nothing Nothing (fst $2) (snd $2) Nothing $1 }
 
 maybemoddeprec :: { Maybe DeprecTxt }
        : '{-# DEPRECATED' STRING '#-}'         { Just $2 }
@@ -441,7 +442,7 @@ tycl_decl :: { RdrNameTyClDecl }
                { let 
                        (binds,sigs) = cvMonoBindsAndSigs $5 
                  in
-                 mkClassDecl $3 $4 (map cvClassOpSig sigs) (Just binds) $1 }
+                 mkClassDecl $3 $4 sigs (Just binds) $1 }
 
 syn_hdr :: { (RdrName, [RdrNameHsTyVar]) }     -- We don't retain the syntax of an infix
                                                -- type synonym declaration. Oh well.
@@ -957,6 +958,8 @@ exp10 :: { RdrNameHsExpr }
                                                        then HsSCC $1 $2
                                                        else HsPar $2 }
 
+        | '{-# CORE' STRING '#-}' exp           { HsCoreAnn $2 $4 }    -- hdaume: core annotation
+
        | reifyexp                              { HsReify $1 }
        | fexp                                  { $1 }
 
@@ -1209,14 +1212,14 @@ deprec_var : var                        { $1 }
           | tycon                      { $1 }
 
 gcon   :: { RdrName }  -- Data constructor namespace
-       : sysdcon               { $1 }
+       : sysdcon               { nameRdrName (dataConName $1) }
        | qcon                  { $1 }
 -- the case of '[:' ':]' is part of the production `parr'
 
-sysdcon        :: { RdrName }  -- Data constructor namespace
-       : '(' ')'               { getRdrName unitDataCon }
-       | '(' commas ')'        { getRdrName (tupleCon Boxed $2) }
-       | '[' ']'               { nameRdrName nilDataConName }
+sysdcon        :: { DataCon }  -- Wired in data constructors
+       : '(' ')'               { unitDataCon }
+       | '(' commas ')'        { tupleCon Boxed $2 }
+       | '[' ']'               { nilDataCon }
 
 var    :: { RdrName }
        : varid                 { $1 }
@@ -1394,8 +1397,10 @@ qconsym :: { RdrName }   -- Qualified or unqualified
 
 consym :: { RdrName }
        : CONSYM                { mkUnqual dataName $1 }
-       | ':'                   { nameRdrName consDataConName }
+
        -- ':' means only list cons
+       | ':'                   { nameRdrName consDataConName }
+                               -- NB: SrcName because we are reading source
 
 
 -----------------------------------------------------------------------------