[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 2696 - (download) (as text) (annotate)
Sat Aug 28 12:34:56 2004 UTC (15 years, 3 months ago) by dpvc
File size: 5844 byte(s)
Improved TeX and string output in a number of situations.  Improved
use of parentheses to avoid things like x+-3.  Fixed wrong parentheses
in powers.  Display (sin(x))^2 as sin^2(x) in TeX output.

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

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9