Parent Directory
|
Revision Log
Revision 5001 - (view) (download) (as text)
| 1 : | sh002i | 2558 | ######################################################################### |
| 2 : | # | ||
| 3 : | dpvc | 2615 | # Implements subtraction |
| 4 : | sh002i | 2558 | # |
| 5 : | package Parser::BOP::subtract; | ||
| 6 : | dpvc | 4994 | use strict; |
| 7 : | our @ISA = qw(Parser::BOP); | ||
| 8 : | sh002i | 2558 | |
| 9 : | # | ||
| 10 : | # Check that the operand types match. | ||
| 11 : | # | ||
| 12 : | sub _check { | ||
| 13 : | dpvc | 5001 | my $self = shift; |
| 14 : | sh002i | 2558 | return if ($self->checkStrings()); |
| 15 : | return if ($self->checkLists()); | ||
| 16 : | return if ($self->checkNumbers()); | ||
| 17 : | dpvc | 3523 | if ($self->{lop}->canBeInUnion && $self->{rop}->canBeInUnion) { |
| 18 : | if ($self->{lop}->isSetOfReals || $self->{rop}->isSetOfReals) { | ||
| 19 : | dpvc | 3477 | $self->{type} = Value::Type('Union',2,$Value::Type{number}); |
| 20 : | foreach my $op ('lop','rop') { | ||
| 21 : | dpvc | 3523 | if (!$self->{$op}->isSetOfReals) { |
| 22 : | dpvc | 3477 | if ($self->{$op}->class eq 'Value') { |
| 23 : | dpvc | 4994 | $self->{$op}{value} = |
| 24 : | dpvc | 5001 | $self->Package("Interval")->promote($self->context,$self->{$op}{value}); |
| 25 : | dpvc | 3477 | } else { |
| 26 : | $self->{$op} = bless $self->{$op}, 'Parser::List::Interval'; | ||
| 27 : | } | ||
| 28 : | dpvc | 5001 | $self->{$op}->typeRef->{name} = $self->context->{parens}{interval}{type}; |
| 29 : | dpvc | 3477 | } |
| 30 : | } | ||
| 31 : | } | ||
| 32 : | return; | ||
| 33 : | } | ||
| 34 : | sh002i | 2558 | my ($ltype,$rtype) = $self->promotePoints(); |
| 35 : | if (Parser::Item::typeMatch($ltype,$rtype)) {$self->{type} = $ltype} | ||
| 36 : | else {$self->matchError($ltype,$rtype)} | ||
| 37 : | } | ||
| 38 : | |||
| 39 : | dpvc | 3523 | sub canBeInUnion {(shift)->type eq 'Union'} |
| 40 : | |||
| 41 : | sh002i | 2558 | # |
| 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 : | dpvc | 2678 | my $self = shift; my $equation = $self->{equation}; |
| 54 : | dpvc | 2796 | 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 : | dpvc | 5001 | $self = $self->Item("BOP")->new($equation,'+',$self->{lop},$self->{rop}{op}); |
| 59 : | sh002i | 2558 | $self = $self->reduce; |
| 60 : | dpvc | 2796 | } elsif ($self->{lop}->isNeg && $reduce->{'(-x)-y'}) { |
| 61 : | sh002i | 2558 | $self = Parser::UOP::Neg |
| 62 : | dpvc | 5001 | ($self->Item("BOP")->new($equation,'+',$self->{lop}{op},$self->{rop})); |
| 63 : | sh002i | 2558 | $self = $self->reduce; |
| 64 : | } | ||
| 65 : | return $self; | ||
| 66 : | } | ||
| 67 : | |||
| 68 : | dpvc | 2796 | $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 : | sh002i | 2558 | ######################################################################### |
| 74 : | |||
| 75 : | 1; |
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |