diff options
| -rw-r--r-- | apl9.h | 2 | ||||
| -rw-r--r-- | array.c | 7 | ||||
| -rw-r--r-- | functions.c | 2 | ||||
| -rw-r--r-- | hybrids.c | 20 | ||||
| -rw-r--r-- | quadnames.c | 9 |
5 files changed, 34 insertions, 6 deletions
@@ -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 *); @@ -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);\ @@ -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 |