view release on metacpan or  search on metacpan

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

package Anarres::Mud::Driver::Compiler::Dump;

use strict;
use Carp qw(:DEFAULT cluck);
use Exporter;
use Data::Dumper;
use Anarres::Mud::Driver::Compiler::Type qw(:all);
use Anarres::Mud::Driver::Compiler::Node qw(@NODETYPES);

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

sub dumptype {
	my $self = shift;
	return "" unless $self->type;
	my $flags =
			$self->flags & F_CONST  ? "z" : "" .
			$self->flags & F_LVALUE ? "=" : "" ;
	return "[" . $flags . $self->type->dump(@_) . "] ";
}

sub dump {
	my $self = shift;
	$self->dumpblock( [ $self->values ], @_ );
}

sub dumpblock {
	my ($self, $vals, $indent, @rest) = @_;
	$indent++;

	my $op = $self->opcode;

	my @fields = map {
			  ! $_				? "<undef>"
			: ! ref($_)			? "q[$_]"
			: ref($_) !~ /::/	? "[" . ref($_) . "]"
			: $_->dump($indent, @rest)
					} @$vals;
	my $sep = "\n" . ("\t" x $indent);
	return join($sep,
			"(" . $self->dumptype($indent, @rest) . lc $op,
			@fields
				) . ")";
	# return join($sep, "([V] block", @locals, @stmts) . ")";
}

{
	package Anarres::Mud::Driver::Compiler::Node::String;
	use String::Escape qw(quote printable);
	sub dump { return quote(printable($_[0]->value(0))) }
}

{
	package Anarres::Mud::Driver::Compiler::Node::Integer;
	sub dump { return $_[0]->value(0) }
}

{
	package Anarres::Mud::Driver::Compiler::Node::Variable;
	sub dump {
		my $self = shift;
		# my $var = $self->value(0);
		# XXX Typechecking should replace with an object?
		# return ref($var) ? $var->dump : $var;
		return "(" . $self->dumptype . "variable "
						. $self->value(0) . ")";
	}