Initial Commit
This commit is contained in:
Riley Schneider
703
database/perl/vendor/lib/Imager/Expr.pm
vendored
Normal file
703
database/perl/vendor/lib/Imager/Expr.pm
vendored
Normal file
@@ -0,0 +1,703 @@
|
||||
package Imager::Expr;
|
||||
use 5.006;
|
||||
use Imager::Regops;
|
||||
use strict;
|
||||
|
||||
our $VERSION = "1.008";
|
||||
|
||||
my %expr_types;
|
||||
|
||||
my $error;
|
||||
|
||||
sub error {
|
||||
shift if UNIVERSAL::isa($_[0], 'Imager::Expr');
|
||||
if (@_) {
|
||||
$error = "@_";
|
||||
}
|
||||
else {
|
||||
return $error;
|
||||
}
|
||||
}
|
||||
|
||||
# what else?
|
||||
my %default_constants =
|
||||
(
|
||||
# too many digits, better than too few
|
||||
pi=>3.14159265358979323846264338327950288419716939937510582097494
|
||||
);
|
||||
|
||||
sub new {
|
||||
my ($class, $opts) = @_;
|
||||
|
||||
# possibly this is a very bad idea
|
||||
my ($type) = grep exists $expr_types{$_}, keys %$opts;
|
||||
die "Imager::Expr: No known expression type"
|
||||
if !defined $type;
|
||||
my $self = bless {}, $expr_types{$type};
|
||||
$self->{variables} = [ @{$opts->{variables}} ];
|
||||
$self->{constants} = { %default_constants, %{$opts->{constants} || {}} };
|
||||
$self->{ops} = $self->compile($opts->{$type}, $opts)
|
||||
or return;
|
||||
$self->optimize()
|
||||
or return;
|
||||
$self->{code} = $self->assemble()
|
||||
or return;
|
||||
$self;
|
||||
}
|
||||
|
||||
sub register_type {
|
||||
my ($pack, $name) = @_;
|
||||
$expr_types{$name} = $pack;
|
||||
}
|
||||
|
||||
sub type_registered {
|
||||
my ($class, $name) = @_;
|
||||
|
||||
$expr_types{$name};
|
||||
}
|
||||
|
||||
sub _variables {
|
||||
return @{$_[0]->{variables}};
|
||||
}
|
||||
|
||||
sub code {
|
||||
return $_[0]->{code};
|
||||
}
|
||||
|
||||
sub nregs {
|
||||
return $_[0]->{nregs};
|
||||
}
|
||||
|
||||
sub cregs {
|
||||
return $_[0]->{cregs};
|
||||
}
|
||||
|
||||
my $numre = '[+-]?(?:\d+\.?\d*|\.\d+)(?:[eE][+-]?\d+)?';
|
||||
|
||||
sub numre {
|
||||
$numre;
|
||||
}
|
||||
|
||||
# optimize the code
|
||||
sub optimize {
|
||||
my ($self) = @_;
|
||||
|
||||
my @ops = @{$self->{ops}};
|
||||
|
||||
# this function cannot current handle code with jumps
|
||||
return 1 if grep $_->[0] =~ /^jump/, @ops;
|
||||
|
||||
# optimization - common sub-expression elimination
|
||||
# it's possible to fold this into the code generation - but it will wait
|
||||
|
||||
my $max_opr = $Imager::Regops::MaxOperands;
|
||||
my $attr = \%Imager::Regops::Attr;
|
||||
my $foundops = 1;
|
||||
while ($foundops) {
|
||||
$foundops = 0;
|
||||
my %seen;
|
||||
my $index;
|
||||
my @out;
|
||||
while (@ops) {
|
||||
my $op = shift @ops;
|
||||
my $desc = join(",", @{$op}[0..$max_opr]);
|
||||
if ($seen{$desc}) {
|
||||
push(@out, @ops);
|
||||
my $old = $op->[-1];
|
||||
my $new = $seen{$desc};
|
||||
for $op (@out) {
|
||||
for my $reg (@{$op}[1..$max_opr]) {
|
||||
$reg = $new if $reg eq $old;
|
||||
}
|
||||
}
|
||||
$foundops=1;
|
||||
last;
|
||||
}
|
||||
$seen{$desc} = $op->[-1];
|
||||
push(@out, $op);
|
||||
}
|
||||
@ops = @out;
|
||||
}
|
||||
# strength reduction
|
||||
for my $op (@ops) {
|
||||
# reduce division by a constant to multiplication by a constant
|
||||
if ($op->[0] eq 'div' && $op->[2] =~ /^r(\d+)/
|
||||
&& defined($self->{"nregs"}[$1])) {
|
||||
my $newreg = @{$self->{"nregs"}};
|
||||
push(@{$self->{"nregs"}}, 1.0/$self->{"nregs"}[$1]);
|
||||
$op->[0] = 'mult';
|
||||
$op->[2] = 'r'.$newreg;
|
||||
}
|
||||
}
|
||||
$self->{ops} = \@ops;
|
||||
1;
|
||||
}
|
||||
|
||||
sub assemble {
|
||||
my ($self) = @_;
|
||||
my $attr = \%Imager::Regops::Attr;
|
||||
my $max_opr = $Imager::Regops::MaxOperands;
|
||||
my @ops = @{$self->{ops}};
|
||||
for my $op (@ops) {
|
||||
$op->[0] = $attr->{$op->[0]}{opcode};
|
||||
for (@{$op}[1..$max_opr+1]) { s/^[rpj]// }
|
||||
}
|
||||
my $pack = $Imager::Regops::PackCode x (2+$Imager::Regops::MaxOperands);
|
||||
|
||||
return join("", ,map { pack($pack, @$_, ) } @ops);
|
||||
}
|
||||
|
||||
# converts stack code to register code
|
||||
sub stack_to_reg {
|
||||
my ($self, @st_ops) = @_;
|
||||
my @regstack;
|
||||
my %nregs;
|
||||
my @vars = $self->_variables();
|
||||
my @nregs = (0) x scalar(@vars);
|
||||
my @cregs;
|
||||
my $attr = \%Imager::Regops::Attr;
|
||||
my %vars;
|
||||
my %names;
|
||||
my $max_opr = $Imager::Regops::MaxOperands;
|
||||
@vars{@vars} = map { "r$_" } 0..$#vars;
|
||||
|
||||
my @ops;
|
||||
for (@st_ops) {
|
||||
if (/^$numre$/) {
|
||||
# combining constants makes the optimization below work
|
||||
if (exists $nregs{$_}) {
|
||||
push(@regstack, $nregs{$_});
|
||||
}
|
||||
else {
|
||||
$nregs{$_} = "r".@nregs;
|
||||
push(@regstack,"r".@nregs);
|
||||
push(@nregs, $_);
|
||||
}
|
||||
}
|
||||
elsif (exists $vars{$_}) {
|
||||
push(@regstack, $vars{$_});
|
||||
}
|
||||
elsif (exists $attr->{$_} && length $attr->{$_}{types}) {
|
||||
if (@regstack < $attr->{$_}{parms}) {
|
||||
error("Imager::transform2: stack underflow on $_");
|
||||
return;
|
||||
}
|
||||
my @parms = splice(@regstack, -$attr->{$_}{parms});
|
||||
my $types = join("", map {substr($_,0,1)} @parms);
|
||||
if ($types ne $attr->{$_}{types}) {
|
||||
if (exists $attr->{$_.'p'} && $types eq $attr->{$_.'p'}{types}) {
|
||||
$_ .= 'p';
|
||||
}
|
||||
else {
|
||||
error("Imager::transform2: Call to $_ with incorrect types");
|
||||
return;
|
||||
}
|
||||
}
|
||||
my $result;
|
||||
if ($attr->{$_}{result} eq 'r') {
|
||||
$result = "r".@nregs;
|
||||
push(@nregs, undef);
|
||||
}
|
||||
else {
|
||||
$result = "p".@cregs;
|
||||
push(@cregs, -1);
|
||||
}
|
||||
push(@regstack, $result);
|
||||
push(@parms, "0") while @parms < $max_opr;
|
||||
push(@ops, [ $_, @parms, $result ]);
|
||||
#print "$result <- $_ @parms\n";
|
||||
}
|
||||
elsif (/^!(\w+)$/) {
|
||||
if (!@regstack) {
|
||||
error("Imager::transform2: stack underflow with $_");
|
||||
return;
|
||||
}
|
||||
$names{$1} = pop(@regstack);
|
||||
}
|
||||
elsif (/^\@(\w+)$/) {
|
||||
if (exists $names{$1}) {
|
||||
push(@regstack, $names{$1});
|
||||
}
|
||||
else {
|
||||
error("Imager::Expr: unknown storage \@$1");
|
||||
return;
|
||||
}
|
||||
}
|
||||
else {
|
||||
error("Imager::Expr: unknown operator $_");
|
||||
return;
|
||||
}
|
||||
}
|
||||
if (@regstack != 1) {
|
||||
error("stack must have only one item at end");
|
||||
return;
|
||||
}
|
||||
if ($regstack[0] !~ /^p/) {
|
||||
error("you must have a color value at the top of the stack at end");
|
||||
return;
|
||||
}
|
||||
push(@ops, [ "ret", $regstack[0], (-1) x $max_opr ]);
|
||||
|
||||
$self->{"nregs"} = \@nregs;
|
||||
$self->{"cregs"} = \@cregs;
|
||||
|
||||
return \@ops;
|
||||
}
|
||||
|
||||
sub dumpops {
|
||||
my $result = '';
|
||||
for my $op (@{$_[0]->{ops}}) {
|
||||
$result .= "@{$op}\n";
|
||||
}
|
||||
$result;
|
||||
}
|
||||
|
||||
# unassembles the compiled code
|
||||
sub dumpcode {
|
||||
my ($self) = @_;
|
||||
my $code = $self->{"code"};
|
||||
my $attr = \%Imager::Regops::Attr;
|
||||
my @code = unpack("${Imager::Regops::PackCode}*", $code);
|
||||
my %names = map { $attr->{$_}{opcode}, $_ } keys %Imager::Regops::Attr;
|
||||
my @vars = $self->_variables();
|
||||
my $result = '';
|
||||
my $index = 0;
|
||||
while (my @op = splice(@code, 0, 2+$Imager::Regops::MaxOperands)) {
|
||||
my $opcode = shift @op;
|
||||
my $name = $names{$opcode};
|
||||
if ($name) {
|
||||
$result .= "j$index: $name($opcode)";
|
||||
my @types = split //, $attr->{$name}{types};
|
||||
for my $parm (@types) {
|
||||
my $reg = shift @op;
|
||||
$result .= " $parm$reg";
|
||||
if ($parm eq 'r') {
|
||||
if ($reg < @vars) {
|
||||
$result.= "($vars[$reg])";
|
||||
}
|
||||
elsif (defined $self->{"nregs"}[$reg]) {
|
||||
$result .= "($self->{\"nregs\"}[$reg])";
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
$result .= " -> $attr->{$name}{result}$op[-1]"
|
||||
if $attr->{$name}{result};
|
||||
$result .= "\n";
|
||||
}
|
||||
else {
|
||||
$result .= "unknown($opcode) @op\n";
|
||||
}
|
||||
++$index;
|
||||
}
|
||||
|
||||
$result;
|
||||
}
|
||||
|
||||
package Imager::Expr::Postfix;
|
||||
our @ISA = qw(Imager::Expr);
|
||||
|
||||
Imager::Expr::Postfix->register_type('rpnexpr');
|
||||
|
||||
my %op_names = ( '+'=>'add', '-'=>'subtract', '*'=>'mult', '/' => 'div',
|
||||
'%'=>'mod', '**'=>'pow' );
|
||||
|
||||
sub compile {
|
||||
my ($self, $expr, $opts) = @_;
|
||||
|
||||
$expr =~ s/#.*//; # remove comments
|
||||
my @st_ops = split ' ', $expr;
|
||||
|
||||
for (@st_ops) {
|
||||
$_ = $op_names{$_} if exists $op_names{$_};
|
||||
$_ = $self->{constants}{$_} if exists $self->{constants}{$_};
|
||||
}
|
||||
return $self->stack_to_reg(@st_ops);
|
||||
}
|
||||
|
||||
package Imager::Expr::Infix;
|
||||
|
||||
our @ISA = qw(Imager::Expr);
|
||||
use Imager::Regops qw(%Attr $MaxOperands);
|
||||
|
||||
{
|
||||
local @INC = @INC;
|
||||
pop @INC if $INC[-1] eq '.';
|
||||
eval "use Parse::RecDescent;";
|
||||
__PACKAGE__->register_type('expr') if !$@;
|
||||
}
|
||||
|
||||
# I really prefer bottom-up parsers
|
||||
my $grammar = <<'GRAMMAR';
|
||||
|
||||
code : assigns 'return' expr
|
||||
{ $return = [ @item[1,3] ] }
|
||||
|
||||
assigns : assign(s?) { $return = [ @{$item[1]} ] }
|
||||
|
||||
assign : identifier '=' expr ';'
|
||||
{ $return = [ @item[1,3] ] }
|
||||
|
||||
expr : relation
|
||||
|
||||
relation : addition (relstuff)(s?)
|
||||
{
|
||||
$return = $item[1];
|
||||
for my $op(@{$item[2]}) { $return = [ $op->[0], $return, $op->[1] ] }
|
||||
1;
|
||||
}
|
||||
|
||||
relstuff : relop addition { $return = [ @item[1,2] ] }
|
||||
|
||||
relop : '<=' { $return = 'le' }
|
||||
| '<' { $return = 'lt' }
|
||||
| '==' { $return = 'eq' }
|
||||
| '>=' { $return = 'ge' }
|
||||
| '>' { $return = 'gt' }
|
||||
| '!=' { $return = 'ne' }
|
||||
|
||||
addition : multiply (addstuff)(s?)
|
||||
{
|
||||
$return = $item[1];
|
||||
# for my $op(@{$item[2]}) { $return .= " @{$op}[1,0]"; }
|
||||
for my $op(@{$item[2]}) { $return = [ $op->[0], $return, $op->[1] ] }
|
||||
1;
|
||||
}
|
||||
addstuff : addop multiply { $return = [ @item[1,2] ] }
|
||||
addop : '+' { $return = 'add' }
|
||||
| '-' { $return = 'subtract' }
|
||||
|
||||
multiply : power mulstuff(s?)
|
||||
{ $return = $item[1];
|
||||
# for my $op(@{$item[2]}) { $return .= " @{$op}[1,0]"; }
|
||||
for my $op(@{$item[2]}) { $return = [ $op->[0], $return, $op->[1] ] }
|
||||
1;
|
||||
}
|
||||
|
||||
mulstuff : mulop power { $return = [ @item[1,2] ] }
|
||||
mulop : '*' { $return = 'mult' }
|
||||
| '/' { $return = 'div' }
|
||||
| '%' { $return = 'mod' }
|
||||
|
||||
power : powstuff(s?) atom
|
||||
{
|
||||
$return = $item[2];
|
||||
for my $op(reverse @{$item[1]}) { $return = [ @{$op}[1,0], $return ] }
|
||||
1;
|
||||
}
|
||||
| atom
|
||||
powstuff : atom powop { $return = [ @item[1,2] ] }
|
||||
powop : '**' { $return = 'pow' }
|
||||
|
||||
atom: '(' expr ')' { $return = $item[2] }
|
||||
| '-' atom { $return = [ uminus=>$item[2] ] }
|
||||
| number
|
||||
| funccall
|
||||
| identifier
|
||||
|
||||
number : /[+-]?(?:\d+\.?\d*|\.\d+)(?:[eE][+-]?\d+)?/
|
||||
|
||||
exprlist : expr ',' exprlist { $return = [ $item[1], @{$item[3]} ] }
|
||||
| expr { $return = [ $item[1] ] }
|
||||
|
||||
funccall : identifier '(' exprlist ')'
|
||||
{ $return = [ $item[1], @{$item[3]} ] }
|
||||
|
||||
identifier : /[^\W\d]\w*/ { $return = $item[1] }
|
||||
|
||||
GRAMMAR
|
||||
|
||||
my $parser;
|
||||
|
||||
sub init_parser {
|
||||
if (!$parser) {
|
||||
$parser = Parse::RecDescent->new($grammar);
|
||||
}
|
||||
}
|
||||
|
||||
sub compile {
|
||||
my ($self, $expr, $opts) = @_;
|
||||
if (!$parser) {
|
||||
$parser = Parse::RecDescent->new($grammar);
|
||||
}
|
||||
my $optree = $parser->code($expr);
|
||||
if (!$optree) {
|
||||
$self->error("Error in $expr\n");
|
||||
return;
|
||||
}
|
||||
|
||||
@{$self->{inputs}}{$self->_variables} = ();
|
||||
$self->{varregs} = {};
|
||||
@{$self->{varregs}}{$self->_variables} = map { "r$_" } 0..$self->_variables-1;
|
||||
$self->{"nregs"} = [ (undef) x $self->_variables ];
|
||||
$self->{"cregs"} = [];
|
||||
$self->{"lits"} = {};
|
||||
|
||||
eval {
|
||||
# generate code for the assignments
|
||||
for my $assign (@{$optree->[0]}) {
|
||||
my ($varname, $tree) = @$assign;
|
||||
if (exists $self->{inputs}{$varname}) {
|
||||
$self->error("$varname is an input - you can't assign to it");
|
||||
return;
|
||||
}
|
||||
$self->{varregs}{$varname} = $self->gencode($tree);
|
||||
}
|
||||
|
||||
# generate the final result
|
||||
my $result = $self->gencode($optree->[1]);
|
||||
if ($result !~ /^p\d+$/) {
|
||||
$self->error("You must return a color value");
|
||||
return;
|
||||
}
|
||||
push(@{$self->{genops}}, [ 'ret', $result, (0) x $MaxOperands ])
|
||||
};
|
||||
if ($@) {
|
||||
$self->error($@);
|
||||
return;
|
||||
}
|
||||
|
||||
return $self->{genops};
|
||||
}
|
||||
|
||||
sub gencode {
|
||||
my ($self, $tree) = @_;
|
||||
|
||||
if (ref $tree) {
|
||||
my ($op, @parms) = @$tree;
|
||||
|
||||
if (!exists $Attr{$op}) {
|
||||
die "Unknown operator or function $op";
|
||||
}
|
||||
|
||||
for my $subtree (@parms) {
|
||||
$subtree = $self->gencode($subtree);
|
||||
}
|
||||
my $types = join("", map {substr($_,0,1)} @parms);
|
||||
|
||||
if (length($types) < length($Attr{$op}{types})) {
|
||||
die "Too few parameters in call to $op";
|
||||
}
|
||||
if ($types ne $Attr{$op}{types}) {
|
||||
# some alternate operators have the same name followed by p
|
||||
my $opp = $op."p";
|
||||
if (exists $Attr{$opp} &&
|
||||
$types eq $Attr{$opp}{types}) {
|
||||
$op = $opp;
|
||||
}
|
||||
else {
|
||||
die "Call to $_ with incorrect types";
|
||||
}
|
||||
}
|
||||
my $result;
|
||||
if ($Attr{$op}{result} eq 'r') {
|
||||
$result = "r".@{$self->{nregs}};
|
||||
push(@{$self->{nregs}}, undef);
|
||||
}
|
||||
else {
|
||||
$result = "p".@{$self->{cregs}};
|
||||
push(@{$self->{cregs}}, undef);
|
||||
}
|
||||
push(@parms, "0") while @parms < $MaxOperands;
|
||||
push(@{$self->{genops}}, [ $op, @parms, $result]);
|
||||
return $result;
|
||||
}
|
||||
elsif (exists $self->{varregs}{$tree}) {
|
||||
return $self->{varregs}{$tree};
|
||||
}
|
||||
elsif ($tree =~ /^$numre$/ || exists $self->{constants}{$tree}) {
|
||||
$tree = $self->{constants}{$tree} if exists $self->{constants}{$tree};
|
||||
|
||||
if (exists $self->{lits}{$tree}) {
|
||||
return $self->{lits}{$tree};
|
||||
}
|
||||
my $reg = "r".@{$self->{nregs}};
|
||||
push(@{$self->{nregs}}, $tree);
|
||||
$self->{lits}{$tree} = $reg;
|
||||
|
||||
return $reg;
|
||||
}
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Imager::Expr - implements expression parsing and compilation for the
|
||||
expression evaluation engine used by Imager::transform2()
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
my $code = Imager::Expr->new({rpnexpr=>$someexpr})
|
||||
or die "Cannot compile $someexpr: ",Imager::Expr::error();
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This module is used internally by the Imager::transform2() function.
|
||||
You shouldn't have much need to use it directly, but you may want to
|
||||
extend it.
|
||||
|
||||
To create a new Imager::Expr object, call:
|
||||
|
||||
my %options;
|
||||
my $expr = Imager::Expr->new(\%options)
|
||||
or die Imager::Expr::error();
|
||||
|
||||
You will need to set an expression value and you may set any of the
|
||||
following:
|
||||
|
||||
=over
|
||||
|
||||
=item *
|
||||
|
||||
constants
|
||||
|
||||
A hashref defining extra constants for expression parsing. The names
|
||||
of the constants must be valid identifiers (/[^\W\d]\w*/) and the
|
||||
values must be valid numeric constants (that Perl recognizes in
|
||||
scalars).
|
||||
|
||||
Imager::Expr may define it's own constants (currently just pi.)
|
||||
|
||||
=item *
|
||||
|
||||
variables
|
||||
|
||||
A reference to an array of variable names. These are allocated
|
||||
numeric registers starting from register zero.
|
||||
|
||||
=back
|
||||
|
||||
=for stopwords RPN
|
||||
|
||||
By default you can define a C<rpnexpr> key (which emulates RPN) or
|
||||
C<expr> (an infix expression). It's also possible to write other
|
||||
expression parsers that will use other keys. Only one expression key
|
||||
should be defined.
|
||||
|
||||
=head2 Instance methods
|
||||
|
||||
The Imager::Expr::error() method is used to retrieve the error if the
|
||||
expression object cannot be created.
|
||||
|
||||
=head2 Methods
|
||||
|
||||
Imager::Expr provides only a few simple methods meant for external use:
|
||||
|
||||
=for stopwords VM
|
||||
|
||||
=over
|
||||
|
||||
=item Imager::Expr->type_registered($keyword)
|
||||
|
||||
Returns true if the given expression type is available. The parameter
|
||||
is the key supplied to the new() method.
|
||||
|
||||
if (Imager::Expr->type_registered('expr')) {
|
||||
# use infix expressions
|
||||
}
|
||||
|
||||
=item $expr->code()
|
||||
|
||||
Returns the compiled code.
|
||||
|
||||
=item $expr->nregs()
|
||||
|
||||
Returns a reference to the array of numeric registers.
|
||||
|
||||
=item $expr->cregs()
|
||||
|
||||
Returns a reference to the array of color registers.
|
||||
|
||||
=item $expr->dumpops()
|
||||
|
||||
Returns a string with the generated VM "machine code".
|
||||
|
||||
=item $expr->dumpcode()
|
||||
|
||||
Returns a string with the disassembled VM "machine code".
|
||||
|
||||
=back
|
||||
|
||||
=head2 Creating a new parser
|
||||
|
||||
I'll write this one day.
|
||||
|
||||
Methods used by parsers:
|
||||
|
||||
=over
|
||||
|
||||
=item compile
|
||||
|
||||
This is the main method you'll need to implement in a parser. See the
|
||||
existing parsers for a guide.
|
||||
|
||||
It's supplied the following parameters:
|
||||
|
||||
=over
|
||||
|
||||
=item *
|
||||
|
||||
$expr - the expression to be parsed
|
||||
|
||||
=item *
|
||||
|
||||
$options - the options hash supplied to transform2.
|
||||
|
||||
=back
|
||||
|
||||
Return an array ref of array refs containing opcodes and operands.
|
||||
|
||||
=item @vars = $self->_variables()
|
||||
|
||||
A list (not a reference) of the input variables. This should be used
|
||||
to allocate as many registers as there are variable as input
|
||||
registers.
|
||||
|
||||
=item $self->error($message)
|
||||
|
||||
Set the return value of Imager::Expr::error()
|
||||
|
||||
=item @ops = $self->stack_to_reg(@stack_ops)
|
||||
|
||||
Converts marginally parsed RPN to register code.
|
||||
|
||||
=item assemble()
|
||||
|
||||
Called to convert op codes into byte code.
|
||||
|
||||
=item numre()
|
||||
|
||||
Returns a regular expression that matches floating point numbers.
|
||||
|
||||
=item optimize()
|
||||
|
||||
Optimizes the assembly code, including attempting common subexpression
|
||||
elimination and strength reducing division by a constant into
|
||||
multiplication by a constant.
|
||||
|
||||
=item register_type()
|
||||
|
||||
Called by a new expression parser implementation to register itself,
|
||||
call as:
|
||||
|
||||
YourClassName->register_type('type code');
|
||||
|
||||
where type code is the parameter that will accept the expression.
|
||||
|
||||
=back
|
||||
|
||||
=head2 Future compatibility
|
||||
|
||||
Try to avoid doing your own optimization beyond literal folding - if
|
||||
we add some sort of jump, the existing optimizer will need to be
|
||||
rewritten, and any optimization you perform may well be broken too
|
||||
(well, your code generation will probably be broken anyway <sigh>).
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Tony Cook <tonyc@cpan.org>, Arnar M. Hrafnkelsson
|
||||
|
||||
=cut
|
||||
Reference in New Issue
Block a user