[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 2558 - (download) (as text) (annotate)
Wed Jul 28 20:32:33 2004 UTC (15 years, 6 months ago) by sh002i
File size: 22708 byte(s)
merged changes from rel-2-1-a1 -- stop using that branch.

    1 # handle sqrt(-1) and log of negatives (make complexes)
    2 # do division by zero and log of zero checks in compound functions
    3 # add context flags for various reduction checks
    4 # make context flag for reduction of constants
    5 # make reduce have reduce patterns as parameters
    6 # more reduce patterns
    7 # make operator strings customizable (reduce, and other places they are used)
    8 # add parens alternately as () and []?
    9 
   10 package Parser;
   11 my $pkg = "Parser";
   12 
   13 use strict;
   14 #use Carp;
   15 
   16 ##################################################
   17 #
   18 #  Parse a string and create a new Parser object
   19 #  If the string is already a parsed object then copy the parse tree
   20 #  If it is a Value, make an appropriate tree for it.
   21 #
   22 sub new {
   23   my $self = shift; my $class = ref($self) || $self;
   24   my $string = shift;
   25   my $math = bless {
   26     string => undef,
   27     tokens => [],
   28     tree => undef,
   29     variables => {}, values => {},
   30     context => Parser::Context->current,
   31     error => 0, errorPos => undef,
   32     message => '',
   33   }, $class;
   34   if (ref($string) =~ m/^(Parser|Value::Formula)/) {
   35     my $tree = $string; $tree = $tree->{tree} if exists $tree->{tree};
   36     $math->{tree} = $tree->copy($math);
   37   } elsif (ref($string) =~ m/^Value/) {
   38     $math->{tree} = Parser::Value->new($math,$string);
   39   } else {
   40     $math->{string} = $string;
   41     $math->tokenize;
   42     $math->parse;
   43   }
   44   return $math;
   45 }
   46 
   47 sub copy {my $self = shift; $self->new($self)}
   48 
   49 ##################################################
   50 #
   51 #  Break the string into tokens based on the patterns for the various
   52 #  types of objects.
   53 #
   54 sub tokenize {
   55   my $self = shift; my $space;
   56   my $tokens = $self->{tokens}; my $string = $self->{string};
   57   my $tokenPattern = $self->{context}{pattern}{token};
   58   @{$tokens} = (); $self->{error} = 0; $self->{message} = '';
   59   $string =~ m/^\s*/gc; my $p0 = 0; my $p1;
   60   while (pos($string) < length($string)) {
   61     $p0 = pos($string);
   62     if ($string =~ m/\G$tokenPattern/gc) {
   63       $p1 = pos($string);
   64       push(@{$tokens},['str',$1,$p0,$p1,$space])   if (defined($1));
   65       push(@{$tokens},['fn',$2,$p0,$p1,$space])    if (defined($2));
   66       push(@{$tokens},['const',$3,$p0,$p1,$space]) if (defined($3));
   67       push(@{$tokens},['num',$4,$p0,$p1,$space])   if (defined($4));
   68       push(@{$tokens},['op',$5,$p0,$p1,$space])    if (defined($5));
   69       push(@{$tokens},['open',$6,$p0,$p1,$space])  if (defined($6));
   70       push(@{$tokens},['close',$7,$p0,$p1,$space]) if (defined($7));
   71       push(@{$tokens},['var',$8,$p0,$p1,$space])   if (defined($8));
   72     } else {
   73       push(@{$tokens},['error',substr($string,$p0,3),$p0]);
   74       $self->{error} = 1;
   75       last;
   76     }
   77     $space = ($string =~ m/\G\s+/gc);
   78   }
   79 }
   80 
   81 ##################################################
   82 #
   83 #  Parse the token list to produce the expression tree.  This does syntax checks
   84 #  and reports "compile-time" errors.
   85 #
   86 #  Start with a stack that has a single entry (an OPEN object for the expression)
   87 #  For each token, try to add that token to the tree.
   88 #  After all tokens have been finished, add a CLOSE object for the initial OPEN
   89 #    and save the complete tree
   90 #
   91 sub parse {
   92   my $self = shift;
   93   $self->{tree} = undef; $self->{error} = 0;
   94   $self->{stack} = [{type => 'open', value => 'start'}];
   95   foreach my $ref (@{$self->{tokens}}) {
   96     $self->{ref} = $ref; $self->{space} = $ref->[4];
   97     for ($ref->[0]) {
   98       /open/  and do {$self->Open($ref->[1]); last};
   99       /close/ and do {$self->Close($ref->[1],$ref); last};
  100       /op/    and do {$self->Op($ref->[1],$ref); last};
  101       /num/   and do {$self->Num($ref->[1]); last};
  102       /const/ and do {$self->Const($ref->[1]); last};
  103       /var/   and do {$self->Var($ref->[1]); last};
  104       /fn/    and do {$self->Fn($ref->[1]); last};
  105       /str/   and do {$self->Str($ref->[1]); last};
  106       /error/ and do {$self->Error("Unexpected characters '$ref->[1]'",$ref); last};
  107     }
  108     return if ($self->{error});
  109   }
  110   $self->Close('start'); return if ($self->{error});
  111   $self->{tree} = $self->{stack}->[0]->{value};
  112 }
  113 
  114 
  115 #  Get the top or previous item of the stack
  116 #
  117 sub top {
  118   my $self = shift; my $i = shift || 0;
  119   return $self->{stack}->[$i-1];
  120 }
  121 sub prev {(shift)->top(-1)}
  122 
  123 #
  124 #  Push or pop the top of the stack
  125 #
  126 sub pop {pop(@{(shift)->{stack}})}
  127 sub push {push(@{(shift)->{stack}},@_)}
  128 
  129 #
  130 #  Return the type of the top item
  131 #
  132 sub state {(shift)->top->{type}}
  133 
  134 #
  135 #  Report an error at a given possition (if possible)
  136 #
  137 sub Error {
  138   my $self = shift; my $context = $self->{context};
  139   my $message = shift; my $ref = shift; my $string;
  140   if ($ref) {
  141     $message .= "; see position ".($ref->[2]+1)." of formula";
  142     $string = $self->{string};
  143     $ref = [$ref->[2],$ref->[3]];
  144   }
  145   $context->setError($message,$string,$ref);
  146   die $message . Value::getCaller();
  147 #  confess $message;
  148 }
  149 
  150 #
  151 #  Insert an implicit multiplication
  152 #
  153 sub ImplicitMult {
  154   my $self = shift;
  155   my $ref = $self->{ref};
  156   $self->Op(' ');
  157   $self->{ref} = $ref;
  158 }
  159 
  160 #
  161 #  Push an operator onto the expression stack.
  162 #  We save the operator symbol, the precedence, etc.
  163 #
  164 sub pushOperator {
  165   my $self = shift;
  166   my ($op,$precedence,$reverse) = @_;
  167   $self->push({
  168     type => 'operator', ref => $self->{ref},
  169     name => $op, precedence => $precedence, reverse => $reverse
  170   });
  171 }
  172 
  173 #
  174 #  Push an operand onto the expression stack.
  175 #
  176 sub pushOperand {
  177   my $self = shift; my $value = shift;
  178   $self->push({type => 'operand', ref => $self->{ref}, value => $value});
  179 }
  180 
  181 ##################################################
  182 #
  183 #  Handle an operator token
  184 #
  185 #  Get the operator data from the context
  186 #  If the top of the stack is an operand
  187 #    If the operator is a left-associative unary operator
  188 #      Insert an implicit multiplication and save the operator
  189 #    Otherwise
  190 #      Complete any pending operations of higher precedence
  191 #      If the top item is still an operand
  192 #        If we have a (right associative) unary operator
  193 #          Apply it to the top operand
  194 #        Otherwise (binary operator)
  195 #          Convert the space operator to explicit multiplication
  196 #          Save the opertor on the stack
  197 #      Otherwise, (top is not an operand)
  198 #        If the operator is an explicit on or the top is a function
  199 #          Call Op again to report the error, or to apply
  200 #            the operator to the function (this happens when
  201 #            there is a function to a power, for example)
  202 #  Otherwise (top is not an operand)
  203 #    If this is a left-associative unary operator, save it on the stack
  204 #    Otherwise, if it is a left-associative operator that CAN be unary
  205 #      Save the unary version of the operator on the stack
  206 #    Otherwise, if the top item is a function
  207 #      If the operator can be applied to functions, save it on the stack
  208 #      Otherwise, report that the function is missing its inputs
  209 #    Otherwise, report the missing operand for this operator
  210 #
  211 sub Op {
  212   my $self = shift; my $name = shift;
  213   my $ref = $self->{ref} = shift;
  214   my $context = $self->{context}; my $op = $context->{operators}{$name};
  215   $op = $context->{operators}{$op->{space}} if $self->{space} && defined($op->{space});
  216   if ($self->state eq 'operand') {
  217     if ($op->{type} eq 'unary' && $op->{associativity} eq 'left') {
  218       $self->ImplicitMult();
  219       $self->pushOperator($name,$op->{precedence});
  220     } else {
  221       $self->Precedence($op->{precedence});
  222       if ($self->state eq 'operand') {
  223         if ($op->{type} eq 'unary') {
  224           my $top = $self->pop;
  225           $self->pushOperand(Parser::UOP->new($self,$name,$top->{value},$ref));
  226         } else {
  227           $name = $context->{operators}{' '}{string}
  228             if $name eq ' ' or $name eq $context->{operators}{' '}{space};
  229           $self->pushOperator($name,$op->{precedence});
  230         }
  231       } elsif ($ref || $self->state ne 'fn') {$self->Op($name,$ref)}
  232     }
  233   } else {
  234     $name = 'u'.$name, $op = $context->{operators}{$name}
  235       if ($op->{type} eq 'both' && defined $context->{operators}{'u'.$name});
  236     if ($op->{type} eq 'unary' && $op->{associativity} eq 'left') {
  237       $self->pushOperator($name,$op->{precedence});
  238     } elsif ($self->state eq 'fn') {
  239       if ($op->{leftf}) {
  240         $self->pushOperator($name,$op->{precedence},1);
  241       } else {
  242         my $top = $self->top;
  243         $self->Error("Function '$top->{name}' is missing its input(s)",$top->{ref});
  244       }
  245     } else {$self->Error("Missing operand before '$name'",$ref)}
  246   }
  247 }
  248 
  249 ##################################################
  250 #
  251 #  Handle an open parenthesis
  252 #
  253 #  If the top of the stack is an operand
  254 #    Check if the open paren is really a close paren (for when the open
  255 #      and close symbol are the same)
  256 #    Otherwise insert an implicit multiplication
  257 #  Save the open object on the stack
  258 #
  259 sub Open {
  260   my $self = shift; my $type = shift;
  261   my $paren = $self->{context}{parens}{$type};
  262   if ($self->state eq 'operand') {
  263     if ($type eq $paren->{close})
  264       {$self->Close($type,$self->{ref}); return} else {$self->ImplicitMult()}
  265   }
  266   $self->push({type => 'open', value => $type, ref => $self->{ref}});
  267 }
  268 
  269 ##################################################
  270 #
  271 #  Handle a close parenthesis
  272 #
  273 #  When the top stack object is
  274 #    An open parenthesis (that is empty):
  275 #      Get the data for the type of parentheses
  276 #      If the parentheses can be empty and the parentheses match
  277 #        Save the empty list
  278 #      Otherwise report a message appropriate to the type of parentheses
  279 #
  280 #    An operand:
  281 #      Complete any pending operations, and stop if there was an error
  282 #      If the top is no longer an operand
  283 #        Call Close to report the error and return
  284 #      Get the item before the operand (an OPEN object), and its parenthesis type
  285 #      If the parens match
  286 #        Pop the operand off the stack
  287 #        If the parens can't be removed, or if the operand is a list
  288 #          Make the operand into a list object
  289 #        Replace the paren object with the operand
  290 #        If the parentheses are used for function calls and the
  291 #          previous stack object is a function call, do the function apply
  292 #        Otherwise report an appropriate error message
  293 #
  294 #    A function:
  295 #      Report an error message about missing inputs
  296 #
  297 #    An operator:
  298 #      Report the missing operation
  299 #
  300 sub Close {
  301   my $self = shift; my $type = shift;
  302   my $ref = $self->{ref} = shift;
  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 {$self->Error("Empty parentheses: '$top->{value} $type'",$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(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(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(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 #  Save the number as an operand
  469 #
  470 sub Num {
  471   my $self = shift;
  472   $self->ImplicitMult() if $self->state eq 'operand';
  473   $self->pushOperand(Parser::Number->new($self,shift,$self->{ref}));
  474 }
  475 
  476 ##################################################
  477 #
  478 #  Handle a constant token
  479 #
  480 #  Add an implicit multiplication, if needed
  481 #  Save the number as an operand
  482 #
  483 sub Const {
  484   my $self = shift; my $ref = $self->{ref};
  485   my $name = shift; my $const = $self->{context}{constants}{$name};
  486   $self->ImplicitMult() if $self->state eq 'operand';
  487   if (defined($self->{context}{variables}{$name})) {
  488     $self->pushOperand(Parser::Variable->new($self,$name,$ref));
  489   } elsif ($const->{keepName}) {
  490     $self->pushOperand(Parser::Constant->new($self,$name,$ref));
  491   } else {
  492     $self->pushOperand(Parser::Value->new($self,[$const->{value}],$ref));
  493   }
  494 }
  495 
  496 ##################################################
  497 #
  498 #  Handle a variable token
  499 #
  500 #  Add an implicit multiplication, if needed
  501 #  Save the variable as an operand
  502 #
  503 sub Var {
  504   my $self = shift;
  505   $self->ImplicitMult() if $self->state eq 'operand';
  506   $self->pushOperand(Parser::Variable->new($self,shift,$self->{ref}));
  507 }
  508 
  509 ##################################################
  510 #
  511 #  Handle a function token
  512 #
  513 #  Add an implicit multiplication, if needed
  514 #  Save the function object on the stack
  515 #
  516 sub Fn {
  517   my $self = shift;
  518   $self->ImplicitMult() if $self->state eq 'operand';
  519   $self->push({type => 'fn', name => shift, ref => $self->{ref}});
  520 }
  521 
  522 ##################################################
  523 #
  524 #  Handle a string constant
  525 #
  526 #  Add an implicit multiplication, if needed (will report an error)
  527 #  Save the string object on the stack
  528 #
  529 sub Str {
  530   my $self = shift;
  531   $self->ImplicitMult() if $self->state eq 'operand';
  532   $self->pushOperand(Parser::String->new($self,shift,$self->{ref}));
  533 }
  534 
  535 ##################################################
  536 ##################################################
  537 #
  538 #  Evaluate the equation using the given values
  539 #
  540 sub eval {
  541   my $self = shift;
  542   $self->setValues(@_);
  543   foreach my $x (keys %{$self->{values}}) {
  544     $self->Error("The value of '$x' can't be a formula")
  545       if Value::isFormula($self->{values}{$x});
  546   }
  547   $self->{tree}->eval;
  548 }
  549 
  550 ##################################################
  551 #
  552 #  Removes redundent items (like x+-y, 0+x and 1*x, etc)
  553 #  (substituting the given values).
  554 #
  555 sub reduce {
  556   my $self = shift;
  557   $self = $self->copy($self);
  558   $self->setValues(@_);
  559   $self->{tree} = $self->{tree}->reduce;
  560   $self->{variables} = $self->{tree}->getVariables;
  561   return $self;
  562 }
  563 
  564 ##################################################
  565 #
  566 #  Substitute values for one or more variables
  567 #
  568 sub substitute {
  569   my $self = shift;
  570   $self = $self->copy($self);
  571   $self->setValues(@_);
  572   foreach my $x (keys %{$self->{values}}) {delete $self->{variables}{$x}}
  573   $self->{tree} = $self->{tree}->substitute;
  574   return $self;
  575 }
  576 
  577 ##################################################
  578 #
  579 #  Produces a printable string (substituting the given values).
  580 #
  581 sub string {
  582   my $self = shift;
  583   $self->setValues(@_);
  584   $self->{tree}->string;
  585 }
  586 
  587 ##################################################
  588 #
  589 #  Produces a TeX string (substituting the given values).
  590 #
  591 sub TeX {
  592   my $self = shift;
  593   $self->setValues(@_);
  594   $self->{tree}->TeX;
  595 }
  596 
  597 ##################################################
  598 #
  599 #  Produces a perl eval string (substituting the given values).
  600 #
  601 sub perl {
  602   my $self = shift;
  603   $self->setValues(@_);
  604   $self->{tree}->perl;
  605 }
  606 
  607 ##################################################
  608 #
  609 #  Produce a perl function
  610 #
  611 #  (Parameters specify an optional name and an array reference of
  612 #   optional variables. If the name is not included, an anonymous
  613 #   code reference is returned.  If the variables are not included,
  614 #   then the variables from the formula are used in sorted order.)
  615 #
  616 sub perlFunction {
  617   my $self = shift; my $name = shift; my $vars = shift;
  618   $vars = [sort(keys %{$self->{variables}})] unless $vars;
  619   my $n = scalar(@{$vars}); my $vnames = '';
  620   if ($n > 0) {
  621     my @v = (); foreach my $x (@{$vars}) {push(@v,'$'.$x)}
  622     $vnames = "my (".join(',',@v).") = \@_;";
  623   }
  624   my $fn = eval
  625    "package main;
  626     sub $name {
  627       die \"Wrong number of arguments".($name?" to '$name'":'')."\" if scalar(\@_) != $n;
  628       $vnames
  629       return ".$self->perl.";
  630     }";
  631   $self->Error($@) if $@;
  632   return $fn;
  633 }
  634 
  635 
  636 ##################################################
  637 #
  638 #  Sets the values of variables for evaluation purposes
  639 #
  640 sub setValues {
  641   my $self = shift; my ($value,$type);
  642   my $variables = $self->{context}{variables};
  643   $self->{values} = {@_};
  644   foreach my $x (keys %{$self->{values}}) {
  645     $self->Error("Undeclared variable '$x'") unless defined $variables->{$x};
  646     $value = $self->{values}{$x};
  647     $value = Value::Formula->new($value) unless
  648       Value::matchNumber($value) || Value::isFormula($value) || Value::isValue($value);
  649     if (Value::isFormula($value)) {$type = $value->typeRef}
  650      else {($value,$type) = Value::getValueType($self,$value)}
  651     $self->Error("Variable '$x' should be of type $variables->{$x}{type}{name}")
  652        unless Parser::Item::typeMatch($type,$variables->{$x}{type});
  653     $self->{values}{$x} = $value;
  654   }
  655 }
  656 
  657 #########################################################################
  658 #########################################################################
  659 #
  660 #  Load the sub-classes and Value.pm
  661 #
  662 
  663 use Parser::Item;
  664 use Value;
  665 use Value::Formula;
  666 use Parser::Context;
  667 # use Parser::Differentiation;
  668 
  669 #########################################################################
  670 
  671 1;
  672 

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9