#!/usr/bin/perl -w
use strict;
#use Test::More qw(no_plan);
use Test::More tests => 3;
use_ok qw(Parse::Eyapp) or exit;
# use Data::Dumper;
my $translationscheme = q{
%{
# head code is available at tree construction time
# use Data::Dumper;
our %sym; # symbol table
%}
%metatree
%left '='
%left '-' '+'
%left '*' '/'
%%
line: %name EXP
exp <+ ';'> /* Expressions separated by semicolons */
{ $lhs->{n} = [ map { $_->{n}} $_[1]->Children() ]; }
;
exp:
%name PLUS
exp.left '+' exp.right
{ $lhs->{n} = $left->{n} + $right->{n} }
| %name MINUS
exp.left '-' exp.right
{ $lhs->{n} = $left->{n} - $right->{n} }
| %name TIMES
exp.left '*' exp.right
{ $lhs->{n} = $left->{n} * $right->{n} }
| %name DIV
exp.left '/' exp.right
{ $lhs->{n} = $left->{n} / $right->{n} }
| %name NUM $NUM
{ $lhs->{n} = $NUM->{attr} }
| '(' $exp ')' %begin { $exp }
| %name VAR
$VAR
{ $lhs->{n} = $sym{$VAR->{attr}}->{n} }
| %name ASSIGN
$VAR '=' $exp
{ $lhs->{n} = $sym{$VAR->{attr}}->{n} = $exp->{n} }
;
%%
# tail code is available at tree construction time
sub _Error {
my($token)=$_[0]->YYCurval;
my($what)= $token ? "input: '$token'" : "end of input";
die "Syntax error near $what.\n";
}
sub _Lexer {
my($parser)=shift;
for ($parser->YYData->{INPUT}) {
$_ or return('',undef);
s/^\s*//;
s/^([0-9]+(?:\.[0-9]+)?)// and return('NUM',$1);
s/^([A-Za-z][A-Za-z0-9_]*)// and return('VAR',$1);
s/^(.)// and return($1,$1);
s/^\s*//;
}
}
sub Run {
my($self)=shift;
return $self->YYParse( yylex => \&_Lexer, yyerror => \&_Error );
}
}; # end translation scheme
# $Data::Dumper::Indent = 1;
# $Data::Dumper::Terse = 1;
# $Data::Dumper::Deepcopy = 1;
my $p = Parse::Eyapp->new_grammar(
input=>$translationscheme,
classname=>'main',
firstline => 6,
#outputfile => 'main.pm'
);
die $p->Warnings."Solve Ambiguities. See file main.output\n" if $p->Warnings;
my $parser = main->new();
#print "Write a sequence of arithmetic expressions: " if is_interactive();
$parser->YYData->{INPUT} = 'a=2*3; b = 4; c = a+b'; # <>;
my $t = $parser->Run() or die "Syntax Error analyzing input";
$t->translation_scheme;
# my $treestring = Dumper($t);
our %sym;
# my $symboltable = Dumper(\%sym);
my $expected_symbol_table = { 'c' => { 'n' => 10 }, 'a' => { 'n' => 6 }, 'b' => { 'n' => '4' } };
is_deeply(\%sym, $expected_symbol_table, "symbol table");
my $expected_result = [6, 4, 10];
is_deeply($t->{n}, $expected_result);
#print <<"EOR";
#***********Tree*************
#$treestring
#******Symbol table**********
#$symboltable
#************Result**********
#@{$t->{n}}
#
#EOR