view release on metacpan or  search on metacpan

lib/Driver/Compiler/Check.pm  view on Meta::CPAN

			or push(@errors, "Cannot index on array with " .
							$idx->type->name);
		return @errors if @errors;
		$self->settype($val->type->dereference);
		bless $self, __PACKAGE__;
		return ();
	}
}

{
	package Anarres::Mud::Driver::Compiler::Node::MapIndex;
	__PACKAGE__->steal("Index", "lvaluep");

	sub convert {
		my ($self, $program, @rest) = @_;
		my ($val, $idx, $endp) = $self->values;
		my @errors = ();

		$val->check($program, @rest)
			or push(@errors, "Failed to check value " . $val->opcode);
		$idx->check($program, @rest)
			or push(@errors, "Failed to check index " . $idx->opcode);
		$val->type->is_mapping
			or push(@errors, "Cannot perform mapping dereference on " .
							$val->type->name);
		# XXX Make this use promotion properly.
		$idx->type->equals(T_STRING)
			||
		$idx->type->equals(T_INTEGER)
			or push(@errors, "Cannot index on mapping with " .
							$idx->type->name);
		return @errors if @errors;
		$endp
			and $program->error("Cannot index from end of mapping");
		$self->settype($val->type->dereference);
		bless $self, __PACKAGE__;
		return ();
	}
}

{
	package Anarres::Mud::Driver::Compiler::Node::Member;
	sub lvaluep {
		if ($_[0]->value(0)->lvaluep) {
			$_[0]->setflag(F_LVALUE);
			return 1;
		}
		return undef;
	}

	sub check {
		my ($self, $program, @rest) = @_;
		$self->tc_start;
		my ($value, $field) = $self->values;
		$value->check($program, @rest)
						or return $self->tc_fail;
		my $type = $value->type;
		if (!($type->is_class)) {
			$program->error("Cannot get member $field of type " .
							$type->name);
			# print STDERR "Failed fragment is " . $value->dump, "\n";
			return $self->tc_fail;
		}
		elsif (0) {	# XXX Does the field exist?
			$program->error("No field called $field in class " .
							$type->class);
			return $self->tc_fail;
		}
		my $ftype = $program->class_field_type($type->class, $field);
		$self->settype($ftype);	# Might be T_FAILED
		return $self->tc_end;
	}
}

{
	package Anarres::Mud::Driver::Compiler::Node::New;
	sub check {
		my ($self, $program, $flags, @rest) = @_;
		my $cname = $self->value(0);
		$self->tc_start("class $cname");
		my $type = $program->class_type($cname);
		$self->settype($type);	# Might be T_FAILED
		return $self->tc_end;
	}
}

# 1. Promote things to blocks.
# 2. Check children
# 3. Check that things are lvalues.
# 4. Check that things are appropriate types.
# 5. Rebless the current node.
# 6. Set the type of the current node.
# 7. Return a success or failure.

{
	package Anarres::Mud::Driver::Compiler::Node::Sscanf;
	# This should be $_[1], @{$_[2]}
	sub check {
		my ($self, $program, $flags, @rest) = @_;
		my @values = $self->values;
		$self->tc_start;
		$self->check_children(\@values, $program, @rest)
						or return $self->tc_fail(T_INTEGER);

		my $exp = shift @values;
		my $fmt = shift @values;

		my $sexp = $exp->promote(T_STRING);
		unless ($sexp) {
			$program->error("Input for sscanf must be string, not " .
							${ $exp->type });
			return $self->tc_fail(T_INTEGER);
		}
		$self->setvalue(0, $sexp);

		my $sfmt = $fmt->promote(T_STRING);
		unless ($sfmt) {
			$program->error("Format for sscanf must be string, not " .
							$fmt->type->dump);
			return $self->tc_fail(T_INTEGER);
		}