/*
Copyright (C) 2001-2008, The Perl Foundation.
$Id: /mirror/trunk/src/pmc/array.pmc 35409 2009-01-11T03:55:39.964567Z allison  $

=head1 NAME

src/pmc/array.pmc - Array PMC

=head1 DESCRIPTION

These are the vtable functions for the Array base class.

=head2 Functions

=over 4

=cut

*/

#include "parrot/parrot.h"

/*

=item C<static PMC *undef(PARROT_INTERP)>

Returns a C<Undef> PMC.

=cut

*/

static PMC *undef(PARROT_INTERP) {
    return pmc_new(interp, enum_class_Undef);
}

/*

=item C<static PMC *retval(PARROT_INTERP, void *ret)>

Processes C<*ret>, returning the appropriate PMC, or raising an
exception if necessary.

=cut

*/

static PMC *retval(PARROT_INTERP, void *ret) {
    PMC *value;

    if (ret == 0)
        Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_OUT_OF_BOUNDS,
            "Array index out of bounds!");

    /* XXX getting non existent value, exception or undef?
     * current is for perlarray */
    if (ret == (void *)-1)
        value = undef(interp);
    else {
        value = *(PMC **)ret;

        /* XXX same here */
        if (!value)
            value = undef(interp);
    }

    return value;
}

/*

=item C<static PMC
*Parrot_Array_set_pmc_ptr(PARROT_INTERP, List *list, INTVAL key)>

Returns a pointer to the element at index C<key> of C<*list>. If
this element was previously empty, then this function also creates
and assigns an "undef" PMC to that element.

=cut

*/

static PMC *Parrot_Array_set_pmc_ptr(PARROT_INTERP, List *list, INTVAL key) {
    void * const ret = list_get(interp, list, key, enum_type_PMC);
    PMC  *value;

    if (ret == 0)
        Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_OUT_OF_BOUNDS,
            "Array index out of bounds!");

    /* assign into a sparse or not yet set value */
    if (ret == (void *)-1 || *(PMC **)ret == 0) {
        value = undef(interp);
        list_assign(interp, list, key, value, enum_type_PMC);
    }
    else
        value = *(PMC **)ret;

    return value;
}


