From 07082593ab4abfbf9a3dd6729cb2e548ec303115 Mon Sep 17 00:00:00 2001
From: Peter Mikkelsen <petermikkelsen10@gmail.com>
Date: Fri, 14 Jan 2022 00:31:03 +0000
Subject: =?UTF-8?q?Implement=20code=20for=20running=20operators=20(both=20?=
 =?UTF-8?q?monadic=20and=20dyadic).=20Also=20implement=20=E2=8D=A8=20and?=
 =?UTF-8?q?=20=E2=8D=A5=20since=20they=20are=20very=20simple?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 apl9.h      | 48 ++++++++++++++++++++++++++-----
 eval.c      | 93 +++++++++++++++++++++++++++++++++----------------------------
 functions.c | 40 ++++++++++++++++++++++++++
 lexer.c     | 10 ++++---
 mkfile      |  1 +
 operators.c | 64 ++++++++++++++++++++++++++++++++++++++++++
 print.c     | 31 ++++++++++++++++++---
 7 files changed, 229 insertions(+), 58 deletions(-)
 create mode 100644 operators.c

diff --git a/apl9.h b/apl9.h
index 63b6d7a..72b8ca2 100644
--- a/apl9.h
+++ b/apl9.h
@@ -25,15 +25,23 @@ typedef enum
 	AtypeArray,
 } arrayDataType;
 
+typedef enum
+{
+	OperatortypeDop,
+	OperatortypePrim,
+} operatorType;
+
 typedef enum
 {
 	FunctypeDfn,
 	FunctypePrim,
+	FunctypeOp,
 } functionType;
 
 /* Data types */
 typedef struct Array Array;
 typedef struct Statement Statement;
+typedef struct Operator Operator;
 typedef struct Function Function;
 typedef struct Datum Datum;
 typedef struct Symbol Symbol;
@@ -61,12 +69,25 @@ struct Statement
 	Statement *next;
 };
 
+struct Operator
+{
+	operatorType type;
+	int dyadic;
+	union {
+		int code;
+		Rune *dop;
+	};
+	Datum *left;
+	Datum *right;
+};
+
 struct Function
 {
 	functionType type;
 	union {
 		int code;
 		Rune *dfn;
+		Operator operator;
 	};
 	Array *left;
 };
@@ -79,6 +100,7 @@ struct Datum
 		Array *array;
 		Statement stmt;
 		Function func;
+		Operator operator;
 		Symbol *symbol;
 	};
 };
@@ -98,6 +120,8 @@ struct Symtab
 
 typedef Array* (*fnmonad)(Array*);
 typedef Array* (*fndyad)(Array*, Array*);
+typedef Array* (*opmonad)(Datum *, Array *, Array *);
+typedef Array* (*opdyad)(Datum *, Datum *, Array *, Array *);
 
 /* Function prototypes for the different source files */
 /* main.c */
@@ -107,6 +131,7 @@ Datum *evalline(Rune *);
 Rune *ppdatum(Datum);
 Rune *ppdatums(Datum *, int);
 Rune *pparray(Array *);
+Rune *ppoperator(Operator);
 
 /* lexer.c */
 Statement *lexline(Rune *);
@@ -133,7 +158,10 @@ Array *allocarray(int, int, int);
 void freearray(Array *);
 void incref(Array *);
 
-/* Monadic functions from functions.h */
+/* functions.c */
+Array *runfunc(Function, Array *,Array *);
+
+/* Monadic functions from function.c */
 Array *fnSame(Array *);
 Array *fnTally(Array *);
 Array *fnEnclose(Array *);
@@ -142,7 +170,7 @@ Array *fnIndexGenerator(Array *);
 Array *fnRavel(Array *);
 Array *fnShape(Array *);
 
-/* Dyadic functions from functions.h */
+/* Dyadic functions from function.c */
 Array *fnPlus(Array *, Array *);
 Array *fnMinus(Array *, Array *);
 Array *fnTimes(Array *, Array *);
@@ -154,16 +182,22 @@ Array *fnRight(Array *, Array *);
 Array *fnCatenateFirst(Array *, Array *);
 Array *fnReshape(Array *, Array *);
 
+/* Monadic operators from operators.c */
+Array *opSwitch(Datum *, Array *, Array *);
+Array *opOver(Datum *, Datum *, Array *, Array *);
+
 /* Global variables */
 extern int traceeval; /* eval.c */
 extern Rune *errormsg; /* eval.c */
 extern int datasizes[]; /* array.c */
