[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 5696 - (download) (as text) (annotate)
Sat Jun 14 12:14:21 2008 UTC (11 years, 8 months ago) by dpvc
File size: 4394 byte(s)
Added

	 no strict "refs"

to try to avoid new error checking in Perl 5.10.

    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; no strict "refs";
    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