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

View of /trunk/pg/lib/Parser/Item.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: 4376 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 the basic parse tree node.  Subclasses of this class
    4 #  are things like binary operator, function call, and so on.
    5 #
    6 package Parser::Item;
    7 use strict;
    8 use UNIVERSAL;
    9 use Scalar::Util;
   10 
   11 #
   12 #  Make these available to Parser items
   13 #
   14 sub isa {UNIVERSAL::isa(@_)}
   15 sub can {UNIVERSAL::can(@_)}
   16 
   17 sub weaken {Scalar::Util::weaken((shift)->{equation})}
   18 
   19 #
   20 #  Return the class name of an item
   21 #
   22 sub class {
   23   my @parts = split(/::/,ref(shift));
   24   return $parts[(scalar(@parts) > 2 ? -2 : -1)];
   25 }
   26 
   27 #
   28 #  Get the equation context
   29 #
   30 sub context {
   31   my $self = shift;
   32   return (ref($self) ? $self->{equation}{context} : Value->context);
   33 }
   34 
   35 #
   36 #  Get the package for a given Parser class
   37 #
   38 sub Item {
   39   my $self = shift; my $class = shift;
   40   my $context = (Value::isContext($_[0]) ? shift : $self->context);
   41   return $context->{parser}{$class} if defined $context->{parser}{$class};
   42   return "Parser::$class" if defined @{"Parser::${class}::ISA"};
   43   Value::Error("No such package 'Parser::%s'",$class);
   44 }
   45 
   46 #
   47 #  Same but for Value classes
   48 #
   49 sub Package {
   50   my $self = shift; my $class = shift;
   51   my $context = (Value::isContext($_[0]) ? shift : $self->context);
   52   $context->Package($class);
   53 }
   54 
   55 #
   56 #  Get various type information
   57 #
   58 sub type {my $self = shift; return $self->{type}{name}}
   59 sub typeRef {my $self = shift; return $self->{type}}
   60 sub length {my $self = shift; return $self->{type}{length}}
   61 sub entryType {
   62   my $self = shift; my $type = $self->{type};
   63   return $type->{list} ? $type->{entryType}: $type;
   64 }
   65 
   66 #
   67 #  True if two types agree
   68 #
   69 sub typeMatch {
   70   my ($ltype,$rtype) = @_;
   71   return 0 if ($ltype->{name} ne $rtype->{name});
   72   return 1 if (!$ltype->{list} && !$rtype->{list});
   73   return 0 if ($ltype->{list} != $rtype->{list});
   74   return 0 if ($ltype->{length} ne $rtype->{length});
   75   return typeMatch($ltype->{entryType},$rtype->{entryType});
   76 }
   77 
   78 #
   79 #  Check if an item is a number, complex, etc.
   80 #
   81 sub isRealNumber {my $self = shift; return $self->isNumber && !$self->isComplex}
   82 sub isNumber {my $self = shift; return ($self->typeRef->{name} eq 'Number')}
   83 sub isComplex {
   84   my $self = shift; my $type = $self->typeRef;
   85   return ($type->{name} eq 'Number' && $type->{length} == 2);
   86 }
   87 sub isNumOrInfinity {
   88   my $self = shift;
   89   return ($self->isRealNumber || $self->{isInfinite});
   90 }
   91 
   92 #
   93 #  Check if an item is a unary negation
   94 #
   95 sub isNeg {
   96   my $self = shift;
   97   return ($self->class eq 'UOP' && $self->{uop} eq 'u-' && !$self->{op}->{isInfinite});
   98 }
   99 
  100 #
  101 #  Check if an item can be in a union or is a set or reals
  102 #    (overridden in subclasses)
  103 #
  104 sub canBeInUnion {0}
  105 sub isSetOfReals {(shift)->type =~ m/^(Interval|Union|Set)$/}
  106 
  107 #
  108 #  Add parens to an expression (alternating the type of paren)
  109 #
  110 sub addParens {
  111   my $self = shift; my $string = shift;
  112   if ($string =~ m/^[^\[]*\(/) {return '['.$string.']'}
  113   return '('.$string.')';
  114 }
  115 
  116 #
  117 #  These are stubs for the subclasses
  118 #
  119 sub getVariables {{}}   #  find out what variables are used
  120 sub makeList {shift}    #  flatten a tree of commas into a list
  121 sub makeMatrix {}       #  convert a list to a matrix
  122 
  123 sub reduce {shift}
  124 sub substitute {shift}
  125 sub string {}
  126 sub TeX {}
  127 sub perl {}
  128 
  129 sub ijk {
  130   my $self = shift;
  131   $self->Error("Can't use method 'ijk' with objects of type '%s'",$self->type);
  132 }
  133 
  134 #
  135 #  Recursively copy an item, and set a new equation pointer, if any
  136 #
  137 sub copy {
  138   my $self = shift; my $equation = shift;
  139   my $new = {%{$self}};
  140   if (ref($self) ne 'HASH') {
  141     $new->{equation} = $equation if defined($equation);
  142     $new->{ref} = undef;
  143     bless $new, ref($self);
  144     $new->weaken;
  145   }
  146   $new->{type} = copy($self->{type}) if defined($self->{type});
  147   return $new;
  148 }
  149 
  150 #
  151 #  Report an error message
  152 #
  153 sub Error {
  154   my $self = shift;
  155   my $message = shift; $message = [$message,@_] if scalar(@_) > 0;
  156   $self->{equation}->Error($message,$self->{ref}) if defined($self->{equation});
  157   Parser->Error($message);
  158 }
  159 
  160 #########################################################################
  161 #
  162 #  Load the subclasses.
  163 #
  164 
  165 END {
  166   use Parser::BOP;
  167   use Parser::UOP;
  168   use Parser::List;
  169   use Parser::Function;
  170   use Parser::Variable;
  171   use Parser::Constant;
  172   use Parser::Value;
  173   use Parser::Number;
  174   use Parser::Complex;
  175   use Parser::String;
  176 }
  177 
  178 #########################################################################
  179 
  180 1;

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9