/*
Copyright (C) 2001-2003, The Perl Foundation.
$Id: /mirror/trunk/languages/APL/src/pmc/aplvector.pmc 33586 2008-12-06T13:00:56.132030Z moritz  $


=head1 NAME

src/pmc/APLVector.pmc - APLVector

=head1 DESCRIPTION

These are the vtable functions for the APL Vector class.

=cut

=head2 Helper functions

=over 4

=item INTVAL size_of_shape(INTERP, PMC)

=cut

*/

#include "parrot/parrot.h"

static INTVAL
size_of_shape(Interp *interp, PMC* self, PMC* shape)
{
    INTVAL retval;
    INTVAL dimension;
    INTVAL length;
    INTVAL pos;

    if (!shape || PMC_IS_NULL(shape)) {
        /* not set, so a simple 1D */
        return VTABLE_get_integer(interp, self);
    }

    retval = 1;
    dimension = VTABLE_get_integer(interp, shape);
    for (pos = 0; pos < dimension; pos++)
    {
        length = VTABLE_get_integer_keyed_int(interp, shape, pos);
        retval *= length;
    }
    return retval;
}

/*

=back

=head2 Methods

=over 4

=cut

*/




pmclass APLVector
    extends ResizablePMCArray
    provides array
    group   apl_group

    need_ext
    dynpmc
    {

/*

=item C<void class_init()>

initialize the pmc class. Store some constants, etc.

=cut

*/

    /* RT#48194: move any constant string declarations here so we just do them once. */
    void class_init() {
    }


/*

=item C<PMC* init()>

initialize the instance.

=cut

*/

void init() {
    SUPER();
};

/*

=item C<PMC* get_shape()>

Returns a vector-like PMC containing the shape of this PMC.

=cut

*/

    METHOD PMC* get_shape() {
        PMC* shape;
        INTVAL array_t;
        STRING* property_name;

        property_name = string_from_literal(INTERP, "shape");
        shape = VTABLE_getprop(INTERP, SELF, property_name);
        if (PMC_IS_NULL(shape)) {
           /*
            * No shape has been set yet. This means that we are
            * a simple vector
            *
            * we use our own type here. Perhaps a better way to
            * specify it?
            */
            /*
            array_t = pmc_type(INTERP,
                string_from_literal(INTERP, "APLVector"));
            */
            shape = pmc_new(INTERP, VTABLE_type(INTERP, SELF));

            VTABLE_set_integer_native(INTERP, shape, 1);
            VTABLE_set_integer_keyed_int(INTERP, shape, 0,
                VTABLE_get_integer(INTERP, SELF));
            VTABLE_setprop(INTERP, SELF, property_name, shape);
        }
        RETURN(PMC* shape);
    }

/*

=item C<PMC* set_shape()>

Reshape the existing APLvector by passing in an existing vector.

If the new shape is larger than our old shape, pad the end of the APLv
with elements from the beginning.

If the new shape is shorter than our old shape, truncate elements from
the end of the APLv.

=cut

*/


    METHOD set_shape(PMC *new_shape) {
        STRING* property_name;
        PMC*    old_shape;
        INTVAL  old_size, new_size, pos;

        /* save the old shape momentarily, set the new shape */
        property_name = string_from_literal(INTERP, "shape");
        old_shape = VTABLE_getprop(INTERP, SELF, property_name);
        VTABLE_setprop(INTERP, SELF, property_name, new_shape);

        /* how big are these shapes? */
        old_size = size_of_shape(INTERP, SELF, old_shape);
        new_size = size_of_shape(INTERP, SELF, new_shape);

        if (old_size > new_size) {
            for (; new_size != old_size; new_size++) {
                VTABLE_pop_pmc(INTERP, SELF);
            }
        } else if (new_size > old_size) {
            pos = 0;
            for (; new_size != old_size; old_size++, pos++) {
                /* RT#48196 clone this? */
                VTABLE_push_pmc(INTERP, SELF,
                    VTABLE_get_pmc_keyed_int(INTERP, SELF, pos));
            }
        }
    }

/*

=back

=cut

*/

}


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