super.pmc

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

=head1 NAME

src/pmc/super.pmc - Super Class

=head1 DESCRIPTION

A Super PMC holds an object and redirects method lookup to the parent
of the object's class.

=head1 SYNOPSIS

  .sub meth :method
      .local pmc s
      s = new 'Super', self
      s."meth"()
  .end

=head2 Methods

=over 4

=cut

*/

#include "parrot/parrot.h"

pmclass Super need_ext {

/*

=item C<void init(PMC *obj)>

Create an unbound super instance.

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

Initialize a new super instance, bound to the C<obj>.

=item C<void set_pmc(PMC *obj)>

Bind the object C<obj> to this Super instance.

=item C<PMC *get_pmc(void)>

Return the bound object.

=item C<void mark()>

Set the bound object live.

=item C<PMC *find_method(STRING *name)>

Find the method for C<*name> in the parent class of the bound object.

=cut

*/

    VTABLE void init() {
        PMC_pmc_val(SELF)    = PMCNULL;
        PMC_struct_val(SELF) = PMCNULL;
    }

    VTABLE void init_pmc(PMC *obj) {
        PMC_struct_val(SELF) = PMCNULL;
        SELF.set_pmc(obj);
    }

    VTABLE void set_pmc(PMC *obj) {
        PMC *mro, *classobj;
        PMC_pmc_val(SELF) = obj;

        if (PMC_IS_NULL(obj))
            return;

        if (PObj_is_object_TEST(obj)) {
            classobj = VTABLE_get_class(interp, obj);
            if (PMC_IS_NULL(classobj))
                return;
            mro = VTABLE_inspect_str(interp, classobj, CONST_STRING(interp, "all_parents"));
        }
        else {
            mro = obj->vtable->mro;
        }

        if (PMC_IS_NULL(mro))
            return;

        if (VTABLE_elements(INTERP, mro) <= 1)
            real_exception(INTERP, NULL, E_TypeError, "object has no parent");

        PObj_custom_mark_SET(SELF);
    }

    VTABLE PMC *get_pmc() {
        return PMC_pmc_val(SELF);
    }


    VTABLE void mark() {
        if (PMC_pmc_val(SELF))
            pobject_lives(INTERP, (PObj *)PMC_pmc_val(SELF));
        if (PMC_struct_val(SELF))
            pobject_lives(INTERP, (PObj *)PMC_struct_val(SELF));
    }

    VTABLE PMC *find_method(STRING *name) {
        PMC *mro, *classobj, *parent_class, *parent_methods;
        PMC *method = PMCNULL;

        PMC * const obj = PMC_pmc_val(SELF);

        if (PMC_IS_NULL(obj))
            real_exception(INTERP, NULL, E_TypeError,
                "no object bound to super");

        classobj = VTABLE_get_class(interp, obj);

        mro = VTABLE_inspect_str(interp, classobj, CONST_STRING(interp, "all_parents"));

        parent_class = VTABLE_get_pmc_keyed_int(INTERP, mro, 1);
        parent_methods = VTABLE_inspect_str(interp, parent_class, CONST_STRING(interp, "methods"));

        if (VTABLE_exists_keyed_str(interp, parent_methods, name)) {
            method = VTABLE_get_pmc_keyed_str(interp, parent_methods,
                name);
        }

        return method;
    }
}

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