evaluating parsed expressions

[Ted Zlatanov]

I am parsing cfengine class definitions, which have a pretty simple
syntax:

a.(b|!c) means a and ( b or (not c))

The logical true/false value of a class is defined by whether it
exists as a key in the global hash %classes.  I basically should get a
boolean back from eval_tree.

I wanted, however, that P::RD do the evaluation of the expressions for
me as well.  I tried to do in the actions, e.g. "or" would do 
{ $item[1] || $item[3] } but that would not work as the parser would
give up in disgust.  The actions are too tightly integrated with the
parsing to be reused for evaluating, it seems.  Maybe I'm not clear on
the documentation.

I ended up doing the following, which can be seen as either moderately
clever or horribly convolved, depending on your frame of mind and the
number of hours you have gone without sleep trying to finish it.

I used one of the demos to get me started.

The demos and previous P:RD discussions were not enlightening, so I'm
wondering if anyone has better ways to do this sort of
self-evaluation.  I must be missing something fairly obvious.

I have seen Damian's code in
http:[EMAIL PROTECTED]/msg00029.html but
that separates the grammar from the evaluation engine.  I prefer to
have them integrated, as the example below shows.  Jeffrey Franks also
mentioned he might try to use the Class::Visitor module, but after
looking at that module I think the effort of adapting to its API is
hardly worthwhile.

Thanks
Ted

------------------------------------------------------

# local scope for the autoaction, 
{
 local $::RD_AUTOACTION = q{ [ sub{ $_[1]; }, $item[1] ] };
 $parser = new Parse::RecDescent(q{
  input : or

  or : and /\|+/ or { [ sub{ $_[1] || $_[2] }, $item{and}, $item{or} ] }
     | and

  and : unary /\.+/ and { [ sub{ $_[1] && $_[2] }, $item{unary},  $item{and} ] }
      | unary

  unary : not
        | '(' input ')' { [ sub{ $_[1] }, $item{input} ] }
        | atom

  not : '!'/\w+/ { [ sub{
                       my $classes = shift;
                       my $atom = shift;
#                       print "not_atom($atom) ";
                       return !exists $classes->{$atom};
                      }, $item[2] ] }

  atom : /\w+/ { [ sub{
                       my $classes = shift;
                       my $atom = shift;
#                       print "atom($atom) ";
                       return exists $classes->{$atom};
                      }, $item[1] ] }

});
}


# {{{ eval_tree: evaluate nested parse tree
sub eval_tree
{
 my $branch = shift @_;
 my $depth = shift @_ || 0;

 return undef unless defined $branch;
 my $code = shift @$branch;
 return $code unless scalar @$branch;

 foreach my $key (@$branch)
 {
  if (ref $key eq 'ARRAY')
  {
   $key = eval_tree($key, $depth+1);
  }
 }

 return $code->(\%classes, @$branch);
}
# }}}

# example usage
print eval_tree($parser->input("a.b|(c)"));