[system] / trunk / pg / lib / Parser / BOP / equality.pm Repository: Repository Listing bbplugincoursesdistsnplrochestersystemwww

# View of /trunk/pg/lib/Parser/BOP/equality.pm

Thu Jun 28 22:33:31 2007 UTC (12 years, 7 months ago) by dpvc
File size: 4222 byte(s)
Added perl method so that the result is always a number (not a blank
when it is false).


    1 #########################################################################
2 #
3 #  Implements equality
4 #
5 package Parser::BOP::equality;
6 use strict;
7 our @ISA = qw(Parser::BOP);
8
9 #
10 #  Check that the operand types are numbers.
11 #
12 sub _check {
13   my $self = shift; my$name = $self->{def}{string} ||$self->{bop};
14   $self->Error("Only one equality is allowed in an equation") 15 if ($self->{lop}->type eq 'Equality' || $self->{rop}->type eq 'Equality'); 16$self->Error("Operands of '%s' must be Numbers",$name) unless$self->checkNumbers();
17   $self->{type} = Value::Type('Equality',1); # Make it not a number, to get errors with other operations. 18 } 19 20 # 21 # Determine if the two sides are equal (use fuzzy reals) 22 # 23 sub _eval { 24 my$self = shift; my %context = (context => $self->context); 25 my ($a,$b) = @_; 26$a = Value::makeValue($a,%context) unless ref($a);
27   $b = Value::makeValue($b,%context) unless ref($b); 28 return ($a == $b)? 1 : 0; 29 } 30 31 # 32 # Remove redundent minuses 33 # 34 sub _reduce { 35 my$self = shift;
36   my $equation =$self->{equation};
37   my $reduce =$equation->{context}{reduction};
38   if ($self->{lop}->isNeg &&$self->{rop}->isNeg && $reduce->{'-x=-y'}) { 39$self = $self->Item("BOP")->new($equation,'=',$self->{lop}{op},$self->{rop}{op});
40     $self =$self->reduce;
41   }
42   if ($self->{lop}->isNeg &&$self->{rop}{isConstant} &&
43       $self->{rop}->isNumber &&$reduce->{'-x=n'}) {
44     $self =$self->Item("BOP")->new($equation,"=",$self->{lop}{op},Parser::UOP::Neg($self->{rop})); 45$self = $self->reduce; 46 } 47 return$self;
48 }
49
50 $Parser::reduce->{'-x=-y'} = 1; 51$Parser::reduce->{'-x=n'} = 1;
52
53 #
54 #  Don't add parens to the left and right parts
55 #
56 sub string {
57   my ($self,$precedence,$showparens,$position,$outerRight) = @_; 58 my$string; my $bop =$self->{def};
59   $position = '' unless defined($position);
60   $showparens = '' unless defined($showparens);
61   my $extraParens =$self->{equation}{context}->flag('showExtraParens');
62   my $addparens = 63 defined($precedence) &&
64       ($precedence >$bop->{precedence} || ($precedence ==$bop->{precedence} &&
65         ($bop->{associativity} eq 'right' ||$showparens eq 'same')));
66   $outerRight = !$addparens && ($outerRight ||$position eq 'right');
67
68   $string =$self->{lop}->string($bop->{precedence}). 69$bop->{string}.
70             $self->{rop}->string($bop->{precedence});
71
72   $string =$self->addParens($string) if ($addparens);
73   return $string; 74 } 75 76 sub TeX { 77 my ($self,$precedence,$showparens,$position,$outerRight) = @_;
78   my $TeX; my$bop = $self->{def}; 79$position = '' unless defined($position); 80$showparens = '' unless defined($showparens); 81 my$extraParens = $self->{equation}{context}->flag('showExtraParens'); 82 my$addparens =
83       defined($precedence) && 84 ($precedence > $bop->{precedence} || ($precedence == $bop->{precedence} && 85 ($bop->{associativity} eq 'right' || $showparens eq 'same'))); 86$outerRight = !$addparens && ($outerRight || $position eq 'right'); 87 88$TeX = $self->{lop}->TeX($bop->{precedence}).
89          (defined($bop->{TeX}) ?$bop->{TeX} : $bop->{string}) . 90$self->{rop}->TeX($bop->{precedence}); 91 92$TeX = '\left('.$TeX.'\right)' if ($addparens);
93   return $TeX; 94 } 95 96 sub perl { 97 my$self= shift;
98   my $bop =$self->{def};
99   return
100      "(" .
101        $self->{lop}->perl(1). 102 " ".($bop->{perl} || $bop->{string})." ". 103$self->{rop}->perl(2) .
104      " ? 1 : 0)";
105 }
106
107
108 #
109 #  Add/Remove the equality operator to/from a context
110 #
111 sub Allow {
112   my $self = shift || "Value"; my$context = shift || $self->context; 113 my$allow = shift; $allow = 1 unless defined($allow);
114   if ($allow) { 115 my$prec = $context->{operators}{','}{precedence}; 116$prec = 1 unless defined($prec); 117$context->operators->add(
118       '=' => {
119          class => 'Parser::BOP::equality',
120          precedence => $prec+.25, # just above comma 121 associativity => 'left', # computed left to right 122 type => 'bin', # binary operator 123 string => ' = ', # output string for it 124 perl => '==', # perl string 125 } 126 ); 127 } else {$context->operators->remove('=')}
128   return;
129 }
130
131 #########################################################################
132
133 1;