Kappa's Lair v5

В продолжение к http://friendfeed.com/kkapp/b5d3658c — разбор и вычисление инфиксного арифметического выражения. Потратил несколько часов, и то сошлось только со второго захода. Убил кучу времени на попытки сделать двоичное AST и споткнулся на выражения типа (1 - 2 - 3), где важна ассоциативность слева.

#! /usr/bin/perl
use strict;
use warnings;

use Test::Most;

# expr = sub_expr
#        | sub_expr [+-] expr
# sub_expr = atom
#            | atom [*/] sub_expr
# atom = N
#        | ( expr )
# --->
#[3, +, [ 2, *, 3]]

sub parse_atom {
	if ($_[0] =~ /\G\s*\(/gc) {
		my @val = parse_expr($_[0]);
		$_[0] =~ /\G\s*\)/gc or return undef;
		return ([@val]);
	}

	if ($_[0] =~ /\G\s*([+-]?\d+)/gc) {
		return $1;
	}

	return undef;
}

sub parse_sub_expr {
	my @val = parse_atom($_[0]);

	if ($_[0] =~ /\G\s*([*\/])/gc) {
		push @val, $1;
		push @val, parse_sub_expr($_[0]);
	}

	return @val;
}

sub parse_expr {
	my @val = parse_sub_expr($_[0]);
	if (@val > 1) {
		@val = ([@val]);
	}

	if ($_[0] =~ /\G\s*([+-])/gc) {
		push @val, $1;
		push @val, parse_expr($_[0]);
	}

	return @val;
}

sub parse_calc {
	$_[0] =~ /^/g;
	if (my @val = parse_expr($_[0])) {
		if ($_[0] =~ /\G\s*$/gc) {
			if (@val == 1 && ref $val[0] eq 'ARRAY') {
				return $val[0];
			}
			else {
				return \@val;
			}
		}
	}

	return undef;
}

cmp_deeply(parse_calc('3'), [3]);
cmp_deeply(parse_calc('3 + 2'), [3, '+', 2]);
cmp_deeply(parse_calc('3 - 2 * 1'), [3, '-', [2, '*', 1]]);
cmp_deeply(parse_calc('(3 - 2) / 3'), [[3, '-', 2], '/', 3]);

sub calc { calc_tree(parse_calc($_[0])) }

my %f = (
	'+' => sub { $_[0] + $_[1] },
	'-' => sub { $_[0] - $_[1] },
	'*' => sub { $_[0] * $_[1] },
	'/' => sub { $_[0] / $_[1] },
);

sub calc_tree {
	my $tree = shift;
	unless (ref $tree) {
		return $tree;
	}

	my @rest = @$tree;
	my $head = shift @rest;

	my $rv = calc_tree($head);

	while (@rest >= 2) {
		my ($op, $right) = (shift @rest, shift @rest);
		$rv = $f{$op}->($rv, calc_tree($right));
	}

	return $rv;
}

is(calc('3'), 3);
is(calc('3 + 2'), 5);
is(calc('2 * 2 * 3'), 12);
is(calc('2 * 2 * 2 * 2 * 2'), 32);
is(calc('1+1+1'), 3);
is(calc('4-5+6-7'), -2);
is(calc('100/10*10'), 100);
is(calc('6 / 2 + -1'), 2);
is(calc('(6 + 3) * 2'), 18);
is(calc('((6 + 3) * 2 - 2) / 8'), 2);

done_testing;