#!/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 error $::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{expression} } 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");