[haddock @ 2002-04-04 16:23:43 by simonmar]

This is Haddock, my stab at a Haskell documentation tool.  It's not
quite ready for release yet, but I'm putting it in the repository so
others can take a look.

It uses a locally modified version of the hssource parser, extended
with support for GHC extensions and documentation annotations.

1 files changed, 886 insertions, 0 deletions

diff --git a/src/HsParser.ly b/src/HsParser.ly
new file mode 100644
index 00000000..3ccd4b6f
--- /dev/null
+++ b/src/HsParser.ly
@@ -0,0 +1,886 @@
+q-----------------------------------------------------------------------------
+$Id: HsParser.ly,v 1.1 2002/04/04 16:23:43 simonmar Exp $
+
+(c) Simon Marlow, Sven Panne 1997-2000
+
+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 HsSyn
+> import HsParseMonad
+> import HsLexer
+> import HsParseUtils
+> 
+> #ifdef __HUGS__
+> {-
+> #endif
+> import GlaExts
+> #ifdef __HUGS__
+> -}
+> #endif
+> }
+
+-----------------------------------------------------------------------------
+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 $$ }
+>	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 $$ }
+>	DOCGROUP   { DocSection _ _ }
+
+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' modid maybeexports 'where' body
+>		{ HsModule $3 $4 (reverse (fst $6)) (reverse (snd $6)) $1 }
+>	| body
+>		{ HsModule main_mod Nothing (reverse (fst $1)) (reverse (snd $1)) Nothing }
+
+> optdoc :: { Maybe String }
+>	: DOCNEXT					{ Just $1 }
+>	| {- empty -}					{ Nothing }
+
+> body :: { ([HsImportDecl],[HsDecl]) }
+>	:  '{' bodyaux '}'				{ $2 }
+> 	|      layout_on  bodyaux close			{ $2 }
+
+> bodyaux :: { ([HsImportDecl],[HsDecl]) }
+>	: impdecls ';' topdecls optsemi			{ ($1, $3) }
+>	|              topdecls optsemi			{ ([], $1) }
+>	| impdecls              optsemi			{ ($1, []) }
+>	| {- empty -}					{ ([], []) }
+
+> optsemi :: { () }
+>	: ';'						{ () }
+>	| {- empty -}					{ () }
+
+-----------------------------------------------------------------------------
+The Export List
+
+> maybeexports :: { Maybe [HsExportSpec] }
+> 	:  exports				{ Just $1 }
+> 	|  {- empty -}				{ Nothing }
+
+> exports :: { [HsExportSpec] }
+>	: '(' exportlist ')'			{ $2 }
+
+> exportlist :: { [HsExportSpec] }
+>	:  export ',' exportlist		{ $1 : $3 }
+>	|  docgroup exportlist			{ $1 : $2 }
+> 	|  ',' exportlist			{ $2 }
+>	|  export				{ [$1] }
+> 	|  {- empty -}				{ [] }
+
+> docgroup :: { HsExportSpec }
+> 	: DOCGROUP	{ case $1 of { DocSection i s -> HsEGroup i s } }
+
+> export :: { HsExportSpec }
+> 	:  qvar					{ HsEVar $1 }
+> 	|  gtycon				{ HsEAbs $1 }
+> 	|  gtycon '(' '..' ')'			{ HsEThingAll $1 }
+> 	|  gtycon '(' ')'		        { HsEThingWith $1 [] }
+> 	|  gtycon '(' qcnames ')'		{ HsEThingWith $1 (reverse $3) }
+> 	|  'module' modid			{ HsEModuleContents $2 }
+
+> qcnames :: { [HsQName] }
+> 	:  qcnames ',' qcname			{ $3 : $1 }
+> 	|  qcname				{ [$1]  }
+
+> qcname :: { HsQName }
+>	:  qvar					{ $1 }
+> 	|  qcon					{ $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 }
+> 	|  tyconorcls				{ HsIAbs $1 }
+> 	|  tyconorcls '(' '..' ')'		{ HsIThingAll $1 }
+> 	|  tyconorcls '(' ')'		        { HsIThingWith $1 [] }
+> 	|  tyconorcls '(' cnames ')'		{ HsIThingWith $1 (reverse $3) }
+
+> 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
+
+Note: The report allows topdecls to be empty. This would result in another
+shift/reduce-conflict, so we don't handle this case here, but in bodyaux.
+
+> topdecls :: { [HsDecl] }
+>	: topdecls ';' topdecl		{ $3 : $1 }
+>	| topdecl			{ [$1] }
+
+> topdecl :: { HsDecl }
+>	: 'type' simpletype srcloc '=' type	
+>			{ HsTypeDecl $3 (fst $2) (snd $2) $5 }
+>	| 'data' ctype srcloc '=' constrs deriving
+>			{% checkDataHeader $2 `thenP` \(cs,c,t) ->
+>			   returnP (HsDataDecl $3 cs c t (reverse $5) $6) }
+>	| 'newtype' ctype srcloc '=' constr deriving
+>			{% checkDataHeader $2 `thenP` \(cs,c,t) ->
+>			   returnP (HsNewTypeDecl $3 cs c t $5 $6) }
+>	| 'class' srcloc ctype optcbody	
+>			{ HsClassDecl $2 $3 $4 }
+>	| 'instance' srcloc ctype optvaldefs
+>			{ HsInstDecl $2 $3 $4 }
+>	| 'default' srcloc '(' typelist ')'
+>			{ HsDefaultDecl $2 $4 }
+>	| 'foreign' fdecl { $2 }
+>       | decl		{ $1 }
+
+> typelist :: { [HsType] }
+>	: types				{ $1 }
+>	| type				{ [$1] }
+>	| {- empty -}			{ [] }
+
+> decls :: { [HsDecl] }
+>	: decls1 optsemi		{ reverse $1 }
+>	| optsemi 			{ [] }
+
+> decls1 :: { [HsDecl] }
+>	: decls1 ';' decl		{ $3 : $1 }
+>	| decl				{ [$1] }
+
+> decl :: { HsDecl }
+>	: signdecl			{ $1 }
+>	| fixdecl			{ $1 }
+>	| valdef			{ $1 }
+>	| DOCNEXT			{ HsDocCommentNext $1 }
+>	| DOCPREV			{ HsDocCommentPrev $1 }
+>	| DOCGROUP			{ case $1 of { DocSection i s -> 
+>							HsDocGroup i s } }
+
+> decllist :: { [HsDecl] }
+>	: '{' decls '}'			{ $2 }
+>	|     layout_on  decls close	{ $2 }
+
+> signdecl :: { HsDecl }
+>	: vars srcloc '::' ctype	{ HsTypeSig $2 (reverse $1) $4 }
+
+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 }
+> 	| srcloc 'import' callconv fspec
+>	  { case $4 of (spec,nm,ty) -> HsForeignImport $1 $3 HsFISafe spec nm ty }
+> 	| 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 '::' ctype      { ($1, $2, $4) }
+> 	 |        varid '::' ctype      { ("", $1, $3) }
+
+-----------------------------------------------------------------------------
+Types
+
+> type :: { HsType }
+>	: btype '->' type		{ HsTyFun $1 $3 }
+>	| btype				{ $1 }
+
+> btype :: { HsType }
+>	: btype atype			{ HsTyApp $1 $2 }
+>	| atype				{ $1 }
+
+> atype :: { HsType }
+>	: gtycon			{ HsTyCon $1 }
+>	| tyvar				{ HsTyVar $1 }
+>	| '(' types ')'			{ HsTyTuple True  $2 }
+>	| '(#' type '#)'		{ HsTyTuple False [$2] }
+>	| '(#' types '#)'		{ HsTyTuple False $2 }
+>	| '[' type ']'			{ HsTyApp list_tycon $2 }
+>	| '(' ctype ')'			{ $2 }
+
+> gtycon :: { HsQName }
+>	: qtycls			{ $1 }
+>	| '(' ')'			{ unit_tycon_name }
+>	| '(' '->' ')'			{ fun_tycon_name }
+>	| '[' ']'			{ list_tycon_name }
+>	| '(' commas ')'		{ tuple_tycon_name $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 }
+>	| btype '=>' type		{% checkContext $1 `thenP` \c ->
+>					   returnP (mkHsForAllType Nothing c $3) }
+>	| type				{ $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] }
+>	: constrs '|' constr		{ $3 : $1 }
+>	| constr			{ [$1] }
+
+> constr :: { HsConDecl }
+>	: srcloc scontype maybe_doc
+>		{ HsConDecl $1 (fst $2) (snd $2) $3 }
+>	| srcloc sbtype conop sbtype maybe_doc
+>		{ HsConDecl $1 $3 [$2,$4] $5 }
+>	| srcloc con '{' fielddecls '}' maybe_doc
+>		{ HsRecDecl $1 (toTyClsHsName $2) $4 $6 }
+
+> maybe_doc :: { Maybe String }
+> 	: DOCPREV			{ Just $1 }
+>	| {- empty -}			{ Nothing }
+
+> 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 ',' fielddecls	{ $1 : $3 }
+>	| ',' fielddecls		{ $2 }
+>	| fielddecl			{ [$1] }
+>	| {- empty -}			{ [] }
+
+> fielddecl :: { HsFieldDecl }
+>	: vars '::' stype		{ HsFieldDecl (reverse $1) $3 Nothing }
+
+> 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
+
+> optcbody :: { [HsDecl] }
+>	: 'where' decllist			{ $2 }
+>	| {- empty -}				{ [] }
+
+-----------------------------------------------------------------------------
+Instance declarations
+
+> optvaldefs :: { [HsDecl] }
+>	: 'where' '{' valdefs '}'		{ $3 }
+>	| 'where' layout_on valdefs close	{ $3 }
+>	| {- empty -}				{ [] }
+
+> valdefs :: { [HsDecl] }
+> 	: valdefs1 optsemi			{ $1 }
+>	| optsemi				{ [] }
+
+> valdefs1 :: { [HsDecl] }
+>	: valdefs1 ';' valdef			{ $3 : $1 }
+>	| valdef				{ [$1] }
+
+-----------------------------------------------------------------------------
+Value definitions
+
+> valdef :: { HsDecl }
+>	: exp0b srcloc rhs		{% checkValDef ($2, $1, $3, [])}
+>	| exp0b srcloc rhs 'where' decllist
+>					{% checkValDef ($2, $1, $3, $5)}
+
+> rhs	:: { HsRhs }
+>	: '=' exp			{% checkExpr $2 `thenP` \e ->
+>					   returnP (HsUnGuardedRhs e) }
+>	| gdrhs				{ 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' decllist '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 }
+>	: qvar				{ HsVar $1 }
+>	| gcon				{ $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 '|' quals			{ HsListComp $1 (reverse $3) }
+
+> lexps :: { [HsExp] }
+>	: lexps ',' exp 		{ $3 : $1 }
+>	| exp ',' exp			{ [$3,$1] }
+
+-----------------------------------------------------------------------------
+List comprehensions
+
+> quals :: { [HsStmt] }
+>	: quals ',' qual		{ $3 : $1 }
+>	| qual				{ [$1] }
+
+> qual  :: { HsStmt }
+>	: pat '<-' exp			{ HsGenerator $1 $3 }
+>	| exp				{ HsQualifier $1 }
+>  	| 'let' decllist		{ 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		{ HsAlt $2 $1 $3 [] }
+>	| pat srcloc ralt 'where' decllist
+>				 	{ HsAlt $2 $1 $3 $5 }
+
+> 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 :: { HsExp }
+>  	: '(' ')'		{ unit_con }
+>	| '[' ']'		{ HsList [] }
+>	| '(' commas ')'	{ tuple_con $2 }
+>  	| qcon			{ HsCon $1 }
+
+> var 	:: { HsName }
+>	: varid			{ $1 }
+>	| '(' varsym ')'	{ $2 }
+
+> qvar 	:: { HsQName }
+>	: qvarid		{ $1 }
+>	| '(' qvarsym ')'	{ $2 }
+
+> con	:: { HsName }
+>	: conid			{ $1 }
+>	| '(' consym ')'        { $2 }
+
+> 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) ->
+>				   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 }
+
+-----------------------------------------------------------------------------
+
+> {
+> happyError = parseError "Parse error"
+> }