-extern Rune primfuncnames[]; /* function.c */
-extern Rune primmonopnames[]; /* lexer.c */
-extern Rune primdyadopnames[]; /* lexer.c */
+extern Rune primfuncnames[]; /* functions.c */
+extern Rune primmonopnames[]; /* operators.c */
+extern Rune primdyadopnames[]; /* operators.c */
 extern Rune primhybridnames[]; /* lexer.c */
-extern fnmonad monadfunctiondefs[]; /* function.c */
-extern fndyad dyadfunctiondefs[]; /* function.c */
+extern fnmonad monadfunctiondefs[]; /* functions.c */
+extern fndyad dyadfunctiondefs[]; /* functions.c */
+extern opmonad monadoperatordefs[]; /* operators.c */
+extern opdyad dyadoperatordefs[]; /* operators.c */
 extern Symtab *globalsymtab; /* symbol.c */
 extern Symtab *currentsymtab; /* symbol.c */
 extern int alloccounts; /* memory.c */
\ No newline at end of file
diff --git a/eval.c b/eval.c
index 6b59c74..e7b0a13 100644
--- a/eval.c
+++ b/eval.c
@@ -17,32 +17,34 @@ Datum dyadfun(Datum, Datum);
 Datum parens(Datum, Datum);
 Datum nameis(Datum, Datum);
 Datum assign(Datum, Datum);
+Datum monadop(Datum, Datum);
+Datum dyadop(Datum, Datum);
 Datum *lookup(Datum);
 
 int bindingstrengths[13][13] = {
 /*	A  F  H  MO DO AF (  )  [  ]  ←  IS N */
-	4, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* A */
-	2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* F */
-	0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* H */
+	6, 3, 0, 4, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* A */
+	2, 0, 0, 4, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* F */
+	0, 0, 0, 4, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* H */
 	0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* MO */
-	0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* DO */
+	5, 5, 5, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* DO */
 	2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* AF */
-	0, 0, 0, 0, 0, 0, 0, 5, 0, 0, 0, 0, 0, /* ( */
-	5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, /* ) */
+	0, 0, 0, 0, 0, 0, 0, 7, 0, 0, 0, 0, 0, /* ( */
+	7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, /* ) */
 	0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* [ */
 	0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* ] */
 	0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* ← */
 	1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* IS */
-	0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 6, 0, 0, /* N */
+	0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 8, 0, 0, /* N */
 };
 
 evalfn evalfns[13][13] = {
 /*	A  F  H  MO DO AF (  )  [  ] ← IS N */
-	strand, dyadfun, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* A */
-	monadfun, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* F */
-	0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* H */
+	strand, dyadfun, 0, monadop, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* A */
+	monadfun, 0, 0, monadop, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* F */
+	0, 0, 0, monadop, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* H */
 	0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* MO */
-	0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* DO */
+	dyadop, dyadop, dyadop, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* DO */
 	monadfun, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* AF */
 	0, 0, 0, 0, 0, 0, 0, parens, 0, 0, 0, 0, 0, /* ( */
 	0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* ) */
@@ -164,38 +166,7 @@ monadfun(Datum left, Datum right)
 	Datum result;
 	result.tag = ArrayTag;
 	result.shy = 0;
-
-	if(left.func.type == FunctypeDfn){
-		Symtab *tmpsymtab = currentsymtab;
-		currentsymtab = newsymtab();
-		if(left.func.left){
-			Symbol *alpha = getsym(currentsymtab, L"⍺");
-			alpha->value.tag = ArrayTag;
-			alpha->value.array = left.func.left;
-			/* no need to increment refs, since it was done on binding the arg */
-			alpha->undefined = 0;
-		}
-
-		Symbol *omega = getsym(currentsymtab, L"⍵");
-		omega->value = right;
-		omega->undefined = 0;
-		incref(right.array);
-
-		Datum *dfnres = evalline(left.func.dfn);
-		freesymtab(currentsymtab);
-		currentsymtab = tmpsymtab;
-		return *dfnres; /* TODO what if the evaluation failed */
-	}else{
-		/* TODO handle undefined functions here */
-		if(left.func.left)
-			result.array = dyadfunctiondefs[left.func.code](left.func.left, right.array);
-		else
-			result.array = monadfunctiondefs[left.func.code](right.array);
-	}
-
-	if(left.func.left)
-		freearray(left.func.left);
-
+	result.array = runfunc(left.func, left.func.left, right.array);
 	return result;
 }
 
@@ -250,4 +221,40 @@ assign(Datum left, Datum right)
 	}
 	right.shy = 1;
 	return right;
