view release on metacpan or  search on metacpan

Efun/Core/Core.pm  view on Meta::CPAN

		# XXX varargs
		sprintf			=> [ M_PURE, T_STRING, T_STRING, T_ARRAY, ],
		sscanf			=> [ M_PURE, T_STRING, T_STRING, T_ARRAY, ],

		# Array stuff

		member_array	=> [ M_PURE, T_INTEGER, T_UNKNOWN, T_ARRAY, ],
		unique_array	=> [ M_PURE, T_ARRAY->array, T_ARRAY, T_CLOSURE],
			# XXX We can map mappings. :-(
		map				=> [ 0,		T_ARRAY, T_ARRAY, T_CLOSURE, ],
		filter			=> [ 0,		T_ARRAY, T_ARRAY, T_CLOSURE, ],
		allocate		=> [ 0,		T_ARRAY, T_INTEGER, T_UNKNOWN, ],

		# Mapping stuff

		keys			=> [ M_PURE,	T_STRING->array, T_MAPPING, ],
		values			=> [ M_PURE,	T_ARRAY, T_MAPPING, ],
		map_delete		=> [ 0,			T_UNKNOWN, T_MAPPING,T_STRING,],

		# Type stuff

		to_int			=> [ M_PURE,	T_INTEGER, T_STRING, ],
		to_string		=> [ M_PURE,	T_STRING, T_INTEGER, ],
		typeof			=> [ M_PURE,	T_STRING, T_UNKNOWN, ],
		sizeof			=> [ M_PURE,	T_INTEGER, T_UNKNOWN, ],

		intp			=> [ $pflags,	T_BOOL, T_UNKNOWN, ],
		stringp			=> [ $pflags,	T_BOOL, T_UNKNOWN, ],
		arrayp			=> [ $pflags,	T_BOOL, T_UNKNOWN, ],
		mapp			=> [ $pflags,	T_BOOL, T_UNKNOWN, ],
		functionp		=> [ $pflags,	T_BOOL, T_UNKNOWN, ],
		classp			=> [ $pflags,	T_BOOL, T_UNKNOWN, ],
		objectp			=> [ $pflags,	T_BOOL, T_UNKNOWN, ],
		clonep			=> [ M_PURE,	T_BOOL, T_UNKNOWN, ],
		undefinedp		=> [ M_PURE,	T_BOOL, T_UNKNOWN, ],

		# Closure stuff

		# XXX varargs
		evaluate		=> [ 0,		T_UNKNOWN, T_CLOSURE, T_ARRAY, ],

		# Reflection

		function_exists	=> [ 0,		T_OBJECT, T_STRING, T_INTEGER, ],
		functions		=> [ 0,		T_OBJECT, T_INTEGER, ],
		variables		=> [ 0,		T_OBJECT, T_INTEGER, ],
		inherits		=> [ M_PURE,	T_INTEGER, T_STRING, T_OBJECT, ],
		call_stack		=> [ 0,		T_STRING->array, T_INTEGER, ],

		# File stuff

		file_size		=> [ 0,		T_INTEGER, T_STRING, ],
		read_file		=> [ 0,		T_STRING, T_STRING, ],
		write_file		=> [ 0,		T_INTEGER, T_STRING, T_STRING, ],

		# System stuff

		time			=> [ 0,		T_INTEGER, ],

		debug_message	=> [ 0,		T_STRING, T_STRING, ],
		error			=> [ 0,		T_INTEGER, T_STRING, ],
		catch			=> [ 0,		T_STRING, T_UNKNOWN, ],
		shutdown		=> [ 0,		T_INTEGER, ],

		trace			=> [ 0,		T_INTEGER, T_INTEGER, ],
			);

	# We call this as an exported function since ISA isn't yet set up.
	foreach (keys %efuns) {
		register(__PACKAGE__ . "::" . $_, @{ $efuns{$_} });
	}
}

{
	package Anarres::Mud::Driver::Efun::Core::time;
	sub generate_call { "time()" }
}

{
	package Anarres::Mud::Driver::Efun::Core::debug_message;
	sub generate_call { "print STDERR $_[1], '\\n'" }
}

{
	package Anarres::Mud::Driver::Efun::Core::previous_object;
	sub invoke { undef }
}

{
	package Anarres::Mud::Driver::Efun::Core::file_name;
	sub generate_call {
		"Anarres::Mud::Driver::Program::package_to_path(ref($_[1]))"
	}
}

{
	package Anarres::Mud::Driver::Efun::Core::find_object;
	# sub generate_call { "undef" }
	sub invoke { undef }
}

{
	package Anarres::Mud::Driver::Efun::Core::to_string;
	# XXX This only works for CONSTANT integers, of course.
	# sub generate_call { '"' . $_[1] . '"' }
	# This works for any integer which is about to be evaluated as
	# a string by Perl. 6 . 7 == "67";
	sub generate_call { ('' . $_[1]) }
}

{
	package Anarres::Mud::Driver::Efun::Core::strlen;
	sub generate_call { "length($_[1])" }
}

{
	package Anarres::Mud::Driver::Efun::Core::error;
	sub generate_call { "die('LPC: ' . $_[1])" }
}

{
	package Anarres::Mud::Driver::Efun::Core::catch;
	sub generate_call { "do { eval { $_[1] }; $@; }"; }
}

{
	package Anarres::Mud::Driver::Efun::Core::implode;
	sub generate_call { "join($_[2], \@{ $_[1] })" }
}

{
	package Anarres::Mud::Driver::Efun::Core::explode;
	# invoke is an XSUB
}

{
	package Anarres::Mud::Driver::Efun::Core::replace_string;
	# invoke is an XSUB
}