mirror of
https://github.com/perlbot/perlbuut
synced 2025-06-08 14:05:40 -04:00
759 lines
20 KiB
Perl
759 lines
20 KiB
Perl
#!/usr/bin/perl
|
|
|
|
package Math::Farnsworth::Evaluate;
|
|
|
|
use strict;
|
|
use warnings;
|
|
|
|
use Data::Dumper;
|
|
use Carp;
|
|
|
|
use Math::Farnsworth::FunctionDispatch;
|
|
use Math::Farnsworth::Variables;
|
|
use Math::Farnsworth::Units;
|
|
use Math::Farnsworth::Parser;
|
|
use Math::Farnsworth::Value;
|
|
use Math::Farnsworth::Value::Pari;
|
|
use Math::Farnsworth::Value::Date;
|
|
use Math::Farnsworth::Value::String;
|
|
use Math::Farnsworth::Value::Undef;
|
|
use Math::Farnsworth::Value::Lambda;
|
|
use Math::Farnsworth::Value::Array;
|
|
use Math::Farnsworth::Value::Boolean;
|
|
use Math::Farnsworth::Output;
|
|
use Math::Farnsworth::Error;
|
|
|
|
use Math::Pari ':hex'; #why not?
|
|
|
|
sub new
|
|
{
|
|
my $class = shift;
|
|
my $self = {};
|
|
bless $self;
|
|
|
|
my %opts = (@_);
|
|
|
|
if (ref($opts{funcs}) eq "Math::Farnsworth::FunctionDispatch")
|
|
{
|
|
$self->{funcs} = $opts{funcs};
|
|
}
|
|
else
|
|
{
|
|
$self->{funcs} = new Math::Farnsworth::FunctionDispatch();
|
|
}
|
|
|
|
if (ref($opts{vars}) eq "Math::Farnsworth::Variables")
|
|
{
|
|
$self->{vars} = $opts{vars};
|
|
}
|
|
else
|
|
{
|
|
$self->{vars} = new Math::Farnsworth::Variables();
|
|
}
|
|
|
|
if (ref($opts{units}) eq "Math::Farnsworth::Units")
|
|
{
|
|
$self->{units} = $opts{units};
|
|
}
|
|
else
|
|
{
|
|
$self->{units} = new Math::Farnsworth::Units();
|
|
}
|
|
|
|
if (ref($opts{parser}) eq "Math::Farnsworth::Parser")
|
|
{
|
|
$self->{parser} = $opts{parser};
|
|
}
|
|
else
|
|
{
|
|
$self->{parser} = new Math::Farnsworth::Parser();
|
|
}
|
|
|
|
$self->{dumpbranches} = 0;
|
|
|
|
return $self;
|
|
}
|
|
|
|
sub eval
|
|
{
|
|
my $self = shift;
|
|
my $code = shift; #i should probably take an array, so i can use arrays of things, but that'll be later
|
|
|
|
$code =~ s/^\s*//;
|
|
$code =~ s/\s*$//;
|
|
|
|
my $tree = $self->{parser}->parse($code); #should i catch the exceptions here? dunno
|
|
|
|
#print Dumper($tree);
|
|
|
|
$self->evalbranch($tree);
|
|
}
|
|
|
|
#evaluate a single branch
|
|
sub evalbranch
|
|
{
|
|
my $self = shift;
|
|
|
|
my $branch = shift;
|
|
my $type = ref($branch); #this'll grab what kind from the bless on the tree
|
|
|
|
my $return; #to make things simpler later on
|
|
|
|
#print Data::Dumper->Dump([$branch],["BRANCH"]);
|
|
|
|
if ($type eq "Add")
|
|
{
|
|
my $a = $self->makevalue($branch->[0]);
|
|
my $b = $self->makevalue($branch->[1]);
|
|
$return = $a + $b;
|
|
}
|
|
elsif ($type eq "Sub")
|
|
{
|
|
my $a = $self->makevalue($branch->[0]);
|
|
my $b = $self->makevalue($branch->[1]);
|
|
$return = $a - $b;
|
|
}
|
|
elsif ($type eq "Mul")
|
|
{
|
|
if ((ref($branch->[0]) eq "Fetch") && (ref($branch->[1]) eq "Array") && ($branch->[2] eq "imp"))
|
|
{
|
|
#we've got a new style function call!
|
|
my $a = $branch->[0][0]; #grab the function name
|
|
my $b = $self->makevalue($branch->[1]);
|
|
|
|
#print "----------------FUNCCALL! $a\n";
|
|
#print Dumper($a, $b);
|
|
|
|
if ($self->{funcs}->isfunc($a)) #check if there is a func $a
|
|
{ #$return = $self->{funcs}->callfunc($self, $name, $args, $branch);
|
|
$return = $self->{funcs}->callfunc($self, $a, $b, $branch);
|
|
}
|
|
else #otherwise we try to
|
|
{
|
|
$a = $self->makevalue($branch->[0]); #evaluate it, since it wasn't a function
|
|
|
|
$return = $a * $b; #do the multiplication
|
|
}
|
|
}
|
|
else
|
|
{
|
|
my $a = $self->makevalue($branch->[0]);
|
|
my $b = $self->makevalue($branch->[1]);
|
|
|
|
#print "-----------SUBMULT!\n";
|
|
#print Dumper($a,$b);
|
|
|
|
$return = $a * $b;
|
|
}
|
|
}
|
|
elsif ($type eq "Div")
|
|
{
|
|
my $a = $self->makevalue($branch->[0]);
|
|
my $b = $self->makevalue($branch->[1]);
|
|
#print Dumper($a, $b);
|
|
$return = $a / $b;
|
|
}
|
|
elsif ($type eq "Conforms")
|
|
{
|
|
my $a = $self->makevalue($branch->[0]);
|
|
my $b = $self->makevalue($branch->[1]);
|
|
$return = new Math::Farnsworth::Value::Boolean($a->conforms($b));
|
|
}
|
|
elsif ($type eq "Mod")
|
|
{
|
|
my $a = $self->makevalue($branch->[0]);
|
|
my $b = $self->makevalue($branch->[1]);
|
|
$return = $a % $b;
|
|
}
|
|
elsif ($type eq "Pow")
|
|
{
|
|
my $a = $self->makevalue($branch->[0]);
|
|
my $b = $self->makevalue($branch->[1]);
|
|
$return = $a ** $b;
|
|
}
|
|
elsif ($type eq "And")
|
|
{
|
|
my $a = $self->makevalue($branch->[0]);
|
|
|
|
if ($a->bool())
|
|
{
|
|
my $b = $self->makevalue($branch->[1]);
|
|
$return = $a && $b ? 1 : 0;
|
|
$return = Math::Farnsworth::Value::Boolean->new($return); #make sure its the right type
|
|
}
|
|
else
|
|
{
|
|
$return = Math::Farnsworth::Value::Boolean->new(0); #make sure its the right type
|
|
}
|
|
}
|
|
elsif ($type eq "Or")
|
|
{
|
|
my $a = $self->makevalue($branch->[0]);
|
|
|
|
if ($a->bool())
|
|
{
|
|
$return = Math::Farnsworth::Value::Boolean->new(1); #make sure its the right type
|
|
}
|
|
else
|
|
{
|
|
my $b = $self->makevalue($branch->[1]);
|
|
$return = $a || $b ? 1 : 0;
|
|
$return = Math::Farnsworth::Value::Boolean->new($return); #make sure its the right type
|
|
}
|
|
}
|
|
elsif ($type eq "Xor")
|
|
{
|
|
my $a = $self->makevalue($branch->[0]);
|
|
my $b = $self->makevalue($branch->[1]);
|
|
$return = $a->bool() ^ $b->bool() ? 1 : 0;
|
|
$return = Math::Farnsworth::Value::Boolean->new($return); #make sure its the right type
|
|
}
|
|
elsif ($type eq "Not")
|
|
{
|
|
my $a = $self->makevalue($branch->[0]);
|
|
$return = $a->bool() ? 0 : 1;
|
|
$return = Math::Farnsworth::Value::Boolean->new($return); #make sure its the right type
|
|
}
|
|
elsif ($type eq "Gt")
|
|
{
|
|
my $a = $self->makevalue($branch->[0]);
|
|
my $b = $self->makevalue($branch->[1]);
|
|
$return = ($a > $b) ? 1 : 0;
|
|
$return = Math::Farnsworth::Value::Boolean->new($return); #make sure its the right type
|
|
}
|
|
elsif ($type eq "Lt")
|
|
{
|
|
my $a = $self->makevalue($branch->[0]);
|
|
my $b = $self->makevalue($branch->[1]);
|
|
$return = $a < $b ? 1 : 0;
|
|
$return = Math::Farnsworth::Value::Boolean->new($return); #make sure its the right type
|
|
}
|
|
elsif ($type eq "Ge")
|
|
{
|
|
my $a = $self->makevalue($branch->[0]);
|
|
my $b = $self->makevalue($branch->[1]);
|
|
$return = $a >= $b ? 1 : 0;
|
|
$return = Math::Farnsworth::Value::Boolean->new($return); #make sure its the right type
|
|
}
|
|
elsif ($type eq "Le")
|
|
{
|
|
my $a = $self->makevalue($branch->[0]);
|
|
my $b = $self->makevalue($branch->[1]);
|
|
$return = $a <= $b ? 1 : 0;
|
|
$return = Math::Farnsworth::Value::Boolean->new($return); #make sure its the right type
|
|
}
|
|
elsif ($type eq "Compare")
|
|
{
|
|
my $a = $self->makevalue($branch->[0]);
|
|
my $b = $self->makevalue($branch->[1]);
|
|
$return = $a <=> $b;
|
|
$return = Math::Farnsworth::Value::Pari->new($return); #make sure its the right type
|
|
}
|
|
elsif ($type eq "Eq")
|
|
{
|
|
my $a = $self->makevalue($branch->[0]);
|
|
my $b = $self->makevalue($branch->[1]);
|
|
$return = $a == $b ? 1 : 0;
|
|
$return = Math::Farnsworth::Value::Boolean->new($return); #make sure its the right type
|
|
}
|
|
elsif ($type eq "Ne")
|
|
{
|
|
my $a = $self->makevalue($branch->[0]);
|
|
my $b = $self->makevalue($branch->[1]);
|
|
$return = $a != $b ? 1 : 0;
|
|
$return = Math::Farnsworth::Value::Boolean->new($return); #make sure its the right type
|
|
}
|
|
elsif ($type eq "Ternary")
|
|
{
|
|
#turing completeness FTW
|
|
my $left = $self->makevalue($branch->[0]);
|
|
#$left = $left->bool() != new Math::Farnsworth::Value::Pari(0, $left->{dimen}); #shouldn't need it anymore, since i got ->bool working
|
|
$return = $left ? $self->makevalue($branch->[1]) : $self->makevalue($branch->[2]);
|
|
}
|
|
elsif ($type eq "If")
|
|
{
|
|
#turing completeness FTW
|
|
my $left = $self->makevalue($branch->[0]);
|
|
#$left = $left != new Math::Farnsworth::Value(0, $left->{dimen});
|
|
|
|
if ($left)
|
|
{
|
|
$return = $self->makevalue($branch->[1]);
|
|
}
|
|
else
|
|
{
|
|
$return = $self->makevalue($branch->[2]);
|
|
}
|
|
}
|
|
elsif ($type eq "Store")
|
|
{
|
|
my $lvalue = $self->makevalue($branch->[0]);
|
|
my $value = $self->makevalue($branch->[1]);
|
|
$return = $value; #make stores evaluate to the value on the right
|
|
#$self->{vars}->setvar($name, $value);
|
|
|
|
my $cloned = $value->clone();
|
|
warn "SETTING VALUES";
|
|
warn Data::Dumper->Dump([$lvalue, $lvalue->getref(), $value, $cloned], [qw($lvalue \$ref $value $cloned)]);
|
|
${$lvalue->getref()} = $cloned;
|
|
}
|
|
elsif ($type eq "DeclareVar")
|
|
{
|
|
my $name = $branch->[0];
|
|
my $value;
|
|
#print "\n\n DECLARING $name\n";
|
|
#print Dumper($branch);
|
|
|
|
if (defined($branch->[1]))
|
|
{
|
|
$value = $self->makevalue($branch->[1]);
|
|
}
|
|
else
|
|
{
|
|
$value = $self->makevalue(bless [0], 'Num');
|
|
}
|
|
|
|
$return = $value; #make stores evaluate to the value on the right
|
|
$self->{vars}->declare($name, $value);
|
|
}
|
|
elsif ($type eq "FuncDef")
|
|
{
|
|
#print Dumper($branch);
|
|
my $name = $branch->[0];
|
|
my $args = $branch->[1];
|
|
my $value = $branch->[2]; #not really a value, but in fact the tree to run for the function
|
|
|
|
my $nvars = new Math::Farnsworth::Variables($self->{vars}); #lamdbas get their own vars
|
|
my %nopts = (vars => $nvars, funcs => $self->{funcs}, units => $self->{units}, parser => $self->{parser});
|
|
my $scope = $self->new(%nopts);
|
|
|
|
my $vargs;
|
|
|
|
for my $arg (@$args)
|
|
{
|
|
my $reference = $arg->[3];
|
|
my $constraint = $arg->[2];
|
|
my $default = $arg->[1];
|
|
my $name = $arg->[0]; #name
|
|
|
|
if (defined($default))
|
|
{
|
|
$default = $self->makevalue($default); #should be right
|
|
}
|
|
|
|
if (defined($constraint))
|
|
{
|
|
#print Dumper($constraint);
|
|
$constraint = $self->makevalue($constraint); #should be right
|
|
#print Dumper($constraint);
|
|
}
|
|
|
|
push @$vargs, [$name, $default, $constraint, $reference];
|
|
}
|
|
|
|
$self->{funcs}->addfunc($name, $vargs, $value, $scope);
|
|
$return = undef; #cause an error should someone manage to make it parse other than the way i think it should be
|
|
}
|
|
elsif ($type eq "FuncCall")
|
|
{
|
|
print "DEPRECIATED FUNCTION CALL!\n";
|
|
my $name = $branch->[0];
|
|
my $args = $self->makevalue($branch->[1]); #this is an array, need to evaluate it
|
|
|
|
$return = $self->{funcs}->callfunc($self, $name, $args, $branch);
|
|
|
|
#print "FUNCCALL RETURNED\n";
|
|
#print Dumper($return);
|
|
|
|
}
|
|
elsif ($type eq "Lambda")
|
|
{
|
|
my $args = $branch->[0];
|
|
my $code = $branch->[1];
|
|
|
|
#print "==========LAMBDA==========\n";
|
|
#print Data::Dumper->Dump([$args,$code], ["args", "code"]);
|
|
|
|
my $nvars = new Math::Farnsworth::Variables($self->{vars}); #lamdbas get their own vars
|
|
my %nopts = (vars => $nvars, funcs => $self->{funcs}, units => $self->{units}, parser => $self->{parser});
|
|
my $scope = $self->new(%nopts);
|
|
|
|
#this should probably get a function in Math::Farnsworth::FunctionDispatch
|
|
my $vargs;
|
|
|
|
for my $arg (@$args)
|
|
{
|
|
my $reference = $arg->[3];
|
|
my $constraint = $arg->[2];
|
|
my $default = $arg->[1];
|
|
my $name = $arg->[0]; #name
|
|
|
|
if ($reference)
|
|
{
|
|
#we've got a reference for lambdas!
|
|
carp "Passing arguments by reference for lambdas is unsupported at this time";
|
|
}
|
|
|
|
if (defined($default))
|
|
{
|
|
$default = $self->makevalue($default); #should be right
|
|
}
|
|
|
|
if (defined($constraint))
|
|
{
|
|
#print Dumper($constraint);
|
|
$constraint = $self->makevalue($constraint); #should be right
|
|
#print Dumper($constraint);
|
|
}
|
|
|
|
push @$vargs, [$name, $default, $constraint, $reference];
|
|
}
|
|
|
|
$return = new Math::Farnsworth::Value::Lambda($scope, $args, $code, $branch);
|
|
}
|
|
elsif ($type eq "LambdaCall")
|
|
{
|
|
my $left = $self->makevalue($branch->[0]);
|
|
my $right = $self->makevalue($branch->[1]);
|
|
|
|
error "Right side of lamdbda call must evaluate to a Lambda\n" unless $right->istype("Lambda");
|
|
|
|
#need $args to be an array
|
|
my $args = $left->istype("Array") ? $left : new Math::Farnsworth::Value::Array([$left]);
|
|
|
|
$return = $self->{funcs}->calllambda($right, $args); #needs to be updated
|
|
}
|
|
elsif (($type eq "Array") || ($type eq "SubArray"))
|
|
{
|
|
my $array = []; #fixes bug with empty arrays
|
|
for my $bs (@$branch) #iterate over all the elements
|
|
{
|
|
my $type = ref($bs); #find out what kind of thing we are
|
|
my $value = $self->makevalue($bs);
|
|
|
|
#print "ARRAY FILL -- $type\n";
|
|
|
|
# if ($value->istype("Array"))
|
|
# {
|
|
#since we have an array, but its not in a SUBarray, we dereference it before the push
|
|
#push @$array, $value->getarray() unless ($type eq "SubArray");
|
|
#push @$array, $value;# if ($type eq "SubArray");
|
|
#}
|
|
#else
|
|
{
|
|
#print "ARRAY VALUE --- ".Dumper($value);
|
|
#its not an array or anything so we push it on
|
|
push @$array, $value; #we return an array ref! i need more error checking around for this later
|
|
}
|
|
}
|
|
$return = new Math::Farnsworth::Value::Array($array);
|
|
}
|
|
elsif ($type eq "ArgArray")
|
|
{
|
|
my $array = []; #autovivification wasn't working?
|
|
for my $bs (@$branch) #iterate over all the elements
|
|
{
|
|
my $type = ref($bs); #find out what kind of thing we are
|
|
my $value = $self->makevalue($bs);
|
|
|
|
#even if it is an array we don't want to deref it here, because thats the wrong behavior, this will make things like push[a, 1,2,3] work properly
|
|
push @$array, $value; #we return an array ref! i need more error checking around for this later
|
|
}
|
|
$return = new Math::Farnsworth::Value::Array($array);
|
|
}
|
|
elsif ($type eq "ArrayFetch")
|
|
{
|
|
#print "\n\nAFETCH\n";
|
|
my $var = $self->makevalue($branch->[0]); #need to check if this is an array, and die if not
|
|
my $listval = $self->makevalue($branch->[1]);
|
|
my @rval;
|
|
|
|
#print Data::Dumper->Dump([$branch, $var, $listval], ["branch","var","listval"]);
|
|
|
|
for ($listval->getarray())
|
|
{
|
|
my $index = $_->getpari()*1.0;
|
|
#print STDERR "ARFET: ".$_->toperl()."\n";
|
|
#ok this line FOR WHATEVER REASON, makes Math::Pari.xs die in isnull(), WHY i don't know, there's something wrong here somewhere
|
|
#my $float = $_ * (Math::Farnsworth::Value::Pari->new(1.0)); #makes rationals work right
|
|
|
|
my $input = $var->getarrayref()->[$index];
|
|
|
|
#error "Array out of bounds\n" #old message, check is down below now;
|
|
$var->getarrayref()->[$index] = TYPE_UNDEF unless defined $input;
|
|
$input = $var->getarrayref()->[$index] unless defined $input; #reset the value if needed, this code should be redone but i don't feel like it right now XXX
|
|
|
|
$input->setref(\$var->getarrayref()->[$index]);
|
|
push @rval, $input;
|
|
}
|
|
|
|
#print Dumper(\@rval);
|
|
|
|
if (@rval > 1)
|
|
{
|
|
my $pr = new Math::Farnsworth::Value::Array([@rval]);
|
|
$return = $pr;
|
|
$return->setref(\$return); #i think this should work fine
|
|
}
|
|
else
|
|
{
|
|
$return = $rval[0];
|
|
}
|
|
}
|
|
elsif ($type eq "ArrayStore")
|
|
{
|
|
my $var = $self->makevalue(bless [$branch->[0]], 'Fetch'); #need to check if this is an array, and die if not
|
|
my $listval = $self->makevalue($branch->[1]);
|
|
my $rval = $self->makevalue($branch->[2]);
|
|
|
|
#print Dumper($branch, $var, $listval);
|
|
|
|
if ($listval->getarray() > 1)
|
|
{
|
|
error "Assigning to slices not implemented yet\n";
|
|
}
|
|
|
|
error "Only numerics may be given as array indexes!" unless ($listval->getarrayref()->[0]->istype("Pari"));
|
|
|
|
my $num = $listval->getarrayref()->[0]->getpari() + 0; #the +0 makes sure its coerced into a number
|
|
|
|
$var->getarrayref()->[$num] = $rval;
|
|
|
|
for my $value ($var->getarray())
|
|
{
|
|
$value = $self->makevalue(bless [0], 'Num') if !defined($value);
|
|
}
|
|
|
|
$return = $rval;
|
|
}
|
|
elsif ($type eq "While")
|
|
{
|
|
my $cond = $branch->[0]; #what to check each time
|
|
my $stmts = $branch->[1]; #what to run each time
|
|
|
|
my $condval = $self->makevalue($cond);
|
|
while ($condval)
|
|
{
|
|
my $v = $self->makevalue($stmts);
|
|
$condval = $self->makevalue($cond);
|
|
}
|
|
|
|
$return = undef; #cause errors
|
|
}
|
|
elsif ($type eq "Stmt")
|
|
{
|
|
for my $bs (@$branch) #iterate over all the statements
|
|
{
|
|
if (defined($bs))
|
|
{
|
|
my $r = $self->makevalue($bs);
|
|
$return = $r if defined $r; #this has interesting semantics!
|
|
}
|
|
}
|
|
}
|
|
elsif ($type eq "Paren")
|
|
{
|
|
$return = $self->makevalue($branch->[0]);
|
|
}
|
|
elsif ($type eq "SetDisplay")
|
|
{
|
|
print Dumper($branch);
|
|
my $combo = $branch->[0][0]; #is a string?
|
|
my $right = $branch->[1];
|
|
|
|
Math::Farnsworth::Output->setdisplay($combo, $right);
|
|
}
|
|
elsif ($type eq "UnitDef")
|
|
{
|
|
my $unitsize = $self->makevalue($branch->[1]);
|
|
my $name = $branch->[0];
|
|
$self->{units}->addunit($name, $unitsize);
|
|
}
|
|
elsif ($type eq "DefineDimen")
|
|
{
|
|
my $unit = $branch->[1];
|
|
my $dimen = $branch->[0];
|
|
$self->{units}->adddimen($dimen, $unit);
|
|
}
|
|
elsif ($type eq "DefineCombo")
|
|
{
|
|
my $combo = $branch->[1]; #should get me a string!
|
|
my $value = $self->makevalue($branch->[0]);
|
|
Math::Farnsworth::Output::addcombo($combo, $value);
|
|
}
|
|
elsif (($type eq "SetPrefix") || ($type eq "SetPrefixAbrv"))
|
|
{
|
|
my $name = $branch->[0];
|
|
my $value = $self->makevalue($branch->[1]);
|
|
#carp "SETTING PREFIX0: $name : $value : ".Dumper($branch->[1]) if ($name eq "m");
|
|
$self->{units}->setprefix($name, $value);
|
|
}
|
|
elsif ($type eq "Trans")
|
|
{
|
|
my $left = $self->makevalue($branch->[0]);
|
|
my $rights = eval {$self->makevalue($branch->[1])};
|
|
#print Dumper($@);
|
|
my $right = $rights;
|
|
|
|
if (!$@ && defined($rights) && $rights->istype("String")) #if its a string we do some fun stuff
|
|
{
|
|
print "STRINGED\n";
|
|
$right = $self->eval($rights->getstring()); #we need to set $right to the evaluation $rights
|
|
#print Dumper($rights, $right);
|
|
print "ERRORED: ".Dumper($@);
|
|
}
|
|
|
|
if (!$@)
|
|
{
|
|
if ($left->conforms($right)) #only do this if they are the same
|
|
{
|
|
my $dispval = ($left / $right);
|
|
|
|
#$return = $left;
|
|
%$return = %$left; #ok this makes NO SENSE as to WHY it would behave like it was...
|
|
bless $return, ref($left);
|
|
|
|
if ($rights->istype("String"))
|
|
{
|
|
#right side was a string, use it
|
|
$return->{outmagic} = [$dispval, $rights];
|
|
}
|
|
else
|
|
{
|
|
$return->{outmagic} = [$dispval];
|
|
}
|
|
}
|
|
elsif ($self->{funcs}->isfunc($branch->[1][0]))
|
|
{
|
|
$left = $left->istype("Array") ? $left : new Math::Farnsworth::Value::Array([$left]);
|
|
$return = $self->{funcs}->callfunc($self, $branch->[1][0], $left);
|
|
|
|
if ($rights->istype("String"))
|
|
{
|
|
#right side was a string, use it
|
|
my $nm = {%$return}; #do a shallow copy!
|
|
bless $nm, ref($return); #rebless it
|
|
$return->{outmagic} = [$nm, $rights];
|
|
}
|
|
}
|
|
else
|
|
{
|
|
error "Conformance error, left side has different units than right side ".Dumper($branch->[1])."\n";
|
|
}
|
|
}
|
|
else
|
|
{
|
|
#$right doesn't evaluate... so we check for a function?
|
|
$left = $left->istype("Array") ? $left : new Math::Farnsworth::Value::Array([$left]);
|
|
$return = $self->{funcs}->callfunc($self, $branch->[1][0], $left);
|
|
|
|
if (defined($rights) && $rights->istype("String"))
|
|
{
|
|
#right side was a string, use it
|
|
my $nm = {%$return}; #do a shallow copy!
|
|
bless $nm, ref($return); #rebless it
|
|
$return->{outmagic} = [$nm, $rights];
|
|
}
|
|
}
|
|
}
|
|
|
|
if (!defined($return))
|
|
{
|
|
#this creates a "true" undefined value for returning, this makes things funner! it also introduced a bug from naive coding above, which has been fixed
|
|
$return = new Math::Farnsworth::Value::Undef();
|
|
}
|
|
|
|
return $return;
|
|
}
|
|
|
|
sub makevalue
|
|
{
|
|
my $self = shift;
|
|
my $input = shift;
|
|
|
|
# print "MAKEVALUE---------\n";
|
|
# print Dumper($input);
|
|
|
|
if (ref($input) eq "Num")
|
|
{
|
|
#need to make a value here with Math::Farnsworth::Value!
|
|
my $val = new Math::Farnsworth::Value::Pari($input->[0]);
|
|
return $val;
|
|
}
|
|
if (ref($input) eq "HexNum")
|
|
{
|
|
#need to make a value here with Math::Farnsworth::Value!
|
|
#print "HEX VALUE: ".$input->[0]."\n";
|
|
my $value = eval $input->[0]; #this SHOULD work, shouldn't be a security risk since its validated through the lexer and parser.
|
|
my $val = new Math::Farnsworth::Value::Pari($value);
|
|
return $val;
|
|
}
|
|
elsif (ref($input) eq "Fetch")
|
|
{
|
|
#this needs to decide between variable and unit, but that'll come later
|
|
#esp since i also have to have this overridable for functions!
|
|
|
|
my $name = $input->[0];
|
|
if ($self->{vars}->isvar($name))
|
|
{
|
|
return $self->{vars}->getvar($input->[0]);
|
|
}
|
|
elsif ($self->{units}->isunit($name))
|
|
{
|
|
#print "FETCH: $name\n" if ($name eq "milli");
|
|
return $self->{units}->getunit($name);
|
|
}
|
|
|
|
die "Undefined symbol '$name'\n";
|
|
}
|
|
elsif (ref($input) eq "String") #we've got a string that should be a value!
|
|
{
|
|
my $value = $input->[0];
|
|
#here it comes in with quotes, so lets remove them
|
|
#$value =~ s/^"(.*)"$/$1/; #no longer needed
|
|
#$value =~ s/\\"/"/g; #i'm gonna move these into the constructor i think
|
|
#$value =~ s/\\\\/\\/g;
|
|
$value =~ s/\\(.)/qq("\\$1")/eeg;
|
|
my $ss = sub
|
|
{
|
|
my $var =shift;
|
|
$var =~ s/^[\$]//;
|
|
my $output = undef;
|
|
if ($var !~ /^{.*}$/)
|
|
{
|
|
$output = new Math::Farnsworth::Output($self->{units}, $self->{vars}->getvar($var), $self);
|
|
}
|
|
else
|
|
{
|
|
$var =~ s/[{}]//g;
|
|
$output = new Math::Farnsworth::Output($self->{units}, $self->eval($var), $self);
|
|
}
|
|
|
|
"".$output;
|
|
};
|
|
$value =~ s/(?<!\\)(\$\w+|\${[^}]+})/$ss->($1)/eg;
|
|
my $val = new Math::Farnsworth::Value::String($value);
|
|
return $val;
|
|
}
|
|
elsif (ref($input) eq "Date")
|
|
{
|
|
#print "\n\n\nMaking DATE!\n\n\n";
|
|
my $val = new Math::Farnsworth::Value::Date($input->[0]);
|
|
# print Dumper($val);
|
|
return $val;
|
|
}
|
|
elsif (ref($input) eq "VarArg")
|
|
{
|
|
#warn "Got a VarArg, code untested, want to mark when i get them\n"; #just so i can track down the inevitable crash
|
|
return "VarArg";
|
|
}
|
|
elsif (ref($input) =~ /Math::Farnsworth::Value/)
|
|
{
|
|
warn "Got a Math::Farnsworth::Value::*, i PROBABLY shouldn't be getting these, i'm just going to let it fall through";
|
|
return $input;
|
|
}
|
|
|
|
return $self->evalbranch($input);
|
|
}
|
|
|
|
1;
|