Beefy Boxes and Bandwidth Generously Provided by pair Networks
Think about Loose Coupling
 
PerlMonks  

Re^2: Help on Parse::RecDescent!

by tobyink (Abbot)
on Oct 28, 2012 at 18:12 UTC ( #1001285=note: print w/ replies, xml ) Need Help??


in reply to Re: Help on Parse::RecDescent!
in thread Help on Parse::RecDescent!

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'


Comment on Re^2: Help on Parse::RecDescent!
Download Code
Replies are listed 'Best First'.
Re^3: Help on Parse::RecDescent!
by lgn8412 (Initiate) on Nov 05, 2012 at 17:03 UTC
    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: note [id://1001285]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others musing on the Monastery: (6)
As of 2015-08-01 00:09 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    The top three priorities of my open tasks are (in descending order of likelihood to be worked on) ...









    Results (285 votes), past polls