Implement fgh and gh trains

4 files changed, 138 insertions, 28 deletions

diff --git a/apl9.h b/apl9.h
index 8be337c..78b5c11 100644
--- a/apl9.h
+++ b/apl9.h
@@ -39,6 +39,7 @@ typedef enum
 	FunctypeOp,
 	FunctypeQuad,
 	FunctypeHybrid,
+	FunctypeTrain,
 } functionType;
 
 typedef enum
@@ -59,6 +60,7 @@ typedef enum
 typedef struct Array Array;
 typedef struct Statement Statement;
 typedef struct Operator Operator;
+typedef struct FunctionTrain FunctionTrain;
 typedef struct Function Function;
 typedef struct Datum Datum;
 typedef struct Symbol Symbol;
@@ -103,6 +105,12 @@ struct Operator
 	Datum *right;
 };
 
+struct FunctionTrain
+{
+	int nfuncs;
+	Function *funcs;
+};
+
 struct Function
 {
 	functionType type;
@@ -111,6 +119,7 @@ struct Function
 		Rune *dfn;
 		Operator operator;
 		QuadnameDef *quad;
+		FunctionTrain train;
 	};
 	Array *left;
 };
@@ -179,6 +188,7 @@ Rune *ppdatum(Datum);
 Rune *ppdatums(Datum *, int);
 Rune *pparray(Array *);
 Rune *ppoperator(Operator);
+Rune *ppfunction(Function);
 
 /* lexer.c */
 Statement *lexline(Rune *, int);
@@ -219,6 +229,7 @@ void incref(Array *);
 /* functions.c */
 Array *runfunc(Function, Array *,Array *);
 Array *rundfn(Rune *, Array *, Array *);
+Array *runtrain(Function *, int, Array *, Array *, Array *);
 
 /* quadnames.c */
 Datum quadnamedatum(QuadnameDef);
diff --git a/eval.c b/eval.c
index 86d0d15..f63f5e0 100644
--- a/eval.c
+++ b/eval.c
@@ -18,27 +18,28 @@ Datum nameis(Datum, Datum);
 Datum assign(Datum, Datum);
 Datum monadop(Datum, Datum);
 Datum dyadop(Datum, Datum);
+Datum train(Datum, Datum);
 Datum *lookup(Datum);
 
 int bindingstrengths[11][11] = {
 /*	A  F  H  MO DO AF (  )  ←  IS N */
-	6, 3, 3, 4, 0, 0, 0, 0, 0, 0, 0, /* A */
-	2, 0, 4, 4, 0, 0, 0, 0, 0, 0, 0, /* F */
-	0, 0, 0, 4, 0, 0, 0, 0, 0, 0, 0, /* H */
+	7, 4, 4, 5, 0, 0, 0, 0, 0, 0, 0, /* A */
+	3, 2, 5, 5, 0, 0, 0, 0, 0, 0, 0, /* F */
+	0, 0, 0, 5, 0, 0, 0, 0, 0, 0, 0, /* H */
 	0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* MO */
-	5, 5, 5, 0, 0, 0, 0, 0, 0, 0, 0, /* DO */
-	2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* AF */
-	0, 0, 0, 0, 0, 0, 0, 7, 0, 0, 0, /* ( */
-	7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, /* ) */
+	6, 6, 6, 0, 0, 0, 0, 0, 0, 0, 0, /* DO */
+	3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* AF */
+	0, 0, 0, 0, 0, 0, 0, 8, 0, 0, 0, /* ( */
+	8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, /* ) */
 	0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* ← */
 	1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* IS */
-	0, 0, 0, 0, 0, 0, 0, 0, 8, 0, 0, /* N */
+	0, 0, 0, 0, 0, 0, 0, 0, 9, 0, 0, /* N */
 };
 
 evalfn evalfns[11][11] = {
 /*	A  F  H  MO DO AF (  )  ←  IS N */
 	strand, dyadfun, dyadfun, monadop, 0, 0, 0, 0, 0, 0, 0, /* A */
-	monadfun, 0, monadop, monadop, 0, 0, 0, 0, 0, 0, 0, /* F */
+	monadfun, train, monadop, monadop, 0, 0, 0, 0, 0, 0, 0, /* F */
 	0, 0, 0, monadop, 0, 0, 0, 0, 0, 0, 0, /* H */
 	0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* MO */
 	dyadop, dyadop, dyadop, 0, 0, 0, 0, 0, 0, 0, 0, /* DO */
@@ -287,4 +288,35 @@ dyadop(Datum left, Datum right)
 	if(arg->tag == ArrayTag)	
 		incref(arg->array);
 	return result;
+}
+
+Datum
+train(Datum left, Datum right)
+{
+	Datum result;
+	result.shy = 0;
+	result.tag = FunctionTag;
+	result.func.type = FunctypeTrain;
+	result.func.left = left.func.left;
+
+	if(left.func.type == FunctypeTrain)
+		result.func = left.func;
+	else{
+		result.func.train.nfuncs = 1;
+		result.func.train.funcs = malloc(sizeof(Function));
+		result.func.train.funcs[0] = left.func;
+	}
+
+	if(right.func.type == FunctypeTrain){
+		int oldn = result.func.train.nfuncs;
+		result.func.train.nfuncs = oldn + right.func.train.nfuncs;
+		result.func.train.funcs = realloc(result.func.train.funcs, sizeof(Function) * result.func.train.nfuncs);
+		for(int i = 0; i < right.func.train.nfuncs; i++)
+			result.func.train.funcs[oldn + i] = right.func.train.funcs[i];
+	}else{
+		result.func.train.nfuncs++;
+		result.func.train.funcs = realloc(result.func.train.funcs, sizeof(Function) * result.func.train.nfuncs);
+		result.func.train.funcs[result.func.train.nfuncs-1] = right.func;
+	}
+	return result;
 }
