view release on metacpan or  search on metacpan

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

						or return $self->tc_fail(T_MAPPING);

		my $ret = 1;

		my $flag = F_CONST;
		my $type = T_NIL;
		my $idx = 0;
		foreach (@values) {
			# Search the types to find a good type.
			if ($idx & 1) {
				$type = $_->type->unify($type);
			}
			else {
				my $key = $_->promote(T_STRING);
				if ($key) {
					$self->setvalue($idx, $key);
				}
				else {
					$program->error("Map keys must be strings, not " .
									$_->dump);
					$ret = undef;
				}
			}

			$flag &= $_->flags;
			$idx++;
		}

		$self->settype($type->mapping);
		$self->setflag($flag) if $flag;

		return $ret ? $self->tc_end : $self->tc_fail;
	}
}

{
	package Anarres::Mud::Driver::Compiler::Node::Closure;
	# XXX Write this.
	sub check {
		my ($self, $program, @rest) = @_;
		$self->tc_start;
		$self->setvalue(1, $program->closure($self));
		$self->settype(T_CLOSURE);
		return $self->tc_end;
	}
}

{
	package Anarres::Mud::Driver::Compiler::Node::Variable;
	sub lvaluep { 1; }
	# Look up type
	sub check {
		my ($self, $program, @rest) = @_;
		my $name = $self->value(0);
		$self->tc_start($name);
		my ($var, $class);
		confess "XXX No program" unless $program;
		if ($var = $program->local($name)) {
			$class = 'Anarres::Mud::Driver::Compiler::Node::VarLocal';
		}
		elsif ($var = $program->global($name)) {
			$class = 'Anarres::Mud::Driver::Compiler::Node::VarGlobal';
		}
		# elsif ($var = $program->static($name)) {
		#	$class ='Anarres::Mud::Driver::Compiler::Node::VarStatic';
		# }
		else {
			$program->error("Variable $name not found");
			# XXX Should we fake something up? We end up
			# dying later if we leave a Variable in the tree.
			return $self->tc_fail;
		}
		bless $self, $class;
		$self->settype($var->type);
		return $self->tc_end;
	}
	# XXX As an rvalue? Delegate to a basic type infer method.
	# XXX If it's an rvalue then it must be initialised. Also for ++, --
}

{
	package Anarres::Mud::Driver::Compiler::Node::VarStatic;
	sub lvaluep { 1; }
}

{
	package Anarres::Mud::Driver::Compiler::Node::VarGlobal;
	sub lvaluep { 1; }
}

{
	package Anarres::Mud::Driver::Compiler::Node::VarLocal;
	sub lvaluep { 1; }
}

{
	package Anarres::Mud::Driver::Compiler::Node::Parameter;
	sub lvaluep { 1; }
	# XXX We could look this up at the current point ...
	sub check { $_[0]->settype(T_UNKNOWN); return 1; }	# XXX Do this!
}

{
	package Anarres::Mud::Driver::Compiler::Node::Funcall;
	# Look up return type, number of args
	sub check {
		my ($self, $program, @rest) = @_;

		# Changing the format of this node will require modifications
		# to StmtIf optimisation.
		my @values = $self->values;
		my $method = shift @values;

		$self->tc_start('"' . $method->proto . '"');

		my @failed = ();
		my $ctr = 0;
		foreach (@values) {
			$_->check($program, @rest) or push(@failed, $ctr);
			$ctr++;
		}