improved thread safety for Imager

[imager.git] / lib / Imager / Expr.pm

diff --git a/lib/Imager/Expr.pm b/lib/Imager/Expr.pm
index 5effa507a10ca35727a8edc85d9764a1e7708dee..69b84d78e81004913e3cbd2abaae15567cd98813 100644 (file)
--- a/lib/Imager/Expr.pm
+++ b/lib/Imager/Expr.pm
@@ -2,6 +2,9 @@ package Imager::Expr;
 
 use Imager::Regops;
 use strict;
+use vars qw($VERSION);
+
+$VERSION = "1.005";
 
 my %expr_types;
 
@@ -48,6 +51,12 @@ sub register_type {
   $expr_types{$name} = $pack;
 }
 
+sub type_registered {
+  my ($class, $name) = @_;
+
+  $expr_types{$name};
+}
+
 sub _variables {
   return @{$_[0]->{variables}};
 }
@@ -298,6 +307,7 @@ my %op_names = ( '+'=>'add', '-'=>'subtract', '*'=>'mult', '/' => 'div',
 sub compile {
   my ($self, $expr, $opts) = @_;
 
+  $expr =~ s/#.*//; # remove comments
   my @st_ops = split ' ', $expr;
 
   for (@st_ops) {
@@ -334,6 +344,7 @@ 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] ] }
@@ -350,6 +361,7 @@ 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' }
@@ -359,6 +371,7 @@ 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] ] }
@@ -370,6 +383,7 @@ 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] ] }
@@ -433,7 +447,7 @@ sub compile {
     # generate the final result
     my $result = $self->gencode($optree->[1]);
     if ($result !~ /^p\d+$/) {
-      $self->error("You must return a colour value");
+      $self->error("You must return a color value");
       return;
     }
     push(@{$self->{genops}}, [ 'ret', $result, (0) x $MaxOperands ])
@@ -534,9 +548,11 @@ To create a new Imager::Expr object, call:
 You will need to set an expression value and you may set any of the
 following:
 
-=over 4
+=over
 
-=item constants
+=item *
+
+constants
 
 A hashref defining extra constants for expression parsing.  The names
 of the constants must be valid identifiers (/[^\W\d]\w*/) and the
@@ -545,15 +561,19 @@ scalars).
 
 Imager::Expr may define it's own constants (currently just pi.)
 
-=item variables
+=item *
+
+variables
 
 A reference to an array of variable names.  These are allocated
 numeric registers starting from register zero.
 
 =back
 
-By default you can define a 'rpnexpr' key (which emulates RPN) or
-'expr' (an infix expression).  It's also possible to write other
+=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.
 
@@ -566,7 +586,18 @@ expression object cannot be created.
 
 Imager::Expr provides only a few simple methods meant for external use:
 
-=over 4
+=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()
 
@@ -578,7 +609,7 @@ Returns a reference to the array of numeric registers.
 
 =item $expr->cregs()
 
-Returns a reference to the array of colour registers.
+Returns a reference to the array of color registers.
 
 =item $expr->dumpops()
 
@@ -586,7 +617,7 @@ Returns a string with the generated VM "machine code".
 
 =item $expr->dumpcode()
 
-Returns a string with the unassembled VM "machine code".
+Returns a string with the disassembled VM "machine code".
 
 =back
 
@@ -596,7 +627,28 @@ I'll write this one day.
 
 Methods used by parsers:
 
-=over 4
+=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()
 
@@ -612,6 +664,29 @@ Set the return value of Imager::Expr::error()
 
 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