\ No newline at end of file
diff --git a/functions.c b/functions.c
index 09e4917..c229322 100644
--- a/functions.c
+++ b/functions.c
@@ -206,8 +206,12 @@ runfunc(Function f, Array *left, Array *right)
 			throwerror(err, ENotImplemented);
 		}
 		return d(left, right);
-	}else
+	}else if(f.type == FunctypeTrain)
+		return runtrain(f.train.funcs, f.train.nfuncs, left, right, nil);
+	else{
+		throwerror(L"runfunc for this function type", ENotImplemented);
 		return nil;
+	}
 }
 
 Array *
@@ -219,6 +223,51 @@ rundfn(Rune *code, Array *left, Array *right)
 	return runfunc(dfn, left, right);
 }
 
+Array *
+runtrain(Function *funcs, int nfuncs, Array *left, Array *right, Array *acc)
+{
+	if(nfuncs >= 3 && acc == nil){
+		Array *rtmp = runfunc(funcs[nfuncs-1], left, right);
+		Array *ltmp = runfunc(funcs[nfuncs-3], left, right);
+		Array *r = simplifyarray(rtmp);
+		Array *l = simplifyarray(ltmp);
+		Array *c = runfunc(funcs[nfuncs-2], l, r);
+		freearray(rtmp);
+		freearray(ltmp);
+		freearray(r);
+		freearray(l);
+		if(nfuncs == 3)
+			return c;
+		else
+			return runtrain(funcs, nfuncs-3, left, right, c);
+	}else if(nfuncs >= 2 && acc != nil){
+		Array *ltmp = runfunc(funcs[nfuncs-2], left, right);
+		Array *l = simplifyarray(ltmp);
+		Array *c = runfunc(funcs[nfuncs-1], l, acc);
+		freearray(ltmp);
+		freearray(acc);
+		freearray(l);
+		if(nfuncs == 2)
+			return c;
+		else
+			return runtrain(funcs, nfuncs-2, left, right, c);
+	}else if(nfuncs == 2 && acc == nil){
+		Array *rtmp = runfunc(funcs[1], left, right);
+		Array *r = simplifyarray(rtmp);
+		Array *c = runfunc(funcs[0], nil, r);
+		freearray(rtmp);
+		freearray(r);
+		return c;
+	}else if(nfuncs == 1 && acc != nil){
+		Array *c = runfunc(funcs[0], nil, acc);
+		freearray(acc);
+		return c;
+	}else{
+		throwerror(L"train combination", ENotImplemented);
+		return nil;
+	}
+}
+
 /* Monadic functions */
 
 Array *
diff --git a/print.c b/print.c
index e0619a6..564956b 100644
--- a/print.c
+++ b/print.c
@@ -16,27 +16,11 @@ ppdatum(Datum d)
 	Rune *result;
 	switch(d.tag){
 	case ArrayTag: result = pparray(d.array); break;
-	case FunctionTag:
-		if(d.func.type == FunctypePrim)
-			result = runesmprint("%C", primfuncnames[d.func.code]);
-		else if(d.func.type == FunctypeDfn)
-			result = runesmprint("{%S}", d.func.dfn);
-		else if(d.func.type == FunctypeOp)
-			result = runesmprint("%S", ppoperator(d.func.operator));
-		else
-			result = runesmprint("%S", d.func.quad->name);
-		break;
+	case FunctionTag: result = ppfunction(d.func); break;
 	case HybridTag: result = runesmprint("%C", primhybridnames[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 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 BoundFunctionTag: result = runesmprint("%S∘%S", pparray(d.func.left), ppfunction(d.func)); break;
 	case LParTag: result = runestrdup(L"("); break;
 	case RParTag: result = runestrdup(L")"); break;
 	case ArrowTag: result = runestrdup(L"←"); break;
@@ -207,6 +191,40 @@ ppoperator(Operator op)
 	return res;
 }
 
+Rune *
+ppfunction(Function f)
+{
+	Rune *result;
+	switch(f.type){
+	case FunctypePrim:
+		result = runesmprint("%C", primfuncnames[f.code]);
+		break;
+	case FunctypeDfn:
+		result = runesmprint("{%S}", f.dfn);
+		break;
+	case FunctypeOp:
+		result = runesmprint("%S", ppoperator(f.operator));
+		break;
+	case FunctypeQuad:
+		result = runesmprint("%S", f.quad->name);
+		break;
+	case FunctypeTrain:
+		result = runesmprint("");
+		for(int i = 0; i < f.train.nfuncs; i++){
+			Rune *tmp = result;
+			Rune *fun = ppfunction(f.train.funcs[i]);
+			result = runesmprint("%S%S", tmp, fun);
+			free(tmp);
+			free(fun);
+		}
+		break;
+	default:
+		result = runesmprint("<non printable function type %d>", f.type);
+		break;
+	}
+	return result;
+}
+
 void
 strdims(Rune *s, int *width, int *height)
 {