pmclass Array need_ext provides array {

/*

=back

=head2 Methods

=over 4

=item C<void class_init()>

Class initialization. Creates the required memory pools.

=cut

*/

    void class_init() {
        /* class_init_code; called for side effects */
        Small_Object_Pool *List_chunks =
            get_bufferlike_pool(INTERP, sizeof (List_chunk));
        Small_Object_Pool *Lists       =
            get_bufferlike_pool(INTERP, sizeof (List));

        /* XXX until there's a function to allocate a pool in an arena */
        UNUSED(List_chunks);
        UNUSED(Lists);
    }

/*

=item C<void init()>

Initializes the PMC by calling the underlying C<list_new()> function.

=cut

*/

    VTABLE void init() {
        list_pmc_new(INTERP, SELF);
        PObj_custom_mark_SET(SELF);
    }

/*

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

Calls C<list_new_init()> to initialize the underlying list.

C<*init> contains the initialization information specifying initial
size, number of dimensions, etc.

=cut

*/

    VTABLE void init_pmc(PMC *init) {
        list_pmc_new_init(INTERP, SELF, init);
        PObj_custom_mark_SET(SELF);
    }

/*

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

Copy the contents of other to self.

=cut

*/

    VTABLE void assign_pmc(PMC *other) {
        const INTVAL size = VTABLE_elements(INTERP, other);
        INTVAL       i;

        SELF.set_integer_native(size);
        for (i = 0; i < size; i++) {
            PMC * const elem = VTABLE_get_pmc_keyed_int(INTERP, other, i);
            SELF.set_pmc_keyed_int(i, elem);
        }
    }


/*

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

Implemented as an alias to C<assign_pmc> since the behavior is the same.

=cut

*/

    VTABLE void set_pmc(PMC *other) {
        SELF.assign_pmc(other);
    }

/*

=item C<void mark()>

Mark the array and its contents as live.

=cut

*/

    VTABLE void mark() {
        list_mark(INTERP, (List *)PMC_data(SELF));
    }

/*

=item C<PMC *clone()>

Return a clone of the array.

=cut

*/

    VTABLE PMC *clone() {
        List       *l    = list_clone(INTERP, (List *)PMC_data(SELF));
        PMC * const dest = pmc_new_noinit(INTERP, SELF->vtable->base_type);

        PObj_custom_mark_SET(dest);

        PMC_data(dest) = l;
        l->container   = dest;

        return dest;
    }

/*

=item C<INTVAL get_integer()>

Returns the number of elements in the array.

=cut

*/

    VTABLE INTVAL get_integer() {
        return SELF.elements();
    }

/*

=item C<INTVAL get_bool()>

Returns true if the array has one or more elements.

=cut

*/

    VTABLE INTVAL get_bool() {
        const INTVAL size = SELF.elements();
        return (INTVAL)(size != 0);
    }

/*

=item C<INTVAL elements()>

Returns the number of elements in the array.

=cut

*/

    VTABLE INTVAL elements() {
        return ((List *) PMC_data(SELF))->length;
    }

/*

=item C<FLOATVAL get_number()>

Returns the number of elements in the array.

=cut

*/

    VTABLE FLOATVAL get_number() {
        INTVAL e = SELF.elements();
        return (FLOATVAL)e;
    }

/*

=item C<STRING *get_string()>

Returns a string representation of the array.

=cut

*/

    VTABLE STRING *get_string() {
        return Parrot_sprintf_c(INTERP, "array[%p]", SELF);
    }

/*

=item C<INTVAL get_integer_keyed_int(INTVAL key)>

Returns the integer value of the element at index C<key>.

=cut

*/

    VTABLE INTVAL get_integer_keyed_int(INTVAL key) {
        PMC * const value = SELF.get_pmc_keyed_int(key);

        return VTABLE_get_integer(INTERP, value);
    }

/*

=item C<INTVAL get_integer_keyed(PMC *key)>

Returns the integer value of the element at index C<key>.

=cut

*/

    VTABLE INTVAL get_integer_keyed(PMC *key) {
        INTVAL ix;
        PMC   *nextkey, *box;

        if (!key)
            return 0;

        ix      = key_integer(INTERP, key);
        nextkey = key_next(INTERP, key);

        if (!nextkey)
            return SELF.get_integer_keyed_int(ix);

        box = SELF.get_pmc_keyed_int(ix);

        if (!box)
            box = undef(INTERP);

        return VTABLE_get_integer_keyed(INTERP, box, nextkey);
    }

/*

=item C<FLOATVAL get_number_keyed_int(INTVAL key)>

Returns the float value of the element at index C<key>.

=cut

*/

    VTABLE FLOATVAL get_number_keyed_int(INTVAL key) {
        PMC * const value = SELF.get_pmc_keyed_int(key);

        return VTABLE_get_number(INTERP, value);

    }

/*

=item C<FLOATVAL get_number_keyed(PMC *key)>

Returns the float value of the element at index C<key>.

=cut

*/

    VTABLE FLOATVAL get_number_keyed(PMC *key) {
        INTVAL ix;
        PMC *nextkey, *box;

        if (!key)
            return (FLOATVAL)0;

        ix      = key_integer(INTERP, key);
        nextkey = key_next(INTERP, key);

        if (!nextkey)
            return SELF.get_number_keyed_int(ix);

        box = SELF.get_pmc_keyed_int(ix);

        if (!box)
            box = undef(INTERP);

        return VTABLE_get_number_keyed(INTERP, box, nextkey);
    }

/*

=item C<STRING *get_string_keyed_int(INTVAL key)>

Returns the string value of the element at index C<key>.

=cut

*/

    VTABLE STRING *get_string_keyed_int(INTVAL key) {
        PMC * const value = SELF.get_pmc_keyed_int(key);

        return VTABLE_get_string(INTERP, value);
    }

/*

=item C<STRING *get_string_keyed(PMC *key)>

Returns the string value of the element at index C<key>.

=cut

*/

    VTABLE STRING *get_string_keyed(PMC *key) {
        INTVAL ix;
        PMC   *nextkey, *box;

        if (!key)
            return 0;

        ix      = key_integer(INTERP, key);
        nextkey = key_next(INTERP, key);

        if (!nextkey)
            return SELF.get_string_keyed_int(ix);

        box = SELF.get_pmc_keyed_int(ix);

        if (!box)
            box = undef(INTERP);

        return VTABLE_get_string_keyed(INTERP, box, nextkey);
    }

/*

=item C<PMC *get_pmc_keyed_int(INTVAL key)>

Returns the PMC value of the element at index C<key>.

=cut

*/

    VTABLE PMC *get_pmc_keyed_int(INTVAL key) {

        return retval(INTERP,
            list_get(INTERP, (List *)PMC_data(SELF), key, enum_type_PMC));
    }

/*

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

Returns the PMC value of the element at index C<key>.

=cut

*/

    VTABLE PMC *get_pmc_keyed(PMC *key) {
        INTVAL ix;
        PMC   *nextkey, *box;

        if (!key)
            return 0;

        ix      = key_integer(INTERP, key);
        nextkey = key_next(INTERP, key);

        if (!nextkey)
            return SELF.get_pmc_keyed_int(ix);

        box = SELF.get_pmc_keyed_int(ix);

        if (!box)
            box = undef(INTERP);

        return VTABLE_get_pmc_keyed(INTERP, box, nextkey);
    }

/*

=item C<void set_integer_native(INTVAL size)>

Sets the length of the array to C<size>.

=cut

*/

    VTABLE void set_integer_native(INTVAL size) {
        list_set_length(INTERP, (List *)PMC_data(SELF), size);
    }
/*

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

Sets the length of the array to the number of elements in C<*value>.

=cut

*/

    VTABLE void set_integer_same(PMC *value) {
        const INTVAL size = VTABLE_elements(INTERP, value);
        list_set_length(INTERP, (List *)PMC_data(SELF), size);
    }

/*

=item C<void set_integer_keyed_int(INTVAL key, INTVAL value)>

Sets the integer value of the PMC at element C<key> to C<value>.

=cut

*/

    VTABLE void set_integer_keyed_int(INTVAL key, INTVAL value) {
        PMC * const ptr =
            Parrot_Array_set_pmc_ptr(INTERP, (List *)PMC_data(SELF), key);

        VTABLE_set_integer_native(INTERP, ptr, value);
    }

/*

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

Sets the integer value of the PMC at element C<key> to C<value>.

=cut

*/

    VTABLE void set_integer_keyed(PMC *key, INTVAL value) {
        INTVAL ix;
        PMC   *nextkey, *box;

        if (!key)
            return;

        ix      = key_integer(INTERP, key);
        nextkey = key_next(INTERP, key);

        if (!nextkey) {
            SELF.set_integer_keyed_int(ix, value);
            return;
        }

        box = SELF.get_pmc_keyed_int(ix);

        /* autovivify an Array */
        if (!box)
            box = pmc_new(INTERP, SELF.type());

        VTABLE_set_integer_keyed(INTERP, box, nextkey, value);
    }

/*

=item C<void set_number_keyed_int(INTVAL key, FLOATVAL value)>

Sets the numeric value of the PMC at element C<key> to C<value>.

=cut

*/

    VTABLE void set_number_keyed_int(INTVAL key, FLOATVAL value) {
        PMC * const ptr =
            Parrot_Array_set_pmc_ptr(INTERP, (List *)PMC_data(SELF), key);

        VTABLE_set_number_native(INTERP, ptr, value);
    }

/*

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

Sets the numeric value of the PMC at element C<key> to C<value>.

=cut

*/

    VTABLE void set_number_keyed(PMC *key, FLOATVAL value) {
        INTVAL ix;
        PMC   *nextkey, *box;

        if (!key)
            return;

        ix      = key_integer(INTERP, key);
        nextkey = key_next(INTERP, key);

        if (!nextkey) {
            SELF.set_number_keyed_int(ix, value);
            return;
        }

        box = SELF.get_pmc_keyed_int(ix);

        /* autovivify an Array */
        if (!box)
            box = pmc_new(INTERP, SELF.type());

        VTABLE_set_number_keyed(INTERP, box, nextkey, value);
    }

/*

=item C<void set_string_keyed_int(INTVAL key, STRING *value)>

Sets the string value of the PMC at element C<key> to C<value>.

=cut

*/

    VTABLE void set_string_keyed_int(INTVAL key, STRING *value) {
        PMC * const ptr =
            Parrot_Array_set_pmc_ptr(INTERP, (List *)PMC_data(SELF), key);

        VTABLE_set_string_native(INTERP, ptr, value);
    }

/*

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

Sets the string value of the PMC at element C<key> to C<value>.

=cut

*/

    VTABLE void set_string_keyed(PMC *key, STRING *value) {
        INTVAL ix;
        PMC   *nextkey, *box;

        if (!key)
            return;

        ix      = key_integer(INTERP, key);
        nextkey = key_next(INTERP, key);

        if (!nextkey) {
            VTABLE_set_string_keyed_int(INTERP, SELF, ix, value);
            return;
        }

        box = SELF.get_pmc_keyed_int(ix);

        /* autovivify an Array */
        if (!box)
            box = pmc_new(INTERP, SELF.type());

        VTABLE_set_string_keyed(INTERP, box, nextkey, value);
    }

/*

=item C<void set_pmc_keyed_int(INTVAL idx, PMC *src)>

Sets the PMC at element C<idx> to C<*src>.

=cut

*/

    VTABLE void set_pmc_keyed_int(INTVAL idx, PMC *src) {
        const INTVAL length = ((List *)PMC_data(SELF))->length;

        if (idx >= length || -idx > length)
            Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_OUT_OF_BOUNDS,
                "Array index out of bounds!");

        list_assign(INTERP, (List *)PMC_data(SELF), idx,
            (void *)src, enum_type_PMC);
    }