+}
+
+Datum
+monadop(Datum left, Datum right)
+{
+	traceprint("Applying left argument to operator\n");
+	Datum *arg = malloc(sizeof(Datum));
+	*arg = left;
+
+	Datum result;
+	result.shy = 0;
+	result.tag = FunctionTag,
+	result.func.type = FunctypeOp;
+	result.func.operator = right.operator;
+	result.func.operator.left = arg;
+	result.func.left = nil;
+	if(arg->tag == ArrayTag)
+		incref(arg->array);
+	return result;
+}
+
+Datum
+dyadop(Datum left, Datum right)
+{
+	traceprint("Applying right argument to operator\n");
+	Datum *arg = malloc(sizeof(Datum));
+	*arg = right;
+
+	Datum result;
+	result.shy = 0;
+	result.tag = MonadicOpTag,
+	result.operator = left.operator;
+	result.operator.right = arg;
+	if(arg->tag == ArrayTag)	
+		incref(arg->array);
+	return result;
 }
\ No newline at end of file
diff --git a/functions.c b/functions.c
index db9fe01..636c195 100644
--- a/functions.c
+++ b/functions.c
@@ -116,6 +116,46 @@ fndyad dyadfunctiondefs[] = {
 	0, /* ⍕ */
 };
 
+/* Runner function */
+Array *
+runfunc(Function f, Array *left, Array *right)
+{
+	if(f.type == FunctypeDfn){
+		Symtab *tmpsymtab = currentsymtab;
+		currentsymtab = newsymtab();
+
+		if(left){
+			Symbol *alpha = getsym(currentsymtab, L"⍺");
+			alpha->value.tag = ArrayTag;
+			alpha->value.array = left;
+			alpha->undefined = 0;
+			incref(left);
+		}
+
+		Symbol *omega = getsym(currentsymtab, L"⍵");
+		omega->value.tag = ArrayTag;
+		omega->value.array = right;
+		omega->undefined = 0;
+		incref(right);
+
+		Datum *dfnres = evalline(f.dfn);
+		freesymtab(currentsymtab);
+		currentsymtab = tmpsymtab;
+		return (*dfnres).array; /* TODO what if the evaluation failed */
+	}else if(f.type == FunctypePrim){
+		if(left)
+			return dyadfunctiondefs[f.code](left, right);
+		else
+			return monadfunctiondefs[f.code](right);
+	}else{
+		/* TODO assumes prim op, not dop */
+		if(f.operator.dyadic)
+			return dyadoperatordefs[f.operator.code](f.operator.left, f.operator.right, left, right);
+		else
+			return monadoperatordefs[f.operator.code](f.operator.left, left, right);
+	}
+}
+
 /* Monadic functions */
 
 Array *
diff --git a/lexer.c b/lexer.c
index ceccf2f..bf2aaa4 100644
--- a/lexer.c
+++ b/lexer.c
@@ -4,8 +4,6 @@
 
 #include "apl9.h"
 
-Rune primmonopnames[] = L"¨⍨⌸⌶&";
-Rune primdyadopnames[] = L"⍣.∘⍤⍥@⍠⌺";
 Rune primhybridnames[] = L"/\⌿⍀";
 
 Statement *
