[LON-CAPA-cvs] cvs: loncom /xml/algebra AlgParser.pm

[albertel]

albertel		Wed May  2 16:49:01 2007 EDT

  Modified files:              
    /loncom/xml/algebra	AlgParser.pm 
  Log:
  - properly handle -10 = -10 and throw error on -10 -=10
  
  
  
Index: loncom/xml/algebra/AlgParser.pm
diff -u loncom/xml/algebra/AlgParser.pm:1.16 loncom/xml/algebra/AlgParser.pm:1.17
--- loncom/xml/algebra/AlgParser.pm:1.16	Mon Mar 13 15:28:53 2006
+++ loncom/xml/algebra/AlgParser.pm	Wed May  2 16:48:55 2007
@@ -39,7 +39,8 @@
 
 my $binoper3 = '(?:\\^|\\*\\*)';
 my $binoper2 = '[/*_,]';
-my $binoper1 = '(?:<>|<=|>=|[-+=><%!])';
+my $binoper1 = '(?:[-+%!])';
+my $binoper0 = '(?:<>|<=|>=|[=><])';
 my $openparen = '[{(\\[]';
 my $closeparen = '[})\\]]';
 my $varname = '[A-Za-z](?:_[0-9]+)?';
@@ -64,7 +65,7 @@
 my $otherfunc = '(?:exp|abs|logten|log|ln|sqrt|sgn|step|fact|int|lim|fun[a-zA-Z])';
 my $funcname = '(?:' . $otherfunc . '|' . $trigfname . ')';
 
-my $tokenregexp = "(?:($binoper3)|($binoper2)|($binoper1)|($openparen)|" .
+my $tokenregexp = "(?:($binoper3)|($binoper2)|($binoper1)|($binoper0)|($openparen)|" .
     "($closeparen)|($funcname)|($specialvalue)|($varname)|" .
     "($numberE)|($number))";
 
@@ -77,13 +78,14 @@
 	if (defined($1)) {return ['binop3',  $1];}
 	if (defined($2)) {return ['binop2',  $2];}
 	if (defined($3)) {return ['binop1',  $3];}
-	if (defined($4)) {return ['openp',   $4];}
-	if (defined($5)) {return ['closep',  $5];}
-	if (defined($6)) {return ['func1',   $6];}
-	if (defined($7)) {return ['special', $7];}
-	if (defined($8)) {return ['varname', $8];}
-	if (defined($9)) {return ['numberE', $9];}
-	if (defined($10)) {return ['number', $10];}
+	if (defined($4)) {return ['binop0',  $4];}
+	if (defined($5)) {return ['openp',   $5];}
+	if (defined($6)) {return ['closep',  $6];}
+	if (defined($7)) {return ['func1',   $7];}
+	if (defined($8)) {return ['special', $8];}
+	if (defined($9)) {return ['varname', $9];}
+	if (defined($10)) {return ['numberE',$10];}
+	if (defined($11)) {return ['number', $11];}
   }
   else {
     push @{$self->{posarray}}, [$p1, undef];
@@ -118,7 +120,7 @@
   local $_;
   while ($currenttok) {
     $_ = $currenttok->[0];
-    /binop1/ && do {
+    /binop[01]/ && do {
       # check if we have a binary or unary operation here.
       if (defined(${$currentref})) {
         # binary - walk up the tree until we hit an open paren or the top
@@ -126,16 +128,21 @@
           $currentref = pop @backtrace;
         }
 	my $index = ((${$currentref}->[0] eq 'top')?1:3);
-        ${$currentref}->[$index] = ['binop1', $currenttok->[1],
+        ${$currentref}->[$index] = [$currenttok->[0], $currenttok->[1],
                                     ${$currentref}->[$index], undef];
         push @backtrace, $currentref;
         push @backtrace, \${$currentref}->[$index];
         $currentref = \${$currentref}->[$index]->[3];
-      } else {
+      } elsif (/binop1/) {
         # unary
         ${$currentref} = ['unop1', $currenttok->[1], undef];
         push @backtrace, $currentref;
         $currentref = \${$currentref}->[2];
+      } else {
+	  my ($mark) = pop(@{$self->{posarray}});
+	  my $position = 1+$mark->[0];
+	  return $self->error("Didn't expect " . $currenttok->[1] .
+			      " at position $position" , $mark);
       }
     };
     /binop2/ && do {
@@ -485,7 +492,7 @@
 
   local $_;
   $_ = $type;
-  /binop1/ && do {
+  /binop[01]/ && do {
     my ($p1, $p2) = ('','');
     if ($args[2]->[0] eq 'binop1') {($p1,$p2)=qw{ ( ) };}
     return ($args[1]->tostring() . $args[0] . $p1 .
@@ -530,7 +537,7 @@
 
   local $_;
   $_ = $type;
-  /binop1/ && do {
+  /binop[01]/ && do {
     my ($p1, $p2) = ('','');
     if ($args[2]->[0] eq 'binop1') {($p1,$p2)=qw{ \left( \right) };}
     my $cmd=$args[0];