/*

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

Sets the PMC at index C<key> to C<value>.

=cut

*/

    VTABLE void set_pmc_keyed(PMC *key, PMC *value) {
        PMC *box;

        const INTVAL ix      = key_integer(INTERP, key);
        PMC * const  nextkey = key_next(INTERP, key);

        if (!nextkey) {
            VTABLE_set_pmc_keyed_int(INTERP, SELF, ix, value);
            return;
        }

        box = SELF.get_pmc_keyed_int(ix);

        /* autovivify an Array */
        if (!box)
            box = pmc_new(INTERP, SELF.type());

        VTABLE_set_pmc_keyed(INTERP, box, nextkey, value);
    }

/*

=item C<void push_integer(INTVAL value)>

Extends the array by adding an element of value C<value> to the end of
the array.

=cut

*/

    VTABLE void push_integer(INTVAL value) {
        const INTVAL nextix = SELF.elements();
        SELF.set_integer_keyed_int(nextix, value);
    }

/*

=item C<void push_float(FLOATVAL value)>

Extends the array by adding an element of value C<value> to the end of
the array.

=cut

*/

    VTABLE void push_float(FLOATVAL value) {
        const INTVAL nextix = SELF.elements();
        SELF.set_number_keyed_int(nextix, value);
    }

/*

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

Extends the array by adding an element of value C<*value> to the end of
the array.

=cut

*/

    VTABLE void push_string(STRING *value) {
        const INTVAL nextix = SELF.elements();
        SELF.set_string_keyed_int(nextix, value);
    }

