class.pmc

/*
Copyright (C) 2001-2007, The Perl Foundation.
$Id$

=head1 NAME

src/pmc/class.pmc - defines a class

=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 Role PMC structure (C<Parrot_Role>) consists of five items:

=over 4

=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 MRO order.
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_methods>

A directory of vtable method 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/parrot.h"
#include "pmc_namespace.h"
#include "classobject.h"

/* Build a string representing the fully qualified class name. */
STRING* Parrot_Class_get_fq_classname(Parrot_Interp interp, Parrot_Class *class_info) {
    STRING *fq_class = string_from_cstring(interp, "", 0);
    STRING *seperator = string_from_const_cstring(interp, "::", 0);
    if (!PMC_IS_NULL(class_info->namespace)) {
        /* If we have a namespace name, make a key from its name. */
        /* XXX BAD AND WRONG! Need to call get_name method properly! */
        PMC *fq_name = Parrot_NameSpace_nci_get_name(interp, class_info->namespace);
        int elements = VTABLE_elements(interp, fq_name);
        int j;
        for (j = 0; j < elements; j++) {
            /* Append to class name. */
            fq_class = string_append(interp, fq_class,
                VTABLE_get_string_keyed_int(interp, fq_name, j));
            fq_class = string_append(interp, fq_class, seperator);
        }
    } else if (class_info->name != NULL) {
        /* If we don't have a namespace but we do have a name,
         * use that. XXX Is this sensible? */
        fq_class = string_copy(interp, class_info->name);
    }
    return fq_class;
}


/* This function builds the attribute index (table to map class name and
 * attribute name to an index) for the current class. */
static void build_attrib_index(Parrot_Interp interp, PMC *self) {
    Parrot_Class *class = PARROT_CLASS(self);
    int num_classes = VTABLE_elements(interp, class->all_parents);
    int i;
    int cur_index = 0;
    PMC *table = pmc_new(interp, enum_class_Hash);

    /* We will go over the list of all parents to construct the table. */
    for (i = 0; i < num_classes; i++) {
       /* Get the class and its attribute metadata hash. */
        PMC *cur_class = VTABLE_get_pmc_keyed_int(interp, class->all_parents, i);
        Parrot_Class *class_info = PARROT_CLASS(cur_class);
        PMC *attribs = class_info->attrib_metadata;
        PMC *iter = VTABLE_get_iter(interp, attribs);

        /* Build a string representing the fully qualified class name. */
        STRING *fq_class = Parrot_Class_get_fq_classname(interp, class_info);

        /* Iterate over the attributes. */
        while (VTABLE_get_bool(interp, iter)) {
            /* Get attribute. */
            PMC *cur_attrib = VTABLE_get_pmc_keyed_str(interp, attribs,
                VTABLE_shift_string(interp, iter));
            STRING *attrib_name;
            STRING *full_key = string_copy(interp, fq_class);

            /* Get attribute name and append it to the key. */
            attrib_name = VTABLE_get_string_keyed_str(interp, cur_attrib,
                string_from_const_cstring(interp, "name", 0));
            full_key = string_append(interp, full_key, attrib_name);

            /* Insert into hash, along with index. */
            VTABLE_set_integer_keyed_str(interp, table, full_key, cur_index);
            cur_index++;
        }
    }

    /* Store built table and invalidate cache. */
    class->attrib_index = table;
    class->attrib_cache = pmc_new(interp, enum_class_Hash);
}


