{-
-----------------------------------------------------------------------------
-$Id: Parser.y,v 1.5 1999/06/03 14:44:23 simonmar Exp $
+$Id: Parser.y,v 1.8 1999/06/28 15:42:33 simonmar Exp $
Haskell grammar.
%token
'_' { ITunderscore } -- Haskell keywords
- 'as' { ITas }
'case' { ITcase }
'class' { ITclass }
'data' { ITdata }
'deriving' { ITderiving }
'do' { ITdo }
'else' { ITelse }
- 'hiding' { IThiding }
'if' { ITif }
'import' { ITimport }
'in' { ITin }
'module' { ITmodule }
'newtype' { ITnewtype }
'of' { ITof }
- 'qualified' { ITqualified }
'then' { ITthen }
'type' { ITtype }
'where' { ITwhere }
: ctype {% checkInstType $1 }
ctype :: { RdrNameHsType }
- : 'forall' tyvars '.' btype '=>' type
- {% checkContext $4 `thenP` \c ->
- returnP (HsForAllTy (Just $2) c $6) }
+ : 'forall' tyvars '.' context type
+ { HsForAllTy (Just $2) $4 $5 }
| 'forall' tyvars '.' type { HsForAllTy (Just $2) [] $4 }
- | btype '=>' type {% checkContext $1 `thenP` \c ->
- returnP (HsForAllTy Nothing c $3) }
+ | context type { HsForAllTy Nothing $1 $2 }
| type { $1 }
types0 :: { [RdrNameHsType] }
: constrs '|' constr { $3 : $1 }
| constr { [$1] }
-{- ToDo: existential stuff -}
-
constr :: { RdrNameConDecl }
- : srcloc scontype
- { ConDecl (fst $2) [] [] (VanillaCon (snd $2)) $1 }
- | srcloc sbtype conop sbtype
- { ConDecl $3 [] [] (InfixCon $2 $4) $1 }
- | srcloc con '{' fielddecls '}'
- { ConDecl $2 [] [] (RecCon (reverse $4)) $1 }
+ : srcloc forall context constr_stuff
+ { ConDecl (fst $4) $2 $3 (snd $4) $1 }
+ | srcloc forall constr_stuff
+ { ConDecl (fst $3) $2 [] (snd $3) $1 }
+
+forall :: { [RdrNameHsTyVar] }
+ : 'forall' tyvars '.' { $2 }
+ | {- empty -} { [] }
+
+context :: { RdrNameContext }
+ : btype '=>' {% checkContext $1 }
+
+constr_stuff :: { (RdrName, RdrNameConDetails) }
+ : scontype { (fst $1, VanillaCon (snd $1)) }
+ | sbtype conop sbtype { ($2, InfixCon $1 $3) }
+ | con '{' fielddecls '}' { ($1, RecCon (reverse $3)) }
newconstr :: { RdrNameConDecl }
: srcloc conid atype { ConDecl $2 [] [] (NewCon $3 Nothing) $1 }
| layout_on stmts close { reverse $2 }
stmts :: { [RdrNameStmt] }
- : stmts ';' stmt { $3 : $1 }
- | stmts ';' { $1 }
+ : ';' stmts1 { $2 }
+ | stmts1 { $1 }
+
+stmts1 :: { [RdrNameStmt] }
+ : stmts1 ';' stmt { $3 : $1 }
+ | stmts1 ';' { $1 }
| stmt { [$1] }
- | {- empty -} { [] }
stmt :: { RdrNameStmt }
: srcloc infixexp '<-' exp {% checkPattern $2 `thenP` \p ->
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 }
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
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 }