#!/usr/bin/perl
#####
# from http://www.adp-gmbh.ch/perl/rec_descent.html
###############
use strict;
use warnings;
use diagnostics;

use Parse::RecDescent;

my $grammar = q {
					  { my ($node, %vars);
					    my $counter = 0;
					    sub value { my $self=shift; return $self->{_VALUE_}; }
					  }

start:          statements                { RETURN=  value($item[1]) }				 TRACE

statements:     statement ';' statements  { RETURN=  value($item[3]) }                           TRACE
              | statement                 { RETURN=  value($item[1]) }                           TRACE
					 
statement:      variable '=' statement    { RETURN=  $vars{value($item[1])} = value($item[3]) }  TRACE
              | expression                { RETURN=  value($item[1]) }                           TRACE
					 

expression:     term '+' expression       { RETURN=  value($item[1]) + value($item[3]) }         TRACE
              | term '-' expression       { RETURN=  value($item[1]) - value($item[3]) }         TRACE
              | term			  { RETURN=  value($item[1]) }                           TRACE

term:           factor '*' term           { RETURN=  value($item[1]) * value($item[3]) }
              | factor '/' term           { RETURN=  value($item[1]) / value($item[3]) }
              | factor			  { RETURN=  value($item[1]) }

factor:         number                    { RETURN=  value($item[1]) }
              | variable                  { RETURN=  $vars{value($item[1])} ||= 0 }
              | '+' factor                { RETURN=  value($item[2]) }
              | '-' factor                { RETURN=  -1 * value($item[2]) }
              | '(' statement ')'         { RETURN=  value($item[2]) }

number:         /\d+/                     { TERMINAL }

variable:       /[a-z]+/i		  { TERMINAL }

};

my $terminal   = q{ $return=$node=bless({_VALUE_=>$item[1]}, $item[0]) };
my $return_eq  = q{ $return=$node=bless(\%item,$item[0]); $node->{_ORDER_}=$counter++; $node->{_VALUE_}= };
my $trace      = q{ { print " ($counter)  @item \n" } };

for ($grammar){
  s/RETURN=/$return_eq/g;
  s/TERMINAL/$terminal/g;
  s/TRACE/$trace/g;
}

$::RD_HINT=1;
my $parser = Parse::RecDescent->new($grammar);

my @text = ( # "three=3;six=2*three;eight=three+5;2+eight*six+50",
	     # "x",
	     # "x+1",
	     # "x=0; x+1",
	     "x=0; x=x+1",
	     # "x=0; x=x+1; x",
	     # "x=0; x=x+1; x+1",
	    );


for my $text (@text){
  my $result = $parser->start($text);
  print "Result of '$text' is is " . $result->{_VALUE_} . "\n";
  print "Here's the tree.\n" . tree_to_text($result) . "\n";
}

my $indent_width;
sub tree_to_text {
  my $root = shift;
  $indent_width ||= 3;
  return $root->{__RULE__} . " => " . node_to_text($root, $indent_width);
}
sub node_to_text {
  my ($node, $indent) = @_;
  my $result = '';
  if (ref $node){
    $result .= "{\n";
    for my $key (sort keys %$node){
      next if $key =~ /ACTION|RULE/;
      $result .= " " x $indent . " $key => ". node_to_text($node->{$key}, $indent + $indent_width);
    }
    $result .= " " x $indent . " }\n";
  }
  else {
    $result .= "$node \n";
  }
  return $result;
}

__END__

============================================================================================================

mahoney@cs parse_recdescent$ ./calc_tree.pl 

 (13)  expression term=HASH(0x9cefa18) 0 
 (14)  statement expression=HASH(0x9d640dc) 0 
 (15)  statement variable=HASH(0x9cee134) = statement=HASH(0x9cef700) 0 

 # Looking at "x=x+1" and trying to match "statement; statements" ... which eventually fails.
 # But, along the way it evaluates "statement" ... and increments x !
 (32)  expression term=HASH(0x9cf7698) 1                                         ###
 (33)  expression term=HASH(0x9cf06b4) + expression=HASH(0x9cf7494) 1            ###
 (34)  statement expression=HASH(0x9cef9a0) 1                                    ### not part of final tree
 (35)  statement variable=HASH(0x9cf4d80) = statement=HASH(0x9cef814) 1          ### 

 # Now we're looking at "x=x+1" and trying to match "stament" ... which succeeds.
 (52)  expression term=HASH(0x9cf76d0) 1 
 (53)  expression term=HASH(0x9cf7754) + expression=HASH(0x9cf75a8) 2 
 (54)  statement expression=HASH(0x9cf5038) 2 
 (55)  statement variable=HASH(0x9cf5140) = statement=HASH(0x9cf4da4) 2 

 (56)  statements statement=HASH(0x9cf4bd0) 2 
 (57)  statements statement=HASH(0x9d5b534) ; statements=HASH(0x9cf286c) 2 
 (58)  start statements=HASH(0x9cae858) 2 

Result of 'x=0; x=x+1' is is 2
Here's the tree.
start => {
    _ORDER_ => 57 
    _VALUE_ => 2 
    statements => {
       _ORDER_ => 56 
       _VALUE_ => 2 
       __STRING1__ => ; 
       statement => {
          _ORDER_ => 14 
          _VALUE_ => 0 
          __STRING1__ => = 
          statement => {
             _ORDER_ => 13 
             _VALUE_ => 0 
             expression => {
                _ORDER_ => 12 
                _VALUE_ => 0 
                term => {
                   _ORDER_ => 11 
                   _VALUE_ => 0 
                   factor => {
                      _ORDER_ => 10 
                      _VALUE_ => 0 
                      number => {
                         _VALUE_ => 0 
                         }
                      }
                   }
                }
             }
          variable => {
             _VALUE_ => x 
             }
          }
       statements => {
          _ORDER_ => 55 
          _VALUE_ => 2 
          statement => {
             _ORDER_ => 54 
             _VALUE_ => 2 
             __STRING1__ => = 
             statement => {
                _ORDER_ => 53 
                _VALUE_ => 2 
                expression => {
                   _ORDER_ => 52 
                   _VALUE_ => 2 
                   __STRING1__ => + 
                   expression => {
                      _ORDER_ => 51 
                      _VALUE_ => 1 
                      term => {
                         _ORDER_ => 50 
                         _VALUE_ => 1 
                         factor => {
                            _ORDER_ => 49 
                            _VALUE_ => 1 
                            number => {
                               _VALUE_ => 1 
                               }
                            }
                         }
                      }
                   term => {
                      _ORDER_ => 38 
                      _VALUE_ => 1 
                      factor => {
                         _ORDER_ => 37 
                         _VALUE_ => 1 
                         variable => {
                            _VALUE_ => x 
                            }
                         }
                      }
                   }
                }
             variable => {
                _VALUE_ => x 
                }
             }
          }
       }
    }

mahoney@cs parse_recdescent$ 
