Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
branch: master
Fetching contributors…

Cannot retrieve contributors at this time

2177 lines (1601 sloc) 69.725 kb
/*
Copyright (C) 2001-2014, Parrot Foundation.
=head1 NAME
src/pmc/class.pmc - Class PMC
=head1 DESCRIPTION
This class implements the Class PMC, as outlined in
F<docs/pdds/pdd15_objects.pod>.
Class is not derived from any other PMC.
=head2 Structure
The Class PMC structure (C<Parrot_Class>) consists of twelve items:
=over 4
=item C<id>
The type number of the PMC.
=item C<name>
The name of the class -- a STRING.
An empty STRING is allocated during initialization.
=item C<namespace>
The namespace the class is associated with, if any.
A Null PMC is allocated during initialization.
=item C<instantiated>
A flag denoting whether this class has been instantiated since last
modification. A native integer with value zero is allocated during
initialization.
=item C<parents>
An array of immediate parent classes.
An empty ResizablePMCArray PMC is allocated during initialization.
=item C<all_parents>
A cached array of ourself and all parent classes, in method resolution
order (MRO). A ResizablePMCArray PMC is allocated during initialization,
and is populated with the current class.
=item C<roles>
An array of the roles this class has been composed from.
An empty ResizablePMCArray PMC is allocated during initialization.
=item C<methods>
A directory of method names and method bodies this class provides.
An empty Hash PMC is allocated during initialization.
=item C<vtable_overrides>
A directory of vtable function names and method bodies this class overrides.
An empty Hash PMC is allocated during initialization.
=item C<attrib_metadata>
A directory of attribute names and attribute metadata this class contains.
An empty Hash PMC is allocated during initialization.
=item C<attrib_index>
A lookup table for attributes in this class and parents.
A Null PMC is allocated during initialization.
=item C<attrib_cache>
A cache of visible attribute names to attribute indexes.
A Null PMC is allocated during initialization.
=item C<resolve_method>
A list of method names the class provides used for name conflict resolution.
An empty ResizablePMCArray PMC is allocated during initialization.
=cut
*/
#include "parrot/oo_private.h"
#include "pmc/pmc_object.h"
#include "pmc/pmc_namespace.h"
/* HEADERIZER HFILE: none */
/* HEADERIZER BEGIN: static */
/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
static void build_attrib_index(PARROT_INTERP, ARGIN(PMC *self))
__attribute__nonnull__(1)
__attribute__nonnull__(2);
static int cache_class_attribs(PARROT_INTERP,
ARGIN(PMC *cur_class),
ARGIN(PMC *attrib_index),
ARGIN(PMC *cache),
int cur_index)
__attribute__nonnull__(1)
__attribute__nonnull__(2)
__attribute__nonnull__(3)
__attribute__nonnull__(4);
static void calculate_mro(PARROT_INTERP,
ARGIN(PMC *SELF),
INTVAL num_parents)
__attribute__nonnull__(1)
__attribute__nonnull__(2);
static void init_class_from_hash(PARROT_INTERP,
ARGMOD(PMC *self),
ARGIN_NULLOK(PMC *info))
__attribute__nonnull__(1)
__attribute__nonnull__(2)
FUNC_MODIFIES(*self);
static void initialize_parents(PARROT_INTERP,
ARGIN(PMC *object),
ARGIN(PMC *all_parents))
__attribute__nonnull__(1)
__attribute__nonnull__(2)
__attribute__nonnull__(3);
static void initialize_parents_pmc(PARROT_INTERP,
ARGIN(PMC *object),
ARGIN(PMC *all_parents),
ARGIN(PMC *init))
__attribute__nonnull__(1)
__attribute__nonnull__(2)
__attribute__nonnull__(3)
__attribute__nonnull__(4);
PARROT_CANNOT_RETURN_NULL
static STRING * make_class_name(PARROT_INTERP, ARGIN(PMC *SELF))
__attribute__nonnull__(1)
__attribute__nonnull__(2);
#define ASSERT_ARGS_build_attrib_index __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
PARROT_ASSERT_ARG(interp) \
, PARROT_ASSERT_ARG(self))
#define ASSERT_ARGS_cache_class_attribs __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
PARROT_ASSERT_ARG(interp) \
, PARROT_ASSERT_ARG(cur_class) \
, PARROT_ASSERT_ARG(attrib_index) \
, PARROT_ASSERT_ARG(cache))
#define ASSERT_ARGS_calculate_mro __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
PARROT_ASSERT_ARG(interp) \
, PARROT_ASSERT_ARG(SELF))
#define ASSERT_ARGS_init_class_from_hash __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
PARROT_ASSERT_ARG(interp) \
, PARROT_ASSERT_ARG(self))
#define ASSERT_ARGS_initialize_parents __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
PARROT_ASSERT_ARG(interp) \
, PARROT_ASSERT_ARG(object) \
, PARROT_ASSERT_ARG(all_parents))
#define ASSERT_ARGS_initialize_parents_pmc __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
PARROT_ASSERT_ARG(interp) \
, PARROT_ASSERT_ARG(object) \
, PARROT_ASSERT_ARG(all_parents) \
, PARROT_ASSERT_ARG(init))
#define ASSERT_ARGS_make_class_name __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
PARROT_ASSERT_ARG(interp) \
, PARROT_ASSERT_ARG(SELF))
/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
/* HEADERIZER END: static */
/*
=item C<static int cache_class_attribs(PARROT_INTERP, PMC *cur_class, PMC
*attrib_index, PMC *cache, int cur_index)>
Create a cached map of all attributes (including those inherited from parent
types), where the name of each attribute is mapped to an integer index into
a storage array.
=cut
*/
static int
cache_class_attribs(PARROT_INTERP,
ARGIN(PMC *cur_class), ARGIN(PMC *attrib_index),
ARGIN(PMC *cache), int cur_index)
{
ASSERT_ARGS(cache_class_attribs)
/* The attribute metadata hash. */
Parrot_Class_attributes * const class_info = PARROT_CLASS(cur_class);
PMC * const attribs = class_info->attrib_metadata;
PMC * const iter = VTABLE_get_iter(interp, attribs);
/* Build a string representing the fully qualified class name. */
/* Retrieve the fully qualified class name for the class. */
STRING * const fq_class = VTABLE_get_string(interp, cur_class);
PMC * const class_cache = Parrot_pmc_new(interp, enum_class_Hash);
VTABLE_set_pmc_keyed_str(interp, cache, fq_class, class_cache);
/* Iterate over the attributes. */
while (VTABLE_get_bool(interp, iter)) {
/* Get attribute. */
PMC * const cur_attrib = VTABLE_get_pmc_keyed_str(interp,
attribs, VTABLE_shift_string(interp, iter));
/* Get attribute name and append it to the key. */
STRING * const name_str = CONST_STRING(interp, "name");
STRING * const attrib_name = VTABLE_get_string_keyed_str(
interp, cur_attrib, name_str);
STRING * const full_key = Parrot_str_concat(interp, fq_class, attrib_name);
/* Insert into hash, along with index. */
VTABLE_set_integer_keyed_str(interp, attrib_index, full_key, cur_index);
VTABLE_set_integer_keyed_str(interp, class_cache, attrib_name, cur_index);
++cur_index;
}
return cur_index;
}
/*
=item C<static void build_attrib_index(PARROT_INTERP, PMC *self)>
This function builds the attribute index (table to map class name and
attribute name to an index) for the current class.
=cut
*/
static void
build_attrib_index(PARROT_INTERP, ARGIN(PMC *self))
{
ASSERT_ARGS(build_attrib_index)
Parrot_Class_attributes * const _class = PARROT_CLASS(self);
int cur_index = 0;
PMC * const attrib_index = Parrot_pmc_new(interp, enum_class_Hash);
PMC * const cache = Parrot_pmc_new_init_int(interp,
enum_class_Hash, enum_type_INTVAL);
const int num_classes = VTABLE_elements(interp, _class->all_parents);
int i;
/* Go over the list of all parents to construct the attribute index. */
for (i = 0; i < num_classes; ++i) {
/* Get the class and check that it respects the standard class interface
* (if not we don't know how it stores its attributes, so we'll have to
* delegate the lookup). */
PMC * const cur_class = VTABLE_get_pmc_keyed_int(interp,
_class->all_parents, i);
if (PObj_is_class_TEST(cur_class))
cur_index = cache_class_attribs(interp, cur_class,
attrib_index, cache, cur_index);
}
/* Store built attribute index and invalidate cache. */
_class->attrib_index = attrib_index;
_class->attrib_cache = cache;
PARROT_GC_WRITE_BARRIER(interp, self);
}
/*
=item C<static void init_class_from_hash(PARROT_INTERP, PMC *self, PMC *info)>
Takes a hash and initializes the class based on it.
=cut
*/
static void
init_class_from_hash(PARROT_INTERP, ARGMOD(PMC *self), ARGIN_NULLOK(PMC *info))
{
ASSERT_ARGS(init_class_from_hash)
Parrot_Class_attributes * const _class = PARROT_CLASS(self);
STRING * const name_str = CONST_STRING(interp, "name");
STRING * const parents_str = CONST_STRING(interp, "parents");
STRING * const methods_str = CONST_STRING(interp, "methods");
STRING * const roles_str = CONST_STRING(interp, "roles");
STRING * const attrs_str = CONST_STRING(interp, "attributes");
STRING * const resolve_method_str = CONST_STRING(interp, "resolve_method");
STRING * const set_class_str = CONST_STRING(interp, "set_class");
PMC *old_ns;
/* Ensure we actually have some initialization info. */
if (PMC_IS_NULL(info))
return;
/* Take a copy of the current namespace the class is attached to. */
old_ns = _class->_namespace;
/* Check if we have a name/namespace. */
if (VTABLE_exists_keyed_str(interp, info, name_str)) {
STRING *new_name;
PMC *new_namespace;
PMC *name_arg = VTABLE_get_pmc_keyed_str(interp, info, name_str);
VTABLE *new_vtable;
INTVAL type_num;
/* If we were passed a namespace PMC, set the namespace attribute
* directly. Otherwise, lookup or create the appropriate namespace. */
if (name_arg->vtable->base_type == enum_class_NameSpace) {
new_namespace = name_arg;
name_arg = Parrot_ns_get_name(interp, new_namespace);
VTABLE_shift_string(interp, name_arg);
}
else {
PMC * const hll_ns = VTABLE_get_pmc_keyed_int(interp,
interp->HLL_namespace, Parrot_pcc_get_HLL(interp, CURRENT_CONTEXT(interp)));
new_namespace = Parrot_ns_make_namespace_keyed(interp, hll_ns, name_arg);
}
if (PMC_IS_NULL(new_namespace))
Parrot_ex_throw_from_c_noargs(interp, EXCEPTION_INVALID_OPERATION,
"Failed to set namespace for class");
/* Set the name of the class to the name of the innermost namespace
* associated with the class. */
new_name = VTABLE_get_string(interp, new_namespace);
if (STRING_IS_NULL(new_name) || STRING_IS_EMPTY(new_name))
Parrot_ex_throw_from_c_noargs(interp, EXCEPTION_INVALID_OPERATION,
"Failed to set name for class");
_class->_namespace = new_namespace;
_class->name = new_name;
/* At this point we know the class isn't anonymous */
CLASS_is_anon_CLEAR(self);
/* Register a type number for the class. */
type_num = Parrot_oo_register_type(interp, name_arg, new_namespace);
/* Link the type number with the class's vtable. */
new_vtable = Parrot_vtbl_clone_vtable(interp, self->vtable);
new_vtable->base_type = type_num;
new_vtable->pmc_class = self;
new_vtable->whoami = VTABLE_get_string(interp, self);
new_vtable->mro = _class->all_parents;
new_vtable->ro_variant_vtable =
Parrot_vtbl_clone_vtable(interp, self->vtable->ro_variant_vtable);
/* Store the class's vtable in the global table */
interp->vtables[type_num] = new_vtable;
_class->id = type_num;
}
/* If we were attached to a namespace and are now attached to a new one,
* need to unset ourselves in the old namespace. */
if (!PMC_IS_NULL(old_ns) && _class->_namespace != old_ns)
Parrot_pcc_invoke_method_from_c_args(interp, old_ns,
set_class_str,
"P->", PMCNULL);
/* Link namespace to this class, if there is one. */
if (!PMC_IS_NULL(_class->_namespace)) {
Parrot_pcc_invoke_method_from_c_args(interp, _class->_namespace,
set_class_str,
"P->", self);
}
/* Initialize resolve_method. */
if (VTABLE_exists_keyed_str(interp, info, resolve_method_str)) {
/* Set it. */
_class->resolve_method =
VTABLE_get_pmc_keyed_str(interp, info, resolve_method_str);
}
/* Initialize parents, if we have any. */
if (VTABLE_exists_keyed_str(interp, info, parents_str)) {
/* Loop over parents array and add them. */
PMC * const parent_list = VTABLE_get_pmc_keyed_str(interp, info,
parents_str);
const int parent_count = VTABLE_elements(interp, parent_list);
int i;
for (i = 0; i < parent_count; ++i)
VTABLE_add_parent(interp, self,
VTABLE_get_pmc_keyed_int(interp, parent_list, i));
}
/* Initialize roles, if we have any. */
if (VTABLE_exists_keyed_str(interp, info, roles_str)) {
/* Loop over roles array and compose them. */
PMC * const role_list = VTABLE_get_pmc_keyed_str(interp, info,
roles_str);
const int role_count = VTABLE_elements(interp, role_list);
int i;
for (i = 0; i < role_count; ++i)
VTABLE_add_role(interp, self,
VTABLE_get_pmc_keyed_int(interp, role_list, i));
}
/* Initialize attributes, if we have any. */
if (VTABLE_exists_keyed_str(interp, info, attrs_str)) {
/* Loop over attributes array and add them. */
PMC * const attrs_name_list = VTABLE_get_pmc_keyed_str(interp, info,
attrs_str);
const int attrib_count = VTABLE_elements(interp, attrs_name_list);
int i;
for (i = 0; i < attrib_count; ++i) {
STRING * const attr_name = VTABLE_get_string_keyed_int(interp,
attrs_name_list, i);
VTABLE_add_attribute(interp, self, attr_name, PMCNULL);
}
}
/* Initialize methods. */
if (VTABLE_exists_keyed_str(interp, info, methods_str)) {
/* Get the methods hash. */
PMC * const methods = VTABLE_get_pmc_keyed_str(interp, info,
methods_str);
/* Iterate over the list of methods. */
PMC * const iter = VTABLE_get_iter(interp, methods);
while (VTABLE_get_bool(interp, iter)) {
/* Add the method. */
STRING * const method_name = VTABLE_shift_string(interp, iter);
PMC * const method_pmc = VTABLE_get_pmc_keyed_str(interp,
methods, method_name);
VTABLE_add_method(interp, self, method_name, method_pmc);
}
}
/* Extract any methods from the namespace */
Parrot_oo_extract_methods_from_namespace(interp, self, _class->_namespace);
}
/*
=item C<static void initialize_parents(PARROT_INTERP, PMC *object, PMC
*all_parents)>
Loop over all parents in the MRO, setting up delegate objects if necessary and
calling C<init> vtables on them, if necessary.
=cut
*/
static void
initialize_parents(PARROT_INTERP, ARGIN(PMC *object), ARGIN(PMC *all_parents))
{
ASSERT_ARGS(initialize_parents)
INTVAL parent_index = VTABLE_elements(interp, all_parents) - 1;
STRING * const name = CONST_STRING(interp, "init");
/* Loop through the parents in reverse MRO order. */
for (; parent_index >= 0; --parent_index) {
PMC *meth;
PMC * const parent = VTABLE_get_pmc_keyed_int(interp,
all_parents, parent_index);
/* PMCProxy parents store an instance to delegate to */
if (parent->vtable->base_type == enum_class_PMCProxy) {
PMC *proxy = VTABLE_instantiate(interp, parent, PMCNULL);
STRING *proxy_str = CONST_STRING(interp, "proxy");
VTABLE_set_attr_keyed(interp, object, parent, proxy_str, proxy);
}
meth = Parrot_oo_find_vtable_override_for_class(interp, parent, name);
if (!PMC_IS_NULL(meth)) {
/* preserve current_object */
Parrot_ext_call(interp, meth, "Pi->", object);
}
}
}
/*
=item C<static void initialize_parents_pmc(PARROT_INTERP, PMC *object, PMC
*all_parents, PMC *init)>
Loop over all parents in the MRO, setting up delegate objects if necessary and
calling C<init_pmc> vtables on them, if necessary.
=cut
*/
static void
initialize_parents_pmc(PARROT_INTERP, ARGIN(PMC *object),
ARGIN(PMC *all_parents), ARGIN(PMC *init))
{
ASSERT_ARGS(initialize_parents_pmc)
INTVAL parent_index = VTABLE_elements(interp, all_parents) - 1;
STRING * const name = CONST_STRING(interp, "init_pmc");
/* Loop through the parents in reverse MRO order. */
for (; parent_index >= 0; --parent_index) {
PMC *meth;
PMC * const parent = VTABLE_get_pmc_keyed_int(interp,
all_parents, parent_index);
/* PMCProxy parents store an instance to delegate to */
if (parent->vtable->base_type == enum_class_PMCProxy) {
PMC * const proxy = VTABLE_instantiate(interp, parent, init);
STRING * const proxy_str = CONST_STRING(interp, "proxy");
VTABLE_set_attr_keyed(interp, object, parent, proxy_str, proxy);
}
meth = Parrot_oo_find_vtable_override_for_class(interp, parent, name);
if (!PMC_IS_NULL(meth))
Parrot_ext_call(interp, meth, "PiP->", object, init);
}
}
/*
=item C<static STRING * make_class_name(PARROT_INTERP, PMC *SELF)>
This function makes and caches the name of this class, returning the string
directly. C<VTABLE_isa()> uses the name without copying it, for efficiency
reasons, as it does not modify the STRING. C<VTABLE_get_string()> makes a
copy of the STRING, so its callers are free to modify it.
=cut
*/
PARROT_CANNOT_RETURN_NULL
static STRING *
make_class_name(PARROT_INTERP, ARGIN(PMC *SELF))
{
ASSERT_ARGS(make_class_name)
Parrot_Class_attributes * const _class = PARROT_CLASS(SELF);
PMC * const _namespace = _class->_namespace;
if (!PMC_IS_NULL(_namespace)) {
if (_class->fullname)
return _class->fullname;
else {
/* Call the 'get_name' method on the class's associated
* namespace to retrieve a fully qualified list of names, then
* join the list with a semicolon. */
PMC * const names = Parrot_ns_get_name(interp, _namespace);
if (!PMC_IS_NULL(names))
/* remove the HLL namespace name */
VTABLE_shift_string(interp, names);
PARROT_GC_WRITE_BARRIER(interp, SELF);
_class->fullname = Parrot_str_join(interp, CONST_STRING(interp, ";"), names);
return _class->fullname;
}
}
/* Otherwise, copy the stored string name of the class. */
return _class->name;
}
/*
=item C<static void calculate_mro(PARROT_INTERP, PMC *SELF, INTVAL num_parents)>
Calculates the C3 method resolution order for this class. C3 is the name of an
algorithm used to calculate the method resolution order (MRO) to use in a
system with multiple inheritance. For more information see the documentation
associated with C<Parrot_ComputeMRO_C3>.
=cut
*/
static void
calculate_mro(PARROT_INTERP, ARGIN(PMC *SELF), INTVAL num_parents)
{
ASSERT_ARGS(calculate_mro)
Parrot_Class_attributes * const _class = PARROT_CLASS(SELF);
/* SELF is already on the all_parents */
if (num_parents == 0)
return;
if (num_parents == 1) {
STRING * const ap = CONST_STRING(interp, "all_parents");
PMC * const parent = VTABLE_get_pmc_keyed_int(interp,
_class->parents, 0);
PMC * const parent_mro = VTABLE_inspect_str(interp, parent, ap);
PMC * const mro = VTABLE_clone(interp, parent_mro);
VTABLE_unshift_pmc(interp, mro, SELF);
PARROT_GC_WRITE_BARRIER(interp, SELF);
_class->all_parents = mro;
}
else {
PARROT_GC_WRITE_BARRIER(interp, SELF);
_class->all_parents = Parrot_ComputeMRO_C3(interp, SELF);
}
if (!CLASS_is_anon_TEST(SELF))
interp->vtables[VTABLE_type(interp, SELF)]->mro = _class->all_parents;
}
/*
=back
=head2 Functions
=over 4
=cut
*/
pmclass Class auto_attrs {
ATTR INTVAL id; /* The type number of the PMC. */
ATTR STRING *name; /* The name of the class. */
ATTR STRING *fullname; /* The name of the class. */
ATTR PMC *_namespace; /* The namespace it's linked to, if any. */
ATTR INTVAL instantiated; /* Any instantiations since last modification? */
ATTR PMC *parents; /* Immediate parent classes. */
ATTR PMC *all_parents; /* Cached list of ourself and all parents, in MRO order. */
ATTR PMC *roles; /* An array of roles. */
ATTR PMC *methods; /* Hash of method names to methods in this class. */
ATTR PMC *vtable_overrides; /* Hash of Parrot v-table methods we override. */
ATTR PMC *attrib_metadata; /* Hash of attributes in this class to hashes of metadata. */
ATTR PMC *attrib_index; /* Lookup table for attributes in this and parents. */
ATTR PMC *attrib_cache; /* Cache of visible attrib names to indexes. */
ATTR PMC *resolve_method; /* List of method names the class provides to resolve
* conflicts with methods from roles. */
ATTR PMC *parent_overrides;
ATTR PMC *meth_cache;
ATTR Hash *isa_cache;
/*
=item C<void init()>
Initializes a Class PMC.
=item C<void init_pmc(PMC *init_data)>
The actual class creation code, called from C<newclass> opcode. The C<init_data>
argument may be either the name of the class or a hash of initialization
arguments. The class is attached to the current HLL namespace.
=cut
*/
VTABLE void init() {
Parrot_Class_attributes * const _class =
(Parrot_Class_attributes *) PMC_data(SELF);
/* Set flag for custom GC mark. */
PObj_custom_mark_destroy_SETALL(SELF);
/* Set up the object. */
_class->name = CONST_STRING(INTERP, "");
_class->_namespace = PMCNULL;
_class->parents = Parrot_pmc_new(INTERP, enum_class_ResizablePMCArray);
_class->all_parents = Parrot_pmc_new(INTERP, enum_class_ResizablePMCArray);
_class->roles = Parrot_pmc_new(INTERP, enum_class_ResizablePMCArray);
_class->methods = Parrot_pmc_new(INTERP, enum_class_Hash);
_class->attrib_metadata = Parrot_pmc_new(INTERP, enum_class_Hash);
_class->attrib_index = PMCNULL;
_class->attrib_cache = PMCNULL;
_class->meth_cache = PMCNULL;
_class->resolve_method = Parrot_pmc_new(INTERP, enum_class_ResizablePMCArray);
_class->vtable_overrides = Parrot_pmc_new(INTERP, enum_class_Hash);
_class->parent_overrides = Parrot_pmc_new(INTERP, enum_class_Hash);
_class->isa_cache = Parrot_hash_create(INTERP,
enum_type_INTVAL, Hash_key_type_PMC_ptr);
/* We put ourself on the all parents list. */
VTABLE_push_pmc(INTERP, _class->all_parents, SELF);
/* We are a class. */
PObj_is_class_SET(SELF);
/* By default we're anonymous. */
CLASS_is_anon_SET(SELF);
}
VTABLE void init_pmc(PMC *init_data) {
PMC *arg;
const INTVAL arg_type = VTABLE_type(INTERP, init_data);
STRING * const name_str = CONST_STRING(INTERP, "name");
/* Set up the object. */
SELF.init();
/* fast attempt to determine init_data type */
switch (arg_type) {
case enum_class_String:
case enum_class_Key:
case enum_class_ResizableStringArray:
case enum_class_NameSpace:
/* set only the name property */
arg = Parrot_pmc_new(INTERP, enum_class_Hash);
VTABLE_set_pmc_keyed_str(INTERP, arg, name_str, init_data);
break;
case enum_class_Hash:
arg = init_data;
break;
/* slow attempt to determine init_data type */
default:
if (VTABLE_isa(INTERP, init_data, CONST_STRING(INTERP, "String"))
|| VTABLE_isa(INTERP, init_data, CONST_STRING(INTERP, "Key"))
|| VTABLE_isa(INTERP, init_data, CONST_STRING(INTERP, "ResizableStringArray"))) {
/* set only the name property */
arg = Parrot_pmc_new(INTERP, enum_class_Hash);
VTABLE_set_pmc_keyed_str(INTERP, arg, name_str, init_data);
}
if (VTABLE_isa(INTERP, init_data, CONST_STRING(INTERP, "Hash")))
arg = init_data;
else
Parrot_ex_throw_from_c_noargs(INTERP,
EXCEPTION_INVALID_OPERATION,
"Invalid class name key in init_pmc for Class");
break;
}
/* Initialize the class with the supplied data. */
init_class_from_hash(INTERP, SELF, arg);
}
void destroy() {
Parrot_Class_attributes * const _class = PARROT_CLASS(SELF);
Parrot_hash_destroy(INTERP, _class->isa_cache);
}
/*
=item C<STRING *get_string()>
Returns the name of the class (without the HLL namespace).
=cut
*/
VTABLE STRING *get_string() :no_wb {
return make_class_name(INTERP, SELF);
}
/*
=item C<void mark()>
Marks any referenced strings and PMCs in the structure as live.
=cut
*/
VTABLE void mark() :no_wb {
Parrot_Class_attributes * const _class = PARROT_CLASS(SELF);
Parrot_gc_mark_STRING_alive(INTERP, _class->name);
Parrot_gc_mark_STRING_alive(INTERP, _class->fullname);
Parrot_gc_mark_PMC_alive(INTERP, _class->_namespace);
Parrot_gc_mark_PMC_alive(INTERP, _class->parents);
Parrot_gc_mark_PMC_alive(INTERP, _class->all_parents);
Parrot_gc_mark_PMC_alive(INTERP, _class->roles);
Parrot_gc_mark_PMC_alive(INTERP, _class->methods);
Parrot_gc_mark_PMC_alive(INTERP, _class->vtable_overrides);
Parrot_gc_mark_PMC_alive(INTERP, _class->parent_overrides);
Parrot_gc_mark_PMC_alive(INTERP, _class->attrib_metadata);
Parrot_gc_mark_PMC_alive(INTERP, _class->attrib_index);
Parrot_gc_mark_PMC_alive(INTERP, _class->attrib_cache);
Parrot_gc_mark_PMC_alive(INTERP, _class->resolve_method);
Parrot_gc_mark_PMC_alive(INTERP, _class->meth_cache);
if (_class->isa_cache)
Parrot_hash_mark(INTERP, _class->isa_cache);
}
/*
=item C<void add_attribute(STRING *name, PMC *type)>
Adds the given attribute (C<name>) with an optional C<type>.
Throws an exception if the current class has been instantiated.
Enters the attribute in the C<attrib_metadata> table.
Returns an error if an attribute of C<name> already exists.
=cut
*/
VTABLE void add_attribute(STRING *name, PMC *type) {
Parrot_Class_attributes * const _class = PARROT_CLASS(SELF);
PMC * const new_attribute = Parrot_pmc_new(INTERP, enum_class_Hash);
/* If we've been instantiated already, not allowed. */
if (_class->instantiated)
Parrot_ex_throw_from_c_noargs(INTERP, EXCEPTION_INVALID_OPERATION,
"Modifications to classes are not allowed after instantiation");
/* If we already have an attribute of this name, it's an error. */
if (VTABLE_exists_keyed_str(INTERP, _class->attrib_metadata, name))
Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_INVALID_OPERATION,
"Attribute '%Ss' already exists in '%Ss'", name,
VTABLE_get_string(INTERP, SELF));
/* Set name and type. */
VTABLE_set_string_keyed_str(INTERP, new_attribute, CONST_STRING(INTERP, "name"), name);
if (!PMC_IS_NULL(type))
VTABLE_set_pmc_keyed_str(INTERP, new_attribute, CONST_STRING(INTERP, "type"), type);
/* Enter the attribute in the attrib_metadata table. */
VTABLE_set_pmc_keyed_str(INTERP, _class->attrib_metadata, name,
new_attribute);
}
/*
=item C<void remove_attribute(STRING *name)>
Removes the given attribute (C<name>) from the class. Throws an exception if
the current class has been instantiated, or if the class has no attribute
C<name>.
=cut
*/
VTABLE void remove_attribute(STRING *name) :manual_wb {
Parrot_Class_attributes * const _class = PARROT_CLASS(SELF);
/* If we've been instantiated already, not allowed. */
if (_class->instantiated)
Parrot_ex_throw_from_c_noargs(INTERP, EXCEPTION_INVALID_OPERATION,
"Modifications to classes are not allowed after instantiation");
/* If we don't have an attribute of this name, it's an error. */
if (!VTABLE_exists_keyed_str(INTERP, _class->attrib_metadata, name))
Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_INVALID_OPERATION,
"Attribute '%Ss' cannot be removed, does not exist in '%Ss'", name,
VTABLE_get_string(INTERP, SELF));
/* Remove the attribute from the attrib_metadata table. */
VTABLE_delete_keyed_str(INTERP, _class->attrib_metadata, name);
build_attrib_index(INTERP, SELF); /* calls WB */
}
/*
=item C<void add_method(STRING *name, PMC *sub)>
Adds the given sub PMC as a method with the given name.
=cut
*/
VTABLE void add_method(STRING *name, PMC *sub) {
Parrot_Class_attributes * const _class = PARROT_CLASS(SELF);
PMC * const method =
VTABLE_get_pmc_keyed_str(INTERP, _class->methods, name);
/* If we have already added a method with this name... */
if (!PMC_IS_NULL(method)) {
if (method == sub)
return;
Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_INVALID_OPERATION,
"A method named '%S' already exists in class '%S'. "
"It may have been supplied by a role",
name, VTABLE_get_string(INTERP, SELF));
}
/* Enter it into the table. */
VTABLE_set_pmc_keyed_str(INTERP, _class->methods, name, sub);
}
/*
=item C<void remove_method(STRING *name)>
Removes the method with the given name.
=cut
*/
VTABLE void remove_method(STRING *name) {
Parrot_Class_attributes * const _class = PARROT_CLASS(SELF);
if (VTABLE_exists_keyed_str(INTERP, _class->methods, name))
VTABLE_delete_keyed_str(INTERP, _class->methods, name);
else
Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_INVALID_OPERATION,
"No method named '%S' to remove in class '%S'",
name, VTABLE_get_string(INTERP, SELF));
}
/*
=item C<void add_vtable_override(STRING *name, PMC *sub)>
Adds the given sub PMC as a vtable override with the given name.
=cut
*/
VTABLE void add_vtable_override(STRING *name, PMC *sub) {
Parrot_Class_attributes * const _class = PARROT_CLASS(SELF);
/* Check that the name is actually valid as a vtable override */
if (Parrot_get_vtable_index(INTERP, name) == -1)
Parrot_ex_throw_from_c_args(INTERP, NULL,
EXCEPTION_METHOD_NOT_FOUND,
"'%S' is not a valid vtable function name", name);
/* Add it to vtable list. */
VTABLE_set_pmc_keyed_str(INTERP, _class->vtable_overrides, name, sub);
}
/*
=item C<void add_parent(PMC *parent)>
Adds the supplied PMC to the list of parents for the class.
=cut
*/
VTABLE void add_parent(PMC *parent) {
Parrot_Class_attributes * const _class = PARROT_CLASS(SELF);
int parent_count, index;
/* If we've been instantiated already, not allowed. */
if (_class->instantiated)
Parrot_ex_throw_from_c_noargs(INTERP,
EXCEPTION_INVALID_OPERATION,
"Modifications to classes are not allowed after instantiation");
if (PMC_IS_NULL(parent)) {
STRING * const me_str = make_class_name(INTERP, SELF);
Parrot_ex_throw_from_c_args(INTERP, NULL,
EXCEPTION_UNEXPECTED_NULL, "Parent of '%Ss' is null", me_str);
}
/* Ensure it really is a class. */
if (!PObj_is_class_TEST(parent)) {
STRING * const pstr = VTABLE_get_string(INTERP, parent);
STRING * me_str = make_class_name(INTERP, SELF);
Parrot_ex_throw_from_c_args(INTERP, NULL,
EXCEPTION_INVALID_OPERATION,
"Parent '%Ss' of '%Ss' isn't a Class", pstr, me_str);
}
/* Check is not self */
if (parent == SELF)
Parrot_ex_throw_from_c_noargs(INTERP,
EXCEPTION_INVALID_OPERATION, "Can't be own parent");
/* get number of direct parents */
parent_count = VTABLE_elements(INTERP, _class->parents);
/* iterate over all direct parents, check whether this class already has
* the parent being added. */
for (index = 0; index < parent_count; ++index) {
/* get the next parent */
PMC * const current_parent = VTABLE_get_pmc_keyed_int(INTERP,
_class->parents, index);
/* throw an exception if we already have this parent */
if (current_parent == parent)
Parrot_ex_throw_from_c_args(INTERP, NULL,
EXCEPTION_INVALID_OPERATION,
"The class '%S' already has a parent class '%S'. "
"It may have been supplied by a role",
VTABLE_get_string(INTERP, SELF),
VTABLE_get_string(INTERP, parent));
}
/* Check that none of the parents is self */
parent_count = VTABLE_elements(INTERP, PARROT_CLASS(parent)->all_parents);
for (index = 0; index < parent_count; ++index) {
/* get the next parent */
PMC * const current_parent = VTABLE_get_pmc_keyed_int(INTERP,
PARROT_CLASS(parent)->all_parents, index);
if (current_parent == SELF)
Parrot_ex_throw_from_c_args(INTERP, NULL,
EXCEPTION_INVALID_OPERATION,
"Loop in class hierarchy: '%S' is an ancestor of '%S'",
VTABLE_get_string(INTERP, SELF),
VTABLE_get_string(INTERP, parent));
}
/* Add to the lists of our immediate parents and all parents. */
VTABLE_push_pmc(INTERP, _class->parents, parent);
Parrot_hash_put(INTERP, _class->isa_cache, (void *)parent, (void *)1);
calculate_mro(INTERP, SELF, parent_count + 1);
}
/*
=item C<void remove_parent(PMC *parent)>
Remove the supplied class object from the list of parents for the class.
Throws an exception if parent is null, is not a class, or is not a parent, or
if the class has been instantiated.
=cut
*/
VTABLE void remove_parent(PMC *parent) {
Parrot_Class_attributes * const _class = PARROT_CLASS(SELF);
int parent_count, index;
/* If we've been instantiated already, not allowed. */
if (_class->instantiated)
Parrot_ex_throw_from_c_noargs(INTERP,
EXCEPTION_INVALID_OPERATION,
"Modifications to classes are not allowed after instantiation");
/* Ensure it really is a class. */
if (!PObj_is_class_TEST(parent))
Parrot_ex_throw_from_c_noargs(INTERP,
EXCEPTION_INVALID_OPERATION, "Parent isn't a Class");
/* get number of direct parents */
parent_count = VTABLE_elements(INTERP, _class->parents);
/* iterate over all direct parents, looking for the parent to remove */
for (index = 0; index < parent_count; ++index) {
/* get the next parent */
PMC * const current_parent = VTABLE_get_pmc_keyed_int(INTERP,
_class->parents, index);
if (current_parent == parent)
break;
}
if (index >= parent_count)
Parrot_ex_throw_from_c_noargs(INTERP,
EXCEPTION_INVALID_OPERATION,
"Can't remove_parent: is not a parent");
VTABLE_delete_keyed_int(INTERP, _class->parents, index);
Parrot_hash_put(INTERP, _class->isa_cache, (void *)parent, (void *)0);
calculate_mro(INTERP, SELF, parent_count - 1);
}
/*
=item C<void add_role(PMC *role)>
Adds the supplied PMC to the list of roles for the class, provided there are
no conflicts.
=cut
*/
VTABLE void add_role(PMC *role) {
const Parrot_Class_attributes * const _class = PARROT_CLASS(SELF);
/* Do the composition. */
Parrot_ComposeRole(INTERP, role,
_class->resolve_method, !PMC_IS_NULL(_class->resolve_method),
PMCNULL, 0, _class->methods, _class->roles);
}
/*
=item C<PMC *inspect_str(STRING *what)>
Provides introspection of a specific piece of information about the class. The
available information is:
=over 8
=item name
String PMC containing the name of the class
=item namespace
NameSpace PMC of the namespace attached to the class.
=item attributes
Hash keyed on attribute name, where the value is a hash describing it.
=item methods
Hash keyed on method name, value is an invokable PMC. Includes methods composed
in from roles.
=item roles
Array of Role PMCs. Includes roles done by the roles that were composed into
this class.
=item parents
Array of Class PMCs representing the direct parents of this class.
=back
=cut
*/
VTABLE PMC *inspect_str(STRING *what) :no_wb {
Parrot_Class_attributes * const _class = PARROT_CLASS(SELF);
/* What should we return? */
PMC *found;
if (STRING_equal(INTERP, what, CONST_STRING(INTERP, "attributes"))) {
found = _class->attrib_metadata;
}
else if (STRING_equal(INTERP, what, CONST_STRING(INTERP, "parents"))) {
found = _class->parents;
}
else if (STRING_equal(INTERP, what, CONST_STRING(INTERP, "name"))) {
found = Parrot_pmc_new(INTERP, enum_class_String);
VTABLE_set_string_native(INTERP, found, _class->name);
}
else if (STRING_equal(INTERP, what, CONST_STRING(INTERP, "id"))) {
found = Parrot_pmc_new_init_int(INTERP, enum_class_Integer, _class->id);
}
else if (STRING_equal(INTERP, what, CONST_STRING(INTERP, "namespace"))) {
/* Should not clone this. */
return _class->_namespace;
}
else if (STRING_equal(INTERP, what, CONST_STRING(INTERP, "attrib_index"))) {
found = _class->attrib_index;
}
else if (STRING_equal(INTERP, what, CONST_STRING(INTERP, "methods"))) {
found = _class->methods;
}
else if (STRING_equal(INTERP, what, CONST_STRING(INTERP, "vtable_overrides"))) {
found = _class->vtable_overrides;
}
else if (STRING_equal(INTERP, what, CONST_STRING(INTERP, "all_parents"))) {
found = _class->all_parents;
}
else if (STRING_equal(INTERP, what, CONST_STRING(INTERP, "roles"))) {
found = _class->roles;
}
else if (STRING_equal(INTERP, what, CONST_STRING(INTERP, "flags"))) {
found = Parrot_pmc_new_init_int(INTERP, enum_class_Integer,
(INTVAL)PObj_get_FLAGS(SELF));
}
else
Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_INVALID_OPERATION,
"Unknown introspection value '%S'", what);
/* return found value */
if (PMC_IS_NULL(found))
return PMCNULL;
if (found->vtable->base_type == enum_class_Hash) {
/* for Hash return values, create and return a shallow
* clone because the VTABLE_clone does a deep clone */
PMC * const hash = Parrot_pmc_new(INTERP, enum_class_Hash);
Hash *src = (Hash *)VTABLE_get_pointer(interp, found);
Hash *dest = (Hash *)VTABLE_get_pointer(interp, hash);
Parrot_hash_clone_prunable(interp, src, dest, 0);
return hash;
}
return VTABLE_clone(INTERP, found);
}
/*
=item C<PMC *inspect()>
Returns a Hash describing the class, with key/value pairs as described in
inspect_str.
=cut
*/
VTABLE PMC *inspect() :no_wb {
/* Create a hash, then use inspect_str to get all of the data to
* fill it up with. */
PMC * const metadata = Parrot_pmc_new(INTERP, enum_class_Hash);
STRING * const name_str = CONST_STRING(INTERP, "name");
STRING * const ns_str = CONST_STRING(INTERP, "namespace");
STRING * const attrs_str = CONST_STRING(INTERP, "attributes");
STRING * const meths_str = CONST_STRING(INTERP, "methods");
STRING * const parents_str = CONST_STRING(INTERP, "parents");
STRING * const roles_str = CONST_STRING(INTERP, "roles");
STRING * const flags_str = CONST_STRING(INTERP, "flags");
VTABLE_set_pmc_keyed_str(INTERP, metadata, name_str,
VTABLE_inspect_str(INTERP, SELF, name_str));
VTABLE_set_pmc_keyed_str(INTERP, metadata, ns_str,
VTABLE_inspect_str(INTERP, SELF, ns_str));
VTABLE_set_pmc_keyed_str(INTERP, metadata, attrs_str,
VTABLE_inspect_str(INTERP, SELF, attrs_str));
VTABLE_set_pmc_keyed_str(INTERP, metadata, meths_str,
VTABLE_inspect_str(INTERP, SELF, meths_str));
VTABLE_set_pmc_keyed_str(INTERP, metadata, parents_str,
VTABLE_inspect_str(INTERP, SELF, parents_str));
VTABLE_set_pmc_keyed_str(INTERP, metadata, roles_str,
VTABLE_inspect_str(INTERP, SELF, roles_str));
VTABLE_set_pmc_keyed_str(INTERP, metadata, flags_str,
VTABLE_inspect_str(INTERP, SELF, flags_str));
return metadata;
}
/*
=item C<PMC *clone()>
Returns an anonymous copy of the class (with no name and no link to a
namespace). Unsets the instantiated flag, allowing modifications.
=cut
*/
VTABLE PMC *clone() :no_wb {
Parrot_Class_attributes * const _class = PARROT_CLASS(SELF);
/* Create the new class PMC, of the same type of this one (we may
* have been subclassed). */
PMC * const copy = SUPER();
/* Clone parents, roles, methods, attributes and resolve data. We do
* not copy name/namespace related stuff (need anonymous clone) or
* stuff that gets computed on the first instantiation. */
Parrot_Class_attributes * const new_class = PARROT_CLASS(copy);
new_class->name = CONST_STRING(INTERP, "");
new_class->_namespace = PMCNULL;
new_class->parents = VTABLE_clone(INTERP, _class->parents);
new_class->roles = VTABLE_clone(INTERP, _class->roles);
new_class->methods = VTABLE_clone(INTERP, _class->methods);
new_class->vtable_overrides = VTABLE_clone(INTERP,
_class->vtable_overrides);
new_class->parent_overrides = VTABLE_clone(INTERP,
_class->parent_overrides);
new_class->attrib_metadata = VTABLE_clone(INTERP,
_class->attrib_metadata);
new_class->resolve_method = VTABLE_clone(INTERP,
_class->resolve_method);
/* Return cloned class. */
return copy;
}
/*
=item C<PMC *clone_pmc(PMC *args)>
Makes a copy of the class, then modifies or adds to it based upon the contents
of the supplied initialization data. If a new name or namespace is not supplied
in C<args> then the cloned class will be anonymous. The instantiated flag is
unset to allow further modifications.
=cut
*/
VTABLE PMC *clone_pmc(PMC *args) :no_wb {
/* Do the standard clone. */
PMC * const copy = SELF.clone();
init_class_from_hash(INTERP, copy, args);
return copy;
}
/*
=item C<PMC *instantiate(PMC *init)>
Creates a new PMC object of the type of the class and calls init().
=cut
*/
VTABLE PMC *instantiate(PMC *init) :manual_wb {
Parrot_Class_attributes * const _class = PARROT_CLASS(SELF);
PMC *object;
/* If we've not been instantiated before... */
if (!_class->instantiated) {
/* Check that we have all methods listed in resolve list. */
const int resolve_count = VTABLE_elements(INTERP,
_class->resolve_method);
const INTVAL cur_hll = Parrot_pcc_get_HLL(INTERP, CURRENT_CONTEXT(INTERP));
const INTVAL num_parents = VTABLE_elements(INTERP, _class->parents);
INTVAL mro_length;
int i;
/* don't use HLL mappings for internal-only data */
Parrot_pcc_set_HLL(INTERP, CURRENT_CONTEXT(INTERP), 0);
for (i = 0; i < resolve_count; ++i) {
STRING * const check_meth =
VTABLE_get_string_keyed_int(INTERP, _class->resolve_method, i);
if (!VTABLE_exists_keyed_str(INTERP, _class->methods, check_meth))
Parrot_ex_throw_from_c_args(INTERP, NULL,
EXCEPTION_METHOD_NOT_FOUND, "The method '%S' was named "
"in the resolve list, but not supplied", check_meth);
}
/* Build full parents list. */
calculate_mro(INTERP, SELF, num_parents);
build_attrib_index(INTERP, SELF);
if (PMC_IS_NULL(_class->attrib_index)) {
return PMCNULL;
}
/* See if we have any parents from other universes and if so set a
* flag stating so. */
mro_length = VTABLE_elements(INTERP, _class->all_parents);
for (i = 0; i < mro_length; ++i) {
PMC * const class_check = VTABLE_get_pmc_keyed_int(INTERP,
_class->all_parents, i);
if (class_check->vtable->base_type != enum_class_Class) {
/* Found one; that's enough. */
CLASS_has_alien_parents_SET(SELF);
break;
}
}
Parrot_pcc_set_HLL(INTERP, CURRENT_CONTEXT(INTERP), cur_hll);
}
/* Set instantiated flag. */
_class->instantiated = 1;
/* Create object. */
object = Parrot_pmc_new_noinit(INTERP, enum_class_Object);
/* Set custom GC mark and destroy on the object. */
PObj_custom_mark_destroy_SETALL(object);
/* Flag that it is an object */
PObj_is_object_SET(object);
/* Initialize the object's underlying structure, pointing it to this
* class. */
/* TODO: this has been changed in order to use auto_attrs in the
* Object PMC. Needs to be redone in a cleaner way. */
{
Parrot_Object_attributes * const objattr =
PMC_data_typed(object, Parrot_Object_attributes *);
objattr->_class = SELF;
/* Big L1 Instr fetch miss */
objattr->attrib_store =
Parrot_pmc_new_init_int(INTERP, enum_class_ResizablePMCArray,
VTABLE_elements(INTERP, _class->attrib_index));
PARROT_GC_WRITE_BARRIER(INTERP, object);
}
if (!PMC_IS_NULL(init)) {
/* Initialize attributes with the supplied values. */
PMC * const iter = VTABLE_get_iter(INTERP, init);
while (VTABLE_get_bool(INTERP, iter)) {
STRING * const name = VTABLE_shift_string(INTERP, iter);
PMC * const value = VTABLE_get_pmc_keyed_str(INTERP, init,
name);
/* Set the attribute. */
VTABLE_set_attr_str(INTERP, object, name, value);
}
/* Check for overrides on the init_pmc vtable function */
initialize_parents_pmc(INTERP, object, _class->all_parents, init);
}
else
/* Check for overrides on the init vtable function */
initialize_parents(INTERP, object, _class->all_parents);
return object;
}
/*
=item C<INTVAL isa_pmc(PMC *class)>
Returns whether the class is or inherits from C<*class>.
=cut
*/
VTABLE INTVAL isa_pmc(PMC *lookup) :manual_wb {
Parrot_Class_attributes * const _class = PARROT_CLASS(SELF);
PMC *classobj;
HashBucket *b;
INTVAL i, num_classes, retval = 0;
if (PMC_IS_NULL(lookup))
return 0;
if (PObj_is_class_TEST(lookup)) {
if (lookup == SELF)
return 1;
else
classobj = lookup;
}
else
classobj = Parrot_oo_get_class(INTERP, lookup);
if (PMC_IS_NULL(classobj))
return 0;
/* Check if the class object is the same as self's class object */
if (VTABLE_is_same(INTERP, SELF, classobj))
goto found;
if (_class->instantiated) {
b = Parrot_hash_get_bucket(INTERP, _class->isa_cache,
(void *)classobj);
if (b)
return PTR2INTVAL(b->value);
}
/* this is effectively what the default PMC's isa_pmc does
* ... but this can cheat and avoid COW STRINGs for the classobj
* only in these two, very specific and common cases */
if (classobj->vtable->base_type == enum_class_Class
|| classobj->vtable->base_type == enum_class_PMCProxy) {
STRING *classname = make_class_name(INTERP, classobj);
PARROT_ASSERT(SELF->vtable->isa_hash);
if (Parrot_hash_exists(INTERP, SELF->vtable->isa_hash, classname))
goto found;
}
/* Iterate over all the parents and check if they respond true
* for 'isa' on the original comparison. */
num_classes = VTABLE_elements(INTERP, _class->parents);
for (i = 0; i < num_classes; ++i) {
PMC * const cur_class = VTABLE_get_pmc_keyed_int(INTERP,
_class->parents, i);
if (VTABLE_isa_pmc(INTERP, cur_class, lookup))
goto found;
}
cache_and_return:
if (_class->instantiated) {
PARROT_GC_WRITE_BARRIER(INTERP, SELF);
Parrot_hash_put(INTERP, _class->isa_cache, (void *)classobj,
INTVAL2PTR(void *, retval));
}
return retval;
found:
retval = 1;
goto cache_and_return;
}
/*
=item C<INTVAL isa(STRING *classname)>
Returns whether the class is or inherits from C<*classname>.
=cut
*/
VTABLE INTVAL isa(STRING *classname) :no_wb {
PMC *want_class;
/* hard-code this one exception right away */
if (STRING_equal(INTERP, classname, CONST_STRING(INTERP, "Class")))
return 1;
want_class = Parrot_oo_get_class_str(INTERP, classname);
if (PMC_IS_NULL(want_class))
return 0;
if (SELF == want_class)
return 1;
else {
Parrot_Class_attributes * const _class = PARROT_CLASS(SELF);
const INTVAL num_classes = VTABLE_elements(INTERP, _class->all_parents);
int i;
for (i = 1; i < num_classes; ++i) {
PMC * const cur_class = VTABLE_get_pmc_keyed_int(INTERP,
_class->all_parents, i);
if (VTABLE_is_same(INTERP, want_class, cur_class))
return 1;
}
}
return 0;
}
/*
=item C<INTVAL does(STRING *role_name)>
Returns whether the class does the role with the given C<*role_name>.
=cut
*/
VTABLE INTVAL does(STRING *role_name) :no_wb {
Parrot_Class_attributes * const _class = PARROT_CLASS(SELF);
PMC * const role_list = _class->roles;
INTVAL i, count;
if (!role_list)
return 0;
count = VTABLE_elements(INTERP, role_list);
for (i = 0; i < count; ++i) {
PMC * const role = VTABLE_get_pmc_keyed_int(INTERP, role_list, i);
if (VTABLE_does(INTERP, role, role_name))
return 1;
}
/* Iterate over all the parents and check if they respond true
* for 'does' on the original comparison. */
count = VTABLE_elements(INTERP, _class->parents);
for (i = 0; i < count; ++i) {
PMC * const cur_class = VTABLE_get_pmc_keyed_int(INTERP,
_class->parents, i);
if (VTABLE_does(INTERP, cur_class, role_name))
return 1;
}
return VTABLE_isa(INTERP, SELF, role_name);
}
/*
=item C<INTVAL does_pmc(PMC *role)>
Returns whether the class does the given C<*role>.
=cut
*/
VTABLE INTVAL does_pmc(PMC *role) :no_wb {
Parrot_Class_attributes * const _class = PARROT_CLASS(SELF);
PMC * const role_list = _class->roles;
INTVAL i, role_count, count;
if (!role_list)
return 0;
role_count = VTABLE_elements(INTERP, role_list);
for (i = 0; i < role_count; ++i) {
PMC * const test_role = VTABLE_get_pmc_keyed_int(INTERP, role_list, i);
if (VTABLE_does_pmc(INTERP, test_role, role))
return 1;
}
/* Iterate over all the parents and check if they respond true
* for 'does' on the original comparison. */
count = VTABLE_elements(INTERP, _class->parents);
for (i = 0; i < count; ++i) {
PMC * const cur_class = VTABLE_get_pmc_keyed_int(INTERP,
_class->parents, i);
if (VTABLE_does_pmc(INTERP, cur_class, role))
return 1;
}
return VTABLE_isa_pmc(INTERP, SELF, role);
}
VTABLE INTVAL is_equal(PMC * p) :no_wb {
UNUSED(INTERP)
return p == SELF;
}
/*
=item C<INTVAL type()>
Returns the integer type of the class.
=cut
*/
VTABLE INTVAL type() :no_wb {
Parrot_Class_attributes * const _class = PARROT_CLASS(SELF);
UNUSED(INTERP)
return _class->id;
}
/*
=item C<void visit(PMC *info)>
This is used by freeze/thaw to visit the contents of the class.
C<*info> is the visit info, (see F<include/parrot/pmc_freeze.h>).
=cut
*/
VTABLE void visit(PMC *info) :no_wb {
/* 1) visit the attribute description hash */
VISIT_PMC_ATTR(INTERP, info, SELF, Class, attrib_metadata);
/* 2) visit list of parents */
VISIT_PMC_ATTR(INTERP, info, SELF, Class, parents);
/* 3) visit list of roles */
VISIT_PMC_ATTR(INTERP, info, SELF, Class, roles);
/* 4) visit hash of methods */
VISIT_PMC_ATTR(INTERP, info, SELF, Class, methods);
/* 5) visit hash of vtable overrides */
VISIT_PMC_ATTR(INTERP, info, SELF, Class, vtable_overrides);
/* 6) visit list of resolve methods */
VISIT_PMC_ATTR(INTERP, info, SELF, Class, resolve_method);
}
/*
=item C<void freeze(PMC *info)>
Used to archive the class.
=cut
*/
VTABLE void freeze(PMC *info) :no_wb {
Parrot_Class_attributes * const class_data = PARROT_CLASS(SELF);
STRING *serial_namespace = CONST_STRING(INTERP, "");
/* 1) freeze class id */
VTABLE_push_integer(INTERP, info, class_data->id);
/* 2) freeze class name */
VTABLE_push_string(INTERP, info, class_data->name);
/* 3) serialize namespace name, including HLL */
if (!PMC_IS_NULL(class_data->_namespace)) {
PMC * const names = Parrot_ns_get_name(INTERP,
class_data->_namespace);
if (!PMC_IS_NULL(names))
serial_namespace = Parrot_str_join(INTERP, CONST_STRING(INTERP, ";"), names);
}
VTABLE_push_string(INTERP, info, serial_namespace);
/* PARROT_GC_WRITE_BARRIER(INTERP, info); */
}
/*
=item C<void thaw(PMC *info)>
Used to unarchive the class.
=cut
*/
VTABLE void thaw(PMC *info) {
/* The class might already exist in the interpreter, so create it as an
* anonymous class and later decide whether to link it into the
* namespace. */
/* 1) thaw class id */
const INTVAL id = VTABLE_shift_integer(INTERP, info);
/* 2) thaw class name */
STRING * const name = VTABLE_shift_string(INTERP, info);
/* 3) deserialize namespace name, including HLL */
STRING * const serial_namespace = VTABLE_shift_string(INTERP, info);
STRING * const semicolon_str = CONST_STRING(INTERP, ";");
PMC * const namespace_array =
Parrot_str_split(INTERP, semicolon_str, serial_namespace);
PMC *ns = Parrot_ns_get_namespace_keyed(INTERP,
INTERP->root_namespace, namespace_array);
/* If the namespace doesn't exist, we create it, and initialize
* ourselves in it */
if (PMC_IS_NULL(ns)) {
ns = Parrot_ns_make_namespace_keyed(INTERP,
INTERP->root_namespace, namespace_array);
SELF.init_pmc(ns);
}
/* If the namespace exists already, we point to it, but otherwise
* act as an anonymous class. */
else {
SELF.init();
PARROT_CLASS(SELF)->_namespace = ns;
}
/* Set the class's short name to the frozen name */
PARROT_CLASS(SELF)->name = name;
/* Set the class's id the frozen id */
PARROT_CLASS(SELF)->id = id;
}
/*
=item C<INTVAL get_integer()>
This is just a temporary hack. Type ID numbers shouldn't be externally
visible to the average PIR user. However, we need this for now to interface
with functions like Parrot_pmc_new and pmc_reuse, which take type ID numbers still.
=cut
*/
VTABLE INTVAL get_integer() :no_wb {
UNUSED(INTERP)
return PARROT_CLASS(SELF)->id;
}
/*
=item C<void thawfinish(PMC *info)>
Called after the class has been thawed.
=cut
*/
VTABLE void thawfinish(PMC *info) :manual_wb {
Parrot_Class_attributes * const _class = PARROT_CLASS(SELF);
UNUSED(info)
/* Recalculate full MRO from thawed parents */
_class->all_parents = Parrot_ComputeMRO_C3(INTERP, SELF);
_class->parent_overrides = Parrot_pmc_new(INTERP, enum_class_Hash);
/* Rebuild attribute index from thawed attribute metadata */
build_attrib_index(INTERP, SELF); /* calls PARROT_GC_WRITE_BARRIER */
}
/* **********************************************************************
* Below here are methods that eventually will go in a role
* that is composed into here to optionally give a nice interface from
* PIR (ParrotClass isa Class does ClassMethods or something like this).
* **********************************************************************/
/*
=item C<void name(STRING *name :optional, int has_name :opt_flag)>
Sets the name of the class, and updates the namespace accordingly.
=cut
*/
METHOD name(STRING *name :optional, int has_name :opt_flag) :manual_wb {
Parrot_Class_attributes * const _class = PARROT_CLASS(SELF);
STRING *ret_name;
if (has_name) {
/* We'll build a hash just containing the name, then give this to
* init_class_from_hash - saves some code duplication. */
PMC * const naming_hash = Parrot_pmc_new(INTERP, enum_class_Hash);
STRING * const name_str = CONST_STRING(INTERP, "name");
VTABLE_set_string_keyed_str(INTERP, naming_hash, name_str, name);
init_class_from_hash(INTERP, SELF, naming_hash);
PARROT_GC_WRITE_BARRIER(INTERP, SELF);
}
ret_name = _class->name;
RETURN(STRING *ret_name);
}
/*
=item C<void get_namespace()>
Gets the namespace that this class is attached to.
=cut
*/
METHOD get_namespace(PMC *_namespace :optional, int has_name :opt_flag) :no_wb {
Parrot_Class_attributes * const _class = PARROT_CLASS(SELF);
PMC * const ret_namespace = _class->_namespace;
UNUSED(_namespace);
UNUSED(has_name);
RETURN(PMC *ret_namespace);
}
/*
=item C<void resolve_method()>
Sets the list of method names that the class provides to resolve conflicts in
methods from roles. When called with no parameter, returns the list.
=cut
*/
METHOD resolve_method(PMC *resolve_list :optional, int has_list :opt_flag) :manual_wb {
Parrot_Class_attributes * const _class = PARROT_CLASS(SELF);
PMC *ret_list;
/* Store list. */
if (has_list) {
_class->resolve_method = resolve_list;
PARROT_GC_WRITE_BARRIER(INTERP, SELF);
}
ret_list = _class->resolve_method;
RETURN(PMC *ret_list);
}
/*
=item C<void new(PMC *args :slurpy :named)>
Creates an instance of the object. Initializes any attributes specified in the
parameter list.
=cut
*/
METHOD new(PMC *args :slurpy :named) {
/* Check if any arguments are in the slurpy hash, don't pass an empty
* hash to instantiate */
PMC * const obj =
VTABLE_elements(INTERP, args) > 0
? VTABLE_instantiate(INTERP, SELF, args)
: VTABLE_instantiate(INTERP, SELF, PMCNULL);
RETURN(PMC *obj);
}
/*
=item C<void attributes()>
Return a hash where the keys are attribute names and the values are hashes
providing a set of key/value pairs describing the attribute.
=cut
*/
METHOD attributes() {
STRING * const attr_str = CONST_STRING(INTERP, "attributes");
PMC * const ret_attrib_metadata = SELF.inspect_str(attr_str);
RETURN(PMC *ret_attrib_metadata);
}
/*
=item C<void add_attribute()>
Add an attribute to the class. Requires a name and, optionally, a type.
=cut
*/
METHOD add_attribute(STRING *attribute_name,
PMC *attribute_type :optional, int has_type :opt_flag) {
PMC * const type = has_type ? attribute_type : PMCNULL;
SELF.add_attribute(attribute_name, type);
}
/*
=item C<void methods()>
Return a hash where the keys are method names and the values are methods.
=cut
*/
METHOD methods() :no_wb {
PMC * const ret_methods = SELF.inspect_str(CONST_STRING(INTERP, "methods"));
RETURN(PMC *ret_methods);
}
/*
=item C<void add_method(STRING *name, PMC *sub)>
Adds the given sub PMC as a method with the given name. Delegates to the
C<add_method> vtable.
=cut
*/
METHOD add_method(STRING *name, PMC *sub) :manual_wb {
SELF.add_method(name, sub);
}
/*
=item C<void add_vtable_override(STRING *name, PMC *sub)>
Adds the given sub PMC as a vtable override with the given name. Delegates to
the C<add_vtable_override> vtable.
=cut
*/
METHOD add_vtable_override(STRING *name, PMC *sub) :manual_wb {
VTABLE_add_vtable_override(INTERP, SELF, name, sub);
}
/*
=item C<void remove_method(STRING *name)>
Removes the method with the given name.
=cut
*/
METHOD remove_method(STRING *name) :manual_wb {
VTABLE_remove_method(INTERP, SELF, name);
}
/*
=item C<PMC *find_method(STRING *name)>
Walks the MRO of the class and finds the method with the given name.
=cut
*/
METHOD find_method(STRING *name) :no_wb {
Parrot_Class_attributes * const _class = PARROT_CLASS(SELF);
int i;
/* Walk and search. One day, we'll use the cache first. */
const int num_classes = VTABLE_elements(INTERP, _class->all_parents);
for (i = 0; i < num_classes; ++i) {
/* Get the class and see if it has the method. */
PMC * const cur_class =
VTABLE_get_pmc_keyed_int(INTERP, _class->all_parents, i);
const Parrot_Class_attributes * const class_info = PARROT_CLASS(cur_class);
/* Found it! */
if (VTABLE_exists_keyed_str(INTERP, class_info->methods, name)) {
PMC * const ret = VTABLE_get_pmc_keyed_str(INTERP, class_info->methods, name);
RETURN(PMC *ret);
}
}
RETURN(PMC *PMCNULL);
}
/*
=item C<void parents()>
Returns the parents array PMC.
=cut
*/
METHOD parents() :no_wb {
PMC * const ret_parents = SELF.inspect_str(CONST_STRING(INTERP, "parents"));
RETURN(PMC *ret_parents);
}
/*
=item C<void add_parent(PMC *parent)>
Adds the supplied PMC to the list of parents for the class.
=cut
*/
METHOD add_parent(PMC *parent) :manual_wb {
SELF.add_parent(parent);
}
/*
=item C<void roles()>
Returns the roles array PMC.
=cut
*/
METHOD roles() :no_wb {
PMC * const ret_roles = SELF.inspect_str(CONST_STRING(INTERP, "roles"));
RETURN(PMC *ret_roles);
}
/*
=item C<void add_role(PMC *role, PMC *exclude :optional :named("exclude"),
PMC *alias :optional :named("alias"))>
Composes a role into a class with the given exclusions and aliases.
=cut
*/
METHOD add_role(PMC *role,
PMC *exclude_method :optional :named("exclude_method"),
int has_exclude_method :opt_flag,
PMC *alias_method :optional :named("alias_method"),
int has_alias_method :opt_flag) {
Parrot_Class_attributes * const _class = PARROT_CLASS(SELF);
/* Add everything on the resolve list to the exclude list; if we have
* no exclude list, pass along the resolve list in its place if it has
* any methods listed in it. */
if (!has_exclude_method) {
if (VTABLE_elements(INTERP, _class->resolve_method) != 0) {
exclude_method = _class->resolve_method;
has_exclude_method = 1;
}
}
else {
const int resolve_count = VTABLE_elements(INTERP, _class->resolve_method);
int i;
for (i = 0; i < resolve_count; ++i) {
STRING * const meth_name = VTABLE_get_string_keyed_int(INTERP,
_class->resolve_method, i);
VTABLE_push_string(INTERP, exclude_method, meth_name);
}
}
/* Do the composition. */
Parrot_ComposeRole(INTERP, role, exclude_method, has_exclude_method,
alias_method, has_alias_method,
_class->methods, _class->roles);
}
/*
=item C<void inspect(STRING *what :optional)>
Gets all introspection data for the class or, if the optional string
parameter is supplied, a particular item of introspection data.
=cut
*/
METHOD inspect(STRING *what :optional, int has_what :opt_flag) :no_wb {
PMC *found;
/* Just delegate to the appropriate vtable. */
if (has_what)
found = SELF.inspect_str(what);
else
found = SELF.inspect();
RETURN(PMC *found);
}
/*
=item C<void isa(STRING *class_name)>
Returns true if this object is or derives from the class named in
C<class_name>, false otherwise.
=cut
*/
METHOD isa(STRING *class_name) :no_wb {
const INTVAL isa = SELF.isa(class_name);
RETURN(INTVAL isa);
}
/*
=item C<void does(STRING *role_name)>
Returns true if this object or one of its parents performs the named role,
false otherwise.
=cut
*/
METHOD does(STRING *role_name) :no_wb {
const INTVAL does = VTABLE_does(INTERP, SELF, role_name);
RETURN(INTVAL does);
}
METHOD clear_method_cache() {
Parrot_Class_attributes * const attrs = PARROT_CLASS(SELF);
PMC * const cache = attrs->meth_cache;
if (cache)
attrs->meth_cache = PMCNULL;
}
METHOD get_method_cache() :no_wb {
Parrot_Class_attributes * const attrs = PARROT_CLASS(SELF);
PMC * cache = attrs->meth_cache;
if (!cache) {
cache = Parrot_pmc_new(INTERP, enum_class_Hash);
attrs->meth_cache = cache;
}
RETURN(PMC *cache);
}
} /* END pmclass */
/*
=back
=head1 SEE ALSO
F<docs/pdds/pdd15_objects.pod>.
=cut
*/
/*
* Local variables:
* c-file-style: "parrot"
* End:
* vim: expandtab shiftwidth=4 cinoptions='\:2=2' :
*/
Jump to Line
Something went wrong with that request. Please try again.