[project @ 2003-11-27 13:26:38 by simonmar]

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

diff --git a/ghc/compiler/parser/Parser.y b/ghc/compiler/parser/Parser.y
index 925be4e..965863a 100644 (file)
--- a/ghc/compiler/parser/Parser.y
+++ b/ghc/compiler/parser/Parser.y
@@ -1,6 +1,6 @@
 {-                                                             -*-haskell-*-
 -----------------------------------------------------------------------------
-$Id: Parser.y,v 1.126 2003/10/09 11:59:02 simonpj Exp $
+$Id: Parser.y,v 1.131 2003/11/27 13:26:39 simonmar Exp $
 
 Haskell grammar.
 
@@ -137,6 +137,7 @@ Conflicts: 29 shift/reduce, [SDM 19/9/2002]
  '{-# CORE'        { T _ _ ITcore_prag }              -- hdaume: annotated core
  '{-# SCC'        { T _ _ ITscc_prag }
  '{-# DEPRECATED'  { T _ _ ITdeprecated_prag }
+ '{-# UNPACK'      { T _ _ ITunpack_prag }
  '#-}'            { T _ _ ITclose_prag }
 
  '..'          { T _ _ ITdotdot }                      -- reserved symbols
@@ -208,11 +209,10 @@ Conflicts: 29 shift/reduce, [SDM 19/9/2002]
 '[t|'           { T _ _ ITopenTypQuote  }      
 '[d|'           { T _ _ ITopenDecQuote  }      
 '|]'            { T _ _ ITcloseQuote    }
-ID_SPLICE       { T _ _ (ITidEscape $$) }     -- $x
+TH_ID_SPLICE    { T _ _ (ITidEscape $$) }     -- $x
 '$('           { T _ _ ITparenEscape   }     -- $( exp )
-REIFY_TYPE     { T _ _ ITreifyType }   
-REIFY_DECL     { T _ _ ITreifyDecl }   
-REIFY_FIXITY   { T _ _ ITreifyFixity }
+TH_VAR_QUOTE   { T _ _ ITvarQuote      }     -- 'x
+TH_TY_QUOTE    { T _ _ ITtyQuote      }      -- ''T
 
 %monad { P } { >>= } { return }
 %lexer { lexer } { T _ _ ITeof }
@@ -673,7 +673,8 @@ sigtypes :: { [RdrNameHsType] }
        | sigtypes ',' sigtype          { $3 : $1 }
 
 sigtype :: { RdrNameHsType }
-       : ctype                         { mkHsForAllTy Nothing [] $1 }
+       : ctype                         { mkImplicitHsForAllTy [] $1 }
+       -- Wrap an Implicit forall if there isn't one there already
 
 sig_vars :: { [RdrName] }
         : sig_vars ',' var             { $3 : $1 }
@@ -684,8 +685,8 @@ sig_vars :: { [RdrName] }
 
 -- A ctype is a for-all type
 ctype  :: { RdrNameHsType }
-       : 'forall' tv_bndrs '.' ctype   { mkHsForAllTy (Just $2) [] $4 }
-       | context '=>' type             { mkHsForAllTy Nothing   $1 $3 }
+       : 'forall' tv_bndrs '.' ctype   { mkExplicitHsForAllTy $2 [] $4 }
+       | context '=>' type             { mkImplicitHsForAllTy   $1 $3 }
        -- A type of form (context => type) is an *implicit* HsForAllTy
        | type                          { $1 }
 
@@ -827,7 +828,7 @@ stype :: { RdrNameBangType }
 
 strict_mark :: { HsBang }
        : '!'                           { HsStrict }
-       | '!' '!'                       { HsUnbox }
+       | '{-# UNPACK' '#-}' '!'        { HsUnbox }
 
 deriving :: { Maybe RdrNameContext }
        : {- empty -}                   { Nothing }
@@ -931,30 +932,16 @@ exp10 :: { RdrNameHsExpr }
 
         | '{-# CORE' STRING '#-}' exp           { HsCoreAnn $2 $4 }    -- hdaume: core annotation
 
-       | reifyexp                              { HsReify $1 }
        | fexp                                  { $1 }
 
 scc_annot :: { FastString }
        : '_scc_' STRING                        { $2 }
        | '{-# SCC' STRING '#-}'                { $2 }
 
-ccallid :: { FastString }
-       :  VARID                                { $1 }
-       |  CONID                                { $1 }
-
 fexp   :: { RdrNameHsExpr }
-       : fexp aexp                             { (HsApp $1 $2) }
+       : fexp aexp                             { HsApp $1 $2 }
        | aexp                                  { $1 }
 
-reifyexp :: { HsReify RdrName }
-       : REIFY_DECL gtycon                     { Reify ReifyDecl $2 }
-       | REIFY_DECL qvar                       { Reify ReifyDecl $2 }
-       | REIFY_TYPE qcname                     { Reify ReifyType $2 }
-       | REIFY_FIXITY qcname                   { Reify ReifyFixity $2 }
-
-aexps0         :: { [RdrNameHsExpr] }
-       : aexps                                 { reverse $1 }
-
 aexps  :: { [RdrNameHsExpr] }
        : aexps aexp                            { $2 : $1 }
        | {- empty -}                           { [] }
@@ -965,7 +952,7 @@ aexp        :: { RdrNameHsExpr }
        | aexp1                         { $1 }
 
 aexp1  :: { RdrNameHsExpr }
-        : aexp1 '{' fbinds '}'                 {% (mkRecConstrOrUpdate $1 (reverse $3)) }
+        : aexp1 '{' fbinds '}'         {% (mkRecConstrOrUpdate $1 (reverse $3)) }
        | aexp2                         { $1 }
 
 -- Here was the syntax for type applications that I was planning
@@ -973,7 +960,7 @@ aexp1       :: { RdrNameHsExpr }
 -- so it's not enabled yet.
 -- But this case *is* used for the left hand side of a generic definition,
 -- which is parsed as an expression before being munged into a pattern
-       | qcname '{|' gentype '|}'          { (HsApp (HsVar $1) (HsType $3)) }
+       | qcname '{|' gentype '|}'      { (HsApp (HsVar $1) (HsType $3)) }
 
 aexp2  :: { RdrNameHsExpr }
        : ipvar                         { HsIPVar $1 }
@@ -991,8 +978,12 @@ aexp2      :: { RdrNameHsExpr }
        | '_'                           { EWildPat }
        
        -- MetaHaskell Extension
-       | srcloc ID_SPLICE              { mkHsSplice (HsVar (mkUnqual varName $2)) $1 }  -- $x
+       | srcloc TH_ID_SPLICE           { mkHsSplice (HsVar (mkUnqual varName $2)) $1 }  -- $x
        | srcloc '$(' exp ')'           { mkHsSplice $3 $1 }                             -- $( exp )
+       | srcloc TH_VAR_QUOTE qvar      { HsBracket (VarBr $3) $1 }
+       | srcloc TH_VAR_QUOTE qcon      { HsBracket (VarBr $3) $1 }
+       | srcloc TH_TY_QUOTE tyvar      { HsBracket (VarBr $3) $1 }
+       | srcloc TH_TY_QUOTE gtycon     { HsBracket (VarBr $3) $1 }
        | srcloc '[|' exp '|]'          { HsBracket (ExpBr $3) $1 }                       
        | srcloc '[t|' ctype '|]'       { HsBracket (TypBr $3) $1 }                       
        | srcloc '[p|' infixexp '|]'    {% checkPattern $1 $3 >>= \p ->
@@ -1158,22 +1149,20 @@ qual  :: { RdrNameStmt }
 -----------------------------------------------------------------------------
 -- Record Field Update/Construction
 
-fbinds         :: { RdrNameHsRecordBinds }
-       : fbinds ',' fbind              { $3 : $1 }
-       | fbinds ','                    { $1 }
-       | fbind                         { [$1] }
+fbinds :: { RdrNameHsRecordBinds }
+       : fbinds1                       { $1 }
        | {- empty -}                   { [] }
 
+fbinds1        :: { RdrNameHsRecordBinds }
+       : fbinds1 ',' fbind             { $3 : $1 }
+       | fbind                         { [$1] }
+
 fbind  :: { (RdrName, RdrNameHsExpr) }
        : qvar '=' exp                  { ($1,$3) }
 
 -----------------------------------------------------------------------------
 -- Implicit Parameter Bindings
 
-dbinding :: { [(IPName RdrName, RdrNameHsExpr)] }
-       : '{' dbinds '}'                { $2 }
-       | vocurly dbinds close          { $2 }
-
 dbinds         :: { [(IPName RdrName, RdrNameHsExpr)] }
        : dbinds ';' dbind              { $3 : $1 }
        | dbinds ';'                    { $1 }