package Parse::Yapp::Parse;
use vars qw ( @ISA );
use strict;
@ISA= qw ( Parse::Yapp::Driver );
use Parse::Yapp::Driver;
require 5.004;
use Carp;
my($input,$lexlevel,@lineno,$nberr,$prec,$labelno);
my($syms,$head,$tail,$token,$term,$nterm,$rules,$precterm,$start,$nullable);
my($expect);
sub new {
my($class)=shift;
ref($class)
and $class=ref($class);
my($self)=$class->SUPER::new( yyversion => '1.05',
yystates =>
[
{ ACTIONS => {
"%%" => -6,
'HEADCODE' => 3,
'UNION' => 2,
'TOKEN' => 5,
'ASSOC' => 7,
'START' => 6,
'error' => 9,
'TYPE' => 10,
"\n" => 11,
'EXPECT' => 13
},
GOTOS => {
'head' => 1,
'decls' => 12,
'yapp' => 4,
'decl' => 14,
'headsec' => 8
}
},
{ ACTIONS => {
'error' => 19,
"%%" => 16,
'IDENT' => 18
},
GOTOS => {
'rules' => 15,
'rulesec' => 20,
'body' => 17
}
},
{ ACTIONS => {
'CODE' => 21
}
},
{ ACTIONS => {
"\n" => 22
}
},
{ ACTIONS => {
'' => 23
}
},
{ ACTIONS => {
"<" => 25
},
DEFAULT => -19,
GOTOS => {
'typedecl' => 24
}
},
{ ACTIONS => {
'IDENT' => 26
},
GOTOS => {
'ident' => 27
}
},
{ ACTIONS => {
"<" => 25
},
DEFAULT => -19,
GOTOS => {
'typedecl' => 28
}
},
{ ACTIONS => {
"%%" => 29
}
},
{ ACTIONS => {
"\n" => 30
}
},
{ ACTIONS => {
"<" => 25
},
DEFAULT => -19,
GOTOS => {
'typedecl' => 31
}
},
{ DEFAULT => -10
},
{ ACTIONS => {
"%%" => -7,
'HEADCODE' => 3,
'UNION' => 2,
'TOKEN' => 5,
'ASSOC' => 7,
'START' => 6,
'error' => 9,
'TYPE' => 10,
"\n" => 11,
'EXPECT' => 13
},
GOTOS => {
'decl' => 32
}
},
{ ACTIONS => {
'NUMBER' => 33
}
},
{ DEFAULT => -9
},
{ DEFAULT => -28
},
{ DEFAULT => -26
},
{ ACTIONS => {
'TAILCODE' => 34
},
DEFAULT => -45,
GOTOS => {
'tail' => 35
}
},
{ ACTIONS => {
":" => 36
}
},
{ ACTIONS => {
";" => 37
}
},
{ ACTIONS => {
'error' => 19,
"%%" => 39,
'IDENT' => 18
},
GOTOS => {
'rules' => 38
}
},
{ ACTIONS => {
"\n" => 40
}
},
{ DEFAULT => -14
},
{ DEFAULT => -0
},
{ ACTIONS => {
'LITERAL' => 41,
'IDENT' => 26
},
GOTOS => {
'symlist' => 43,
'ident' => 44,
'symbol' => 42
}
},
{ ACTIONS => {
'IDENT' => 45
}
},
{ DEFAULT => -4
},
{ ACTIONS => {
"\n" => 46
}
},
{ ACTIONS => {
'LITERAL' => 41,
'IDENT' => 26
},
GOTOS => {
'symlist' => 47,
'ident' => 44,
'symbol' => 42
}
},
{ DEFAULT => -5
},
{ DEFAULT => -18
},
{ ACTIONS => {
'IDENT' => 26
},
GOTOS => {
'ident' => 48,
'identlist' => 49
}
},
{ DEFAULT => -8
},
{ ACTIONS => {
"\n" => 50
}
},
{ DEFAULT => -46
},
{ DEFAULT => -1
},
{ ACTIONS => {
'CODE' => 57,
'LITERAL' => 41,
'IDENT' => 26
},
DEFAULT => -35,
GOTOS => {
'rhselts' => 56,
'rule' => 51,
'code' => 52,
'rhs' => 53,
'ident' => 44,
'rhselt' => 58,
'rhss' => 55,
'symbol' => 54
}
},
{ DEFAULT => -30
},
{ DEFAULT => -27
},
{ DEFAULT => -25
},
{ DEFAULT => -15
},
{ DEFAULT => -2
},
{ DEFAULT => -22
},
{ ACTIONS => {
"\n" => 60,
'LITERAL' => 41,
'IDENT' => 26
},
GOTOS => {
'ident' => 44,
'symbol' => 59
}
},
{ DEFAULT => -3
},
{ ACTIONS => {
">" => 61
}
},
{ DEFAULT => -13
},
{ ACTIONS => {
"\n" => 62,
'LITERAL' => 41,
'IDENT' => 26
},
GOTOS => {
'ident' => 44,
'symbol' => 59
}
},
{ DEFAULT => -24
},
{ ACTIONS => {
"\n" => 63,
'IDENT' => 26
},
GOTOS => {
'ident' => 64
}
},
{ DEFAULT => -17
},
{ DEFAULT => -32
},
{ DEFAULT => -40
},
{ ACTIONS => {
'PREC' => 66
},
DEFAULT => -34,
GOTOS => {
'prec' => 65
}
},
{ DEFAULT => -39
},
{ ACTIONS => {
"|" => 68,
";" => 67
}
},
{ ACTIONS => {
'CODE' => 57,
'LITERAL' => 41,
'IDENT' => 26
},
DEFAULT => -36,
GOTOS => {
'code' => 52,
'ident' => 44,
'rhselt' => 69,
'symbol' => 54
}
},
{ DEFAULT => -44
},
{ DEFAULT => -38
},
{ DEFAULT => -21
},
{ DEFAULT => -11
},
{ DEFAULT => -20
},
{ DEFAULT => -12
},
{ DEFAULT => -16
},
{ DEFAULT => -23
},
{ ACTIONS => {
'CODE' => 57
},
DEFAULT => -42,
GOTOS => {
'code' => 70,
'epscode' => 71
}
},
{ ACTIONS => {
'LITERAL' => 41,
'IDENT' => 26
},
GOTOS => {
'ident' => 44,
'symbol' => 72
}
},
{ DEFAULT => -29
},
{ ACTIONS => {
'CODE' => 57,
'LITERAL' => 41,
'IDENT' => 26
},
DEFAULT => -35,
GOTOS => {
'rhselts' => 56,
'rule' => 73,
'code' => 52,
'rhs' => 53,
'ident' => 44,
'rhselt' => 58,
'symbol' => 54
}
},
{ DEFAULT => -37
},
{ DEFAULT => -43
},
{ DEFAULT => -33
},
{ DEFAULT => -41
},
{ DEFAULT => -31
}
],
yyrules =>
[
[ '$start', 2, undef
],
[ 'yapp', 3, undef
],
[ 'symbol', 1,
sub
{
exists($$syms{$_[1][0]})
or do {
$$syms{$_[1][0]} = $_[1][1];
$$term{$_[1][0]} = undef;
};
$_[1]
}
],
[ 'symbol', 1, undef
],
[ 'ident', 1,
sub
{
exists($$syms{$_[1][0]})
or do {
$$syms{$_[1][0]} = $_[1][1];
$$term{$_[1][0]} = undef;
};
$_[1]
}
],
[ 'head', 2, undef
],
[ 'headsec', 0, undef
],
[ 'headsec', 1, undef
],
[ 'decls', 2, undef
],
[ 'decls', 1, undef
],
[ 'decl', 1, undef
],
[ 'decl', 4,
sub
{
for (@{$_[3]}) {
my($symbol,$lineno)=@$_;
exists($$token{$symbol})
and do {
_SyntaxError(0,
"Token $symbol redefined: ".
"Previously defined line $$syms{$symbol}",
$lineno);
next;
};
$$token{$symbol}=$lineno;
$$term{$symbol} = [ ];
}
undef
}
],
[ 'decl', 4,
sub
{
for (@{$_[3]}) {
my($symbol,$lineno)=@$_;
defined($$term{$symbol}[0])
and do {
_SyntaxError(1,
"Precedence for symbol $symbol redefined: ".
"Previously defined line $$syms{$symbol}",
$lineno);
next;
};
$$token{$symbol}=$lineno;
$$term{$symbol} = [ $_[1][0], $prec ];
}
++$prec;
undef
}
],
[ 'decl', 3,
sub
{ $start=$_[2][0]; undef }
],
[ 'decl', 2,
sub
{ push(@$head,$_[1]); undef }
],
[ 'decl', 3,
sub
{ undef }
],
[ 'decl', 4,
sub
{
for ( @{$_[3]} ) {
my($symbol,$lineno)=@$_;
exists($$nterm{$symbol})
and do {
_SyntaxError(0,
"Non-terminal $symbol redefined: ".
"Previously defined line $$syms{$symbol}",
$lineno);
next;
};
delete($$term{$symbol}); $$nterm{$symbol}=undef; }
}
],
[ 'decl', 3,
sub
{ $expect=$_[2][0]; undef }
],
[ 'decl', 2,
sub
{ $_[0]->YYErrok }
],
[ 'typedecl', 0, undef
],
[ 'typedecl', 3, undef
],
[ 'symlist', 2,
sub
{ push(@{$_[1]},$_[2]); $_[1] }
],
[ 'symlist', 1,
sub
{ [ $_[1] ] }
],
[ 'identlist', 2,
sub
{ push(@{$_[1]},$_[2]); $_[1] }
],
[ 'identlist', 1,
sub
{ [ $_[1] ] }
],
[ 'body', 2,
sub
{
$start
or $start=$$rules[1][0];
ref($$nterm{$start})
or _SyntaxError(2,"Start symbol $start not found ".
"in rules section",$_[2][1]);
$$rules[0]=[ '$start', [ $start, chr(0) ], undef, undef ];
}
],
[ 'body', 1,
sub
{ _SyntaxError(2,"No rules in input grammar",$_[1][1]); }
],
[ 'rulesec', 2, undef
],
[ 'rulesec', 1, undef
],
[ 'rules', 4,
sub
{ _AddRules($_[1],$_[3]); undef }
],
[ 'rules', 2,
sub
{ $_[0]->YYErrok }
],
[ 'rhss', 3,
sub
{ push(@{$_[1]},$_[3]); $_[1] }
],
[ 'rhss', 1,
sub
{ [ $_[1] ] }
],
[ 'rule', 3,
sub
{ push(@{$_[1]}, $_[2], $_[3]); $_[1] }
],
[ 'rule', 1,
sub
{
my($code)=undef;
defined($_[1])
and $_[1][-1][0] eq 'CODE'
and $code = ${pop(@{$_[1]})}[1];
push(@{$_[1]}, undef, $code);
$_[1]
}
],
[ 'rhs', 0, undef
],
[ 'rhs', 1, undef
],
[ 'rhselts', 2,
sub
{ push(@{$_[1]},$_[2]); $_[1] }
],
[ 'rhselts', 1,
sub
{ [ $_[1] ] }
],
[ 'rhselt', 1,
sub
{ [ 'SYMB', $_[1] ] }
],
[ 'rhselt', 1,
sub
{ [ 'CODE', $_[1] ] }
],
[ 'prec', 2,
sub
{
defined($$term{$_[2][0]})
or do {
_SyntaxError(1,"No precedence for symbol $_[2][0]",
$_[2][1]);
return undef;
};
++$$precterm{$_[2][0]};
$$term{$_[2][0]}[1];
}
],
[ 'epscode', 0,
sub
{ undef }
],
[ 'epscode', 1,
sub
{ $_[1] }
],
[ 'code', 1,
sub
{ $_[1] }
],
[ 'tail', 0, undef
],
[ 'tail', 1,
sub
{ $tail=$_[1] }
]
],
@_);
bless($self,$class);
}
sub _Error {
my($value)=$_[0]->YYCurval;
my($what)= $token ? "input: '$$value[0]'" : "end of input";
_SyntaxError(1,"Unexpected $what",$$value[1]);
}
sub _Lexer {
pos($$input) >= length($$input)
and return('',[ undef, -1 ]);
$lexlevel > 1
and do {
my($pos)=pos($$input);
$lineno[0]=$lineno[1];
$lineno[1]=-1;
pos($$input)=length($$input);
return('TAILCODE',[ substr($$input,$pos), $lineno[0] ]);
};
$lexlevel == 0
? $$input=~m{\G((?:
[\t\ ]+ | \ | /\*.*?\*/ )+)}xsgc
: $$input=~m{\G((?:
\s+ | \ | /\*.*?\*/ )+)}xsgc
and do {
my($blanks)=$1;
pos($$input) >= length($$input)
and return('',[ undef, -1 ]);
$lineno[1]+= $blanks=~tr/\n//;
};
$lineno[0]=$lineno[1];
$$input=~/\G([A-Za-z_][A-Za-z0-9_]*)/gc
and return('IDENT',[ $1, $lineno[0] ]);
$$input=~/\G('(?:[^'\\]|\\\\|\\'|\\)+?')/gc
and do {
$1 eq "'error'"
and do {
_SyntaxError(0,"Literal 'error' ".
"will be treated as error token",$lineno[0]);
return('IDENT',[ 'error', $lineno[0] ]);
};
return('LITERAL',[ $1, $lineno[0] ]);
};
$$input=~/\G(%%)/gc
and do {
++$lexlevel;
return($1, [ $1, $lineno[0] ]);
};
$$input=~/\G{/gc
and do {
my($level,$from,$code);
$from=pos($$input);
$level=1;
while($$input=~/([{}])/gc) {
substr($$input,pos($$input)-1,1) eq '\\' and next;
$level += ($1 eq '{' ? 1 : -1)
or last;
}
$level
and _SyntaxError(2,"Unmatched { opened line $lineno[0]",-1);
$code = substr($$input,$from,pos($$input)-$from-1);
$lineno[1]+= $code=~tr/\n//;
return('CODE',[ $code, $lineno[0] ]);
};
if($lexlevel == 0) { $$input=~/\G%(left|right|nonassoc)/gc
and return('ASSOC',[ uc($1), $lineno[0] ]);
$$input=~/\G%(start)/gc
and return('START',[ undef, $lineno[0] ]);
$$input=~/\G%(expect)/gc
and return('EXPECT',[ undef, $lineno[0] ]);
$$input=~/\G%{/gc
and do {
my($code);
$$input=~/\G(.*?)%}/sgc
or _SyntaxError(2,"Unmatched %{ opened line $lineno[0]",-1);
$code=$1;
$lineno[1]+= $code=~tr/\n//;
return('HEADCODE',[ $code, $lineno[0] ]);
};
$$input=~/\G%(token)/gc
and return('TOKEN',[ undef, $lineno[0] ]);
$$input=~/\G%(type)/gc
and return('TYPE',[ undef, $lineno[0] ]);
$$input=~/\G%(union)/gc
and return('UNION',[ undef, $lineno[0] ]);
$$input=~/\G([0-9]+)/gc
and return('NUMBER',[ $1, $lineno[0] ]);
}
else { $$input=~/\G%(prec)/gc
and return('PREC',[ undef, $lineno[0] ]);
}
$$input=~/\G(.)/sg
or die "Parse::Yapp::Grammar::Parse: Match (.) failed: report as a BUG";
$1 eq "\n"
and ++$lineno[1];
( $1 ,[ $1, $lineno[0] ]);
}
sub _SyntaxError {
my($level,$message,$lineno)=@_;
$message= "*".
[ 'Warning', 'Error', 'Fatal' ]->[$level].
"* $message, at ".
($lineno < 0 ? "eof" : "line $lineno").
".\n";
$level > 1
and die $message;
warn $message;
$level > 0
and ++$nberr;
$nberr == 20
and die "*Fatal* Too many errors detected.\n"
}
sub _AddRules {
my($lhs,$lineno)=@{$_[0]};
my($rhss)=$_[1];
ref($$nterm{$lhs})
and do {
_SyntaxError(1,"Non-terminal $lhs redefined: ".
"Previously declared line $$syms{$lhs}",$lineno);
return;
};
ref($$term{$lhs})
and do {
my($where) = exists($$token{$lhs}) ? $$token{$lhs} : $$syms{$lhs};
_SyntaxError(1,"Non-terminal $lhs previously ".
"declared as token line $where",$lineno);
return;
};
ref($$nterm{$lhs}) or do {
$$syms{$lhs}=$lineno; delete($$term{$lhs}); };
$$nterm{$lhs}=[];
my($epsrules)=0;
for my $rhs (@$rhss) {
my($tmprule)=[ $lhs, [ ], splice(@$rhs,-2) ];
@$rhs
or do {
++$$nullable{$lhs};
++$epsrules;
};
for (0..$ my($what,$value)=@{$$rhs[$_]};
$what eq 'CODE'
and do {
my($name)='@'.++$labelno."-$_";
push(@$rules,[ $name, [], undef, $value ]);
push(@{$$tmprule[1]},$name);
next;
};
push(@{$$tmprule[1]},$$value[0]);
}
push(@$rules,$tmprule);
push(@{$$nterm{$lhs}},$ }
$epsrules > 1
and _SyntaxError(0,"More than one empty rule for symbol $lhs",$lineno);
}
sub Parse {
my($self)=shift;
@_ > 0
or croak("No input grammar\n");
my($parsed)={};
$input=\$_[0];
$lexlevel=0;
@lineno=(1,1);
$nberr=0;
$prec=0;
$labelno=0;
$head=();
$tail="";
$syms={};
$token={};
$term={};
$nterm={};
$rules=[ undef ]; $precterm={};
$start="";
$nullable={};
$expect=0;
pos($$input)=0;
$self->YYParse(yylex => \&_Lexer, yyerror => \&_Error);
$nberr
and _SyntaxError(2,"Errors detected: No output",-1);
@$parsed{ 'HEAD', 'TAIL', 'RULES', 'NTERM', 'TERM',
'NULL', 'PREC', 'SYMS', 'START', 'EXPECT' }
= ( $head, $tail, $rules, $nterm, $term,
$nullable, $precterm, $syms, $start, $expect);
undef($input);
undef($lexlevel);
undef(@lineno);
undef($nberr);
undef($prec);
undef($labelno);
undef($head);
undef($tail);
undef($syms);
undef($token);
undef($term);
undef($nterm);
undef($rules);
undef($precterm);
undef($start);
undef($nullable);
undef($expect);
$parsed
}
1;