Parent Directory
| 
Revision Log
Revision 2688 - (view) (download) (as text)
| 1 : | sh002i | 2558 | package Value; |
| 2 : | my $pkg = 'Value'; | ||
| 3 : | dpvc | 2579 | use vars qw($context $defaultContext %Type); |
| 4 : | sh002i | 2558 | use strict; |
| 5 : | |||
| 6 : | dpvc | 2579 | ############################################################# |
| 7 : | sh002i | 2558 | # |
| 8 : | dpvc | 2579 | # Initialize the context |
| 9 : | # | ||
| 10 : | sh002i | 2558 | |
| 11 : | dpvc | 2579 | use Value::Context; |
| 12 : | |||
| 13 : | $defaultContext = Value::Context->new( | ||
| 14 : | lists => { | ||
| 15 : | 'Point' => {open => '(', close => ')'}, | ||
| 16 : | 'Vector' => {open => '<', close => '>'}, | ||
| 17 : | 'Matrix' => {open => '[', close => ']'}, | ||
| 18 : | 'List' => {open => '(', close => ')'}, | ||
| 19 : | }, | ||
| 20 : | flags => { | ||
| 21 : | # | ||
| 22 : | # For vectors: | ||
| 23 : | # | ||
| 24 : | ijk => 0, # print vectors as <...> | ||
| 25 : | # | ||
| 26 : | dpvc | 2624 | # word to use for infinity |
| 27 : | # | ||
| 28 : | infiniteWord => 'infinity', | ||
| 29 : | # | ||
| 30 : | dpvc | 2579 | # For fuzzy reals: |
| 31 : | # | ||
| 32 : | useFuzzyReals => 1, | ||
| 33 : | dpvc | 2624 | tolerance => 1E-4, |
| 34 : | tolType => 'relative', | ||
| 35 : | zeroLevel => 1E-14, | ||
| 36 : | dpvc | 2579 | zeroLevelTol => 1E-12, |
| 37 : | dpvc | 2596 | # |
| 38 : | dpvc | 2622 | # For functions |
| 39 : | # | ||
| 40 : | dpvc | 2669 | limits => [-2,2], |
| 41 : | num_points => 5, | ||
| 42 : | dpvc | 2670 | granularity => 1000, |
| 43 : | dpvc | 2669 | resolution => undef, |
| 44 : | dpvc | 2688 | max_adapt => 1E8, |
| 45 : | dpvc | 2579 | }, |
| 46 : | ); | ||
| 47 : | |||
| 48 : | $context = \$defaultContext; | ||
| 49 : | |||
| 50 : | |||
| 51 : | sh002i | 2558 | # |
| 52 : | # Precedence of the various types | ||
| 53 : | # (They will be promoted upward automatically when needed) | ||
| 54 : | # | ||
| 55 : | dpvc | 2579 | $$context->{precedence} = { |
| 56 : | dpvc | 2603 | 'Number' => 0, |
| 57 : | 'Real' => 1, | ||
| 58 : | 'Infinity' => 2, | ||
| 59 : | 'Complex' => 3, | ||
| 60 : | 'Point' => 4, | ||
| 61 : | 'Vector' => 5, | ||
| 62 : | 'Matrix' => 6, | ||
| 63 : | 'List' => 7, | ||
| 64 : | 'Interval' => 8, | ||
| 65 : | 'Union' => 9, | ||
| 66 : | dpvc | 2609 | 'String' => 10, |
| 67 : | 'Formula' => 11, | ||
| 68 : | dpvc | 2646 | 'special' => 12, |
| 69 : | dpvc | 2579 | }; |
| 70 : | sh002i | 2558 | |
| 71 : | # | ||
| 72 : | # Binding of perl operator to class method | ||
| 73 : | # | ||
| 74 : | dpvc | 2579 | $$context->{method} = { |
| 75 : | sh002i | 2558 | '+' => 'add', |
| 76 : | '-' => 'sub', | ||
| 77 : | '*' => 'mult', | ||
| 78 : | '/' => 'div', | ||
| 79 : | '**' => 'power', | ||
| 80 : | '.' => '_dot', # see _dot below | ||
| 81 : | 'x' => 'cross', | ||
| 82 : | '<=>' => 'compare', | ||
| 83 : | dpvc | 2625 | 'cmp' => 'cmp', |
| 84 : | dpvc | 2579 | }; |
| 85 : | sh002i | 2558 | |
| 86 : | dpvc | 2601 | $$context->{pattern}{infinite} = '[-+]?inf(?:inity)?'; |
| 87 : | $$context->{pattern}{infinity} = '\+?inf(?:inity)?'; | ||
| 88 : | $$context->{pattern}{-infinity} = '-inf(?:inity)?'; | ||
| 89 : | dpvc | 2596 | |
| 90 : | dpvc | 2579 | push(@{$$context->{data}{values}},'method','precedence'); |
| 91 : | sh002i | 2558 | |
| 92 : | dpvc | 2579 | ############################################################# |
| 93 : | |||
| 94 : | sh002i | 2558 | # |
| 95 : | # Check if a value is a number, complex, etc. | ||
| 96 : | # | ||
| 97 : | dpvc | 2603 | sub matchNumber {my $n = shift; $n =~ m/^$$context->{pattern}{signedNumber}$/i} |
| 98 : | sub matchInfinite {my $n = shift; $n =~ m/^$$context->{pattern}{infinite}$/i} | ||
| 99 : | dpvc | 2579 | sub isReal {class(shift) eq 'Real'} |
| 100 : | sub isComplex {class(shift) eq 'Complex'} | ||
| 101 : | dpvc | 2646 | sub isFormula { |
| 102 : | my $v = shift; | ||
| 103 : | dpvc | 2660 | return class($v) eq 'Formula' || |
| 104 : | (ref($v) && ref($v) ne 'ARRAY' && $v->{isFormula}); | ||
| 105 : | dpvc | 2646 | } |
| 106 : | sub isValue { | ||
| 107 : | my $v = shift; | ||
| 108 : | dpvc | 2660 | return (ref($v) || $v) =~ m/^Value::/ || |
| 109 : | (ref($v) && ref($v) ne 'ARRAY' && $v->{isValue}); | ||
| 110 : | dpvc | 2646 | } |
| 111 : | sh002i | 2558 | |
| 112 : | sub isNumber { | ||
| 113 : | my $n = shift; | ||
| 114 : | dpvc | 2579 | return $n->{tree}->isNumber if isFormula($n); |
| 115 : | return isReal($n) || isComplex($n) || matchNumber($n); | ||
| 116 : | sh002i | 2558 | } |
| 117 : | |||
| 118 : | sub isRealNumber { | ||
| 119 : | my $n = shift; | ||
| 120 : | dpvc | 2579 | return $n->{tree}->isRealNumber if isFormula($n); |
| 121 : | return isReal($n) || matchNumber($n); | ||
| 122 : | sh002i | 2558 | } |
| 123 : | |||
| 124 : | # | ||
| 125 : | dpvc | 2603 | # Convert non-Value objects to Values, if possible |
| 126 : | # | ||
| 127 : | sub makeValue { | ||
| 128 : | my $x = shift; | ||
| 129 : | return $x if ref($x); | ||
| 130 : | return Value::Real->make($x) if matchNumber($x); | ||
| 131 : | dpvc | 2609 | if (matchInfinite($x)) { |
| 132 : | my $I = Value::Infinity->new(); | ||
| 133 : | $I = $I->neg if $x =~ m/^$$Value::context->{pattern}{-infinity}$/; | ||
| 134 : | return $I; | ||
| 135 : | } | ||
| 136 : | if ($Parser::installed) {return $x unless $$Value::context->{strings}{$x}} | ||
| 137 : | return Value::String->make($x); | ||
| 138 : | dpvc | 2603 | } |
| 139 : | |||
| 140 : | # | ||
| 141 : | sh002i | 2558 | # Get a printable version of the class of an object |
| 142 : | # | ||
| 143 : | sub showClass { | ||
| 144 : | dpvc | 2624 | my $value = makeValue(shift); |
| 145 : | dpvc | 2621 | return "'".$value."'" unless Value::isValue($value); |
| 146 : | sh002i | 2558 | my $class = class($value); |
| 147 : | dpvc | 2621 | return showType($value) if ($class eq 'List'); |
| 148 : | dpvc | 2592 | $class .= ' Number' if $class =~ m/^(Real|Complex)$/; |
| 149 : | $class .= ' of Intervals' if $class eq 'Union'; | ||
| 150 : | dpvc | 2609 | $class = 'Word' if $class eq 'String'; |
| 151 : | dpvc | 2624 | return 'a Formula that returns '.showType($value->{tree}) if ($class eq 'Formula'); |
| 152 : | dpvc | 2603 | return 'an '.$class if $class =~ m/^[aeio]/i; |
| 153 : | sh002i | 2558 | return 'a '.$class; |
| 154 : | } | ||
| 155 : | |||
| 156 : | # | ||
| 157 : | # Get a printable version of the type of an object | ||
| 158 : | # | ||
| 159 : | sub showType { | ||
| 160 : | my $value = shift; | ||
| 161 : | my $type = $value->type; | ||
| 162 : | dpvc | 2621 | if ($type eq 'List') { |
| 163 : | my $ltype = $value->typeRef->{entryType}{name}; | ||
| 164 : | if ($ltype && $ltype ne 'unknown') { | ||
| 165 : | $ltype =~ s/y$/ie/; | ||
| 166 : | $type .= ' of '.$ltype.'s'; | ||
| 167 : | } | ||
| 168 : | } | ||
| 169 : | dpvc | 2609 | return 'a Word' if $type eq 'String'; |
| 170 : | sh002i | 2558 | return 'a Complex Number' if $value->isComplex; |
| 171 : | dpvc | 2603 | return 'an '.$type if $type =~ m/^[aeio]/i; |
| 172 : | sh002i | 2558 | return 'a '.$type; |
| 173 : | } | ||
| 174 : | |||
| 175 : | # | ||
| 176 : | dpvc | 2603 | # Return a string describing a value's type |
| 177 : | sh002i | 2558 | # |
| 178 : | sub getType { | ||
| 179 : | my $equation = shift; my $value = shift; | ||
| 180 : | my $strings = $equation->{context}{strings}; | ||
| 181 : | if (ref($value) eq 'ARRAY') { | ||
| 182 : | return 'Interval' if ($value->[0] =~ m/^[(\[]$/ && $value->[-1] =~ m/^[)\]]$/); | ||
| 183 : | my ($type,$ltype); | ||
| 184 : | foreach my $x (@{$value}) { | ||
| 185 : | $type = getType($equation,$x); | ||
| 186 : | if ($type eq 'value') { | ||
| 187 : | $type = $x->type if $x->class eq 'Formula'; | ||
| 188 : | $type = 'Number' if $x->class eq 'Complex' || $type eq 'Complex'; | ||
| 189 : | } | ||
| 190 : | $ltype = $type if $ltype eq ''; | ||
| 191 : | return 'List' if $type ne $ltype; | ||
| 192 : | } | ||
| 193 : | return 'Point' if $ltype eq 'Number'; | ||
| 194 : | return 'Matrix' if $ltype =~ m/Point|Matrix/; | ||
| 195 : | return 'List'; | ||
| 196 : | } | ||
| 197 : | elsif (Value::isFormula($value)) {return 'Formula'} | ||
| 198 : | dpvc | 2660 | elsif (Value::class($value) eq 'Infinity') {return 'Infinity'} |
| 199 : | dpvc | 2612 | elsif (Value::isReal($value)) {return 'Number'} |
| 200 : | sh002i | 2558 | elsif (Value::isValue($value)) {return 'value'} |
| 201 : | elsif (ref($value)) {return 'unknown'} | ||
| 202 : | elsif (defined($strings->{$value})) {return 'String'} | ||
| 203 : | elsif (Value::isNumber($value)) {return 'Number'} | ||
| 204 : | return 'unknown'; | ||
| 205 : | } | ||
| 206 : | |||
| 207 : | # | ||
| 208 : | # Get a string describing a value's type, | ||
| 209 : | # and convert the value to a Value object (if needed) | ||
| 210 : | # | ||
| 211 : | sub getValueType { | ||
| 212 : | my $equation = shift; my $value = shift; | ||
| 213 : | my $type = Value::getType($equation,$value); | ||
| 214 : | if ($type eq 'String') {$type = $Value::Type{string}} | ||
| 215 : | elsif ($type eq 'Number') {$type = $Value::Type{number}} | ||
| 216 : | dpvc | 2660 | elsif ($type eq 'Infinity') {$type = $Value::Type{infinity}} |
| 217 : | dpvc | 2628 | elsif ($type eq 'value' || $type eq 'Formula') {$type = $value->typeRef} |
| 218 : | elsif ($type eq 'unknown') { | ||
| 219 : | sh002i | 2558 | $equation->Error("Can't convert ".Value::showClass($value)." to a constant"); |
| 220 : | } else { | ||
| 221 : | dpvc | 2628 | $type = 'Value::'.$type, $value = $type->new(@{$value}); |
| 222 : | sh002i | 2558 | $type = $value->typeRef; |
| 223 : | } | ||
| 224 : | return ($value,$type); | ||
| 225 : | } | ||
| 226 : | |||
| 227 : | # | ||
| 228 : | # Convert a list of values to a list of formulas (called by Parser::Value) | ||
| 229 : | # | ||
| 230 : | sub toFormula { | ||
| 231 : | my $formula = shift; | ||
| 232 : | my $processed = 0; | ||
| 233 : | my @f = (); my $vars = {}; | ||
| 234 : | foreach my $x (@_) { | ||
| 235 : | if (isFormula($x)) { | ||
| 236 : | $formula->{context} = $x->{context}, $processed = 1 unless $processed; | ||
| 237 : | $formula->{variables} = {%{$formula->{variables}},%{$x->{variables}}}; | ||
| 238 : | push(@f,$x->{tree}->copy($formula)); | ||
| 239 : | } else { | ||
| 240 : | dpvc | 2678 | push(@f,$formula->{context}{parser}{Value}->new($formula,$x)); |
| 241 : | sh002i | 2558 | } |
| 242 : | } | ||
| 243 : | return (@f); | ||
| 244 : | } | ||
| 245 : | |||
| 246 : | # | ||
| 247 : | # Convert a list of values (and open and close parens) | ||
| 248 : | # to a formula whose type is the list type associated with | ||
| 249 : | # the parens. If the formula is constant, evaluate it. | ||
| 250 : | # | ||
| 251 : | sub formula { | ||
| 252 : | my $self = shift; my $values = shift; | ||
| 253 : | my $class = $self->class; | ||
| 254 : | dpvc | 2579 | my $list = $$context->lists->get($class); |
| 255 : | my $open = $list->{'open'}; | ||
| 256 : | my $close = $list->{'close'}; | ||
| 257 : | dpvc | 2629 | my $paren = $open; $paren = 'list' if $class eq 'List'; |
| 258 : | sh002i | 2558 | my $formula = Value::Formula->blank; |
| 259 : | my @coords = Value::toFormula($formula,@{$values}); | ||
| 260 : | dpvc | 2678 | $formula->{tree} = $formula->{context}{parser}{List}->new($formula,[@coords],0, |
| 261 : | dpvc | 2629 | $formula->{context}{parens}{$paren},$coords[0]->typeRef,$open,$close); |
| 262 : | dpvc | 2660 | $formula->{autoFormula} = 1; # mark that this was generated automatically |
| 263 : | dpvc | 2579 | # return $formula->eval if scalar(%{$formula->{variables}}) == 0; |
| 264 : | sh002i | 2558 | return $formula; |
| 265 : | } | ||
| 266 : | |||
| 267 : | # | ||
| 268 : | # A shortcut for new() that creates an instance of the object, | ||
| 269 : | # but doesn't do the error checking. We assume the data are already | ||
| 270 : | # known to be good. | ||
| 271 : | # | ||
| 272 : | sub make { | ||
| 273 : | my $self = shift; my $class = ref($self) || $self; | ||
| 274 : | bless {data => [@_]}, $class; | ||
| 275 : | } | ||
| 276 : | |||
| 277 : | # | ||
| 278 : | # Return a type structure for the item | ||
| 279 : | # (includes name, length of vectors, and so on) | ||
| 280 : | # | ||
| 281 : | sub Type { | ||
| 282 : | my $name = shift; my $length = shift; my $entryType = shift; | ||
| 283 : | $length = 1 unless defined $length; | ||
| 284 : | return {name => $name, length => $length, entryType => $entryType, | ||
| 285 : | list => (defined $entryType), @_}; | ||
| 286 : | } | ||
| 287 : | |||
| 288 : | # | ||
| 289 : | # Some predefined types | ||
| 290 : | # | ||
| 291 : | %Type = ( | ||
| 292 : | dpvc | 2660 | number => Value::Type('Number',1), |
| 293 : | complex => Value::Type('Number',2), | ||
| 294 : | string => Value::Type('String',1), | ||
| 295 : | infinity => Value::Type('Infinity',1), | ||
| 296 : | unknown => Value::Type('unknown',0,undef,list => 1) | ||
| 297 : | sh002i | 2558 | ); |
| 298 : | |||
| 299 : | # | ||
| 300 : | # Return various information about the object | ||
| 301 : | # | ||
| 302 : | sub value {return @{(shift)->{data}}} # the value of the object (as an array) | ||
| 303 : | sub data {return (shift)->{data}} # the reference to the value | ||
| 304 : | sub length {return (shift)->typeRef->{length}} # the number of coordinates | ||
| 305 : | sub type {return (shift)->typeRef->{name}} # the object type | ||
| 306 : | sub entryType {return (shift)->typeRef->{entryType}} # the coordinate type | ||
| 307 : | # | ||
| 308 : | # The the full type-hash for the item | ||
| 309 : | # | ||
| 310 : | sub typeRef { | ||
| 311 : | my $self = shift; | ||
| 312 : | return Value::Type($self->class, $self->length, $Value::Type{number}); | ||
| 313 : | } | ||
| 314 : | # | ||
| 315 : | # The Value.pm object class | ||
| 316 : | # | ||
| 317 : | sub class { | ||
| 318 : | my $self = shift; my $class = ref($self) || $self; | ||
| 319 : | $class =~ s/Value:://; | ||
| 320 : | return $class; | ||
| 321 : | } | ||
| 322 : | |||
| 323 : | # | ||
| 324 : | # Get an element from a point, vector, matrix, or list | ||
| 325 : | # | ||
| 326 : | sub extract { | ||
| 327 : | dpvc | 2678 | my $M = shift; my $i; my @indices = @_; |
| 328 : | return unless Value::isValue($M); | ||
| 329 : | @indices = $_[0]->value if scalar(@_) == 1 && Value::isValue($_[0]); | ||
| 330 : | while (scalar(@indices) > 0) { | ||
| 331 : | $i = shift @indices; $i-- if $i > 0; $i = $i->value if Value::isValue($i); | ||
| 332 : | sh002i | 2558 | Value::Error("Can't extract element number '$i' (index must be an integer)") |
| 333 : | unless $i =~ m/^-?\d+$/; | ||
| 334 : | $M = $M->data->[$i]; | ||
| 335 : | } | ||
| 336 : | return $M; | ||
| 337 : | } | ||
| 338 : | |||
| 339 : | |||
| 340 : | # | ||
| 341 : | # Promote an operand to the same precedence as the current object | ||
| 342 : | # | ||
| 343 : | sub promotePrecedence { | ||
| 344 : | my $self = shift; my $other = shift; | ||
| 345 : | dpvc | 2579 | my $sprec = $$context->{precedence}{class($self)}; |
| 346 : | my $oprec = $$context->{precedence}{class($other)}; | ||
| 347 : | dpvc | 2646 | return (defined($oprec) && $sprec < $oprec) || |
| 348 : | dpvc | 2654 | ($sprec > $oprec && $sprec >= $$context->{precedence}{special}); |
| 349 : | sh002i | 2558 | } |
| 350 : | |||
| 351 : | dpvc | 2592 | sub promote {shift} |
| 352 : | |||
| 353 : | sh002i | 2558 | # |
| 354 : | # Default stub to call when no function is defined for an operation | ||
| 355 : | # | ||
| 356 : | sub nomethod { | ||
| 357 : | my ($l,$r,$flag,$op) = @_; | ||
| 358 : | dpvc | 2646 | my $call = $$context->{method}{$op}; |
| 359 : | sh002i | 2558 | if (defined($call) && $l->promotePrecedence($r)) {return $r->$call($l,!$flag)} |
| 360 : | my $error = "Can't use '$op' with ".$l->class."-valued operands"; | ||
| 361 : | $error .= " (use '**' for exponentiation)" if $op eq '^'; | ||
| 362 : | Value::Error($error); | ||
| 363 : | } | ||
| 364 : | |||
| 365 : | # | ||
| 366 : | # Stubs for the sub-classes | ||
| 367 : | # | ||
| 368 : | sub add {nomethod(@_,'+')} | ||
| 369 : | sub sub {nomethod(@_,'-')} | ||
| 370 : | sub mult {nomethod(@_,'*')} | ||
| 371 : | sub div {nomethod(@_,'/')} | ||
| 372 : | sub power {nomethod(@_,'**')} | ||
| 373 : | sub cross {nomethod(@_,'x')} | ||
| 374 : | |||
| 375 : | # | ||
| 376 : | # If the right operand is higher precedence, we switch the order. | ||
| 377 : | # | ||
| 378 : | # If the right operand is also a Value object, we do the object's | ||
| 379 : | # dot method to combine the two objects of the same class. | ||
| 380 : | # | ||
| 381 : | # Otherwise, since . is used for string concatenation, we want to retain | ||
| 382 : | # that. Since the resulting string is often used in Formula and will be | ||
| 383 : | dpvc | 2579 | # parsed again, we put parentheses around the values to guarantee that |
| 384 : | sh002i | 2558 | # the values will be treated as one mathematical unit. For example, if |
| 385 : | # $f = Formula("1+x") and $g = Formula("y") then Formula("$f/$g") will be | ||
| 386 : | # (1+x)/y not 1+(x/y), as it would be without the implicit parentheses. | ||
| 387 : | # | ||
| 388 : | sub _dot { | ||
| 389 : | my ($l,$r,$flag) = @_; | ||
| 390 : | return Value::_dot($r,$l,!$flag) if ($l->promotePrecedence($r)); | ||
| 391 : | return $l->dot($r,$flag) if (Value::isValue($r)); | ||
| 392 : | dpvc | 2606 | $l = $l->stringify; $l = '('.$l.')' unless $$Value::context->flag('StringifyAsTeX'); |
| 393 : | sh002i | 2558 | return ($flag)? ($r.$l): ($l.$r); |
| 394 : | } | ||
| 395 : | # | ||
| 396 : | # Some classes override this | ||
| 397 : | # | ||
| 398 : | dpvc | 2603 | sub dot { |
| 399 : | sh002i | 2558 | my ($l,$r,$flag) = @_; |
| 400 : | dpvc | 2606 | my $tex = $$Value::context->flag('StringifyAsTeX'); |
| 401 : | $l = $l->stringify; $l = '('.$l.')' if $tex; | ||
| 402 : | if (ref($r)) {$r = $r->stringify; $r = '('.$l.')' if $tex} | ||
| 403 : | sh002i | 2558 | return ($flag)? ($r.$l): ($l.$r); |
| 404 : | } | ||
| 405 : | |||
| 406 : | # | ||
| 407 : | # Compare the values of the objects | ||
| 408 : | # (list classes should replace this) | ||
| 409 : | # | ||
| 410 : | sub compare { | ||
| 411 : | my ($l,$r,$flag) = @_; | ||
| 412 : | if ($l->promotePrecedence($r)) {return $r->compare($l,!$flag)} | ||
| 413 : | return $l->value <=> $r->value; | ||
| 414 : | } | ||
| 415 : | |||
| 416 : | # | ||
| 417 : | dpvc | 2625 | # Compare the values as strings |
| 418 : | # | ||
| 419 : | sub cmp { | ||
| 420 : | my ($l,$r,$flag) = @_; | ||
| 421 : | if ($l->promotePrecedence($r)) {return $r->compare($l,!$flag)} | ||
| 422 : | $l = $l->stringify; $r = $r->stringify if Value::isValue($r); | ||
| 423 : | if ($flag) {my $tmp = $l; $l = $r; $r = $tmp} | ||
| 424 : | return $l cmp $r; | ||
| 425 : | } | ||
| 426 : | |||
| 427 : | # | ||
| 428 : | sh002i | 2558 | # Generate the various output formats |
| 429 : | dpvc | 2606 | # (can be replaced by sub-classes) |
| 430 : | sh002i | 2558 | # |
| 431 : | dpvc | 2606 | sub stringify { |
| 432 : | my $self = shift; | ||
| 433 : | return $self->TeX() if $$Value::context->flag('StringifyAsTeX'); | ||
| 434 : | dpvc | 2612 | $self->string; |
| 435 : | dpvc | 2606 | } |
| 436 : | sub string {shift->value} | ||
| 437 : | sub TeX {shift->string(@_)} | ||
| 438 : | sh002i | 2558 | # |
| 439 : | # For perl, call the appropriate constructor around the objects data | ||
| 440 : | # | ||
| 441 : | sub perl { | ||
| 442 : | my $self = shift; my $parens = shift; my $matrix = shift; | ||
| 443 : | my $class = $self->class; my $mtype = $class eq 'Matrix'; | ||
| 444 : | my $perl; my @p = (); | ||
| 445 : | foreach my $x (@{$self->data}) { | ||
| 446 : | if (Value::isValue($x)) {push(@p,$x->perl(0,$mtype))} else {push(@p,$x)} | ||
| 447 : | } | ||
| 448 : | @p = ("'".$self->{open}."'",@p,"'".$self->{close}."'") if $class eq 'Interval'; | ||
| 449 : | if ($matrix) { | ||
| 450 : | $perl = '['.join(',',@p).']'; | ||
| 451 : | } else { | ||
| 452 : | $perl = $class.'('.join(',',@p).')'; | ||
| 453 : | $perl = '('.$perl.')' if $parens == 1; | ||
| 454 : | } | ||
| 455 : | return $perl; | ||
| 456 : | } | ||
| 457 : | |||
| 458 : | # | ||
| 459 : | # Stubs for when called by Parser | ||
| 460 : | # | ||
| 461 : | sub eval {shift} | ||
| 462 : | sub reduce {shift} | ||
| 463 : | |||
| 464 : | dpvc | 2579 | sub ijk { |
| 465 : | Value::Error("Can't use method 'ijk' with objects of type '".(shift)->class."'"); | ||
| 466 : | } | ||
| 467 : | |||
| 468 : | sh002i | 2558 | # |
| 469 : | # Report an error | ||
| 470 : | # | ||
| 471 : | sub Error { | ||
| 472 : | my $message = shift; | ||
| 473 : | dpvc | 2579 | $$context->setError($message,''); |
| 474 : | dpvc | 2628 | die $message . traceback() if $$context->{debug}; |
| 475 : | dpvc | 2592 | die $message . getCaller(); |
| 476 : | sh002i | 2558 | } |
| 477 : | |||
| 478 : | # | ||
| 479 : | # Try to locate the line and file where the error occurred | ||
| 480 : | # | ||
| 481 : | sub getCaller { | ||
| 482 : | my $frame = 2; | ||
| 483 : | while (my ($pkg,$file,$line,$subname) = caller($frame++)) { | ||
| 484 : | return " at line $line of $file\n" | ||
| 485 : | unless $pkg =~ /^(Value|Parser)/ || | ||
| 486 : | $subname =~ m/^(Value|Parser).*(new|call)$/; | ||
| 487 : | } | ||
| 488 : | return ""; | ||
| 489 : | } | ||
| 490 : | |||
| 491 : | dpvc | 2579 | # |
| 492 : | # For debugging | ||
| 493 : | # | ||
| 494 : | sub traceback { | ||
| 495 : | my $frame = 2; | ||
| 496 : | my $trace = ''; | ||
| 497 : | while (my ($pkg,$file,$line,$subname) = caller($frame++)) | ||
| 498 : | {$trace .= " in $subname at line $line of $file\n"} | ||
| 499 : | return $trace; | ||
| 500 : | } | ||
| 501 : | |||
| 502 : | sh002i | 2558 | ########################################################################### |
| 503 : | # | ||
| 504 : | # Load the sub-classes. | ||
| 505 : | # | ||
| 506 : | |||
| 507 : | dpvc | 2579 | use Value::Real; |
| 508 : | sh002i | 2558 | use Value::Complex; |
| 509 : | dpvc | 2603 | use Value::Infinity; |
| 510 : | sh002i | 2558 | use Value::Point; |
| 511 : | use Value::Vector; | ||
| 512 : | use Value::Matrix; | ||
| 513 : | use Value::List; | ||
| 514 : | use Value::Interval; | ||
| 515 : | use Value::Union; | ||
| 516 : | dpvc | 2609 | use Value::String; |
| 517 : | dpvc | 2664 | use Value::Formula; |
| 518 : | sh002i | 2558 | |
| 519 : | dpvc | 2664 | use Value::WeBWorK; # stuff specific to WeBWorK |
| 520 : | dpvc | 2592 | |
| 521 : | sh002i | 2558 | ########################################################################### |
| 522 : | dpvc | 2592 | |
| 523 : | use vars qw($installed); | ||
| 524 : | $Value::installed = 1; | ||
| 525 : | |||
| 526 : | ########################################################################### | ||
| 527 : | ########################################################################### | ||
| 528 : | dpvc | 2576 | # |
| 529 : | # To Do: | ||
| 530 : | # | ||
| 531 : | dpvc | 2579 | # Make Complex class include more of Complex1.pm |
| 532 : | # Make better interval comparison | ||
| 533 : | dpvc | 2576 | # |
| 534 : | ########################################################################### | ||
| 535 : | sh002i | 2558 | |
| 536 : | dpvc | 2592 | 1; |
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |