/*
Copyright (C) 2001-2003, The Perl Foundation.
$Id: key.pmc 16275 2006-12-28 01:20:44Z particle $

=head1 NAME

src/pmc/key.pmc - Key PMC

=head1 DESCRIPTION

These are the vtable functions for the Key PMC class.

=head2 Methods

=over 4

=cut

*/

#include "parrot/parrot.h"

static int
is_hash_iter(PMC *agg, PMC *key)
{
    if ((PObj_get_FLAGS(key) & KEY_type_FLAGS) ==
        KEY_hash_iterator_FLAGS )
        return 1;
    return 0;
}

pmclass Key need_ext {

/*

=item C<void init()>

Initializes the key.

=cut

*/

    void init() {
        PObj_custom_mark_SET(SELF);
    }

/*

=item C<PMC *clone()>

Creates and returns a clone of the key.

=cut

*/

    PMC* clone() {
        PMC *dest = pmc_new_noinit(INTERP, SELF->vtable->base_type);
        PMC *dkey = dest;
        PMC *key = SELF;
        PMC *p;

        PObj_custom_mark_SET(dest);
        for (; key ; ) {
            switch (PObj_get_FLAGS(key) & KEY_type_FLAGS) {
                case KEY_integer_FLAG:
                case KEY_integer_FLAG|KEY_register_FLAG:
                    key_set_integer(INTERP, dkey, key_integer(INTERP, key));
                    break;
                case KEY_number_FLAG:
                case KEY_number_FLAG|KEY_register_FLAG:
                    key_set_number(INTERP, dkey, key_number(INTERP, key));
                    break;
                case KEY_string_FLAG:
                case KEY_string_FLAG|KEY_register_FLAG:
                    key_set_string(INTERP, dkey,
                        string_copy(INTERP, key_string(INTERP, key)));
                    break;
                case KEY_pmc_FLAG:
                case KEY_pmc_FLAG|KEY_register_FLAG:
                    p = key_pmc(INTERP, key);
                    key_set_pmc(INTERP, dkey, VTABLE_clone(INTERP, p));
                    break;
            }
            key = key_next(INTERP, key);
            if (key) {
                p = key_new(INTERP);
                key_append(INTERP, dkey, p);
                dkey = p;
            }
        }
        return dest;
    }

/*

=item C<void mark()>

Marks the key as live.

=cut

*/

    void mark() {
        key_mark(INTERP, SELF);
    }

/*

=item C<INTVAL get_integer()>

Returns the integer value of the key.

=cut

*/

    INTVAL get_integer() {
        return key_integer(INTERP, SELF);
    }

/*

=item C<FLOATVAL get_number()>

Returns the floating-point number value of the key.

=cut

*/

    FLOATVAL get_number() {
        return key_number(INTERP, SELF);
    }

/*

=item C<STRING *get_string()>

Returns the Parrot string value of the key.

=cut

*/

    STRING* get_string() {
        return key_string(INTERP, SELF);
    }

/*

=item C<PMC *get_pmc()>

Returns the PMC value of the key.

=cut

*/

    PMC* get_pmc() {
        return key_pmc(INTERP, SELF);
    }

/*

=item C<void set_integer_native(INTVAL value)>

=cut

*/

    void set_integer_native(INTVAL value) {
        key_set_integer(INTERP, SELF, value);
    }

/*

=item C<void set_number_native(FLOATVAL value)>

Sets the value of the key to C<value>.

=cut

*/

    void set_number_native(FLOATVAL value) {
        key_set_number(INTERP, SELF, value);
    }

/*

=item C<void set_string_native(STRING *value)>


=cut

*/

    void set_string_native(STRING* value) {
        key_set_string(INTERP, SELF, value);
    }

/*

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

Sets the value of the key to C<*value>.

=cut

*/

    void set_pmc(PMC* value) {
        key_set_pmc(INTERP, SELF, value);
    }

/*

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

Appends C<*value> to the key.

=cut

*/

    void push_pmc(PMC * value) {
        if (value->vtable->base_type != enum_class_Key)
            real_exception(interp, NULL, INVALID_OPERATION,
                "Can only push another Key onto a Key PMC.");
        key_append(INTERP, SELF, value);
    }

/*

=item C<PMC *shift_pmc()>

Returns the next key.

Actually doesn't remove the entry but might be useful to traverse a key
chain.

=cut

*/

    PMC* shift_pmc() {
        return key_next(INTERP, SELF);
    }

/*

=back

=head2 Iterator Interface

=over 4

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

Returns the key itself.

=cut

*/

    PMC* get_pmc_keyed(PMC* key) {
        return key;
    }

/*

=item C<PMC *nextkey_keyed(PMC *key, INTVAL what)>

Returns the next key relative to the location specified in C<what>.
PMC_int_val(-1) means end of iteration.

=cut

*/

    PMC* nextkey_keyed(PMC* agg, INTVAL what) {
        INTVAL n = VTABLE_elements(INTERP, agg);
        PMC *ret = SELF;
        STRING *_hash;

        switch (what) {
            case ITERATE_FROM_START_KEYS:
                /*
                 * OrderedHash supports two iterators: by key
                 * or by ordered values
                 */
                PObj_get_FLAGS(ret) &= ~KEY_type_FLAGS;
                PObj_get_FLAGS(ret) |= KEY_integer_FLAG;
                if (agg->vtable->base_type == enum_class_OrderedHash)
                    PObj_get_FLAGS(ret) |= KEY_number_FLAG;
                goto init;
            case ITERATE_FROM_START:    /* reset key */
                PObj_get_FLAGS(ret) &= ~KEY_type_FLAGS;
                PObj_get_FLAGS(ret) |= KEY_integer_FLAG;
                /*
                 * KEY_hash_iterator_FLAGS, which is the same as
                 * KEY_integer_FLAG | KEY_number_FLAG
                 * indicates a hash iterator operation
                 * KEY_integer_FLAG alone is an indexed hash lookup
                 * with an Integer KEY
                 */
                 _hash = CONST_STRING(interp, "Hash");
                if (VTABLE_isa(INTERP, agg, _hash) &&
                     agg->vtable->base_type != enum_class_OrderedHash)
                    PObj_get_FLAGS(ret) |= KEY_hash_iterator_FLAGS;
        init:
                PMC_int_val(ret) = 0;
                if (!n)
                    PMC_int_val(ret) = -1;
                /*
                 * iterating over a hash needs additionally the
                 * Bucket index
                 */
                if (is_hash_iter(agg, ret))
                    PMC_data(ret) = (void *)INITBucketIndex;
                break;
            case ITERATE_GET_NEXT:
                /*
                 * src/hash.c:parrot_hash_get_idx() advances to next
                 * so, if we are iterating over a hash do nothing
                 * */
                if (!is_hash_iter(agg, ret)) {
                    if (PMC_int_val(ret) < n - 1)
                        ++PMC_int_val(ret);
                    else
                        PMC_int_val(ret) = -1;
                }
                break;
            case ITERATE_GET_PREV:
                if (PMC_int_val(ret) >= 0)
                    --PMC_int_val(ret);
                break;
            case ITERATE_FROM_END:
                PObj_get_FLAGS(ret) &= ~KEY_type_FLAGS;
                PObj_get_FLAGS(ret) |= KEY_integer_FLAG;
                PMC_int_val(ret) = n - 1;
                break;
        }
        return ret;
    }
/*

=item C<void visit(visit_info *info)>

This is used by freeze/thaw to visit the contents of the Key.

=item C<void freeze(visit_info *info)>

Archives the Key.

=item C<void thaw(visit_info *info)>

Unarchives the Key.

=item C<void thawfinish(visit_info *info)>

Called after the Key has been thawed: convert last PMC_NULL key to NULL.

=cut

*/

    void visit(visit_info *info) {
        /*
         * at end a PMC_NULL is written during thaw,
         * which should stop visiting the key
         */
        PMC **pos = (PMC**)&PMC_data(SELF);
        info->thaw_ptr = pos;
        (info->visit_pmc_now)(INTERP, *pos, info);
    }

    void freeze(visit_info *info) {
        IMAGE_IO *io = info->image_io;
        /* write flags */
        INTVAL flags = (PObj_get_FLAGS(SELF) & KEY_type_FLAGS);
        /* write the contents of a register - else thaw can't restore
         * the register state
         */
        io->vtable->push_integer(INTERP, io, flags & ~KEY_register_FLAG);
        /* and contents of this key component */
        switch (flags) {
            case KEY_integer_FLAG:
            case KEY_integer_FLAG|KEY_register_FLAG:
                io->vtable->push_integer(INTERP, io, key_integer(INTERP, SELF));
                break;
            case KEY_number_FLAG:
            case KEY_number_FLAG|KEY_register_FLAG:
                io->vtable->push_float(INTERP, io, key_number(INTERP, SELF));
                break;
            case KEY_string_FLAG:
            case KEY_string_FLAG|KEY_register_FLAG:
                io->vtable->push_string(INTERP, io, key_string(INTERP, SELF));
                break;
            default:
                real_exception(INTERP, NULL, E_KeyError,
                        "Unsupported key type in Key.freeze");
                break;
        }
    }

    void thaw(visit_info *info) {
        IMAGE_IO *io = info->image_io;
        /* get flags */
        INTVAL flags = io->vtable->shift_integer(INTERP, io);
        flags &= KEY_type_FLAGS;
        PObj_get_FLAGS(SELF) |= flags;
        PObj_custom_mark_SET(SELF);
        /* get contents */
        switch (flags) {
            case KEY_integer_FLAG:
                PMC_int_val(SELF) = io->vtable->shift_integer(INTERP, io);
                break;
            case KEY_number_FLAG:
                PMC_num_val(SELF) = io->vtable->shift_float(INTERP, io);
                break;
            case KEY_string_FLAG:
                PMC_str_val(SELF) = io->vtable->shift_string(INTERP, io);
                break;
            default:
                real_exception(INTERP, NULL, E_KeyError,
                        "Unsupported key type in Key.freeze");
                break;
        }
    }

    void thawfinish(visit_info *info) {
        PMC *key = SELF, *next;
        while (1) {
            next = PMC_data(key);
            if (PMC_IS_NULL(next)) {
                PMC_data(key) = NULL;
                break;
            }
            key = next;
        }
    }
}

/*

=back

=cut

*/

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