nummatrix2d.pmc

#include "pla_matrix_types.h"
#include <cblas.h>

#define ALLOCATE_STORAGE(s) (FLOATVAL *)mem_sys_allocate_zeroed(s * sizeof (FLOATVAL))
#define PLATYPENAME "NumMatrix2D"

/* Resize the matrix internal storage to be able to hold a point at position
   (x, y). The matrix grows but does not shrink. New spaces in the matrix
   are initialized to 0.0. Parameters x and y are the indices that are trying
   to be accessed, so we must resize the matrix to be able to accomodate those
   indices. Notice that the matrix type is zero-indexed, so the size is one
   plus the highest index that we need to access.

   This function will not shrink the matrix, only grow it. After the call,
   the matrix will be at least large enough to hold an item at the given
   index. To shrink the matrix, use the get_block() method, or that
   algorithm. */
static void
resize_matrix(PARROT_INTERP, PMC * self, INTVAL row, INTVAL col)
{
    Parrot_NumMatrix2D_attributes * const attrs = PARROT_NUMMATRIX2D(self);
    /* Store the old values */
    const INTVAL old_rows = attrs->rows;
    const INTVAL old_cols = attrs->cols;
    FLOATVAL * old_s = attrs->storage;

    /* rows and y are indices, not sizes. Resize the matrix to accomodate this
       new point without shrinking by taking the max. */
    const INTVAL new_rows = INDEX_MAX(old_rows, row + 1);
    const INTVAL new_cols = INDEX_MAX(old_cols, col + 1);
    const INTVAL newsize = new_rows * new_cols;
    FLOATVAL * new_s = ALLOCATE_STORAGE(newsize);

    INTVAL i, j;
    for (i = 0; i < old_rows; i++) {
        for (j = 0; j < old_cols; j++) {
            ITEM_XY_ROWMAJOR(new_s, new_rows, new_cols, i, j) =
                ITEM_XY_ROWMAJOR(old_s, old_rows, old_cols, i, j);
        }
    }
    attrs->storage = new_s;
    attrs->rows = new_rows;
    attrs->cols = new_cols;
    if (old_s)
        mem_sys_free(old_s);
}

/* If the matrix is lazily transposed, actually transpose the physical memory
   layout. This is necessary for calculations, especially BLAS calculations,
   which aren't lazy-transpose-aware. */
static void
normalize_lazy_transpose(PARROT_INTERP, PMC * self)
{
    Parrot_NumMatrix2D_attributes * const attrs = PARROT_NUMMATRIX2D(self);

    if (IS_TRANSPOSED(attrs->flags)) {
        const INTVAL rows_size = attrs->rows;
        const INTVAL cols_size = attrs->cols;
        const INTVAL size = rows_size * cols_size;
        FLOATVAL * const new_s = ALLOCATE_STORAGE(size);
        FLOATVAL * const old_s = attrs->storage;
        INTVAL i, j;

        for (i = 0; i < rows_size; ++i) {
            for (j = 0; j < cols_size; ++j) {
                ITEM_XY_COLMAJOR(new_s, rows_size, cols_size, i, j) =
                    ITEM_XY_ROWMAJOR(old_s, rows_size, cols_size, i, j);
            }
        }
        attrs->storage = new_s;
        mem_sys_free(old_s);
        FLAG_CLEAR(attrs->flags, FLAG_TRANSPOSED);
    }
}

/* Initialize the PMC from an array, filling the matrix row-at-a-time */
static void
init_from_pmc_array(PARROT_INTERP, PMC * self, INTVAL rows_size,
    INTVAL cols_size, PMC * values)
{
    Parrot_NumMatrix2D_attributes * const attrs = PARROT_NUMMATRIX2D(self);
    FLOATVAL * s;
    INTVAL self_rows, self_cols, i, j, num = 0;
    const INTVAL init_elems = VTABLE_elements(interp, values);

    resize_matrix(interp, self, rows_size - 1, cols_size - 1);
    self_rows = attrs->rows;
    self_cols = attrs->cols;
    s = attrs->storage;

    for (i = 0; i < rows_size; i++) {
        for (j = 0; j < cols_size; j++) {
            const FLOATVAL value = VTABLE_get_number_keyed_int(interp, values, num);
            num++;
            ITEM_XY_ROWMAJOR(s, self_rows, self_cols, i, j) = value;
            if (num >= init_elems)
                return;
        }
    }
}

