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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 5132 - (download) (as text) (annotate)
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;

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9