[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 c5c6173..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.111 2002/10/23 14:30:01 simonpj Exp $
+$Id: Parser.y,v 1.119 2003/06/23 10:35:22 simonpj Exp $
 
 Haskell grammar.
 
@@ -17,17 +17,18 @@ import HsSyn
 import HsTypes         ( mkHsTupCon )
 
 import RdrHsSyn
-import HscTypes                ( ParsedIface(..), IsBootInterface )
+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 }
@@ -295,6 +296,7 @@ iface   :: { ParsedIface }
                        pi_vers    = 1,                 -- Module version
                        pi_orphan  = False,
                        pi_exports = (1,[($2,mkIfaceExports $4)]),
+                       pi_deps    = noDependencies,
                        pi_usages  = [],
                        pi_fixity  = [],
                        pi_insts   = [],
@@ -440,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.
@@ -956,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 }
 
@@ -1020,8 +1024,11 @@ aexp2    :: { RdrNameHsExpr }
        | srcloc '[t|' ctype '|]'       { HsBracket (TypBr $3) $1 }                       
        | srcloc '[p|' infixexp '|]'    {% checkPattern $1 $3 `thenP` \p ->
                                           returnP (HsBracket (PatBr p) $1) }
-       | srcloc '[d|' cvtopdecls '|]'  { HsBracket (DecBr (mkGroup $3)) $1 }
+       | srcloc '[d|' cvtopbody '|]'   { HsBracket (DecBr (mkGroup $3)) $1 }
 
+cvtopbody :: { [RdrNameHsDecl] }
+       :  '{'            cvtopdecls '}'                { $2 }
+       |      layout_on  cvtopdecls close              { $2 }
 
 texps :: { [RdrNameHsExpr] }
        : texps ',' exp                 { $3 : $1 }
@@ -1205,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 }
@@ -1390,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
 
 
 -----------------------------------------------------------------------------