shithub: lpa

Download patch

ref: 1da09c81867fc8416f99b8d7a24d73b2e3acf6e6
parent: f1e8a146075542d085cfb8e632849415d32eb2b0
author: Peter Mikkelsen <peter@pmikkelsen.com>
date: Sat Jul 27 08:40:39 EDT 2024 

Implement dyadic ≡


--- a/array.c
+++ b/array.c
@@ -80,6 +80,12 @@
 }
 
 int
+gettype(Array *a)
+{
+	return a->type;
+}
+
+int
 getrank(Array *a)
 {
 	return a->rank;
@@ -89,6 +95,24 @@
 getshape(Array *a, int dim)
 {
 	return a->shape[dim];
+}
+
+vlong
+getint(Array *a, usize i)
+{
+	return a->intdata[i];
+}
+
+Rune
+getchar(Array *a, usize i)
+{
+	return a->chardata[i];
+}
+
+Array *
+getarray(Array *a, usize i)
+{
+	return a->arraydata[i];
 }
 
 static int printarraysub(char *, Array *, int);
--- a/fns.h
+++ b/fns.h
@@ -5,8 +5,12 @@
 void setchar(Array *, usize, Rune);
 void setarray(Array *, usize, Array *);
 void setshape(Array *, int, usize);
+int gettype(Array *);
 int getrank(Array *);
 usize getshape(Array *, int);
+vlong getint(Array *, usize);
+Rune getchar(Array *, usize);
+Array *getarray(Array *, usize);
 
 Array *simplifyarray(Array *);
 char *printarray(Array *);
--- a/prim.c
+++ b/prim.c
@@ -14,6 +14,7 @@
 /* dyadic functions */
 static Array *primfn_left(Array *, Array *);
 static Array *primfn_right(Array *, Array *);
+static Array *primfn_match(Array *, Array *);
 
 struct {
 	char *spelling;
@@ -27,6 +28,7 @@
 	"+", NameclassFunc, nil, nil, nil,
 	"-", NameclassFunc, nil, nil, nil,
 	"⍴", NameclassFunc, nil, primfn_shape, nil,
+	"≡", NameclassFunc, nil, nil, primfn_match,
 };
 
 char *
@@ -121,4 +123,56 @@
 primfn_right(Array *, Array *y)
 {
 	return y;
+}
+
+static int
+matches(Array *x, Array *y)
+{
+	int res = 0;
+	usize size = 1;
+	int type = gettype(x);
+
+	if(gettype(x) != gettype(y))
+		goto no;
+	if(getrank(x) != getrank(y))
+		goto no;
+	for(int dim = 0; dim < getrank(x); dim++){
+		if(getshape(x, dim) != getshape(y, dim))
+			goto no;
+		size *= getshape(x, dim);
+	}
+
+	for(usize i = 0; i < size; i++){
+		switch(type){
+		case TypeNumber:
+			if(getint(x, i) != getint(y, i))
+				goto no;
+			break;
+		case TypeChar:
+			if(getchar(x, i) != getchar(y, i))
+				goto no;
+			break;
+		case TypeArray:
+			if(!matches(getarray(x, i), getarray(y, i))) /* TODO: RECURSION */
+				goto no;
+			/* TODO: that means we can save space by making them
+			 * point to the same thing :)
+			 */
+			break;
+		default:
+			error(EInternal, "unknown element type");
+		}
+	}
+
+	res = 1;
+no:
+	return res;
+}
+
+static Array *
+primfn_match(Array *x, Array *y)
+{
+	Array *z = allocarray(TypeNumber, 0, 1);
+	setint(z, 0, matches(x, y));
+	return z;
 }
\ No newline at end of file