[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 2611 - (download) (as text) (annotate)
Sat Aug 14 15:59:35 2004 UTC (15 years, 5 months ago) by dpvc
File size: 23828 byte(s)
Fixed a typo in one of the parser answer checkers.  Added a line that
was incorrecctly removed in the parser.

    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
  636       Value::isFormula($value) || Value::isValue($value);
  637     if (Value::isFormula($value)) {$type = $value->typeRef}
  638       else {($value,$type) = Value::getValueType($self,$value)}
  639     $self->Error("Variable '$x' should be of type $variables->{$x}{type}{name}")
  640       unless Parser::Item::typeMatch($type,$variables->{$x}{type});
  641     $self->{values}{$x} = $value;
  642   }
  643 }
  644 
  645 
  646 ##################################################
  647 ##################################################
  648 #
  649 #  Convert a student answer to a formula, with error trapping.
  650 #  If the result is undef, there was an error (message is in Context()->{error} object)
  651 #
  652 
  653 sub Formula {
  654   my $f = shift;
  655   eval {Value::Formula->new($f)};
  656 }
  657 
  658 #
  659 #  Evaluate a formula, with error trapping.
  660 #  If the result is undef, there was an error (message is in Context()->{error} object)
  661 #  If the result was a real, make it a fuzzy one.
  662 #
  663 sub Evaluate {
  664   my $f = shift;
  665   return unless defined($f);
  666   my $v = eval {$f->eval(@_)};
  667   $v = Value::makeValue($v) if defined($v);
  668   return $v;
  669 }
  670 
  671 
  672 ##################################################
  673 ##################################################
  674 #
  675 #  Produce a vector in ijk form
  676 #
  677 sub ijk {
  678   my $self = shift;
  679   $self->{tree}->ijk;
  680 }
  681 
  682 #########################################################################
  683 #########################################################################
  684 #
  685 #  Load the sub-classes and Value.pm
  686 #
  687 
  688 use Parser::Item;
  689 use Value;
  690 use Value::Formula;
  691 use Parser::Context;
  692 use Parser::Context::Default;
  693 
  694 # use Parser::Differentiation;
  695 
  696 ###########################################################################
  697 
  698 use vars qw($installed);
  699 $Parser::installed = 1;
  700 
  701 ###########################################################################
  702 ###########################################################################
  703 #
  704 #   To Do:
  705 #
  706 # handle sqrt(-1) and log of negatives (make complexes)
  707 # do division by zero and log of zero checks in compound functions
  708 # add context flags for various reduction checks
  709 # make context flag for reduction of constants
  710 # make reduce have reduce patterns as parameters
  711 # more reduce patterns
  712 # make operator strings customizable (reduce, and other places they are used)
  713 # add parens alternately as () and []?
  714 #
  715 #########################################################################
  716 
  717 1;
  718 

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9