[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 2558 Revision 2664
1# handle sqrt(-1) and log of negatives (make complexes)
2# do division by zero and log of zero checks in compound functions
3# add context flags for various reduction checks
4# make context flag for reduction of constants
5# make reduce have reduce patterns as parameters
6# more reduce patterns
7# make operator strings customizable (reduce, and other places they are used)
8# add parens alternately as () and []?
9
10package Parser; 1package Parser;
11my $pkg = "Parser"; 2my $pkg = "Parser";
12 3
13use strict; 4use strict;
14#use Carp; 5#use Carp;
20# If it is a Value, make an appropriate tree for it. 11# If it is a Value, make an appropriate tree for it.
21# 12#
22sub new { 13sub new {
23 my $self = shift; my $class = ref($self) || $self; 14 my $self = shift; my $class = ref($self) || $self;
24 my $string = shift; 15 my $string = shift;
16 $string = Value::List->new($string,@_)
17 if scalar(@_) > 0 || ref($string) eq 'ARRAY';
25 my $math = bless { 18 my $math = bless {
26 string => undef, 19 string => undef,
27 tokens => [], 20 tokens => [], tree => undef,
28 tree => undef,
29 variables => {}, values => {}, 21 variables => {}, values => {},
30 context => Parser::Context->current, 22 context => Parser::Context->current,
31 error => 0, errorPos => undef,
32 message => '',
33 }, $class; 23 }, $class;
34 if (ref($string) =~ m/^(Parser|Value::Formula)/) { 24 if (ref($string) =~ m/^(Parser|Value::Formula)/) {
35 my $tree = $string; $tree = $tree->{tree} if exists $tree->{tree}; 25 my $tree = $string; $tree = $tree->{tree} if exists $tree->{tree};
36 $math->{tree} = $tree->copy($math); 26 $math->{tree} = $tree->copy($math);
37 } elsif (ref($string) =~ m/^Value/) { 27 } elsif (Value::isValue($string)) {
38 $math->{tree} = Parser::Value->new($math,$string); 28 $math->{tree} = Parser::Value->new($math,$string);
39 } else { 29 } else {
40 $math->{string} = $string; 30 $math->{string} = $string;
41 $math->tokenize; 31 $math->tokenize;
42 $math->parse; 32 $math->parse;
68 push(@{$tokens},['op',$5,$p0,$p1,$space]) if (defined($5)); 58 push(@{$tokens},['op',$5,$p0,$p1,$space]) if (defined($5));
69 push(@{$tokens},['open',$6,$p0,$p1,$space]) if (defined($6)); 59 push(@{$tokens},['open',$6,$p0,$p1,$space]) if (defined($6));
70 push(@{$tokens},['close',$7,$p0,$p1,$space]) if (defined($7)); 60 push(@{$tokens},['close',$7,$p0,$p1,$space]) if (defined($7));
71 push(@{$tokens},['var',$8,$p0,$p1,$space]) if (defined($8)); 61 push(@{$tokens},['var',$8,$p0,$p1,$space]) if (defined($8));
72 } else { 62 } else {
73 push(@{$tokens},['error',substr($string,$p0,3),$p0]); 63 push(@{$tokens},['error',substr($string,$p0,1),$p0,$p0+1]);
74 $self->{error} = 1; 64 $self->{error} = 1;
75 last; 65 last;
76 } 66 }
77 $space = ($string =~ m/\G\s+/gc); 67 $space = ($string =~ m/\G\s+/gc);
78 } 68 }
101 /num/ and do {$self->Num($ref->[1]); last}; 91 /num/ and do {$self->Num($ref->[1]); last};
102 /const/ and do {$self->Const($ref->[1]); last}; 92 /const/ and do {$self->Const($ref->[1]); last};
103 /var/ and do {$self->Var($ref->[1]); last}; 93 /var/ and do {$self->Var($ref->[1]); last};
104 /fn/ and do {$self->Fn($ref->[1]); last}; 94 /fn/ and do {$self->Fn($ref->[1]); last};
105 /str/ and do {$self->Str($ref->[1]); last}; 95 /str/ and do {$self->Str($ref->[1]); last};
106 /error/ and do {$self->Error("Unexpected characters '$ref->[1]'",$ref); last}; 96 /error/ and do {$self->Error("Unexpected character '$ref->[1]'",$ref); last};
107 } 97 }
108 return if ($self->{error}); 98 return if ($self->{error});
109 } 99 }
110 $self->Close('start'); return if ($self->{error}); 100 $self->Close('start'); return if ($self->{error});
111 $self->{tree} = $self->{stack}->[0]->{value}; 101 $self->{tree} = $self->{stack}->[0]->{value};
142 $string = $self->{string}; 132 $string = $self->{string};
143 $ref = [$ref->[2],$ref->[3]]; 133 $ref = [$ref->[2],$ref->[3]];
144 } 134 }
145 $context->setError($message,$string,$ref); 135 $context->setError($message,$string,$ref);
146 die $message . Value::getCaller(); 136 die $message . Value::getCaller();
147# confess $message;
148} 137}
149 138
150# 139#
151# Insert an implicit multiplication 140# Insert an implicit multiplication
152# 141#
153sub ImplicitMult { 142sub ImplicitMult {
154 my $self = shift; 143 my $self = shift;
155 my $ref = $self->{ref}; 144 my $ref = $self->{ref};
145 $self->Error("Can't perform implied multiplication in this context",$ref)
146 unless $self->{context}{operators}{' '}{class};
156 $self->Op(' '); 147 $self->Op(' ');
157 $self->{ref} = $ref; 148 $self->{ref} = $ref;
158} 149}
159 150
160# 151#
308 if ($paren->{emptyOK} && $paren->{close} eq $type) { 299 if ($paren->{emptyOK} && $paren->{close} eq $type) {
309 $self->pushOperand(Parser::List->new($self,[],1,$paren)) 300 $self->pushOperand(Parser::List->new($self,[],1,$paren))
310 } 301 }
311 elsif ($type eq 'start') {$self->Error("Missing close parenthesis for '$top->{value}'",$top->{ref})} 302 elsif ($type eq 'start') {$self->Error("Missing close parenthesis for '$top->{value}'",$top->{ref})}
312 elsif ($top->{value} eq 'start') {$self->Error("Extra close parenthesis '$type'",$ref)} 303 elsif ($top->{value} eq 'start') {$self->Error("Extra close parenthesis '$type'",$ref)}
313 else {$self->Error("Empty parentheses: '$top->{value} $type'",$top->{ref})} 304 else {$top->{ref}[3]=$ref->[3]; $self->Error("Empty parentheses",$top->{ref})}
314 last; 305 last;
315 }; 306 };
316 307
317 /operand/ and do { 308 /operand/ and do {
318 $self->Precedence(0); return if ($self->{error}); 309 $self->Precedence(0); return if ($self->{error});
463################################################## 454##################################################
464# 455#
465# Handle a numeric token 456# Handle a numeric token
466# 457#
467# Add an implicit multiplication, if needed 458# Add an implicit multiplication, if needed
459# Create the number object and check it
468# Save the number as an operand 460# Save the number as an operand
469# 461#
470sub Num { 462sub Num {
471 my $self = shift; 463 my $self = shift;
472 $self->ImplicitMult() if $self->state eq 'operand'; 464 $self->ImplicitMult() if $self->state eq 'operand';
473 $self->pushOperand(Parser::Number->new($self,shift,$self->{ref})); 465 my $num = Parser::Number->new($self,shift,$self->{ref});
466 my $check = $self->{context}->flag('NumberCheck');
467 &$check($num) if $check;
468 $self->pushOperand($num);
474} 469}
475 470
476################################################## 471##################################################
477# 472#
478# Handle a constant token 473# Handle a constant token
641 my $self = shift; my ($value,$type); 636 my $self = shift; my ($value,$type);
642 my $variables = $self->{context}{variables}; 637 my $variables = $self->{context}{variables};
643 $self->{values} = {@_}; 638 $self->{values} = {@_};
644 foreach my $x (keys %{$self->{values}}) { 639 foreach my $x (keys %{$self->{values}}) {
645 $self->Error("Undeclared variable '$x'") unless defined $variables->{$x}; 640 $self->Error("Undeclared variable '$x'") unless defined $variables->{$x};
646 $value = $self->{values}{$x}; 641 $value = Value::makeValue($self->{values}{$x});
647 $value = Value::Formula->new($value) unless 642 $value = Value::Formula->new($value) unless Value::isValue($value);
648 Value::matchNumber($value) || Value::isFormula($value) || Value::isValue($value);
649 if (Value::isFormula($value)) {$type = $value->typeRef}
650 else {($value,$type) = Value::getValueType($self,$value)} 643 ($value,$type) = Value::getValueType($self,$value);
651 $self->Error("Variable '$x' should be of type $variables->{$x}{type}{name}") 644 $self->Error("Variable '$x' should be of type $variables->{$x}{type}{name}")
652 unless Parser::Item::typeMatch($type,$variables->{$x}{type}); 645 unless Parser::Item::typeMatch($type,$variables->{$x}{type});
653 $self->{values}{$x} = $value; 646 $self->{values}{$x} = $value;
654 } 647 }
648}
649
650
651##################################################
652##################################################
653#
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
685#
686sub ijk {
687 my $self = shift;
688 $self->{tree}->ijk;
655} 689}
656 690
657######################################################################### 691#########################################################################
658######################################################################### 692#########################################################################
659# 693#
660# Load the sub-classes and Value.pm 694# Load the sub-classes and Value.pm
661# 695#
662 696
663use Parser::Item; 697use Parser::Item;
664use Value; 698use Value;
665use Value::Formula;
666use Parser::Context; 699use Parser::Context;
700use Parser::Context::Default;
667# use Parser::Differentiation; 701use Parser::Differentiation;
668 702
703###########################################################################
704
705use vars qw($installed);
706$Parser::installed = 1;
707
708###########################################################################
709###########################################################################
710#
711# To Do:
712#
713# handle sqrt(-1) and log of negatives (make complexes)
714# 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
718# more reduce patterns
719# make operator strings customizable (reduce, and other places they are used)
720# add parens alternately as () and []?
721#
669######################################################################### 722#########################################################################
670 723
6711; 7241;
672 725

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

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9