view release on metacpan or  search on metacpan

Expression.pm  view on Meta::CPAN

				return;
			}
			$right = 0;	# Monadics are all numeric
		}

		unless($right =~ /^([-+]?)0*([\d.]+)([ef][-+]?\d*|)$/i) {
			$self->PrintError("Operand to monadic '%s' is not numeric '%s'", $oper, $right);
			return;
		}
		$right = "$1$2$3";

		return -$right if($oper eq '-');
		return  $right if($oper eq '+');
		return !$right if($oper eq '!');
		return ~$right if($oper eq '~');

		$self->PrintError("Unknown monadic operator when evaluating: '%s'", $oper);
		return;
	}

	# This is complicated by multiple assignment: (a, b, c) := (1, 2, 3, 4). 'c' is given '(3, 4)'.
	# Assign the right value to the left node
	# Where the values list is shorter, leave vars alone: (a, b, c) := (1, 2) does not change c.
	if($oper eq ':=') {
		my @left = $self->EvalTree($tree->{left}, 1);
		my @right = $self->EvalTree($tree->{right}, $wantlv);

		# Easy case, assigning to one variable, assign the whole array:
		return $self->{VarSetFun}($self, @left, @right) if($#right <= 0);

		# Assign conseq values to conseq variables. The last var gets the rest of the values.
		# Ignore too many vars.
		for(my $i = 0; $i <= $#left; $i++) {
			last if($i > $#right);

			if($i == $#left and $i != $#right) {
				$self->{VarSetFun}($self, $left[$i], @right[$i ... $#right]);
				last;
			}
			$self->{VarSetFun}($self, $left[$i], $right[$i]);
		}

		return @right;
	}

	# Flow control: if/while
	if($oper eq 'flow') {
		if($tree->{flow} eq 'if') {
			# left is condition, right is body when true
			my @left = $self->EvalTree($tree->{left}, 0);
			return ($left[-1]) ? ($self->EvalTree($tree->{right}, 0))[-1] : 0;
		}
		if($tree->{flow} eq 'while') {
			my $ret = 0; # Return val, until get something better
			if( !$self->{PermitLoops}) {
				$self->PrintError("Loops not enabled, set property PermitLoops to do so");
				return;
			}
			while(1) {
				if($self->{MaxLoopCount} && ++$self->{LoopCount} > $self->{MaxLoopCount}) {
					$self->PrintError("Loop exceeded maximum iterations: MaxLoopCount = $self->{MaxLoopCount}");
					return;
				}
				# left is loop condition, right is body:
				my @left = $self->EvalTree($tree->{left}, 0);
				return $ret unless($left[-1]);
				$ret = ($self->EvalTree($tree->{right}, 0))[-1];
			}
			return $ret;
		}
	}

	# Evaluate left - may be able to avoid evaluating right.
	# Take care to avoid evaluating a tree twice, not just inefficient but nasty side effects with ++ & -- operators
	my @left = $self->EvalTree($tree->{left}, $wantlv);
	my $left = $left[$#left];
	if(!defined($left) and $oper ne ',' and $oper ne '.' and $oper ne ';') {
		unless($self->{AutoInit}) {
			$self->PrintError("Left value to operator '%s' is not defined", $oper);
			return;
		}
		$left = '';	# Set to the empty string
	}

	# Lazy evaluation:
	return $left ?  $self->EvalTree($tree->{right}{left}, $wantlv) :
			$self->EvalTree($tree->{right}{right}, $wantlv)		if($oper eq '?');

	# Constructing a list of variable names (for assignment):
	return (@left, $self->EvalTree($tree->{right}, 1))			if($oper eq ',' and $wantlv);

	# More lazy evaluation:
	if($oper eq '&&' or $oper eq '||') {
		return 0 if($oper eq '&&' and !$left);
		return 1 if($oper eq '||' and  $left);

		my @right = $self->EvalTree($tree->{right}, 0);

		return($right[$#right] ? 1 : 0);
	}

	# Everything else is a binary operator, get right side - value(s):
	my @right = $self->EvalTree($tree->{right}, 0);
	my $right = $right[-1];

	return (@left, @right)	if($oper eq ',');
	return @right		if($oper eq ';');

	# Array index. Beware: works differently depending on $wantlv.
	# Because when $wantlv it is the array name, not its contents
	if($oper eq '[') {
		return undef	# Check if the array member could exist; ie have index
			if($right !~ /^-?\d+$/);

		@left = $self->{VarGetFun}($self, $left[0]) if($wantlv);

		my $index = $right[-1];
		$index += @left if($index < 0);	# Convert -ve index to a +ve one

		return "$left\[$index]" # Return var[index] for assignment
			if($wantlv);