Implement monadic ≡ (depth)

3 files changed, 37 insertions, 1 deletions

diff --git a/apl9.h b/apl9.h
index 9004636..c56f356 100644
--- a/apl9.h
+++ b/apl9.h
@@ -236,6 +236,7 @@ Array *simplifyarray(Array *);
 int comparearray(Array *, Array *, int);
 Array *fillelement(Array *);
 uvlong arrayspaceused(Array *);
+int arraydepth(Array *, int *);
 
 /* eval.c */
 Datum *eval(Statement *, int);
@@ -292,6 +293,7 @@ Array *fnMagnitude(Array *);
 Array *fnCeiling(Array *);
 Array *fnFloor(Array *);
 Array *fnSame(Array *);
+Array *fnDepth(Array *);
 Array *fnTally(Array *);
 Array *fnMix(Array *);
 Array *fnSplit(Array *);
diff --git a/array.c b/array.c
index 1ae2125..7efc1b0 100644
--- a/array.c
+++ b/array.c
@@ -354,4 +354,28 @@ arrayspaceused(Array *a)
 	for(int i = 0; i < a->size && a->type == AtypeArray; i++)
 		size += arrayspaceused(a->arraydata[i]);
 	return size;
+}
+
+int
+arraydepth(Array *a, int *uniform)
+{
+	if(a->type == AtypeArray){
+		int max = -1;
+		int subuniform;
+		*uniform = 1;
+		for(int i = 0; i < a->size; i++){
+			int subdepth = arraydepth(a->arraydata[i], &subuniform);
+			if(subdepth > max)
+				max = subdepth;
+			if((subdepth != subdepth && max != -1) || subuniform)
+				*uniform = 0;
+		}
+		return max+1;
+	}else{
+		*uniform = 1;
+		if(a->rank == 0)
+			return 0;
+		else
+			return 1;
+	}
 }
\ No newline at end of file
diff --git a/functions.c b/functions.c
index 7952565..9eb6406 100644
--- a/functions.c
+++ b/functions.c
@@ -30,7 +30,7 @@ fnmonad monadfunctiondefs[] = {
 	0, /* < */
 	0, /* > */
 	0, /* ≥ */
-	0, /* ≡ */
+	fnDepth, /* ≡ */
 	fnTally, /* ≢ */
 	0, /* ∨ */
 	0, /* ∧ */
@@ -367,6 +367,16 @@ fnSame(Array *right)
 }
 
 Array *
+fnDepth(Array *right)
+{
+	int uniform;
+	int depth = arraydepth(right, &uniform);
+	if(!uniform)
+		depth = -depth;
+	return mkscalarint(depth);
+}
+
+Array *
 fnTally(Array *right)
 {
 	return mkscalarint(right->rank==0 ? 1 : right->shape[0]);