@@ -77,11 +75,15 @@ lexline(Rune *line)
 			offset++;
 		}else if(p = runestrchr(primmonopnames, line[offset])){
 			stmt->toks[stmt->ntoks].tag = MonadicOpTag;
-			stmt->toks[stmt->ntoks].func.code = p-primmonopnames;
+			stmt->toks[stmt->ntoks].operator.type = OperatortypePrim;
+			stmt->toks[stmt->ntoks].operator.dyadic = 0;
+			stmt->toks[stmt->ntoks].operator.code = p-primmonopnames;
 			offset++;
 		}else if(p = runestrchr(primdyadopnames, line[offset])){
 			stmt->toks[stmt->ntoks].tag = DyadicOpTag;
-			stmt->toks[stmt->ntoks].func.code = p-primdyadopnames;
+			stmt->toks[stmt->ntoks].operator.type = OperatortypePrim;
+			stmt->toks[stmt->ntoks].operator.dyadic = 1;
+			stmt->toks[stmt->ntoks].operator.code = p-primdyadopnames;
 			offset++;
 		}else if(isdigitrune(line[offset])){
 			char buf[64];
diff --git a/mkfile b/mkfile
index c3c3c25..4fdcccd 100644
--- a/mkfile
+++ b/mkfile
@@ -10,6 +10,7 @@ OFILES=\
 	functions.$O\
 	symbol.$O\
 	memory.$O\
+	operators.$O\
 
 HFILES=\
 	apl9.h\
diff --git a/operators.c b/operators.c
new file mode 100644
index 0000000..ba999bd
--- /dev/null
+++ b/operators.c
@@ -0,0 +1,64 @@
+#include <u.h>
+#include <libc.h>
+#include <bio.h>
+
+#include "apl9.h"
+
+Rune primmonopnames[] = L"¨⍨⌸⌶&";
+Rune primdyadopnames[] = L"⍣.∘⍤⍥@⍠⌺";
+
+opmonad monadoperatordefs[] = {
+	0, /* ¨ */
+	opSwitch, /* ⍨ */
+	0, /* ⌸ */
+	0, /* ⌶ */
+	0, /* & */
+};
+
+opdyad dyadoperatordefs[] = {
+	0, /* ⍣ */
+	0, /* . */
+	0, /* ∘ */
+	0, /* ⍤ */
+	opOver, /* ⍥ */
+	0, /* @ */
+	0, /* ⍠ */
+	0, /* ⌺ */
+};
+
+/* Monadic operators */
+Array *
+opSwitch(Datum *lefto, Array *left, Array *right)
+{
+	if(lefto->tag == ArrayTag){
+		incref(lefto->array);
+		return lefto->array;
+	}else if(lefto->tag == FunctionTag){
+		if(left)
+			return runfunc(lefto->func, right, left);
+		else
+			return runfunc(lefto->func, right, right);
+	}else
+		return nil;
+}
+
+/* Dyadic operators */
+Array *
+opOver(Datum *lefto, Datum *righto, Array *left, Array *right)
+{
+	if(lefto->tag != FunctionTag || righto->tag != FunctionTag)
+		return nil;
+	if(left){
+		Array *r = runfunc(righto->func, nil, right);
+		Array *l = runfunc(righto->func, nil, left);
+		Array *res = runfunc(lefto->func, l, r);
+		freearray(r);
+		freearray(l);
+		return res;
+	}else{
+		Array *tmp = runfunc(righto->func, nil, right);
+		Array *res = runfunc(lefto->func, nil, tmp);
+		freearray(tmp);
+		return res;
+	}
+}
\ No newline at end of file
diff --git a/print.c b/print.c
index 8deac3e..8c3dbbf 100644
--- a/print.c
+++ b/print.c
@@ -13,17 +13,21 @@ ppdatum(Datum d)
 	case FunctionTag:
 		if(d.func.type == FunctypePrim)
 			result = runesmprint("%C", primfuncnames[d.func.code]);
-		else
+		else if(d.func.type == FunctypeDfn)
 			result = runesmprint("{%S}", d.func.dfn);
+		else
+			result = runesmprint("%S", ppoperator(d.func.operator));
 		break;
 	case HybridTag: result = runesmprint("%C", primhybridnames[d.func.code]); break;
-	case MonadicOpTag: result = runesmprint("%C", primmonopnames[d.func.code]); break;
-	case DyadicOpTag: result = runesmprint("%C", primdyadopnames[d.func.code]); break;
+	case MonadicOpTag:
+	case DyadicOpTag: result = ppoperator(d.operator); break;
 	case BoundFunctionTag:
 		if(d.func.type == FunctypePrim)
 			result = runesmprint("%S∘%C", pparray(d.func.left), primfuncnames[d.func.code]);
-		else
+		else if(d.func.type == FunctypeDfn)
 			result = runesmprint("%S∘{%S}", pparray(d.func.left), d.func.dfn);
+		else
+			result = runesmprint("%S∘%S", pparray(d.func.left), ppoperator(d.func.operator));
 		break;
 	case LParTag: result = runestrdup(L"("); break;
 	case RParTag: result = runestrdup(L")"); break;
@@ -90,4 +94,23 @@ pparray(Array *a)
 		}		
 	}
 	return res;
+}
+
+Rune *
+ppoperator(Operator op)
+{
+	Rune *left = op.left ? ppdatum(*op.left) : runestrdup(L"");
+	Rune *right = op.right ? ppdatum(*op.right) : runestrdup(L"");
+	Rune *res;
+	if(op.type == OperatortypeDop)
+		res = runesmprint("(%S{%S}%S)", left, op.dop, right);
+	else{
+		res = runesmprint("(%S%C%S)",
+			left,
+			op.dyadic ? primdyadopnames[op.code] : primmonopnames[op.code],
+			right);
+	}
+	free(left);
+	free(right);
+	return res;
 }
\ No newline at end of file
-- 
cgit v1.2.3