shithub: lpa

Download patch

ref: f1e8a146075542d085cfb8e632849415d32eb2b0
parent: 6bc6badcb6768cd559431f139d13c7b9e5ef16ed
author: Peter Mikkelsen <[email protected]>
date: Sat Jul 27 07:47:55 EDT 2024

Implement monadic ⍴

--- a/array.c
+++ b/array.c
@@ -79,6 +79,18 @@
 	a->shape[dim] = size;
 }
 
+int
+getrank(Array *a)
+{
+	return a->rank;
+}
+
+usize
+getshape(Array *a, int dim)
+{
+	return a->shape[dim];
+}
+
 static int printarraysub(char *, Array *, int);
 static int
 printitem(char *p, Array *a, uvlong i, int depth)
--- a/fns.h
+++ b/fns.h
@@ -5,6 +5,9 @@
 void setchar(Array *, usize, Rune);
 void setarray(Array *, usize, Array *);
 void setshape(Array *, int, usize);
+int getrank(Array *);
+usize getshape(Array *, int);
+
 Array *simplifyarray(Array *);
 char *printarray(Array *);
 char *printfunc(Function *);
--- a/parse.c
+++ b/parse.c
@@ -426,7 +426,12 @@
 	case TokString:
 		str = t->tokens[t->offset].string;
 		len = runestrlen(str);
-		val->val = allocarray(TypeChar, len != 1, len);
+		if(len == 1)
+			val->val = allocarray(TypeChar, 0, len);
+		else{
+			val->val = allocarray(TypeChar, 1, len);
+			setshape(val->val, 0, len);
+		}
 		for(uvlong i = 0; i < len; i++)
 			setchar(val->val, i, str[i]);
 		break;
--- a/prim.c
+++ b/prim.c
@@ -9,6 +9,7 @@
 
 /* monadic functions */
 static Array *primfn_same(Array *);
+static Array *primfn_shape(Array *);
 
 /* dyadic functions */
 static Array *primfn_left(Array *, Array *);
@@ -25,6 +26,7 @@
 	"⊣", NameclassFunc, nil, primfn_same, primfn_left,
 	"+", NameclassFunc, nil, nil, nil,
 	"-", NameclassFunc, nil, nil, nil,
+	"⍴", NameclassFunc, nil, primfn_shape, nil,
 };
 
 char *
@@ -93,6 +95,19 @@
 primfn_same(Array *a)
 {
 	return a;
+}
+
+static Array *
+primfn_shape(Array *a)
+{
+	Array *r;
+	int rank;
+
+	rank = getrank(a);
+	r = allocarray(TypeNumber, 1, rank);
+	for(int dim = 0; dim < rank; dim++)
+		setint(r, dim, getshape(a, dim));
+	return r;
 }
 
 /* dyadic functions */