#!/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__