[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 2664 - (download) (as text) (annotate)
Sat Aug 21 22:02:14 2004 UTC (15 years, 5 months ago) by dpvc
File size: 24219 byte(s)
Added a file to perform WeBWorK-specific modifications to the
Parser/Value packages.  (I've tried to make these independent of
WeBWorK, so you can use them in other perl code if you want to.)

The parameters for fuzzy reals and some of the other parameters now
are taken from the pg->{ansEvalDefaults} values (as defined in
global.conf or course.conf).  More still needs to be done with this,
however.

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