/*
Copyright (C) 2006-2008, The Perl Foundation.
$Id: /mirror/trunk/languages/lua/src/pmc/luaany.pmc 34462 2008-12-27T17:23:27.572097Z fperrad  $

=head1 NAME

pmc/luaany.pmc - Lua abstract base class

=head1 DESCRIPTION

C<LuaAny> provides an abstract base class for some Lua types.

=head2 PMC Inheritance Summary

 Class                  Parents
 -----------------------------------------------
 LuaBoolean             LuaAny, Default
 LuaFunction            Sub, LuaAny, Default
 LuaNil                 LuaAny, Default
 LuaNumber              LuaAny, Default
 LuaString              LuaAny, Default
 LuaTable               LuaAny, Default
 LuaThread              LuaAny, Default
 LuaUserdata            LuaAny, Default

=head2 PMC "Attribute" Summary

 Class                  Metatable       Environment     Userdata
     accessor           get_metatable   getfenv         get_attr_str (getattribute)
     mutator            set_metatable   setfenv         set_attr_str (setattribute)
     default value      nil             nil             NULL
 ------------------------------------------------------------------
 LuaBoolean             nil             -               -
 LuaFunction            nil             yes             -
 LuaNil                 nil             -               -
 LuaNumber              nil             -               -
 LuaString              yes (common)    -               -
 LuaTable               yes             -               -
 LuaThread              nil             yes             -
 LuaUserdata            yes             yes             yes

The metatable supports the OO mecanism.

=head2 Methods

=over 4

=cut

*/

#include "lua_private.h"


PMC *
find_meth(PARROT_INTERP, PMC *obj, const char *name) {
    PMC   *meta = NULL;
    INTVAL type = PMC_type(obj);

    if (dynpmc_LuaString == type) {
        meta = Parrot_find_global_s(interp,
                                    const_string(interp, "string"),
                                    const_string(interp, "mt_string"));
    }

    if (dynpmc_LuaFunction != type) {
        if (obj->pmc_ext)
            meta = PMC_metadata(obj);

        if (meta && dynpmc_LuaTable != PMC_type(meta))
            return meta;
    }

    if (meta) {
        PMC *method;
        PMC *key = pmc_new(interp, dynpmc_LuaString);
        VTABLE_set_string_native(interp, key, const_string(interp, name));

        method = VTABLE_get_pmc_keyed(interp, meta, key);

        if (dynpmc_LuaNil != PMC_type(method))
            return method;
    }

    return NULL;
}


pmclass LuaAny
    abstract
    dynpmc
    group lua_group
    hll lua {
/*

=item C<void morph(INTVAL type)>

Changes the PMC to a PMC of a new type

=cut

*/
    VTABLE void morph(INTVAL type) {
        if (PMC_type(SELF) == type)
            return;
        pmc_reuse(INTERP, SELF, type, 0);
    }

/*

=item C<INTVAL get_bool()>

Returns C<true>.

=cut

*/
    VTABLE INTVAL get_bool() {
        return (INTVAL)1;
    }

/*

=item C<void *get_pointer()>

Returns the address of the PMC.

=cut

*/
    VTABLE void* get_pointer() {
        return SELF;
    }

/*

=item C<void assign_pmc(PMC *value)>

=cut

*/
    VTABLE void assign_pmc(PMC *value) {
        VTABLE_morph(INTERP, SELF, PMC_type(value));
        if (PMC_type(value) != dynpmc_LuaNil)
            SELF.set_pmc(value);
    }

/*

=item C<PMC* get_pmc_keyed(PMC *key)>

Throws an exception.

=cut

*/
    VTABLE PMC* get_pmc_keyed(PMC *key) {
        PMC *meth = find_meth(INTERP, SELF, "__index");

        if (meth) {
            if (dynpmc_LuaFunction == PMC_type(meth)) {
                PMC *retval = Parrot_runops_fromc_args(INTERP, meth, "PPP",
                                                       SELF, key);
                if (retval)
                    return retval;

                return pmc_new(INTERP, dynpmc_LuaNil);
            }
            else
                return VTABLE_get_pmc_keyed(INTERP, meth, key);
        }

        Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_ILL_INHERIT,
            "attempt to index a %Ss value", SELF.name());
    }

