File Coverage

blib/lib/Anarres/Mud/Driver/Program/Efun.pm

Criterion	Covered	Total	%
statement	46	54	85.1
branch	2	4	50.0
condition			n/a
subroutine	12	15	80.0
pod	0	6	0.0
total	60	79	75.9

package Anarres::Mud::Driver::Program::Efun;

use strict;
use vars qw(@ISA @EXPORT_OK %EFUNS %EFUNFLAGS);
use Data::Dumper;
use Carp;
use Exporter;
use Anarres::Mud::Driver::Program::Variable;
use Anarres::Mud::Driver::Program::Method;
use Anarres::Mud::Driver::Compiler::Type qw(:all);

@ISA = qw(Anarres::Mud::Driver::Program::Method);
@EXPORT_OK = qw(register efuns efunflags);

%EFUNS = ();
%EFUNFLAGS = ();

sub instantiate {
}

sub register {
	my ($class, $flags, $rettype, @argtypes) = @_;

	# print "Registering efun $class(".join(", ",map{$$_}@argtypes).")\n";

	my $efun = $class;
	$efun =~ s/^.*:://;

	croak "Duplicate efun $efun" if $EFUNS{$efun};

	my @args = ();
	my $i = 0;
	foreach (@argtypes) {
		my $arg = new Anarres::Mud::Driver::Program::Variable(
						Type	=> $_,
						Name	=> "arg" . $i,
							);
		push(@args, $arg);
		$i++;
	}

	{
		no strict qw(refs);
		*{"$class\::ISA"} = [ qw(Anarres::Mud::Driver::Program::Efun) ]
						unless @{"$class\::ISA"};
	}

	my $instance = $class->new(
					Name	=> $efun,
					Type	=> $rettype,
					Args	=> \@args,
						);

	$EFUNS{$efun} = $instance;
	$EFUNFLAGS{$efun} = $flags | M_EFUN | M_INHERITED;
}

# Class methods

sub efuns { return { %EFUNS }; }
sub efunflags { return { %EFUNFLAGS }; }

# Instance methods

sub generate_call {
	my ($self, @args) = @_;
	unshift(@args, '$self');
	return ref($self) . '::invoke(' . join(', ', @args) . ')';
}

sub dump {
	my $self = shift;
	my $name = ref($self);
	$name =~ s/^.*:://;
	return "(efun $name)";
}

1;