static void
add_scalar_float(PARROT_INTERP, PMC * self, FLOATVAL v)
{
    Parrot_NumMatrix2D_attributes * const attrs = PARROT_NUMMATRIX2D(self);
    const INTVAL rows_size = attrs->rows;
    const INTVAL cols_size = attrs->cols;
    FLOATVAL * const s = attrs->storage;
    INTVAL i, j;

    /* TODO: See if BLAS has a routine to do this */
    for (j = 0; j < cols_size; j++) {
        for (i = 0; i < rows_size; i++) {
            ITEM_XY_ROWMAJOR(s, rows_size, cols_size, i, j) += v;
        }
    }
}

pmclass NumMatrix2D dynpmc auto_attrs provides matrix {
    ATTR FLOATVAL * storage;
    ATTR INTVAL rows;
    ATTR INTVAL cols;
    ATTR INTVAL flags;

/*

=head1 VTABLEs

=over 4

=item* init

=cut

*/

    VTABLE void init() {
        Parrot_NumMatrix2D_attributes * const a = PARROT_NUMMATRIX2D(SELF);
        a->storage = NULL;
        a->rows = 0;
        a->cols = 0;
        a->flags = 0;
        PObj_custom_destroy_SET(SELF);
    }

    VTABLE void destroy() {
        Parrot_NumMatrix2D_attributes * const a = PARROT_NUMMATRIX2D(SELF);
        FLOATVAL * const s = a->storage;
        if (s)
            mem_sys_free(s);
    }

/*

=item* get_number_keyed

=item* get_integer_keyed

=item* get_string_keyed

=item* get_pmc_keyed

=cut

*/

    VTABLE FLOATVAL get_number_keyed(PMC * key) {
        Parrot_NumMatrix2D_attributes * const attrs = PARROT_NUMMATRIX2D(SELF);
        const INTVAL rows_size = attrs->rows;
        const INTVAL cols_size = attrs->cols;
        INTVAL rows, cols;
        GET_KEY_INDICES_ROWMAJOR(INTERP, key, rows, cols);
        if (rows >= rows_size || cols >= cols_size)
            Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_OUT_OF_BOUNDS,
                "NumMatrix2d: indices out of bounds");
        return ITEM_XY(attrs->storage, attrs->flags, rows_size, cols_size, rows, cols);
    }

    VTABLE INTVAL get_integer_keyed(PMC * key) {
        const FLOATVAL f = VTABLE_get_number_keyed(INTERP, SELF, key);
        return (INTVAL)f;
    }

    VTABLE STRING * get_string_keyed(PMC * key) {
        const FLOATVAL f = VTABLE_get_number_keyed(INTERP, SELF, key);
        STRING * const item = Parrot_sprintf_c(INTERP, "\t%f", f);
        return item;
    }

    VTABLE PMC * get_pmc_keyed(PMC * key) {
        const FLOATVAL f = VTABLE_get_number_keyed(INTERP, SELF, key);
        PMC * const item = Parrot_pmc_new(INTERP, enum_class_Float);
        VTABLE_set_number_native(INTERP, item, f);
        return item;
    }

/*

=item* get_number_keyed_int

=item* get_integer_keyed_int

=item* get_string_keyed_int

=item* get_pmc_keyed_int

=cut

*/

    VTABLE FLOATVAL get_number_keyed_int(INTVAL key) {
        Parrot_NumMatrix2D_attributes * const attrs = PARROT_NUMMATRIX2D(SELF);
        const INTVAL total_size = attrs->rows * attrs->cols;
        if (key >= total_size) {
            Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_OUT_OF_BOUNDS,
                                        "NumMatrix2D: Matrix dimensions must match in add.");
        }
        return attrs->storage[key];
    }

    VTABLE INTVAL get_integer_keyed_int(INTVAL key) {
        const FLOATVAL f = VTABLE_get_number_keyed_int(INTERP, SELF, key);
        return (INTVAL)f;
    }

    VTABLE STRING * get_string_keyed_int(INTVAL key) {
        const FLOATVAL f = VTABLE_get_number_keyed_int(INTERP, SELF, key);
        STRING * const item = Parrot_sprintf_c(INTERP, "\t%f", f);
        return item;
    }

    VTABLE PMC * get_pmc_keyed_int(INTVAL key) {
        const FLOATVAL f = VTABLE_get_number_keyed_int(INTERP, SELF, key);
        PMC * const item = Parrot_pmc_new(INTERP, enum_class_Float);
        VTABLE_set_number_native(INTERP, item, f);
        return item;
    }