/*

=item C<void set_pmc_keyed(PMC* key, PMC* value)>

Throws an exception.

=cut

*/
    VTABLE void set_pmc_keyed(PMC *key, PMC *value) {
        PMC *meth = find_meth(INTERP, SELF, "__newindex");

        if (!meth)
            Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_ILL_INHERIT,
                "attempt to index a %Ss value", SELF.name());

        if (dynpmc_LuaFunction == PMC_type(meth)) {
            Parrot_runops_fromc_args(INTERP, meth, "vPPP",
                                     SELF, key, value);
        }
        else
            VTABLE_set_pmc_keyed(INTERP, meth, key, value);
    }

/*

=item C<PMC* neg(PMC *dest)>

=item C<void i_neg()>

Throws an exception.

=cut

*/
    VTABLE PMC* neg(PMC *dest) {
        PMC *meth = find_meth(INTERP, SELF, "__unm");

        if (!meth)
            Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_ILL_INHERIT,
                "attempt to perform arithmetic on a %Ss value", SELF.name());

        dest = Parrot_runops_fromc_args(INTERP, meth, "PP", SELF);

        if (PMC_IS_NULL(dest))
            return pmc_new(INTERP, dynpmc_LuaNil);

        return dest;
    }

    VTABLE void i_neg() {
        PMC *meth = find_meth(INTERP, SELF, "__unm");

        if (!meth)
            Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_ILL_INHERIT,
                "attempt to perform arithmetic on a %Ss value", SELF.name());

        SELF = Parrot_runops_fromc_args(INTERP, meth, "PP", SELF);

        if (PMC_IS_NULL(SELF))
                SELF = pmc_new(INTERP, dynpmc_LuaNil);
    }

/*

=item C<PMC* logical_not(PMC *dest)>

Common implementation

=cut

*/
    VTABLE PMC* logical_not(PMC *dest) {
        dest = pmc_new(INTERP, dynpmc_LuaBoolean);
        VTABLE_set_bool(INTERP, dest, ! SELF.get_bool());
        return dest;
    }

/*

=item C<INTVAL defined()>

Always returns true.

=cut

*/
    VTABLE INTVAL defined() {
        return (INTVAL)1;
    }

/*

=item C<void* invoke(void* next)>

Throws an exception.

=cut

*/
    VTABLE opcode_t* invoke(void *next) {
        PMC *meth = find_meth(INTERP, SELF, "__call");
        PMC *retval;

        if (!meth)
            Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_ILL_INHERIT,
                "attempt to call a %Ss value", SELF.name());

            /* fix me */
#if 1
            retval = Parrot_runops_fromc_args(INTERP, meth, "PP", SELF);
            if (!retval)
                retval = pmc_new(INTERP, dynpmc_LuaNil);
#else
            next = VTABLE_invoke(INTERP, meth, next);
#endif
            return (opcode_t *)next;
    }

