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. :)
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)
In reply to (jeffa) Re: Help with tweaking Parse::RecDescent grammar
by jeffa
in thread Help with tweaking Parse::RecDescent grammar
by jeffa
| For: | Use: | ||
| & | & | ||
| < | < | ||
| > | > | ||
| [ | [ | ||
| ] | ] |