Merge branch 'master' of github.com:Whiteknight/parrot-linear-algebra

config/Makefile.in

@@ -39,7 +39,8 @@ DYNEXT_TARGET = $(DYNEXT_DIR)/$(GROUP)$(LOAD_EXT)
 PMC2C_INCLUDES = --include $(PMC_DIR) --include $(SRC_DIR) --include $(SRC_DIR)/pmc
 
 PMC_SOURCES = \
-    $(PMC_DIR)/nummatrix2d.pmc
+    $(PMC_DIR)/nummatrix2d.pmc \
+    $(PMC_DIR)/pmcmatrix2d.pmc
 
 all: $(DYNEXT_TARGET)
 
@@ -53,18 +54,25 @@ clean:
 	$(RM_F) dynext/*$(LOAD_EXT)
 
 realclean: clean
+	$(RM_F) t/*.pbc
 	$(RM_F) Makefile
+
 
 
 install: all
 #IF(cygwin or hpux):    CHMOD 0775 linalg_group$(LOAD_EXT)
 	$(CP) linalg_group$(LOAD_EXT) $(INSTALL_DIR)
 
-
 uninstall:
 	$(RM_F) $(INSTALL_DIR)/linalg_group$(LOAD_EXT)
 
-$(DYNPMC): $(PMC_SOURCES)
+test: t/Glue.pbc all
+	$(NQP) t/harness t/*.t	
+
+t/Glue.pbc: t/Glue.pir
+	$(PARROT) -o t/Glue.pbc t/Glue.pir
+
+$(DYNPMC): src/pmc/pla_matrix_types.h $(PMC_SOURCES)
 	$(PMC2C) --no-lines --dump $(PMC2C_INCLUDES) $(PMC_SOURCES)
 	$(PMC2C) --no-lines --c $(PMC2C_INCLUDES) $(PMC_SOURCES)
 	$(PMC2C) --no-lines --library $(GROUP) --c $(PMC_SOURCES)
@@ -91,6 +99,7 @@ help:
 	@echo "Installation:"
 	@echo "  install:           Install the pmcs to Parrot's install dir"
 	@echo "  uninstall:         Remove an existing installation"
+	@echo ""
 	@echo "Misc:"
 	@echo "  help:              Print this help message."
 	@echo ""

src/pmc/nummatrix2d.pmc

@@ -1,26 +1,6 @@
+#include "pla_matrix_types.h"
 #include <cblas.h>
 
-#define GET_INDICES_FROM_KEY(i, k, x, y) \
-    do { \
-        (x) = VTABLE_get_integer((i), (k)); \
-        (k) = VTABLE_shift_pmc((i), (k)); \
-        (y) = VTABLE_get_integer((i), (k)); \
-    } while(0);
-
-#define INDEX_XY_ROWMAJOR(x_max, y_max, x, y) \
-    (((x_max) * (x)) + (y))
-
-#define INDEX_XY_COLMAJOR(x_max, y_max, x, y) \
-    (((y_max) * (y)) + (x))
-
-#define ITEM_XY_ROWMAJOR(s, x_max, y_max, x, y) \
-    (s)[((x_max) * (x)) + (y)]
-
-#define ITEM_XY_COLMAJOR(s, x_max, y_max, x, y) \
-    (s)[((y_max) * (y)) + (x)]
-
-#define INDEX_MIN(a, b) (((a) <= (b))?(a):(b))
-#define INDEX_MAX(a, b) (((a) >= (b))?(a):(b))
 
 /* 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

src/pmc/pla_matrix_types.h

@@ -0,0 +1,26 @@
+#ifndef _PLA_MATRIX_TYPES_H_
+#define _PLA_MATRIX_TYPES_H_
+
+#define GET_INDICES_FROM_KEY(i, k, x, y) \
+do { \
+    (x) = VTABLE_get_integer((i), (k)); \
+    (k) = VTABLE_shift_pmc((i), (k)); \
+    (y) = VTABLE_get_integer((i), (k)); \
+} while(0);
+
+#define INDEX_XY_ROWMAJOR(x_max, y_max, x, y) \
+    (((x_max) * (x)) + (y))
+
+#define INDEX_XY_COLMAJOR(x_max, y_max, x, y) \
+    (((y_max) * (y)) + (x))
+
+#define ITEM_XY_ROWMAJOR(s, x_max, y_max, x, y) \
+    (s)[((x_max) * (x)) + (y)]
+
+#define ITEM_XY_COLMAJOR(s, x_max, y_max, x, y) \
+    (s)[((y_max) * (y)) + (x)]
+
+#define INDEX_MIN(a, b) (((a) <= (b))?(a):(b))
+#define INDEX_MAX(a, b) (((a) >= (b))?(a):(b))
+
+#endif

src/pmc/pmcmatrix2d.pmc

@@ -0,0 +1,105 @@
+#include "pla_matrix_types.h"
+
+/* 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. */
+static void
+resize_matrix(PARROT_INTERP, PMC * self, INTVAL x, INTVAL y)
+{
+    Parrot_PMCMatrix2D_attributes * const attrs = PARROT_PMCMATRIX2D(self);
+    const INTVAL old_x = attrs->x;
+    const INTVAL old_y = attrs->y;
+    const INTVAL new_x = INDEX_MAX(old_x, x + 1);
+    const INTVAL new_y = INDEX_MAX(old_y, y + 1);
+    const INTVAL newsize = new_x * new_y;
+    PMC ** new_s = (PMC **)mem_sys_allocate_zeroed(newsize * sizeof (PMC *));
+    PMC ** old_s = attrs->storage;
+    const INTVAL min_x = INDEX_MIN(old_x, new_x);
+    const INTVAL min_y = INDEX_MIN(old_y, new_y);
+    INTVAL i, j;
+    for (i = 0; i < min_x; i++) {
+        for (j = 0; j < min_y; j++) {
+            ITEM_XY_ROWMAJOR(new_s, new_x, new_y, i, j) =
+                ITEM_XY_ROWMAJOR(old_s, old_x, old_y, i, j);
+        }
+    }
+    attrs->storage = new_s;
+    attrs->x = new_x;
+    attrs->y = new_y;
+    free(old_s);
+}
+
+
+pmclass PMCMatrix2D dynpmc auto_attrs {
+    ATTR PMC ** storage;
+    ATTR INTVAL x;
+    ATTR INTVAL y;
+
+    VTABLE void init() {
+        PObj_custom_destroy_SET(SELF);
+    }
+
+    VTABLE PMC * get_pmc_keyed(PMC * key) {
+        INTVAL x, y, x_size, y_size;
+        Parrot_PMCMatrix2D_attributes * const attrs
+            = (Parrot_PMCMatrix2D_attributes *) PARROT_PMCMATRIX2D(SELF);
+        x_size = attrs->x;
+        y_size = attrs->y;
+        GET_INDICES_FROM_KEY(INTERP, key, x, y);
+        if (x >= x_size || y >= y_size)
+            Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_OUT_OF_BOUNDS,
+                                        "NumMatrix2d: indices out of bounds");
+        return ITEM_XY_ROWMAJOR(attrs->storage, x_size, y_size, x, y);
+    }
+
+    VTABLE INTVAL get_integer_keyed(PMC * key) {
+        PMC * item = VTABLE_get_pmc_keyed(INTERP, SELF, key);
+        return VTABLE_get_integer(INTERP, item);
+    }
+
+    VTABLE FLOATVAL get_number_keyed(PMC * key) {
+        PMC * item = VTABLE_get_pmc_keyed(INTERP, SELF, key);
+        return VTABLE_get_number(INTERP, item);
+    }
+
+    VTABLE STRING * get_string_keyed(PMC * key) {
+        PMC * item = VTABLE_get_pmc_keyed(INTERP, SELF, key);
+        return VTABLE_get_string(INTERP, item);
+    }
+
+    VTABLE void set_pmc_keyed(PMC * key, PMC * value) {
+        INTVAL x, y, x_size, y_size;
+        Parrot_PMCMatrix2D_attributes * const attrs
+            = (Parrot_PMCMatrix2D_attributes *) PARROT_PMCMATRIX2D(SELF);
+        x_size = attrs->x;
+        y_size = attrs->y;
+        GET_INDICES_FROM_KEY(INTERP, key, x, y);
+        if (x >= x_size || y >= y_size) {
+            resize_matrix(INTERP, SELF, x, y);
+            x_size = attrs->x;
+            y_size = attrs->y;
+        }
+        ITEM_XY_ROWMAJOR(attrs->storage, x_size, y_size, x, y) = value;
+    }
+
+    VTABLE void set_integer_keyed(PMC * key, INTVAL value) {
+        PMC * item = pmc_new(INTERP, enum_class_Integer);
+        VTABLE_set_integer_native(INTERP, item, value);
+        VTABLE_set_pmc_keyed(INTERP, SELF, key, item);
+    }
+
+    VTABLE void set_number_keyed(PMC * key, FLOATVAL value) {
+        PMC * item = pmc_new(INTERP, enum_class_Float);
+        VTABLE_set_number_native(INTERP, item, value);
+        VTABLE_set_pmc_keyed(INTERP, SELF, key, item);
+    }
+
+    VTABLE void set_string_keyed(PMC * key, STRING * value) {
+        PMC * item = pmc_new(INTERP, enum_class_String);
+        VTABLE_set_string_native(INTERP, item, value);
+        VTABLE_set_pmc_keyed(INTERP, SELF, key, item);
+    }
+}