/*

=back

=head2 non-Vtable Methods

=over 4

=item C<void add(PMC *value, PMC *dest)>

=item C<void i_add(PMC *value)>

=item C<void subtract(PMC *value, PMC *dest)>

=item C<void i_substract (PMC *value)>

=item C<void multiply(PMC *value, PMC *dest)>

=item C<void i_multiply(PMC *value)>

=item C<void divide(PMC *value, PMC *dest)>

=item C<void i_divide(PMC *value)>

=item C<PMC* modulus(PMC *value, PMC *dest)>

=item C<void i_modulus(PMC *value)>

=item C<PMC* pow(PMC *value, PMC *dest)>

=item C<void i_pow(PMC *value)>

=item C<PMC* concatenate(PMC *value, PMC *dest)>

=item C<void i_concatenate(PMC *value)>

Throws an exception.

=cut

*/
    MULTI PMC* add(DEFAULT value, PMC *dest) {
        PMC *meth = find_meth(INTERP, SELF, "__add");
        if (!meth)
            Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_ILL_INHERIT,
                "attempt to perform arithmetic on a %Ss value", SELF.name());

        dest = Parrot_runops_fromc_args(INTERP, meth, "PPP", SELF, value);

        if (PMC_IS_NULL(dest))
            return pmc_new(INTERP, dynpmc_LuaNil);

        return dest;
    }

    MULTI void i_add(DEFAULT value) {
        PMC *meth = find_meth(INTERP, SELF, "__add");

        if (!meth)
            Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_ILL_INHERIT,
                "attempt to perform arithmetic on a %Ss value", SELF.name());

        SELF = Parrot_runops_fromc_args(INTERP, meth, "PPP", SELF, value);
        if (PMC_IS_NULL(SELF))
            SELF = pmc_new(INTERP, dynpmc_LuaNil);
    }

    MULTI PMC* subtract(DEFAULT value, PMC *dest) {
        PMC *meth = find_meth(INTERP, SELF, "__sub");
        if (!meth)
            Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_ILL_INHERIT,
                "attempt to perform arithmetic on a %Ss value", SELF.name());

        dest = Parrot_runops_fromc_args(INTERP, meth, "PPP", SELF, value);

        if (PMC_IS_NULL(dest))
            return pmc_new(INTERP, dynpmc_LuaNil);

        return dest;
    }

    MULTI void i_subtract(DEFAULT value) {
        PMC *meth = find_meth(INTERP, SELF, "__sub");
        if (!meth)
            Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_ILL_INHERIT,
                "attempt to perform arithmetic on a %Ss value", SELF.name());

        SELF = Parrot_runops_fromc_args(INTERP, meth, "PPP", SELF, value);

        if (PMC_IS_NULL(SELF))
            SELF = pmc_new(INTERP, dynpmc_LuaNil);
    }

    MULTI PMC* multiply(DEFAULT value, PMC *dest) {
        PMC *meth = find_meth(INTERP, SELF, "__mul");

        if (!meth)
            Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_ILL_INHERIT,
                "attempt to perform arithmetic on a %Ss value", SELF.name());

        dest = Parrot_runops_fromc_args(INTERP, meth, "PPP", SELF, value);

        if (PMC_IS_NULL(dest))
            return pmc_new(INTERP, dynpmc_LuaNil);

        return dest;
    }

    MULTI void i_multiply(DEFAULT value) {
        PMC *meth = find_meth(INTERP, SELF, "__mul");

        if (!meth)
            Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_ILL_INHERIT,
                "attempt to perform arithmetic on a %Ss value", SELF.name());

        SELF = Parrot_runops_fromc_args(INTERP, meth, "PPP", SELF, value);

        if (PMC_IS_NULL(SELF))
            SELF = pmc_new(INTERP, dynpmc_LuaNil);
    }

    MULTI PMC* divide(DEFAULT value, PMC *dest) {
        PMC *meth = find_meth(INTERP, SELF, "__div");

        if (!meth)
            Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_ILL_INHERIT,
                "attempt to perform arithmetic on a %Ss value", SELF.name());

        dest = Parrot_runops_fromc_args(INTERP, meth, "PPP", SELF, value);

        if (PMC_IS_NULL(dest))
            return pmc_new(INTERP, dynpmc_LuaNil);

        return dest;
    }

    MULTI void i_divide(DEFAULT value) {
        PMC *meth = find_meth(INTERP, SELF, "__div");

        if (!meth)
            Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_ILL_INHERIT,
                "attempt to perform arithmetic on a %Ss value", SELF.name());

        SELF = Parrot_runops_fromc_args(INTERP, meth, "PPP", SELF, value);

        if (PMC_IS_NULL(SELF))
            SELF = pmc_new(INTERP, dynpmc_LuaNil);
    }

    MULTI PMC* modulus(DEFAULT value, PMC *dest) {
        PMC *meth = find_meth(INTERP, SELF, "__mod");

        if (!meth)
            Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_ILL_INHERIT,
                "attempt to perform arithmetic on a %Ss value", SELF.name());

        dest = Parrot_runops_fromc_args(INTERP, meth, "PPP", SELF, value);

        if (PMC_IS_NULL(dest))
            return pmc_new(INTERP, dynpmc_LuaNil);

        return dest;
    }

    MULTI void i_modulus(DEFAULT value) {
        PMC *meth = find_meth(INTERP, SELF, "__mod");

        if (!meth)
            Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_ILL_INHERIT,
                "attempt to perform arithmetic on a %Ss value", SELF.name());

        SELF = Parrot_runops_fromc_args(INTERP, meth, "PPP", SELF, value);

        if (PMC_IS_NULL(SELF))
            SELF = pmc_new(INTERP, dynpmc_LuaNil);
    }

    MULTI PMC* pow(DEFAULT value, PMC *dest) {
        PMC *meth = find_meth(INTERP, SELF, "__pow");

        if (!meth)
            Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_ILL_INHERIT,
                "attempt to perform arithmetic on a %Ss value", SELF.name());

        dest = Parrot_runops_fromc_args(INTERP, meth, "PPP", SELF, value);

        if (PMC_IS_NULL(dest))
            return pmc_new(INTERP, dynpmc_LuaNil);

        return dest;
    }

    MULTI void i_pow(DEFAULT value) {
        PMC *meth = find_meth(INTERP, SELF, "__pow");

        if (!meth)
            Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_ILL_INHERIT,
                "attempt to perform arithmetic on a %Ss value", SELF.name());

        SELF = Parrot_runops_fromc_args(INTERP, meth, "PPP", SELF, value);

        if (PMC_IS_NULL(SELF))
            SELF = pmc_new(INTERP, dynpmc_LuaNil);
    }

    MULTI PMC* concatenate(DEFAULT value, PMC *dest) {
        PMC *meth = find_meth(INTERP, SELF, "__concat");

        if (!meth)
            Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_ILL_INHERIT,
                "attempt to concatenate a %Ss value", SELF.name());

        dest = Parrot_runops_fromc_args(INTERP, meth, "PPP", SELF, value);

        if (PMC_IS_NULL(dest))
            return pmc_new(INTERP, dynpmc_LuaNil);

        return dest;
    }

    MULTI void i_concatenate(DEFAULT value) {
        PMC *meth = find_meth(INTERP, SELF, "__concat");
        if (!meth)
            Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_ILL_INHERIT,
                "attempt to concatenate a %Ss value", SELF.name());

        SELF = Parrot_runops_fromc_args(INTERP, meth, "PPP", SELF, value);

        if (PMC_IS_NULL(SELF))
            SELF = pmc_new(INTERP, dynpmc_LuaNil);
    }