/*

=item* set_number_keyed

=item* set_integer_keyed

=cut

*/

    VTABLE void set_number_keyed(PMC * key, FLOATVAL value) {
        Parrot_NumMatrix2D_attributes * const attrs = PARROT_NUMMATRIX2D(SELF);
        INTVAL rows, cols, rows_size = attrs->rows, cols_size = attrs->cols;
        GET_KEY_INDICES_ROWMAJOR(INTERP, key, rows, cols);
        if (rows >= rows_size || cols >= cols_size) {
            resize_matrix(INTERP, SELF, rows, cols);
            rows_size = attrs->rows;
            cols_size = attrs->cols;
        }
        ITEM_XY(attrs->storage, attrs->flags, rows_size, cols_size, rows, cols) = value;
    }

    VTABLE void set_integer_keyed(PMC * key, INTVAL value) {
        VTABLE_set_number_keyed(INTERP, SELF, key, (FLOATVAL)value);
    }

    VTABLE void set_pmc_keyed(PMC * key, PMC * value) {
        const FLOATVAL v = VTABLE_get_number(INTERP, value);
        VTABLE_set_number_keyed(INTERP, SELF, key, v);
    }

/*

=item* get_string

=cut

*/

    VTABLE STRING *get_string() {
        INTVAL rows, cols;
        STRING *pstr = Parrot_str_new(INTERP, "", 0);
        STRING * const newline = Parrot_str_new(INTERP, "\n", 1);
        Parrot_NumMatrix2D_attributes * const attrs = PARROT_NUMMATRIX2D(SELF);
        FLOATVAL * const s = attrs->storage;
        const INTVAL rows_size = attrs->rows;
        const INTVAL cols_size = attrs->cols;

        if (IS_TRANSPOSED(attrs->flags)) {
            for (cols = 0; cols < cols_size; ++cols) {
                for (rows = 0; rows < rows_size; ++rows) {
                    const FLOATVAL f = ITEM_XY_COLMAJOR(s, rows_size, cols_size, rows, cols);
                    STRING * const item = Parrot_sprintf_c(INTERP, "\t%f", f);
                    pstr = Parrot_str_append(INTERP, pstr, item);
                }
                pstr = Parrot_str_append(INTERP, pstr, newline);
            }
        }
        else {
            for (rows = 0; rows < rows_size; ++rows) {
                for (cols = 0; cols < cols_size; ++cols) {
                    const FLOATVAL f = ITEM_XY_ROWMAJOR(s, rows_size, cols_size, rows, cols);
                    STRING * const item = Parrot_sprintf_c(INTERP, "\t%f", f);
                    pstr = Parrot_str_append(INTERP, pstr, item);
                }
                pstr = Parrot_str_append(INTERP, pstr, newline);
            }
        }
        return pstr;
    }

/*

=item* add

=cut

*/

    MULTI PMC *add(NumMatrix2D *value, PMC *dest) {
        int i = 0, j = 0;
        Parrot_NumMatrix2D_attributes * const selfattr = PARROT_NUMMATRIX2D(SELF);
        Parrot_NumMatrix2D_attributes * const valattr = PARROT_NUMMATRIX2D(value);
        Parrot_NumMatrix2D_attributes * destattr;
        const INTVAL rows_size = selfattr->rows;
        const INTVAL cols_size = selfattr->cols;
        const INTVAL storage_size = rows_size * cols_size;

        if (rows_size != valattr->rows || cols_size != valattr->cols)
            Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_OUT_OF_BOUNDS,
              "NumMatrix2D: Matrix dimensions must match in add.");

        normalize_lazy_transpose(INTERP, SELF);
        normalize_lazy_transpose(INTERP, value);
        dest = VTABLE_clone(INTERP, value);
        destattr = PARROT_NUMMATRIX2D(dest);
        cblas_daxpy(storage_size, 1, selfattr->storage, 1, destattr->storage, 1);
        return dest;
    }

    MULTI PMC *add(DEFAULT *value, PMC *dest) {
        const FLOATVAL v = VTABLE_get_number(INTERP, value);
        dest = VTABLE_clone(INTERP, SELF);
        add_scalar_float(INTERP, dest, v);
        return dest;
    }

