Beefy Boxes and Bandwidth Generously Provided by pair Networks DiBona
The stupid question is the question not asked
 
PerlMonks  

Help on Parse::RecDescent!

by lgn8412 (Initiate)
on Oct 28, 2012 at 05:41 UTC ( #1001246=perlquestion: print w/ replies, xml ) Need Help??
lgn8412 has asked for the wisdom of the Perl Monks concerning the following question:

Hi! I'm seeking some wisdom on using the Parse::RecDescent module, I'm currently making an interpreter and I want it to be able to read parentheses, here's what I have so far:

#!/usr/bin/perl -w use strict; use Parse::RecDescent; use Data::Dumper; use vars qw(%VARIABLE); # Enable warnings within the Parse::RecDescent module. $::RD_ERRORS = 1; # Make sure the parser dies when it encounters an e +rror $::RD_WARN = 1; # Enable warnings. This will warn on unused rules & +c. $::RD_HINT = 1; # Give out hints to help fix problems. # $::RD_TRACE = 1; # Trace the whole thing my $grammar = <<'_EOGRAMMAR_'; # Terminals (macros that can't expand further) # startrule: instruction(s /;/) eofile instruction : print_instruction | assign_instruction print_instruction : /print/i expression { print $item{expression}."\n" } assign_instruction : VARIABLE "=" expression { $main::VARIABLE{$item{VARIABLE}} = $item{expre +ssion} } expression : '(' expression ')' { return $item[2] } | INTEGER OP expression { return main::expression(@item) } | STRING '+' expression { return main::concat(@item) } | VARIABLE OP expression { return main::expression(@item) } | INTEGER | VARIABLE { return $main::VARIABLE{$item{VARIABLE}} } | STRING OP : m([-+*/%]) # Mathematical operators INTEGER : /[+-]?[0-9]*\.?[0-9]+/ # Signed integers VARIABLE : /\w[a-z0-9_]*/i # Variable STRING : /'.*?'/ eofile : /^\Z/ _EOGRAMMAR_ sub expression { shift; my ($lhs,$op,$rhs) = @_; $lhs = $VARIABLE{$lhs} if $lhs=~/[^-+(\.)0-9]/; return eval "$lhs $op $rhs"; } sub concat { shift; my ($lhs,$op,$rhs) = @_; $lhs =~ s/^'(.*)'$/$1/; $rhs =~ s/^'(.*)'$/$1/; return "$lhs$rhs" } my $parser = Parse::RecDescent->new($grammar); #print "a=2\n"; $parser->startrule("a= 'hola ' + 3.2 ") +; #print "b=1+2.2\n"; $parser->startrule("b=1+2.2"); #print "print a\n"; $parser->startrule("print a"); #print "print b\n"; $parser->startrule("print b"); print "print 2+2/4\n"; $parser->startrule("print 2+2/4"); #print "print 2+-2/4\n"; $parser->startrule("print 2+-2/4"); #print "a = 5 ; print a\n"; $parser->startrule("a = 5 ; print a");

As you can see, I used an example on the recdescent module (which I found here http://bit.ly/Sjgdhf) and basically added strings and some other functions, as I have it now I really don't know if I have to change drastically the grammar in order to be able to read parentheses and nested parentheses.. I'd really appreciate some help on this, I've been busting my head with the trace option but have not been successful so far, any ideas??

Comment on Help on Parse::RecDescent!
Download Code
Re: Help on Parse::RecDescent!
by tobyink (Abbot) on Oct 28, 2012 at 16:32 UTC

    Rather than attempting to evaluate your mini-scripting language on the fly, you'll probably get more mileage out of compiling it into an abstract syntax tree, which can be evaluated.

    Here's a quick example of building an AST from Parse::RecDescent. The AST is decorated with evaluate methods allowing the script to be executed, and also to_perl and to_javascript methods allowing the script to be automatically translated to a Perl and Javascript.

    perl -E'sub Monkey::do{say$_,for@_,do{($monkey=[caller(0)]->[3])=~s{::}{ }and$monkey}}"Monkey say"->Monkey::do'

      I've just released a newer version of MooX::Struct which makes it a little prettier...

      #!/usr/bin/perl -w use strict; use Parse::RecDescent; my @STACK; use MooX::Struct 0.007 -retain, Program => [ qw( @instructions ), evaluate => sub { my $self = shift; my $result; foreach my $instruction (@{ $self->instructions }) { $result = $instruction->evaluate; } return $result; }, to_perl => sub { my $self = shift; join "\n", map { sprintf('%s;', $_->to_perl) } @{ $self->i +nstructions }; }, to_javascript => sub { my $self = shift; join "\n", map { sprintf('%s;', $_->to_javascript) } @{ $s +elf->instructions }; }, ], PrintStatement => [ qw( $expression ), evaluate => sub { my $self = shift; print STDOUT $self->expression->evaluate, "\n"; }, to_perl => sub { my $self = shift; sprintf('print STDOUT %s, "\n"', $self->expression->to_per +l); }, to_javascript => sub { my $self = shift; sprintf('window.alert(%s)', $self->expression->to_javascri +pt); }, ], Assignment => [ qw( $variable $expression ), evaluate => sub { my $self = shift; $self->variable->evaluate = $self->expression->evaluate; }, to_perl => sub { my $self = shift; sprintf('%s = %s', $self->variable->to_perl, $self->expres +sion->to_perl); }, to_javascript => sub { my $self = shift; sprintf('%s = %s', $self->variable->to_javascript, $self-> +expression->to_javascript); }, ], Expression => [ qw( $lhs $op $rhs ), evaluate => sub { my $self = shift; my $op = $self->op; my $sub = eval qq{ sub { \$_[0] $op \$_[1] } }; $sub->($self->lhs->evaluate, $self->rhs->evaluate); }, to_perl => sub { my $self = shift; sprintf('(%s %s %s)', $self->lhs->to_perl, $self->op, $sel +f->rhs->to_perl); }, to_javascript => sub { my $self = shift; my $op = $self->op; $op = '+' if $op eq '.'; sprintf('(%s %s %s)', $self->lhs->to_javascript, $op, $sel +f->rhs->to_javascript); }, ], Literal => [ qw( $value ), evaluate => sub { $_[0]->value }, ], Integer => [ -extends => ['Literal'], to_perl => sub { my $self = shift; sprintf('%s', $self->value); }, to_javascript => sub { my $self = shift; sprintf('%s', $self->value); }, ], String => [ -extends => ['Literal'], to_perl => sub { my $self = shift; sprintf("'%s'", $self->value); }, to_javascript => sub { my $self = shift; sprintf("'%s'", $self->value); }, ], Variable => [ qw( $name ), evaluate => sub :lvalue { $STACK[-1]{ $_[0]->name } }, to_perl => sub { my $self = shift; sprintf('$%s', $self->name); }, to_javascript => sub { my $self = shift; sprintf('%s', $self->name); }, ], ; $::RD_ERRORS = 1; # Make sure the parser dies when it encounters an er +ror $::RD_WARN = 1; # Enable warnings. This will warn on unused rules &c +. $::RD_HINT = 1; # Give out hints to help fix problems. # $::RD_TRACE = 1; # Trace the whole thing my $parser = Parse::RecDescent->new(<<'_EOGRAMMAR_'); # Terminals (macros that can't expand further) # startrule : instruction(s /;/) { main::Program[ $item[1] ] } instruction : print_instruction { $item[1] } | assign_instruction { $item[1] } | expression { $item[1] } print_instruction : /print/i expression { main::PrintStatement[ $item{expression} ] } assign_instruction : VARIABLE "=" expression { main::Assignment[ $item{VARIABLE}, $item{expressi +on} ] } expression : STRING '+' expression { main::Expression[ $item{STRING}, '.', $item{expression} ] + } | term OP expression { main::Expression[ $item{term}, $item{OP}, $item{expressio +n} ] } | term { $item[1] } term: '(' expression ')' { $item[2] } | INTEGER | STRING | VARIABLE OP : m([*/%+-]) INTEGER : /[+-]?[0-9]*\.?[0-9]+/ # Signed integers { main::Integer[ $item[1] ] } VARIABLE : /\w[a-z0-9_]*/i # Variable { main::Variable[ $item[1] ] } STRING : /'.*?'/ { my $s = $item[0]; $s =~ s/^'(.*)'$/$1/; main::String[ $s ] +} _EOGRAMMAR_ my $parsed = $parser->startrule(<<'SCRIPT'); x = (2+3)/(2*(7+3)); print x; print 'Hello World'; SCRIPT @STACK = {}; print $parsed->to_perl, "\n---\n"; print $parsed->to_javascript, "\n---\n"; $parsed->evaluate;
      perl -E'sub Monkey::do{say$_,for@_,do{($monkey=[caller(0)]->[3])=~s{::}{ }and$monkey}}"Monkey say"->Monkey::do'
        Thanks for all your help, I traced the problem and found out that I wasn't using the $return variable properly as it was said on the Parse::RecDescent docs, a word of advice for all, use at all times $return, not return only!

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://1001246]
Approved by davido
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others making s'mores by the fire in the courtyard of the Monastery: (13)
As of 2014-04-24 12:49 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    April first is:







    Results (565 votes), past polls