/*

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

Extends the array by adding an element of value C<*value> to the end of
the array.

=cut

*/

    void push_pmc(PMC *value) {
        const INTVAL nextix = SELF.elements();
        SELF.set_pmc_keyed_int(nextix, value);
    }

/*

=item C<void unshift_integer(INTVAL value)>

Extends the array by adding an element of value C<value> to the start
of the array.

=cut

*/

    VTABLE void unshift_integer(INTVAL value) {
        PMC * const val = undef(INTERP);

        list_unshift(INTERP, (List *)PMC_data(SELF), val, enum_type_PMC);
        VTABLE_set_integer_native(INTERP, val, value);
    }

/*

=item C<void unshift_float(FLOATVAL value)>

Extends the array by adding an element of value C<value> to the start
of the array.

=cut

*/

    VTABLE void unshift_float(FLOATVAL value) {
        PMC * const val = undef(INTERP);

        list_unshift(INTERP, (List *)PMC_data(SELF), val, enum_type_PMC);
        VTABLE_set_number_native(INTERP, val, value);
    }

/*

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

Extends the array by adding an element of value C<*value> to the start
of the array.

=cut

*/

    VTABLE void unshift_string(STRING *value) {
        PMC * const val = undef(INTERP);
        list_unshift(INTERP, (List *)PMC_data(SELF), val, enum_type_PMC);
        VTABLE_set_string_native(INTERP, val, value);
    }