/*

=item* multiply

=cut

*/

    MULTI PMC *multiply(NumMatrix2D *value, PMC *dest) {
        INTVAL rows_size = 0, cols_size = 0, sflags = 0, vflags = 0;

        Parrot_NumMatrix2D_attributes * const selfattr = PARROT_NUMMATRIX2D(SELF);
        Parrot_NumMatrix2D_attributes * const valattr = PARROT_NUMMATRIX2D(value);
        Parrot_NumMatrix2D_attributes * destattr = NULL;

        rows_size = selfattr->rows;
        cols_size = valattr->cols;
        sflags = selfattr->flags;
        vflags = valattr->flags;

        if (selfattr->cols != valattr->rows) {
            Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_OUT_OF_BOUNDS,
              "NumMatrix2D:");
        }

        dest = Parrot_pmc_new(INTERP, VTABLE_type(INTERP, SELF));
        resize_matrix(INTERP, dest, rows_size - 1, cols_size - 1);
        destattr = (Parrot_NumMatrix2D_attributes *) PARROT_NUMMATRIX2D(dest);

        if (IS_TINY(sflags) || (IS_GENERAL(sflags) && IS_GENERAL(vflags))) {
            cblas_dgemm(CblasRowMajor,
                IS_TRANSPOSED_BLAS(selfattr->flags),
                IS_TRANSPOSED_BLAS(valattr->flags),
                rows_size,
                selfattr->cols,
                cols_size,
                1.,
                selfattr->storage,
                rows_size,
                valattr->storage,
                cols_size,
                0.,
                destattr->storage,
                rows_size
            );
        }
        else if (IS_SYMMETRIC(sflags)) {
            cblas_dsymm(
                CblasRowMajor,
                (IS_TRANSPOSED(vflags) ? CblasRight : CblasLeft),
                CblasUpper,
                rows_size,
                cols_size,
                1.,
                selfattr->storage,
                rows_size,
                valattr->storage,
                valattr->rows,
                1.,
                destattr->storage,
                rows_size
            );

            if (IS_TRANSPOSED(vflags)) {
                /* TODO: Transpose matrix */
            }
        }
        else if (IS_SYMMETRIC(vflags)) {
            cblas_dsymm(
                CblasRowMajor,
                (IS_TRANSPOSED(sflags) ? CblasLeft : CblasRight),
                CblasUpper,
                rows_size,
                cols_size,
                1.,
                valattr->storage,
                valattr->rows,
                selfattr->storage,
                selfattr->rows,
                1.,
                destattr->storage,
                rows_size
            );

            if (IS_TRANSPOSED(sflags)) {
                /* TODO: Transpose matrix */
            }
        }
