From 9dad240ddfbe770ddfc8e1556d77328696a6734c Mon Sep 17 00:00:00 2001
From: Peter Mikkelsen <petermikkelsen10@gmail.com>
Date: Sat, 22 Jan 2022 00:29:08 +0000
Subject: =?UTF-8?q?Implement=20atop,=20but=20not=20rank=20yet=20(=E2=8D=A4?=
 =?UTF-8?q?)?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 operators.c | 49 ++++++++++++++++++++++++++++++++++++++++++++++++-
 1 file changed, 48 insertions(+), 1 deletion(-)

(limited to 'operators.c')

diff --git a/operators.c b/operators.c
index 32b9074..05eed7d 100644
--- a/operators.c
+++ b/operators.c
@@ -19,7 +19,7 @@ opdyad dyadoperatordefs[] = {
 	0, /* ⍣ */
 	0, /* . */
 	opBind, /* ∘ */
-	0, /* ⍤ */
+	opAtop, /* ⍤ */
 	opOver, /* ⍥ */
 	0, /* @ */
 	0, /* ⍠ */
@@ -95,6 +95,53 @@ opBind(Datum *lefto, Datum *righto, Array *left, Array *right)
 		return nil;
 }
 
+Array *
+opAtop(Datum *lefto, Datum *righto, Array *left, Array *right)
+{
+	if(lefto->tag == FunctionTag && righto->tag == FunctionTag){
+		Array *right1;
+		if(left)
+			right1 = runfunc(righto->func, left, right);
+		else
+			right1 = runfunc(righto->func, nil, right);
+		Array *result = runfunc(lefto->func, nil, right1);
+		freearray(right1);
+		return result;
+	}else if(lefto->tag == FunctionTag && righto->tag == ArrayTag){
+		Array *ranks = righto->array;
+		if(ranks->rank > 1)
+			throwerror(nil, ERank);
+		if(ranks->type != AtypeInt)
+			throwerror(nil, EType);
+		if(ranks->size < 1 || ranks->size > 3)
+			throwerror(nil, ELength);
+		int p,q,r;
+		switch(ranks->size){
+		case 1: p = q = r = ranks->intdata[0]; break;
+		case 2:
+			q = ranks->intdata[0];
+			p = r = ranks->intdata[1];
+			break;
+		case 3:
+			p = ranks->intdata[0];
+			q = ranks->intdata[1];
+			r = ranks->intdata[2];
+			break;
+		default:
+			p = q = r = 0;
+		}
+		print("Running %S with ranks %d %d %d\n", ppdatum(*lefto), p, q, r);
+		if(left)
+			throwerror(nil, ENotImplemented);
+		else{
+			
+		}
+		throwerror(nil, ENotImplemented);
+		return nil;
+	}else
+		return nil;
+}
+
 Array *
 opOver(Datum *lefto, Datum *righto, Array *left, Array *right)
 {
-- 
cgit v1.2.3