[project @ 1999-07-27 07:31:16 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 f97ff96..066bc1c 100644 (file)
--- a/ghc/compiler/parser/Parser.y
+++ b/ghc/compiler/parser/Parser.y
@@ -1,6 +1,6 @@
 {-
 -----------------------------------------------------------------------------
-$Id: Parser.y,v 1.8 1999/06/28 15:42:33 simonmar Exp $
+$Id: Parser.y,v 1.12 1999/07/27 07:31:18 simonpj Exp $
 
 Haskell grammar.
 
@@ -61,6 +61,7 @@ Conflicts: 14 shift/reduce
 
 %token
  '_'            { ITunderscore }               -- Haskell keywords
+ 'as'          { ITas }
  'case'        { ITcase }      
  'class'       { ITclass } 
  'data'        { ITdata } 
@@ -68,6 +69,7 @@ Conflicts: 14 shift/reduce
  'deriving'    { ITderiving }
  'do'          { ITdo }
  'else'        { ITelse }
+ 'hiding'      { IThiding }
  'if'          { ITif }
  'import'      { ITimport }
  'in'          { ITin }
@@ -79,6 +81,7 @@ Conflicts: 14 shift/reduce
  'module'      { ITmodule }
  'newtype'     { ITnewtype }
  'of'          { ITof }
+ 'qualified'   { ITqualified }
  'then'        { ITthen }
  'type'        { ITtype }
  'where'       { ITwhere }
@@ -400,9 +403,7 @@ signdecl :: { RdrBinding }
                                              [ RdrSig (Sig n $4 $2) | n <- $1 ] }
 
 sigtype :: { RdrNameHsType }
-       : ctype                 { case $1 of
-                                   HsForAllTy _ _ _ -> $1
-                                   other            -> HsForAllTy Nothing [] $1 }
+       : ctype                 { mkHsForAllTy Nothing [] $1 }
 
 {-
   ATTENTION: Dirty Hackery Ahead! If the second alternative of vars is var
@@ -499,9 +500,10 @@ inst_type :: { RdrNameHsType }
 
 ctype  :: { RdrNameHsType }
        : 'forall' tyvars '.' context type
-                                       { HsForAllTy (Just $2) $4 $5 }
-       | 'forall' tyvars '.' type      { HsForAllTy (Just $2) [] $4 }
-       | context type                  { HsForAllTy Nothing   $1 $2 }
+                                       { mkHsForAllTy (Just $2) $4 $5 }
+       | 'forall' tyvars '.' type      { mkHsForAllTy (Just $2) [] $4 }
+       | context type                  { mkHsForAllTy Nothing   $1 $2 }
+               -- A type of form (context => type) is an *implicit* HsForAllTy
        | type                          { $1 }
 
 types0  :: { [RdrNameHsType] }
@@ -757,17 +759,20 @@ gdpat     :: { RdrNameGRHS }
 -- Statement sequences
 
 stmtlist :: { [RdrNameStmt] }
-       : '{'            stmts '}'      { reverse $2 }
-       |     layout_on  stmts close    { reverse $2 }
+       : '{'                   stmts '}'       { $2 }
+       |     layout_on_for_do  stmts close     { $2 }
 
+-- Stmt list must end in an expression
+-- thought the H98 report doesn't currently say so in the syntax
 stmts :: { [RdrNameStmt] }
-       : ';' stmts1                    { $2 }
-       | stmts1                        { $1 }
+       : stmts1 srcloc exp             { reverse (ExprStmt $3 $2 : $1) }
 
+-- A list of zero or more stmts, ending in semicolon
+-- Returned in *reverse* order
 stmts1 :: { [RdrNameStmt] }
-       : stmts1 ';' stmt               { $3 : $1 }
-       | stmts1 ';'                    { $1 }
-       | stmt                          { [$1] }
+       : stmts1 stmt ';'               { $2 : $1 }
+       | stmts1 ';'                    { $1 }
+       |                               { [] }
 
 stmt  :: { RdrNameStmt }
        : srcloc infixexp '<-' exp      {% checkPattern $2 `thenP` \p ->
@@ -857,6 +862,9 @@ qvarid :: { RdrName }
 
 varid :: { RdrName }
        : VARID                 { mkSrcUnqual varName $1 }
+       | 'as'                  { as_var_RDR }
+       | 'qualified'           { qualified_var_RDR }
+       | 'hiding'              { hiding_var_RDR }
        | 'forall'              { forall_var_RDR }
        | 'export'              { export_var_RDR }
        | 'label'               { label_var_RDR }
@@ -865,16 +873,14 @@ varid :: { RdrName }
 
 varid_no_unsafe :: { RdrName }
        : VARID                 { mkSrcUnqual varName $1 }
+       | 'as'                  { as_var_RDR }
+       | 'qualified'           { qualified_var_RDR }
+       | 'hiding'              { hiding_var_RDR }
        | 'forall'              { forall_var_RDR }
        | 'export'              { export_var_RDR }
        | 'label'               { label_var_RDR }
        | 'dynamic'             { dynamic_var_RDR }
 
--- ``special'' Ids
-'as'       :: { () } : VARID   {% checkAs $1 }
-'qualified' :: { () } : VARID  {% checkQualified $1 }
-'hiding'    :: { () } : VARID  {% checkHiding $1 }
-
 -----------------------------------------------------------------------------
 -- ConIds
 
@@ -945,7 +951,8 @@ close :: { () }
        : vccurly               { () } -- context popped in lexer.
        | error                 {% popContext }
 
-layout_on  :: { () }   :       {% layoutOn  }
+layout_on        :: { () }     : {% layoutOn True{-strict-} }
+layout_on_for_do  :: { () }    : {% layoutOn False }
 
 -----------------------------------------------------------------------------
 -- Miscellaneous (mostly renamings)
@@ -966,6 +973,9 @@ qtycls      :: { RdrName }
 
 tyvar  :: { RdrName }
        : VARID                 { mkSrcUnqual tvName $1 }
+       | 'as'                  { as_tyvar_RDR }
+       | 'qualified'           { qualified_tyvar_RDR }
+       | 'hiding'              { hiding_tyvar_RDR }
        | 'export'              { export_var_RDR }
        | 'label'               { label_var_RDR }
        | 'dynamic'             { dynamic_var_RDR }