More progress -- still on phase1

1 files changed, 0 insertions, 1024 deletions

diff --git a/src/HsParser.ly b/src/HsParser.ly
deleted file mode 100644
index c3edd3ce..00000000
--- a/src/HsParser.ly
+++ /dev/null
@@ -1,1024 +0,0 @@
------------------------------------------------------------------------------
-$Id: HsParser.ly,v 1.21 2004/08/09 11:55:07 simonmar Exp $
-
-(c) Simon Marlow, Sven Panne 1997-2002
-
-Haskell grammar.
------------------------------------------------------------------------------
-
-ToDo: Is (,) valid as exports? We don't allow it.
-ToDo: Check exactly which names must be qualified with Prelude (commas and friends)
-ToDo: Inst (MPCs?)
-ToDo: Polish constr a bit
-ToDo: Ugly: exp0b is used for lhs, pat, exp0, ...
-ToDo: Differentiate between record updates and labeled construction.
-
-> {
-> module HsParser (parse) where
-> 
-> import Monad
-> import HsSyn2
-> import HsParseMonad
-> import HsLexer
-> import HsParseUtils
-> import HaddockLex2 	hiding (Token)
-> import HaddockParse2
-> import HaddockUtil 	hiding (splitTyConApp)
-> import Char 		( isSpace )
-> }
-
------------------------------------------------------------------------------
-Conflicts: 3 shift/reduce
-
-2 for ambiguity in 'case x of y | let z = y in z :: a -> b'
-	(don't know whether to reduce 'True' as a btype or shift the '->'.
-	 Similarly lambda and if.  This is a rather arcane special case:
-	 the default resolution in favour of the shift does what the Report
-	 specifies, but the result will always fail to type-check.)
-
-1 for ambiguity in 'x @ Rec{..}'.  
-	Only sensible parse is 'x @ (Rec{..})', which is what resolving
-	to shift gives us.
-
------------------------------------------------------------------------------
-
-> %token
->	VARID 	 { VarId $$ }
->       IPVARID  { IPVarId $$ }
->	QVARID 	 { QVarId $$ }
->	CONID	 { ConId $$ }
->	QCONID   { QConId $$ }
->	VARSYM	 { VarSym $$ }
->	CONSYM	 { ConSym $$ }
->	QVARSYM	 { QVarSym $$ }
->	QCONSYM  { QConSym $$ }
->	INT	 { IntTok $$ }
->	RATIONAL { FloatTok $$ }
->	CHAR	 { Character $$ }
->	STRING   { StringTok $$ }
-
->	PRIMINT    { PrimInt $$ }
->	PRIMSTRING { PrimString $$ }
->	PRIMFLOAT  { PrimFloat $$ }
->	PRIMDOUBLE { PrimDouble $$ }
->	PRIMCHAR   { PrimChar $$ }
-
-Docs
-
->	DOCNEXT    { DocCommentNext $$ }
->	DOCPREV    { DocCommentPrev $$ }
->	DOCNAMED   { DocCommentNamed $$ }
->	DOCSECTION { DocSection _ _ }
->	DOCOPTIONS { DocOptions $$ }
-
-Symbols
-
->	'('	{ LeftParen }
->	')'	{ RightParen }
->	'(#'	{ LeftUT }
->	'#)'	{ RightUT }
->	';'	{ SemiColon }
->	'{'	{ LeftCurly }
->	'}'	{ RightCurly }
->	vccurly { VRightCurly }			-- a virtual close brace
->	'['	{ LeftSquare }
->	']'	{ RightSquare }
->  	','	{ Comma }
->	'_'	{ Underscore }
->	'`'	{ BackQuote }
-
-Reserved operators
-
->	'.'	{ Dot }
->	'..'	{ DotDot }
->	'::'	{ DoubleColon }
->	'='	{ Equals }
->	'\\'	{ Backslash }
->	'|'	{ Bar }
->	'<-'	{ LeftArrow }
->	'->'	{ RightArrow }
->	'@'	{ At }
->	'~'	{ Tilde }
->	'=>'	{ DoubleArrow }
->	'-'	{ Minus }
->	'!'	{ Exclamation }
-
-Reserved Ids
-
->	'as'		{ KW_As }
->	'case'		{ KW_Case }
->	'ccall'		{ KW_CCall }
->	'class'		{ KW_Class }
->	'data'		{ KW_Data }
->	'default'	{ KW_Default }
->	'deriving'	{ KW_Deriving }
->	'do'		{ KW_Do }
->	'dotnet'	{ KW_DotNet }
->	'else'		{ KW_Else }
->	'export'	{ KW_Export }
->	'forall'	{ KW_Forall }
->	'foreign'	{ KW_Foreign }
->	'hiding'	{ KW_Hiding }
->	'if'		{ KW_If }
->	'import'	{ KW_Import }
->	'in'		{ KW_In }
->	'infix'		{ KW_Infix }
->	'infixl'	{ KW_InfixL }
->	'infixr'	{ KW_InfixR }
->	'instance'	{ KW_Instance }
->	'let'		{ KW_Let }
->	'module'	{ KW_Module }
->	'newtype'	{ KW_NewType }
->	'of'		{ KW_Of }
->	'safe'		{ KW_Safe }
->	'stdcall'	{ KW_StdCall }
->	'then'		{ KW_Then }
->	'threadsafe'	{ KW_ThreadSafe }
->	'type'		{ KW_Type }
->	'unsafe'	{ KW_Unsafe }
->	'where'		{ KW_Where }
->	'qualified'	{ KW_Qualified }
-
-> %monad { P } { thenP } { returnP }
-> %lexer { lexer } { EOF }
-> %name parse
-> %tokentype { Token }
-> %%
-
------------------------------------------------------------------------------
-Module Header
-
-> module :: { HsModule }
-> 	: optdoc 'module' srcloc modid maybeexports 'where' body
->	    { case $1 of { (opts,info,doc) ->
->	      HsModule $3 $4 $5 (reverse (fst $7)) (snd $7)
->		opts info doc } }
->	| body srcloc
->	    { HsModule $2 main_mod Nothing (reverse (fst $1)) (snd $1)
->		Nothing emptyModuleInfo Nothing }
-
-> optdoc :: { (Maybe String,ModuleInfo,Maybe Doc) }
->	: moduleheader			{ (Nothing, fst $1, snd $1) }
->	| DOCOPTIONS			{ (Just $1, emptyModuleInfo,Nothing) }
->	| DOCOPTIONS moduleheader	{ (Just $1, fst $2, snd $2) }
->	| moduleheader DOCOPTIONS	{ (Just $2, fst $1, snd $1) }
->	| {- empty -}			{ (Nothing, emptyModuleInfo,Nothing) } 
-
-> body :: { ([HsImportDecl],[HsDecl]) }
->	:  '{' bodyaux '}'				{ $2 }
-> 	|      layout_on  bodyaux close			{ $2 }
-
-> bodyaux :: { ([HsImportDecl],[HsDecl]) }
->	: impdecls ';' topdecls				{ ($1, $3) }
->	|              topdecls				{ ([], $1) }
->	| impdecls             				{ ($1, []) }
-
-> optsemi :: { () }
->	: ';'						{ () }
->	| {- empty -}					{ () }
-
------------------------------------------------------------------------------
-The Export List
-
-> maybeexports :: { Maybe [HsExportSpec] }
-> 	:  exports				{ Just $1 }
-> 	|  {- empty -}				{ Nothing }
-
-> exports :: { [HsExportSpec] }
->	: '(' exportlist ')'			{ $2 }
-
-> exportlist :: { [HsExportSpec] }
->	:  export exportlist1			{ $1 : $2 }
->	|  exp_doc exportlist			{ $1 : $2 }
-> 	|  {- empty -}				{ [] }
-
-> exportlist1 :: { [HsExportSpec] }
->	:  exp_doc exportlist1			{ $1 : $2 }
-> 	|  ',' exportlist			{ $2 }
->	|  {- empty -}				{ [] }
-
-> exp_doc :: { HsExportSpec }
-> 	: docsection			{ case $1 of { (i,s) -> HsEGroup i s } }
->	| docnamed			{ HsEDocNamed (fst $1) }
->	| docnext			{ HsEDoc $1 }
-
-> export :: { HsExportSpec }
-> 	:  qvar					{ HsEVar $1 }
-> 	|  qgtycon				{ HsEAbs $1 }
-> 	|  qgtycon '(' '..' ')'			{ HsEThingAll $1 }
-> 	|  qgtycon '(' ')'		        { HsEThingWith $1 [] }
-> 	|  qgtycon '(' qcnames ')'		{ HsEThingWith $1 (reverse $3) }
-> 	|  'module' modid			{ HsEModuleContents $2 }
-
-> qcnames :: { [HsQName] }
-> 	:  qcnames ',' qcname			{ $3 : $1 }
-> 	|  qcname				{ [$1]  }
-
-> qcname :: { HsQName }
->	:  qvar					{ $1 }
-> 	|  gcon					{ $1 }
-
------------------------------------------------------------------------------
-Import Declarations
-
-> impdecls :: { [HsImportDecl] }
->	: impdecls ';' impdecl			{ $3 : $1 }
->	| impdecl				{ [$1] }
-
-> impdecl :: { HsImportDecl }
->	: 'import' srcloc optqualified modid maybeas maybeimpspec
-> 		  		{ HsImportDecl $2 $4 $3 $5 $6 }
-
-> optqualified :: { Bool }
->       : 'qualified'                           { True  }
->       | {- empty -}				{ False }
-
-> maybeas :: { Maybe Module }
->       : 'as' modid                            { Just $2 }
->       | {- empty -}				{ Nothing }
-
-
-> maybeimpspec :: { Maybe (Bool, [HsImportSpec]) }
->	: impspec				{ Just $1 }
->	| {- empty -}				{ Nothing }
-
-> impspec :: { (Bool, [HsImportSpec]) }
-> 	:  '(' importlist ')'  			{ (False, reverse $2) }
-> 	|  'hiding' '(' importlist ')' 		{ (True,  reverse $3) }
-
-> importlist :: { [HsImportSpec] }
->	:  importlist ',' import		{ $3 : $1 }
-> 	|  importlist ','			{ $1 }
->	|  import				{ [$1] }
-> 	|  {- empty -}				{ [] }
-
-> import :: { HsImportSpec }
-> 	:  var					{ HsIVar $1 }
-> 	|  gtycon				{ HsIAbs $1 }
-> 	|  gtycon '(' '..' ')'			{ HsIThingAll $1 }
-> 	|  gtycon '(' ')'		        { HsIThingWith $1 [] }
-> 	|  gtycon '(' cnames ')'		{ HsIThingWith $1 (reverse $3) }
-
-> gtycon :: { HsName }
->	: tyconorcls			{ $1 }
->	| '(' ')'			{ unit_tycon_name }
->	| '(' '->' ')'			{ fun_tycon_name }
->	| '[' ']'			{ list_tycon_name }
->	| '(' commas ')'		{ tuple_tycon_name $2 }
-
-> cnames :: { [HsName] }
-> 	:  cnames ',' cname			{ $3 : $1 }
-> 	|  cname				{ [$1]  }
-
-> cname :: { HsName }
->	:  var					{ $1 }
-> 	|  con					{ $1 }
-
------------------------------------------------------------------------------
-Fixity Declarations
-
-> fixdecl :: { HsDecl }
-> 	: srcloc infix prec ops			{ HsInfixDecl $1 $2 $3 (reverse $4) }
-
-> prec :: { Int }
->	: {- empty -}				{ 9 }
->	| INT					{%  checkPrec $1 `thenP` \p ->
->						    returnP (fromIntegral $1) }
-
-> infix :: { HsAssoc }
->	: 'infix'				{ HsAssocNone  }
->	| 'infixl'				{ HsAssocLeft  }
->	| 'infixr'				{ HsAssocRight }
-
-> ops   :: { [HsName] }
->	: ops ',' op				{ $3 : $1 }
->	| op					{ [$1] }
-
------------------------------------------------------------------------------
-Top-Level Declarations
-
-> topdecls :: { [HsDecl] }
->	: topdecl ';' topdecls		{ $1 : $3 }
-> 	| ';' topdecls			{ $2 }
->	| docdecl topdecls		{ $1 : $2 }
->	| topdecl			{ [$1] }
->	| {- empty -}			{ [] }
-
-> topdecl :: { HsDecl }
->	: 'type' simpletype srcloc '=' ctypedoc
->		{ HsTypeDecl $3 (fst $2) (snd $2) $5 Nothing }
->	| 'data' ctype srcloc constrs deriving
->		{% checkDataHeader $2 `thenP` \(cs,c,t) ->
->		   returnP (HsDataDecl $3 cs c t $4 $5 Nothing) }
->	| 'newtype' ctype srcloc '=' constr deriving
->		{% checkDataHeader $2 `thenP` \(cs,c,t) ->
->		   returnP (HsNewTypeDecl $3 cs c t $5 $6 Nothing) }
->	| 'class' srcloc ctype fds optcbody
->		{% checkClassHeader $3 `thenP` \(ctxt,n,tys) ->
->		   returnP (HsClassDecl $2 ctxt n tys $4 $5 Nothing) }
->	| 'instance' srcloc ctype optvaldefs
->		{% checkInstHeader $3 `thenP` \(ctxt,asst) ->
->		   returnP (HsInstDecl $2 ctxt asst $4) }
->	| 'default' srcloc '(' typelist ')'
->		{ HsDefaultDecl $2 $4 }
->	| 'foreign' fdecl { $2 }
->       | decl		{ $1 }
-
-> typelist :: { [HsType] }
->	: types				{ $1 }
->	| type				{ [$1] }
->	| {- empty -}			{ [] }
-
-> decls :: { [HsDecl] }
->	: decl ';' decls		{ $1 : $3 }
-> 	| docdecl decls			{ $1 : $2 }
->	| ';' decls			{ $2 }
->	| decl				{ [$1] }
->	| {- empty -}			{ [] }
-
-> decl :: { HsDecl }
->	: signdecl		{ $1 }
->	| fixdecl		{ $1 }
->	| valdef		{ $1 }
-
-> docdecl :: { HsDecl }
->	: srcloc docnext	{ HsDocCommentNext $1 $2 }
->	| srcloc docprev	{ HsDocCommentPrev $1 $2 }
->	| srcloc docnamed	{ case $2 of { (n,s) -> 
->					HsDocCommentNamed $1 n s } }
->	| srcloc docsection	{ case $2 of { (i,s) -> HsDocGroup $1 i s } }
-
-> decllist :: { [HsDecl] }
->	: '{' decls '}'			{ $2 }
->	|     layout_on  decls close	{ $2 }
-
-> signdecl :: { HsDecl }
->	: vars srcloc '::' ctypedoc	{ HsTypeSig $2 (reverse $1) $4 Nothing }
-
-ATTENTION: Dirty Hackery Ahead! If the second alternative of vars is var
-instead of qvar, we get another shift/reduce-conflict. Consider the
-following programs:
-
-   { (+) :: ... }          only var
-   { (+) x y  = ... }      could (incorrectly) be qvar
-
-We re-use expressions for patterns, so a qvar would be allowed in patterns
-instead of a var only (which would be correct). But deciding what the + is,
-would require more lookahead. So let's check for ourselves...
-
-> vars	:: { [HsName] }
->	: vars ',' var			{ $3 : $1 }
->	| qvar				{% checkUnQual $1 `thenP` \n ->
->					   returnP [n] }
-
------------------------------------------------------------------------------
-Foreign Declarations
-
-> fdecl :: { HsDecl }
-> fdecl : srcloc 'import' callconv safety fspec
->	  { case $5 of (spec,nm,ty) -> HsForeignImport $1 $3 $4 spec nm ty Nothing }
-> 	| srcloc 'import' callconv fspec
->	  { case $4 of (spec,nm,ty) -> HsForeignImport $1 $3 HsFISafe spec nm ty Nothing }
-> 	| srcloc 'export' callconv fspec
->	  { case $4 of (spec,nm,ty) -> HsForeignExport $1 $3 spec nm ty }
-
-> callconv :: { HsCallConv }
-> 	    : 'stdcall'			{ HsStdCall }
-> 	    | 'ccall'			{ HsCCall   }
-> 	    | 'dotnet'			{ HsDotNetCall }
-
-> safety :: { HsFISafety }
-> 	  : 'unsafe'			{ HsFIUnsafe }
-> 	  | 'safe'			{ HsFISafe }
-> 	  | 'threadsafe'		{ HsFIThreadSafe  }
-
-> fspec :: { (String, HsName, HsType) }
-> 	 : STRING varid '::' ctypedoc   { ($1, $2, $4) }
-> 	 |        varid '::' ctypedoc   { ("", $1, $3) }
-
------------------------------------------------------------------------------
-Types
-
-> doctype :: { HsType }
->	: tydoc '->' doctype		{ HsTyFun $1 $3 }
->	| tydoc				{ $1 }
-
-> tydoc :: { HsType }
-> 	: btype				{ $1 }
->	| btype docprev			{ HsTyDoc $1 $2 }
-
-> type :: { HsType }
->       : ipvar '::' type1              { HsTyIP $1 $3 }
->       | type1                         { $1 }
-
-> type1 :: { HsType }
->       : btype				{ $1 }
-> 	| btype '->' type1		{ HsTyFun $1 $3 }
-
-> btype :: { HsType }
->	: btype atype			{ HsTyApp $1 $2 }
->	| atype				{ $1 }
-
-> atype :: { HsType }
->	: qgtycon			{ HsTyCon $1 }
->	| tyvar				{ HsTyVar $1 }
->	| '(' types ')'			{ HsTyTuple True  $2 }
->	| '(#' type '#)'		{ HsTyTuple False [$2] }
->	| '(#' types '#)'		{ HsTyTuple False $2 }
->	| '[' type ']'			{ HsTyApp list_tycon $2 }
->	| '(' ctype ')'			{ $2 }
-
-> qgtycon :: { HsQName }
->	: qtycls			{ $1 }
->	| '(' ')'			{ unit_tycon_qname }
->	| '(' '->' ')'			{ fun_tycon_qname }
->	| '[' ']'			{ list_tycon_qname }
->	| '(' commas ')'		{ tuple_tycon_qname $2 }
-
-(Slightly edited) Comment from GHC's hsparser.y:
-"context => type" vs  "type" is a problem, because you can't distinguish between
-
-	foo :: (Baz a, Baz a)
-	bar :: (Baz a, Baz a) => [a] -> [a] -> [a]
-
-with one token of lookahead.  The HACK is to parse the context as a btype
-(more specifically as a tuple type), then check that it has the right form
-C a, or (C1 a, C2 b, ... Cn z) and convert it into a context.  Blaach!
-
-> ctype :: { HsType }
->	: 'forall' tyvars '.' ctype	{ mkHsForAllType (Just $2) [] $4 }
->	| context '=>' type		{ mkHsForAllType Nothing $1 $3 }
->	| type				{ $1 }
-
-> ctypedoc :: { HsType }
->	: 'forall' tyvars '.' ctypedoc	{ mkHsForAllType (Just $2) [] $4 }
->	| context '=>' doctype		{ mkHsForAllType Nothing $1 $3 }
->	| doctype			{ $1 }
-
-> context :: { HsIPContext }
-> 	: btype				{% checkContext $1 }
-
-> types	:: { [HsType] }
->	: type ',' types		{ $1 : $3 }
->	| type  ',' type		{ [$1,$3] }
-
-> simpletype :: { (HsName, [HsName]) }
->	: tycon tyvars			{ ($1,$2) }
-
-> tyvars :: { [HsName] }
->	: tyvar tyvars			{ $1 : $2 }
->	| {- empty -}			{ [] }
-
------------------------------------------------------------------------------
-Datatype declarations
-
-> constrs :: { [HsConDecl] }
-> 	  : {- empty; a GHC extension -}  { [] }
-> 	  | maybe_docnext '=' constrs1    { addConDocs $3 $1 }
-
-> constrs1 :: { [HsConDecl] }
->	: constr maybe_docnext '|' maybe_docprev constrs1
->			{ addConDoc $1 $4 : addConDocs $5 $2 }
->	| constr			{ [$1] }
-
-> constr :: { HsConDecl }
->	: srcloc maybe_docnext forall_stuff constr_stuff maybe_docprev
->		{ HsConDecl $1 (fst $4) $3 [] (snd $4) ($2 `mplus` $5) }
->	| srcloc maybe_docnext forall_stuff context '=>' constr_stuff maybe_docprev
->		{% checkIPContext $4 `thenP` \ ctxt -> returnP (HsConDecl $1 (fst $6) $3 ctxt (snd $6) ($2 `mplus` $7)) }
-> 	| srcloc maybe_docnext forall_stuff con '{' fielddecls '}' maybe_docprev
-> 		{ HsRecDecl $1 $4 $3 [] $6 ($2 `mplus` $8) }
-> 	| srcloc maybe_docnext forall_stuff context '=>' con '{' fielddecls '}' maybe_docprev
-> 		{% checkIPContext $4 `thenP` \ ctxt -> returnP (HsRecDecl $1 $6 $3 ctxt $8 ($2 `mplus` $10)) }
-
-> forall_stuff :: { [HsName] }
-> 	: 'forall' tyvars '.'		 	{ $2 }
-> 	| {- empty -}				{ [] }
-
-> constr_stuff :: { (HsName, [HsBangType]) }
-> 	: scontype 				{ $1 }
->	| sbtype conop sbtype			{ ($2, [$1,$3]) }
-
-> scontype :: { (HsName, [HsBangType]) }
->	: btype				{% splitTyConApp $1 `thenP` \(c,ts) ->
->					   returnP (toVarHsName c,
->						    map HsUnBangedTy ts) }
->	| scontype1			{ $1 }
-
-> scontype1 :: { (HsName, [HsBangType]) }
->	: btype '!' atype		{% splitTyConApp $1 `thenP` \(c,ts) ->
->					   returnP (toVarHsName c,
->						     map HsUnBangedTy ts++
->						 	[HsBangedTy $3]) }
->	| scontype1 satype		{ (fst $1, snd $1 ++ [$2] ) }
-
-> satype :: { HsBangType }
->	: atype				{ HsUnBangedTy $1 }
->	| '!' atype			{ HsBangedTy   $2 }
-
-> sbtype :: { HsBangType }
->	: btype				{ HsUnBangedTy $1 }
->	| '!' atype			{ HsBangedTy   $2 }
-
-> fielddecls :: { [HsFieldDecl] }
->	: fielddecl maybe_docnext ',' maybe_docprev fielddecls
->		{ addFieldDoc $1 $4 : addFieldDocs $5 $2 }
->	| ',' fielddecls		{ $2 }
->	| fielddecl			{ [$1] }
->	| {- empty -}			{ [] }
-
-> fielddecl :: { HsFieldDecl }
->	: maybe_docnext vars '::' stype maybe_docprev
->		{ HsFieldDecl (reverse $2) $4 ($1 `mplus` $5) }
-
-> stype :: { HsBangType }
->	: ctype				{ HsUnBangedTy $1 }	
->	| '!' atype			{ HsBangedTy   $2 }
-
-> deriving :: { [HsQName] }
->	: {- empty -}			{ [] }
->	| 'deriving' qtycls		{ [$2] }
->	| 'deriving' '('          ')'	{ [] }
->	| 'deriving' '(' dclasses ')'	{ reverse $3 }
-
-> dclasses :: { [HsQName] }
->	: dclasses ',' qtycls		{ $3 : $1 }
->       | qtycls			{ [$1] }
-
------------------------------------------------------------------------------
-Class declarations
-
-> fds :: { [HsFunDep] }
-> 	: {- empty -}			{ [] }
-> 	| '|' fds1			{ reverse $2 }
-
-> fds1 :: { [HsFunDep] }
-> 	: fds1 ',' fd			{ $3 : $1 }
-> 	| fd				{ [$1] }
-
-> fd :: { HsFunDep }
-> 	: varids0 '->' varids0		{ (reverse $1, reverse $3) }
-
-> varids0	:: { [HsName] }
-> 	: {- empty -}			{ [] }
->	| varids0 tyvar			{ $2 : $1 }
-
-> optcbody :: { [HsDecl] }
->	: 'where' decllist		{ $2 }
->	| {- empty -}			{ [] }
-
-> dbinds :: { [HsDecl] }
-> 	 : dbinds ';' dbind		{ $3 : $1 }
-> 	 | dbinds ';'			{ $1 }
-> 	 | dbind			{ [$1] }
-> 
-> dbind	:: { HsDecl }
-> dbind	: ipvar '=' srcloc exp		{% checkValDef ($3, HsVar (UnQual $1), HsUnGuardedRhs $4, []) }
-
-> binds	::  { [HsDecl] }
->	: decllist			{ $1 }
->	| '{'            dbinds '}'	{ $2 }
-> 	|     layout_on  dbinds close	{ $2 }
-
-
-> wherebinds :: { [HsDecl] }
->	: 'where' binds			{ $2 }
->	| {- empty -}			{ [] }
-
------------------------------------------------------------------------------
-Instance declarations
-
-> optvaldefs :: { [HsDecl] }
->	: 'where' '{' valdefs '}'		{ $3 }
->	| 'where' layout_on valdefs close	{ $3 }
->	| {- empty -}				{ [] }
-
-> valdefs :: { [HsDecl] }
->	: valdefs ';' valdef			{ $3 : $1 }
->	| valdefs ';'				{ $1 }
->	| valdef				{ [$1] }
->	| {- empty -}				{ [] }
-
------------------------------------------------------------------------------
-Value definitions
-
-> valdef :: { HsDecl }
->	: exp0b srcloc rhs 
->					{% checkValDef ($2, $1, $3, [])}
-
-> rhs	:: { HsRhs }
->	: '=' exp wherebinds		{% checkExpr $2 `thenP` \e ->
->					   returnP (HsUnGuardedRhs e) }
->	| gdrhs	wherebinds		{ HsGuardedRhss  (reverse $1) }
-
-> gdrhs :: { [HsGuardedRhs] }
->	: gdrhs gdrh			{ $2 : $1 }
->	| gdrh				{ [$1] }
-
-> gdrh :: { HsGuardedRhs }
->	: '|' srcloc quals '=' exp	{% checkExpr $5 `thenP` \e ->
->					   returnP (HsGuardedRhs $2 $3 e) }
-
------------------------------------------------------------------------------
-Expressions
-
-Note: The Report specifies a meta-rule for lambda, let and if expressions
-(the exp's that end with a subordinate exp): they extend as far to
-the right as possible.  That means they cannot be followed by a type
-signature or infix application.  To implement this without shift/reduce
-conflicts, we split exp10 into these expressions (exp10a) and the others
-(exp10b).  That also means that only an exp0 ending in an exp10b (an exp0b)
-can followed by a type signature or infix application.  So we duplicate
-the exp0 productions to distinguish these from the others (exp0a).
-
-> exp   :: { HsExp }
->	: exp0b '::' srcloc ctype  	{ HsExpTypeSig $3 $1 $4 }
->	| exp0				{ $1 }
-
-> exp0 :: { HsExp }
->	: exp0a				{ $1 }
->	| exp0b				{ $1 }
-
-> exp0a :: { HsExp }
->	: exp0b qop exp10a		{ HsInfixApp $1 $2 $3 }
->	| exp10a			{ $1 }
-
-> exp0b :: { HsExp }
->	: exp0b qop exp10b		{ HsInfixApp $1 $2 $3 }
->	| exp10b			{ $1 }
-
-> exp10a :: { HsExp }
->	: '\\' aexps '->' exp		{% checkPatterns (reverse $2) `thenP` \ps ->
->					   returnP (HsLambda ps $4) }
->  	| 'let' binds 'in' exp	         { HsLet $2 $4 }
->	| 'if' exp 'then' exp 'else' exp { HsIf $2 $4 $6 }
-
-> exp10b :: { HsExp }
->	: 'case' exp 'of' altslist	{ HsCase $2 $4 }
->	| '-' fexp			{ HsNegApp $2 }
->  	| 'do' stmtlist			{ HsDo $2 }
->	| fexp				{ $1 }
-
-> fexp :: { HsExp }
->	: fexp aexp			{ HsApp $1 $2 }
->  	| aexp				{ $1 }
-
-> aexps :: { [HsExp] }
->	: aexps aexp			{ $2 : $1 }
->  	| aexp				{ [$1] }
-
-UGLY: Because patterns and expressions are mixed, aexp has to be split into
-two rules: One left-recursive and one right-recursive. Otherwise we get two
-reduce/reduce-errors (for as-patterns and irrefutable patters).
-
-Note: The first alternative of aexp is not neccessarily a record update, it
-could be a labeled construction, too.
-
-> aexp	:: { HsExp }
->  	: aexp '{' '}' 			{% mkRecConstrOrUpdate $1 [] }
->  	| aexp '{' fbinds '}' 		{% mkRecConstrOrUpdate $1 (reverse $3) }
->  	| aexp1				{ $1 }
-
-Even though the variable in an as-pattern cannot be qualified, we use
-qvar here to avoid a shift/reduce conflict, and then check it ourselves
-(as for vars above).
-
-Bug: according to the Report, left sections should be (exp0 qop), but
-that would cause a shift/reduce conflict in which shifting would be no
-different from specifying (exp0b qop).  The only consolation is that
-other implementations don't manage this either.
-
-> aexp1	:: { HsExp }
->	: ipvar                         { HsIPVar (UnQual $1) }
->       | qvar				{ HsVar $1 }
->	| gcon				{ HsCon $1 }
->  	| literal			{ $1 }
->	| '(' exp ')'			{ HsParen $2 }
->	| '(' texps ')'			{ HsTuple True  $2 }
->	| '(#' exp '#)'			{ HsTuple False [$2] }
->	| '(#' texps '#)'		{ HsTuple False $2 }
->	| '[' list ']'                  { $2 }
->	| '(' exp0b qop ')'		{ HsLeftSection $3 $2  }
->	| '(' qopm exp0 ')'		{ HsRightSection $3 $2 }
->	| qvar '@' aexp			{% checkUnQual $1 `thenP` \n ->
->					   returnP (HsAsPat n $3) }
->	| '_'				{ HsWildCard }
->	| '~' aexp1			{ HsIrrPat $2 }
-
-> commas :: { Int }
->	: commas ','			{ $1 + 1 }
->	| ','				{ 1 }
-
-> texps :: { [HsExp] }
->	: exp ',' texps			{ $1 : $3 }
->	| exp ',' exp			{ [$1,$3] }
-
------------------------------------------------------------------------------
-List expressions
-
-The rules below are little bit contorted to keep lexps left-recursive while
-avoiding another shift/reduce-conflict.
-
-> list :: { HsExp }
->	: exp				{ HsList [$1] }
->	| lexps 			{ HsList (reverse $1) }
->	| exp '..'			{ HsEnumFrom $1 }
->	| exp ',' exp '..' 		{ HsEnumFromThen $1 $3 }
->	| exp '..' exp	 		{ HsEnumFromTo $1 $3 }
->	| exp ',' exp '..' exp		{ HsEnumFromThenTo $1 $3 $5 }
->	| exp pquals			{ HsListComp $1 (reverse $2) }
-
-> lexps :: { [HsExp] }
->	: lexps ',' exp 		{ $3 : $1 }
->	| exp ',' exp			{ [$3,$1] }
-
------------------------------------------------------------------------------
-List comprehensions
-
-> pquals :: { [HsStmt] }
->	 : pquals1			{ case $1 of
-> 					    [qs] -> qs
-> 					    qss  -> [HsParStmt (concat qss)]
-> 					}
-			
-> pquals1 :: { [[HsStmt]] }
-> 	: pquals1 '|' quals		{ $3 : $1 }
-> 	| '|' quals			{ [$2] }
-
-> quals :: { [HsStmt] }
->	: quals ',' qual		{ $3 : $1 }
->	| qual				{ [$1] }
-
-> qual  :: { HsStmt }
->	: pat '<-' exp			{ HsGenerator $1 $3 }
->	| exp				{ HsQualifier $1 }
->  	| 'let' binds   		{ HsLetStmt $2 }
-
------------------------------------------------------------------------------
-Case alternatives
-
-> altslist :: { [HsAlt] }
->	: '{' alts optsemi '}'			{ reverse $2 }
->	|     layout_on  alts optsemi close	{ reverse $2 }
-
-
-> alts :: { [HsAlt] }
->	: alts ';' alt			{ $3 : $1 }
->	| alt				{ [$1] }
-
-> alt :: { HsAlt }
->	: pat srcloc ralt wherebinds
->				 	{ HsAlt $2 $1 $3 $4 }
-
-> ralt :: { HsGuardedAlts }
->	: '->' exp			{ HsUnGuardedAlt $2 }
->	| gdpats			{ HsGuardedAlts (reverse $1) }
-
-> gdpats :: { [HsGuardedAlt] }
->	: gdpats gdpat			{ $2 : $1 }
->	| gdpat				{ [$1] }
-
-> gdpat	:: { HsGuardedAlt }
->	: '|' srcloc quals '->' exp 	{ HsGuardedAlt $2 $3 $5 }
-
-> pat :: { HsPat }
->	: exp0b				{% checkPattern $1 }
-
------------------------------------------------------------------------------
-Statement sequences
-
-> stmtlist :: { [HsStmt] }
->	  : '{' stmts '}'		{ $2 }
->	  |     layout_on  stmts close	{ $2 }
-
-The last Stmt should be a HsQualifier, but that's hard to enforce here,
-because we need too much lookahead if we see do { e ; }, so it has to
-be checked for later.
-
-> stmts :: { [HsStmt] }
-> 	  : qual stmts1			{ $1 : $2 }
-> 	  | ';' stmts			{ $2 }
-> 	  | {- empty -}			{ [] }
-
-> stmts1 :: { [HsStmt] }
-> 	  : ';' stmts			{ $2 }
-> 	  | {- empty -}			{ [] }
-
------------------------------------------------------------------------------
-Record Field Update/Construction
-
-> fbinds :: { [HsFieldUpdate] }
->	: fbinds ',' fbind		{ $3 : $1 }
->	| fbind				{ [$1] }
-
-> fbind	:: { HsFieldUpdate }
->	: qvar '=' exp			{ HsFieldUpdate $1 $3 }
-
------------------------------------------------------------------------------
-Variables, Constructors and Operators.
-
-> gcon :: { HsQName }
->  	: '(' ')'		{ unit_con_name }
->	| '[' ']'		{ nil_con_name }
->	| '(' commas ')'	{ tuple_con_name $2 }
->  	| qcon			{ $1 }
-
-> var 	:: { HsName }
->	: varid			{ $1 }
->	| '(' varsym ')'	{ $2 }
-
-> qvar 	:: { HsQName }
->	: qvarid		{ $1 }
->	| '(' qvarsym ')'	{ $2 }
-
-> con	:: { HsName }
->	: conid			{ $1 }
->	| '(' consym ')'        { $2 }
-
-> ipvar :: { HsName }
->       : IPVARID               { HsVarName (HsIdent $1) }
-
-> qcon	:: { HsQName }
->	: qconid		{ $1 }
->	| '(' qconsym ')'	{ $2 }
-
-> varop	:: { HsName }
->	: varsym		{ $1 }
->	| '`' varid '`'		{ $2 }
-
-> qvarop :: { HsQName }
->	: qvarsym		{ $1 }
->	| '`' qvarid '`'	{ $2 }
-
-> qvaropm :: { HsQName }
->	: qvarsymm		{ $1 }
->	| '`' qvarid '`'	{ $2 }
-
-> conop :: { HsName }
->	: consym		{ $1 }	
->	| '`' conid '`'		{ $2 }
-
-> qconop :: { HsQName }
->	: qconsym		{ $1 }
->	| '`' qconid '`'	{ $2 }
-
-> op	:: { HsName }
->	: varop			{ $1 }
->	| conop 		{ $1 }
-
-> qop	:: { HsExp }
->	: qvarop		{ HsVar $1 }
->	| qconop		{ HsCon $1 }
-
-> qopm	:: { HsExp }
->	: qvaropm		{ HsVar $1 }
->	| qconop		{ HsCon $1 }
-
-> qvarid :: { HsQName }
->	: varid			{ UnQual $1 }
->	| QVARID		{ Qual (Module (fst $1)) (HsVarName (HsIdent (snd $1))) }
-
-> varid :: { HsName }
->	: 'forall'		{ forall_name }
->	| varid_no_forall	{ $1 }
-
-> varid_no_forall :: { HsName }
->	: VARID			{ HsVarName (HsIdent $1) }
->	| 'as'			{ as_name }
-> 	| 'unsafe'		{ unsafe_name }
->	| 'safe'		{ safe_name }
->	| 'threadsafe'		{ threadsafe_name }
->	| 'qualified'		{ qualified_name }
->	| 'hiding'		{ hiding_name }
->	| 'export'		{ export_name }
->	| 'stdcall'		{ stdcall_name }
->	| 'ccall'		{ ccall_name }
->	| 'dotnet'		{ dotnet_name }
-
-> qconid :: { HsQName }
->	: conid			{ UnQual $1 }
->	| QCONID		{ Qual (Module (fst $1)) (HsVarName (HsIdent (snd $1))) }
-
-> conid :: { HsName }
->	: CONID			{ HsVarName (HsIdent $1) }
-
-> qconsym :: { HsQName }
->	: consym		{ UnQual $1 }
->	| QCONSYM		{ Qual (Module (fst $1)) (HsVarName (HsSymbol (snd $1))) }
-
-> consym :: { HsName }
->	: CONSYM		{ HsVarName (HsSymbol $1) }
-
-> qvarsym :: { HsQName }
->	: varsym		{ UnQual $1 }
->	| qvarsym1		{ $1 }
-
-> qvarsymm :: { HsQName }
->	: varsymm		{ UnQual $1 }
->	| qvarsym1		{ $1 }
-
-> varsym :: { HsName }
->	: VARSYM		{ HsVarName (HsSymbol $1) }
->	| '.'			{ dot_name }
->	| '-'			{ minus_name }
->	| '!'			{ pling_name }
-
-> varsymm :: { HsName } -- varsym not including '-'
->	: VARSYM		{ HsVarName (HsSymbol $1) }
->	| '.'			{ dot_name }
->	| '!'			{ pling_name }
-
-> qvarsym1 :: { HsQName }
->	: QVARSYM		{ Qual (Module (fst $1)) (HsVarName (HsSymbol (snd $1))) }
-
-> literal :: { HsExp }
->	: INT 			{ HsLit (HsInt $1) }
->	| CHAR 			{ HsLit (HsChar $1) }
->	| RATIONAL		{ HsLit (HsFrac (readRational $1)) }
->	| STRING		{ HsLit (HsString $1) }
->	| PRIMINT		{ HsLit (HsIntPrim $1) }
->	| PRIMCHAR		{ HsLit (HsCharPrim $1) }
->	| PRIMFLOAT		{ HsLit (HsFloatPrim (readRational $1)) }
->	| PRIMDOUBLE		{ HsLit (HsDoublePrim (readRational $1)) }
->	| PRIMSTRING		{ HsLit (HsStringPrim $1) }
-
->  srcloc :: { SrcLoc }	:	{% getSrcLoc }
- 
------------------------------------------------------------------------------
-Layout
-
-> close :: { () }
->	: vccurly		{ () } -- context popped in lexer.
->	| error			{% popContext }
-
-> layout_on  :: { () }	:	{% getSrcLoc `thenP` \(SrcLoc r c f) ->
->				   pushContext (Layout c) }
-
------------------------------------------------------------------------------
-Miscellaneous (mostly renamings)
-
-> modid :: { Module }
->	: CONID			{ Module $1 }
->	| QCONID		{ Module (fst $1 ++ '.':snd $1) }
-
-> tyconorcls :: { HsName }
->	: CONID			{ HsTyClsName (HsIdent $1) }
-
-> tycon :: { HsName }
->	: CONID			{ HsTyClsName (HsIdent $1) }
-
-> qtycls :: { HsQName }
->	: CONID			{ UnQual (HsTyClsName (HsIdent $1)) }
->	| QCONID		{ Qual (Module (fst $1)) (HsTyClsName (HsIdent (snd $1))) }
-
-> tyvar :: { HsName }
->	: varid_no_forall	{ $1 }
-
------------------------------------------------------------------------------
-Documentation comments
-
-> docnext :: { Doc }
->	: DOCNEXT	{% case parseParas (tokenise $1) of {
->				Left  err -> parseError err;
->				Right doc -> returnP doc } }
-
-> docprev :: { Doc }
->	: DOCPREV	{% case parseParas (tokenise $1) of {
->				Left  err -> parseError err;
->				Right doc -> returnP doc } }
-
-> docnamed :: { (String,Doc) }
->	: DOCNAMED	{% let (name,rest) = break isSpace $1 in
->			   case parseParas (tokenise rest) of {
->				Left  err -> parseError err;
->				Right doc -> returnP (name,doc) } }
-
-> docsection :: { (Int,Doc) }
-> 	: DOCSECTION	{% case $1 of { DocSection n s -> 
->			   case parseString (tokenise s) of {
->				Left err -> parseError err;
->				Right doc -> returnP (n, doc) } } }
-
-> maybe_docprev :: { Maybe Doc }
-> 	: docprev			{ Just $1 }
->	| {- empty -}			{ Nothing }
-
-> maybe_docnext :: { Maybe Doc }
-> 	: docnext			{ Just $1 }
->	| {- empty -}			{ Nothing }
-
-> moduleheader :: { (ModuleInfo,Maybe Doc) }
->       : DOCNEXT       {% case parseModuleHeader $1 of {
->                          Right (str,info) -> 
->                             case parseParas (tokenise str) of {
->                                Left err -> parseError err;
->                                Right doc -> returnP (info,Just doc);
->                                };
->                          Left err -> parseError err
->                          } }
-
------------------------------------------------------------------------------
-
-> {
-> happyError = parseError "Parse error"
-> }