happy-meta-0.1.1: src/Parser.ly

-----------------------------------------------------------------------------
$Id: Parser.ly,v 1.15 2005/01/26 01:10:42 ross Exp $

The parser.

(c) 1993-2000 Andy Gill, Simon Marlow
-----------------------------------------------------------------------------

> {
> {-# OPTIONS_GHC -w #-}
> module Parser (ourParser,AbsSyn) where
> import ParseMonad
> import AbsSyn
> import Lexer
> }

> %name ourParser
> %tokentype { Token }
> %token
>	id		{ TokenInfo $$ TokId }
>	spec_tokentype	{ TokenKW      TokSpecId_TokenType }
>	spec_token	{ TokenKW      TokSpecId_Token }
>	spec_name	{ TokenKW      TokSpecId_Name }
>	spec_partial	{ TokenKW      TokSpecId_Partial }
>	spec_lexer	{ TokenKW      TokSpecId_Lexer }
>	spec_imported_identity	{ TokenKW      TokSpecId_ImportedIdentity }
>	spec_monad	{ TokenKW      TokSpecId_Monad }
>       spec_nonassoc	{ TokenKW      TokSpecId_Nonassoc }
>       spec_left	{ TokenKW      TokSpecId_Left }
>       spec_right	{ TokenKW      TokSpecId_Right }
>       spec_prec	{ TokenKW      TokSpecId_Prec }
>       spec_expect     { TokenKW      TokSpecId_Expect }
>       spec_error      { TokenKW      TokSpecId_Error }
>       spec_attribute  { TokenKW      TokSpecId_Attribute }
>       spec_attributetype      { TokenKW      TokSpecId_Attributetype }
>	code		{ TokenInfo $$ TokCodeQuote }
>       int             { TokenNum $$  TokNum }
>	":"		{ TokenKW      TokColon }
>	";"		{ TokenKW      TokSemiColon }
>	"::"		{ TokenKW      TokDoubleColon }
>	"%%"		{ TokenKW      TokDoublePercent }
>	"|"		{ TokenKW      TokBar }
>	"("		{ TokenKW      TokParenL }
>	")"		{ TokenKW      TokParenR }
>	","		{ TokenKW      TokComma }

> %monad { P }
> %lexer { lexer } { TokenEOF }

> %%

> parser :: { AbsSyn }
>	: optCode tokInfos "%%" rules optCode
>				{ AbsSyn $1 (reverse $2) (reverse $4) $5 }

> rules :: { [Rule] }
> 	: rules rule	{ $2 : $1 }
>	| rule		{ [$1] }

> rule :: { Rule }
> 	: id params "::" code ":" prods         { ($1,$2,$6,Just $4) }
>	| id params "::" code id ":" prods      { ($1,$2,$7,Just $4) }
>  	| id params ":" prods                   { ($1,$2,$4,Nothing) }

> params :: { [String] }
>       : "(" comma_ids ")"             { reverse $2 }
>       | {- empty -}                   { [] }

> comma_ids :: { [String] }
>       : id                            { [$1] }
>       | comma_ids "," id              { $3 : $1 }

> prods :: { [Prod] }
> 	: prod "|" prods		{ $1 : $3 }
>	| prod				{ [$1] }

> prod :: { Prod }
> 	: terms prec code ";"		{% lineP >>= \l -> return ($1,$3,l,$2) }
>	| terms prec code		{% lineP >>= \l -> return ($1,$3,l,$2) }

> term :: { Term }
>       : id                             { App $1 [] }
>       | id "(" comma_terms ")"         { App $1 (reverse $3) }

> terms :: { [Term] }
>       : terms_rev                      { reverse $1 }
>       |                                { [] }

> terms_rev :: { [Term] }
>       : term                           { [$1] }
>       | terms_rev term                 { $2 : $1 }

> comma_terms :: { [Term] }
>       : term                           { [$1] }
>       | comma_terms "," term           { $3 : $1 }

> prec :: { Maybe String }
>       : spec_prec id			{ Just $2 }
>       |            			{ Nothing }

> tokInfos :: { [Directive String] } 
>	: tokInfos tokInfo		{ $2 : $1 }
>	| tokInfo			{ [$1] }

> tokInfo :: { Directive String } 
>	: spec_tokentype code		{ TokenType $2 }
>	| spec_token tokenSpecs		{ TokenSpec $2 }
>	| spec_name id optStart		{ TokenName $2 $3 False }
>	| spec_partial id optStart	{ TokenName $2 $3 True  }
>	| spec_imported_identity	{ TokenImportedIdentity }
>	| spec_lexer code code		{ TokenLexer $2 $3 }
>	| spec_monad code		{ TokenMonad "()" $2 ">>=" "return" }
>	| spec_monad code code		{ TokenMonad $2 $3 ">>=" "return" }
>	| spec_monad code code code	{ TokenMonad "()" $2 $3 $4 }
>	| spec_monad code code code code	{ TokenMonad $2 $3 $4 $5 }
>	| spec_nonassoc ids		{ TokenNonassoc $2 }
>	| spec_right ids		{ TokenRight $2 }
>	| spec_left ids			{ TokenLeft $2 }
>       | spec_expect int               { TokenExpect $2 }
>       | spec_error code               { TokenError $2 }
>       | spec_attributetype code       { TokenAttributetype $2 }
>       | spec_attribute id code        { TokenAttribute $2 $3 }

> optStart :: { Maybe String }
> 	: id				{ Just $1 }
>	| {- nothing -}			{ Nothing }

> tokenSpecs :: { [(String,String)] }
>	: tokenSpec tokenSpecs		{ $1:$2 }
>	| tokenSpec 			{ [$1] }

> tokenSpec :: { (String,String) }
>	: id code			{ ($1,$2) }

> ids 	:: { [String] }
> 	: id ids			{ $1 : $2 }
>	| {- nothing -}			{ [] }

> optCode :: { Maybe String }
>	: code				{ Just $1 }
>	| {- nothing -}			{ Nothing }

> {
> happyError :: P a
> happyError = lineP >>= \l -> fail (show l ++ ": Parse error\n")
> }