The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
%{
use Data::Dumper;
$Data::Dumper::Indent=1;
sub build_node { 
  my $self = shift;

  my @children = @_;
  my @right = $self->YYRightside();
  my $var = $self->YYLhs;
  my $rule = $self->YYRuleindex();

  for(my $i = 0; $i < @right; $i++) {
    $_ = $right[$i];
    if ($self->YYIsterm($_)) {
      $children[$i] = bless { token => $_, attr => $children[$i] },
                                          __PACKAGE__.'::TERMINAL';
    }
  }
  bless { 
          children => \@children, 
	  info => "$var -> @right"
        }, __PACKAGE__."::${var}_$rule" 
}
%}
%right  '='
%left   '-' '+'
%left   '*' '/'
%left   NEG
%defaultaction { build_node(@_) }

%%
input:                 { } 
        |   input line { }
;

line:     '\n'       { } 
        | exp '\n'   { print Dumper($_[1]);  } 
        | error '\n' { $_[0]->YYErrok; }
;

exp:        NUM    
        |   VAR   
        |   VAR '=' exp         
        |   exp '+' exp         
        |   exp '-' exp        
        |   exp '*' exp       
        |   exp '/' exp      
        |   '-' exp %prec NEG 
        |   '(' exp ')'  { $_[2] } /* Let us simplify a bit the tree */
;

%%


sub _Error {
        exists $_[0]->YYData->{ERRMSG}
    and do {
        print $_[0]->YYData->{ERRMSG};
        delete $_[0]->YYData->{ERRMSG};
        return;
    };
    print "Syntax error.\n";
}

sub _Lexer {
    my($parser)=shift;

        $parser->YYData->{INPUT}
    or  $parser->YYData->{INPUT} = <STDIN>
    or  return('',undef);

    $parser->YYData->{INPUT}=~s/^[ \t]//;

    for ($parser->YYData->{INPUT}) {
        s/^([0-9]+(?:\.[0-9]+)?)//
                and return('NUM',$1);
        s/^([A-Za-z][A-Za-z0-9_]*)//
                and return('VAR',$1);
        s/^(.)//s
                and return($1,$1);
    }
}

sub Run {
    my($self)=shift;

    $self->lexer(\&_Lexer);
    $self->error(\&_Error);
    $self->YYParse();
}