Sophie

Sophie

distrib > Fedora > 15 > i386 > by-pkgid > 890cf518b78038a784eb346d2e43e31c > files > 12

perl-ParseLex-2.19-3.fc15.noarch.rpm

#!/usr/bin/perl -w

require 5.004; 
use strict;
use lib "../lib";

package Parse::SymbolicExpressions;
use Parse::Lex;
@Parse::SymbolicExpressions::ISA = qw(Parse::Lex);

sub upto {
  my $self = shift;
  my $upto = shift;
  my $token;
  my @list = ();
  my $current = $self->getToken; # save the current token
  while (($token = $self->next)->type ne $upto) {
    push @list, $token->text;
  }
  $self->setToken($current);
  @list;
}

my %apply = (
	     '+' => sub {
	       my $r;
	       foreach (@_) { $r += $_ }
	       $r;
	     },
	     '-' => sub {
	       my $r;
	       foreach (@_) { $r -= $_ }
	       $r;
	     },
	     '*' => sub {
	       my $r = shift;
	       foreach (@_) {
		 $_ or return 0;
		 $r *= $_
	       }
	       $r;
	     },
	     '/' => sub {
	       my $r = shift;
	       foreach (@_) {
		 $_ or die "illegal division by 0";
		 $r /= $_;
	       }
	       $r;
	     },
	    );

my @token = (
	     'LEFTP' => '[\(]' => sub {
	       my($operator, @operands) = shift->lexer->upto('RIGHTP');
	       &{$apply{$operator}}(@operands);
	     },
	     'RIGHTP' => '[\)]', 
	     'OPERATOR' => '[-+/*]',
	     'NUMBER' =>  '\d+',
	     'ERROR' => '.*' => sub {
	       die qq!can\'t analyze: "$_[1]"\n!;
	     }
	    );

my $lexer = Parse::SymbolicExpressions->new(@token);

my $exp = '(* 2 (+ 3 3))';
$lexer->from($exp);
print "result of $exp: ", $lexer->next->text, "\n";

__END__