/*        else if (IS_TRIANGLE(sflags)) {
            cblas_dtrmm(
                CblasRowMajor,
                CblasLeft,
                (IS_LTRIANGLE(sflags) ? CblasLower : CblasUpper),
                rows_size,
                cols_size,
                1.,
                selfattr->storage,
                selfattr->rows,
                valattr->storage,
                valattr->rows,
                0.,
                destattr->storage,
                rows_size
            );

        }
        else if (IS_TRIANGLE(vflags)) {
            cblas_dtrmm(
                CblasRowMajor,
                CblasRight,
                (IS_LTRIANGLE(vflags) ? CblasLower : CblasUpper),

        }
*/
        else {
            Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_UNIMPLEMENTED,
                "parrot-linear-algebra: Method multiply not implemented for "
                "this combination of flags.");
        }

        destattr->flags = sflags & vflags;
        return dest;
    }

    MULTI PMC *multiply(Float *value, PMC *dest) {
        const FLOATVAL v = VTABLE_get_number(INTERP, value);
        Parrot_NumMatrix2D_attributes * const attrs = PARROT_NUMMATRIX2D(SELF);
        Parrot_NumMatrix2D_attributes * dest_attrs;
        const INTVAL rows_size = attrs->rows;
        const INTVAL cols_size = attrs->cols;
        FLOATVAL * const s = attrs->storage;
        FLOATVAL * dest_s;
        INTVAL i, j;

        dest = Parrot_pmc_new(INTERP, SELF->vtable->base_type);
        resize_matrix(INTERP, dest, rows_size - 1, cols_size - 1);
        dest_attrs = PARROT_NUMMATRIX2D(dest);
        dest_s = dest_attrs->storage;

        /* TODO: See if BLAS has a routine to do this */
        for (j = 0; j < cols_size; j++) {
            for (i = 0; i < rows_size; i++) {
                ITEM_XY_ROWMAJOR(dest_s, rows_size, cols_size, i, j) =
                    ITEM_XY_ROWMAJOR(s, rows_size, cols_size, i, j) * v;
            }
        }
        return dest;
    }

    /* TODO: Update this to account for transpositions */
    VTABLE PMC * get_attr_str(STRING * idx) {
        Parrot_NumMatrix2D_attributes * const attrs = PARROT_NUMMATRIX2D(SELF);
        if (Parrot_str_equal(INTERP, idx, CONST_STRING(INTERP, "rows"))) {
            PMC * const rows = Parrot_pmc_new(INTERP, enum_class_Integer);
            VTABLE_set_integer_native(INTERP, rows, attrs->rows);
            return rows;
        }
        else if (Parrot_str_equal(INTERP, idx, CONST_STRING(INTERP, "cols"))) {
            PMC * const cols = Parrot_pmc_new(INTERP, enum_class_Integer);
            VTABLE_set_integer_native(INTERP, cols, attrs->cols);
            return cols;
        }
        else if (Parrot_str_equal(INTERP, idx, CONST_STRING(INTERP, "size"))) {
            PMC * const size = Parrot_pmc_new(INTERP, enum_class_Integer);
            VTABLE_set_integer_native(INTERP, size, attrs->cols * attrs->rows);
            return size;
        }
        return PMCNULL;
    }

    VTABLE PMC * clone() {
        PMC * const c = Parrot_pmc_new(INTERP, SELF->vtable->base_type);
        Parrot_NumMatrix2D_attributes * const old_atts = PARROT_NUMMATRIX2D(SELF);
        Parrot_NumMatrix2D_attributes * const new_atts = PARROT_NUMMATRIX2D(c);
        INTVAL rows, cols;
        INTVAL const rows_size = old_atts->rows;
        INTVAL const cols_size = old_atts->cols;
        INTVAL const newsize = rows_size * cols_size;
        FLOATVAL * const old_s = old_atts->storage;
        FLOATVAL * const new_s = ALLOCATE_STORAGE(newsize);
        for (rows = 0; rows < rows_size; ++rows) {
            for (cols = 0; cols < cols_size; ++cols) {
                ITEM_XY_ROWMAJOR(new_s, rows_size, cols_size, rows, cols) =
                    ITEM_XY_ROWMAJOR(old_s, rows_size, cols_size, rows, cols);
            }
        }
        new_atts->storage = new_s;
        new_atts->flags = old_atts->flags;
        new_atts->rows = rows_size;
        new_atts->cols = cols_size;
        return c;
    }

    VTABLE INTVAL is_equal(PMC * other) {
        if (other->vtable->base_type == SELF->vtable->base_type) {
            Parrot_NumMatrix2D_attributes * const self_attrs = PARROT_NUMMATRIX2D(SELF);
            Parrot_NumMatrix2D_attributes * const other_attrs = PARROT_NUMMATRIX2D(other);
            const INTVAL self_rows = self_attrs->rows;
            const INTVAL self_cols = self_attrs->cols;
            const INTVAL self_flags = self_attrs->flags;
            const INTVAL other_rows = other_attrs->rows;
            const INTVAL other_cols = other_attrs->cols;
            const INTVAL other_flags = other_attrs->flags;
            FLOATVAL * const self_s = self_attrs->storage;
            FLOATVAL * const other_s = other_attrs->storage;
            INTVAL rows, cols;

            if (self_rows != other_rows || self_cols != other_cols)
                return 0;

            for (cols = 0; cols < self_cols; cols++) {
                for (rows = 0; rows < self_rows; rows++) {
                    const FLOATVAL self_value =
                        ITEM_XY(self_s, self_flags, self_rows, self_cols, rows, cols);
                    const FLOATVAL other_value =
                        ITEM_XY(other_s, other_flags, other_rows, other_cols, rows, cols);
                    if (self_value != other_value)
                        return 0;
                }
            }
            return 1;
        }
        return 0;
    }

    VTABLE void freeze(PMC *info) {
        Parrot_NumMatrix2D_attributes * const attrs = PARROT_NUMMATRIX2D(SELF);
        INTVAL const rows = attrs->rows;
        INTVAL const cols = attrs->cols;
        INTVAL const flags = attrs->flags;
        INTVAL i, j;
        FLOATVAL * const s = attrs->storage;
        VTABLE_push_integer(INTERP, info, rows);
        VTABLE_push_integer(INTERP, info, cols);
        VTABLE_push_integer(INTERP, info, flags);
        for (i = 0; i < cols; i++) {
            for (j = 0; j < rows; j++) {
                const FLOATVAL f = ITEM_XY(s, flags, rows, cols, j, i);
                VTABLE_push_float(INTERP, info, f);
            }
        }
    }

    VTABLE void thaw(PMC *info) {
        Parrot_NumMatrix2D_attributes * const attrs = PARROT_NUMMATRIX2D(SELF);
        INTVAL const rows = VTABLE_shift_integer(INTERP, info);
        INTVAL const cols = VTABLE_shift_integer(INTERP, info);
        INTVAL const flags = VTABLE_shift_integer(INTERP, info);
        INTVAL i, j;
        FLOATVAL * s;
        attrs->rows = 0;
        attrs->cols = 0;
        attrs->storage = NULL;
        attrs->flags = 0;
        resize_matrix(INTERP, SELF, rows - 1, cols - 1);
        s = attrs->storage;
        attrs->flags = flags;
        for (i = 0; i < cols; i++) {
            for (j = 0; j < rows; j++) {
                const FLOATVAL f = VTABLE_shift_float(INTERP, info);
                ITEM_XY(s, flags, rows, cols, j, i) = f;
            }
        }
    }




