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

View of /trunk/pg/lib/AlgParser.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1050 - (download) (as text) (annotate)
Fri Jun 6 21:39:42 2003 UTC (16 years, 8 months ago) by sh002i
File size: 19849 byte(s)
moved PG modules and macro files from webwork-modperl to pg
-sam

    1 #!/usr/bin/perl
    2 
    3 ## Last modification: 8/3/00 by akp
    4 ## Originally written by Daniel Martin, Dept of Math, John Hopkins
    5 ## Additions and modifications were made by James Martino, Dept of Math, John Hopkins
    6 ## Additions and modifications were made by Arnold Pizer, Dept of Math, Univ of Rochester
    7 
    8 #use lib '/home/martind/lib/perl5/site_perl';
    9 #use Data::Dumper;
   10 
   11 package AlgParser;
   12 use HTML::Entities;
   13 
   14 %close = ();
   15 
   16 sub new {
   17   my $package = shift;
   18   my (%ret);
   19   $ret{string} = "";
   20   $ret{posarray} = [];
   21   $ret{parseerror} = "";
   22   $ret{parseresult} = [];
   23   bless \%ret, $package;
   24   return \%ret;
   25 }
   26 
   27 sub inittokenizer {
   28   my($self, $string) = @_;
   29   $self->{string} =~ m/\G.*$/g;
   30   $self->{string} = undef;
   31   $self->{string} = $string;
   32   $self->{string} =~ m/\G.*$/g;
   33   $self->{string} =~ m/^/g;
   34 }
   35 
   36 $close{'{'} = '}';
   37 $close{'['} = ']';
   38 $close{'('} = ')';
   39 
   40 $binoper3 = '(?:\\^|\\*\\*)';
   41 $binoper2 = '[/*]';
   42 $binoper1 = '[-+]';
   43 $openparen = '[{(\\[]';
   44 $closeparen = '[})\\]]';
   45 $varname = '[A-Za-z](?:_[0-9]+)?';
   46 $specialvalue = '(?:e|pi)';
   47 $numberplain = '(?:\d+(?:\.\d*)?|\.\d+)';
   48 $numberE = '(?:' . $numberplain . 'E[-+]?\d+)';
   49 $number = '(?:' . $numberE . '|' . $numberplain . ')';
   50 $trigfname = '(?:cosh|sinh|tanh|cot|(?:a(?:rc)?)?cos|(?:a(?:rc)?)?sin|' .
   51     '(?:a(?:rc)?)?tan|sech?)';
   52 $otherfunc = '(?:exp|abs|logten|log|ln|sqrt|sgn|step|fact)';
   53 $funcname = '(?:' . $otherfunc . '|' . $trigfname . ')';
   54 
   55 $tokenregexp = "(?:($binoper3)|($binoper2)|($binoper1)|($openparen)|" .
   56     "($closeparen)|($funcname)|($specialvalue)|($varname)|" .
   57     "($numberE)|($number))";
   58 
   59 sub nexttoken {
   60   my($self) = shift;
   61   $self->{string} =~ m/\G\s+/gc;
   62   my($p1) = pos($self->{string}) || 0;
   63   if(scalar($self->{string} =~ m/\G$tokenregexp/gc)) {
   64         push @{$self->{posarray}}, [$p1, pos($self->{string})];
   65   if (defined($1)) {return ['binop3',  $1];}
   66   if (defined($2)) {return ['binop2',  $2];}
   67   if (defined($3)) {return ['binop1',  $3];}
   68   if (defined($4)) {return ['openp',   $4];}
   69   if (defined($5)) {return ['closep',  $5];}
   70   if (defined($6)) {return ['func1',   $6];}
   71   if (defined($7)) {return ['special', $7];}
   72   if (defined($8)) {return ['varname', $8];}
   73   if (defined($9)) {return ['numberE', $9];}
   74   if (defined($10)) {return ['number', $10];}
   75   }
   76   else {
   77     push @{$self->{posarray}}, [$p1, undef];
   78     return undef;
   79   }
   80 }
   81 
   82 sub parse {
   83   my $self = shift;
   84   $self->{parseerror} = "";
   85   $self->{posarray} = [];
   86   $self->{parseresult} = ['top', undef];
   87   my (@backtrace) = (\$self->{parseresult});
   88   my (@pushback) = ();
   89 
   90   my $currentref = \$self->{parseresult}->[1];
   91   my $curenttok;
   92 
   93   my $sstring = shift;
   94   $self->inittokenizer($sstring);
   95   $currenttok = $self->nexttoken;
   96   if (!$currenttok) {
   97     if ($self->{string} =~ m/\G$/g) {
   98       return $self->error("empty");
   99     } else {
  100       my($mark) = pop @{$self->{posarray}};
  101       my $position = 1+$mark->[0];
  102       return $self->error("Illegal character at position $position", $mark);
  103     }
  104   }
  105   # so I can assume we got a token
  106   local $_;
  107   while ($currenttok) {
  108     $_ = $currenttok->[0];
  109     /binop1/ && do {
  110       # check if we have a binary or unary operation here.
  111       if (defined(${$currentref})) {
  112         # binary - walk up the tree until we hit an open paren or the top
  113         while (${$currentref}->[0] !~ /^(openp|top)/) {
  114           $currentref = pop @backtrace;
  115         }
  116   my $index = ((${$currentref}->[0] eq 'top')?1:3);
  117         ${$currentref}->[$index] = ['binop1', $currenttok->[1],
  118                                     ${$currentref}->[$index], undef];
  119         push @backtrace, $currentref;
  120         push @backtrace, \${$currentref}->[$index];
  121         $currentref = \${$currentref}->[$index]->[3];
  122       } else {
  123         # unary
  124         ${$currentref} = ['unop1', $currenttok->[1], undef];
  125         push @backtrace, $currentref;
  126         $currentref = \${$currentref}->[2];
  127       }
  128     };
  129     /binop2/ && do {
  130       if (defined(${$currentref})) {
  131         # walk up the tree until an open paren, the top, binop1 or unop1
  132         # I decide arbitrarily that -3*4 should be parsed as -(3*4)
  133         # instead of as (-3)*4.  Not that it makes a difference.
  134 
  135         while (${$currentref}->[0] !~ /^(openp|top|binop1)/) {
  136           $currentref = pop @backtrace;
  137         }
  138         my $a = ${$currentref}->[0];
  139         my $index = (($a eq 'top')?1:3);
  140         ${$currentref}->[$index] = ['binop2', $currenttok->[1],
  141                                     ${$currentref}->[$index], undef];
  142         push @backtrace, $currentref;
  143         push @backtrace, \${$currentref}->[$index];
  144         $currentref = \${$currentref}->[$index]->[3];
  145       } else {
  146         # Error
  147         my($mark) = pop @{$self->{posarray}};
  148         my $position =1+$mark->[0];
  149         return $self->error("Didn't expect " . $currenttok->[1] .
  150                             " at position $position" , $mark);
  151       }
  152     };
  153     /binop3/ && do {
  154       if (defined(${$currentref})) {
  155         # walk up the tree until we need to stop
  156         # Note that the right-associated nature of ^ means we need to
  157         # stop walking backwards when we hit a ^ as well.
  158         while (${$currentref}->[0] !~ /^(openp|top|binop[123]|unop1)/) {
  159           $currentref = pop @backtrace;
  160         }
  161         my $a = ${$currentref}->[0];
  162         my $index = ($a eq 'top')?1:($a eq 'unop1')?2:3;
  163         ${$currentref}->[$index] = ['binop3', $currenttok->[1],
  164                                     ${$currentref}->[$index], undef];
  165         push @backtrace, $currentref;
  166         push @backtrace, \${$currentref}->[$index];
  167         $currentref = \${$currentref}->[$index]->[3];
  168       } else {
  169         # Error
  170         my($mark) = pop @{$self->{posarray}};
  171         my $position = 1+$mark->[0];
  172         return $self->error("Didn't expect " . $currenttok->[1] .
  173                             " at position $position", $mark);
  174       }
  175     };
  176     /openp/ && do {
  177       if (defined(${$currentref})) {
  178         # we weren't expecting this - must be implicit
  179         # multiplication.
  180         push @pushback, $currenttok;
  181         $currenttok = ['binop2', 'implicit'];
  182         next;
  183       } else {
  184         my($me) = pop @{$self->{posarray}};
  185         ${$currentref} = [$currenttok->[0], $currenttok->[1], $me, undef];
  186         push @backtrace, $currentref;
  187         $currentref = \${$currentref}->[3];
  188       }
  189     };
  190     /func1/ && do {
  191       if (defined(${$currentref})) {
  192         # we weren't expecting this - must be implicit
  193         # multiplication.
  194         push @pushback, $currenttok;
  195         $currenttok = ['binop2', 'implicit'];
  196         next;
  197       } else {
  198         # just like a unary operator
  199         ${$currentref} = [$currenttok->[0], $currenttok->[1], undef];
  200         push @backtrace, $currentref;
  201         $currentref = \${$currentref}->[2];
  202       }
  203     };
  204     /closep/ && do {
  205       if (defined(${$currentref})) {
  206         # walk up the tree until we need to stop
  207         while (${$currentref}->[0] !~ /^(openp|top)/) {
  208           $currentref = pop @backtrace;
  209         }
  210         my $a = ${$currentref}->[0];
  211         if ($a eq 'top') {
  212           my($mark) = pop @{$self->{posarray}};
  213           my $position = 1+$mark->[0];
  214           return $self->error("Unmatched close " . $currenttok->[1] .
  215                               " at position $position", $mark);
  216         } elsif ($close{${$currentref}->[1]} ne $currenttok->[1]) {
  217           my($mark) = pop @{$self->{posarray}};
  218           my $position = 1+$mark->[0];
  219           return $self->error("Mismatched parens at position $position"
  220                               , ${$currentref}->[2], $mark);
  221         } else {
  222           ${$currentref}->[0] = 'closep';
  223           ${$currentref}->[2] = pop @{${$currentref}};
  224         }
  225       } else {
  226         # Error - something like (3+4*)
  227         my($mark) = pop @{$self->{posarray}};
  228         my $position = 1+$mark->[0];
  229         return $self->error("Premature close " . $currenttok->[1] .
  230                             " at position $position", $mark);
  231       }
  232     };
  233     /special|varname|numberE?/ && do {
  234       if (defined(${$currentref})) {
  235         # we weren't expecting this - must be implicit
  236         # multiplication.
  237         push @pushback, $currenttok;
  238         $currenttok = ['binop2', 'implicit'];
  239         next;
  240       } else {
  241         ${$currentref} = [$currenttok->[0], $currenttok->[1]];
  242       }
  243     };
  244     if (@pushback) {
  245       $currenttok = pop @pushback;
  246     } else {
  247       $currenttok = $self->nexttoken;
  248     }
  249   }
  250   # ok, we stopped parsing.  Now we need to see why.
  251   if ($self->{parseresult}->[0] eq 'top') {
  252     $self->{parseresult} = $self->arraytoexpr($self->{parseresult}->[1]);
  253   } else {
  254     return $self->error("Internal consistency error; not at top when done");
  255   }
  256   if ($self->{string} =~ m/\G\s*$/g) {
  257     if (!defined(${$currentref})) {
  258       $self->{string} .= " ";
  259       return $self->error("I was expecting more at the end of the line",
  260                         [length($self->{string})-1, length($self->{string})]);
  261     } else {
  262       # check that all the parens were closed
  263       while (@backtrace) {
  264         $currentref = pop @backtrace;
  265         if (${$currentref}->[0] eq 'openp') {
  266           my($mark) = ${$currentref}->[2];
  267           my $position = 1+$mark->[0];
  268           return $self->error("Unclosed parentheses beginning at position $position"
  269                          , $mark);
  270         }
  271       }
  272       # Ok, we must really have parsed something
  273       return $self->{parseresult};
  274     }
  275   } else {
  276       my($mark) = pop @{$self->{posarray}};
  277       my $position = 1+$mark->[0];
  278       return $self->error("Illegal character at position $position",$mark);
  279   }
  280 }
  281 
  282 sub arraytoexpr {
  283   my ($self) = shift;
  284   return Expr->fromarray(@_);
  285 }
  286 
  287 sub error {
  288   my($self, $errstr, @markers) = @_;
  289 #  print STDERR Data::Dumper->Dump([\@markers],
  290 #                                  ['$markers']);
  291   $self->{parseerror} = $errstr;
  292   my($htmledstring) = '<tt class="parseinput">';
  293   my($str) = $self->{string};
  294 #  print STDERR Data::Dumper->Dump([$str], ['$str']);
  295   my($lastpos) = 0;
  296   $str =~ s/ /\240/g;
  297   while(@markers) {
  298     my($ref) = shift @markers;
  299     my($pos1) = $ref->[0];
  300     my($pos2) = $ref->[1];
  301     if (!defined($pos2)) {$pos2 = $pos1+1;}
  302     $htmledstring .= encode_entities(substr($str,$lastpos,$pos1-$lastpos)) .
  303            '<b class="parsehilight">' .
  304            encode_entities(substr($str,$pos1,$pos2-$pos1)) .
  305            '</b>';
  306     $lastpos = $pos2;
  307   }
  308 #  print STDERR Data::Dumper->Dump([$str, $htmledstring, $lastpos],
  309 #                                  ['$str', '$htmledstring', '$lastpos']);
  310   $htmledstring .= encode_entities(substr($str,$lastpos));
  311   $htmledstring .= '</tt>';
  312 #  $self->{htmlerror} = '<p class="parseerr">' . "\n" .
  313 #                       '<span class="parsedesc">' .
  314 #                       encode_entities($errstr) . '</span><br>' . "\n" .
  315 #                       $htmledstring . "\n" . '</p>' . "\n";
  316   $self->{htmlerror} =  $htmledstring ;
  317   $self->{htmlerror} =  'empty' if $errstr eq 'empty';
  318   $self->{error_msg} = $errstr;
  319 
  320 #  warn $errstr . "\n";
  321   return undef;
  322 }
  323 
  324 sub tostring {
  325   my ($self) = shift;
  326   return $self->{parseresult}->tostring(@_);
  327 }
  328 
  329 sub tolatex {
  330   my ($self) = shift;
  331   return $self->{parseresult}->tolatex(@_);
  332 }
  333 
  334 sub tolatexstring { return tolatex(@_);}
  335 
  336 sub exprtolatexstr {
  337   return exprtolatex(@_);
  338 }
  339 
  340 sub exprtolatex {
  341   my($expr) = shift;
  342   my($exprobj);
  343   if ((ref $expr) eq 'ARRAY') {
  344     $exprobj = Expr->new(@$expr);
  345   } else {
  346     $exprobj = $expr;
  347   }
  348   return $exprobj->tolatex();
  349 }
  350 
  351 sub exprtostr {
  352   my($expr) = shift;
  353   my($exprobj);
  354   if ((ref $expr) eq 'ARRAY') {
  355     $exprobj = Expr->new(@$expr);
  356   } else {
  357     $exprobj = $expr;
  358   }
  359   return $exprobj->tostring();
  360 }
  361 
  362 sub normalize {
  363   my ($self, $degree) = @_;
  364   $self->{parseresult} = $self->{parseresult}->normalize($degree);
  365 }
  366 
  367 sub normalize_expr {
  368   my($expr, $degree) = @_;
  369   my($exprobj);
  370   if ((ref $expr) eq 'ARRAY') {
  371     $exprobj = Expr->new(@$expr);
  372   } else {
  373     $exprobj = $expr;
  374   }
  375   return $exprobj->normalize($degree);
  376 }
  377 
  378 package AlgParserWithImplicitExpand;
  379 @ISA=qw(AlgParser);
  380 
  381 sub arraytoexpr {
  382   my ($self) = shift;
  383   my ($foo) = ExprWithImplicitExpand->fromarray(@_);
  384 # print STDERR Data::Dumper->Dump([$foo],['retval']);
  385   return $foo;
  386 }
  387 
  388 package Expr;
  389 
  390 sub new {
  391   my($class) = shift;
  392   my(@args) = @_;
  393   my($ret) = [@args];
  394   return (bless $ret, $class);
  395 }
  396 
  397 sub head {
  398   my($self) = shift;
  399   return ($self->[0]);
  400 }
  401 
  402 
  403 sub normalize {
  404 #print STDERR "normalize\n";
  405 #print STDERR Data::Dumper->Dump([@_]);
  406 
  407   my($self, $degree) = @_;
  408   my($class) = ref $self;
  409   $degree = $degree || 0;
  410   my($type, @args) = @$self;
  411   local $_;
  412   $_ = $type;
  413   my ($ret) = [$type, @args];
  414 
  415 
  416   if(/closep/) {
  417     $ret = $args[1]->normalize($degree);
  418   } elsif (/unop1/) {
  419     $ret = $class->new($type, $args[0], $args[1]->normalize($degree));
  420   } elsif (/binop/) {
  421     $ret = $class->new($type, $args[0], $args[1]->normalize($degree),
  422                              $args[2]->normalize($degree));
  423   } elsif (/func1/) {
  424     $args[0] =~ s/^arc/a/;
  425     $ret = $class->new($type, $args[0], $args[1]->normalize($degree));
  426   }
  427 
  428 
  429   if ($degree < 0) {return $ret;}
  430 
  431 
  432   ($type, @args) = @$ret;
  433   $ret = $class->new($type, @args);
  434   $_ = $type;
  435   if (/binop1/ && ($args[2]->[0] =~ 'unop1')) {
  436     my($h1, $h2) = ($args[0], $args[2]->[1]);
  437     my($s1, $s2) = ($h1 eq '-', $h2 eq '-');
  438     my($eventual) = ($s1==$s2);
  439     if ($eventual) {
  440       $ret = $class->new('binop1', '+', $args[1], $args[2]->[2] );
  441     } else {
  442       $ret = $class->new('binop1', '-', $args[1], $args[2]->[2] );
  443     }
  444   } elsif (/binop2/ && ($args[1]->[0] =~ 'unop1')) {
  445     $ret = $class->new('unop1', '-',
  446                        $class->new($type, $args[0], $args[1]->[2],
  447                                    $args[2])->normalize($degree) );
  448   } elsif (/binop[12]/ && ($args[2]->[0] eq $type) &&
  449                           ($args[0] =~ /[+*]/)) {
  450 # Remove frivolous right-association
  451 # For example, fix 3+(4-5) or 3*(4x)
  452     $ret = $class->new($type, $args[2]->[1],
  453                        $class->new($type, $args[0], $args[1],
  454                                    $args[2]->[2])->normalize($degree),
  455                        $args[2]->[3]);
  456   } elsif (/unop1/ && ($args[0] eq '+')) {
  457     $ret = $args[1];
  458   } elsif (/unop1/ && ($args[1]->[0] =~ 'unop1')) {
  459     $ret = $args[1]->[2];
  460   }
  461   if ($degree > 0) {
  462   }
  463   return $ret;
  464 }
  465 
  466 sub tostring {
  467 # print STDERR "Expr::tostring\n";
  468 # print STDERR Data::Dumper->Dump([@_]);
  469   my($self) = shift;
  470   my($type, @args) = @$self;
  471   local $_;
  472   $_ = $type;
  473   /binop1/ && do {
  474     my ($p1, $p2) = ('','');
  475     if ($args[2]->[0] eq 'binop1') {($p1,$p2)=qw{ ( ) };}
  476     return ($args[1]->tostring() . $args[0] . $p1 .
  477             $args[2]->tostring() . $p2);
  478   };
  479   /unop1/ && do {
  480     my ($p1, $p2) = ('','');
  481     if ($args[1]->[0] =~ /binop1/) {($p1,$p2)=qw{ ( ) };}
  482     return ($args[0] . $p1 . $args[1]->tostring() . $p2);
  483   };
  484   /binop2/ && do {
  485     my ($p1, $p2, $p3, $p4)=('','','','');
  486     if ($args[0] =~ /implicit/) {$args[0] = ' ';}
  487     if ($args[1]->[0] =~ /binop1/) {($p1,$p2)=qw{ ( ) };}
  488 #    if ($args[2]->[0] =~ /binop[12]/) {($p3,$p4)=qw{ ( ) };}
  489     if ($args[2]->[0] =~ /binop[12]|unop1/) {($p3,$p4)=qw{ ( ) };}
  490     return ($p1 . $args[1]->tostring() . $p2 . $args[0] . $p3 .
  491             $args[2]->tostring() . $p4);
  492   };
  493   /binop3/ && do {
  494     my ($p1, $p2, $p3, $p4)=('','','','');
  495 #    if ($args[1]->[0] =~ /binop[123]|numberE/) {($p1,$p2)=qw{ ( ) };}
  496     if ($args[1]->[0] =~ /binop[123]|unop1|numberE/) {($p1,$p2)=qw{ ( ) };}
  497 #    if ($args[2]->[0] =~ /binop[12]|numberE/) {($p3,$p4)=qw{ ( ) };}
  498     if ($args[2]->[0] =~ /binop[12]|unop1|numberE/) {($p3,$p4)=qw{ ( ) };}
  499     return ($p1 . $args[1]->tostring() . $p2 . $args[0] . $p3 .
  500             $args[2]->tostring() . $p4);
  501   };
  502   /func1/ && do {
  503     return ($args[0] . '(' . $args[1]->tostring() . ')');
  504   };
  505   /special|varname|numberE?/ && return $args[0];
  506   /closep/ && do {
  507     my(%close) = %AlgParser::close;
  508 
  509 
  510 
  511     return ($args[0] . $args[1]->tostring() . $close{$args[0]});
  512   };
  513 }
  514 
  515 sub tolatex {
  516   my($self) = shift;
  517   my($type, @args) = @$self;
  518   local $_;
  519   $_ = $type;
  520   /binop1/ && do {
  521     my ($p1, $p2) = ('','');
  522     if ($args[2]->[0] eq 'binop1') {($p1,$p2)=qw{ \left( \right) };}
  523     return ($args[1]->tolatex() . $args[0] . $p1 .
  524             $args[2]->tolatex() . $p2);
  525   };
  526   /unop1/ && do {
  527     my ($p1, $p2) = ('','');
  528     if ($args[1]->[0] =~ /binop1/) {($p1,$p2)=qw{ \left( \right) };}
  529     return ($args[0] . $p1 . $args[1]->tolatex() . $p2);
  530   };
  531   /binop2/ && do {
  532     my ($p1, $p2, $p3, $p4) = ('','','','');
  533     if ($args[0] =~ /implicit/) {
  534       if ( (($args[1]->head eq qq(number)) &&
  535             ($args[2]->head eq qq(number))) ||
  536            (($args[1]->head eq qq(binop2)) &&
  537             ($args[1]->[2]->head eq qq(number))) ) {
  538         $args[0] = '\\,';
  539       } else {
  540         $args[0] = ' ';
  541       }
  542     }
  543     if ($args[1]->[0] =~ /binop1|numberE/)
  544       {($p1,$p2)=qw{ \left( \right) };}
  545  #   if ($args[2]->[0] =~ /binop[12]|numberE/)
  546   if ($args[2]->[0] =~ /binop[12]|numberE|unop1/)
  547       {($p3,$p4)=qw{ \left( \right) };}
  548     if ($args[0] eq '/'){
  549   return('\frac{' . $p1 . $args[1]->tolatex() . $p2 . '}'.
  550                '{' . $p3 . $args[2]->tolatex() . $p4 . '}' );
  551     }
  552     else{
  553     return ($p1 . $args[1]->tolatex() . $p2 . $args[0] . $p3 .
  554             $args[2]->tolatex() . $p4);
  555     }
  556   };
  557   /binop3/ && do {
  558     my ($p1, $p2, $p3, $p4)=('','','','');
  559 #    if ($args[1]->[0] =~ /binop[123]|numberE/) {($p1,$p2)=qw{ \left( \right) };}
  560   if ($args[1]->[0] =~ /binop[123]|unop1|numberE/) {($p1,$p2)=qw{ \left( \right) };}
  561 # Not necessary in latex
  562 #   if ($args[2]->[0] =~ /binop[12]/) {($p3,$p4)=qw{ \left( \right) };}
  563     return ($p1 . $args[1]->tolatex() . $p2 . "^{" . $p3 .
  564             $args[2]->tolatex() . $p4 . "}");
  565   };
  566   /func1/ && do {
  567       my($p1,$p2);
  568       if($args[0] eq "sqrt"){($p1,$p2)=qw{ \left{ \right} };}
  569       else {($p1,$p2)=qw{ \left( \right) };}
  570 
  571       $specialfunc = '(?:abs|logten|asin|acos|atan|sech|sgn|step|fact)';
  572 
  573 
  574       if ($args[0] =~ /$specialfunc/) {
  575          return ('\mbox{' . $args[0] .'}'. $p1 . $args[1]->tolatex() . $p2);
  576       }
  577       else {
  578         return ('\\' . $args[0] . $p1 . $args[1]->tolatex() . $p2);
  579       }
  580   };
  581   /special/ && do {
  582     if ($args[0] eq 'pi') {return '\pi';} else {return $args[0];}
  583   };
  584   /varname|(:?number$)/ && return $args[0];
  585   /numberE/ && do {
  586     $args[0] =~ m/($AlgParser::numberplain)E([-+]?\d+)/;
  587     return ($1 . '\times 10^{' . $2 . '}');
  588   };
  589   /closep/ && do {
  590     my($backslash) = '';
  591     my(%close) = %AlgParser::close;
  592     if ($args[0] eq '{') {$backslash = '\\';}
  593 #This is for editors to match: }
  594     return ('\left' . $backslash . $args[0] . $args[1]->tolatex() .
  595             '\right' . $backslash . $close{$args[0]});
  596   };
  597 }
  598 
  599 sub fromarray {
  600   my($class) = shift;
  601   my($expr) = shift;
  602   if ((ref $expr) ne qq{ARRAY}) {
  603     die "Program error; fromarray not passed an array ref.";
  604   }
  605   my($type, @args) = @$expr;
  606   foreach my $i (@args) {
  607     if (ref $i) {
  608       $i = $class->fromarray($i);
  609     }
  610   }
  611   return $class->new($type, @args);
  612 }
  613 
  614 package ExprWithImplicitExpand;
  615 @ISA=qw(Expr);
  616 
  617 
  618 sub tostring {
  619 # print STDERR "ExprWIE::tostring\n";
  620 # print STDERR Data::Dumper->Dump([@_]);
  621   my ($self) = shift;
  622 
  623   my($type, @args) = @$self;
  624 
  625   if (($type eq qq(binop2)) && ($args[0] eq qq(implicit))) {
  626     my ($p1, $p2, $p3, $p4)=('','','','');
  627     if ($args[1]->head =~ /binop1/) {($p1,$p2)=qw{ ( ) };}
  628 #    if ($args[2]->head =~ /binop[12]/) {($p3,$p4)=qw{ ( ) };}
  629     if ($args[2]->head =~ /binop[12]|unop1/) {($p3,$p4)=qw{ ( ) };}
  630     return ($p1 . $args[1]->tostring() . $p2 . '*' . $p3 .
  631             $args[2]->tostring() . $p4);
  632   } else {
  633     return $self->SUPER::tostring(@_);
  634   }
  635 }

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9