luaany.pmc

/*
Copyright (C) 2006, The Perl Foundation.
$Id$

=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 "parrot/parrot.h"

extern INTVAL dynpmc_LuaBoolean;
extern INTVAL dynpmc_LuaClosure;
extern INTVAL dynpmc_LuaFunction;
extern INTVAL dynpmc_LuaNil;
extern INTVAL dynpmc_LuaString;
extern INTVAL dynpmc_LuaTable;

extern PMC * find_meth(Interp* interp, PMC *obj, const char *name);

PMC *
find_meth(Interp* interp, PMC *obj, const char *name) {
    PMC *meta = NULL;
    INTVAL type = obj->vtable->base_type;

    if (dynpmc_LuaString == type) {
        meta = Parrot_find_global_cur(interp,
                                      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 != meta->vtable->base_type) {
            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 != method->vtable->base_type) {
            return method;
        }
    }
    return NULL;
}


pmclass LuaAny
    abstract
    dynpmc
    group lua_group
    hll Lua {
/*

=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<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 == meth->vtable->base_type
             || dynpmc_LuaFunction == meth->vtable->base_type) {
                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 == meth->vtable->base_type
             || dynpmc_LuaFunction == meth->vtable->base_type) {
                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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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:
 */