[system] / trunk / pg / lib / Parser / BOP / underscore.pm Repository:
ViewVC logotype

View of /trunk/pg/lib/Parser/BOP/underscore.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 5130 - (download) (as text) (annotate)
Mon Jul 9 12:45:06 2007 UTC (12 years, 7 months ago) by dpvc
File size: 3797 byte(s)
Added new flags to error checking of operands and function arguments.
This is so that a context can be developed that is more forgiving
about what can be put next to what.  Such a context can NOT be used
for evaluation or answer checking, but can be used to generate TeX
output in more sophisticated situations.

    1 #########################################################################
    2 #
    3 #  Implement vector and matrix element extraction.
    4 #
    5 package Parser::BOP::underscore;
    6 use strict;
    7 our @ISA = qw(Parser::BOP);
    8 
    9 #
   10 #  Check that the operand types are OK
   11 #
   12 sub _check {
   13   my $self = shift;
   14   return if ($self->checkStrings());
   15   my ($ltype,$rtype) = $self->promotePoints();
   16   if ($ltype->{name} =~ m/Vector|Matrix|List/) {
   17     if ($rtype->{name} =~ m/Number|Vector/ ||
   18   ($rtype->{name} eq 'List' && $rtype->{entryType}{name} eq 'Number')) {
   19       $self->{type} = {%{$ltype}};
   20       $self->{type}{length} = $rtype->{length};
   21     } elsif ($self->context->flag("allowBadOperands")) {$self->{type} = $Value::Type{number}}
   22     else {$self->Error("Right-hand operand of '_' must be a Number or List of numbers")}
   23   } elsif ($self->context->flag("allowBadOperands")) {$self->{type} = $Value::Type{number}}
   24   else {$self->Error("Entries can be extracted only from Vectors, Matrices, or Lists")}
   25 }
   26 
   27 #
   28 #  Perform the extraction.
   29 #
   30 sub _eval {
   31   my $self = shift; my $M = shift; my $i = shift;
   32   $i = $i->data if Value::isValue($i);
   33   $i = [$i] unless ref($i) eq 'ARRAY';
   34   my $n = $M->extract(@{$i});
   35   return $n if ref($n);
   36   return $self->Package("List")->new($self->context) if $n eq '';
   37   return $n;
   38 }
   39 
   40 #
   41 #  If the right-hand side is constant and the left is a list
   42 #    extact the given coordinate(s).  Return empty lists
   43 #    if we run past the end of the coordinates.  Return
   44 #    a simpler extraction if a portion of the extraction
   45 #    can be performed.
   46 #
   47 sub _reduce {
   48   my $self = shift; my $equation = $self->{equation};
   49   my $context = $self->context;
   50   my $reduce = $context->{reduction};
   51   return $self unless $self->{rop}->{isConstant} && $self->{lop}{coords} && $reduce->{'V_n'};
   52   my $index = $self->{rop}->eval; my $M = $self->{lop};
   53   $index = $index->data if Value::isValue($index);
   54   $index = [$index] unless ref($index) eq 'ARRAY';
   55   my @index = @{$index};
   56   while (scalar(@index) > 0) {
   57     unless ($M->{coords}) {
   58       return $self->Item("Value")->new($equation,$self->Package("List")->new($context))
   59         unless $M->type =~ m/Point|Vector|Matrix|List/;
   60       return $self->Item("BOP")->new($equation,$self->{bop},
   61           $M,$self->Item("Value")->new($equation,@index))
   62     }
   63     my $i = shift(@index); $i-- if $i > 0;
   64     $self->Error("Can't extract element number '%s' (index must be an integer)",$i)
   65       unless $i =~ m/^-?\d+$/;
   66     $M = $M->{coords}[$i];
   67     return $self->Item("Value")->new($equation,$self->Package("List")->new($context)) unless $M;
   68   }
   69   return $M;
   70 }
   71 
   72 $Parser::reduce->{'V_n'} = 1;
   73 
   74 #
   75 #  Brace the index for TeX.  (Not really good for multiple indices.)
   76 #
   77 sub TeX {
   78   my ($self,$precedence,$showparens,$position,$outerRight) = @_;
   79   my $TeX; my $bop = $self->{def};
   80   $position = '' unless defined($position);
   81   $showparens = '' unless defined($showparens);
   82   my $addparens =
   83       defined($precedence) &&
   84       ($showparens eq 'all' || $precedence > $bop->{precedence} ||
   85       ($precedence == $bop->{precedence} &&
   86         ($bop->{associativity} eq 'right' || $showparens eq 'same')));
   87   $outerRight = !$addparens && ($outerRight || $position eq 'right');
   88 
   89   my $symbol = (defined($bop->{TeX}) ? $bop->{TeX} : $bop->{string});
   90   $TeX = $self->{lop}->TeX($bop->{precedence},$bop->{leftparens},'left',$outerRight).
   91     $symbol.'{'.$self->{rop}->TeX.'}';
   92 
   93   $TeX = '\left('.$TeX.'\right)' if $addparens;
   94   return $TeX;
   95 }
   96 
   97 #
   98 #  Perl used extract method of the Value::List object.
   99 #
  100 sub perl {
  101   my ($self,$precedence,$showparens,$position) = @_;
  102   my $bop = $self->{def};
  103   $self->{lop}->perl($bop->{precedence},$bop->{leftparens},'left').
  104     '->extract('.$self->{rop}->perl.')';
  105 }
  106 
  107 #########################################################################
  108 
  109 1;

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9