Parent Directory
| 
Revision Log
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 |