[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 5067 - (download) (as text) (annotate)
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;

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9