/* Takes a hash and initializes the class based on it. */
static void init_class_from_hash(Parrot_Interp interp, PMC *self, PMC *info)
{
    Parrot_Class *class = PARROT_CLASS(self);
    int have_name, have_ns;
    PMC *old_ns;
    int i;

    /* Ensure we actually have some initialization info. */
    if (PMC_IS_NULL(info))
        return;

    /* Check if we have a name and/or a namespace. */
    have_name = VTABLE_exists_keyed_str(interp, info,
        string_from_const_cstring(interp, "name", 0));
    have_ns = VTABLE_exists_keyed_str(interp, info,
        string_from_const_cstring(interp, "namespace", 0));

    /* Take a copy of the current namespace the class is attached to. */
    old_ns = class->namespace;

    /* Otherwise, let's roll! If we have a namespace and a name, set both. */
    if (have_name && have_ns) {
        /* If we weren't passed a NameSpace PMC, assume it's something we have
         * to look one up with and do so. */
        PMC *namespace = VTABLE_get_pmc_keyed_str(interp, info,
            string_from_const_cstring(interp, "namespace", 0));
        if (!VTABLE_isa(interp, namespace, string_from_const_cstring(interp, "NameSpace", 0)))
            namespace = Parrot_make_namespace_autobase(interp, namespace);

        /* If we get something null back it's an error; otherwise, store it. */
        if (!PMC_IS_NULL(namespace))
            class->namespace = namespace;
        else
            real_exception(interp, NULL, E_NameError, "Namespace not found");

        /* Set a (string) name. */
        class->name = VTABLE_get_string_keyed_str(interp, info,
            string_from_const_cstring(interp, "name", 0));
    }

    /* Otherwise, we may just have a name. */
    else if (have_name) {
        /* Set the name. */
        class->name = VTABLE_get_string_keyed_str(interp, info,
            string_from_const_cstring(interp, "name", 0));

        /* Namespace is nested in the current namespace and with the name of
         * the class. */
        class->namespace = Parrot_make_namespace_keyed_str(interp,
            CONTEXT(interp->ctx)->current_namespace, class->name);
    }

    /* Otherwise, we may just have a namespace. */
    else if (have_ns) {
        /* If we weren't passed a NameSpace PMC, assume it's something we have
         * to look one up with and do so. */
        PMC *namespace = VTABLE_get_pmc_keyed_str(interp, info,
            string_from_const_cstring(interp, "namespace", 0));
        if (!VTABLE_isa(interp, namespace, string_from_const_cstring(interp, "NameSpace", 0)))
            namespace = Parrot_make_namespace_autobase(interp, namespace);

        /* If we get something null back it's an error; otherwise, store it. */
        if (!PMC_IS_NULL(namespace))
            class->namespace = namespace;
        else
            real_exception(interp, NULL, E_NameError, "Namespace not found");

        /* Name is that of the most nested part of the namespace. */
        class->name = VTABLE_get_string(interp, namespace);
    }

    /* If we were attached to a namespce 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_PCCINVOKE(interp, old_ns,
            string_from_const_cstring(interp, "set_class", 0),
            "P->", PMCNULL);

    /* Link namespace to this class, if there is one. */
    if (!PMC_IS_NULL(class->namespace))
        Parrot_PCCINVOKE(interp, class->namespace,
            string_from_const_cstring(interp, "set_class", 0),
            "P->", self);

    /* Initialize resolve_method. */
    if (VTABLE_exists_keyed_str(interp, info,
        string_from_const_cstring(interp, "resolve_method", 0))) {
        /* Set it. */
        class->resolve_method = VTABLE_get_pmc_keyed_str(interp, info,
            string_from_const_cstring(interp, "resolve_method", 0));
    }

    /* Initialize parents, if we have any. */
    if (VTABLE_exists_keyed_str(interp, info,
        string_from_const_cstring(interp, "parents", 0))) {
        /* Loop over parents array and add them. */
        PMC *parent_list = VTABLE_get_pmc_keyed_str(interp, info,
            string_from_const_cstring(interp, "parents", 0));
        int parent_count = VTABLE_elements(interp, parent_list);
        for (i = 0; i < parent_count; i++) {
            PMC *parent = VTABLE_get_pmc_keyed_int(interp, parent_list, i);
            VTABLE_add_parent(interp, self, parent);
        }
    }

    /* Initialize roles, if we have any. */
    if (VTABLE_exists_keyed_str(interp, info,
        string_from_const_cstring(interp, "roles", 0))) {
        /* Loop over roles array and compose them. */
        PMC *role_list = VTABLE_get_pmc_keyed_str(interp, info,
            string_from_const_cstring(interp, "roles", 0));
        int role_count = VTABLE_elements(interp, role_list);
        for (i = 0; i < role_count; i++) {
            PMC *role = VTABLE_get_pmc_keyed_int(interp, role_list, i);
            VTABLE_add_role(interp, self, role);
        }
    }

    /* Initialize attributes, if we have any. */
    if (VTABLE_exists_keyed_str(interp, info,
        string_from_const_cstring(interp, "attributes", 0))) {
        /* Loop over attributes array and add them. */
        PMC *attrib_name_list = VTABLE_get_pmc_keyed_str(interp, info,
            string_from_const_cstring(interp, "attributes", 0));
        int attrib_count = VTABLE_elements(interp, attrib_name_list);
        for (i = 0; i < attrib_count; i++) {
            STRING *attrib_name = VTABLE_get_string_keyed_int(interp,
                attrib_name_list, i);
            VTABLE_add_attribute(interp, self, attrib_name, PMCNULL);
        }
    }

    /* Initialize methods. */
    if (VTABLE_exists_keyed_str(interp, info,
        string_from_const_cstring(interp, "methods", 0))) {
        /* Get the methods hash. */
        PMC *methods = VTABLE_get_pmc_keyed_str(interp, info,
            string_from_const_cstring(interp, "methods", 0));

        /* Iterate over the list of methods. */
        PMC *iter = VTABLE_get_iter(interp, methods);
        while (VTABLE_get_bool(interp, iter)) {
            /* Add the method. */
            STRING *method_name = VTABLE_shift_string(interp, iter);
            PMC *method_pmc = VTABLE_get_pmc_keyed_str(interp, methods, method_name);
            VTABLE_add_method(interp, self, method_name, method_pmc);
        }
    }
}


