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

View of /trunk/pg/lib/Parser/List.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 5509 - (download) (as text) (annotate)
Sat Sep 15 00:56:51 2007 UTC (12 years, 2 months ago) by dpvc
File size: 7562 byte(s)
Formula objects and Context objects contain reference loops, which
prevent them from being freed properly by perl when they are no longer
needed.  This is a source of an important memory leak in WeBWorK.  The
problem has been fixed by using Scalar::Util::weaken for these
recursive references, so these objects can be freed properly when they
go out of scope.  This should cause an improvement in the memory usage
of the httpd child processes.

    1 #########################################################################
    2 #
    3 #  Implements base List class.
    4 #
    5 package Parser::List;
    6 use strict;
    7 our @ISA = qw(Parser::Item);
    8 
    9 $Parser::class->{List} = 'Parser::List';
   10 
   11 #
   12 #  First, check to see if we might be forming an interval
   13 #    (true if the close paren is not the right one for the
   14 #     open paren, or if one of the coordinates is infinity).
   15 #  If we aren't forming an interval,
   16 #    See if we need to form a matrix (entry type is already a vector)
   17 #    Otherwise if we have mixed entry types (type is unknown)
   18 #      Form a list if we can
   19 #      Otherwise report an appropriate error
   20 #  Then create the appropriately typed list object
   21 #
   22 sub new {
   23   my $self = shift;
   24   my $equation = shift; my $coords = shift;
   25   my $constant = shift; my $paren = shift;
   26   my $entryType = shift || $Value::Type{unknown};
   27   my $open = shift || ''; my $close = shift || '';
   28   my $context = $equation->{context};
   29   my $parens = $context->{parens};
   30 
   31   if ($paren && $close && $paren->{formInterval} && scalar(@{$coords}) == 2) {
   32     $paren = $parens->{interval}
   33       if $paren->{close} ne $close || $coords->[0]->{isInfinite} || $coords->[1]->{isInfinite};
   34   }
   35   my $type = Value::Type($paren->{type},scalar(@{$coords}),$entryType,
   36                                 list => 1, formMatrix => $paren->{formMatrix});
   37   if ($type->{name} ne 'Interval' && ($type->{name} ne 'Set' || $type->{length} != 0)) {
   38     if ($paren->{formMatrix} && $entryType->{formMatrix}) {$type->{name} = 'Matrix'}
   39     elsif ($entryType->{name} eq 'unknown') {
   40       if ($paren->{formList}) {$type->{name} = 'List'}
   41       elsif ($type->{name} eq 'Point') {
   42         $equation->Error("Entries in a Matrix must be of the same type and length")}
   43       else {$equation->Error(["Entries in a %s must be of the same type",$type->{name}])}
   44     }
   45   }
   46   $open = '' if $open eq 'start'; $close = '' if $close eq 'start';
   47   my $list = bless {
   48     coords => $coords, type => $type, open => $open, close => $close,
   49     paren => $paren, equation => $equation, isConstant => $constant
   50   }, $context->{lists}{$type->{name}}{class};
   51   $list->weaken;
   52 
   53   my $zero = 1;
   54   foreach my $x (@{$coords}) {$zero = 0, last unless $x->{isZero}}
   55   $list->{isZero} = 1 if $zero && scalar(@{$coords}) > 0;
   56 
   57   $list->_check;
   58 
   59 #  warn ">> $list->{type}{name} of $list->{type}{entryType}{name} of length $list->{type}{length}\n";
   60 
   61   if ($list->{isConstant} && $context->flag('reduceConstants')) {
   62     $type = $list->{type};
   63     $list = $list->Item("Value")->new($equation,[$list->eval]);
   64     $list->{type} = $type; $list->{open} = $open; $list->{close} = $close;
   65     $list->{value}->{open} = $open, $list->{value}->{close} = $close
   66       if ref($list->{value});
   67   }
   68   return $list;
   69 }
   70 
   71 sub canBeInUnion {
   72   my $self = shift;
   73   $self->length == 2 && $self->typeRef->{entryType}{name} eq 'Number' &&
   74     $self->{open} =~ m/^[\(\[]$/ && $self->{close} =~ m/^[\)\]]$/;
   75 }
   76 
   77 sub _check {}
   78 
   79 ##################################################
   80 
   81 #
   82 #  Evaluate all the entries in the list
   83 #    then process the results
   84 #
   85 sub eval {
   86   my $self = shift; my @p = ();
   87   foreach my $x (@{$self->{coords}}) {push(@p,$x->eval)}
   88   $self->_eval([@p]);
   89 }
   90 
   91 #
   92 #  Call the appropriate creation routine from Value.pm
   93 #  (Can be over-written by sub-classes)
   94 #
   95 sub _eval {
   96   my $self = shift;
   97   my $value = $self->Package($self->type)->new($self->context,@_);
   98   $value->{open} = $self->{open}; $value->{close} = $self->{close};
   99   return $value;
  100 }
  101 
  102 #
  103 #  Reduce all the entries in the list
  104 #  Mark the result as a zero or constant vector as appropriate
  105 #  Do any sub-class defined reductions.
  106 #
  107 sub reduce {
  108   my $self = shift;
  109   my $zero = 1; my $constant = 1;
  110   foreach my $x (@{$self->{coords}}) {
  111     $x = $x->reduce;
  112     $zero = 0 unless $x->{isZero};
  113     $constant = 0 unless $x->{isConstant};
  114   }
  115   $self->{isZero} = 1 if $zero and scalar(@{$self->{coords}}) > 0;
  116   $self->{isConstant} = 1 if $constant;
  117   ## check matrix for being identity
  118   return $self->Item("Value")->new($self->{equation},[$self->eval]) if $constant;
  119   $self->_reduce;
  120 }
  121 #
  122 #  Stub for sub-classes.
  123 #
  124 sub _reduce {shift}
  125 
  126 #
  127 #  Substitute in each coordinate
  128 #  Mark the result as a zero or constant vector as appropriate
  129 #
  130 sub substitute {
  131   my $self = shift;
  132   my @coords = (); my $zero = 1; my $constant = 1;
  133   foreach my $x (@{$self->{coords}}) {
  134     $x = $x->substitute;
  135     $zero = 0 unless $x->{isZero};
  136     $constant = 0 unless $x->{isConstant};
  137   }
  138   $self->{isZero} = 1 if $zero and scalar(@coords) > 0;
  139   $self->{isConstant} = 1 if $constant;
  140   ## check matrix for being identity
  141   return $self->Item("Value")->new($self->{equation},[$self->eval])
  142       if $constant && $self->{equation}{context}->flag('reduceConstants');
  143   return $self;
  144 }
  145 
  146 #
  147 #  Copy all the list entries as well as the list object.
  148 #
  149 sub copy {
  150   my $self = shift; my $equation = shift;
  151   my $new = $self->SUPER::copy($equation);
  152   $new->{coords} = [];
  153   foreach my $x (@{$self->{coords}}) {push(@{$new->{coords}},$x->copy($equation))}
  154   return $new;
  155 }
  156 
  157 ##################################################
  158 
  159 #
  160 #  Return the coordinate array reference
  161 #
  162 sub coords {(shift)->{coords}}
  163 
  164 #
  165 #  Get the variables from all the coordinates
  166 #
  167 sub getVariables {
  168   my $self = shift; my $vars = {};
  169   foreach my $x (@{$self->{coords}}) {$vars = {%{$vars},%{$x->getVariables}}}
  170   return $vars;
  171 }
  172 
  173 #
  174 #  Convert the list to a matrix with given open and close parens
  175 #  (Used my Matrix to convert the rows from points and vectors to
  176 #   matrices so they print properly.  Probably a mistake.)
  177 #
  178 sub makeMatrix {
  179   my $self = shift;
  180   my ($name,$open,$close) = @_;
  181   bless $self, $self->{equation}{context}{lists}{$name}{class};
  182   $self->{type}{name} = $name;
  183   $self->{open} = $open; $self->{close} = $close;
  184 }
  185 
  186 ##################################################
  187 #
  188 #  Generate the various output formats.
  189 #
  190 
  191 #
  192 #  Produce a string version.
  193 #
  194 sub string {
  195   my $self = shift; my $precedence = shift; my @coords = ();
  196   foreach my $x (@{$self->{coords}}) {push(@coords,$x->string)}
  197   return $self->{open}.join(',',@coords).$self->{close};
  198 }
  199 
  200 #
  201 #  Produce TeX version.
  202 #
  203 #  Use stretchable open and close delimiters (quoting braces)
  204 #
  205 sub TeX {
  206   my $self = shift; my $precedence = shift; my @coords = ();
  207   my ($open,$close) = ($self->{open},$self->{close});
  208   $open = '\{' if $open eq '{'; $close = '\}' if $close eq '}';
  209   $open  = '\left' .$open  if $open  ne '';
  210   $close = '\right'.$close if $close ne '';
  211   foreach my $x (@{$self->{coords}}) {push(@coords,$x->TeX)}
  212   return $open.join(',',@coords).$close unless $self->{ColumnVector};
  213   '\left[\begin{array}{c}'.join('\cr'."\n",@coords).'\cr\end{array}\right]';
  214 }
  215 
  216 #
  217 #  Produce perl version
  218 #
  219 sub perl {
  220   my $self = shift; my $parens = shift; my $matrix = shift;
  221   my $perl; my @p = ();
  222   foreach my $x (@{$self->{coords}}) {push(@p,$x->perl)}
  223   $perl = $self->Package($self->type).'->new('.join(',',@p).')';
  224   $perl = "(${perl})->with(open=>'$self->{open}',close=>'$self->{close}')"
  225     if $self->canBeInUnion ||
  226       ($self->type eq 'List' && $self->{open}.$self->{close} ne '()');
  227   $perl = '('.$perl.')' if $parens;
  228   return $perl;
  229 }
  230 
  231 #########################################################################
  232 #
  233 #  Load the subclasses.
  234 #
  235 
  236 END {
  237   use Parser::List::Point;
  238   use Parser::List::Vector;
  239   use Parser::List::Matrix;
  240   use Parser::List::List;
  241   use Parser::List::Interval;
  242   use Parser::List::Set;
  243   use Parser::List::AbsoluteValue;
  244 }
  245 
  246 #########################################################################
  247 
  248 1;

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9