/*

=back

=head1 METHODS

=over 4

*/
/*

=item resize()

=cut

*/

    METHOD resize(INTVAL new_rows, INTVAL new_cols) {
        resize_matrix(INTERP, SELF, new_rows - 1, new_cols - 1);
    }

/*

=item fill()

Fill the matrix with a single value. if sizes are provided, fill to those
sizes, growing the matrix if needed.

=cut

*/

    METHOD fill(FLOATVAL value,
                INTVAL rows_size :optional, INTVAL has_rows_size :opt_flag,
                INTVAL cols_size :optional, INTVAL has_cols_size :opt_flag
               ) {
        Parrot_NumMatrix2D_attributes * const attrs = PARROT_NUMMATRIX2D(SELF);
        FLOATVAL * s  = attrs->storage;
        INTVAL const curr_rows_size = attrs->rows;
        INTVAL const curr_cols_size = attrs->cols;
        INTVAL rows, cols;

        if (!has_rows_size)
            rows_size = curr_rows_size;
        if (!has_cols_size)
            cols_size = curr_cols_size;

        if ((has_rows_size && rows_size > curr_rows_size) ||
            (has_cols_size && cols_size > curr_cols_size)) {
            resize_matrix(INTERP, SELF, rows_size - 1, cols_size - 1);
            s = attrs->storage;
        }

        for (rows = 0; rows < rows_size; ++rows) {
            for (cols = 0; cols < cols_size; ++cols) {
                ITEM_XY_ROWMAJOR(s, rows_size, cols_size, rows, cols) = value;
            }
        }
    }