t/00-sanity.t

@@ -0,0 +1,15 @@
+#! parrot_nqp
+our @ARGS;
+MAIN();
+
+sub MAIN () {
+    my $num_tests := 18;
+    Q:PIR {
+        .local pmc c
+        load_language 'parrot'
+        c = compreg 'parrot'
+        c.'import'('Test::More')
+    };
+    plan(1);
+    ok(1, "Test harness works");
+}

t/10-nummatrix.t

@@ -0,0 +1,85 @@
+#! parrot_nqp
+our @ARGS;
+MAIN();
+
+sub MAIN () {
+    my $num_tests := 18;
+    Q:PIR {
+        .local pmc c
+        load_language 'parrot'
+        c = compreg 'parrot'
+        c.'import'('Test::More')
+
+        .local pmc pla
+        pla = loadlib 'linalg_group'
+        if pla goto pla_library_loaded
+        say "Cannot load linalg_group"
+        exit 1
+      pla_library_loaded:
+    };
+    plan(11);
+    create_nummatrix2d();
+    set_number_nummatrix2d();
+    get_number_nummatrix2d();
+}
+
+sub create_nummatrix2d() {
+    Q:PIR {
+        $P0 = new 'NumMatrix2D'
+        $I0 = isnull $P0
+        $I0 = not $I0
+        'ok'($I0, "Can create a new NumMatrix2D")
+    }
+}
+
+sub set_number_nummatrix2d() {
+    Q:PIR {
+        push_eh can_not_set
+        $P0 = new 'NumMatrix2D'
+        $P0[2;2] = 3.0
+        $P0[0;0] = 1.0
+        $P0[1;1] = 2.0
+        ok(1, "can set values")
+        goto test_passed
+      can_not_set:
+        ok(0, "Cannot set values")
+      test_passed:
+    }
+}
+
+sub get_number_nummatrix2d() {
+    Q:PIR {
+        $P0 = new 'NumMatrix2D'
+        $P0[2;2] = 3.0
+        $P0[0;0] = 1.0
+        $P0[1;1] = 2.0
+
+        $N0 = $P0[0;0]
+        is($N0, 1.0, "Got 1,1")
+
+        $N0 = $P0[0;1]
+        is($N0, 0.0, "Got 1,1")
+
+        $N0 = $P0[0;2]
+        is($N0, 0.0, "Got 1,1")
+
+        $N0 = $P0[1;0]
+        is($N0, 0.0, "Got 1,1")
+
+        $N0 = $P0[1;1]
+        is($N0, 2.0, "Got 1,1")
+
+        $N0 = $P0[1;2]
+        is($N0, 0.0, "Got 1,1")
+
+        $N0 = $P0[2;0]
+        is($N0, 0.0, "Got 1,1")
+
+        $N0 = $P0[2;1]
+        is($N0, 0.0, "Got 1,1")
+
+        $N0 = $P0[2;2]
+        is($N0, 3.0, "Got 1,1")
+    }
+}
+