/*

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

Extends the array by adding an element of value C<*value> to the start
of the array.

=cut

*/

    void unshift_pmc(PMC *value) {
        list_unshift(INTERP, (List *)PMC_data(SELF), value, enum_type_PMC);
    }

/*

=item C<INTVAL pop_integer()>

Removes and returns an integer from the end of the array.

=cut

*/

    VTABLE INTVAL pop_integer() {
        PMC * const ptr = SELF.pop_pmc();
        return VTABLE_get_integer(INTERP, ptr);
    }

/*

=item C<FLOATVAL pop_float()>

Removes and returns a float value from the end of the array.

=cut

*/

    VTABLE FLOATVAL pop_float() {
        PMC * const ptr = SELF.pop_pmc();
        return VTABLE_get_number(INTERP, ptr);
    }

/*

=item C<STRING *pop_string()>

Removes and returns a string from the end of the array.

=cut

*/

    VTABLE STRING *pop_string() {
        PMC * const ptr = SELF.pop_pmc();
        return VTABLE_get_string(INTERP, ptr);
    }

/*

=item C<PMC *pop_pmc()>

Removes and returns a PMC from the end of the array.

=cut

*/

    VTABLE PMC *pop_pmc() {
        return retval(INTERP,
            list_pop(INTERP, (List *)PMC_data(SELF), enum_type_PMC));
    }

/*

=item C<INTVAL shift_integer()>

Removes and returns an integer from the start of the array.

=cut

*/

    VTABLE INTVAL shift_integer() {
        PMC * const ptr = SELF.shift_pmc();
        return VTABLE_get_integer(INTERP, ptr);
    }

/*

=item C<FLOATVAL shift_float()>

Removes and returns a float from the start of the array.

=cut

*/

    VTABLE FLOATVAL shift_float() {
        PMC * const ptr = SELF.shift_pmc();
        return VTABLE_get_number(INTERP, ptr);
    }

/*

=item C<STRING *shift_string()>

Removes and returns a string from the start of the array.

=cut

*/

    VTABLE STRING *shift_string() {
        PMC * const ptr = SELF.shift_pmc();
        return VTABLE_get_string(INTERP, ptr);
    }

/*

=item C<PMC *shift_pmc()>

Removes and returns a PMC from the start of the array.

=cut

*/

    VTABLE PMC *shift_pmc() {
        return retval(INTERP,
            list_shift(INTERP, (List *)PMC_data(SELF), enum_type_PMC));
    }

