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

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

Parent Directory Parent Directory | Revision Log 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