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

Diff of /trunk/pg/lib/Parser.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

Revision 2664 Revision 2796
1package Parser; 1package Parser;
2my $pkg = "Parser"; 2my $pkg = "Parser";
3
4use strict; 3use strict;
5#use Carp; 4
5#
6# Map class names to packages (added to Context, and
7# can be overriden to customize the parser)
8#
9our $class = {Formula => 'Parser::Formula'};
10
11#
12# Collect the default reduction flags for use in the context
13#
14our $reduce = {};
6 15
7################################################## 16##################################################
8# 17#
9# Parse a string and create a new Parser object 18# Parse a string and create a new Parser object
10# If the string is already a parsed object then copy the parse tree 19# If the string is already a parsed object then copy the parse tree
23 }, $class; 32 }, $class;
24 if (ref($string) =~ m/^(Parser|Value::Formula)/) { 33 if (ref($string) =~ m/^(Parser|Value::Formula)/) {
25 my $tree = $string; $tree = $tree->{tree} if exists $tree->{tree}; 34 my $tree = $string; $tree = $tree->{tree} if exists $tree->{tree};
26 $math->{tree} = $tree->copy($math); 35 $math->{tree} = $tree->copy($math);
27 } elsif (Value::isValue($string)) { 36 } elsif (Value::isValue($string)) {
28 $math->{tree} = Parser::Value->new($math,$string); 37 $math->{tree} = $math->{context}{parser}{Value}->new($math,$string);
29 } else { 38 } else {
30 $math->{string} = $string; 39 $math->{string} = $string;
31 $math->tokenize; 40 $math->tokenize;
32 $math->parse; 41 $math->parse;
33 } 42 }
136 die $message . Value::getCaller(); 145 die $message . Value::getCaller();
137} 146}
138 147
139# 148#
140# Insert an implicit multiplication 149# Insert an implicit multiplication
150# (fix up the reference for spaces or juxtaposition)
141# 151#
142sub ImplicitMult { 152sub ImplicitMult {
143 my $self = shift; 153 my $self = shift;
144 my $ref = $self->{ref}; 154 my $ref = $self->{ref}; my $iref = [@{$ref}];
155 $iref->[2]--; $iref->[3] = $iref->[2]+1;
156 $iref->[3]++ unless substr($self->{string},$iref->[2],1) eq ' ';
145 $self->Error("Can't perform implied multiplication in this context",$ref) 157 $self->Error("Can't perform implied multiplication in this context",$iref)
146 unless $self->{context}{operators}{' '}{class}; 158 unless $self->{context}{operators}{' '}{class};
147 $self->Op(' '); 159 $self->Op(' ',$iref);
148 $self->{ref} = $ref; 160 $self->{ref} = $ref;
149} 161}
150 162
151# 163#
152# Push an operator onto the expression stack. 164# Push an operator onto the expression stack.
211 } else { 223 } else {
212 $self->Precedence($op->{precedence}); 224 $self->Precedence($op->{precedence});
213 if ($self->state eq 'operand') { 225 if ($self->state eq 'operand') {
214 if ($op->{type} eq 'unary') { 226 if ($op->{type} eq 'unary') {
215 my $top = $self->pop; 227 my $top = $self->pop;
216 $self->pushOperand(Parser::UOP->new($self,$name,$top->{value},$ref)); 228 $self->pushOperand($context->{parser}{UOP}->new($self,$name,$top->{value},$ref));
217 } else { 229 } else {
218 $name = $context->{operators}{' '}{string} 230 $name = $context->{operators}{' '}{string}
219 if $name eq ' ' or $name eq $context->{operators}{' '}{space}; 231 if $name eq ' ' or $name eq $context->{operators}{' '}{space};
220 $self->pushOperator($name,$op->{precedence}); 232 $self->pushOperator($name,$op->{precedence});
221 } 233 }
222 } elsif ($ref || $self->state ne 'fn') {$self->Op($name,$ref)} 234 } elsif (($ref && $name ne ' ') || $self->state ne 'fn') {$self->Op($name,$ref)}
223 } 235 }
224 } else { 236 } else {
225 $name = 'u'.$name, $op = $context->{operators}{$name} 237 $name = 'u'.$name, $op = $context->{operators}{$name}
226 if ($op->{type} eq 'both' && defined $context->{operators}{'u'.$name}); 238 if ($op->{type} eq 'both' && defined $context->{operators}{'u'.$name});
227 if ($op->{type} eq 'unary' && $op->{associativity} eq 'left') { 239 if ($op->{type} eq 'unary' && $op->{associativity} eq 'left') {
278# If the parens can't be removed, or if the operand is a list 290# If the parens can't be removed, or if the operand is a list
279# Make the operand into a list object 291# Make the operand into a list object
280# Replace the paren object with the operand 292# Replace the paren object with the operand
281# If the parentheses are used for function calls and the 293# If the parentheses are used for function calls and the
282# previous stack object is a function call, do the function apply 294# previous stack object is a function call, do the function apply
295# Otherwise if the parens can form Intervals, do so
283# Otherwise report an appropriate error message 296# Otherwise report an appropriate error message
284# 297#
285# A function: 298# A function:
286# Report an error message about missing inputs 299# Report an error message about missing inputs
287# 300#
288# An operator: 301# An operator:
289# Report the missing operation 302# Report the missing operation
290# 303#
291sub Close { 304sub Close {
292 my $self = shift; my $type = shift; 305 my $self = shift; my $type = shift;
293 my $ref = $self->{ref} = shift; 306 my $ref = $self->{ref} = shift;
307 my $parser = $self->{context}{parser};
294 my $parens = $self->{context}{parens}; 308 my $parens = $self->{context}{parens};
295 309
296 for ($self->state) { 310 for ($self->state) {
297 /open/ and do { 311 /open/ and do {
298 my $top = $self->pop; my $paren = $parens->{$top->{value}}; 312 my $top = $self->pop; my $paren = $parens->{$top->{value}};
299 if ($paren->{emptyOK} && $paren->{close} eq $type) { 313 if ($paren->{emptyOK} && $paren->{close} eq $type) {
300 $self->pushOperand(Parser::List->new($self,[],1,$paren)) 314 $self->pushOperand($parser->{List}->new($self,[],1,$paren))
301 } 315 }
302 elsif ($type eq 'start') {$self->Error("Missing close parenthesis for '$top->{value}'",$top->{ref})} 316 elsif ($type eq 'start') {$self->Error("Missing close parenthesis for '$top->{value}'",$top->{ref})}
303 elsif ($top->{value} eq 'start') {$self->Error("Extra close parenthesis '$type'",$ref)} 317 elsif ($top->{value} eq 'start') {$self->Error("Extra close parenthesis '$type'",$ref)}
304 else {$top->{ref}[3]=$ref->[3]; $self->Error("Empty parentheses",$top->{ref})} 318 else {$top->{ref}[3]=$ref->[3]; $self->Error("Empty parentheses",$top->{ref})}
305 last; 319 last;
312 if ($paren->{close} eq $type) { 326 if ($paren->{close} eq $type) {
313 my $top = $self->pop; 327 my $top = $self->pop;
314 if (!$paren->{removable} || ($top->{value}->type eq "Comma")) { 328 if (!$paren->{removable} || ($top->{value}->type eq "Comma")) {
315 $top = $top->{value}; 329 $top = $top->{value};
316 $top = {type => 'operand', value => 330 $top = {type => 'operand', value =>
317 Parser::List->new($self,[$top->makeList],$top->{isConstant},$paren, 331 $parser->{List}->new($self,[$top->makeList],$top->{isConstant},$paren,
318 ($top->type eq 'Comma') ? $top->entryType : $top->typeRef, 332 ($top->type eq 'Comma') ? $top->entryType : $top->typeRef,
319 ($type ne 'start') ? ($self->top->{value},$type) : () )}; 333 ($type ne 'start') ? ($self->top->{value},$type) : () )};
320 } 334 }
321 $self->pop; $self->push($top); 335 $self->pop; $self->push($top);
322 $self->CloseFn() if ($paren->{function} && $self->prev->{type} eq 'fn'); 336 $self->CloseFn() if ($paren->{function} && $self->prev->{type} eq 'fn');
323 } elsif ($paren->{formInterval} eq $type && $self->top->{value}->length == 2) { 337 } elsif ($paren->{formInterval} eq $type && $self->top->{value}->length == 2) {
324 my $top = $self->pop->{value}; my $open = $self->pop->{value}; 338 my $top = $self->pop->{value}; my $open = $self->pop->{value};
325 $self->pushOperand( 339 $self->pushOperand(
326 Parser::List->new($self,[$top->makeList],$top->{isConstant}, 340 $parser->{List}->new($self,[$top->makeList],$top->{isConstant},
327 $paren,$top->entryType,$open,$type)); 341 $paren,$top->entryType,$open,$type));
328 } else { 342 } else {
329 my $prev = $self->prev; 343 my $prev = $self->prev;
330 if ($type eq "start") {$self->Error("Missing close parenthesis for '$prev->{value}'",$prev->{ref})} 344 if ($type eq "start") {$self->Error("Missing close parenthesis for '$prev->{value}'",$prev->{ref})}
331 elsif ($prev->{value} eq "start") {$self->Error("Extra close parenthesis '$type'",$ref)} 345 elsif ($prev->{value} eq "start") {$self->Error("Extra close parenthesis '$type'",$ref)}
332 else {$self->Error("Mismatched parentheses: '$prev->{value}' and '$type'",$ref)} 346 else {$self->Error("Mismatched parentheses: '$prev->{value}' and '$type'",$ref)}
405 $self->push($fun); 419 $self->push($fun);
406 } else {$self->push($top,$op,$fun)} 420 } else {$self->push($top,$op,$fun)}
407 } else { 421 } else {
408 my $rop = $self->pop; my $op = $self->pop; my $lop = $self->pop; 422 my $rop = $self->pop; my $op = $self->pop; my $lop = $self->pop;
409 if ($op->{reverse}) {my $tmp = $rop; $rop = $lop; $lop = $tmp} 423 if ($op->{reverse}) {my $tmp = $rop; $rop = $lop; $lop = $tmp}
410 $self->pushOperand(Parser::BOP->new($self,$op->{name}, 424 $self->pushOperand($context->{parser}{BOP}->new($self,$op->{name},
411 $lop->{value},$rop->{value},$op->{ref}),$op->{reverse}); 425 $lop->{value},$rop->{value},$op->{ref}),$op->{reverse});
412 } 426 }
413 } else { 427 } else {
414 my $rop = $self->pop; my $op = $self->pop; 428 my $rop = $self->pop; my $op = $self->pop;
415 $self->pushOperand(Parser::UOP->new 429 $self->pushOperand($context->{parser}{UOP}->new
416 ($self,$op->{name},$rop->{value},$op->{ref}),$op->{reverse}); 430 ($self,$op->{name},$rop->{value},$op->{ref}),$op->{reverse});
417 } 431 }
418 last; 432 last;
419 }; 433 };
420 434
445 my $constant = $top->{isConstant}; 459 my $constant = $top->{isConstant};
446 if ($context->{parens}{$top->{open}}{function} && 460 if ($context->{parens}{$top->{open}}{function} &&
447 $context->{parens}{$top->{open}}{close} eq $top->{close} && 461 $context->{parens}{$top->{open}}{close} eq $top->{close} &&
448 !$context->{functions}{$fn->{name}}{vectorInput}) 462 !$context->{functions}{$fn->{name}}{vectorInput})
449 {$top = $top->coords} else {$top = [$top]} 463 {$top = $top->coords} else {$top = [$top]}
450 $self->pushOperand(Parser::Function->new 464 $self->pushOperand($context->{parser}{Function}->new
451 ($self,$fn->{name},$top,$constant,$fn->{ref})); 465 ($self,$fn->{name},$top,$constant,$fn->{ref}));
452} 466}
453 467
454################################################## 468##################################################
455# 469#
460# Save the number as an operand 474# Save the number as an operand
461# 475#
462sub Num { 476sub Num {
463 my $self = shift; 477 my $self = shift;
464 $self->ImplicitMult() if $self->state eq 'operand'; 478 $self->ImplicitMult() if $self->state eq 'operand';
465 my $num = Parser::Number->new($self,shift,$self->{ref}); 479 my $num = $self->{context}{parser}{Number}->new($self,shift,$self->{ref});
466 my $check = $self->{context}->flag('NumberCheck'); 480 my $check = $self->{context}->flag('NumberCheck');
467 &$check($num) if $check; 481 &$check($num) if $check;
468 $self->pushOperand($num); 482 $self->pushOperand($num);
469} 483}
470 484
474# 488#
475# Add an implicit multiplication, if needed 489# Add an implicit multiplication, if needed
476# Save the number as an operand 490# Save the number as an operand
477# 491#
478sub Const { 492sub Const {
479 my $self = shift; my $ref = $self->{ref}; 493 my $self = shift; my $ref = $self->{ref}; my $name = shift;
480 my $name = shift; my $const = $self->{context}{constants}{$name}; 494 my $const = $self->{context}{constants}{$name};
495 my $parser = $self->{context}{parser};
481 $self->ImplicitMult() if $self->state eq 'operand'; 496 $self->ImplicitMult() if $self->state eq 'operand';
482 if (defined($self->{context}{variables}{$name})) { 497 if (defined($self->{context}{variables}{$name})) {
483 $self->pushOperand(Parser::Variable->new($self,$name,$ref)); 498 $self->pushOperand($parser->{Variable}->new($self,$name,$ref));
484 } elsif ($const->{keepName}) { 499 } elsif ($const->{keepName}) {
485 $self->pushOperand(Parser::Constant->new($self,$name,$ref)); 500 $self->pushOperand($parser->{Constant}->new($self,$name,$ref));
486 } else { 501 } else {
487 $self->pushOperand(Parser::Value->new($self,[$const->{value}],$ref)); 502 $self->pushOperand($parser->{Value}->new($self,[$const->{value}],$ref));
488 } 503 }
489} 504}
490 505
491################################################## 506##################################################
492# 507#
496# Save the variable as an operand 511# Save the variable as an operand
497# 512#
498sub Var { 513sub Var {
499 my $self = shift; 514 my $self = shift;
500 $self->ImplicitMult() if $self->state eq 'operand'; 515 $self->ImplicitMult() if $self->state eq 'operand';
501 $self->pushOperand(Parser::Variable->new($self,shift,$self->{ref})); 516 $self->pushOperand($self->{context}{parser}{Variable}->new($self,shift,$self->{ref}));
502} 517}
503 518
504################################################## 519##################################################
505# 520#
506# Handle a function token 521# Handle a function token
522# Save the string object on the stack 537# Save the string object on the stack
523# 538#
524sub Str { 539sub Str {
525 my $self = shift; 540 my $self = shift;
526 $self->ImplicitMult() if $self->state eq 'operand'; 541 $self->ImplicitMult() if $self->state eq 'operand';
527 $self->pushOperand(Parser::String->new($self,shift,$self->{ref})); 542 $self->pushOperand($self->{context}{parser}{String}->new($self,shift,$self->{ref}));
528} 543}
529 544
530################################################## 545##################################################
531################################################## 546##################################################
532# 547#
543} 558}
544 559
545################################################## 560##################################################
546# 561#
547# Removes redundent items (like x+-y, 0+x and 1*x, etc) 562# Removes redundent items (like x+-y, 0+x and 1*x, etc)
548# (substituting the given values). 563# using the provided flags
549# 564#
550sub reduce { 565sub reduce {
551 my $self = shift; 566 my $self = shift;
552 $self = $self->copy($self); 567 $self = $self->copy($self);
553 $self->setValues(@_); 568 my $reduce = $self->{context}{reduction};
569 $self->{context}{reduction} = {%{$reduce},@_};
554 $self->{tree} = $self->{tree}->reduce; 570 $self->{tree} = $self->{tree}->reduce;
555 $self->{variables} = $self->{tree}->getVariables; 571 $self->{variables} = $self->{tree}->getVariables;
572 $self->{context}{reduction} = $reduce if $reduce;
556 return $self; 573 return $self;
557} 574}
558 575
559################################################## 576##################################################
560# 577#
649 666
650 667
651################################################## 668##################################################
652################################################## 669##################################################
653# 670#
654# Convert a student answer to a formula, with error trapping.
655# If the result is undef, there was an error (message is in Context()->{error} object)
656#
657
658sub Formula {
659 my $f = shift;
660 my $v = eval {Value::Formula->new($f)};
661 $$Value::context->setError($@) unless defined($v) ||
662 $$Value::context->{error}{flag};
663 return $v;
664}
665
666#
667# Evaluate a formula, with error trapping.
668# If the result is undef, there was an error (message is in Context()->{error} object)
669# If the result was a real, make it a fuzzy one.
670#
671sub Evaluate {
672 my $f = shift;
673 return unless defined($f);
674 my $v = eval {$f->eval(@_)};
675 if (defined($v)) {$v = Value::makeValue($v)}
676 else {$f->setError($@) unless $f->{context}{error}{flag}}
677 return $v;
678}
679
680
681##################################################
682##################################################
683#
684# Produce a vector in ijk form 671# Produce a vector in ijk form
685# 672#
686sub ijk { 673sub ijk {
687 my $self = shift; 674 my $self = shift;
688 $self->{tree}->ijk; 675 $self->{tree}->ijk;
710# 697#
711# To Do: 698# To Do:
712# 699#
713# handle sqrt(-1) and log of negatives (make complexes) 700# handle sqrt(-1) and log of negatives (make complexes)
714# do division by zero and log of zero checks in compound functions 701# do division by zero and log of zero checks in compound functions
715# add context flags for various reduction checks
716# make context flag for reduction of constants
717# make reduce have reduce patterns as parameters 702# make reduce have reduce patterns as parameters
718# more reduce patterns 703# more reduce patterns
719# make operator strings customizable (reduce, and other places they are used) 704# make operator strings customizable (reduce, and other places they are used)
720# add parens alternately as () and []?
721# 705#
722######################################################################### 706#########################################################################
723 707
7241; 7081;
725 709

Legend:
Removed from v.2664  
changed lines
  Added in v.2796

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9