/*

=item C<void splice(PMC *value, INTVAL offset, INTVAL count)>

Replaces C<count> elements starting at C<offset> with the elements in
C<value>.

If C<count> is 0 then the elements in C<value> will be inserted after
C<offset>.

=cut

*/

    void splice(PMC *value, INTVAL offset, INTVAL count) {
        if (SELF->vtable->base_type != value->vtable->base_type)
            Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_INVALID_OPERATION,
                "Type mismatch in splice");

        list_splice(INTERP, (List *)PMC_data(SELF),
            (List *)PMC_data(value), offset, count);
    }

/*

=item C<INTVAL defined_keyed_int(INTVAL key)>

Returns TRUE is the element at C<key> is defined; otherwise returns false.

=cut

*/

    VTABLE INTVAL defined_keyed_int(INTVAL key) {
        PMC  *value;
        void * const ret =
            list_get(INTERP, (List *)PMC_data(pmc), key, enum_type_PMC);

        if (ret == 0 || ret == (void *) -1)
            return 0;

        value = *(PMC **)ret;

        if (!value)
            return 0;

        return VTABLE_defined(INTERP, value);
    }

/*

=item C<INTVAL defined_keyed(PMC *key)>

Returns TRUE is the element at C<key> is defined; otherwise returns false.

=cut

*/

    VTABLE INTVAL defined_keyed(PMC *key) {
        PMC *box;

        const INTVAL ix      = key_integer(INTERP, key);
        PMC * const  nextkey = key_next(INTERP, key);

        if (!nextkey)
            return SELF.defined_keyed_int(ix);

        box = SELF.get_pmc_keyed_int(ix);

        if (!box)
            return 0;

        return VTABLE_defined_keyed(INTERP, box, nextkey);
    }

/*

=item C<INTVAL exists_keyed_int(INTVAL key)>

Returns TRUE is the element at C<key> exists; otherwise returns false.

=cut

*/

    VTABLE INTVAL exists_keyed_int(INTVAL key) {
        void * ret = list_get(INTERP,
            (List *)PMC_data(pmc), key, enum_type_PMC);

        if (ret == 0 || ret == (void *)-1)
            return 0;

        return !PMC_IS_NULL(*(PMC **)ret);
    }

/*

=item C<INTVAL exists_keyed(PMC *key)>

Returns TRUE is the element at C<key> exists; otherwise returns false.

=cut

*/

    VTABLE INTVAL exists_keyed(PMC *key) {
        PMC *box;

        const INTVAL ix      = key_integer(INTERP, key);
        PMC * const  nextkey = key_next(INTERP, key);

        if (!nextkey)
            return SELF.exists_keyed_int(ix);

        box = SELF.get_pmc_keyed_int(ix);

        if (!box)
            return 0;

        return VTABLE_exists_keyed(INTERP, box, nextkey);
    }

/*

=item C<void delete_keyed_int(INTVAL key)>

Removes the element at C<key>.

=cut

*/

    VTABLE void delete_keyed_int(INTVAL key) {
        list_splice(INTERP, (List *)PMC_data(pmc), NULL, key, 1);
    }

/*

=item C<void delete_keyed(PMC *key)>

Removes the element at C<*key>.

=cut

*/

    VTABLE void delete_keyed(PMC *key) {
        const INTVAL ix = key_integer(INTERP, key);
        list_splice(INTERP, (List *)PMC_data(pmc), NULL, ix, 1);
    }

/*

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

The C<==> operation. Compares two array to hold equal elements.

=cut

*/

    VTABLE INTVAL is_equal(PMC *value) {
        INTVAL j, n;

        if (value->vtable->base_type != enum_class_Array)
            return 0;

        n = SELF.elements();

        if (VTABLE_elements(INTERP, value) != n)
            return 0;

        for (j = 0; j < n; ++j) {
            PMC * const item1 = SELF.get_pmc_keyed_int(j);
            PMC * const item2 = VTABLE_get_pmc_keyed_int(INTERP, value, j);

            if (item1 != item2) {
                INTVAL result;
                Parrot_mmd_multi_dispatch_from_c_args(INTERP, "is_equal",
                    "PP->I", item1, item2, &result);
                if (!result)
                    return 0;
            }
        }

        return 1;
    }

