Implement monadic f⌿ and f/. Identity elements and windowed reduce is not implemented yet

2 files changed, 73 insertions, 4 deletions

diff --git a/apl9.h b/apl9.h
index 11643d5..6e6574e 100644
--- a/apl9.h
+++ b/apl9.h
@@ -270,6 +270,12 @@ Array *opSwitch(Datum *, Array *, Array *);
 /* Dyadic operators from operators.c */
 Array *opOver(Datum *, Datum *, Array *, Array *);
 
+/* Dyadic functions from hybrids.c */
+
+/* Monadic operators from hybrids.c */
+Array *opReduceLast(Datum *, Array *, Array *);
+Array *opReduceFirst(Datum *, Array *, Array *);
+
 /* Global variables */
 extern int traceeval; /* eval.c */
 extern int debugmem; /* memory.c */
diff --git a/hybrids.c b/hybrids.c
index 3483d42..39f3f7a 100644
--- a/hybrids.c
+++ b/hybrids.c
@@ -4,7 +4,7 @@
 
 #include "apl9.h"
 
-Rune primhybridnames[] = L"/\⌿⍀";
+Rune primhybridnames[] = L"/\\⌿⍀";
 
 fndyad hybridfunctiondefs[] = {
 	0, /* / */
@@ -14,8 +14,71 @@ fndyad hybridfunctiondefs[] = {
 };
 
 opmonad hybridoperatordefs[] = {
-	0, /* / */
+	opReduceLast, /* / */
 	0, /* \ */
-	0, /* ⌿ */
+	opReduceFirst, /* ⌿ */
 	0, /* ⍀ */
-};
\ No newline at end of file
+};
+
+/* function definitions */
+
+/* operator definitions */
+Array *
+opReduceLast(Datum *lefto, Array *left, Array *right)
+{
+	if(left)
+		throwerror(L"left argument to f/", ENotImplemented);
+
+	right = fnTranspose(right);
+	Array *tmp = opReduceFirst(lefto, left, right);
+	Array *res = fnTranspose(tmp);
+	freearray(right);
+	freearray(tmp);
+	return res;
+}
+
+Array *
+opReduceFirst(Datum *lefto, Array *left, Array *right)
+{
+	if(left)
+		throwerror(L"left argument to f⌿", ENotImplemented);
+
+	if(right->rank == 0)
+		return fnSame(right);
+
+	int n = right->shape[0];
+	int io = currentsymtab->io;
+	if(n == 0)
+		throwerror(L"Can't figure out identity element", ENotImplemented);
+
+	Array *result = allocarray(AtypeArray, right->rank - 1, right->size / n);
+	for(int i = 0; i < right->rank-1; i++)
+		result->shape[i] = right->shape[i+1];
+
+	Array *index = allocarray(AtypeArray, 1, right->rank);
+	index->shape[0] = right->rank;
+	Array *tmp = mkscalarint(n);
+	index->arraydata[0] = fnIndexGenerator(tmp);
+	freearray(tmp);
+	for(int i = 1; i < index->size; i++)
+		index->arraydata[i] = mkscalarint(io);
+
+	for(int i = 0; i < result->size; i++){
+		for(int j = index->size - 1; index->arraydata[j]->intdata[0] == io + right->shape[j]; j--){
+			index->arraydata[j]->intdata[0] = io;
+			index->arraydata[j-1]->intdata[0]++;
+		}
+		Array *vector = fnIndex(index, right);
+		result->arraydata[i] = arrayitem(vector, n-1);
+		for(int j = n-2; j >= 0; j--){
+			Array *argL = arrayitem(vector, j);
+			Array *argR = result->arraydata[i];
+			result->arraydata[i] = runfunc(lefto->func, argL, argR);
+			freearray(argL);
+			freearray(argR);
+		}
+		index->arraydata[index->size-1]->intdata[0]++;
+	}
+	freearray(index);
+	return result;
+}