view release on metacpan or  search on metacpan

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

package Anarres::Mud::Driver::Compiler::Check;

use strict;
use vars qw(@ISA @EXPORT_OK @STACK $DEBUG
		%OPTYPETABLE %OPTYPES %OPCHOICES);
use Carp qw(:DEFAULT cluck);
use Data::Dumper;
use List::Util qw(first);
use Anarres::Mud::Driver::Compiler::Type qw(:all);
use Anarres::Mud::Driver::Compiler::Node qw(:all);

# This has turned into a rather long, complex and involved Perl file.

# Error messages starting with [D] are duplicating work done elsewhere
# and are candidates for removal.

push(@Anarres::Mud::Driver::Compiler::Node::ISA, __PACKAGE__);

sub DBG_TC_NAME		() { 1 }
sub DBG_TC_PROMOTE	() { 2 }
sub DBG_TC_CONVERT	() { 4 }

$DEBUG = 0;;
$DEBUG |= DBG_TC_NAME		if 0;
$DEBUG |= DBG_TC_PROMOTE	if 0;
$DEBUG |= DBG_TC_CONVERT	if 0;

@STACK = ();

sub debug_tc {
	my ($self, $class, @args) = @_;
	return undef unless $DEBUG & $class;
	my $msg = join(": ", @args);
	print STDERR "DebugTC: $msg\n";
}

# Called at the beginning of any typecheck call
sub tc_start {
	my ($self, @args) = @_;
	push(@STACK, $self);
	$self->debug_tc(DBG_TC_NAME, "Checking " . $self->opcode, @args);
}

# Called at the end of any typecheck call, possibly by tc_fail().
sub tc_end {
	my ($self, $type, @args) = @_;
	$self->settype($type) if $type;
	$self->debug_tc(DBG_TC_NAME, "Finished " . $self->opcode, @args);
	pop(@STACK);
	return 1;	# Make it return a success.
}

	# This is a utility method. Calling it is mandatory
	# in the case of failure.
sub tc_fail {
	my ($self, $type, @args) = @_;
	$type = T_FAILED unless $type;
	$self->tc_end($type, @args);
	return undef;	# Make it return a failure.
}




sub LV ($) { return [ $_[0], F_LVALUE ] }

# Opcodes which are choice targets and provide a custom convert