[system] / trunk / pg / lib / Parser / BOP / dot.pm Repository:
ViewVC logotype

View of /trunk/pg/lib/Parser/BOP/dot.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2678 - (download) (as text) (annotate)
Mon Aug 23 23:55:37 2004 UTC (15 years, 5 months ago) by dpvc
File size: 1369 byte(s)
Modified the parser so that the classes for the various object
constructors are stored in the context table rather than hard-coded
into the parser.  That way, you can override the default classes with
your own.  This gives you even more complete control to modify the
parser.  (You had been able to replace the definitions of operators,
functions and list-like objects, but could not override the behaviour
of numbers, strings, variables, and so on.  Now you can.)

This effects most of the files, but only by changing the name of the
calls that create the various objects.

There are also a couple of other minor fixes.

    1 #########################################################################
    2 #
    3 #  Implement vector dot product.
    4 #
    5 package Parser::BOP::dot;
    6 use strict; use vars qw(@ISA);
    7 @ISA = qw(Parser::BOP);
    8 
    9 #
   10 #  Check that the operands are vectors of compatible types.
   11 #
   12 sub _check {
   13   my $self = shift;
   14   return if ($self->checkStrings());
   15   return if ($self->checkLists());
   16   return if ($self->checkNumbers());
   17   my ($ltype,$rtype) = $self->promotePoints();
   18   if ($ltype->{name} eq 'Vector' && $rtype->{name} eq 'Vector') {
   19     if (Parser::Item::typeMatch($ltype,$rtype)) {$self->{type} = $Value::Type{number}}
   20     else {$self->matchError($ltype,$rtype)}
   21   } else {$self->Error("Operands for dot product must be Vectors")}
   22 }
   23 
   24 #
   25 #  Use perl '.' for dot product
   26 #   (see Value.pm; special care must be taken to make string concatenation
   27 #    work with this.)
   28 #
   29 sub _eval {$_[1] . $_[2]}
   30 
   31 #
   32 #  Return zero if one operand is zero.
   33 #  Factor out negatives.
   34 #
   35 sub _reduce {
   36   my $self = shift;
   37   return $self->{equation}{context}{parser}{Number}->new($self->{equation},0)
   38     if ($self->{lop}{isZero} || $self->{rop}{isZero});
   39   return $self->makeNeg($self->{lop}{op},$self->{rop}) if ($self->{lop}->isNeg);
   40   return $self->makeNeg($self->{lop},$self->{rop}{op}) if ($self->{rop}->isNeg);
   41   return $self;
   42 }
   43 
   44 #########################################################################
   45 
   46 1;
   47 

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9