[project @ 2002-12-10 16:28:48 by igloo]

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

diff --git a/ghc/compiler/parser/Parser.y b/ghc/compiler/parser/Parser.y
index 851deb7..907c929 100644 (file)
--- a/ghc/compiler/parser/Parser.y
+++ b/ghc/compiler/parser/Parser.y
@@ -1,6 +1,6 @@
 {-                                                             -*-haskell-*-
 -----------------------------------------------------------------------------
-$Id: Parser.y,v 1.109 2002/10/11 08:48:13 simonpj Exp $
+$Id: Parser.y,v 1.114 2002/12/10 16:28:48 igloo Exp $
 
 Haskell grammar.
 
@@ -17,7 +17,7 @@ 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, 
@@ -236,8 +236,11 @@ Conflicts: 29 shift/reduce, [SDM 19/9/2002]
 '[t|'           { ITopenTypQuote  }      
 '[d|'           { ITopenDecQuote  }      
 '|]'            { ITcloseQuote    }
-ID_SPLICE       { ITidEscape $$   }           -- $x
-'$('           { ITparenEscape   }           -- $( exp )
+ID_SPLICE       { ITidEscape $$   }     -- $x
+'$('           { ITparenEscape   }     -- $( exp )
+REIFY_TYPE     { ITreifyType } 
+REIFY_DECL     { ITreifyDecl } 
+REIFY_FIXITY   { ITreifyFixity }
 
 %monad { P } { thenP } { returnP }
 %lexer { lexer } { ITeof }
@@ -292,6 +295,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   = [],
@@ -466,21 +470,23 @@ decls     :: { [RdrBinding] }     -- Reversed
        | {- empty -}                   { [] }
 
 
-wherebinds :: { RdrNameHsBinds }
-       : where                         { cvBinds $1 }
+decllist :: { [RdrBinding] }   -- Reversed
+       : '{'            decls '}'      { $2 }
+       |     layout_on  decls close    { $2 }
 
 where  :: { [RdrBinding] }     -- Reversed
+                               -- No implicit parameters
        : 'where' decllist              { $2 }
        | {- empty -}                   { [] }
 
-decllist :: { [RdrBinding] }   -- Reversed
-       : '{'            decls '}'      { $2 }
-       |     layout_on  decls close    { $2 }
+binds  ::  { RdrNameHsBinds }  -- May have implicit parameters
+       : decllist                      { cvBinds $1 }
+       | '{'            dbinds '}'     { IPBinds $2 False{-not with-} }
+       |     layout_on  dbinds close   { IPBinds $2 False{-not with-} }
 
-letbinds :: { RdrNameHsExpr -> RdrNameHsExpr }
-       : decllist                      { HsLet (cvBinds $1) }
-       | '{'            dbinds '}'     { \e -> HsWith e $2 False{-not with-} }
-       |     layout_on  dbinds close   { \e -> HsWith e $2 False{-not with-} }
+wherebinds :: { RdrNameHsBinds }       -- May have implicit parameters
+       : 'where' binds                 { $2 }
+       | {- empty -}                   { EmptyBinds }
 
 
 
@@ -919,7 +925,7 @@ sigdecl :: { RdrBinding }
 
 exp   :: { RdrNameHsExpr }
        : infixexp '::' sigtype         { ExprWithTySig $1 $3 }
-       | infixexp 'with' dbinding      { HsWith $1 $3 True{-not a let-} }
+       | infixexp 'with' dbinding      { HsLet (IPBinds $3 True{-not a let-}) $1 }
        | infixexp                      { $1 }
 
 infixexp :: { RdrNameHsExpr }
@@ -933,7 +939,7 @@ exp10 :: { RdrNameHsExpr }
                           returnP (HsLam (Match ps $5 
                                            (GRHSs (unguardedRHS $8 $7) 
                                                   EmptyBinds placeHolderType))) }
-       | 'let' letbinds 'in' exp               { $2 $4 }
+       | 'let' binds 'in' exp                  { HsLet $2 $4 }
        | 'if' srcloc exp 'then' exp 'else' exp { HsIf $3 $5 $7 $2 }
        | 'case' srcloc exp 'of' altslist       { HsCase $3 $5 $2 }
        | '-' fexp                              { mkHsNegApp $2 }
@@ -951,6 +957,7 @@ exp10 :: { RdrNameHsExpr }
                                                        then HsSCC $1 $2
                                                        else HsPar $2 }
 
+       | reifyexp                              { HsReify $1 }
        | fexp                                  { $1 }
 
 scc_annot :: { FastString }
@@ -965,6 +972,12 @@ fexp       :: { RdrNameHsExpr }
        : 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 }
 
@@ -1008,8 +1021,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 }
@@ -1146,7 +1162,7 @@ stmt  :: { RdrNameStmt }
        : srcloc infixexp '<-' exp      {% checkPattern $1 $2 `thenP` \p ->
                                           returnP (BindStmt p $4 $1) }
        | srcloc exp                    { ExprStmt $2 placeHolderType $1 }
-       | srcloc 'let' decllist         { LetStmt (cvBinds $3) }
+       | srcloc 'let' binds            { LetStmt $3 }
 
 -----------------------------------------------------------------------------
 -- Record Field Update/Construction