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;