[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 2628 - (download) (as text) (annotate)
Mon Aug 16 21:41:05 2004 UTC (15 years, 6 months ago) by dpvc
File size: 23726 byte(s)
Allow parser "constants" to be (in reality) formulas.  That way, for
example, you can defined T, N and B to be the formulas for the unit
tangent, normal and binormal of a space curve (as functions of "t")
and the student can write anwers in terms of T, N and B (without
having to compute them).

You could have created FUNCTIONS T(t), N(t) and B(t), and added them
to the parser to get almost the same effect, but the students would
have had to include the "(t)".  (If you want that, go ahead and do it
that way.)

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

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9