#!/usr/bin/perl -w
=head1 NAME
bench_optree.pl - Look at different ways of storing data that transform fast.
=cut
use strict;
use Benchmark qw(cmpthese timethese);
use CGI::Ex::Dump qw(debug);
use constant skip_execute => 1;
#my $obj = bless [1, 2], __PACKAGE__;
#my $struct1 = \ [ '-', 1, 2 ];
#my $struct2 = ['-', 1, 2];
#
#sub call { $_[0]->[0] - $_[0]->[1] }
#
#sub obj_meth { $obj->call }
#sub ref_type { if (ref($struct1) eq 'REF') { if (${$struct1}->[0] eq '-') { ${$struct1}->[1] - ${$struct1}->[2] } } }
#
#print "(".obj_meth().")\n";
#print "(".ref_type().")\n";
#cmpthese timethese(-2, {
# obj_meth => \&obj_meth,
# ref_type => \&ref_type,
#}, 'auto');
###----------------------------------------------------------------###
### setup a new way of storing and executing the variable tree
sub get_var2 { ref($_[1]) ? $_[1]->call($_[0]) : $_[1] }
{
package Num;
sub new { my $c = shift; bless \@_, $c };
sub call { $_[0]->[0] }
package A::B;
sub new { my $c = shift; bless \@_, $c }
# sub new { my $c = shift; bless [map{ref$_?$_:Num->new($_)} @_], $c }
package A::B::Minus;
our @ISA = qw(A::B);
sub call { $_[1]->get_var2($_[0]->[0]) - $_[1]->get_var2($_[0]->[1]) }
package A::B::Plus;
our @ISA = qw(A::B);
sub call { $_[1]->get_var2($_[0]->[0]) + $_[1]->get_var2($_[0]->[1]) }
package A::B::Mult;
our @ISA = qw(A::B);
sub call { $_[1]->get_var2($_[0]->[0]) * $_[1]->get_var2($_[0]->[1]) }
package A::B::Div;
our @ISA = qw(A::B);
sub call { $_[1]->get_var2($_[0]->[0]) / $_[1]->get_var2($_[0]->[1]) }
package A::B::Var;
our @ISA = qw(A::B);
use vars qw($HASH_OPS $LIST_OPS $SCALAR_OPS $FILTER_OPS $OP_FUNC);
BEGIN {
$HASH_OPS = $CGI::Ex::Template::HASH_OPS;
$LIST_OPS = $CGI::Ex::Template::LIST_OPS;
$SCALAR_OPS = $CGI::Ex::Template::SCALAR_OPS;
$FILTER_OPS = $CGI::Ex::Template::FILTER_OPS;
$OP_FUNC = $CGI::Ex::Template::OP_FUNC;
}
use constant trace => 0;
sub call {
my $var = shift;
my $self = shift;
my $ARGS = shift || {};
my $i = 0;
my $generated_list;
### determine the top level of this particular variable access
my $ref = $var->[$i++];
my $args = $var->[$i++];
warn "get_variable: begin \"$ref\"\n" if trace;
if (defined $ref) {
if ($ARGS->{'is_namespace_during_compile'}) {
$ref = $self->{'NAMESPACE'}->{$ref};
} else {
return if $ref =~ /^[_.]/; # don't allow vars that begin with _
$ref = $self->{'_vars'}->{$ref};
}
}
my %seen_filters;
while (defined $ref) {
### check at each point if the returned thing was a code
if (UNIVERSAL::isa($ref, 'CODE')) {
my @results = $ref->($args ? @{ $self->vivify_args($args) } : ());
if (defined $results[0]) {
$ref = ($#results > 0) ? \@results : $results[0];
} elsif (defined $results[1]) {
die $results[1]; # TT behavior - why not just throw ?
} else {
$ref = undef;
last;
}
}
### descend one chained level
last if $i >= $#$var;
my $was_dot_call = $ARGS->{'no_dots'} ? 1 : $var->[$i++] eq '.';
my $name = $var->[$i++];
my $args = $var->[$i++];
warn "get_variable: nested \"$name\"\n" if trace;
### allow for named portions of a variable name (foo.$name.bar)
if (ref $name) {
$name = $name->call($self);
if (! defined($name) || $name =~ /^[_.]/) {
$ref = undef;
last;
}
}
if ($name =~ /^_/) { # don't allow vars that begin with _
$ref = undef;
last;
}
### allow for scalar and filter access (this happens for every non virtual method call)
if (! ref $ref) {
if ($SCALAR_OPS->{$name}) { # normal scalar op
$ref = $SCALAR_OPS->{$name}->($ref, $args ? @{ $self->vivify_args($args) } : ());
} elsif ($LIST_OPS->{$name}) { # auto-promote to list and use list op
$ref = $LIST_OPS->{$name}->([$ref], $args ? @{ $self->vivify_args($args) } : ());
} elsif (my $filter = $self->{'FILTERS'}->{$name} # filter configured in Template args
|| $FILTER_OPS->{$name} # predefined filters in CET
|| (UNIVERSAL::isa($name, 'CODE') && $name) # looks like a filter sub passed in the stash
|| $self->list_filters->{$name}) { # filter defined in Template::Filters
if (UNIVERSAL::isa($filter, 'CODE')) {
$ref = eval { $filter->($ref) }; # non-dynamic filter - no args
if (my $err = $@) {
$self->throw('filter', $err) if ref($err) !~ /Template::Exception$/;
die $err;
}
} elsif (! UNIVERSAL::isa($filter, 'ARRAY')) {
$self->throw('filter', "invalid FILTER entry for '$name' (not a CODE ref)");
} elsif (@$filter == 2 && UNIVERSAL::isa($filter->[0], 'CODE')) { # these are the TT style filters
eval {
my $sub = $filter->[0];
if ($filter->[1]) { # it is a "dynamic filter" that will return a sub
($sub, my $err) = $sub->($self->context, $args ? @{ $self->vivify_args($args) } : ());
if (! $sub && $err) {
$self->throw('filter', $err) if ref($err) !~ /Template::Exception$/;
die $err;
} elsif (! UNIVERSAL::isa($sub, 'CODE')) {
$self->throw('filter', "invalid FILTER for '$name' (not a CODE ref)")
if ref($sub) !~ /Template::Exception$/;
die $sub;
}
}
$ref = $sub->($ref);
};
if (my $err = $@) {
$self->throw('filter', $err) if ref($err) !~ /Template::Exception$/;
die $err;
}
} else { # this looks like our vmethods turned into "filters" (a filter stored under a name)
$self->throw('filter', 'Recursive filter alias \"$name\"') if $seen_filters{$name} ++;
$var = [$name, 0, '|', @$filter, @{$var}[$i..$#$var]]; # splice the filter into our current tree
$i = 2;
}
if (scalar keys %seen_filters
&& $seen_filters{$var->[$i - 5] || ''}) {
$self->throw('filter', "invalid FILTER entry for '".$var->[$i - 5]."' (not a CODE ref)");
}
} else {
$ref = undef;
}
} else {
### method calls on objects
if (UNIVERSAL::can($ref, 'can')) {
my @args = $args ? @{ $self->vivify_args($args) } : ();
my @results = eval { $ref->$name(@args) };
if ($@) {
die $@ if ref $@ || $@ !~ /Can\'t locate object method/;
} elsif (defined $results[0]) {
$ref = ($#results > 0) ? \@results : $results[0];
next;
} elsif (defined $results[1]) {
die $results[1]; # TT behavior - why not just throw ?
} else {
$ref = undef;
last;
}
# didn't find a method by that name - so fail down to hash and array access
}
### hash member access
if (UNIVERSAL::isa($ref, 'HASH')) {
if ($was_dot_call && exists($ref->{$name}) ) {
$ref = $ref->{$name};
} elsif ($HASH_OPS->{$name}) {
$ref = $HASH_OPS->{$name}->($ref, $args ? @{ $self->vivify_args($args) } : ());
} elsif ($ARGS->{'is_namespace_during_compile'}) {
return $var; # abort - can't fold namespace variable
} else {
$ref = undef;
}
### array access
} elsif (UNIVERSAL::isa($ref, 'ARRAY')) {
if ($name =~ /^\d+$/) {
$ref = ($name > $#$ref) ? undef : $ref->[$name];
} else {
$ref = (! $LIST_OPS->{$name}) ? undef : $LIST_OPS->{$name}->($ref, $args ? @{ $self->vivify_args($args) } : ());
}
}
}
} # end of while
### allow for undefinedness
if (! defined $ref) {
if ($self->{'_debug_undef'}) {
my $chunk = $var->[$i - 2];
$chunk = $chunk->call($self) if ref $chunk;
die "$chunk is undefined\n";
} else {
$ref = $self->undefined_any($var);
}
}
### allow for special behavior for the '..' operator
if ($generated_list && $ARGS->{'list_context'} && ref($ref) eq 'ARRAY') {
return @$ref;
}
return $ref;
}
};
sub plus ($$) { A::B::Plus->new( @_) }
sub minus ($$) { A::B::Minus->new(@_) }
sub mult ($$) { A::B::Mult->new( @_) }
sub div ($$) { A::B::Div->new( @_) }
sub var { A::B::Var->new( @_) };
$INC{'A/B.pm'} = 1;
$INC{'A/B/Plus.pm'} = 1;
$INC{'A/B/Minus.pm'} = 1;
$INC{'A/B/Mult.pm'} = 1;
$INC{'A/B/Div.pm'} = 1;
$INC{'A/B/Var.pm'} = 1;
###----------------------------------------------------------------###
### now benchmark the different variable storage methods
my $vars = {
foo => {bar => {baz => [qw(a b c)]}},
bing => 'bang',
};
my $self = bless {'_vars' => $vars}, __PACKAGE__;
#pauls@pslaptop:~/perl/CGI-Ex/lib$ perl -e 'my $a = "1 + 2 * (3 + (4 / 5) * 9) - 20";
# use CGI::Ex::Template;
# use Data::Dumper;
# print Dumper(CGI::Ex::Template->new->parse_variable(\$a));'
###----------------------------------------------------------------###
my $Y0 = '$self->{_vars}->{bing}';
my $Y1 = [ 'bing', 0 ];
my $Y2 = var('bing', 0);
debug $Y2;
### are they all the same
print eval($Y0)."\n";
print $self->get_variable($Y1)."\n";
print $self->get_var2($Y2)."\n";
if (! skip_execute) {
cmpthese timethese (-2, {
perl => sub { eval $Y0 },
bare_data => sub { $self->get_variable($Y1) },
method_call => sub { $self->get_var2($Y2) },
}, 'auto');
}
###----------------------------------------------------------------###
my $Z0 = '$self->{_vars}->{foo}->{bar}->{baz}->[1]';
my $Z1 = [ 'foo', 0, '.', 'bar', 0, '.', 'baz', 0, '.', 1, 0];
my $Z2 = var('foo', 0, '.', 'bar', 0, '.', 'baz', 0, '.', 1, 0);
debug $Z2;
### are they all the same
print eval($Z0)."\n";
print $self->get_variable($Z1)."\n";
print $self->get_var2($Z2)."\n";
if (! skip_execute) {
cmpthese timethese (-2, {
perl => sub { eval $Z0 },
bare_data => sub { $self->get_variable($Z1) },
method_call => sub { $self->get_var2($Z2) },
}, 'auto');
}
###----------------------------------------------------------------###
### $A0 = perl, $A1 = old optree, $A2 = new optree
my $A0 = "1 + 2 * (3 + (4 / 5) * 9) - 20";
my $A1 = [ \[ '-', [ \[ '+', '1', [ \[ '*', '2', [ \[ '+', '3', [ \[ '*', [ \[ '/', '4', '5' ], 0 ], '9' ], 0 ] ], 0 ] ], 0 ] ], 0 ], '20' ], 0 ];
my $A2 = minus(plus(1, mult(2, plus(3, mult(div(4,5), 9)))), 20);
debug $A2;
### are they all the same
print eval($A0)."\n";
print $self->get_variable($A1)."\n";
print $self->get_var2($A2)."\n";
if (! skip_execute) {
cmpthese timethese (-2, {
perl => sub { eval $A0 },
bare_data => sub { $self->get_variable($A1) },
method_call => sub { $self->get_var2($A2) },
}, 'auto');
}
###----------------------------------------------------------------###
my $B0 = "1 + 2";
my $B1 = [ \[ '+', 1, 2] ];
my $B2 = plus(1, 2);
debug $B2;
### are they all the same
print eval($B0)."\n";
print $self->get_variable($B1)."\n";
print $self->get_var2($B2)."\n";
if (! skip_execute) {
cmpthese timethese (-2, {
perl => sub { eval $B0 },
bare_data => sub { $self->get_variable($B1) },
method_call => sub { $self->get_var2($B2) },
}, 'auto');
}
###----------------------------------------------------------------###
### Test (de)serialization speed
use Storable;
my $d1 = Storable::freeze($A1);
my $d2 = Storable::freeze($A2);
Storable::thaw($d1); # load lib
print length($d1)."\n";
print length($d2)."\n";
cmpthese timethese (-2, {
freeze_bare => sub { Storable::freeze($A1) },
freeze_meth => sub { Storable::freeze($A2) },
}, 'auto');
cmpthese timethese (-2, {
thaw_bare => sub { Storable::thaw($d1) },
thaw_meth => sub { Storable::thaw($d2) },
}, 'auto');
###----------------------------------------------------------------###
### create libraries similar to those from CGI::Ex::Template 1.201
use CGI::Ex::Template;
use vars qw($HASH_OPS $LIST_OPS $SCALAR_OPS $FILTER_OPS $OP_FUNC);
BEGIN {
$HASH_OPS = $CGI::Ex::Template::HASH_OPS;
$LIST_OPS = $CGI::Ex::Template::LIST_OPS;
$SCALAR_OPS = $CGI::Ex::Template::SCALAR_OPS;
$FILTER_OPS = $CGI::Ex::Template::FILTER_OPS;
$OP_FUNC = $CGI::Ex::Template::OP_FUNC;
}
use constant trace => 0;
sub get_variable {
### allow for the parse tree to store literals
return $_[1] if ! ref $_[1];
my $self = shift;
my $var = shift;
my $ARGS = shift || {};
my $i = 0;
my $generated_list;
### determine the top level of this particular variable access
my $ref = $var->[$i++];
my $args = $var->[$i++];
warn "get_variable: begin \"$ref\"\n" if trace;
if (ref $ref) {
if (ref($ref) eq 'SCALAR') { # a scalar literal
$ref = $$ref;
} elsif (ref($ref) eq 'REF') { # operator
return $self->play_operator($$ref) if ${ $ref }->[0] eq '\\'; # return the closure
$generated_list = 1 if ${ $ref }->[0] eq '..';
$ref = $self->play_operator($$ref);
} else { # a named variable access (ie via $name.foo)
$ref = $self->get_variable($ref);
if (defined $ref) {
return if $ref =~ /^[_.]/; # don't allow vars that begin with _
$ref = $self->{'_vars'}->{$ref};
}
}
} elsif (defined $ref) {
if ($ARGS->{'is_namespace_during_compile'}) {
$ref = $self->{'NAMESPACE'}->{$ref};
} else {
return if $ref =~ /^[_.]/; # don't allow vars that begin with _
$ref = $self->{'_vars'}->{$ref};
}
}
my %seen_filters;
while (defined $ref) {
### check at each point if the returned thing was a code
if (UNIVERSAL::isa($ref, 'CODE')) {
my @results = $ref->($args ? @{ $self->vivify_args($args) } : ());
if (defined $results[0]) {
$ref = ($#results > 0) ? \@results : $results[0];
} elsif (defined $results[1]) {
die $results[1]; # TT behavior - why not just throw ?
} else {
$ref = undef;
last;
}
}
### descend one chained level
last if $i >= $#$var;
my $was_dot_call = $ARGS->{'no_dots'} ? 1 : $var->[$i++] eq '.';
my $name = $var->[$i++];
my $args = $var->[$i++];
warn "get_variable: nested \"$name\"\n" if trace;
### allow for named portions of a variable name (foo.$name.bar)
if (ref $name) {
if (ref($name) eq 'ARRAY') {
$name = $self->get_variable($name);
if (! defined($name) || $name =~ /^[_.]/) {
$ref = undef;
last;
}
} else {
die "Shouldn't get a ". ref($name) ." during a vivify on chain";
}
}
if ($name =~ /^_/) { # don't allow vars that begin with _
$ref = undef;
last;
}
### allow for scalar and filter access (this happens for every non virtual method call)
if (! ref $ref) {
if ($SCALAR_OPS->{$name}) { # normal scalar op
$ref = $SCALAR_OPS->{$name}->($ref, $args ? @{ $self->vivify_args($args) } : ());
} elsif ($LIST_OPS->{$name}) { # auto-promote to list and use list op
$ref = $LIST_OPS->{$name}->([$ref], $args ? @{ $self->vivify_args($args) } : ());
} elsif (my $filter = $self->{'FILTERS'}->{$name} # filter configured in Template args
|| $FILTER_OPS->{$name} # predefined filters in CET
|| (UNIVERSAL::isa($name, 'CODE') && $name) # looks like a filter sub passed in the stash
|| $self->list_filters->{$name}) { # filter defined in Template::Filters
if (UNIVERSAL::isa($filter, 'CODE')) {
$ref = eval { $filter->($ref) }; # non-dynamic filter - no args
if (my $err = $@) {
$self->throw('filter', $err) if ref($err) !~ /Template::Exception$/;
die $err;
}
} elsif (! UNIVERSAL::isa($filter, 'ARRAY')) {
$self->throw('filter', "invalid FILTER entry for '$name' (not a CODE ref)");
} elsif (@$filter == 2 && UNIVERSAL::isa($filter->[0], 'CODE')) { # these are the TT style filters
eval {
my $sub = $filter->[0];
if ($filter->[1]) { # it is a "dynamic filter" that will return a sub
($sub, my $err) = $sub->($self->context, $args ? @{ $self->vivify_args($args) } : ());
if (! $sub && $err) {
$self->throw('filter', $err) if ref($err) !~ /Template::Exception$/;
die $err;
} elsif (! UNIVERSAL::isa($sub, 'CODE')) {
$self->throw('filter', "invalid FILTER for '$name' (not a CODE ref)")
if ref($sub) !~ /Template::Exception$/;
die $sub;
}
}
$ref = $sub->($ref);
};
if (my $err = $@) {
$self->throw('filter', $err) if ref($err) !~ /Template::Exception$/;
die $err;
}
} else { # this looks like our vmethods turned into "filters" (a filter stored under a name)
$self->throw('filter', 'Recursive filter alias \"$name\"') if $seen_filters{$name} ++;
$var = [$name, 0, '|', @$filter, @{$var}[$i..$#$var]]; # splice the filter into our current tree
$i = 2;
}
if (scalar keys %seen_filters
&& $seen_filters{$var->[$i - 5] || ''}) {
$self->throw('filter', "invalid FILTER entry for '".$var->[$i - 5]."' (not a CODE ref)");
}
} else {
$ref = undef;
}
} else {
### method calls on objects
if (UNIVERSAL::can($ref, 'can')) {
my @args = $args ? @{ $self->vivify_args($args) } : ();
my @results = eval { $ref->$name(@args) };
if ($@) {
die $@ if ref $@ || $@ !~ /Can\'t locate object method/;
} elsif (defined $results[0]) {
$ref = ($#results > 0) ? \@results : $results[0];
next;
} elsif (defined $results[1]) {
die $results[1]; # TT behavior - why not just throw ?
} else {
$ref = undef;
last;
}
# didn't find a method by that name - so fail down to hash and array access
}
### hash member access
if (UNIVERSAL::isa($ref, 'HASH')) {
if ($was_dot_call && exists($ref->{$name}) ) {
$ref = $ref->{$name};
} elsif ($HASH_OPS->{$name}) {
$ref = $HASH_OPS->{$name}->($ref, $args ? @{ $self->vivify_args($args) } : ());
} elsif ($ARGS->{'is_namespace_during_compile'}) {
return $var; # abort - can't fold namespace variable
} else {
$ref = undef;
}
### array access
} elsif (UNIVERSAL::isa($ref, 'ARRAY')) {
if ($name =~ /^\d+$/) {
$ref = ($name > $#$ref) ? undef : $ref->[$name];
} else {
$ref = (! $LIST_OPS->{$name}) ? undef : $LIST_OPS->{$name}->($ref, $args ? @{ $self->vivify_args($args) } : ());
}
}
}
} # end of while
### allow for undefinedness
if (! defined $ref) {
if ($self->{'_debug_undef'}) {
my $chunk = $var->[$i - 2];
$chunk = $self->get_variable($chunk) if ref($chunk) eq 'ARRAY';
die "$chunk is undefined\n";
} else {
$ref = $self->undefined_any($var);
}
}
### allow for special behavior for the '..' operator
if ($generated_list && $ARGS->{'list_context'} && ref($ref) eq 'ARRAY') {
return @$ref;
}
return $ref;
}
sub vivify_args {
my $self = shift;
my $vars = shift;
my $args = shift || {};
return [map {$self->get_variable($_, $args)} @$vars];
}
sub play_operator {
my $self = shift;
my $tree = shift;
my $ARGS = shift || {};
my $op = $tree->[0];
$tree = [@$tree[1..$#$tree]];
### allow for operator function override
if (exists $OP_FUNC->{$op}) {
return $OP_FUNC->{$op}->($self, $op, $tree, $ARGS);
}
### do constructors and short-circuitable operators
if ($op eq '~' || $op eq '_') {
return join "", grep {defined} @{ $self->vivify_args($tree) };
} elsif ($op eq 'arrayref') {
return $self->vivify_args($tree, {list_context => 1});
} elsif ($op eq 'hashref') {
my $args = $self->vivify_args($tree);
push @$args, undef if ! ($#$args % 2);
return {@$args};
} elsif ($op eq '?') {
if ($self->get_variable($tree->[0])) {
return defined($tree->[1]) ? $self->get_variable($tree->[1]) : undef;
} else {
return defined($tree->[2]) ? $self->get_variable($tree->[2]) : undef;
}
} elsif ($op eq '||' || $op eq 'or' || $op eq 'OR') {
for my $node (@$tree) {
my $var = $self->get_variable($node);
return $var if $var;
}
return '';
} elsif ($op eq '&&' || $op eq 'and' || $op eq 'AND') {
my $var;
for my $node (@$tree) {
$var = $self->get_variable($node);
return 0 if ! $var;
}
return $var;
} elsif ($op eq '!') {
my $var = ! $self->get_variable($tree->[0]);
return defined($var) ? $var : '';
}
### equality operators
local $^W = 0;
my $n = $self->get_variable($tree->[0]);
$tree = [@$tree[1..$#$tree]];
if ($op eq '==') { for (@$tree) { $_ = $self->get_variable($_); return '' if ! ($n eq $_) }; return 1 }
elsif ($op eq '!=') { for (@$tree) { $_ = $self->get_variable($_); return '' if ! ($n ne $_) }; return 1 }
elsif ($op eq 'eq') { for (@$tree) { $_ = $self->get_variable($_); return '' if ! ($n eq $_) }; return 1 }
elsif ($op eq 'ne') { for (@$tree) { $_ = $self->get_variable($_); return '' if ! ($n ne $_) }; return 1 }
elsif ($op eq '<') { for (@$tree) { $_ = $self->get_variable($_); return '' if ! ($n < $_); $n = $_ }; return 1 }
elsif ($op eq '>') { for (@$tree) { $_ = $self->get_variable($_); return '' if ! ($n > $_); $n = $_ }; return 1 }
elsif ($op eq '<=') { for (@$tree) { $_ = $self->get_variable($_); return '' if ! ($n <= $_); $n = $_ }; return 1 }
elsif ($op eq '>=') { for (@$tree) { $_ = $self->get_variable($_); return '' if ! ($n >= $_); $n = $_ }; return 1 }
elsif ($op eq 'lt') { for (@$tree) { $_ = $self->get_variable($_); return '' if ! ($n lt $_); $n = $_ }; return 1 }
elsif ($op eq 'gt') { for (@$tree) { $_ = $self->get_variable($_); return '' if ! ($n gt $_); $n = $_ }; return 1 }
elsif ($op eq 'le') { for (@$tree) { $_ = $self->get_variable($_); return '' if ! ($n le $_); $n = $_ }; return 1 }
elsif ($op eq 'ge') { for (@$tree) { $_ = $self->get_variable($_); return '' if ! ($n ge $_); $n = $_ }; return 1 }
### numeric operators
my $args = $self->vivify_args($tree);
if (! @$args) {
if ($op eq '-') { return - $n }
$self->throw('operator', "Not enough args for operator \"$op\"");
}
if ($op eq '..') { return [($n || 0) .. ($args->[-1] || 0)] }
elsif ($op eq '+') { $n += $_ for @$args; return $n }
elsif ($op eq '-') { $n -= $_ for @$args; return $n }
elsif ($op eq '*') { $n *= $_ for @$args; return $n }
elsif ($op eq '/') { $n /= $_ for @$args; return $n }
elsif ($op eq 'div'
|| $op eq 'DIV') { $n = int($n / $_) for @$args; return $n }
elsif ($op eq '%'
|| $op eq 'mod'
|| $op eq 'MOD') { $n %= $_ for @$args; return $n }
elsif ($op eq '**'
|| $op eq 'pow') { $n **= $_ for @$args; return $n }
$self->throw('operator', "Un-implemented operation $op");
}