[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 2579 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
11# If it is a Value, make an appropriate tree for it. 20# If it is a Value, make an appropriate tree for it.
12# 21#
13sub new { 22sub new {
14 my $self = shift; my $class = ref($self) || $self; 23 my $self = shift; my $class = ref($self) || $self;
15 my $string = shift; 24 my $string = shift;
25 $string = Value::List->new($string,@_)
26 if scalar(@_) > 0 || ref($string) eq 'ARRAY';
16 my $math = bless { 27 my $math = bless {
17 string => undef, 28 string => undef,
18 tokens => [], tree => undef, 29 tokens => [], tree => undef,
19 variables => {}, values => {}, 30 variables => {}, values => {},
20 context => Parser::Context->current, 31 context => Parser::Context->current,
21 }, $class; 32 }, $class;
22 if (ref($string) =~ m/^(Parser|Value::Formula)/) { 33 if (ref($string) =~ m/^(Parser|Value::Formula)/) {
23 my $tree = $string; $tree = $tree->{tree} if exists $tree->{tree}; 34 my $tree = $string; $tree = $tree->{tree} if exists $tree->{tree};
24 $math->{tree} = $tree->copy($math); 35 $math->{tree} = $tree->copy($math);
25 } elsif (ref($string) =~ m/^Value/) { 36 } elsif (Value::isValue($string)) {
26 $math->{tree} = Parser::Value->new($math,$string); 37 $math->{tree} = $math->{context}{parser}{Value}->new($math,$string);
27 } else { 38 } else {
28 $math->{string} = $string; 39 $math->{string} = $string;
29 $math->tokenize; 40 $math->tokenize;
30 $math->parse; 41 $math->parse;
31 } 42 }
56 push(@{$tokens},['op',$5,$p0,$p1,$space]) if (defined($5)); 67 push(@{$tokens},['op',$5,$p0,$p1,$space]) if (defined($5));
57 push(@{$tokens},['open',$6,$p0,$p1,$space]) if (defined($6)); 68 push(@{$tokens},['open',$6,$p0,$p1,$space]) if (defined($6));
58 push(@{$tokens},['close',$7,$p0,$p1,$space]) if (defined($7)); 69 push(@{$tokens},['close',$7,$p0,$p1,$space]) if (defined($7));
59 push(@{$tokens},['var',$8,$p0,$p1,$space]) if (defined($8)); 70 push(@{$tokens},['var',$8,$p0,$p1,$space]) if (defined($8));
60 } else { 71 } else {
61 push(@{$tokens},['error',substr($string,$p0,3),$p0]); 72 push(@{$tokens},['error',substr($string,$p0,1),$p0,$p0+1]);
62 $self->{error} = 1; 73 $self->{error} = 1;
63 last; 74 last;
64 } 75 }
65 $space = ($string =~ m/\G\s+/gc); 76 $space = ($string =~ m/\G\s+/gc);
66 } 77 }
89 /num/ and do {$self->Num($ref->[1]); last}; 100 /num/ and do {$self->Num($ref->[1]); last};
90 /const/ and do {$self->Const($ref->[1]); last}; 101 /const/ and do {$self->Const($ref->[1]); last};
91 /var/ and do {$self->Var($ref->[1]); last}; 102 /var/ and do {$self->Var($ref->[1]); last};
92 /fn/ and do {$self->Fn($ref->[1]); last}; 103 /fn/ and do {$self->Fn($ref->[1]); last};
93 /str/ and do {$self->Str($ref->[1]); last}; 104 /str/ and do {$self->Str($ref->[1]); last};
94 /error/ and do {$self->Error("Unexpected characters '$ref->[1]'",$ref); last}; 105 /error/ and do {$self->Error("Unexpected character '$ref->[1]'",$ref); last};
95 } 106 }
96 return if ($self->{error}); 107 return if ($self->{error});
97 } 108 }
98 $self->Close('start'); return if ($self->{error}); 109 $self->Close('start'); return if ($self->{error});
99 $self->{tree} = $self->{stack}->[0]->{value}; 110 $self->{tree} = $self->{stack}->[0]->{value};
130 $string = $self->{string}; 141 $string = $self->{string};
131 $ref = [$ref->[2],$ref->[3]]; 142 $ref = [$ref->[2],$ref->[3]];
132 } 143 }
133 $context->setError($message,$string,$ref); 144 $context->setError($message,$string,$ref);
134 die $message . Value::getCaller(); 145 die $message . Value::getCaller();
135# confess $message;
136} 146}
137 147
138# 148#
139# Insert an implicit multiplication 149# Insert an implicit multiplication
150# (fix up the reference for spaces or juxtaposition)
140# 151#
141sub ImplicitMult { 152sub ImplicitMult {
142 my $self = shift; 153 my $self = shift;
143 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 ' ';
157 $self->Error("Can't perform implied multiplication in this context",$iref)
158 unless $self->{context}{operators}{' '}{class};
144 $self->Op(' '); 159 $self->Op(' ',$iref);
145 $self->{ref} = $ref; 160 $self->{ref} = $ref;
146} 161}
147 162
148# 163#
149# Push an operator onto the expression stack. 164# Push an operator onto the expression stack.
208 } else { 223 } else {
209 $self->Precedence($op->{precedence}); 224 $self->Precedence($op->{precedence});
210 if ($self->state eq 'operand') { 225 if ($self->state eq 'operand') {
211 if ($op->{type} eq 'unary') { 226 if ($op->{type} eq 'unary') {
212 my $top = $self->pop; 227 my $top = $self->pop;
213 $self->pushOperand(Parser::UOP->new($self,$name,$top->{value},$ref)); 228 $self->pushOperand($context->{parser}{UOP}->new($self,$name,$top->{value},$ref));
214 } else { 229 } else {
215 $name = $context->{operators}{' '}{string} 230 $name = $context->{operators}{' '}{string}
216 if $name eq ' ' or $name eq $context->{operators}{' '}{space}; 231 if $name eq ' ' or $name eq $context->{operators}{' '}{space};
217 $self->pushOperator($name,$op->{precedence}); 232 $self->pushOperator($name,$op->{precedence});
218 } 233 }
219 } elsif ($ref || $self->state ne 'fn') {$self->Op($name,$ref)} 234 } elsif (($ref && $name ne ' ') || $self->state ne 'fn') {$self->Op($name,$ref)}
220 } 235 }
221 } else { 236 } else {
222 $name = 'u'.$name, $op = $context->{operators}{$name} 237 $name = 'u'.$name, $op = $context->{operators}{$name}
223 if ($op->{type} eq 'both' && defined $context->{operators}{'u'.$name}); 238 if ($op->{type} eq 'both' && defined $context->{operators}{'u'.$name});
224 if ($op->{type} eq 'unary' && $op->{associativity} eq 'left') { 239 if ($op->{type} eq 'unary' && $op->{associativity} eq 'left') {
275# 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
276# Make the operand into a list object 291# Make the operand into a list object
277# Replace the paren object with the operand 292# Replace the paren object with the operand
278# If the parentheses are used for function calls and the 293# If the parentheses are used for function calls and the
279# 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
280# Otherwise report an appropriate error message 296# Otherwise report an appropriate error message
281# 297#
282# A function: 298# A function:
283# Report an error message about missing inputs 299# Report an error message about missing inputs
284# 300#
285# An operator: 301# An operator:
286# Report the missing operation 302# Report the missing operation
287# 303#
288sub Close { 304sub Close {
289 my $self = shift; my $type = shift; 305 my $self = shift; my $type = shift;
290 my $ref = $self->{ref} = shift; 306 my $ref = $self->{ref} = shift;
307 my $parser = $self->{context}{parser};
291 my $parens = $self->{context}{parens}; 308 my $parens = $self->{context}{parens};
292 309
293 for ($self->state) { 310 for ($self->state) {
294 /open/ and do { 311 /open/ and do {
295 my $top = $self->pop; my $paren = $parens->{$top->{value}}; 312 my $top = $self->pop; my $paren = $parens->{$top->{value}};
296 if ($paren->{emptyOK} && $paren->{close} eq $type) { 313 if ($paren->{emptyOK} && $paren->{close} eq $type) {
297 $self->pushOperand(Parser::List->new($self,[],1,$paren)) 314 $self->pushOperand($parser->{List}->new($self,[],1,$paren))
298 } 315 }
299 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})}
300 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)}
301 else {$self->Error("Empty parentheses: '$top->{value} $type'",$top->{ref})} 318 else {$top->{ref}[3]=$ref->[3]; $self->Error("Empty parentheses",$top->{ref})}
302 last; 319 last;
303 }; 320 };
304 321
305 /operand/ and do { 322 /operand/ and do {
306 $self->Precedence(0); return if ($self->{error}); 323 $self->Precedence(0); return if ($self->{error});
309 if ($paren->{close} eq $type) { 326 if ($paren->{close} eq $type) {
310 my $top = $self->pop; 327 my $top = $self->pop;
311 if (!$paren->{removable} || ($top->{value}->type eq "Comma")) { 328 if (!$paren->{removable} || ($top->{value}->type eq "Comma")) {
312 $top = $top->{value}; 329 $top = $top->{value};
313 $top = {type => 'operand', value => 330 $top = {type => 'operand', value =>
314 Parser::List->new($self,[$top->makeList],$top->{isConstant},$paren, 331 $parser->{List}->new($self,[$top->makeList],$top->{isConstant},$paren,
315 ($top->type eq 'Comma') ? $top->entryType : $top->typeRef, 332 ($top->type eq 'Comma') ? $top->entryType : $top->typeRef,
316 ($type ne 'start') ? ($self->top->{value},$type) : () )}; 333 ($type ne 'start') ? ($self->top->{value},$type) : () )};
317 } 334 }
318 $self->pop; $self->push($top); 335 $self->pop; $self->push($top);
319 $self->CloseFn() if ($paren->{function} && $self->prev->{type} eq 'fn'); 336 $self->CloseFn() if ($paren->{function} && $self->prev->{type} eq 'fn');
320 } elsif ($paren->{formInterval} eq $type && $self->top->{value}->length == 2) { 337 } elsif ($paren->{formInterval} eq $type && $self->top->{value}->length == 2) {
321 my $top = $self->pop->{value}; my $open = $self->pop->{value}; 338 my $top = $self->pop->{value}; my $open = $self->pop->{value};
322 $self->pushOperand( 339 $self->pushOperand(
323 Parser::List->new($self,[$top->makeList],$top->{isConstant}, 340 $parser->{List}->new($self,[$top->makeList],$top->{isConstant},
324 $paren,$top->entryType,$open,$type)); 341 $paren,$top->entryType,$open,$type));
325 } else { 342 } else {
326 my $prev = $self->prev; 343 my $prev = $self->prev;
327 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})}
328 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)}
329 else {$self->Error("Mismatched parentheses: '$prev->{value}' and '$type'",$ref)} 346 else {$self->Error("Mismatched parentheses: '$prev->{value}' and '$type'",$ref)}
402 $self->push($fun); 419 $self->push($fun);
403 } else {$self->push($top,$op,$fun)} 420 } else {$self->push($top,$op,$fun)}
404 } else { 421 } else {
405 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;
406 if ($op->{reverse}) {my $tmp = $rop; $rop = $lop; $lop = $tmp} 423 if ($op->{reverse}) {my $tmp = $rop; $rop = $lop; $lop = $tmp}
407 $self->pushOperand(Parser::BOP->new($self,$op->{name}, 424 $self->pushOperand($context->{parser}{BOP}->new($self,$op->{name},
408 $lop->{value},$rop->{value},$op->{ref}),$op->{reverse}); 425 $lop->{value},$rop->{value},$op->{ref}),$op->{reverse});
409 } 426 }
410 } else { 427 } else {
411 my $rop = $self->pop; my $op = $self->pop; 428 my $rop = $self->pop; my $op = $self->pop;
412 $self->pushOperand(Parser::UOP->new 429 $self->pushOperand($context->{parser}{UOP}->new
413 ($self,$op->{name},$rop->{value},$op->{ref}),$op->{reverse}); 430 ($self,$op->{name},$rop->{value},$op->{ref}),$op->{reverse});
414 } 431 }
415 last; 432 last;
416 }; 433 };
417 434
442 my $constant = $top->{isConstant}; 459 my $constant = $top->{isConstant};
443 if ($context->{parens}{$top->{open}}{function} && 460 if ($context->{parens}{$top->{open}}{function} &&
444 $context->{parens}{$top->{open}}{close} eq $top->{close} && 461 $context->{parens}{$top->{open}}{close} eq $top->{close} &&
445 !$context->{functions}{$fn->{name}}{vectorInput}) 462 !$context->{functions}{$fn->{name}}{vectorInput})
446 {$top = $top->coords} else {$top = [$top]} 463 {$top = $top->coords} else {$top = [$top]}
447 $self->pushOperand(Parser::Function->new 464 $self->pushOperand($context->{parser}{Function}->new
448 ($self,$fn->{name},$top,$constant,$fn->{ref})); 465 ($self,$fn->{name},$top,$constant,$fn->{ref}));
449} 466}
450 467
451################################################## 468##################################################
452# 469#
453# Handle a numeric token 470# Handle a numeric token
471#
472# Add an implicit multiplication, if needed
473# Create the number object and check it
474# Save the number as an operand
475#
476sub Num {
477 my $self = shift;
478 $self->ImplicitMult() if $self->state eq 'operand';
479 my $num = $self->{context}{parser}{Number}->new($self,shift,$self->{ref});
480 my $check = $self->{context}->flag('NumberCheck');
481 &$check($num) if $check;
482 $self->pushOperand($num);
483}
484
485##################################################
486#
487# Handle a constant token
454# 488#
455# Add an implicit multiplication, if needed 489# Add an implicit multiplication, if needed
456# Save the number as an operand 490# Save the number as an operand
457# 491#
458sub Num {
459 my $self = shift;
460 $self->ImplicitMult() if $self->state eq 'operand';
461 $self->pushOperand(Parser::Number->new($self,shift,$self->{ref}));
462}
463
464##################################################
465#
466# Handle a constant token
467#
468# Add an implicit multiplication, if needed
469# Save the number as an operand
470#
471sub Const { 492sub Const {
472 my $self = shift; my $ref = $self->{ref}; 493 my $self = shift; my $ref = $self->{ref}; my $name = shift;
473 my $name = shift; my $const = $self->{context}{constants}{$name}; 494 my $const = $self->{context}{constants}{$name};
495 my $parser = $self->{context}{parser};
474 $self->ImplicitMult() if $self->state eq 'operand'; 496 $self->ImplicitMult() if $self->state eq 'operand';
475 if (defined($self->{context}{variables}{$name})) { 497 if (defined($self->{context}{variables}{$name})) {
476 $self->pushOperand(Parser::Variable->new($self,$name,$ref)); 498 $self->pushOperand($parser->{Variable}->new($self,$name,$ref));
477 } elsif ($const->{keepName}) { 499 } elsif ($const->{keepName}) {
478 $self->pushOperand(Parser::Constant->new($self,$name,$ref)); 500 $self->pushOperand($parser->{Constant}->new($self,$name,$ref));
479 } else { 501 } else {
480 $self->pushOperand(Parser::Value->new($self,[$const->{value}],$ref)); 502 $self->pushOperand($parser->{Value}->new($self,[$const->{value}],$ref));
481 } 503 }
482} 504}
483 505
484################################################## 506##################################################
485# 507#
489# Save the variable as an operand 511# Save the variable as an operand
490# 512#
491sub Var { 513sub Var {
492 my $self = shift; 514 my $self = shift;
493 $self->ImplicitMult() if $self->state eq 'operand'; 515 $self->ImplicitMult() if $self->state eq 'operand';
494 $self->pushOperand(Parser::Variable->new($self,shift,$self->{ref})); 516 $self->pushOperand($self->{context}{parser}{Variable}->new($self,shift,$self->{ref}));
495} 517}
496 518
497################################################## 519##################################################
498# 520#
499# Handle a function token 521# Handle a function token
515# Save the string object on the stack 537# Save the string object on the stack
516# 538#
517sub Str { 539sub Str {
518 my $self = shift; 540 my $self = shift;
519 $self->ImplicitMult() if $self->state eq 'operand'; 541 $self->ImplicitMult() if $self->state eq 'operand';
520 $self->pushOperand(Parser::String->new($self,shift,$self->{ref})); 542 $self->pushOperand($self->{context}{parser}{String}->new($self,shift,$self->{ref}));
521} 543}
522 544
523################################################## 545##################################################
524################################################## 546##################################################
525# 547#
536} 558}
537 559
538################################################## 560##################################################
539# 561#
540# 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)
541# (substituting the given values). 563# using the provided flags
542# 564#
543sub reduce { 565sub reduce {
544 my $self = shift; 566 my $self = shift;
545 $self = $self->copy($self); 567 $self = $self->copy($self);
546 $self->setValues(@_); 568 my $reduce = $self->{context}{reduction};
569 $self->{context}{reduction} = {%{$reduce},@_};
547 $self->{tree} = $self->{tree}->reduce; 570 $self->{tree} = $self->{tree}->reduce;
548 $self->{variables} = $self->{tree}->getVariables; 571 $self->{variables} = $self->{tree}->getVariables;
572 $self->{context}{reduction} = $reduce if $reduce;
549 return $self; 573 return $self;
550} 574}
551 575
552################################################## 576##################################################
553# 577#
629 my $self = shift; my ($value,$type); 653 my $self = shift; my ($value,$type);
630 my $variables = $self->{context}{variables}; 654 my $variables = $self->{context}{variables};
631 $self->{values} = {@_}; 655 $self->{values} = {@_};
632 foreach my $x (keys %{$self->{values}}) { 656 foreach my $x (keys %{$self->{values}}) {
633 $self->Error("Undeclared variable '$x'") unless defined $variables->{$x}; 657 $self->Error("Undeclared variable '$x'") unless defined $variables->{$x};
634 $value = $self->{values}{$x}; 658 $value = Value::makeValue($self->{values}{$x});
635 $value = Value::Formula->new($value) unless 659 $value = Value::Formula->new($value) unless Value::isValue($value);
636 Value::matchNumber($value) || Value::isFormula($value) || Value::isValue($value);
637 if (Value::isFormula($value)) {$type = $value->typeRef}
638 else {($value,$type) = Value::getValueType($self,$value)} 660 ($value,$type) = Value::getValueType($self,$value);
639 $self->Error("Variable '$x' should be of type $variables->{$x}{type}{name}") 661 $self->Error("Variable '$x' should be of type $variables->{$x}{type}{name}")
640 unless Parser::Item::typeMatch($type,$variables->{$x}{type}); 662 unless Parser::Item::typeMatch($type,$variables->{$x}{type});
641 $self->{values}{$x} = $value; 663 $self->{values}{$x} = $value;
642 } 664 }
643} 665}
644 666
645 667
659# Load the sub-classes and Value.pm 681# Load the sub-classes and Value.pm
660# 682#
661 683
662use Parser::Item; 684use Parser::Item;
663use Value; 685use Value;
664use Value::Formula;
665use Parser::Context; 686use Parser::Context;
666use Parser::Context::Default; 687use Parser::Context::Default;
667
668# use Parser::Differentiation; 688use Parser::Differentiation;
689
690###########################################################################
691
692use vars qw($installed);
693$Parser::installed = 1;
669 694
670########################################################################### 695###########################################################################
671########################################################################### 696###########################################################################
672# 697#
673# To Do: 698# To Do:
674# 699#
675# handle sqrt(-1) and log of negatives (make complexes) 700# handle sqrt(-1) and log of negatives (make complexes)
676# 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
677# add context flags for various reduction checks
678# make context flag for reduction of constants
679# make reduce have reduce patterns as parameters 702# make reduce have reduce patterns as parameters
680# more reduce patterns 703# more reduce patterns
681# make operator strings customizable (reduce, and other places they are used) 704# make operator strings customizable (reduce, and other places they are used)
682# add parens alternately as () and []?
683# 705#
684######################################################################### 706#########################################################################
685 707
6861; 7081;
687 709

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

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9