/*

=item transpose()

Transposes the matrix.

=cut

*/

    METHOD transpose() {
        Parrot_NumMatrix2D_attributes * const attrs = PARROT_NUMMATRIX2D(SELF);
        INTVAL tmp = 0;
        INTVAL transposed = IS_TRANSPOSED(attrs->flags);

        SWAP_XY(attrs);

        if (transposed)
            attrs->flags -= FLAG_TRANSPOSED;
        else
            attrs->flags += FLAG_TRANSPOSED;
        transposed = !transposed;
        RETURN(INTVAL transposed);
    }

/*

=item mem_transpose()

Transposes the actual data storage of the matrix. More expensive up-front
than the transpose() method.

=cut

*/

    METHOD mem_transpose() {
        Parrot_NumMatrix2D_attributes * const attrs = PARROT_NUMMATRIX2D(SELF);
        const INTVAL rows_size = attrs->rows;
        const INTVAL cols_size = attrs->cols;
        const INTVAL newsize = rows_size * cols_size;
        FLOATVAL * new_s = ALLOCATE_STORAGE(newsize);
        FLOATVAL * old_s = attrs->storage;

        INTVAL i, j;
        for (i = 0; i < rows_size; i++) {
            for (j = 0; j < cols_size; j++) {
                ITEM_XY_ROWMAJOR(new_s, cols_size, rows_size, j, i) =
                    ITEM_XY_ROWMAJOR(old_s, rows_size, cols_size, i, j);
            }
        }
        attrs->storage = new_s;
        SWAP_XY(attrs);
        if (old_s)
            free(old_s);
    }

/*

=item iterate_function_inplace()

Calls a function for every element in the array, replacing the current
value with the return value of the called function.

=cut

*/

    METHOD iterate_function_inplace(PMC * func, PMC * args :slurpy) {
        Parrot_NumMatrix2D_attributes * const attrs = PARROT_NUMMATRIX2D(SELF);
        const INTVAL rows_size = attrs->rows;
        const INTVAL cols_size = attrs->cols;
        const INTVAL newsize = rows_size * cols_size;
        FLOATVAL * old_s = attrs->storage;
        FLOATVAL * new_s = ALLOCATE_STORAGE(newsize);
        INTVAL i, j;

        if (newsize == 0 || old_s == NULL)
            RETURN();

        for (j = 0; j < cols_size; j++) {
            for (i = 0; i < rows_size; i++) {
                const FLOATVAL value = ITEM_XY_ROWMAJOR(old_s, rows_size, cols_size, i, j);
                FLOATVAL result = 0.0;
                Parrot_ext_call(INTERP, func, "PNIIPf->N", SELF, value, i, j, args, &result);
                ITEM_XY_ROWMAJOR(new_s, rows_size, cols_size, i, j) = result;
            }
        }
        attrs->storage = new_s;
        if (old_s)
            free(old_s);
    }

    METHOD iterate_function_external(PMC * func, PMC * args :slurpy) {
        Parrot_NumMatrix2D_attributes * const attrs = PARROT_NUMMATRIX2D(SELF);
        PMC * const new_matrix = Parrot_pmc_new(INTERP, SELF->vtable->base_type);
        Parrot_NumMatrix2D_attributes * new_attrs;
        const INTVAL rows_size = attrs->rows;
        const INTVAL cols_size = attrs->cols;
        const INTVAL newsize = rows_size * cols_size;
        FLOATVAL * const self_s = attrs->storage;
        FLOATVAL * new_s;
        INTVAL i, j;

        if (newsize == 0 || self_s == NULL)
            RETURN(PMC * new_matrix);

        resize_matrix(INTERP, new_matrix, rows_size - 1, cols_size - 1);
        new_attrs = PARROT_NUMMATRIX2D(new_matrix);
        new_s = new_attrs->storage;

        for (j = 0; j < cols_size; j++) {
            for (i = 0; i < rows_size; i++) {
                FLOATVAL value = ITEM_XY_ROWMAJOR(self_s, rows_size, cols_size, i, j);
                FLOATVAL result = 0.0;
                Parrot_ext_call(INTERP, func, "PNIIPf->N", SELF, value, i, j, args, &result);
                ITEM_XY_ROWMAJOR(new_s, rows_size, cols_size, i, j) = result;
            }
        }
        RETURN(PMC * new_matrix);
    }

