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

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

Mon Jul 9 19:54:21 2007 UTC (12 years, 7 months ago) by dpvc
File size: 4278 byte(s)
Better control over when extra parentheses are added.


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