[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 2991 - (download) (as text) (annotate)
Tue Nov 9 15:23:38 2004 UTC (15 years, 3 months ago) by gage
File size: 19742 byte(s)
Defined some variables that were causing warning messages.
Someone more familiar with this script should look at this
to make sure that this subsection of the parser is working correctly.

-- Mike

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

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9