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

View of /trunk/pg/lib/Parser/UOP.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2653 - (download) (as text) (annotate)
Thu Aug 19 17:31:18 2004 UTC (15 years, 3 months ago) by dpvc
File size: 5560 byte(s)
Fixed error with handling of +infinity and -infinity.
(They had been defined as strings, but now we can let the + and -
operators handle them).

    1 #########################################################################
    2 #
    3 #  Implements the base Unary Operator class
    4 #
    5 package Parser::UOP;
    6 use strict; use vars qw(@ISA);
    7 @ISA = qw(Parser::Item);
    8 
    9 sub new {
   10   my $self = shift; my $class = ref($self) || $self;
   11   my $equation = shift;
   12   my ($uop,$op,$ref) = @_;
   13   my $def = $equation->{context}{operators}{$uop};
   14   my $UOP = bless {
   15     uop => $uop, op => $op,
   16     def => $def, ref => $ref, equation => $equation
   17   }, $def->{class};
   18   $UOP->_check;
   19   $UOP->{isConstant} = 1 if $op->{isConstant};
   20   $UOP = Parser::Value->new($equation,[$UOP->eval])
   21     if $op->{isConstant} && !$UOP->isNeg;
   22   return $UOP;
   23 }
   24 
   25 #
   26 #  Stub for checking if the BOP can operate on the given operands.
   27 #  (Implemented in subclasses.)
   28 #
   29 sub _check {}
   30 
   31 ##################################################
   32 
   33 #
   34 #  Evaluate the operand and then perform the operation on it
   35 #
   36 sub eval {
   37   my $self = shift;
   38   $self->_eval($self->{op}->eval);
   39 }
   40 #
   41 #  Stub for sub-classes.
   42 #
   43 sub _eval {return $_[1]}
   44 
   45 
   46 #
   47 #  Reduce the operand.
   48 #  If it is constant and we are not negation (we want to be ablet o factor it out),
   49 #    return the value of the operation.
   50 #
   51 sub reduce {
   52   my $self = shift;
   53   my $uop = $self->{def};
   54   $self->{op} = $self->{op}->reduce;
   55   return Parser::Value->new($self->{equation},[$self->eval])
   56     if $self->{op}{isConstant} && !$self->isNeg;
   57   $self->_reduce;
   58 }
   59 #
   60 #  Stub for sub-classes.
   61 #
   62 sub _reduce {shift}
   63 
   64 sub substitute {
   65   my $self = shift;
   66   my $uop = $self->{def};
   67   $self->{op} = $self->{op}->substitute;
   68   return Parser::Value->new($self->{equation},[$self->eval])
   69     if $self->{op}{isConstant} && !$self->isNeg;
   70   return $self;
   71 }
   72 
   73 #
   74 #  Copy the operand as well as the rest of the object
   75 #
   76 sub copy {
   77   my $self = shift; my $equation = shift;
   78   my $new = $self->SUPER::copy($equation);
   79   $new->{op} = $self->{op}->copy($equation);
   80   return $new;
   81 }
   82 
   83 ##################################################
   84 #
   85 #  Service routines for checking the types of operands.
   86 #
   87 
   88 
   89 #
   90 #  Error if the operand is a string
   91 #
   92 sub checkString {
   93   my $self = shift;
   94   my $type = $self->{op}->typeRef;
   95   return 0 if ($type->{name} ne 'String');
   96   my $name = $self->{def}{string} || $self->{uop};
   97   $self->Error("Operand of '$name' can't be ".
   98          ($self->{op}{isInfinite}? 'an infinity': 'a word'));
   99   return 1;
  100 }
  101 
  102 #
  103 #  Error if operand is a list
  104 #
  105 sub checkList {
  106   my $self = shift;
  107   my $type = $self->{op}->typeRef;
  108   return 0 if ($type->{name} ne 'List');
  109   my $name = $self->{def}{string} || $self->{uop};
  110   $self->Error("Operand of '$name' can't be a list");
  111   return 1;
  112 }
  113 
  114 
  115 #
  116 #  Determine if the operand is an infinity and set the type
  117 #
  118 sub checkInfinite {
  119   my $self = shift;
  120   my $uop = $self->{def};
  121   return 0 unless $self->{op}->{isInfinite} && $uop->{allowInfinite};
  122   $self->{type} = $self->{op}->typeRef;
  123   return 1;
  124 }
  125 
  126 #
  127 #  Determine if the operand is a number, and set the type
  128 #    to complex or number according to the type of operand.
  129 #
  130 sub checkNumber {
  131   my $self = shift;
  132   return 0 if !($self->{op}->isNumber);
  133   if ($self->{op}->isComplex) {$self->{type} = $Value::Type{complex}}
  134   else {$self->{type} = $Value::Type{number}}
  135   return 1;
  136 }
  137 
  138 ##################################################
  139 #
  140 #  Service routines for adjusting the values of operands.
  141 #
  142 
  143 #
  144 #  Produce a reduced negation of an item.
  145 #
  146 sub Neg {
  147   my $self = shift;
  148   $self->Error("Can't reduce:  negation operator is not defined")
  149     if (!defined($self->{equation}{context}{operators}{'u-'}));
  150   return (Parser::UOP->new($self->{equation},'u-',$self))->reduce;
  151 }
  152 
  153 #
  154 #  Get the variables used in the operand
  155 #
  156 sub getVariables {
  157   my $self = shift;
  158   $self->{op}->getVariables;
  159 }
  160 
  161 ##################################################
  162 #
  163 #  Generate the various output formats.
  164 #
  165 
  166 
  167 #
  168 #  Produce a string version of the equation.
  169 #
  170 #  We add parentheses if the precedence of the operator is less
  171 #    than the parent operation.
  172 #  Add the operator before or after the operand according to the
  173 #    associativity of the operator.
  174 #
  175 sub string {
  176   my $self = shift;
  177   my $precedence = shift; my $showparens = shift;
  178   my $string; my $uop = $self->{def};
  179   my $addparens = defined($precedence) && $precedence >= $uop->{precedence};
  180   if ($uop->{associativity} eq "right") {
  181     $string = $self->{op}->string($uop->{precedence}).$uop->{string};
  182   } else {
  183     $string = $uop->{string}.$self->{op}->string($uop->{precedence});
  184   }
  185   $string = "(".$string.")" if $addparens;
  186   return $string;
  187 }
  188 
  189 #
  190 #  Produce the TeX form
  191 #
  192 sub TeX {
  193   my $self = shift; my $precedence = shift; my $showparens = shift;
  194   my $TeX; my $uop = $self->{def};
  195   my $addparens = defined($precedence) && $precedence >= $uop->{precedence};
  196   $TeX = (defined($uop->{TeX}) ? $uop->{TeX} : $uop->{string});
  197   if ($uop->{associativity} eq "right") {
  198     $TeX = $self->{op}->TeX($uop->{precedence}) . $TeX;
  199   } else {
  200     $TeX = $TeX . $self->{op}->TeX($uop->{precedence});
  201   }
  202   $TeX = '\left('.$TeX.'\right)' if $addparens;
  203   return $TeX;
  204 }
  205 
  206 #
  207 #  Produce a Perl expression
  208 #
  209 sub perl {
  210   my $self = shift; my $parens = shift;
  211   my $uop = $self->{def};
  212   my $perl = (defined($uop->{perl})? $uop->{perl}: $uop->{string}).$self->{op}->perl(1);
  213   $perl = '('.$perl.')' if $parens;
  214   return $perl;
  215 }
  216 
  217 #########################################################################
  218 #
  219 #  Load the subclasses.
  220 #
  221 
  222 use Parser::UOP::undefined;
  223 use Parser::UOP::plus;
  224 use Parser::UOP::minus;
  225 use Parser::UOP::factorial;
  226 
  227 #########################################################################
  228 
  229 1;
  230 

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9