/*
Copyright (C) 2006-2007, The Perl Foundation.
$Id: luaany.pmc 23367 2007-12-02 17:17:36Z fperrad $

=head1 NAME

pmc/luaany.pmc - Lua abstract base class

=head1 DESCRIPTION

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

=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) {
        PMC *ns = Parrot_get_ctx_HLL_namespace(interp);
        ns = Parrot_make_namespace_keyed_str(interp, ns, const_string(interp, "Lua"));
        ns = Parrot_make_namespace_keyed_str(interp, ns, const_string(interp, "string"));
        meta = Parrot_find_global_n(interp,
                                    ns,
                                    const_string(interp, "mt_string"));
    }
    if (dynpmc_LuaClosure != type && dynpmc_LuaFunction != type) {
        if (obj->pmc_ext != NULL) {
            meta = PMC_metadata(obj);
        }
        if (meta != NULL && dynpmc_LuaTable != PMC_type(meta)) {
            return meta;
        }
    }

    if (meta != NULL) {
        PMC *method;
        PMC *key = pmc_new(interp, dynpmc_LuaString);
        PMC_str_val(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

*/
    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

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

/*

=item C<void *get_pointer()>

Returns the address of the PMC.

=cut

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

/*

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

=cut

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

/*

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

Throws an exception.

=cut

*/
    PMC* get_pmc_keyed(PMC* key) {
        PMC *meth = find_meth(INTERP, SELF, "__index");
        if (meth != NULL) {
            if (dynpmc_LuaClosure == PMC_type(meth)
             || dynpmc_LuaFunction == PMC_type(meth)) {
                PMC *retval = Parrot_runops_fromc_args(INTERP, meth, "PPP",
                                                       SELF, key);
                if (NULL == retval) {
                    return pmc_new(INTERP, dynpmc_LuaNil);
                }
                return retval;
            }
            else {
                return VTABLE_get_pmc_keyed(INTERP, meth, key);
            }
        }
        real_exception(INTERP, NULL, ILL_INHERIT,
                "attempt to index a %s value",
                string_to_cstring(INTERP, DYNSELF.name()));
        return NULL;
    }

/*

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

Throws an exception.

=cut

*/
    void set_pmc_keyed(PMC* key, PMC* value) {
        PMC* meth = find_meth(INTERP, SELF, "__newindex");
        if (meth != NULL) {
            if (dynpmc_LuaClosure == PMC_type(meth)
             || dynpmc_LuaFunction == PMC_type(meth)) {
                Parrot_runops_fromc_args(INTERP, meth, "vPPP",
                                         SELF, key, value);
            }
            else {
                VTABLE_set_pmc_keyed(INTERP, meth, key, value);
            }
            return;
        }
        real_exception(INTERP, NULL, ILL_INHERIT,
                "attempt to index a %s value",
                string_to_cstring(INTERP, DYNSELF.name()));
    }

/*

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

=item C<void i_neg()>

Throws an exception.

=cut

*/
    PMC* neg(PMC* dest) {
        PMC *meth = find_meth(INTERP, SELF, "__unm");
        if (meth != NULL) {
            dest = Parrot_runops_fromc_args(INTERP, meth, "PP", SELF);
            if (PMC_IS_NULL(dest)) {
                dest = pmc_new(INTERP, dynpmc_LuaNil);
            }
            return dest;
        }
        real_exception(INTERP, NULL, ILL_INHERIT,
                "attempt to perform arithmetic on a %s value",
                string_to_cstring(INTERP, DYNSELF.name()));
        return NULL;
    }

    void i_neg() {
        PMC *meth = find_meth(INTERP, SELF, "__unm");
        if (meth != NULL) {
            SELF = Parrot_runops_fromc_args(INTERP, meth, "PP", SELF);
            if (PMC_IS_NULL(SELF)) {
                SELF = pmc_new(INTERP, dynpmc_LuaNil);
            }
            return;
        }
        real_exception(INTERP, NULL, ILL_INHERIT,
                "attempt to perform arithmetic on a %s value",
                string_to_cstring(INTERP, DYNSELF.name()));
    }

/*

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

Common implementation

=cut

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

/*

=item C<INTVAL defined()>

Always returns true.

=cut

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

/*

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

Throws an exception.

=cut

*/
    opcode_t* invoke(void* next) {
        PMC *meth = find_meth(INTERP, SELF, "__call");
        if (meth != NULL) {
            /* fix me */
#if 1
            PMC *retval = Parrot_runops_fromc_args(INTERP, meth, "PP", SELF);
            if (NULL == retval) {
                retval = pmc_new(INTERP, dynpmc_LuaNil);
            }
#else
            next = VTABLE_invoke(INTERP, meth, next);
#endif
            return next;
        }
        real_exception(INTERP, NULL, ILL_INHERIT,
                "attempt to call a %s value",
                string_to_cstring(INTERP, DYNSELF.name()));
        return NULL;
    }