/*

=item C<PMC *slice(PMC *key, INTVAL f)>

Return a new iterator for the slice PMC C<key> if f == 0.

Return a new pythonic array slice if f == 1.

=item C<PMC *get_iter()>

Return a new iterator for SELF.

=cut

*/

    VTABLE PMC *slice(PMC *key, INTVAL f) {
        if (f == 0) {
            STRING     *name = CONST_STRING(interp, "set_key");
            PMC * const iter = pmc_new_init(INTERP, enum_class_Iterator, SELF);
            Parrot_PCCINVOKE(interp, iter, name, "P->", key);
            return iter;
        }

        Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_INVALID_OPERATION,
                "Array: Unknown slice type");
    }

    VTABLE PMC *get_iter() {
        STRING     *name = CONST_STRING(interp, "set_key");
        PMC * const iter = pmc_new_init(INTERP, enum_class_Iterator, SELF);
        PMC * const key  = pmc_new(INTERP, enum_class_Key);
        Parrot_PCCINVOKE(interp, iter, name, "P->", key);

        PObj_get_FLAGS(key) |= KEY_integer_FLAG;
        PMC_int_val(key)     = 0;

        if (!((List *)PMC_data(SELF))->length)
            PMC_int_val(key) = -1;

        return iter;
    }

/*

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

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

C<*info> is the visit info, (see F<include/parrot/pmc_freeze.h>).

=cut

*/

    VTABLE void visit(visit_info *info) {
        list_visit(INTERP, (List *)PMC_data(SELF), info);
        SUPER(info);
    }

/*

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

Used to archive the array.

=cut

*/

    VTABLE void freeze(visit_info *info) {
        IMAGE_IO * const io = info->image_io;
        SUPER(info);
        VTABLE_push_integer(INTERP, io, VTABLE_elements(INTERP, SELF));
    }

/*

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

Used to unarchive the array.

=cut

*/

    VTABLE void thaw(visit_info *info) {
        IMAGE_IO * const io = info->image_io;

        SUPER(info);
        if (info->extra_flags == EXTRA_IS_NULL) {
            SELF.set_integer_native(VTABLE_shift_integer(INTERP, io));
    }
}

/*

=item C<PMC *share_ro()>

Recursively make the array read-only and shared.

=cut

*/
    VTABLE PMC *share_ro() {
        PMC *_true, *ret;

        /* prevent infinite recursion */
        if (PObj_is_PMC_shared_TEST(SELF))
            Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_INVALID_OPERATION,
                    "share_ro on something that already is shared");

        _true = pmc_new(INTERP, enum_class_Integer);
        VTABLE_set_integer_native(INTERP, _true, 1);

        ret   = pt_shared_fixup(INTERP, SELF);

        /* first set readonly */
        VTABLE_setprop(INTERP, ret, CONST_STRING(INTERP, "_ro"), _true);

        /* XXX do something that deals better with sparse lists */
        {
            INTVAL i;
            const INTVAL max = VTABLE_elements(INTERP, ret);

            for (i = 0; i < max; ++i) {
                PMC * const value =
                    (PMC *)list_get(INTERP, PMC_data_typed(ret, List *),
                                 i, enum_type_PMC);

                if (!PMC_IS_NULL(value)) {
                    /* XXX do we need to clone first? */
                    PMC * const new_value = VTABLE_share_ro(INTERP, value);

                    if (new_value != value)
                        list_assign(INTERP, PMC_data_typed(ret, List *),
                            i, new_value, enum_type_PMC);
                }
            }
        }

        /* XXX FIXME workaround lack of metadata sharing */
        PMC_metadata(SELF) = NULL;

        return ret;
    }
}

/*

=back

=head1 SEE ALSO

F<src/list.c>, F<include/parrot/list.h>

=head1 TODO

Create global immutable undef object.

=cut

*/

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