[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 2682 - (download) (as text) (annotate)
Tue Aug 24 03:36:54 2004 UTC (15 years, 5 months ago) by dpvc
File size: 23971 byte(s)
Fixed a bug with  sin^2 x  that introduced when I adjusted the
error report for implied multiplication.

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

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9