/*

=item C<INTVAL is_equal(PMC *value)>

=cut

*/
    MULTI INTVAL is_equal(DEFAULT value) {
        return (INTVAL)0;
    }

/*

=item C<INTVAL cmp(PMC *value)>

Performs a multiple dispatch call for 'cmp'.
Without shortcut like in Default PMC.

=cut

*/
    VTABLE INTVAL cmp(PMC *value) {
        INTVAL retval;
        Parrot_mmd_multi_dispatch_from_c_args(interp,
                "cmp", "PP->I", SELF, value, &retval);
        return retval;
    }

    MULTI INTVAL cmp(DEFAULT value) {
        STRING *self_name = SELF.name();
        STRING *val_name  = VTABLE_name(INTERP, value);

        if (string_compare(INTERP, self_name, val_name) != 0)
            Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_ILL_INHERIT,
                "attempt to compare %Ss with %Ss", self_name, val_name);
        else
            Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_ILL_INHERIT,
                "attempt to compare two %Ss values", self_name);
    }

/*

=back

=head2 Specific Methods

=over 4

=item C<PMC *get_metatable()>

=cut

*/
    METHOD PMC* get_metatable() {
        PMC *nil = pmc_new(INTERP, dynpmc_LuaNil);
        RETURN(PMC *nil);
    }

/*

=item C<PMC* len()>


=cut

*/
    METHOD PMC* len() {
        PMC *meth = find_meth(INTERP, SELF, "__len");
        PMC *retval;

        if (!meth)
            Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_ILL_INHERIT,
                "attempt to get length of a %Ss value", SELF.name());

        retval = Parrot_runops_fromc_args(INTERP, meth, "PP", SELF);

        if (PMC_IS_NULL(retval))
            retval = pmc_new(INTERP, dynpmc_LuaNil);

        RETURN(PMC *retval);
    }

/*

=item C<PMC* tonumber()>

Returns C<nil>.

=cut

*/
    METHOD PMC* tonumber() {
        PMC *nil = pmc_new(INTERP, dynpmc_LuaNil);
        RETURN(PMC *nil);
    }

/*

=item C<PMC* tostring()>

Return a Lua C<string>.

Common implementation (use C<__tostring> or C<get_string>).

=cut

*/
    METHOD PMC* tostring() {
        PMC *meth = find_meth(INTERP, SELF, "__tostring");
        PMC *retval;

        if (meth) {
            retval = Parrot_runops_fromc_args(INTERP, meth, "PP", SELF);

            if (PMC_IS_NULL(retval))
                retval = pmc_new(INTERP, dynpmc_LuaNil);
        }
        else {
            retval = pmc_new(INTERP, dynpmc_LuaString);
            VTABLE_set_string_native(INTERP, retval, SELF.get_string());
        }

        RETURN(PMC *retval);
    }
}

/*

=back

=cut

*/


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