/*

=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

*/
    PMC* add(PMC* value, PMC* dest) {
        PMC *meth = find_meth(INTERP, SELF, "__add");
        if (meth != NULL) {
            dest = Parrot_runops_fromc_args(INTERP, meth, "PPP", SELF, value);
            if (PMC_IS_NULL(dest)) {
                dest = pmc_new(INTERP, dynpmc_LuaNil);
            }
            return dest;
        }
        real_exception(INTERP, NULL, ILL_INHERIT,
                "attempt to perform arithmetic on a %s value",
                string_to_cstring(INTERP, DYNSELF.name()));
        return NULL;
    }

    void i_add(PMC* value) {
        PMC *meth = find_meth(INTERP, SELF, "__add");
        if (meth != NULL) {
            SELF = Parrot_runops_fromc_args(INTERP, meth, "PPP", SELF, value);
            if (PMC_IS_NULL(SELF)) {
                SELF = pmc_new(INTERP, dynpmc_LuaNil);
            }
            return;
        }
        real_exception(INTERP, NULL, ILL_INHERIT,
                "attempt to perform arithmetic on a %s value",
                string_to_cstring(INTERP, DYNSELF.name()));
    }

    PMC* subtract(PMC* value, PMC* dest) {
        PMC *meth = find_meth(INTERP, SELF, "__sub");
        if (meth != NULL) {
            dest = Parrot_runops_fromc_args(INTERP, meth, "PPP", SELF, value);
            if (PMC_IS_NULL(dest)) {
                dest = pmc_new(INTERP, dynpmc_LuaNil);
            }
            return dest;
        }
        real_exception(INTERP, NULL, ILL_INHERIT,
                "attempt to perform arithmetic on a %s value",
                string_to_cstring(INTERP, DYNSELF.name()));
        return NULL;
    }

    void i_subtract(PMC* value) {
        PMC *meth = find_meth(INTERP, SELF, "__sub");
        if (meth != NULL) {
            SELF = Parrot_runops_fromc_args(INTERP, meth, "PPP", SELF, value);
            if (PMC_IS_NULL(SELF)) {
                SELF = pmc_new(INTERP, dynpmc_LuaNil);
            }
            return;
        }
        real_exception(INTERP, NULL, ILL_INHERIT,
                "attempt to perform arithmetic on a %s value",
                string_to_cstring(INTERP, DYNSELF.name()));
    }

    PMC* multiply(PMC* value, PMC* dest) {
        PMC *meth = find_meth(INTERP, SELF, "__mul");
        if (meth != NULL) {
            dest = Parrot_runops_fromc_args(INTERP, meth, "PPP", SELF, value);
            if (PMC_IS_NULL(dest)) {
                dest = pmc_new(INTERP, dynpmc_LuaNil);
            }
            return dest;
        }
        real_exception(INTERP, NULL, ILL_INHERIT,
                "attempt to perform arithmetic on a %s value",
                string_to_cstring(INTERP, DYNSELF.name()));
        return NULL;
    }

    void i_multiply(PMC* value) {
        PMC *meth = find_meth(INTERP, SELF, "__mul");
        if (meth != NULL) {
            SELF = Parrot_runops_fromc_args(INTERP, meth, "PPP", SELF, value);
            if (PMC_IS_NULL(SELF)) {
                SELF = pmc_new(INTERP, dynpmc_LuaNil);
            }
            return;
        }
        real_exception(INTERP, NULL, ILL_INHERIT,
                "attempt to perform arithmetic on a %s value",
                string_to_cstring(INTERP, DYNSELF.name()));
    }

    PMC* divide(PMC* value, PMC* dest) {
        PMC *meth = find_meth(INTERP, SELF, "__div");
        if (meth != NULL) {
            dest = Parrot_runops_fromc_args(INTERP, meth, "PPP", SELF, value);
            if (PMC_IS_NULL(dest)) {
                dest = pmc_new(INTERP, dynpmc_LuaNil);
            }
            return dest;
        }
        real_exception(INTERP, NULL, ILL_INHERIT,
                "attempt to perform arithmetic on a %s value",
                string_to_cstring(INTERP, DYNSELF.name()));
        return NULL;
    }

    void i_divide(PMC* value) {
        PMC *meth = find_meth(INTERP, SELF, "__div");
        if (meth != NULL) {
            SELF = Parrot_runops_fromc_args(INTERP, meth, "PPP", SELF, value);
            if (PMC_IS_NULL(SELF)) {
                SELF = pmc_new(INTERP, dynpmc_LuaNil);
            }
            return;
        }
        real_exception(INTERP, NULL, ILL_INHERIT,
                "attempt to perform arithmetic on a %s value",
                string_to_cstring(INTERP, DYNSELF.name()));
    }

    PMC* modulus(PMC* value, PMC* dest) {
        PMC *meth = find_meth(INTERP, SELF, "__mod");
        if (meth != NULL) {
            dest = Parrot_runops_fromc_args(INTERP, meth, "PPP", SELF, value);
            if (PMC_IS_NULL(dest)) {
                dest = pmc_new(INTERP, dynpmc_LuaNil);
            }
            return dest;
        }
        real_exception(INTERP, NULL, ILL_INHERIT,
                "attempt to perform arithmetic on a %s value",
                string_to_cstring(INTERP, DYNSELF.name()));
        return NULL;
    }

    void i_modulus(PMC* value) {
        PMC *meth = find_meth(INTERP, SELF, "__mod");
        if (meth != NULL) {
            SELF = Parrot_runops_fromc_args(INTERP, meth, "PPP", SELF, value);
            if (PMC_IS_NULL(SELF)) {
                SELF = pmc_new(INTERP, dynpmc_LuaNil);
            }
            return;
        }
        real_exception(INTERP, NULL, ILL_INHERIT,
                "attempt to perform arithmetic on a %s value",
                string_to_cstring(INTERP, DYNSELF.name()));
    }

    PMC* pow(PMC* value, PMC* dest) {
        PMC *meth = find_meth(INTERP, SELF, "__pow");
        if (meth != NULL) {
            dest = Parrot_runops_fromc_args(INTERP, meth, "PPP", SELF, value);
            if (PMC_IS_NULL(dest)) {
                dest = pmc_new(INTERP, dynpmc_LuaNil);
            }
            return dest;
        }
        real_exception(INTERP, NULL, ILL_INHERIT,
                "attempt to perform arithmetic on a %s value",
                string_to_cstring(INTERP, DYNSELF.name()));
        return NULL;
    }

    void i_pow(PMC* value) {
        PMC *meth = find_meth(INTERP, SELF, "__pow");
        if (meth != NULL) {
            SELF = Parrot_runops_fromc_args(INTERP, meth, "PPP", SELF, value);
            if (PMC_IS_NULL(SELF)) {
                SELF = pmc_new(INTERP, dynpmc_LuaNil);
            }
            return;
        }
        real_exception(INTERP, NULL, ILL_INHERIT,
                "attempt to perform arithmetic on a %s value",
                string_to_cstring(INTERP, DYNSELF.name()));
    }

    PMC* concatenate(PMC* value,  PMC* dest) {
        PMC *meth = find_meth(INTERP, SELF, "__concat");
        if (meth != NULL) {
            dest = Parrot_runops_fromc_args(INTERP, meth, "PPP", SELF, value);
            if (PMC_IS_NULL(dest)) {
                dest = pmc_new(INTERP, dynpmc_LuaNil);
            }
            return dest;
        }
        real_exception(INTERP, NULL, ILL_INHERIT,
                "attempt to concatenate a %s value",
                string_to_cstring(INTERP, DYNSELF.name()));
        return NULL;
    }

    void i_concatenate(PMC* value) {
        PMC *meth = find_meth(INTERP, SELF, "__concat");
        if (meth != NULL) {
            SELF = Parrot_runops_fromc_args(INTERP, meth, "PPP", SELF, value);
            if (PMC_IS_NULL(SELF)) {
                SELF = pmc_new(INTERP, dynpmc_LuaNil);
            }
            return;
        }
        real_exception(INTERP, NULL, ILL_INHERIT,
                "attempt to concatenate a %s value",
                string_to_cstring(INTERP, DYNSELF.name()));
    }

