in reply to Help with tweaking Parse::RecDescent grammar

Ok, finally got it! I'd like to thank (in no particular order) PodMaster, castaway, bart, Abigail-II, merlyn (supersearch++), demerphq, tall_man, and extremely for the help. For the record, PodMaster got my code working, but it was castaway that first spotted the undef problem with $return. Abigail-II hit the nail on the head about the double calc/parsing that i was doing: ICK! ;)

For those interested, here is the revised code in working order. I opted to eval strings during runtime instead of calling anonymous subroutines. The reason is because i need to use the values of particular vars at runtime, not compile time, and eval'ing strings seems to me to be a better fit for that.
use strict; use warnings; use Data::Dumper; use Parse::RecDescent; use vars qw( %item @item $return %symbol %axis %label @code $curr ); @axis{'X','Y','Z'} = (0,0,1); my $file = shift or die "must supply filename"; my $debug = shift; my $data = do {local $/;<DATA>}; my $parser = Parse::RecDescent->new($data); $RD_HINT = 1; #$RD_TRACE = $debug; open FH, $file or die "can't open $file: $!"; $parser->startrule($_) while <FH>; die "ERROR: program does not end with HALT" unless $code[-1] =~ /exit/ +; for ($curr = 0; $curr < @code; $curr++) { my $line = $code[$curr]; if (substr($line,0,4) eq 'GOTO') { my ($new,$true) = (split(':',$line,3))[1,2]; $curr = $new - 1 and next if eval $true; } elsif ($debug) { print STDERR "$line\n"; } die "ERROR: moved while gripper down" if $line =~ /axis{(?:X|Y)/ an +d $axis{Z} == 0; eval $line; die "ERROR: moved X off board" if $axis{X} < 0 or $axis{X} > 32; die "ERROR: moved Y off board" if $axis{Y} < 0 or $axis{Y} > 32; } __DATA__ startrule : opcode | label opcode opcode: YMOVE | XMOVE | DOWN | UP | PRINTLOC | GOTO | IF | SET | ADD | SUB | HALT label: /[a-z]\w*/i { $main::label{$item[1]} = scalar @main::code; } YMOVE: /YMOVE/i int_or_var { push @main::code, '$axis{Y} += ' . $item{int_or_var}; } XMOVE: /XMOVE/i int_or_var { push @main::code, '$axis{X} += ' . $item{int_or_var}; } DOWN: /DOWN/i { push @main::code, '$axis{Z}--'; } UP: /UP/i { push @main::code, '$axis{Z}++'; } PRINTLOC: /PRINTLOC/i { push @main::code, 'print "@{[map $axis{$_},sort keys %axis]}\n"' +; } IF: /IF/i int_or_var relop int_or_var label_name { push @main::code, join(':', 'GOTO', '$label{' . $item{label_name} . '}', "@item[2,3,4]", # ex: "7 <= 8" ); } GOTO: /GOTO/i label_name { push @main::code, join(':', 'GOTO', '$label{' . $item{label_name} . '}', 1, # goto is like if, only always true ); } SET: /SET/i var int_or_var { push @main::code, "$item{var} = $item{int_or_var}"; } ADD: /ADD/i var int_or_var { push @main::code, "$item{var} += $item{int_or_var}"; } SUB: /SUB/i var int_or_var { push @main::code, "$item{var} -= $item{int_or_var}"; } HALT: /HALT/i { push @main::code, 'exit(0)'; } label_name: /[a-z]\w*/i int_or_var: var | int var: /[a-z]\w*/i { $return = '$symbol{' . lc $item[1] . '}'; 1; } int: /-*\d+/ relop: '<' | '>' | '==' | '!=' | '>=' | '<='

And here are some sample input files to test out:


# this is the original, it should output "8 7 0"
   YMOVE 10              # along y-axis
   SET RMOVE 0           # sets RMOVE to 0
L1  ADD RMOVE 1           # adds 1 to RMOVE
   xmove 1               # along x-axis
   IF rmove < 8 L1
   IF 9 < 8 L1
YMOVE -3
   down                  # along z-axis (lower gripper)
   PRINTLOC
HALT

# this one should loop until X moves off of board (32x32 BTW)
label xmove 1
printloc
goto label
halt

# this one errs: can't move gripper while Z is down
down
xmove 1
halt

# another err: code must end with HALT
xmove 1
ymove 1

UPDATE:
Thanks for the bullet-proofing, demerphq. That regular expression for relop is very nice. :)

thanks again :)

jeffa

L-LL-L--L-LL-L--L-LL-L--
-R--R-RR-R--R-RR-R--R-RR
B--B--B--B--B--B--B--B--
H---H---H---H---H---H---
(the triplet paradiddle with high-hat)

Replies are listed 'Best First'.
Re: (jeffa) Re: Help with tweaking Parse::RecDescent grammar
by demerphq (Chancellor) on Feb 11, 2003 at 23:08 UTC
    Hi Jeffa sorry I wasnt able to help out more when we spoke in the cb. I finally had some time this evening and pulled the code off your scratch pad. I havent looked at your latest solution i thought this way would be more educational for both of us. :-)

    I found a couple of issues with the grammar besides the return undef problem. In a couple of cases you wrote the grammar as though it would be handled the same way that yacc would. For instance,

    relop : '<' | '<='
    This is bad because because it will cause 'foo <= 10' to be parsed as 'foo < = 10'. Replacing it by a single regex to match the appropriate options is better here (and faster).

    Another one was the way you handled the label. If the opcode part following a label fails the parse, the label is still assigned. A similar (and very common mistake) occurs in your startrule. Your grammar can match a sentence that starts off valid and then degenerates. Perhaps this is the behaviour you wanted, but im guessing you werent aware. (Incidentally I dont recall that its well documented but the startrule doesnt have to be called that, you can call $parser->any_defined_rule($foo) and have it start parsing from that rule. Which can be useful for debugging a particular rule, but also makes using the parser look a little nicer.)

    If you uncomment the various rules and comment out their complements then youll see the failures occur (you really should trap to see if the parse failed :-). I also cleaned things up a bit. Now a single rule 'identifier' fills in for all the places where label_name and var_name were being used.

    Anyay, interesting stuff, I kinda wonder about some things in it, I dont understand why the variables in if are evaluated at compile time and not run time. Also why there isnt more checking of values in the label and symbol table. Im kinda interested now to review your latest post. :-)

    Cheers, I enjoy hacking around with P::RD. I wish I had more cause to use it in anger. :-)

    Update: Ok I read the latest code, and I like the improvements. You resolved at least a couple of the the issues I mention above. But some are still open and waiting to bite you.

    Goodnight and HTH

    --- demerphq
    my friends call me, usually because I'm late....