/*

=back

=head2 Functions

=over 4

=cut

*/

pmclass Class
    need_ext {


/*

=item C<void init()>

Initializes a Class PMC.

=item C<void init_pmc(PMC *name)>

The actual class creation code, called from C<newclass> opcode.
The C<init> argument must stringify to the name of the class.
The class is attatched to the current namespace.

=cut

*/

    void init() {
        Parrot_Class *class = NULL;

        /* Set flags for custom DOD mark and destroy. */
        PObj_custom_mark_SET(SELF);
        PObj_active_destroy_SET(SELF);

        /* We are a class. */
        PObj_is_class_SET(SELF);

        /* Set up the object. */
        class                  = mem_sys_allocate_zeroed(sizeof(Parrot_Class));
        class->name            = CONST_STRING(interp, "");
        class->namespace       = PMCNULL;
        class->instantiated    = 0;
        class->parents         = pmc_new(interp, enum_class_ResizablePMCArray);
        class->all_parents     = pmc_new(interp, enum_class_ResizablePMCArray);
        class->roles           = pmc_new(interp, enum_class_ResizablePMCArray);
        class->methods         = pmc_new(interp, enum_class_Hash);
        class->vtable_methods  = pmc_new(interp, enum_class_Hash);
        class->attrib_metadata = pmc_new(interp, enum_class_Hash);
        class->attrib_index    = PMCNULL;
        class->attrib_cache    = PMCNULL;
        class->resolve_method  = pmc_new(interp, enum_class_ResizablePMCArray);

        /* We put ourself on the all parents list. */
        VTABLE_push_pmc(interp, class->all_parents, SELF);

        PMC_data(SELF)         = class;
    }

    void init_pmc(PMC* init_data) {
        Parrot_Class *class = NULL;

        /* Set up the object. */
        SELF.init();

        /* Initialize the class with the supplied data. */
        init_class_from_hash(interp, SELF, init_data);
    }


/*

=item C<void destroy()>

Free the memory associated with the object's underlying struct.

=cut

*/

    void destroy() {
            mem_sys_free(PMC_data(SELF));
    }


/*

=item C<void mark()>

Mark any referenced strings and PMCs in the structure as live.

=cut

*/

    void mark() {
        Parrot_Class *class = PARROT_CLASS(SELF);
        if (class->name)
            pobject_lives(interp, (PObj*)class->name);
        if (class->namespace)
            pobject_lives(interp, (PObj*)class->namespace);
        if (class->parents)
            pobject_lives(interp, (PObj*)class->parents);
        if (class->all_parents)
            pobject_lives(interp, (PObj*)class->all_parents);
        if (class->roles)
            pobject_lives(interp, (PObj*)class->roles);
        if (class->methods)
            pobject_lives(interp, (PObj*)class->methods);
        if (class->vtable_methods)
            pobject_lives(interp, (PObj*)class->vtable_methods);
        if (class->attrib_metadata)
            pobject_lives(interp, (PObj*)class->attrib_metadata);
        if (class->attrib_index)
            pobject_lives(interp, (PObj*)class->attrib_index);
        if (class->attrib_cache)
            pobject_lives(interp, (PObj*)class->attrib_cache);
        if (class->resolve_method)
            pobject_lives(interp, (PObj*)class->resolve_method);
    }


/*

=item C<void add_attribute(STRING *name, PMC *type)>

Adds the given attribute (C<name>) with an optional C<type>.
Creates a new class if the current class has been instantiated.
Enters the attribute in the C<attributes> array.
Returns an error if an attribute of C<name> already exists.

=cut

*/

    void add_attribute(STRING *name, PMC *type)
    {
        Parrot_Class *class = PARROT_CLASS(SELF);
        PMC *new_attribute = pmc_new(interp, enum_class_Hash);

        /* If we've been instantiated already, need a new class. */
        if (class->instantiated) {
            /* XXX Unimplemented! */
            real_exception(interp, NULL, E_NotImplementedError,
                "Modifications to already instantiated classes not allowed yet.");
        }

        /* If we've already got an attribute of this name, it's an error. */
        if (VTABLE_exists_keyed_str(interp, class->attrib_metadata, name)) {
            real_exception(interp, NULL, INVALID_OPERATION,
                "An attribute of this name already exists.");
        }

        /* 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 attributes array. */
        VTABLE_set_pmc_keyed_str(interp, class->attrib_metadata, name, new_attribute);
    }

/*

=item C<void add_method(STRING *name, PMC *sub)>

Adds the given sub PMC as a method with the given name.

=cut

*/
    void add_method(STRING *name, PMC *sub)
    {
        Parrot_Class *class = PARROT_CLASS(SELF);

        /* If we have already added a method with this name... */
        if (VTABLE_exists_keyed_str(interp, class->methods, name)) {
            /* XXX Need to handle multi methods here. */
            real_exception(interp, NULL, E_NotImplementedError,
                "A method of this name already exists. It may have been supplied by a role.");
        }
        else {
            /* Enter it into the table. */
            VTABLE_set_pmc_keyed_str(interp, class->methods, name, sub);
        }
    }

/*

=item C<void add_parent(PMC *parent)>

Adds the supplied PMC to the list of parents for the class.

=cut

*/
    void add_parent(PMC *parent)
    {
        Parrot_Class *class = PARROT_CLASS(SELF);

        /* If we've been instantiated already, need a new class. */
        if (class->instantiated) {
            /* XXX Unimplemented! */
            real_exception(interp, NULL, E_NotImplementedError,
                "Modifications to already instantiated classes not allowed yet.");
            return;
        }

        /* Ensure it really is a class. */
        if (!PObj_is_class_TEST(parent)) {
            real_exception(interp, NULL, E_TypeError,
                "You can only add a class as a parent to another class.");
            return;
        }

        /* XXX Check we don't already have this parent. */

        /* Add to the list of our immediate parents. */
        VTABLE_push_pmc(interp, class->parents, parent);
    }

/*

=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

*/
    void add_role(PMC *role)
    {
        Parrot_Class *class = PARROT_CLASS(SELF);

        /* Do the composition. */
        Parrot_ComposeRole(interp, role, PMCNULL, 0, 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 namespce

NameSpace PMC of the the namespace attached to the class

=item attributes

Hash keyed on attribute name, value is 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

*/
    PMC* inspect_str(STRING *what)
    {
        Parrot_Class *class = PARROT_CLASS(SELF);

        /* What should we return? */
        PMC *found;
        if (string_equal(interp, what, CONST_STRING(interp, "name")) == 0) {
            found = pmc_new(interp, enum_class_String);
            VTABLE_set_string_native(interp, found, class->name);
        }
        else if (string_equal(interp, what, CONST_STRING(interp, "namespace")) == 0) {
            /* Should not clone this. */
            return class->namespace;
        }
        else if (string_equal(interp, what, CONST_STRING(interp, "attributes")) == 0) {
            found = class->attrib_metadata;
        }
        else if (string_equal(interp, what, CONST_STRING(interp, "methods")) == 0) {
            found = class->methods;
        }
        else if (string_equal(interp, what, CONST_STRING(interp, "parents")) == 0) {
            found = class->parents;
        }
        else if (string_equal(interp, what, CONST_STRING(interp, "roles")) == 0) {
            found = class->roles;
        }
        else {
            real_exception(interp, NULL, INVALID_OPERATION,
                "Unknown introspection value '%S'", what);
        }

        /* Clone and return. */
        return PMC_IS_NULL(found) ? PMCNULL : VTABLE_clone(interp, found);
    }

/*

=item C<PMC* inspect()>

Returns a Hash describing the class, with key/value pairs as described in
inspect_str.

=cut

*/
    PMC* inspect()
    {
        /* Create a hash, then use inspect_str to get all of the data to
         * fill it up with. */
        PMC *metadata = pmc_new(interp, enum_class_Hash);
        VTABLE_set_pmc_keyed_str(interp, metadata, CONST_STRING(interp, "name"),
            VTABLE_inspect_str(interp, SELF, CONST_STRING(interp, "name")));
        VTABLE_set_pmc_keyed_str(interp, metadata, CONST_STRING(interp, "namespace"),
            VTABLE_inspect_str(interp, SELF, CONST_STRING(interp, "namespace")));
        VTABLE_set_pmc_keyed_str(interp, metadata, CONST_STRING(interp, "attributes"),
            VTABLE_inspect_str(interp, SELF, CONST_STRING(interp, "attributes")));
        VTABLE_set_pmc_keyed_str(interp, metadata, CONST_STRING(interp, "methods"),
            VTABLE_inspect_str(interp, SELF, CONST_STRING(interp, "methods")));
        VTABLE_set_pmc_keyed_str(interp, metadata, CONST_STRING(interp, "parents"),
            VTABLE_inspect_str(interp, SELF, CONST_STRING(interp, "parents")));
        VTABLE_set_pmc_keyed_str(interp, metadata, CONST_STRING(interp, "roles"),
            VTABLE_inspect_str(interp, SELF, CONST_STRING(interp, "roles")));
        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

*/

    PMC* clone()
    {
        Parrot_Class *class = PARROT_CLASS(SELF);

        /* Create the new class PMC, of the same type of this one (we may
         * have been subclassed). */
        PMC *copy = pmc_new(interp, SELF->vtable->base_type);

        /* 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 *new_class = PARROT_CLASS(copy);
        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_methods = VTABLE_clone(interp, class->vtable_methods);
        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

*/

    PMC* clone_pmc(PMC *args)
    {
        /* Do the standard clone. */
        PMC *copy = DYNSELF.clone();

        /* Initialize it with the supplied arguments. */
        init_class_from_hash(interp, copy, args);

        /* Return cloned class. */
        return copy;
    }

    /* **********************************************************************
     * Below here are non-vtable 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 got_name :opt_flag)>

Sets the name of the class, and updates the namespace accoringly.

=cut

*/
    PCCMETHOD void name(STRING *name :optional, int got_name :opt_flag) {
        Parrot_Class *class = PARROT_CLASS(SELF);
        STRING *ret_name = NULL;

        if (got_name) {
            /* We'll build a hash just containing the name, then give this to
             * init_class_from_hash - saves some code duplication. */
            PMC *naming_hash = pmc_new(interp, enum_class_Hash);
            VTABLE_set_string_keyed_str(interp, naming_hash,
                CONST_STRING(interp, "name"), name);
            init_class_from_hash(interp, SELF, naming_hash);
        }

        ret_name = class->name;
        PCCRETURN(STRING *ret_name);
    }

/*

=item C<void namespace()>

Gets the namespace that this class is attached to.

=cut

*/
    PCCMETHOD void namespace(PMC *namespace :optional, int got_name :opt_flag) {
        Parrot_Class *class = PARROT_CLASS(SELF);
        PMC *ret_namespace = class->namespace;
        PCCRETURN(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

*/
    PCCMETHOD void resolve_method(PMC *resolve_list :optional, int got_list :opt_flag) {
        Parrot_Class *class = PARROT_CLASS(SELF);
        PMC *ret_list = NULL;

        if (got_list) {
            /* Store list. */
            class->resolve_method = resolve_list;
        }

        ret_list = class->resolve_method;
        PCCRETURN(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

*/
    PCCMETHOD void new(PMC *args :slurpy :named) {
        Parrot_Class *class = PARROT_CLASS(SELF);
        PMC *obj;
        PMC *iter;
        Parrot_Object *obj_guts = NULL;

        /* If we've not been instantiated before... */
        if (!class->instantiated) {
            /* Check that we have all methods listed in resolve list. */
            int resolve_count = VTABLE_elements(interp, class->resolve_method);
            int i;
            for (i = 0; i < resolve_count; i++) {
                STRING *check_meth = VTABLE_get_string_keyed_int(interp,
                    class->resolve_method, i);
                if (!VTABLE_exists_keyed_str(interp, class->methods, check_meth)) {
                    real_exception(interp, NULL, METH_NOT_FOUND,
                        "The method '%S' was named in the resolve list, but not supplied",
                        check_meth);
                }
            }

            /* Build full parents list.
             * XXX Need pluggable MRO, for now always do C3. */
            class->all_parents = Parrot_ComputeMRO_C3(interp, SELF);

            /* Build attributes index. */
            build_attrib_index(interp, SELF);
            if (PMC_IS_NULL(class->attrib_index))
                return;
        }

        /* Set instantiated flag. */
        class->instantiated = 1;

        /* Create object. */
        obj = pmc_new_noinit(interp, enum_class_Object);

        /* Set custom DOD mark and destroy on the object. */
        PObj_custom_mark_SET(obj);
        PObj_active_destroy_SET(obj);

        /* Initialize the object's underlying structure, pointing it to this
         * class. */
        obj_guts = mem_sys_allocate_zeroed(sizeof(Parrot_Object));
        obj_guts->class = SELF;
        obj_guts->attrib_store = pmc_new(interp, enum_class_ResizablePMCArray);
        PMC_data(obj) = obj_guts;

        /* Initialize attributes with the supplied values. */
        iter = VTABLE_get_iter(interp, args);
        while (VTABLE_get_bool(interp, iter)) {
            /* Get name and value. */
            STRING *attr_name = VTABLE_shift_string(interp, iter);
            PMC *attr_value = VTABLE_get_pmc_keyed_str(interp, args, attr_name);

            /* Set the attribute. */
            VTABLE_set_attr_str(interp, obj, attr_name, attr_value);
        }

        PCCRETURN(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

*/
    PCCMETHOD void attributes() {
        PMC *ret_attrib_metadata = VTABLE_inspect_str(interp, SELF,
            CONST_STRING(interp, "attributes"));
        PCCRETURN(PMC *ret_attrib_metadata);
    }

/*

=item C<void add_attribute()>

Add an attribute to the class. Requires a name and, optionally, a type.

=cut

*/
    PCCMETHOD void add_attribute(STRING *attribute_name,
            PMC* attribute_type :optional, int got_type :opt_flag) {
        VTABLE_add_attribute(interp, SELF, attribute_name,
            got_type ? attribute_type : PMCNULL);
    }

/*

=item C<void methods()>

Return a hash where the keys are method names and the values are methods.

=cut

*/
    PCCMETHOD void methods() {
        PMC *ret_methods = VTABLE_inspect_str(interp, SELF,
            CONST_STRING(interp, "methods"));
        PCCRETURN(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 method.

=cut

*/
    PCCMETHOD void add_method(STRING *name, PMC *sub)
    {
        VTABLE_add_method(interp, SELF, name, sub);
    }

/*

=item C<void parents()>

Return the parents array PMC.

=cut

*/
    PCCMETHOD void parents() {
        PMC *ret_parents = VTABLE_inspect_str(interp, SELF,
            CONST_STRING(interp, "parents"));
        PCCRETURN(PMC *ret_parents);
    }

/*

=item C<void add_parent(PMC *parent)>

Adds the supplied PMC to the list of parents for the class.

=cut

*/
    PCCMETHOD void add_parent(PMC *parent) {
        VTABLE_add_parent(interp, SELF, parent);
    }

/*

=item C<void roles()>

Return the roles array PMC.

=cut

*/
    PCCMETHOD void roles() {
        PMC *ret_roles = VTABLE_inspect_str(interp, SELF,
            CONST_STRING(interp, "roles"));
        PCCRETURN(PMC *ret_roles);
    }

/*

=item C<void add_role(PMC* role, PMC* exclude :optional :named["exclude"],
PMC* alias :optional :named["alias"])>

Compose a role into a class with the given exclusions and aliases.

=cut

*/
    PCCMETHOD void add_role(PMC* role,
            PMC* exclude_method :optional :named["exclude_method"],
            int got_exclude_method :opt_flag,
            PMC* alias_method :optional :named["alias_method"],
            int got_alias_method :opt_flag) {
        Parrot_Class *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 (!got_exclude_method) {
            if (VTABLE_elements(interp, class->resolve_method) != 0) {
                exclude_method = class->resolve_method;
                got_exclude_method = 1;
            }
        }
        else {
            int resolve_count = VTABLE_elements(interp, class->resolve_method);
            int i;
            for (i = 0; i < resolve_count; i++) {
                STRING *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, got_exclude_method,
                           alias_method, got_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

*/
    PCCMETHOD void inspect(STRING *what :optional, int got_what :opt_flag) {
        PMC *found;

        /* Just delegate to the appropriate vtable method. */
        if (got_what)
            found = VTABLE_inspect_str(interp, SELF, what);
        else
            found = VTABLE_inspect(interp, SELF);

        PCCRETURN(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

*/
    PCCMETHOD void isa(STRING *class_name) {
        INTVAL isa = VTABLE_isa(interp, SELF, class_name);

        PCCRETURN(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

*/
    PCCMETHOD void does(STRING *role_name) {
        INTVAL i, role_count;
        PMC *role_list = ((Parrot_Class *)PMC_data(SELF))->roles;

        /* not a coding standards violation; the macro expands greatly! */
        if (!role_list) {
            PCCRETURN(INTVAL 0);
        }

        role_count = VTABLE_elements(interp, role_list);

        for (i = 0; i < role_count; i++) {
            STRING *r_name;
            PMC    *role     = VTABLE_get_pmc_keyed_int(interp, role_list, i);
            (STRING *r_name) = PCCINVOKE(interp, role, "name");

            if (string_compare(interp, role_name, r_name))
                PCCRETURN(INTVAL 1);
        }

        PCCRETURN(INTVAL 0);
    }
} /* END pmclass */

/*

=back

=head1 SEE ALSO

F<docs/pdds/pdd15_objects.pod>.

=cut

*/

/*
 * Local variables:
 *   c-file-style: "parrot"
 * End:
 * vim: expandtab shiftwidth=4:
 */