/*

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

=cut

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

/*

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

=cut

*/
    INTVAL cmp(PMC* value) {
        char * s = string_to_cstring(INTERP, DYNSELF.name());
        char * v = string_to_cstring(INTERP, VTABLE_name(INTERP, value));

        if (strcmp(s, v) != 0) {
            real_exception(INTERP, NULL, ILL_INHERIT,
                    "attempt to compare %s with %s", s, v);
        }
        else {
            real_exception(INTERP, NULL, ILL_INHERIT,
                    "attempt to compare two %s values", s);
        }
        return (INTVAL)0;
    }

/*

=back

=head2 Specific Methods

=over 4

=item C<PMC *get_metatable()>

=cut

*/
    METHOD PMC* get_metatable() {
        return pmc_new(INTERP, dynpmc_LuaNil);
    }

/*

=item C<PMC* len()>


=cut

*/
    METHOD PMC* len() {
        PMC *meth = find_meth(INTERP, SELF, "__len");
        if (meth != NULL) {
            PMC *retval = Parrot_runops_fromc_args(INTERP, meth, "PP", SELF);
            if (PMC_IS_NULL(retval)) {
                retval = pmc_new(INTERP, dynpmc_LuaNil);
            }
            return retval;
        }
        real_exception(INTERP, NULL, ILL_INHERIT,
                "attempt to get length of a %s value",
                string_to_cstring(INTERP, DYNSELF.name()));
        return NULL;
    }

/*

=item C<PMC* tonumber()>

Returns C<nil>.

=cut

*/
    METHOD PMC* tonumber() {
        return pmc_new(INTERP, dynpmc_LuaNil);
    }

/*

=item C<PMC* tostring()>

Return a Lua C<string>.

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

=cut

*/
    METHOD PMC* tostring() {
        PMC *retval;

        PMC *meth = find_meth(INTERP, SELF, "__tostring");
        if (meth != NULL) {
            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);
            PMC_str_val(retval) = DYNSELF.get_string();
        }
        return retval;
    }

}

/*

=back

=head1 AUTHORS

Francois Perrad.

=cut

*/


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