From fe701a61f4d057597dab3d46ba0fe31e550b41df Mon Sep 17 00:00:00 2001
From: Peter Mikkelsen <petermikkelsen10@gmail.com>
Date: Tue, 11 Jan 2022 17:04:30 +0000
Subject: =?UTF-8?q?Add=20monadic=20=E2=89=A2=20and=20=E2=8D=B4?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 apl9.h      |  2 ++
 functions.c | 66 ++++++++++++++++++++++++++++++++++++++++---------------------
 2 files changed, 45 insertions(+), 23 deletions(-)

diff --git a/apl9.h b/apl9.h
index 4080a81..bc6f894 100644
--- a/apl9.h
+++ b/apl9.h
@@ -82,9 +82,11 @@ int simplescalar(Array *);
 Datum *eval(Datum *, int *);
 
 /* Monadic functions from functions.h */
+Array *fnTally(Array *);
 Array *fnEnclose(Array *);
 Array *fnNest(Array *);
 Array *fnRavel(Array *);
+Array *fnShape(Array *);
 
 /* Dyadic functions from functions.h */
 Array *fnCatenateFirst(Array *, Array *);
diff --git a/functions.c b/functions.c
index ddd5532..8a5c959 100644
--- a/functions.c
+++ b/functions.c
@@ -31,7 +31,7 @@ fnmonad monadfunctiondefs[] = {
 	0, /* > */
 	0, /* ≥ */
 	0, /* ≡ */
-	0, /* ≢ */
+	fnTally, /* ≢ */
 	0, /* ∨ */
 	0, /* ∧ */
 	0, /* ⍲ */
@@ -53,7 +53,7 @@ fnmonad monadfunctiondefs[] = {
 	0, /* ~ */
 	fnRavel, /* , */
 	0, /* ⍪ */
-	0, /* ⍴ */
+	fnShape, /* ⍴ */
 	0, /* ⌽ */
 	0, /* ⊖ */
 	0, /* ⍉ */
@@ -61,30 +61,12 @@ fnmonad monadfunctiondefs[] = {
 	0,  /* ⍕ */
 };
 
-Array *
-fnCatenateFirst(Array *left, Array *right)
-{
-	/* not even close to being right, but it works for stranding :) */
-	if(left->rank == 0)
-		left = fnRavel(left);
-	if(right->rank == 0)
-		right = fnRavel(right);
-
-	/* assume two vectors of same type for now */
-	Array *res = mkarray(left->type, 1, left->size+right->size);
-	res->shape[0] = left->shape[0] + right->shape[0];
-	memcpy(res->rawdata, left->rawdata, datasizes[res->type]*left->size);
-	memcpy(res->rawdata+datasizes[res->type]*left->size, right->rawdata, datasizes[res->type]*right->size);
-	return res;
-}
+/* Monadic functions */
 
 Array *
-fnNest(Array *right)
+fnTally(Array *right)
 {
-	if(simplearray(right))
-		return fnEnclose(right);
-	else
-		return right;
+	return mkscalarint(right->rank==0 ? 1 : right->shape[0]);
 }
 
 Array *
@@ -99,6 +81,15 @@ fnEnclose(Array *right)
 	}
 }
 
+Array *
+fnNest(Array *right)
+{
+	if(simplearray(right))
+		return fnEnclose(right);
+	else
+		return right;
+}
+
 Array *
 fnRavel(Array *right)
 {
@@ -107,4 +98,33 @@ fnRavel(Array *right)
 	res->shape = realloc(res->shape, sizeof(int) * 1);
 	res->shape[0] = res->size;
 	return res;
+}
+
+Array *
+fnShape(Array *right)
+{
+	Array *res = mkarray(AtypeInt, 1, right->rank);
+	res->shape[0] = right->rank;
+	for(int i = 0; i < right->rank; i++)
+		res->intdata[i] = right->shape[i];
+	return res;
+}
+
+/* Dyadic functions */
+
+Array *
+fnCatenateFirst(Array *left, Array *right)
+{
+	/* not even close to being right, but it works for stranding :) */
+	if(left->rank == 0)
+		left = fnRavel(left);
+	if(right->rank == 0)
+		right = fnRavel(right);
+
+	/* assume two vectors of same type for now */
+	Array *res = mkarray(left->type, 1, left->size+right->size);
+	res->shape[0] = left->shape[0] + right->shape[0];
+	memcpy(res->rawdata, left->rawdata, datasizes[res->type]*left->size);
+	memcpy(res->rawdata+datasizes[res->type]*left->size, right->rawdata, datasizes[res->type]*right->size);
+	return res;
 }
\ No newline at end of file
-- 
cgit v1.2.3