/*

=item instantiate_from_array()

Instantiate a new matrix from a linear array, filling each row with data
in order.

=cut

*/

    METHOD initialize_from_array(INTVAL rows_size, INTVAL cols_size, PMC *values) {
        init_from_pmc_array(INTERP, SELF, rows_size, cols_size, values);
    }

    METHOD initialize_from_args(INTVAL rows_size, INTVAL cols_size, PMC *values :slurpy) {
        init_from_pmc_array(INTERP, SELF, rows_size, cols_size, values);
    }

    METHOD get_block(INTVAL rows_idx, INTVAL cols_idx, INTVAL rows_size, INTVAL cols_size) {
        Parrot_NumMatrix2D_attributes * const attrs = PARROT_NUMMATRIX2D(SELF);
        FLOATVAL * const s = attrs->storage;
        const INTVAL rows = attrs->rows;
        const INTVAL cols = attrs->cols;
        INTVAL i, j;

        if ((rows < rows_idx + rows_size) || (cols < cols_idx + cols_size))
            Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_OUT_OF_BOUNDS,
                PLATYPENAME ": Block boundaries exceed matrix size");
        if (rows_idx < 0 || cols_idx < 0)
            Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_OUT_OF_BOUNDS,
                PLATYPENAME ": Can not get block at negative location");
        if (rows_size < 0 || cols_size < 0)
            Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_OUT_OF_BOUNDS,
                PLATYPENAME ": Can not get block with negative size");
        else {
            PMC * const new_matrix = Parrot_pmc_new(INTERP, SELF->vtable->base_type);
            Parrot_NumMatrix2D_attributes * const new_attrs = PARROT_NUMMATRIX2D(new_matrix);
            FLOATVAL * new_s;
            resize_matrix(INTERP, new_matrix, rows_size - 1, cols_size - 1);
            new_s = new_attrs->storage;
            for (i = 0; i < cols_size; i++) {
                for (j = 0; j < rows_size; j++) {
                    ITEM_XY_ROWMAJOR(new_s, rows_size, cols_size, j, i) =
                        ITEM_XY_ROWMAJOR(s, rows, cols, j + rows_idx, i + cols_idx);
                }
            }
            RETURN(PMC * new_matrix);
        }
    }

    METHOD set_block(INTVAL rows_idx, INTVAL cols_idx, PMC * blck) {
        Parrot_NumMatrix2D_attributes * const self_attrs = PARROT_NUMMATRIX2D(SELF);
        Parrot_NumMatrix2D_attributes * const blck_attrs = PARROT_NUMMATRIX2D(blck);
        FLOATVAL * self_s = self_attrs->storage;
        FLOATVAL * const blck_s = blck_attrs->storage;
        INTVAL self_rows = self_attrs->rows;
        INTVAL self_cols = self_attrs->cols;
        const INTVAL blck_rows = blck_attrs->rows;
        const INTVAL blck_cols = blck_attrs->cols;
        INTVAL i, j;

        if (rows_idx < 0 || cols_idx < 0)
            Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_OUT_OF_BOUNDS,
                PLATYPENAME ": Can not set_block with negative indices");

        if (!VTABLE_does(INTERP, blck, CONST_STRING(interp, "matrix")))
            /* TODO: In this case, we should be able to do a .fill over the block
                     dimensions with VTABLE_get_number on the scalar value */
            Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_OUT_OF_BOUNDS,
                PLATYPENAME ": Can not set_block on a non-matrix value");

        if (blck_rows + rows_idx > self_rows || blck_cols + cols_idx > self_cols) {
            resize_matrix(INTERP, SELF, blck_rows + rows_idx - 1, blck_cols + cols_idx - 1);
            self_s = self_attrs->storage;
            self_rows = self_attrs->rows;
            self_cols = self_attrs->cols;
        }
        for (i = 0; i < blck_cols; i++) {
            for (j = 0; j < blck_rows; j++) {
                ITEM_XY_ROWMAJOR(self_s, self_rows, self_cols, j + rows_idx, i + cols_idx) =
                    ITEM_XY_ROWMAJOR(blck_s, blck_rows, blck_cols, j, i);
            }
        }
    }

/*

=back

=end

*/
}