[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 2657 - (download) (as text) (annotate)
Fri Aug 20 11:13:51 2004 UTC (15 years, 5 months ago) by dpvc
File size: 24150 byte(s)
Handle trapped error messages that are not produced by the parser
error reporter (i.e., by bugs within the parser itself).  Also added
an error if implied multiplication is attempted when the operator for
it is not defined in the current context.

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

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9