Implement ∘ and fix a bug in simplifyarray

4 files changed, 35 insertions, 4 deletions

diff --git a/apl9.h b/apl9.h
index 92a5127..2b61a3d 100644
--- a/apl9.h
+++ b/apl9.h
@@ -268,6 +268,7 @@ Array *opEach(Datum *, Array *, Array *);
 Array *opSwitch(Datum *, Array *, Array *);
 
 /* Dyadic operators from operators.c */
+Array *opBind(Datum *, Datum *, Array *, Array *);
 Array *opOver(Datum *, Datum *, Array *, Array *);
 
 /* Dyadic functions from hybrids.c */
diff --git a/array.c b/array.c
index 37cd159..2e0e71e 100644
--- a/array.c
+++ b/array.c
@@ -192,8 +192,16 @@ simplifyarray(Array *a)
 		b->stranded = a->stranded;
 		for(i = 0; i < a->rank; i++)
 			b->shape[i] = a->shape[i];
-		for(i = 0; i < a->size; i++)
+		for(i = 0; i < a->size; i++){
 			memcpy(b->rawdata + i * datasizes[type], a->arraydata[i]->rawdata, datasizes[type]);
+			if(b->type == AtypeArray)
+				incref(b->arraydata[i]);
+		}
+		if(b->type == AtypeArray){
+			Array *tmp = b;
+			b = simplifyarray(b);
+			freearray(tmp);
+		}
 		return b;
 	}else if(canfloat){
 		Array *b = allocarray(AtypeFloat, a->rank, a->size);
diff --git a/operators.c b/operators.c
index 65948de..32b9074 100644
--- a/operators.c
+++ b/operators.c
@@ -18,7 +18,7 @@ opmonad monadoperatordefs[] = {
 opdyad dyadoperatordefs[] = {
 	0, /* ⍣ */
 	0, /* . */
-	0, /* ∘ */
+	opBind, /* ∘ */
 	0, /* ⍤ */
 	opOver, /* ⍥ */
 	0, /* @ */
@@ -43,7 +43,7 @@ opEach(Datum *lefto, Array *left, Array *right)
 		leftarr = nil;
 		rightarr = fnSame(right);
 	}
-	
+
 	Array *result = allocarray(AtypeArray, rightarr->rank, rightarr->size);
 	for(i = 0; i < rightarr->rank; i++)
 		result->shape[i] = rightarr->shape[i];
@@ -76,6 +76,26 @@ opSwitch(Datum *lefto, Array *left, Array *right)
 
 /* Dyadic operators */
 Array *
+opBind(Datum *lefto, Datum *righto, Array *left, Array *right)
+{
+	if(lefto->tag == FunctionTag && righto->tag == FunctionTag){
+		Array *right1 = runfunc(righto->func, nil, right);
+		Array *result = runfunc(lefto->func, left, right1);
+		freearray(right1);
+		return result;
+	}else if(lefto->tag == FunctionTag && righto->tag == ArrayTag){
+		if(left)
+			throwerror(L"The function doesn't take a left argument", ESyntax);
+		return runfunc(lefto->func, right, righto->array);
+	}else if(lefto->tag == ArrayTag && righto->tag == FunctionTag){
+		if(left)
+			throwerror(L"The function doesn't take a left argument", ESyntax);
+		return runfunc(righto->func, lefto->array, right);
+	}else
+		return nil;
+}
+
+Array *
 opOver(Datum *lefto, Datum *righto, Array *left, Array *right)
 {
 	if(lefto->tag != FunctionTag || righto->tag != FunctionTag)
diff --git a/print.c b/print.c
index 842d9b3..e0619a6 100644
--- a/print.c
+++ b/print.c
@@ -194,7 +194,9 @@ ppoperator(Operator op)
 	Rune *res;
 	if(op.type == OperatortypeDop)
 		res = runesmprint("(%S{%S}%S)", left, op.dop, right);
-	else{
+	else if(op.type == OperatortypeHybrid){
+		res = runesmprint("(%S%C)", left, primhybridnames[op.code]);
+	}else{
 		res = runesmprint("(%S%C%S)",
 			left,
 			op.dyadic ? primdyadopnames[op.code] : primmonopnames[op.code],