Implement replicate first and last ⌿ /

5 files changed, 34 insertions, 6 deletions

diff --git a/apl9.h b/apl9.h
index 1348d23..3181fcb 100644
--- a/apl9.h
+++ b/apl9.h
@@ -360,6 +360,8 @@ Array *opObverse(Datum *, Datum *, Array *, Array *);
 Array *opSelfReference2(Datum *, Datum *, Array *, Array *);
 
 /* Dyadic functions from hybrids.c */
+Array *fnReplicateLast(Array *, Array *);
+Array *fnReplicateFirst(Array *, Array *);
 
 /* Monadic operators from hybrids.c */
 Array *opReduceLast(Datum *, Array *, Array *);
diff --git a/array.c b/array.c
index e333870..3ec8639 100644
--- a/array.c
+++ b/array.c
@@ -100,17 +100,18 @@ scalarextend(Array *a, Array *b, Array **aa, Array **bb)
 	   aa and bb are unchanged.
 	*/
 
-	if(a->size == 1 && b->size != 1){
+	if(a->rank == 0 && b->rank != 0){
 		*aa = extend(a, b);
 		*bb = fnSame(b);
-	}else if(b->size == 1 && a->size != 1){
+	}else if(a->rank != 0 && b->rank == 0){
 		*aa = fnSame(a);
 		*bb = extend(b, a);
 	}else if(a->size == b->size && a->rank == b->rank){
 		/* Check that each dimension matches */
-		for(int i = 0; i < a->rank; i++)
+		for(int i = 0; i < a->rank; i++){
 			if(a->shape[i] != b->shape[i])
 				return 0;
+		}
 		*aa = fnSame(a);
 		*bb = fnSame(b);
 	}else
diff --git a/functions.c b/functions.c
index 0e302de..6c9f837 100644
--- a/functions.c
+++ b/functions.c
@@ -747,7 +747,7 @@ fnSelfReference1(Array *right)
 Array *name(Array *left, Array *right){\
 	Array *leftarr, *rightarr;\
 	if(!commontype(left, right, &leftarr, &rightarr, forcefloat)) throwerror(nil, EType);\
-	if(!scalarextend(leftarr, rightarr, &left, &right)) throwerror(nil, ERank);\
+	if(!scalarextend(leftarr, rightarr, &left, &right)) throwerror(L"scalar extension fail", ERank);\
 	Array *res;\
 	if(left->type != AtypeArray && restype != left->type)\
 		res = duparrayshape(left, restype);\
diff --git a/hybrids.c b/hybrids.c
index 2ac2a91..da42e62 100644
--- a/hybrids.c
+++ b/hybrids.c
@@ -7,9 +7,9 @@
 Rune primhybridnames[] = L"/\\⌿⍀";
 
 fndyad hybridfunctiondefs[] = {
-	0, /* / */
+	fnReplicateLast, /* / */
 	0, /* \ */
-	0, /* ⌿ */
+	fnReplicateFirst, /* ⌿ */
 	0, /* ⍀ */
 };
 
@@ -21,6 +21,22 @@ opmonad hybridoperatordefs[] = {
 };
 
 /* function definitions */
+Array *
+fnReplicateLast(Array *left, Array *right)
+{
+	return rundfn(L"⍉⍺⌿⍉⍵", nil, nil, left, right);
+}
+
+Array *
+fnReplicateFirst(Array *left, Array *right)
+{
+	Rune *code =
+		L"(0=≢⍴⍵)∧⍺∧.=0: 0⍴⍵ ⋄"
+		L"⍺∧.=0: (((1,¯1+≢⍴⍵)⌿¯1 1)⌿⍴⍵)⍴⍵ ⋄"
+		L"1=×⌿⍴,⍵: ↑⍪⌿(+⌿⍺)⍴⊂⍵ ⋄"
+		L"↑↑⍪⌿⍺ (⍵{e←⊂⍵⌷⍶ ⋄ ⍺>0: ⍺⍴e ⋄ (|⍺)⍴⎕PROTO e})¨⍳≢⍵";
+	return rundfn(code, nil, nil, left, right);
+}
 
 /* operator definitions */
 Array *
diff --git a/quadnames.c b/quadnames.c
index 2646840..467e0a6 100644
--- a/quadnames.c
+++ b/quadnames.c
@@ -17,6 +17,7 @@ Array *runfile(Array *);
 Array *quadthrow1(Array *);
 Array *quadthrow2(Array *, Array *);
 Array *quadinfo(Array *);
+Array *quadproto(Array *);
 
 QuadnameDef quadnames[] = {
 	{L"⎕", NameTag, getquad, setquad, nil, nil},
@@ -26,6 +27,7 @@ QuadnameDef quadnames[] = {
 	{L"⎕RUN", FunctionTag, nil, nil, runfile, nil},
 	{L"⎕THROW", FunctionTag, nil, nil, quadthrow1, quadthrow2},
 	{L"⎕INFO", FunctionTag, nil, nil, quadinfo, nil},
+	{L"⎕PROTO", FunctionTag, nil, nil, quadproto, nil},
 	{nil, 0, nil, nil, nil, nil} /* MUST BE LAST */
 };
 
@@ -225,4 +227,11 @@ quadinfo(Array *a)
 	free(res);
 	free(info);
 	return infoarr;
+}
+
+/* ⎕PROTO */
+Array *
+quadproto(Array *a)
+{
+	return fillelement(a);
 }
\ No newline at end of file