[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 5696 - (download) (as text) (annotate)
Sat Jun 14 12:14:21 2008 UTC (11 years, 8 months ago) by dpvc
File size: 6585 byte(s)
Added

	 no strict "refs"

to try to avoid new error checking in Perl 5.10.

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

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9