The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl -w
# Test YATW s
use strict;
use Parse::Eyapp;
use Parse::Eyapp::Treeregexp;

my $translationscheme = q{
  %token NUM = /([0-9]+(?:\.[0-9]+)?)/
  %token VAR = /([A-Za-z][A-Za-z0-9_]*)/

  %defaultaction  { $lhs->{n} = $_[1]->{n} }
  %metatree

  %left   '-' '+'
  %left   '*' 
  %left   NEG

  %%
  line:       %name EXP  
                exp  
  ;

  exp:    
              %name PLUS  
                exp.left '+'  exp.right 
            { $lhs->{n} .= $left->{n} + $right->{n} }
          |   %name TIMES 
                exp.left '*' exp.right  
            { $lhs->{n} = $left->{n} * $right->{n} }
          |   %name NUM   $NUM          
            { $lhs->{n} = $NUM->{attr} }
          |   '(' $exp ')'  %begin { $exp }       
          |   %name MINUS
          exp.left '-' exp.right    
            { $lhs->{n} = $left->{n} - $right->{n} }

          |   %name UMINUS 
          '-' $exp %prec NEG        
            { $lhs->{n} = -$exp->{n} }
  ;

  %%
}; # end translation scheme

sub is_code {
  my $self = shift; # tree

  # $_[0] is the father, $_[1] the index
  if ((ref($self) eq 'CODE')) {
    splice(@{$_[0]->{children}}, $_[1], 1);
    return 1;
  }
  return 0;
}

Parse::Eyapp->new_grammar(
  input=>$translationscheme,
  classname=>'Calc', 
  firstline =>7,
); 
my $parser = Calc->new();                # Create the parser

$parser->YYPrompt("Give an expression (like -2*3): ");
$parser->slurp_file('', "\n");
print ${$parser->input}; # Set the input

my $t = $parser->YYParse;                # Parse it

exit(1) if $parser->YYNberr > 0;

print $t->str."\n";
my $p = Parse::Eyapp::YATW->new(PATTERN => \&is_code);
$p->s($t);

{ no warnings; # make attr info available only for this display
  local *TERMINAL::info = sub { $_[0]{attr} };
  print $t->str."\n";
}