[ Index ] |
PHP Cross Reference of Unnamed Project |
[Summary view] [Print] [Text view]
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|da|db|dc|de|df|dg|dh|di|dj|dk|dl|dm|dn|do|dp|dq|dr|ds|dt|du|dv|dw|dx|dy|dz|infty|alpha|bita|gamma|zita|thita|iota|kappa|lambda|mu|nu|xi|rho|sigma|tau|phi|chi|psi|omega|zepslon|zdelta|xeta|zupslon|zeroplace)'; 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|int|lim|fun[a-zA-Z])'; 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 if ($args[0] =~ /implicit/) { 541 if ( (($args[1]->head eq qq(number)) && 542 ($args[2]->head eq qq(number))) || 543 (($args[1]->head eq qq(binop2)) && 544 ($args[1]->[2]->head eq qq(number))) ) { 545 $args[0] = '\\,'; 546 } else { 547 $args[0] = ' '; 548 } 549 } 550 if ($args[1]->[0] =~ /binop1|numberE/) 551 {($p1,$p2)=qw{ \left( \right) };} 552 # if ($args[2]->[0] =~ /binop[12]|numberE/) 553 if ($args[2]->[0] =~ /binop[12]|numberE|unop1/) 554 {($p3,$p4)=qw{ \left( \right) };} 555 if ($args[0] eq '/'){ 556 # return('\frac{' . $p1 . $args[1]->tolatex() . $p2 . '}'. 557 # '{' . $p3 . $args[2]->tolatex() . $p4 . '}' ); 558 return('\frac{' . $args[1]->tolatex() . '}'. 559 '{' . $args[2]->tolatex() . '}' ); 560 } 561 else{ 562 return ($p1 . $args[1]->tolatex() . $p2 . $args[0] . $p3 . 563 $args[2]->tolatex() . $p4); 564 } 565 }; 566 /binop3/ && do { 567 my ($p1, $p2, $p3, $p4)=('','','',''); 568 # if ($args[1]->[0] =~ /binop[123]|numberE/) {($p1,$p2)=qw{ \left( \right) };} 569 if ($args[1]->[0] =~ /binop[123]|unop1|numberE/) {($p1,$p2)=qw{ \left( \right) };} 570 # Not necessary in latex 571 # if ($args[2]->[0] =~ /binop[12]/) {($p3,$p4)=qw{ \left( \right) };} 572 return ($p1 . $args[1]->tolatex() . $p2 . "^{" . $p3 . 573 $args[2]->tolatex() . $p4 . "}"); 574 }; 575 /func1/ && do { 576 my($p1,$p2); 577 if($args[0] eq "sqrt"){($p1,$p2)=qw{ \left{ \right} };} 578 else {($p1,$p2)=qw{ \left( \right) };} 579 580 # 581 # DPVC -- 2003/03/31 582 # added missing trig functions 583 # 584 #$specialfunc = '(?:abs|logten|asin|acos|atan|sech|sgn|step|fact)'; 585 $specialfunc = '(?:abs|logten|a(?:sin|cos|tan|sec|csc|cot)h?|sgn|step|fact)'; 586 # 587 # End DPVC 588 # 589 590 if ($args[0] =~ /$specialfunc/) { 591 return ('\mbox{' . $args[0] .'}'. $p1 . $args[1]->tolatex() . $p2); 592 } 593 else { 594 return ('\\' . $args[0] . $p1 . $args[1]->tolatex() . $p2); 595 } 596 }; 597 /special/ && do { 598 if ($args[0] eq 'pi') {return '\pi';} else {return $args[0];} 599 }; 600 /varname|(:?number$)/ && return $args[0]; 601 /numberE/ && do { 602 $args[0] =~ m/($AlgParser::numberplain)E([-+]?\d+)/; 603 return ($1 . '\times 10^{' . $2 . '}'); 604 }; 605 /closep/ && do { 606 my($backslash) = ''; 607 my(%close) = %AlgParser::close; 608 if ($args[0] eq '{') {$backslash = '\\';} 609 #This is for editors to match: } 610 return ('\left' . $backslash . $args[0] . $args[1]->tolatex() . 611 '\right' . $backslash . $close{$args[0]}); 612 }; 613 } 614 615 sub fromarray { 616 my($class) = shift; 617 my($expr) = shift; 618 if ((ref $expr) ne qq{ARRAY}) { 619 die "Program error; fromarray not passed an array ref."; 620 } 621 my($type, @args) = @$expr; 622 foreach my $i (@args) { 623 if (ref $i) { 624 $i = $class->fromarray($i); 625 } 626 } 627 return $class->new($type, @args); 628 } 629 630 package ExprWithImplicitExpand; 631 @ISA=qw(Expr); 632 633 634 sub tostring { 635 # print STDERR "ExprWIE::tostring\n"; 636 # print STDERR Data::Dumper->Dump([@_]); 637 my ($self) = shift; 638 639 my($type, @args) = @$self; 640 641 if (($type eq qq(binop2)) && ($args[0] eq qq(implicit))) { 642 my ($p1, $p2, $p3, $p4)=('','','',''); 643 if ($args[1]->head =~ /binop1/) {($p1,$p2)=qw{ ( ) };} 644 # if ($args[2]->head =~ /binop[12]/) {($p3,$p4)=qw{ ( ) };} 645 if ($args[2]->head =~ /binop[12]|unop1/) {($p3,$p4)=qw{ ( ) };} 646 return ($p1 . $args[1]->tostring() . $p2 . '*' . $p3 . 647 $args[2]->tostring() . $p4); 648 } else { 649 return $self->SUPER::tostring(@_); 650 } 651 }
title
Description
Body
title
Description
Body
title
Description
Body
title
Body
Generated: Thu Aug 11 10:00:09 2016 | Cross-referenced by PHPXref 0.7.1 |