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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2676 - (download) (as text) (annotate)
Mon Aug 23 05:00:16 2004 UTC (15 years, 4 months ago) by dpvc
File size: 23569 byte(s)
Better highlighting for syntax error involving implied
multiplication.  (No highlighted had been done in the past.)

    1 package Parser;
    2 my $pkg = "Parser";
    3 
    4 use strict;
    5 #use Carp;
    6 
    7 ##################################################
    8 #
    9 #  Parse a string and create a new Parser object
   10 #  If the string is already a parsed object then copy the parse tree
   11 #  If it is a Value, make an appropriate tree for it.
   12 #
   13 sub new {
   14   my $self = shift; my $class = ref($self) || $self;
   15   my $string = shift;
   16   $string = Value::List->new($string,@_)
   17     if scalar(@_) > 0 || ref($string) eq 'ARRAY';
   18   my $math = bless {
   19     string => undef,
   20     tokens => [], tree => undef,
   21     variables => {}, values => {},
   22     context => Parser::Context->current,
   23   }, $class;
   24   if (ref($string) =~ m/^(Parser|Value::Formula)/) {
   25     my $tree = $string; $tree = $tree->{tree} if exists $tree->{tree};
   26     $math->{tree} = $tree->copy($math);
   27   } elsif (Value::isValue($string)) {
   28     $math->{tree} = Parser::Value->new($math,$string);
   29   } else {
   30     $math->{string} = $string;
   31     $math->tokenize;
   32     $math->parse;
   33   }
   34   return $math;
   35 }
   36 
   37 sub copy {my $self = shift; $self->new($self)}
   38 
   39 ##################################################
   40 #
   41 #  Break the string into tokens based on the patterns for the various
   42 #  types of objects.
   43 #
   44 sub tokenize {
   45   my $self = shift; my $space;
   46   my $tokens = $self->{tokens}; my $string = $self->{string};
   47   my $tokenPattern = $self->{context}{pattern}{token};
   48   @{$tokens} = (); $self->{error} = 0; $self->{message} = '';
   49   $string =~ m/^\s*/gc; my $p0 = 0; my $p1;
   50   while (pos($string) < length($string)) {
   51     $p0 = pos($string);
   52     if ($string =~ m/\G$tokenPattern/gc) {
   53       $p1 = pos($string);
   54       push(@{$tokens},['str',$1,$p0,$p1,$space])   if (defined($1));
   55       push(@{$tokens},['fn',$2,$p0,$p1,$space])    if (defined($2));
   56       push(@{$tokens},['const',$3,$p0,$p1,$space]) if (defined($3));
   57       push(@{$tokens},['num',$4,$p0,$p1,$space])   if (defined($4));
   58       push(@{$tokens},['op',$5,$p0,$p1,$space])    if (defined($5));
   59       push(@{$tokens},['open',$6,$p0,$p1,$space])  if (defined($6));
   60       push(@{$tokens},['close',$7,$p0,$p1,$space]) if (defined($7));
   61       push(@{$tokens},['var',$8,$p0,$p1,$space])   if (defined($8));
   62     } else {
   63       push(@{$tokens},['error',substr($string,$p0,1),$p0,$p0+1]);
   64       $self->{error} = 1;
   65       last;
   66     }
   67     $space = ($string =~ m/\G\s+/gc);
   68   }
   69 }
   70 
   71 ##################################################
   72 #
   73 #  Parse the token list to produce the expression tree.  This does syntax checks
   74 #  and reports "compile-time" errors.
   75 #
   76 #  Start with a stack that has a single entry (an OPEN object for the expression)
   77 #  For each token, try to add that token to the tree.
   78 #  After all tokens have been finished, add a CLOSE object for the initial OPEN
   79 #    and save the complete tree
   80 #
   81 sub parse {
   82   my $self = shift;
   83   $self->{tree} = undef; $self->{error} = 0;
   84   $self->{stack} = [{type => 'open', value => 'start'}];
   85   foreach my $ref (@{$self->{tokens}}) {
   86     $self->{ref} = $ref; $self->{space} = $ref->[4];
   87     for ($ref->[0]) {
   88       /open/  and do {$self->Open($ref->[1]); last};
   89       /close/ and do {$self->Close($ref->[1],$ref); last};
   90       /op/    and do {$self->Op($ref->[1],$ref); last};
   91       /num/   and do {$self->Num($ref->[1]); last};
   92       /const/ and do {$self->Const($ref->[1]); last};
   93       /var/   and do {$self->Var($ref->[1]); last};
   94       /fn/    and do {$self->Fn($ref->[1]); last};
   95       /str/   and do {$self->Str($ref->[1]); last};
   96       /error/ and do {$self->Error("Unexpected character '$ref->[1]'",$ref); last};
   97     }
   98     return if ($self->{error});
   99   }
  100   $self->Close('start'); return if ($self->{error});
  101   $self->{tree} = $self->{stack}->[0]->{value};
  102 }
  103 
  104 
  105 #  Get the top or previous item of the stack
  106 #
  107 sub top {
  108   my $self = shift; my $i = shift || 0;
  109   return $self->{stack}->[$i-1];
  110 }
  111 sub prev {(shift)->top(-1)}
  112 
  113 #
  114 #  Push or pop the top of the stack
  115 #
  116 sub pop {pop(@{(shift)->{stack}})}
  117 sub push {push(@{(shift)->{stack}},@_)}
  118 
  119 #
  120 #  Return the type of the top item
  121 #
  122 sub state {(shift)->top->{type}}
  123 
  124 #
  125 #  Report an error at a given possition (if possible)
  126 #
  127 sub Error {
  128   my $self = shift; my $context = $self->{context};
  129   my $message = shift; my $ref = shift; my $string;
  130   if ($ref) {
  131     $message .= "; see position ".($ref->[2]+1)." of formula";
  132     $string = $self->{string};
  133     $ref = [$ref->[2],$ref->[3]];
  134   }
  135   $context->setError($message,$string,$ref);
  136   die $message . Value::getCaller();
  137 }
  138 
  139 #
  140 #  Insert an implicit multiplication
  141 #  (fix up the reference for spaces or juxtaposition)
  142 #
  143 sub ImplicitMult {
  144   my $self = shift;
  145   my $ref = $self->{ref}; my $iref = [@{$ref}];
  146   $iref->[2]--; $iref->[3] = $iref->[2]+1;
  147   $iref->[3]++ unless substr($self->{string},$iref->[2],1) eq ' ';
  148   $self->Error("Can't perform implied multiplication in this context",$iref)
  149     unless $self->{context}{operators}{' '}{class};
  150   $self->Op(' ',$iref);
  151   $self->{ref} = $ref;
  152 }
  153 
  154 #
  155 #  Push an operator onto the expression stack.
  156 #  We save the operator symbol, the precedence, etc.
  157 #
  158 sub pushOperator {
  159   my $self = shift;
  160   my ($op,$precedence,$reverse) = @_;
  161   $self->push({
  162     type => 'operator', ref => $self->{ref},
  163     name => $op, precedence => $precedence, reverse => $reverse
  164   });
  165 }
  166 
  167 #
  168 #  Push an operand onto the expression stack.
  169 #
  170 sub pushOperand {
  171   my $self = shift; my $value = shift;
  172   $self->push({type => 'operand', ref => $self->{ref}, value => $value});
  173 }
  174 
  175 ##################################################
  176 #
  177 #  Handle an operator token
  178 #
  179 #  Get the operator data from the context
  180 #  If the top of the stack is an operand
  181 #    If the operator is a left-associative unary operator
  182 #      Insert an implicit multiplication and save the operator
  183 #    Otherwise
  184 #      Complete any pending operations of higher precedence
  185 #      If the top item is still an operand
  186 #        If we have a (right associative) unary operator
  187 #          Apply it to the top operand
  188 #        Otherwise (binary operator)
  189 #          Convert the space operator to explicit multiplication
  190 #          Save the opertor on the stack
  191 #      Otherwise, (top is not an operand)
  192 #        If the operator is an explicit on or the top is a function
  193 #          Call Op again to report the error, or to apply
  194 #            the operator to the function (this happens when
  195 #            there is a function to a power, for example)
  196 #  Otherwise (top is not an operand)
  197 #    If this is a left-associative unary operator, save it on the stack
  198 #    Otherwise, if it is a left-associative operator that CAN be unary
  199 #      Save the unary version of the operator on the stack
  200 #    Otherwise, if the top item is a function
  201 #      If the operator can be applied to functions, save it on the stack
  202 #      Otherwise, report that the function is missing its inputs
  203 #    Otherwise, report the missing operand for this operator
  204 #
  205 sub Op {
  206   my $self = shift; my $name = shift;
  207   my $ref = $self->{ref} = shift;
  208   my $context = $self->{context}; my $op = $context->{operators}{$name};
  209   $op = $context->{operators}{$op->{space}} if $self->{space} && defined($op->{space});
  210   if ($self->state eq 'operand') {
  211     if ($op->{type} eq 'unary' && $op->{associativity} eq 'left') {
  212       $self->ImplicitMult();
  213       $self->pushOperator($name,$op->{precedence});
  214     } else {
  215       $self->Precedence($op->{precedence});
  216       if ($self->state eq 'operand') {
  217         if ($op->{type} eq 'unary') {
  218           my $top = $self->pop;
  219           $self->pushOperand(Parser::UOP->new($self,$name,$top->{value},$ref));
  220         } else {
  221           $name = $context->{operators}{' '}{string}
  222             if $name eq ' ' or $name eq $context->{operators}{' '}{space};
  223           $self->pushOperator($name,$op->{precedence});
  224         }
  225       } elsif ($ref || $self->state ne 'fn') {$self->Op($name,$ref)}
  226     }
  227   } else {
  228     $name = 'u'.$name, $op = $context->{operators}{$name}
  229       if ($op->{type} eq 'both' && defined $context->{operators}{'u'.$name});
  230     if ($op->{type} eq 'unary' && $op->{associativity} eq 'left') {
  231       $self->pushOperator($name,$op->{precedence});
  232     } elsif ($self->state eq 'fn') {
  233       if ($op->{leftf}) {
  234         $self->pushOperator($name,$op->{precedence},1);
  235       } else {
  236         my $top = $self->top;
  237         $self->Error("Function '$top->{name}' is missing its input(s)",$top->{ref});
  238       }
  239     } else {$self->Error("Missing operand before '$name'",$ref)}
  240   }
  241 }
  242 
  243 ##################################################
  244 #
  245 #  Handle an open parenthesis
  246 #
  247 #  If the top of the stack is an operand
  248 #    Check if the open paren is really a close paren (for when the open
  249 #      and close symbol are the same)
  250 #    Otherwise insert an implicit multiplication
  251 #  Save the open object on the stack
  252 #
  253 sub Open {
  254   my $self = shift; my $type = shift;
  255   my $paren = $self->{context}{parens}{$type};
  256   if ($self->state eq 'operand') {
  257     if ($type eq $paren->{close})
  258       {$self->Close($type,$self->{ref}); return} else {$self->ImplicitMult()}
  259   }
  260   $self->push({type => 'open', value => $type, ref => $self->{ref}});
  261 }
  262 
  263 ##################################################
  264 #
  265 #  Handle a close parenthesis
  266 #
  267 #  When the top stack object is
  268 #    An open parenthesis (that is empty):
  269 #      Get the data for the type of parentheses
  270 #      If the parentheses can be empty and the parentheses match
  271 #        Save the empty list
  272 #      Otherwise report a message appropriate to the type of parentheses
  273 #
  274 #    An operand:
  275 #      Complete any pending operations, and stop if there was an error
  276 #      If the top is no longer an operand
  277 #        Call Close to report the error and return
  278 #      Get the item before the operand (an OPEN object), and its parenthesis type
  279 #      If the parens match
  280 #        Pop the operand off the stack
  281 #        If the parens can't be removed, or if the operand is a list
  282 #          Make the operand into a list object
  283 #        Replace the paren object with the operand
  284 #        If the parentheses are used for function calls and the
  285 #          previous stack object is a function call, do the function apply
  286 #        Otherwise report an appropriate error message
  287 #
  288 #    A function:
  289 #      Report an error message about missing inputs
  290 #
  291 #    An operator:
  292 #      Report the missing operation
  293 #
  294 sub Close {
  295   my $self = shift; my $type = shift;
  296   my $ref = $self->{ref} = shift;
  297   my $parens = $self->{context}{parens};
  298 
  299   for ($self->state) {
  300     /open/ and do {
  301       my $top = $self->pop; my $paren = $parens->{$top->{value}};
  302       if ($paren->{emptyOK} && $paren->{close} eq $type) {
  303         $self->pushOperand(Parser::List->new($self,[],1,$paren))
  304       }
  305       elsif ($type eq 'start') {$self->Error("Missing close parenthesis for '$top->{value}'",$top->{ref})}
  306       elsif ($top->{value} eq 'start') {$self->Error("Extra close parenthesis '$type'",$ref)}
  307       else {$top->{ref}[3]=$ref->[3]; $self->Error("Empty parentheses",$top->{ref})}
  308       last;
  309     };
  310 
  311     /operand/ and do {
  312       $self->Precedence(0); return if ($self->{error});
  313       if ($self->state ne 'operand') {$self->Close($type,$ref); return}
  314       my $paren = $parens->{$self->prev->{value}};
  315       if ($paren->{close} eq $type) {
  316         my $top = $self->pop;
  317         if (!$paren->{removable} || ($top->{value}->type eq "Comma")) {
  318           $top = $top->{value};
  319           $top = {type => 'operand', value =>
  320                   Parser::List->new($self,[$top->makeList],$top->{isConstant},$paren,
  321                     ($top->type eq 'Comma') ? $top->entryType : $top->typeRef,
  322                     ($type ne 'start') ? ($self->top->{value},$type) : () )};
  323         }
  324         $self->pop; $self->push($top);
  325         $self->CloseFn() if ($paren->{function} && $self->prev->{type} eq 'fn');
  326       } elsif ($paren->{formInterval} eq $type && $self->top->{value}->length == 2) {
  327         my $top = $self->pop->{value}; my $open = $self->pop->{value};
  328         $self->pushOperand(
  329            Parser::List->new($self,[$top->makeList],$top->{isConstant},
  330                               $paren,$top->entryType,$open,$type));
  331       } else {
  332         my $prev = $self->prev;
  333         if ($type eq "start") {$self->Error("Missing close parenthesis for '$prev->{value}'",$prev->{ref})}
  334         elsif ($prev->{value} eq "start") {$self->Error("Extra close parenthesis '$type'",$ref)}
  335         else {$self->Error("Mismatched parentheses: '$prev->{value}' and '$type'",$ref)}
  336         return;
  337       }
  338       last;
  339     };
  340 
  341     /fn/ and do {
  342       my $top = $self->top;
  343       $self->Error("Function '$top->{name}' is missing its input(s)",$top->{ref});
  344       return;
  345     };
  346 
  347     /operator/ and do {
  348       my $top = $self->top(); my $name = $top->{name}; $name =~ s/^u//;
  349       $self->Error("Missing operand after '$name'",$top->{ref});
  350       return;
  351     };
  352   }
  353 }
  354 
  355 ##################################################
  356 #
  357 #  Handle any pending operations of higher precedence
  358 #
  359 #  While the top stack item is an operand:
  360 #    When the preceding item is:
  361 #      An pending operator:
  362 #        Get the precedence of the operator (use the special right-hand prrecedence
  363 #          of there is one, otherwise use the general precedence)
  364 #        Stop processing if the current operator precedence is higher
  365 #        If the stacked operator is binary or if it is reversed (for function operators)
  366 #          Stop processing if the precedence is equal and we are right associative
  367 #          If the operand for the stacked operator is a function
  368 #            If the operation is ^(-1) (for inverses)
  369 #              Push the inverse function name
  370 #            Otherwise
  371 #              Reverse the order of the stack, so that the function can be applied
  372 #                to the next operand (it will be unreversed later)
  373 #          Otherwise (not a function, so an operand)
  374 #            Get the operands and binary operator off the stack
  375 #            If it is reversed (for functions), get the order right
  376 #            Save the result of the binary operation as an operand on the stack
  377 #        Otherwise (the stack contains a unary operator)
  378 #          Get the operator and operand off the stack
  379 #          Push the result of the unary operator as an operand on the stack
  380 #
  381 #      A pending function call:
  382 #        Keep working if the precedence of the operator is higher than a function call
  383 #        Otherwise apply the function to the operator and continue
  384 #
  385 #      Anything else:
  386 #        Return (no more pending operations)
  387 #
  388 #    If there was an error, stop processing
  389 #
  390 sub Precedence {
  391   my $self = shift; my $precedence = shift;
  392   my $context = $self->{context};
  393   while ($self->state eq 'operand') {
  394     my $prev = $self->prev;
  395     for ($prev->{type}) {
  396 
  397       /operator/ and do {
  398         my $prev_prec = $context->{operators}{$prev->{name}}{rprecedence};
  399         $prev_prec = $prev->{precedence} unless $prev_prec;
  400         return if ($precedence > $prev_prec);
  401         if ($self->top(-2)->{type} eq 'operand' || $prev->{reverse}) {
  402           return if ($precedence == $prev_prec &&
  403               $context->{operators}{$prev->{name}}{associativity} eq 'right');
  404           if ($self->top(-2)->{type} eq 'fn') {
  405             my $top = $self->pop; my $op = $self->pop; my $fun = $self->pop;
  406             if (Parser::Function::checkInverse($self,$fun,$op,$top)) {
  407               $fun->{name} = $context->{functions}{$fun->{name}}{inverse};
  408               $self->push($fun);
  409             } else {$self->push($top,$op,$fun)}
  410           } else {
  411             my $rop = $self->pop; my $op = $self->pop; my $lop = $self->pop;
  412             if ($op->{reverse}) {my $tmp = $rop; $rop = $lop; $lop = $tmp}
  413             $self->pushOperand(Parser::BOP->new($self,$op->{name},
  414                  $lop->{value},$rop->{value},$op->{ref}),$op->{reverse});
  415           }
  416         } else {
  417           my $rop = $self->pop; my $op = $self->pop;
  418           $self->pushOperand(Parser::UOP->new
  419              ($self,$op->{name},$rop->{value},$op->{ref}),$op->{reverse});
  420         }
  421         last;
  422       };
  423 
  424       /fn/ and do {
  425         return if ($precedence > $context->{operators}{fn}{precedence});
  426         $self->CloseFn();
  427         last;
  428       };
  429 
  430       return;
  431 
  432     }
  433     return if ($self->{error});
  434   }
  435 }
  436 
  437 ##################################################
  438 #
  439 #  Apply a function to its parameters
  440 #
  441 #  If the operand is a list and the parens are those for function calls
  442 #    Use the list items as the parameters, otherwise use the top item
  443 #  Pop the function object, and push the result of the function call
  444 #
  445 sub CloseFn {
  446   my $self = shift; my $context = $self->{context};
  447   my $top = $self->pop->{value}; my $fn = $self->pop;
  448   my $constant = $top->{isConstant};
  449   if ($context->{parens}{$top->{open}}{function} &&
  450       $context->{parens}{$top->{open}}{close} eq $top->{close} &&
  451       !$context->{functions}{$fn->{name}}{vectorInput})
  452          {$top = $top->coords} else {$top = [$top]}
  453   $self->pushOperand(Parser::Function->new
  454      ($self,$fn->{name},$top,$constant,$fn->{ref}));
  455 }
  456 
  457 ##################################################
  458 #
  459 #  Handle a numeric token
  460 #
  461 #  Add an implicit multiplication, if needed
  462 #  Create the number object and check it
  463 #  Save the number as an operand
  464 #
  465 sub Num {
  466   my $self = shift;
  467   $self->ImplicitMult() if $self->state eq 'operand';
  468   my $num = Parser::Number->new($self,shift,$self->{ref});
  469   my $check = $self->{context}->flag('NumberCheck');
  470   &$check($num) if $check;
  471   $self->pushOperand($num);
  472 }
  473 
  474 ##################################################
  475 #
  476 #  Handle a constant token
  477 #
  478 #  Add an implicit multiplication, if needed
  479 #  Save the number as an operand
  480 #
  481 sub Const {
  482   my $self = shift; my $ref = $self->{ref};
  483   my $name = shift; my $const = $self->{context}{constants}{$name};
  484   $self->ImplicitMult() if $self->state eq 'operand';
  485   if (defined($self->{context}{variables}{$name})) {
  486     $self->pushOperand(Parser::Variable->new($self,$name,$ref));
  487   } elsif ($const->{keepName}) {
  488     $self->pushOperand(Parser::Constant->new($self,$name,$ref));
  489   } else {
  490     $self->pushOperand(Parser::Value->new($self,[$const->{value}],$ref));
  491   }
  492 }
  493 
  494 ##################################################
  495 #
  496 #  Handle a variable token
  497 #
  498 #  Add an implicit multiplication, if needed
  499 #  Save the variable as an operand
  500 #
  501 sub Var {
  502   my $self = shift;
  503   $self->ImplicitMult() if $self->state eq 'operand';
  504   $self->pushOperand(Parser::Variable->new($self,shift,$self->{ref}));
  505 }
  506 
  507 ##################################################
  508 #
  509 #  Handle a function token
  510 #
  511 #  Add an implicit multiplication, if needed
  512 #  Save the function object on the stack
  513 #
  514 sub Fn {
  515   my $self = shift;
  516   $self->ImplicitMult() if $self->state eq 'operand';
  517   $self->push({type => 'fn', name => shift, ref => $self->{ref}});
  518 }
  519 
  520 ##################################################
  521 #
  522 #  Handle a string constant
  523 #
  524 #  Add an implicit multiplication, if needed (will report an error)
  525 #  Save the string object on the stack
  526 #
  527 sub Str {
  528   my $self = shift;
  529   $self->ImplicitMult() if $self->state eq 'operand';
  530   $self->pushOperand(Parser::String->new($self,shift,$self->{ref}));
  531 }
  532 
  533 ##################################################
  534 ##################################################
  535 #
  536 #  Evaluate the equation using the given values
  537 #
  538 sub eval {
  539   my $self = shift;
  540   $self->setValues(@_);
  541   foreach my $x (keys %{$self->{values}}) {
  542     $self->Error("The value of '$x' can't be a formula")
  543       if Value::isFormula($self->{values}{$x});
  544   }
  545   $self->{tree}->eval;
  546 }
  547 
  548 ##################################################
  549 #
  550 #  Removes redundent items (like x+-y, 0+x and 1*x, etc)
  551 #  (substituting the given values).
  552 #
  553 sub reduce {
  554   my $self = shift;
  555   $self = $self->copy($self);
  556   $self->setValues(@_);
  557   $self->{tree} = $self->{tree}->reduce;
  558   $self->{variables} = $self->{tree}->getVariables;
  559   return $self;
  560 }
  561 
  562 ##################################################
  563 #
  564 #  Substitute values for one or more variables
  565 #
  566 sub substitute {
  567   my $self = shift;
  568   $self = $self->copy($self);
  569   $self->setValues(@_);
  570   foreach my $x (keys %{$self->{values}}) {delete $self->{variables}{$x}}
  571   $self->{tree} = $self->{tree}->substitute;
  572   return $self;
  573 }
  574 
  575 ##################################################
  576 #
  577 #  Produces a printable string (substituting the given values).
  578 #
  579 sub string {
  580   my $self = shift;
  581   $self->setValues(@_);
  582   $self->{tree}->string;
  583 }
  584 
  585 ##################################################
  586 #
  587 #  Produces a TeX string (substituting the given values).
  588 #
  589 sub TeX {
  590   my $self = shift;
  591   $self->setValues(@_);
  592   $self->{tree}->TeX;
  593 }
  594 
  595 ##################################################
  596 #
  597 #  Produces a perl eval string (substituting the given values).
  598 #
  599 sub perl {
  600   my $self = shift;
  601   $self->setValues(@_);
  602   $self->{tree}->perl;
  603 }
  604 
  605 ##################################################
  606 #
  607 #  Produce a perl function
  608 #
  609 #  (Parameters specify an optional name and an array reference of
  610 #   optional variables. If the name is not included, an anonymous
  611 #   code reference is returned.  If the variables are not included,
  612 #   then the variables from the formula are used in sorted order.)
  613 #
  614 sub perlFunction {
  615   my $self = shift; my $name = shift; my $vars = shift;
  616   $vars = [sort(keys %{$self->{variables}})] unless $vars;
  617   my $n = scalar(@{$vars}); my $vnames = '';
  618   if ($n > 0) {
  619     my @v = (); foreach my $x (@{$vars}) {push(@v,'$'.$x)}
  620     $vnames = "my (".join(',',@v).") = \@_;";
  621   }
  622   my $fn = eval
  623    "package main;
  624     sub $name {
  625       die \"Wrong number of arguments".($name?" to '$name'":'')."\" if scalar(\@_) != $n;
  626       $vnames
  627       return ".$self->perl.";
  628     }";
  629   $self->Error($@) if $@;
  630   return $fn;
  631 }
  632 
  633 
  634 ##################################################
  635 #
  636 #  Sets the values of variables for evaluation purposes
  637 #
  638 sub setValues {
  639   my $self = shift; my ($value,$type);
  640   my $variables = $self->{context}{variables};
  641   $self->{values} = {@_};
  642   foreach my $x (keys %{$self->{values}}) {
  643     $self->Error("Undeclared variable '$x'") unless defined $variables->{$x};
  644     $value = Value::makeValue($self->{values}{$x});
  645     $value = Value::Formula->new($value) unless Value::isValue($value);
  646     ($value,$type) = Value::getValueType($self,$value);
  647     $self->Error("Variable '$x' should be of type $variables->{$x}{type}{name}")
  648       unless Parser::Item::typeMatch($type,$variables->{$x}{type});
  649     $self->{values}{$x} = $value;
  650   }
  651 }
  652 
  653 
  654 ##################################################
  655 ##################################################
  656 #
  657 #  Produce a vector in ijk form
  658 #
  659 sub ijk {
  660   my $self = shift;
  661   $self->{tree}->ijk;
  662 }
  663 
  664 #########################################################################
  665 #########################################################################
  666 #
  667 #  Load the sub-classes and Value.pm
  668 #
  669 
  670 use Parser::Item;
  671 use Value;
  672 use Parser::Context;
  673 use Parser::Context::Default;
  674 use Parser::Differentiation;
  675 
  676 ###########################################################################
  677 
  678 use vars qw($installed);
  679 $Parser::installed = 1;
  680 
  681 ###########################################################################
  682 ###########################################################################
  683 #
  684 #   To Do:
  685 #
  686 # handle sqrt(-1) and log of negatives (make complexes)
  687 # do division by zero and log of zero checks in compound functions
  688 # add context flags for various reduction checks
  689 # make context flag for reduction of constants
  690 # make reduce have reduce patterns as parameters
  691 # more reduce patterns
  692 # make operator strings customizable (reduce, and other places they are used)
  693 # add parens alternately as () and []?
  694 #
  695 #########################################################################
  696 
  697 1;
  698 

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9