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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 5001 - (download) (as text) (annotate)
Tue Jun 12 04:05:56 2007 UTC (12 years, 8 months ago) by dpvc
File size: 2235 byte(s)
More fixes for creating items in the corret context.  Also added a
method for looking up the package associated with a particular Parser
class (for consistency with the Value->Package call).

    1 #########################################################################
    2 #
    3 #  Implements subtraction
    4 #
    5 package Parser::BOP::subtract;
    6 use strict;
    7 our @ISA = qw(Parser::BOP);
    8 
    9 #
   10 #  Check that the operand types match.
   11 #
   12 sub _check {
   13   my $self = shift;
   14   return if ($self->checkStrings());
   15   return if ($self->checkLists());
   16   return if ($self->checkNumbers());
   17   if ($self->{lop}->canBeInUnion && $self->{rop}->canBeInUnion) {
   18     if ($self->{lop}->isSetOfReals || $self->{rop}->isSetOfReals) {
   19       $self->{type} = Value::Type('Union',2,$Value::Type{number});
   20       foreach my $op ('lop','rop') {
   21   if (!$self->{$op}->isSetOfReals) {
   22     if ($self->{$op}->class eq 'Value') {
   23       $self->{$op}{value} =
   24         $self->Package("Interval")->promote($self->context,$self->{$op}{value});
   25     } else {
   26       $self->{$op} = bless $self->{$op}, 'Parser::List::Interval';
   27     }
   28     $self->{$op}->typeRef->{name} = $self->context->{parens}{interval}{type};
   29   }
   30       }
   31     }
   32     return;
   33   }
   34   my ($ltype,$rtype) = $self->promotePoints();
   35   if (Parser::Item::typeMatch($ltype,$rtype)) {$self->{type} = $ltype}
   36   else {$self->matchError($ltype,$rtype)}
   37 }
   38 
   39 sub canBeInUnion {(shift)->type eq 'Union'}
   40 
   41 #
   42 #  Do subtraction
   43 #
   44 sub _eval {$_[1] - $_[2]}
   45 
   46 #
   47 #  Remove subtracting zero
   48 #  Turn subtraction from zero into negation.
   49 #  Turn subtracting a negative into addition.
   50 #  Factor out common negatives.
   51 #
   52 sub _reduce {
   53   my $self = shift; my $equation = $self->{equation};
   54   my $reduce = $equation->{context}{reduction};
   55   return $self->{lop} if $self->{rop}{isZero} && $reduce->{'x-0'};
   56   return Parser::UOP::Neg($self->{rop}) if $self->{lop}{isZero} && $reduce->{'0-x'};
   57   if ($self->{rop}->isNeg && $reduce->{'x-(-y)'}) {
   58     $self = $self->Item("BOP")->new($equation,'+',$self->{lop},$self->{rop}{op});
   59     $self = $self->reduce;
   60   } elsif ($self->{lop}->isNeg && $reduce->{'(-x)-y'}) {
   61     $self = Parser::UOP::Neg
   62       ($self->Item("BOP")->new($equation,'+',$self->{lop}{op},$self->{rop}));
   63     $self = $self->reduce;
   64   }
   65   return $self;
   66 }
   67 
   68 $Parser::reduce->{'x-0'} = 1;
   69 $Parser::reduce->{'0-x'} = 1;
   70 $Parser::reduce->{'x-(-y)'} = 1;
   71 $Parser::reduce->{'(-x)-y'} = 1;
   72 
   73 #########################################################################
   74 
   75 1;

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9