views:

149

answers:

2

Hi,

I'm working with the Parse::RecDescent parser in Perl, and I seem to have the most terrible time getting information from it. The information readily available online does not seem to have non-trivial examples.

Here is the code:

event_function: object_list ':' event_list ';'
     <defer:
     {       #item is a special character with Parse::Recdescent.
      print Dumper($item{object_list});
      $return = $item[1];
     }
     >
     | object_list ':' ';'
     <defer:
     { 
      print Dumper($item{object_list});
      $return = $item[1];
     }
     >

Here is the output

PS W:\developers\paulnathan\rd_dir> perl parser.pl testfile
$VAR1 = 4;
$VAR1 = 8;
PS W:\developers\paulnathan\rd_dir>

The input file parses correctly.

stuff, stuff2: pre-operation event = {foo1, foo2};

It should be outputting a hash keyed by "stuff", "stuff2".

Thoughts?

edit:

object_list : 
     object ',' object_list
     <defer:
     {

      my $retval = ();
      $retval = ::merge_hash_refs($item[1], $item[3]);

      $return = $retval;
     }
     >
     | object
     <defer:
     { 
      #print Dumper($item{object});
      $return = $item{object};
     }
     >  

    object : 
     '/' /[a-z0-9_][a-z0-9_]*/ '/' '...'
      <defer:
      {
       $::objects->{$item[2]} = "stuff";
       $return = $::objects;
      }
      >
     |  /[a-z0-9_][a-z0-9_]*/
      <defer:
      { 
       $::objects->{$item[1]} = "stuff";
       $return = $::objects;
      }
      >

edit2: Merge_hash_refs, just in case. :-)

#takes two hash references.
sub merge_hash_refs {
    my($ref1, $ref2) = @_;
    my $retref = ();
    while( my ($k, $v) = each %$ref1 ) {
     $retref->{$k} = $v;
    }
    while( my ($k, $v) = each %$ref2 ) {
     $retref->{$k} = $v;
    }

    return $retref;
}
+5  A: 

If you add a use strict to your script you'll get the fatal error Can't use string ("1") as a HASH ref while "strict refs" in use at [the call to merge_hash_refs]. It appears that the closures created by the <defer> directives are causing the contents of @item to be the ones when the production matched instead of the hashrefs eventually returned by the subrules. Removing the <defer> directives gives me this output:

$VAR1 = {
          'stuff2' => 'stuff',
          'stuff' => 'stuff'
        };

Of course, this has the side effect that $::object is updated by successful object productions even if the higher level rules fail (including backtracking). I'd write it this way:

use strict;
use warnings;
use Parse::RecDescent;
use Data::Dumper;

my $parser = Parse::RecDescent->new(<<'EOT');
event_function: object_list ':' event_list(?) ';'
    {
     $return = $item[1];
    }

object_list : <leftop: object ',' object>
    {
     $return = { map { %$_ } @{$item[1]} };
    }

object : 
    '/' /[a-z0-9_][a-z0-9_]*/ '/' '...'
     {
      $return = { $item[2] => 'stuff' };
     }
    |  /[a-z0-9_][a-z0-9_]*/
     { 
      $return = { $item[1] => 'stuff' };
     }

# stub, don't know what this should be
event_list : /[^;]+/

EOT

my %object;

while (<DATA>) {
    my $x = $parser->event_function($_);

    next unless $x;

    # merge objects into master list
    while (my ($k, $v) = each %$x) {
     $object{$k} = $v;
    }
}

print Dumper \%object;

__DATA__
stuff, stuff2: pre-operation event = {foo1, foo2};
stuff3, stuff4: ;

The output is:

$VAR1 = {
          'stuff2' => 'stuff',
          'stuff3' => 'stuff',
          'stuff' => 'stuff',
          'stuff4' => 'stuff'
        };
Michael Carman
That makes a kind of evil sense. Sigh. Thank you.
Paul Nathan
A: 

Probably not an answer to your question, but when you start an each() loop through a hash, if each() had previously been used on the hash it just starts from wherever the iterator was pointing. To be safe, put a void-context keys() (e.g. keys(%$ref1);) before the while loop to reset the iterator. Older versions of Data::Dumper had a cute little bug of leaving the iterator pointing just after the last element sometimes, making the hash appear to be empty to an unsafe while(...each...) loop :)

ysth
That wasn't the answer, but I'm glad you told me. :-)
Paul Nathan