1560 lines
50 KiB
C
1560 lines
50 KiB
C
#include "../core.h"
|
||
#include "../utils/each.h"
|
||
#include "../utils/mut.h"
|
||
#include "../utils/talloc.h"
|
||
#include "../builtins.h"
|
||
|
||
NOINLINE Arr* emptyArr(B x, ur xr) {
|
||
B xf = getFillQ(x);
|
||
if (xr==1) {
|
||
if (isF64(xf)) return a(emptyIVec());
|
||
if (noFill(xf)) return a(emptyHVec());
|
||
if (isC32(xf)) return a(emptyCVec());
|
||
}
|
||
Arr* r;
|
||
if (isF64(xf)) { u64* rp; r = m_bitarrp(&rp, 0); }
|
||
else if (noFill(xf)) { r = (Arr*) m_harrUp(0).c; }
|
||
else if (isC32(xf)) { u8* rp; r = m_c8arrp(&rp, 0); }
|
||
else { r = m_fillarrp(0); fillarr_setFill(r, xf); }
|
||
if (xr<=1) arr_rnk01(r, xr);
|
||
return r;
|
||
}
|
||
|
||
static Arr* take_impl(usz ria, B x) { // consumes x; returns v↑⥊𝕩 without set shape; v is non-negative
|
||
usz xia = IA(x);
|
||
if (ria>xia) {
|
||
B xf = getFillE(x);
|
||
MAKE_MUT(r, ria); mut_init(r, el_or(TI(x,elType), selfElType(xf)));
|
||
MUTG_INIT(r);
|
||
mut_copyG(r, 0, x, 0, xia);
|
||
mut_fillG(r, xia, xf, ria-xia);
|
||
decG(x);
|
||
if (r->fns->elType!=el_B) { dec(xf); return mut_fp(r); } // TODO dec(xf) not required? maybe define as a helper fn?
|
||
return a(withFill(mut_fv(r), xf));
|
||
} else {
|
||
return TI(x,slice)(x,0,ria);
|
||
}
|
||
}
|
||
|
||
B m_vec1(B a) {
|
||
if (isF64(a)) {
|
||
i32 i = (i32)a.f;
|
||
if (RARE(a.f != i)) { f64* rp; B r = m_f64arrv(&rp, 1); rp[0] = a.f; return r; }
|
||
else if (q_ibit(i)) { u64* rp; B r = m_bitarrv(&rp, 1); rp[0] = i; return r; }
|
||
else if (i == (i8 )i) { i8* rp; B r = m_i8arrv (&rp, 1); rp[0] = i; return r; }
|
||
else if (i == (i16)i) { i16* rp; B r = m_i16arrv(&rp, 1); rp[0] = i; return r; }
|
||
else { i32* rp; B r = m_i32arrv(&rp, 1); rp[0] = i; return r; }
|
||
}
|
||
if (isC32(a)) {
|
||
u32 c = o2cG(a);
|
||
if (LIKELY(c<U8_MAX )) { u8* rp; B r = m_c8arrv (&rp, 1); rp[0] = c; return r; }
|
||
else if (LIKELY(c<U16_MAX)) { u16* rp; B r = m_c16arrv(&rp, 1); rp[0] = c; return r; }
|
||
else { u32* rp; B r = m_c32arrv(&rp, 1); rp[0] = c; return r; }
|
||
}
|
||
Arr* ra = arr_shVec(m_fillarrp(1));
|
||
fillarr_ptr(ra)[0] = a;
|
||
fillarr_setFill(ra, m_f64(0));
|
||
fillarr_setFill(ra, asFill(inc(a)));
|
||
return taga(ra);
|
||
}
|
||
|
||
FORCE_INLINE B m_vec2Base(B a, B b, bool fills) {
|
||
if (isAtm(a)&isAtm(b)) {
|
||
if (LIKELY(isNum(a)&isNum(b))) {
|
||
i32 ai=a.f; i32 bi=b.f;
|
||
if (RARE(ai!=a.f | bi!=b.f)) { f64* rp; B r = m_f64arrv(&rp, 2); rp[0]=o2fG(a); rp[1]=o2fG(b); return r; }
|
||
else if (q_ibit(ai) & q_ibit(bi)) { u64* rp; B r = m_bitarrv(&rp, 2); rp[0]=ai | (bi<<1); return r; }
|
||
else if (ai==(i8 )ai & bi==(i8 )bi) { i8* rp; B r = m_i8arrv (&rp, 2); rp[0]=ai; rp[1]=bi; return r; }
|
||
else if (ai==(i16)ai & bi==(i16)bi) { i16* rp; B r = m_i16arrv(&rp, 2); rp[0]=ai; rp[1]=bi; return r; }
|
||
else { i32* rp; B r = m_i32arrv(&rp, 2); rp[0]=ai; rp[1]=bi; return r; }
|
||
}
|
||
if (isC32(b)&isC32(a)) {
|
||
u32 ac=o2cG(a); u32 bc=o2cG(b);
|
||
if (ac==(u8 )ac & bc==(u8 )bc) { u8* rp; B r = m_c8arrv (&rp, 2); rp[0]=ac; rp[1]=bc; return r; }
|
||
else if (ac==(u16)ac & bc==(u16)bc) { u16* rp; B r = m_c16arrv(&rp, 2); rp[0]=ac; rp[1]=bc; return r; }
|
||
else { u32* rp; B r = m_c32arrv(&rp, 2); rp[0]=ac; rp[1]=bc; return r; }
|
||
}
|
||
}
|
||
if (fills) {
|
||
if (isAtm(a) || isAtm(b)) goto noFills;
|
||
B af = asFill(incG(a));
|
||
if (noFill(af)) goto noFills;
|
||
B bf = asFill(incG(b));
|
||
if (noFill(bf)) { dec(af); goto noFills; }
|
||
if (!fillEqual(af,bf)) { dec(bf); dec(af); goto noFills; }
|
||
dec(bf);
|
||
Arr* ra = arr_shVec(m_fillarrp(2));
|
||
fillarr_setFill(ra, af);
|
||
fillarr_ptr(ra)[0] = a;
|
||
fillarr_ptr(ra)[1] = b;
|
||
return taga(ra);
|
||
}
|
||
noFills:
|
||
return m_hVec2(a,b);
|
||
}
|
||
|
||
B m_vec2(B a, B b) { return m_vec2Base(a, b, false); }
|
||
|
||
B pair_c1(B t, B x) { return m_vec1(x); }
|
||
B pair_c2(B t, B w, B x) { return m_vec2Base(w, x, true); }
|
||
|
||
Arr* cpyWithShape(B x) {
|
||
Arr* xv = a(x);
|
||
if (reusable(x)) return xv;
|
||
ur xr = PRNK(xv);
|
||
Arr* r;
|
||
if (xr<=1) {
|
||
r = TIv(xv,slice)(x, 0, PIA(xv));
|
||
arr_rnk01(r, xr);
|
||
} else {
|
||
usz* sh = PSH(xv);
|
||
ptr_inc(shObjS(sh));
|
||
r = TIv(xv,slice)(x, 0, PIA(xv));
|
||
r->sh = sh;
|
||
}
|
||
SPRNK(r, xr);
|
||
return r;
|
||
}
|
||
|
||
B shape_c1(B t, B x) {
|
||
if (isAtm(x)) return m_vec1(x);
|
||
if (RNK(x)==1) return x;
|
||
usz ia = IA(x);
|
||
if (ia==1 && TI(x,elType)<el_B) {
|
||
B n = IGet(x,0);
|
||
decG(x);
|
||
return m_vec1(n);
|
||
}
|
||
if (reusable(x)) { FL_KEEP(x, fl_squoze);
|
||
decSh(v(x)); arr_shVec(a(x));
|
||
return x;
|
||
}
|
||
return taga(arr_shVec(TI(x,slice)(x, 0, ia)));
|
||
}
|
||
static B truncReshape(B x, usz xia, usz nia, ur nr, ShArr* sh) { // consumes all
|
||
B r; Arr* ra;
|
||
if (reusable(x) && xia==nia) { r = x; decSh(v(x)); ra = (Arr*)v(r); }
|
||
else { ra = TI(x,slice)(x, 0, nia); r = taga(ra); }
|
||
arr_shSetU(ra, nr, sh);
|
||
return r;
|
||
}
|
||
static void fill_words(void* rp, u64 v, u64 bytes) {
|
||
usz wds = bytes/8;
|
||
usz ext = bytes%8;
|
||
u64* p = rp;
|
||
for (usz i=0; i<wds; i++) p[i] = v;
|
||
if (ext) memcpy(p+wds, &v, ext);
|
||
}
|
||
B shape_c2(B t, B w, B x) {
|
||
usz xia = isArr(x)? IA(x) : 1;
|
||
usz nia = 1;
|
||
ur nr;
|
||
ShArr* sh;
|
||
if (isF64(w)) {
|
||
nia = o2s(w);
|
||
nr = 1;
|
||
sh = NULL;
|
||
} else {
|
||
if (isAtm(w)) w = m_atomUnit(w);
|
||
if (RNK(w)>1) thrM("⥊: 𝕨 must have rank at most 1");
|
||
if (IA(w)>UR_MAX) thrM("⥊: Result rank too large");
|
||
nr = IA(w);
|
||
sh = nr<=1? NULL : m_shArr(nr);
|
||
if (TI(w,elType)==el_i32) {
|
||
i32* wi = i32any_ptr(w);
|
||
if (nr>1) for (i32 i = 0; i < nr; i++) sh->a[i] = wi[i];
|
||
bool bad=false, good=false;
|
||
for (i32 i = 0; i < nr; i++) {
|
||
if (wi[i]<0) thrF("⥊: 𝕨 contained %i", wi[i]);
|
||
bad|= mulOn(nia, wi[i]);
|
||
good|= wi[i]==0;
|
||
}
|
||
if (bad && !good) thrM("⥊: 𝕨 too large");
|
||
} else {
|
||
SGetU(w)
|
||
i32 unkPos = -1;
|
||
i32 unkInd ONLY_GCC(=0);
|
||
bool bad=false, good=false;
|
||
for (i32 i = 0; i < nr; i++) {
|
||
B c = GetU(w, i);
|
||
if (isF64(c)) {
|
||
usz v = o2s(c);
|
||
if (sh) sh->a[i] = v;
|
||
bad|= mulOn(nia, v);
|
||
good|= v==0;
|
||
} else {
|
||
if (isArr(c) || !isVal(c)) thrM("⥊: 𝕨 must consist of natural numbers or ∘ ⌊ ⌽ ↑");
|
||
if (unkPos!=-1) thrM("⥊: 𝕨 contained multiple computed axes");
|
||
unkPos = i;
|
||
if (!isPrim(c)) thrM("⥊: 𝕨 must consist of natural numbers or ∘ ⌊ ⌽ ↑");
|
||
unkInd = ((i32)v(c)->flags) - 1;
|
||
good|= xia==0 | unkInd==n_floor;
|
||
}
|
||
}
|
||
if (bad && !good) thrM("⥊: 𝕨 too large");
|
||
if (unkPos!=-1) {
|
||
if (unkInd!=n_atop & unkInd!=n_floor & unkInd!=n_reverse & unkInd!=n_take) thrM("⥊: 𝕨 must consist of natural numbers or ∘ ⌊ ⌽ ↑");
|
||
if (nia==0) thrM("⥊: Can't compute axis when the rest of the shape is empty");
|
||
i64 div = xia/nia;
|
||
i64 mod = xia%nia;
|
||
usz item;
|
||
bool fill = false;
|
||
if (unkInd == n_atop) {
|
||
if (mod!=0) thrM("⥊: Shape must be exact when reshaping with ∘");
|
||
item = div;
|
||
} else if (unkInd == n_floor) {
|
||
item = div;
|
||
} else if (unkInd == n_reverse) {
|
||
item = mod? div+1 : div;
|
||
} else if (unkInd == n_take) {
|
||
item = mod? div+1 : div;
|
||
fill = true;
|
||
} else UD;
|
||
if (sh) sh->a[unkPos] = item;
|
||
nia = uszMul(nia, item);
|
||
if (fill) {
|
||
if (!isArr(x)) x = m_atomUnit(x);
|
||
x = taga(arr_shVec(take_impl(nia, x)));
|
||
xia = nia;
|
||
}
|
||
}
|
||
}
|
||
decG(w);
|
||
}
|
||
|
||
Arr* r;
|
||
if (isArr(x)) {
|
||
if (nia <= xia) {
|
||
return truncReshape(x, xia, nia, nr, sh);
|
||
} else {
|
||
if (xia <= 1) {
|
||
if (RARE(xia == 0)) thrM("⥊: Empty 𝕩 and non-empty result");
|
||
B n = IGet(x,0);
|
||
decG(x);
|
||
x = n;
|
||
goto unit;
|
||
}
|
||
if (xia <= nia/2) x = any_squeeze(x);
|
||
|
||
u8 xl = arrTypeBitsLog(TY(x));
|
||
u8 xt = arrNewType(TY(x));
|
||
u8* rp;
|
||
u64 bi, bf; // Bytes present, bytes wanted
|
||
if (xl == 0) { // Bits
|
||
u64* rq; r = m_bitarrp(&rq, nia);
|
||
rp = (u8*)rq;
|
||
usz nw = BIT_N(nia);
|
||
u64* xp = bitarr_ptr(x);
|
||
u64 b = xia;
|
||
if (b % 8) {
|
||
if (b < 64) {
|
||
// Need to avoid calling bit_cpy with arguments <64 bits apart
|
||
u64 v = xp[0] & (~(u64)0 >> (64-b));
|
||
do { v |= v<<b; b*=2; } while (b%8 && b<64);
|
||
rq[0] = v;
|
||
if (b>64 && nia>64) rq[1] = v>>(64-b/2);
|
||
} else {
|
||
memcpy(rq, xp, (b+7)/8);
|
||
}
|
||
for (; b%8; b*=2) {
|
||
if (b>nw*32) {
|
||
if (b<nia) bit_cpy(rq, b, rq, 0, nia-b);
|
||
b = 64*nw; // Ensure bi>=bf since bf is rounded up
|
||
break;
|
||
}
|
||
bit_cpy(rq, b, rq, 0, b);
|
||
}
|
||
} else {
|
||
memcpy(rp, xp, b/8);
|
||
}
|
||
bi = b/8;
|
||
bf = 8*nw;
|
||
if (bi == 1) { memset(rp, rp[0], bf); bi=bf; }
|
||
} else {
|
||
if (TI(x,elType) == el_B) {
|
||
B xf = getFillQ(x);
|
||
MAKE_MUT(m, nia); mut_init(m, el_B);
|
||
MUTG_INIT(m);
|
||
i64 div = nia/xia;
|
||
i64 mod = nia%xia;
|
||
for (i64 i = 0; i < div; i++) mut_copyG(m, i*xia, x, 0, xia);
|
||
mut_copyG(m, div*xia, x, 0, mod);
|
||
decG(x);
|
||
return withFill(taga(arr_shSetU(mut_fp(m), nr, sh)), xf);
|
||
}
|
||
u8 xk = xl - 3;
|
||
rp = m_tyarrp(&r, 1<<xk, nia, xt);
|
||
bi = (u64)xia<<xk;
|
||
bf = (u64)nia<<xk;
|
||
memcpy(rp, tyany_ptr(x), bi);
|
||
}
|
||
decG(x);
|
||
if (bi<=8 && !(bi & (bi-1))) {
|
||
// Divisor of 8: write words
|
||
usz b = bi*8;
|
||
u64 v = *(u64*)rp & (~(u64)0 >> (64-b));
|
||
while (b<64) { v |= v<<b; b*=2; }
|
||
fill_words(rp, v, bf);
|
||
} else {
|
||
// Double up to length l, then copy in blocks
|
||
u64 l = 1<<15; if (l>bf) l=bf;
|
||
for (; bi<=l/2; bi+=bi) memcpy(rp+bi, rp, bi);
|
||
u64 e=bi; for (; e+bi<=bf; e+=bi) memcpy(rp+e, rp, bi);
|
||
if (e<bf) memcpy(rp+e, rp, bf-e);
|
||
}
|
||
}
|
||
} else {
|
||
unit:
|
||
#define FILL(E,T,V) T* rp; r = m_##E##arrp(&rp,nia); fill_words(rp, V, (u64)nia*sizeof(T));
|
||
if (isF64(x)) {
|
||
i32 n = (i32)x.f;
|
||
if (RARE(n!=x.f)) {
|
||
FILL(f64,f64,x.u)
|
||
} else if (n==(i8)n) { // memset can be faster than writing words
|
||
u8 b = n;
|
||
i8* rp; u64 nb = nia;
|
||
if (b <= 1) { r = m_bitarrp((u64**)&rp,nia); nb = 8*BIT_N(nia); b=-b; }
|
||
else { r = m_i8arrp ( &rp,nia); }
|
||
memset(rp, b, nb);
|
||
} else {
|
||
if(n==(i16)n) { FILL(i16,i16,(u16)n*0x0001000100010001) }
|
||
else { FILL(i32,i32,(u32)n*0x0000000100000001) }
|
||
}
|
||
} else if (isC32(x)) {
|
||
u32 c = o2cG(x);
|
||
if (c==(u8 )c) { u8* rp; r = m_c8arrp(&rp,nia); memset(rp, c, nia); }
|
||
else if (c==(u16)c) { FILL(c16,u16,c*0x0001000100010001) }
|
||
else { FILL(c32,u32,c*0x0000000100000001) }
|
||
} else {
|
||
incBy(x, nia); // in addition with the existing reference, this covers the filled amount & asFill
|
||
r = m_fillarrp(nia);
|
||
if (sizeof(B)==8) fill_words(fillarr_ptr(r), x.u, (u64)nia*8);
|
||
else for (usz i = 0; i < nia; i++) fillarr_ptr(r)[i] = x;
|
||
fillarr_setFill(r, asFill(x));
|
||
}
|
||
#undef FILL
|
||
}
|
||
return taga(arr_shSetU(r,nr,sh));
|
||
}
|
||
|
||
B pick_c1(B t, B x) {
|
||
if (isAtm(x)) return x;
|
||
if (RARE(IA(x)==0)) {
|
||
thrM("⊑: Argument cannot be empty");
|
||
// B r = getFillE(x);
|
||
// dec(x);
|
||
// return r;
|
||
}
|
||
B r = IGet(x, 0);
|
||
decG(x);
|
||
return r;
|
||
}
|
||
|
||
static NOINLINE void checkIndexList(B w, ur xr) {
|
||
SGetU(w)
|
||
usz ia = IA(w);
|
||
for (usz i = 0; i < ia; i++) if (!isNum(GetU(w,i))) thrM("⊑: 𝕨 contained list with mixed-type elements");
|
||
if (ia>xr+xr+10) {
|
||
if (RNK(w)!=1) thrF("⊑: Leaf arrays in 𝕨 must have rank 1 (element in 𝕨 has shape %H)", w);
|
||
thrF("⊑: Leaf array in 𝕨 too large (has shape %H)", w);
|
||
}
|
||
}
|
||
static B recPick(B w, B x) { // doesn't consume
|
||
assert(isArr(w) && isArr(x));
|
||
usz ia = IA(w);
|
||
ur xr = RNK(x);
|
||
usz* xsh = SH(x);
|
||
switch(TI(w,elType)) { default: UD;
|
||
case el_i8: { i8* wp = i8any_ptr (w); if(RNK(w)!=1)goto wrr; if (ia!=xr)goto wrl; usz c=0; for (usz i = 0; i < ia; i++) { c = c*xsh[i] + WRAP(wp[i], xsh[i], goto oob); }; return IGet(x,c); }
|
||
case el_i16: { i16* wp = i16any_ptr(w); if(RNK(w)!=1)goto wrr; if (ia!=xr)goto wrl; usz c=0; for (usz i = 0; i < ia; i++) { c = c*xsh[i] + WRAP(wp[i], xsh[i], goto oob); }; return IGet(x,c); }
|
||
case el_i32: { i32* wp = i32any_ptr(w); if(RNK(w)!=1)goto wrr; if (ia!=xr)goto wrl; usz c=0; for (usz i = 0; i < ia; i++) { c = c*xsh[i] + WRAP(wp[i], xsh[i], goto oob); }; return IGet(x,c); }
|
||
case el_f64: { f64* wp = f64any_ptr(w); if(RNK(w)!=1)goto wrr; if (ia!=xr)goto wrl; usz c=0; for (usz i = 0; i < ia; i++) { i64 ws = (i64)wp[i]; if (wp[i]!=ws) thrM(ws==I64_MIN? "⊑: 𝕨 contained value too large" : "⊑: 𝕨 contained a non-integer");
|
||
c = c*xsh[i] + WRAP(ws, xsh[i], goto oob); }; return IGet(x,c); }
|
||
case el_c8: case el_c16: case el_c32: case el_bit:
|
||
case el_B: {
|
||
if (ia==0) {
|
||
if (xr!=0) thrM("⊑: Empty array in 𝕨 must correspond to unit in 𝕩");
|
||
return IGet(x,0);
|
||
}
|
||
SGetU(w)
|
||
if (isNum(GetU(w,0))) {
|
||
if(RNK(w)!=1) goto wrr;
|
||
if (ia!=xr) goto wrl;
|
||
usz c=0;
|
||
for (usz i = 0; i < ia; i++) {
|
||
B cw = GetU(w,i);
|
||
if (!isNum(cw)) thrM("⊑: 𝕨 contained list with mixed-type elements");
|
||
c = c*xsh[i] + WRAP(o2i64(cw), xsh[i], goto oob);
|
||
}
|
||
return IGet(x,c);
|
||
} else {
|
||
M_HARR(r, ia);
|
||
for(usz i=0; i<ia; i++) {
|
||
B c = GetU(w, i);
|
||
if (isAtm(c)) thrM("⊑: 𝕨 contained list with mixed-type elements");
|
||
HARR_ADD(r, i, recPick(c, x));
|
||
}
|
||
return HARR_FC(r, w);
|
||
}
|
||
}
|
||
}
|
||
#undef PICK
|
||
|
||
wrr: checkIndexList(w, xr); thrF("⊑: Leaf arrays in 𝕨 must have rank 1 (element: %B)", w); // wrong index rank
|
||
wrl: checkIndexList(w, xr); thrF("⊑: Picking item at wrong rank (index %B in array of shape %H)", w, x); // wrong index length
|
||
oob: checkIndexList(w, xr); thrF("⊑: Indexing out-of-bounds (index %B in array of shape %H)", w, x);
|
||
}
|
||
|
||
B pick_c2(B t, B w, B x) {
|
||
if (RARE(isAtm(x))) {
|
||
if (isArr(w) && RNK(w)==1 && IA(w)==0) { dec(w); return x; }
|
||
x = m_atomUnit(x);
|
||
}
|
||
if (isNum(w)) {
|
||
if (RNK(x)!=1) thrF("⊑: 𝕩 must be a list when 𝕨 is a number (%H ≡ ≢𝕩)", x);
|
||
usz p = WRAP(o2i64(w), IA(x), thrF("⊑: indexing out-of-bounds (𝕨≡%R, %s≡≠𝕩)", w, iaW));
|
||
B r = IGet(x, p);
|
||
decG(x);
|
||
return r;
|
||
}
|
||
if (!isArr(w)) thrM("⊑: 𝕨 must be a numeric array");
|
||
B r = recPick(w, x);
|
||
decG(w); decG(x);
|
||
return r;
|
||
}
|
||
|
||
FORCE_INLINE B affixes(B x, i32 post) {
|
||
if (!isArr(x) || RNK(x)==0) thrM(post? "↓: Argument must have rank at least 1" : "↑: Argument must have rank at least 1");
|
||
ur xr = RNK(x);
|
||
usz* xsh = SH(x);
|
||
u64 cam = *xsh;
|
||
u64 ria = cam+1;
|
||
M_HARR(r, ria);
|
||
BSS2A slice = TI(x,slice);
|
||
if (xr==1) {
|
||
incByG(x, cam);
|
||
for (usz i = 0; i < ria; i++) HARR_ADD(r, i, taga(arr_shVec(slice(x, post?i:0, post?cam-i:i))));
|
||
} else {
|
||
incByG(x, cam+1);
|
||
assert(xr>=2);
|
||
usz csz = arr_csz(x);
|
||
usz* csh = xsh+1;
|
||
for (usz i = 0; i < ria; i++) {
|
||
usz len = post? cam-i : i;
|
||
Arr* c = slice(x, post? i*csz : 0, len*csz);
|
||
usz* sh = arr_shAlloc(c, xr);
|
||
*(sh++) = len;
|
||
shcpy(sh, csh, xr-1);
|
||
HARR_ADD(r, i, taga(c));
|
||
}
|
||
dec(x);
|
||
}
|
||
B rf = incG(HARR_O(r).a[post? cam : 0]);
|
||
return withFill(HARR_FV(r), rf);
|
||
}
|
||
|
||
B take_c1(B t, B x) { return affixes(x, 0); }
|
||
B drop_c1(B t, B x) { return affixes(x, 1); }
|
||
|
||
B take_c2(B, B, B);
|
||
B drop_c2(B, B, B);
|
||
NOINLINE B takedrop_highrank(bool take, B w, B x) {
|
||
#define SYMB (take? "↑" : "↓")
|
||
if (!isArr(w)) goto nonint;
|
||
ur wr = RNK(w);
|
||
if (wr>1) thrF("%U: 𝕨 must have rank at most 1 (%H ≡ ≢𝕨)", SYMB, w);
|
||
usz wia = IA(w);
|
||
if (wia >= UR_MAX) thrF("%U: Result rank too large", SYMB);
|
||
B r, w0;
|
||
if (wia<=1) {
|
||
if (wia==0) { r = x; goto decW_ret; }
|
||
w0 = IGetU(w,0);
|
||
if (!isF64(w0)) goto nonint;
|
||
basicTake:;
|
||
r = take? C2(take, w0, x) : C2(drop, w0, x);
|
||
goto decW_ret;
|
||
} else {
|
||
// return take? c2rt(take, w, x) : c2rt(drop, w, x);
|
||
|
||
ur xr = RNK(x);
|
||
ur rr = xr>wia? xr : wia;
|
||
assert(rr>=2);
|
||
ShArr* rsh = m_shArr(rr);
|
||
|
||
TALLOC(usz, tmp, rr*5);
|
||
usz* ltv = tmp+rr*0; // total counters
|
||
usz* lcv = tmp+rr*1; // current counters
|
||
usz* xcv = tmp+rr*2; // sizes to skip by in x
|
||
usz* rcv = tmp+rr*3; // sizes to skip by in r
|
||
usz* wn = tmp+rr*4; // 𝕨<0
|
||
usz* xsh = SH(x);
|
||
SGetU(w)
|
||
|
||
usz ria = 1;
|
||
bool anyFill = false;
|
||
i64 cellStart = -1; // axis from which whole cells can be copied
|
||
for (usz i = 0; i < rr; i++) {
|
||
i64 cw = i<wia? o2i64(GetU(w, i)) : take? xsh[i] : 0;
|
||
u64 cwa = cw<0? -cw : cw;
|
||
wn[i] = cw<0;
|
||
usz xshc = i<rr-xr? 1 : xsh[i-(rr-xr)];
|
||
|
||
u64 c = take? cwa : cwa>=xshc? 0 : xshc-cwa;
|
||
if (c!=xshc) cellStart = i;
|
||
anyFill|= c>xshc;
|
||
rsh->a[i] = c;
|
||
if (mulOn(ria, c)) thrOOM();
|
||
}
|
||
CHECK_IA(ria, 8);
|
||
|
||
if (cellStart<=0) {
|
||
if (xr==rr) {
|
||
decShObj(rsh);
|
||
} else {
|
||
Arr* ra = TI(x,slice)(x,0,IA(x));
|
||
PLAINLOOP for (usz i = 0; i < rr-xr; i++) rsh->a[i] = 1;
|
||
x = VALIDATE(taga(arr_shSetU(ra, rr, rsh)));
|
||
}
|
||
if (cellStart==-1) { // printf("equal shape\n");
|
||
r = x;
|
||
goto decW_tfree;
|
||
} else { // printf("last axis\n");
|
||
w0 = GetU(w, 0);
|
||
TFREE(tmp);
|
||
goto basicTake;
|
||
}
|
||
} else if (ria==0) { // printf("empty result\n");
|
||
r = taga(arr_shSetU(emptyArr(x, rr), rr, rsh));
|
||
} else { // printf("generic\n");
|
||
MAKE_MUT(rm, ria); mut_init(rm, TI(x,elType));
|
||
B xf = getFillR(x);
|
||
if (anyFill && noFill(xf)) {
|
||
#if PROPER_FILLS
|
||
thrM("↑: fill element required for overtaking, but 𝕩 doesn't have one");
|
||
#else
|
||
xf = m_f64(0);
|
||
#endif
|
||
}
|
||
|
||
MUTG_INIT(rm);
|
||
if (IA(x)==0) {
|
||
mut_fillG(rm, 0, xf, ria);
|
||
} else { // actual generic copying code
|
||
|
||
usz xcs=1, rcs=1; // current cell size
|
||
usz xs=0, rs=0; // cumulative sum
|
||
usz ri=0, xi=0; // index of first copy
|
||
usz xSkip, rSkip; // amount to skip forward by
|
||
usz cellWrite = 0; // batch write cell size
|
||
ONLY_GCC(xSkip=rSkip=USZ_MAX/2;)
|
||
for (usz i=rr; i-->0; ) {
|
||
usz xshc = i<rr-xr? 1 : xsh[i-(rr-xr)];
|
||
usz rshc = rsh->a[i];
|
||
|
||
i64 diff = xshc-(i64)rshc;
|
||
i64 off = take^wn[i]? 0 : diff; // take? (wn[i]? diff : 0) : wn[i]? 0 : diff
|
||
if (off>0) xi+= off*xcs;
|
||
if (off<0) ri-= off*rcs;
|
||
|
||
bool pad = diff<0;
|
||
|
||
// ltv[i] = lcv[i] = pad? xshc : rshc;
|
||
// rcv[i] = rs; if ( pad) rs-= rcs*diff; rcs*= rshc;
|
||
// xcv[i] = xs; if (!pad) xs+= xcs*diff; xcs*= xshc;
|
||
rcv[i]=rs;
|
||
xcv[i]=xs;
|
||
if (pad) { rs-= rcs*diff; ltv[i]=lcv[i]=xshc; }
|
||
else { xs+= xcs*diff; ltv[i]=lcv[i]=rshc; }
|
||
usz rcs0 = rcs;
|
||
rcs*= rshc;
|
||
xcs*= xshc;
|
||
|
||
if (i==cellStart) {
|
||
xSkip=xcs;
|
||
rSkip=rcs;
|
||
cellWrite = (pad? rcs0*xshc : rcs);
|
||
xs+= cellWrite;
|
||
rs+= cellWrite;
|
||
}
|
||
}
|
||
|
||
usz pri = 0;
|
||
while (true) {
|
||
if (anyFill) { // TODO if cellWrite is a small enough number of bytes (limit possibly higher for el_bit) & elType<el_B, write all the fills at the start at once
|
||
if (ri!=pri) mut_fillG(rm, pri, xf, ri-pri);
|
||
pri = ri+cellWrite;
|
||
}
|
||
mut_copyG(rm, ri, x, xi, cellWrite);
|
||
usz cr = cellStart-1;
|
||
if (0 == --lcv[cr]) {
|
||
do {
|
||
if (cr==0) goto endCopy;
|
||
lcv[cr] = ltv[cr];
|
||
cr--;
|
||
} while (0 == --lcv[cr]);
|
||
ri+= rcv[cr];
|
||
xi+= xcv[cr];
|
||
} else {
|
||
ri+= rSkip;
|
||
xi+= xSkip;
|
||
}
|
||
}
|
||
endCopy:;
|
||
if (anyFill && pri!=ria) mut_fillG(rm, pri, xf, ria-pri);
|
||
|
||
} // end of actual generic copying code
|
||
|
||
r = withFill(taga(arr_shSetU(mut_fp(rm), rr, rsh)), xf);
|
||
}
|
||
decG(x);
|
||
decW_tfree: TFREE(tmp);
|
||
goto decW_ret;
|
||
}
|
||
UD;
|
||
|
||
decW_ret: decG(w);
|
||
return r;
|
||
|
||
nonint: thrF("%U: 𝕨 must consist of integers", SYMB);
|
||
#undef SYMB
|
||
}
|
||
|
||
#define TAKEDROP_INIT(TAKE) \
|
||
if (!isArr(x)) x = m_atomUnit(x); \
|
||
if (!isNum(w)) return takedrop_highrank(TAKE, w, x); \
|
||
Arr* a; \
|
||
i64 wv = o2i64(w); \
|
||
i64 n = wv; \
|
||
ur xr = RNK(x); \
|
||
usz csz=1; usz* xsh ONLY_GCC(=0); \
|
||
if (xr>1) { \
|
||
csz = arr_csz(x); \
|
||
xsh = SH(x); \
|
||
ptr_inc(shObjS(xsh)); \
|
||
if (mulOn(n, csz)) thrOOM(); \
|
||
} else xr=1; \
|
||
|
||
#define TAKEDROP_SHAPE(SH0) \
|
||
if (xr>1) { \
|
||
usz* rsh=arr_shAlloc(a,xr); \
|
||
u64 wva = wv<0? -wv : wv; \
|
||
rsh[0] = SH0; \
|
||
shcpy(rsh+1, xsh+1, xr-1); \
|
||
ptr_dec(shObjS(xsh)); \
|
||
} \
|
||
return taga(a);
|
||
|
||
B take_c2(B t, B w, B x) {
|
||
TAKEDROP_INIT(1);
|
||
|
||
if (n>=0) {
|
||
CHECK_IA(n, 8);
|
||
a = take_impl(n, x);
|
||
if (xr==1) return taga(arr_shVec(a));
|
||
} else {
|
||
n = -n;
|
||
CHECK_IA(n, 8);
|
||
usz xia = IA(x);
|
||
if (n>xia) {
|
||
B xf = getFillE(x);
|
||
MAKE_MUT(r, n); mut_init(r, el_or(TI(x,elType), selfElType(xf)));
|
||
MUTG_INIT(r);
|
||
mut_fillG(r, 0, xf, n-xia);
|
||
mut_copyG(r, n-xia, x, 0, xia);
|
||
decG(x);
|
||
a = a(withFill(taga(arr_shVec(mut_fp(r))), xf));
|
||
} else {
|
||
a = TI(x,slice)(x,xia-n,n);
|
||
if (xr==1) return taga(arr_shVec(a));
|
||
}
|
||
}
|
||
TAKEDROP_SHAPE(wva);
|
||
}
|
||
B drop_c2(B t, B w, B x) {
|
||
TAKEDROP_INIT(0);
|
||
|
||
u64 na = n<0? -n : n;
|
||
usz xia = IA(x);
|
||
if (RARE(na>=xia)) { a = emptyArr(x, xr); decG(x); }
|
||
else {
|
||
a = TI(x,slice)(x, n<0? 0 : na, xia-na);
|
||
if (xr==1) return taga(arr_shVec(a));
|
||
}
|
||
|
||
TAKEDROP_SHAPE(wva>=*xsh? 0 : *xsh-wva);
|
||
}
|
||
|
||
|
||
|
||
B join_c1(B t, B x) {
|
||
if (isAtm(x)) thrM("∾: Argument must be an array");
|
||
|
||
ur xr = RNK(x);
|
||
usz xia = IA(x);
|
||
if (xia==0) {
|
||
B xf = getFillE(x);
|
||
if (isAtm(xf)) {
|
||
decA(xf); decG(x);
|
||
if (!PROPER_FILLS && xr==1) return emptyHVec();
|
||
thrM("∾: Empty array 𝕩 cannot have an atom fill element");
|
||
}
|
||
ur ir = RNK(xf);
|
||
if (ir<xr) thrF("∾: Empty array 𝕩 fill rank must be at least rank of 𝕩 (shape %H and fill shape %H)", x, xf);
|
||
B xff = getFillQ(xf);
|
||
HArr_p r = m_harrUp(0);
|
||
usz* sh = arr_shAlloc((Arr*)r.c, ir);
|
||
if (sh) {
|
||
sh[0] = 0;
|
||
usz* fsh = SH(xf);
|
||
if (xr>1) {
|
||
usz* xsh = SH(x);
|
||
for (usz i = 0; i < xr; i++) sh[i] = xsh[i]*fsh[i];
|
||
}
|
||
shcpy(sh+xr, fsh+xr, ir-xr);
|
||
}
|
||
dec(xf); decG(x);
|
||
return withFill(r.b, xff);
|
||
|
||
} else if (xr==1) {
|
||
SGetU(x)
|
||
B x0 = GetU(x,0);
|
||
B rf; if(SFNS_FILLS) rf = getFillQ(x0);
|
||
ur rm = isAtm(x0) ? 0 : RNK(x0); // Maximum element rank seen
|
||
ur rr = rm; // Result rank, or minimum possible so far
|
||
ur rd = 0; // Difference of max and min lengths (0 or 1)
|
||
usz* esh = NULL;
|
||
usz cam = 1; // Result length
|
||
if (rm) {
|
||
esh = SH(x0);
|
||
cam = *esh++;
|
||
} else {
|
||
rr++;
|
||
}
|
||
|
||
for (usz i = 1; i < xia; i++) {
|
||
B c = GetU(x, i);
|
||
ur cr = isAtm(c) ? 0 : RNK(c);
|
||
if (cr == 0) {
|
||
if (rm > 1) thrF("∾: Item ranks in a list can differ by at most one (contained ranks %i and %i)", 0, rm);
|
||
rd=rm; cam++;
|
||
} else {
|
||
usz* csh = SH(c);
|
||
ur cd = rm - cr;
|
||
if (RARE(cd > rd)) {
|
||
if ((ur)(cd+1-rd) > 2-rd) thrF("∾: Item ranks in a list can differ by at most one (contained ranks %i and %i)", rm-rd*(cr==rm), cr);
|
||
if (cr > rr) { // Previous elements were cells
|
||
esh--;
|
||
if (cam != i * *esh) thrM("∾: Item trailing shapes must be equal");
|
||
rr=cr; cam=i;
|
||
}
|
||
rm = cr>rm ? cr : rm;
|
||
rd = 1;
|
||
}
|
||
cam += cr < rm ? 1 : *csh++;
|
||
if (!eqShPart(csh, esh, cr-1)) thrF("∾: Item trailing shapes must be equal (contained arrays with shapes %H and %H)", x0, c);
|
||
}
|
||
if (SFNS_FILLS && !noFill(rf)) rf = fill_or(rf, getFillQ(c));
|
||
}
|
||
if (rm==0) thrM("∾: Some item rank must be equal or greater than rank of argument");
|
||
|
||
usz csz = shProd(esh, 0, rr-1);
|
||
MAKE_MUT(r, cam*csz);
|
||
usz ri = 0;
|
||
for (usz i = 0; i < xia; i++) {
|
||
B c = GetU(x, i);
|
||
if (isArr(c)) {
|
||
usz cia = IA(c);
|
||
mut_copy(r, ri, c, 0, cia);
|
||
ri+= cia;
|
||
} else {
|
||
mut_set(r, ri, inc(c));
|
||
ri++;
|
||
}
|
||
}
|
||
assert(ri==cam*csz);
|
||
Arr* ra = mut_fp(r);
|
||
usz* sh = arr_shAlloc(ra, rr);
|
||
if (sh) {
|
||
sh[0] = cam;
|
||
shcpy(sh+1, esh, rr-1);
|
||
}
|
||
decG(x);
|
||
return SFNS_FILLS? qWithFill(taga(ra), rf) : taga(ra);
|
||
} else if (xr==0) {
|
||
return bqn_merge(x);
|
||
} else {
|
||
SGetU(x)
|
||
B x0 = GetU(x,0);
|
||
B rf; if(SFNS_FILLS) rf = getFillQ(x0);
|
||
ur r0 = isAtm(x0) ? 0 : RNK(x0);
|
||
|
||
usz xia = IA(x);
|
||
usz* xsh = SH(x);
|
||
usz tlen = 4*xr+2*r0; for (usz a=0; a<xr; a++) tlen+=xsh[a];
|
||
TALLOC(usz, st, tlen); // Temp buffer
|
||
st[xr-1]=1; for (ur a=xr; a-->1; ) st[a-1] = st[a]*xsh[a]; // Stride
|
||
usz* tsh0 = st+xr; usz* tsh = tsh0+xr+r0; // Test shapes
|
||
// Length buffer i is lp+lp[i]
|
||
usz* lp = tsh+xr+r0; lp[0]=xr; for (usz a=1; a<xr; a++) lp[a] = lp[a-1]+xsh[a-1];
|
||
|
||
// Expand checked region from the root ⊑𝕩 along each axis in order,
|
||
// so that a non-root element is checked when the axis of the first
|
||
// nonzero in its index is reached.
|
||
ur tr = r0; // Number of root axes remaining
|
||
for (ur a = 0; a < xr; a++) {
|
||
// Check the axis starting at the root, getting axis lengths
|
||
usz n = xsh[a];
|
||
usz *ll = lp+lp[a];
|
||
if (n == 1) {
|
||
if (!tr) thrM("∾: Ranks of argument items too small");
|
||
st[a] = ll[0] = SH(x0)[r0-tr];
|
||
tr--; continue;
|
||
}
|
||
usz step = st[a];
|
||
ll[0] = r0;
|
||
for (usz i=1; i<n; i++) {
|
||
B c = GetU(x, i*step);
|
||
ll[i] = LIKELY(isArr(c)) ? RNK(c) : 0;
|
||
}
|
||
usz r1s=r0; for (usz i=1; i<n; i++) if (ll[i]>r1s) r1s=ll[i];
|
||
ur r1 = r1s;
|
||
ur a0 = r1==r0; // Root has axis a
|
||
if (tr < a0) thrM("∾: Ranks of argument items too small");
|
||
for (usz i=0; i<n; i++) {
|
||
ur rd = r1 - ll[i];
|
||
if (rd) {
|
||
if (rd>1) thrF("∾: Item ranks along an axis can differ by at most one (contained ranks %i and %i along axis %i)", ll[i], r1, a);
|
||
ll[i] = -1;
|
||
} else {
|
||
B c = GetU(x, i*step);
|
||
ll[i] = SH(c)[r0-tr];
|
||
}
|
||
}
|
||
|
||
// Check shapes
|
||
for (usz j=0; j<xia; j+=n*step) {
|
||
B base = GetU(x, j);
|
||
ur r = isAtm(base) ? 0 : RNK(base);
|
||
ur r1 = r+1-a0;
|
||
ur lr = 0;
|
||
if (r) {
|
||
usz* sh=SH(base);
|
||
lr = r - tr;
|
||
shcpy(tsh,sh,r); shcpy(tsh0,sh,r);
|
||
if (!a0) shcpy(tsh +lr+1, tsh +lr , tr );
|
||
else shcpy(tsh0+lr , tsh0+lr+1, tr-1);
|
||
}
|
||
for (usz i=1; i<n; i++) {
|
||
B c = GetU(x, j+i*step);
|
||
bool rd = ll[i]==-1;
|
||
tsh[lr] = ll[i];
|
||
ur cr=0; usz* sh=NULL; if (!isAtm(c)) { cr=RNK(c); sh=SH(c); }
|
||
if (cr != r1-rd) thrF("∾: Incompatible item ranks", base, c);
|
||
if (!eqShPart(rd?tsh0:tsh, sh, cr)) thrF("∾: Incompatible item shapes (contained arrays with shapes %H and %H along axis %i)", base, c, a);
|
||
if (SFNS_FILLS && !noFill(rf)) rf = fill_or(rf, getFillQ(c));
|
||
}
|
||
}
|
||
tr -= a0;
|
||
|
||
// Transform to lengths by changing -1 to 1, and get total
|
||
usz len = 0;
|
||
for (usz i=0; i<n; i++) {
|
||
len += ll[i] &= 1 | -(usz)(ll[i]!=-1);
|
||
}
|
||
st[a] = len;
|
||
}
|
||
|
||
// Move the data
|
||
usz* csh = tr ? SH(x0) + r0-tr : NULL; // Trailing shape
|
||
usz csz = shProd(csh, 0, tr);
|
||
MAKE_MUT(r, shProd(st, 0, xr)*csz);
|
||
// Element index and effective shape, updated progressively
|
||
usz *ei =tsh; for (usz i=0; i<xr; i++) ei [i]=0;
|
||
usz ri = 0;
|
||
usz *ll = lp+lp[xr-1];
|
||
for (usz i = 0;;) {
|
||
B e = GetU(x, i);
|
||
usz l = ll[ei[xr-1]] * csz;
|
||
if (RARE(isAtm(e))) {
|
||
assert(l==1);
|
||
mut_set(r, ri, inc(e));
|
||
} else {
|
||
usz eia = IA(e);
|
||
if (eia) {
|
||
usz rj = ri;
|
||
usz *ii=tsh0; for (usz k=0; k<xr-1; k++) ii[k]=0;
|
||
usz str0 = st[xr-1]*csz;
|
||
for (usz j=0;;) {
|
||
mut_copy(r, rj, e, j, l);
|
||
j+=l; if (j==eia) break;
|
||
usz str = str0;
|
||
rj += str;
|
||
for (usz a = xr-2; RARE(++ii[a] == lp[lp[a]+ei[a]]); a--) {
|
||
rj -= ii[a]*str;
|
||
ii[a] = 0;
|
||
str *= st[a];
|
||
rj += str;
|
||
}
|
||
}
|
||
}
|
||
}
|
||
if (++i == xia) break;
|
||
ri += l;
|
||
usz str = csz;
|
||
for (usz a = xr-1; RARE(++ei[a] == xsh[a]); ) {
|
||
ei[a] = 0;
|
||
str *= st[a];
|
||
a--;
|
||
ri += (lp[lp[a]+ei[a]]-1) * str;
|
||
}
|
||
}
|
||
Arr* ra = mut_fp(r);
|
||
usz* sh = arr_shAlloc(ra, xr+tr);
|
||
shcpy(sh , st , xr);
|
||
shcpy(sh+xr, csh, tr);
|
||
TFREE(st);
|
||
decG(x);
|
||
return SFNS_FILLS? qWithFill(taga(ra), rf) : taga(ra);
|
||
}
|
||
}
|
||
B join_c2(B t, B w, B x) {
|
||
if (isAtm(w)) w = m_atomUnit(w);
|
||
ur wr = RNK(w);
|
||
if (isAtm(x)) {
|
||
if (wr==1 && inplace_add(w, x)) return w;
|
||
x = m_atomUnit(x);
|
||
}
|
||
ur xr = RNK(x);
|
||
B f = fill_both(w, x);
|
||
|
||
ur c = wr>xr?wr:xr;
|
||
if (c==0) {
|
||
HArr_p r = m_harrUv(2);
|
||
r.a[0] = IGet(w,0); decG(w);
|
||
r.a[1] = IGet(x,0); decG(x);
|
||
NOGC_E;
|
||
return qWithFill(r.b, f);
|
||
}
|
||
if (c-wr > 1 || c-xr > 1) thrF("∾: Argument ranks must differ by 1 or less (%i≡=𝕨, %i≡=𝕩)", wr, xr);
|
||
|
||
bool reusedW;
|
||
B r = arr_join_inline(w, x, false, &reusedW);
|
||
if (c==1) {
|
||
if (RNK(r)==0) SRNK(r,1);
|
||
} else {
|
||
assert(c>1);
|
||
ur rnk0 = RNK(r);
|
||
ShArr* sh0 = shObj(r);
|
||
usz wia;
|
||
usz* wsh;
|
||
if (wr==1 && reusedW) {
|
||
wia = IA(w)-IA(x);
|
||
wsh = &wia;
|
||
} else {
|
||
wsh = SH(w); // when wr>1, shape object won't be disturbed by arr_join_inline
|
||
}
|
||
usz* xsh = SH(x);
|
||
SRNK(r, 0); // otherwise shape allocation failing may break things
|
||
usz* rsh = arr_shAlloc(a(r), c);
|
||
#if PRINT_JOIN_REUSE
|
||
printf(reusedW? "reuse:1;" : "reuse:0;");
|
||
#endif
|
||
for (i32 i = 1; i < c; i++) {
|
||
usz s = xsh[i+xr-c];
|
||
if (RARE(wsh[i+wr-c] != s)) {
|
||
B msg = make_fmt("∾: Lengths not matchable (%2H ≡ ≢𝕨, %H ≡ ≢𝕩)", wr, wsh, x);
|
||
if (rnk0>1) decShObj(sh0);
|
||
mm_free((Value*)shObjS(rsh));
|
||
arr_shVec(a(r));
|
||
thr(msg);
|
||
}
|
||
rsh[i] = s;
|
||
}
|
||
rsh[0] = (wr==c? wsh[0] : 1) + (xr==c? xsh[0] : 1);
|
||
if (rnk0>1) decShObj(sh0);
|
||
}
|
||
|
||
decG(x);
|
||
if (!reusedW) decG(w);
|
||
return qWithFill(r, f);
|
||
}
|
||
|
||
|
||
B couple_c1(B t, B x) {
|
||
if (isAtm(x)) return m_vec1(x);
|
||
usz rr = RNK(x);
|
||
usz ia = IA(x);
|
||
Arr* r = TI(x,slice)(incG(x),0, ia);
|
||
usz* sh = arr_shAlloc(r, rr+1);
|
||
if (sh) { sh[0] = 1; shcpy(sh+1, SH(x), rr); }
|
||
decG(x);
|
||
return taga(r);
|
||
}
|
||
B couple_c2(B t, B w, B x) {
|
||
if (isAtm(w)&isAtm(x)) return m_vec2(w, x);
|
||
if (isAtm(w)) w = m_atomUnit(w);
|
||
if (isAtm(x)) x = m_atomUnit(x);
|
||
if (!eqShape(w, x)) thrF("≍: 𝕨 and 𝕩 must have equal shapes (%H ≡ ≢𝕨, %H ≡ ≢𝕩)", w, x);
|
||
usz ia = IA(w);
|
||
ur wr = RNK(w);
|
||
MAKE_MUT(r, ia*2); mut_init(r, el_or(TI(w,elType), TI(x,elType)));
|
||
MUTG_INIT(r);
|
||
mut_copyG(r, 0, w, 0, ia);
|
||
mut_copyG(r, ia, x, 0, ia);
|
||
Arr* ra = mut_fp(r);
|
||
usz* sh = arr_shAlloc(ra, wr+1);
|
||
if (sh) { sh[0]=2; shcpy(sh+1, SH(w), wr); }
|
||
if (!SFNS_FILLS) { decG(w); decG(x); return taga(ra); }
|
||
B rf = fill_both(w, x);
|
||
decG(w); decG(x);
|
||
return qWithFill(taga(ra), rf);
|
||
}
|
||
|
||
|
||
static inline void shift_check(B w, B x) {
|
||
ur wr = RNK(w); usz* wsh = SH(w);
|
||
ur xr = RNK(x); usz* xsh = SH(x);
|
||
if (wr+1!=xr & wr!=xr) thrF("shift: =𝕨 must be =𝕩 or ¯1+=𝕩 (%i≡=𝕨, %i≡=𝕩)", wr, xr);
|
||
for (i32 i = 1; i < xr; i++) if (wsh[i+wr-xr] != xsh[i]) thrF("shift: Lengths not matchable (%H ≡ ≢𝕨, %H ≡ ≢𝕩)", w, x);
|
||
}
|
||
|
||
B shiftb_c1(B t, B x) {
|
||
if (isAtm(x) || RNK(x)==0) thrM("»: Argument cannot be a scalar");
|
||
usz ia = IA(x);
|
||
if (ia==0) return x;
|
||
B xf = getFillE(x);
|
||
usz csz = arr_csz(x);
|
||
|
||
MAKE_MUT(r, ia); mut_init(r, el_or(TI(x,elType), selfElType(xf)));
|
||
MUTG_INIT(r);
|
||
mut_copyG(r, csz, x, 0, ia-csz);
|
||
mut_fillG(r, 0, xf, csz);
|
||
return qWithFill(mut_fcd(r, x), xf);
|
||
}
|
||
B shiftb_c2(B t, B w, B x) {
|
||
if (isAtm(x) || RNK(x)==0) thrM("»: 𝕩 cannot be a scalar");
|
||
if (isAtm(w)) w = m_atomUnit(w);
|
||
shift_check(w, x);
|
||
B f = fill_both(w, x);
|
||
usz wia = IA(w);
|
||
usz xia = IA(x);
|
||
MAKE_MUT(r, xia); mut_init(r, el_or(TI(w,elType), TI(x,elType)));
|
||
MUTG_INIT(r);
|
||
int mid = wia<xia? wia : xia;
|
||
mut_copyG(r, 0 , w, 0, mid);
|
||
mut_copyG(r, mid, x, 0, xia-mid);
|
||
decG(w);
|
||
return qWithFill(mut_fcd(r, x), f);
|
||
}
|
||
|
||
B shifta_c1(B t, B x) {
|
||
if (isAtm(x) || RNK(x)==0) thrM("«: Argument cannot be a scalar");
|
||
usz ia = IA(x);
|
||
if (ia==0) return x;
|
||
B xf = getFillE(x);
|
||
usz csz = arr_csz(x);
|
||
MAKE_MUT(r, ia); mut_init(r, el_or(TI(x,elType), selfElType(xf)));
|
||
MUTG_INIT(r);
|
||
mut_copyG(r, 0, x, csz, ia-csz);
|
||
mut_fillG(r, ia-csz, xf, csz);
|
||
return qWithFill(mut_fcd(r, x), xf);
|
||
}
|
||
B shifta_c2(B t, B w, B x) {
|
||
if (isAtm(x) || RNK(x)==0) thrM("«: 𝕩 cannot be a scalar");
|
||
if (isAtm(w)) w = m_atomUnit(w);
|
||
shift_check(w, x);
|
||
B f = fill_both(w, x);
|
||
usz wia = IA(w);
|
||
usz xia = IA(x);
|
||
MAKE_MUT(r, xia); mut_init(r, el_or(TI(w,elType), TI(x,elType)));
|
||
MUTG_INIT(r);
|
||
if (wia < xia) {
|
||
usz m = xia-wia;
|
||
mut_copyG(r, 0, x, wia, m);
|
||
mut_copyG(r, m, w, 0, wia);
|
||
} else {
|
||
mut_copyG(r, 0, w, wia-xia, xia);
|
||
}
|
||
decG(w);
|
||
return qWithFill(mut_fcd(r, x), f);
|
||
}
|
||
|
||
static u64 bit_reverse(u64 x) {
|
||
u64 c = __builtin_bswap64(x);
|
||
c = (c&0x0f0f0f0f0f0f0f0f)<<4 | (c&0xf0f0f0f0f0f0f0f0)>>4;
|
||
c = (c&0x3333333333333333)<<2 | (c&0xcccccccccccccccc)>>2;
|
||
c = (c&0x5555555555555555)<<1 | (c&0xaaaaaaaaaaaaaaaa)>>1;
|
||
return c;
|
||
}
|
||
B reverse_c1(B t, B x) {
|
||
if (isAtm(x) || RNK(x)==0) thrM("⌽: Argument cannot be a unit");
|
||
usz n = *SH(x);
|
||
if (n==0) return x;
|
||
u8 xl = cellWidthLog(x);
|
||
u8 xt = arrNewType(TY(x));
|
||
if (xl<=6 && (xl>=3 || xl==0)) {
|
||
void* xv = tyany_ptr(x);
|
||
B r;
|
||
switch(xl) { default: UD; break;
|
||
case 0: {
|
||
u64* rp; r = m_bitarrc(&rp, x);
|
||
u64* xp=xv; usz g = BIT_N(n); usz e = g-1;
|
||
for (usz i = 0; i < g; i++) rp[i] = bit_reverse(xp[e-i]);
|
||
if (n&63) {
|
||
u64 sh=(-n)&63;
|
||
for (usz i=0; i<e; i++) rp[i]=rp[i]>>sh|rp[i+1]<<(64-sh);
|
||
rp[e]>>=sh;
|
||
}
|
||
break;
|
||
}
|
||
case 3: { u8* xp=xv; u8* rp = m_tyarrc(&r, 1, x, xt); for (usz i=0; i<n; i++) rp[i]=xp[n-i-1]; break; }
|
||
case 4: { u16* xp=xv; u16* rp = m_tyarrc(&r, 2, x, xt); for (usz i=0; i<n; i++) rp[i]=xp[n-i-1]; break; }
|
||
case 5: { u32* xp=xv; u32* rp = m_tyarrc(&r, 4, x, xt); for (usz i=0; i<n; i++) rp[i]=xp[n-i-1]; break; }
|
||
case 6: if (TI(x,elType)!=el_B) { u64* xp=xv; u64* rp = m_tyarrc(&r, 8, x, xt); for (usz i=0; i<n; i++) rp[i]=xp[n-i-1]; break; }
|
||
else {
|
||
HArr_p rp = m_harrUc(x);
|
||
B* xp = arr_bptr(x);
|
||
if (xp!=NULL) for (usz i=0; i<n; i++) rp.a[i] = inc(xp[n-i-1]);
|
||
else { SGet(x) for (usz i=0; i<n; i++) rp.a[i] = Get(x, n-i-1); }
|
||
NOGC_E;
|
||
r = rp.b;
|
||
B xf = getFillQ(x);
|
||
decG(x);
|
||
return withFill(r, xf);
|
||
}
|
||
}
|
||
decG(x);
|
||
return r;
|
||
}
|
||
B xf = getFillQ(x);
|
||
SLOW1("⌽𝕩", x);
|
||
usz csz = arr_csz(x);
|
||
usz cam = SH(x)[0];
|
||
usz rp = 0;
|
||
usz ip = IA(x);
|
||
MAKE_MUT(r, ip); mut_init(r, TI(x,elType));
|
||
MUTG_INIT(r);
|
||
for (usz i = 0; i < cam; i++) {
|
||
ip-= csz;
|
||
mut_copyG(r, rp, x, ip, csz);
|
||
rp+= csz;
|
||
}
|
||
return withFill(mut_fcd(r, x), xf);
|
||
}
|
||
|
||
|
||
B reverse_c2(B t, B w, B x);
|
||
|
||
#define WRAP_ROT(V, L) ({ i64 v_ = (V); usz l_ = (L); if ((u64)v_ >= (u64)l_) { v_%= (i64)l_; if(v_<0) v_+= l_; } v_; })
|
||
static NOINLINE B rotate_highrank(bool inv, B w, B x) {
|
||
#define INV (inv? "⁼" : "")
|
||
if (RNK(w)>1) thrF("⌽%U: 𝕨 must have rank at most 1 (%H ≡ ≢𝕨)", INV, w);
|
||
B r;
|
||
usz wia = IA(w);
|
||
if (isAtm(x) || RNK(x)==0) {
|
||
if (wia!=0) goto badlen;
|
||
r = isAtm(x)? m_unit(x) : x;
|
||
goto decW_ret;
|
||
}
|
||
|
||
ur xr = RNK(x);
|
||
if (wia==1) {
|
||
lastaxis:;
|
||
f64 wf = o2f(IGetU(w, 0));
|
||
r = C2(reverse, m_f64(inv? -wf : wf), x);
|
||
goto decW_ret;
|
||
}
|
||
if (wia>xr) goto badlen;
|
||
if (wia==0 || IA(x)==0) { r=x; goto decW_ret; }
|
||
|
||
usz* xsh = SH(x);
|
||
SGetU(w)
|
||
ur cr = wia-1;
|
||
usz rot0, l0;
|
||
usz csz = 1;
|
||
while (1) {
|
||
usz xshc = xsh[cr];
|
||
if (cr==0) goto lastaxis;
|
||
i64 wv = WRAP_ROT(o2i64(GetU(w, cr)), xshc);
|
||
if (wv!=0) { rot0 = inv? xshc-wv : wv; l0 = xshc; break; }
|
||
csz*= xshc;
|
||
cr--;
|
||
}
|
||
NOUNROLL for (usz i = xr; i-->wia; ) csz*= xsh[i];
|
||
|
||
TALLOC(usz, tmp, cr*3);
|
||
usz* pos = tmp+cr*0; // current position
|
||
usz* rot = tmp+cr*1; // (≠𝕩)|𝕨
|
||
usz* xcv = tmp+cr*2; // sizes to skip by in x
|
||
|
||
usz ri=0, xi=0; // current index in r & x
|
||
usz rSkip = csz*l0;
|
||
usz ccsz = rSkip;
|
||
for (usz i = cr; i-->0; ) {
|
||
usz xshc = xsh[i];
|
||
i64 v = WRAP_ROT(o2i64(GetU(w, i)), xshc);
|
||
if (inv && v!=0) v = xshc-v;
|
||
pos[i] = rot[i] = v;
|
||
xi+= v*ccsz;
|
||
xcv[i] = ccsz;
|
||
ccsz*= xshc;
|
||
}
|
||
|
||
MAKE_MUT(rm, IA(x)); mut_init(rm, TI(x,elType));
|
||
MUTG_INIT(rm);
|
||
|
||
usz n0 = csz*rot0;
|
||
usz n1 = csz*(l0-rot0);
|
||
while (true) {
|
||
mut_copyG(rm, ri+n1, x, xi, n0);
|
||
mut_copyG(rm, ri, x, xi+n0, n1);
|
||
usz c = cr-1;
|
||
while (true) {
|
||
if (xsh[c] == ++pos[c]) { xi-=xcv[c]*pos[c]; pos[c]=0; }
|
||
xi+= xcv[c];
|
||
if (pos[c]!=rot[c]) break;
|
||
if (c==0) goto endCopy;
|
||
c--;
|
||
}
|
||
ri+= rSkip;
|
||
}
|
||
endCopy:;
|
||
|
||
TFREE(tmp);
|
||
B xf = getFillE(x);
|
||
r = withFill(mut_fcd(rm, x), xf);
|
||
|
||
decW_ret: decG(w);
|
||
return r;
|
||
badlen: thrF("⌽%U: Length of list 𝕨 must be at most rank of 𝕩 (%s ≡ ≠𝕨, %H ≡ ≢𝕩⟩", INV, wia, x);
|
||
#undef INV
|
||
}
|
||
B reverse_c2(B t, B w, B x) {
|
||
if (isArr(w)) return rotate_highrank(0, w, x);
|
||
if (isAtm(x) || RNK(x)==0) thrM("⌽: 𝕩 must have rank at least 1 for atom 𝕨");
|
||
usz xia = IA(x);
|
||
if (xia==0) return x;
|
||
usz cam = SH(x)[0];
|
||
usz csz = arr_csz(x);
|
||
i64 am = WRAP_ROT(o2i64(w), cam);
|
||
if (am==0) return x;
|
||
am*= csz;
|
||
MAKE_MUT(r, xia); mut_init(r, TI(x,elType));
|
||
MUTG_INIT(r);
|
||
mut_copyG(r, 0, x, am, xia-am);
|
||
mut_copyG(r, xia-am, x, 0, am);
|
||
B xf = getFillQ(x);
|
||
return withFill(mut_fcd(r, x), xf);
|
||
}
|
||
|
||
#ifdef __BMI2__
|
||
#include <immintrin.h>
|
||
#if USE_VALGRIND
|
||
#define _pdep_u64 vg_pdep_u64
|
||
#endif
|
||
#endif
|
||
|
||
#if SINGELI_X86_64
|
||
static NOINLINE void base_transpose_u32(u32* rp, u32* xp, u64 w, u64 h, u64 xo, u64 ro) { PLAINLOOP for(usz y=0;y<h;y++) NOVECTORIZE for(usz x=0;x<w;x++) rp[x*ro+y] = xp[y*xo+x]; }
|
||
#define SINGELI_FILE transpose
|
||
#include "../utils/includeSingeli.h"
|
||
#endif
|
||
|
||
|
||
extern B rt_transp;
|
||
B transp_c1(B t, B x) {
|
||
if (RARE(isAtm(x))) return m_atomUnit(x);
|
||
ur xr = RNK(x);
|
||
if (xr<=1) return x;
|
||
|
||
usz ia = IA(x);
|
||
usz* xsh = SH(x);
|
||
usz h = xsh[0];
|
||
if (ia==0 || h==1) {
|
||
no_reorder:;
|
||
Arr* r = cpyWithShape(x);
|
||
ShArr* sh = m_shArr(xr);
|
||
shcpy(sh->a, xsh+1, xr-1);
|
||
sh->a[xr-1] = h;
|
||
arr_shReplace(r, xr, sh);
|
||
return taga(r);
|
||
}
|
||
usz w = xsh[1] * shProd(xsh, 2, xr);
|
||
if (w==1) goto no_reorder;
|
||
|
||
Arr* r;
|
||
usz xi = 0;
|
||
u8 xe = TI(x,elType);
|
||
bool toBit = false;
|
||
if (h==2) {
|
||
if (xe==el_B) {
|
||
B* xp = TO_BPTR(x);
|
||
B* x0 = xp; B* x1 = x0+w;
|
||
HArr_p rp = m_harrUp(ia);
|
||
for (usz i=0; i<w; i++) { rp.a[i*2] = inc(x0[i]); rp.a[i*2+1] = inc(x1[i]); }
|
||
NOGC_E;
|
||
r = (Arr*) rp.c;
|
||
} else {
|
||
#ifndef __BMI2__
|
||
if (xe==el_bit) { x = taga(cpyI8Arr(x)); xsh=SH(x); xe=el_i8; toBit=true; }
|
||
void* rp = m_tyarrp(&r,elWidth(xe),ia,el2t(xe));
|
||
#else
|
||
void* rp = m_tyarrlbp(&r,elWidthLogBits(xe),ia,el2t(xe));
|
||
#endif
|
||
void* xp = tyany_ptr(x);
|
||
switch(xe) { default: UD;
|
||
#ifdef __BMI2__
|
||
case el_bit:;
|
||
u32* x0 = xp;
|
||
Arr* x1o = TI(x,slice)(inc(x),w,w);
|
||
u32* x1 = (u32*) ((TyArr*)x1o)->a;
|
||
for (usz i=0; i<BIT_N(ia); i++) ((u64*)rp)[i] = _pdep_u64(x0[i], 0x5555555555555555) | _pdep_u64(x1[i], 0xAAAAAAAAAAAAAAAA);
|
||
mm_free((Value*)x1o);
|
||
break;
|
||
#endif
|
||
case el_i8: case el_c8: { u8* x0=xp; u8* x1=x0+w; for (usz i=0; i<w; i++) { ((u8* )rp)[i*2] = x0[i]; ((u8* )rp)[i*2+1] = x1[i]; } } break;
|
||
case el_i16:case el_c16: { u16* x0=xp; u16* x1=x0+w; for (usz i=0; i<w; i++) { ((u16*)rp)[i*2] = x0[i]; ((u16*)rp)[i*2+1] = x1[i]; } } break;
|
||
case el_i32:case el_c32: { u32* x0=xp; u32* x1=x0+w; for (usz i=0; i<w; i++) { ((u32*)rp)[i*2] = x0[i]; ((u32*)rp)[i*2+1] = x1[i]; } } break;
|
||
case el_f64: { u64* x0=xp; u64* x1=x0+w; for (usz i=0; i<w; i++) { ((u64*)rp)[i*2] = x0[i]; ((u64*)rp)[i*2+1] = x1[i]; } } break;
|
||
}
|
||
}
|
||
} else if (w==2 && xe!=el_B) {
|
||
#ifndef __BMI2__
|
||
if (xe==el_bit) { x = taga(cpyI8Arr(x)); xsh=SH(x); xe=el_i8; toBit=true; }
|
||
#endif
|
||
void* rp = m_tyarrlbp(&r,elWidthLogBits(xe),ia,el2t(xe));
|
||
void* xp = tyany_ptr(x);
|
||
switch(xe) { default: UD;
|
||
#if __BMI2__
|
||
case el_bit:;
|
||
u64* r0 = rp; TALLOC(u64, r1, BIT_N(h));
|
||
for (usz i=0; i<BIT_N(ia); i++) {
|
||
u64 v = ((u64*)xp)[i];
|
||
((u32*)r0)[i] = _pext_u64(v, 0x5555555555555555);
|
||
((u32*)r1)[i] = _pext_u64(v, 0xAAAAAAAAAAAAAAAA);
|
||
}
|
||
bit_cpy(r0, h, r1, 0, h);
|
||
TFREE(r1);
|
||
break;
|
||
#endif
|
||
case el_i8: case el_c8: { u8* r0=rp; u8* r1=r0+h; for (usz i=0; i<h; i++) { r0[i] = ((u8* )xp)[i*2]; r1[i] = ((u8* )xp)[i*2+1]; } } break;
|
||
case el_i16:case el_c16: { u16* r0=rp; u16* r1=r0+h; for (usz i=0; i<h; i++) { r0[i] = ((u16*)xp)[i*2]; r1[i] = ((u16*)xp)[i*2+1]; } } break;
|
||
case el_i32:case el_c32: { u32* r0=rp; u32* r1=r0+h; for (usz i=0; i<h; i++) { r0[i] = ((u32*)xp)[i*2]; r1[i] = ((u32*)xp)[i*2+1]; } } break;
|
||
case el_f64: { f64* r0=rp; f64* r1=r0+h; for (usz i=0; i<h; i++) { r0[i] = ((f64*)xp)[i*2]; r1[i] = ((f64*)xp)[i*2+1]; } } break;
|
||
}
|
||
} else {
|
||
switch(xe) { default: UD;
|
||
case el_bit: x = taga(cpyI8Arr(x)); xsh=SH(x); xe=el_i8; toBit=true; // fallthough
|
||
case el_i8: case el_c8: { u8* xp=tyany_ptr(x); u8* rp = m_tyarrp(&r,1,ia,el2t(xe)); PLAINLOOP for(usz y=0;y<h;y++) NOVECTORIZE for(usz x=0;x<w;x++) rp[x*h+y] = xp[xi++]; break; }
|
||
case el_i16:case el_c16: { u16* xp=tyany_ptr(x); u16* rp = m_tyarrp(&r,2,ia,el2t(xe)); PLAINLOOP for(usz y=0;y<h;y++) NOVECTORIZE for(usz x=0;x<w;x++) rp[x*h+y] = xp[xi++]; break; }
|
||
case el_i32:case el_c32:
|
||
#if SINGELI_X86_64
|
||
if (w>=8 && h>=8) { u32* xp=tyany_ptr(x); u32* rp = m_tyarrp(&r,4,ia,el2t(xe)); simd_transpose_i32(rp, xp, w, h); break; }
|
||
#endif
|
||
{ u32* xp=tyany_ptr(x); u32* rp = m_tyarrp(&r,4,ia,el2t(xe)); PLAINLOOP for(usz y=0;y<h;y++) NOVECTORIZE for(usz x=0;x<w;x++) rp[x*h+y] = xp[xi++]; break; }
|
||
case el_f64: { f64* xp=f64any_ptr(x); f64* rp; r=m_f64arrp(&rp,ia); PLAINLOOP for(usz y=0;y<h;y++) NOVECTORIZE for(usz x=0;x<w;x++) rp[x*h+y] = xp[xi++]; break; }
|
||
case el_B: { // can't be bothered to implement a bitarr transpose
|
||
B xf = getFillR(x);
|
||
B* xp = TO_BPTR(x);
|
||
|
||
HArr_p p = m_harrUp(ia);
|
||
for(usz y=0;y<h;y++) for(usz x=0;x<w;x++) p.a[x*h+y] = inc(xp[xi++]); // TODO inc afterwards, but don't when there's a method of freeing a HArr without freeing its elements
|
||
NOGC_E;
|
||
|
||
usz* rsh = arr_shAlloc((Arr*)p.c, xr);
|
||
if (xr==2) {
|
||
rsh[0] = w;
|
||
rsh[1] = h;
|
||
} else {
|
||
shcpy(rsh, xsh+1, xr-1);
|
||
rsh[xr-1] = h;
|
||
}
|
||
decG(x); return qWithFill(p.b, xf);
|
||
}
|
||
}
|
||
}
|
||
usz* rsh = arr_shAlloc(r, xr);
|
||
if (xr==2) {
|
||
rsh[0] = w;
|
||
rsh[1] = h;
|
||
} else {
|
||
shcpy(rsh, xsh+1, xr-1);
|
||
rsh[xr-1] = h;
|
||
}
|
||
decG(x); return taga(toBit? (Arr*)cpyBitArr(taga(r)) : r);
|
||
}
|
||
B transp_c2(B t, B w, B x) { return c2rt(transp, w, x); }
|
||
|
||
B transp_im(B t, B x) {
|
||
if (isAtm(x)) thrM("⍉⁼: 𝕩 must not be an atom");
|
||
if (RNK(x)<=2) return transp_c1(t, x);
|
||
return def_fn_im(bi_transp, x);
|
||
}
|
||
|
||
|
||
B pick_uc1(B t, B o, B x) { // TODO do in-place like pick_ucw; maybe just call it?
|
||
if (isAtm(x) || IA(x)==0) return def_fn_uc1(t, o, x);
|
||
B xf = getFillQ(x);
|
||
usz ia = IA(x);
|
||
B arg = IGet(x, 0);
|
||
B rep = c1(o, arg);
|
||
MAKE_MUT(r, ia); mut_init(r, el_or(TI(x,elType), selfElType(rep)));
|
||
MUTG_INIT(r);
|
||
mut_setG(r, 0, rep);
|
||
mut_copyG(r, 1, x, 1, ia-1);
|
||
return qWithFill(mut_fcd(r, x), xf);
|
||
}
|
||
|
||
B pick_ucw(B t, B o, B w, B x) {
|
||
if (isArr(w) || isAtm(x) || RNK(x)!=1) return def_fn_ucw(t, o, w, x);
|
||
usz xia = IA(x);
|
||
usz wi = WRAP(o2i64(w), xia, thrF("𝔽⌾(n⊸⊑)𝕩: reading out-of-bounds (n≡%R, %s≡≠𝕩)", w, xia));
|
||
if (TI(x,elType)==el_B) {
|
||
B* xp;
|
||
if (TY(x)==t_harr || TY(x)==t_hslice) {
|
||
if (!(TY(x)==t_harr && reusable(x))) x = taga(cpyHArr(x));
|
||
xp = harr_ptr(x);
|
||
} else if (TY(x)==t_fillarr && reusable(x)) {
|
||
xp = fillarr_ptr(a(x));
|
||
} else {
|
||
Arr* x2 = m_fillarrp(xia);
|
||
fillarr_setFill(x2, getFillQ(x));
|
||
xp = fillarr_ptr(x2);
|
||
COPY_TO(xp, el_B, 0, x, 0, xia);
|
||
arr_shCopy(x2, x);
|
||
dec(x);
|
||
x = taga(x2);
|
||
}
|
||
B c = xp[wi];
|
||
xp[wi] = m_f64(0);
|
||
xp[wi] = c1(o, c);
|
||
return x;
|
||
}
|
||
B arg = IGet(x, wi);
|
||
B rep = c1(o, arg);
|
||
if (reusable(x) && TI(x,canStore)(rep)) { REUSE(x);
|
||
u8 xt = TY(x);
|
||
if (xt==t_i8arr ) { i8* xp = i8any_ptr (x); xp[wi] = o2iG(rep); return x; }
|
||
else if (xt==t_i16arr) { i16* xp = i16any_ptr(x); xp[wi] = o2iG(rep); return x; }
|
||
else if (xt==t_i32arr) { i32* xp = i32any_ptr(x); xp[wi] = o2iG(rep); return x; }
|
||
else if (xt==t_f64arr) { f64* xp = f64any_ptr(x); xp[wi] = o2fG(rep); return x; }
|
||
else if (xt==t_c8arr ) { u8* xp = c8any_ptr (x); xp[wi] = o2cG(rep); return x; }
|
||
else if (xt==t_c16arr) { u16* xp = c16any_ptr(x); xp[wi] = o2cG(rep); return x; }
|
||
else if (xt==t_c32arr) { u32* xp = c32any_ptr(x); xp[wi] = o2cG(rep); return x; }
|
||
}
|
||
MAKE_MUT(r, xia); mut_init(r, el_or(TI(x,elType), selfElType(rep)));
|
||
MUTG_INIT(r);
|
||
mut_setG(r, wi, rep);
|
||
mut_copyG(r, 0, x, 0, wi);
|
||
mut_copyG(r, wi+1, x, wi+1, xia-wi-1);
|
||
B xf = getFillQ(x);
|
||
return qWithFill(mut_fcd(r, x), xf);
|
||
}
|
||
|
||
static B takedrop_ucw(i64 wi, B o, u64 am, B x, ux xr) {
|
||
usz xia = IA(x);
|
||
usz csz = arr_csz(x);
|
||
usz tk = csz*am; // taken element count
|
||
usz lv = xia-tk; // elements left alone
|
||
|
||
Arr* arg = TI(x,slice)(incG(x), wi<0? lv : 0, tk);
|
||
usz* ash = arr_shAlloc(arg, xr);
|
||
if (ash) { ash[0] = am; shcpy(ash+1, SH(x)+1, xr-1); }
|
||
|
||
B rep = c1(o, taga(arg));
|
||
if (isAtm(rep)) thrM("𝔽⌾(n⊸↑): 𝔽 returned an atom");
|
||
usz* repsh = SH(rep);
|
||
if (RNK(rep)==0 || !eqShPart(repsh+1, SH(x)+1, xr-1) || repsh[0]!=am) thrM("𝔽⌾(n⊸↑)𝕩: 𝔽 returned an array with a different shape than n↑𝕩");
|
||
|
||
MAKE_MUT(r, xia);
|
||
mut_init(r, el_or(TI(x,elType), TI(rep,elType))); MUTG_INIT(r);
|
||
if (wi<0) {
|
||
mut_copyG(r, 0, x, 0, lv);
|
||
mut_copyG(r, lv, rep, 0, tk);
|
||
} else {
|
||
mut_copyG(r, 0, rep, 0, tk);
|
||
mut_copyG(r, tk, x, tk, lv);
|
||
}
|
||
|
||
dec(rep);
|
||
return mut_fcd(r, x);
|
||
}
|
||
|
||
B take_ucw(B t, B o, B w, B x) {
|
||
if (!isF64(w)) return def_fn_ucw(t, o, w, x);
|
||
i64 wi = o2i64(w);
|
||
u64 am = wi<0? -wi : wi;
|
||
if (isAtm(x)) x = m_vec1(x);
|
||
ur xr = RNK(x); if (xr==0) xr = 1;
|
||
if (am>SH(x)[0]) thrF("𝔽⌾(n⊸↑)𝕩: Cannot modify fill with Under (%l ≡ 𝕨, %H ≡ ≢𝕩)", wi, x);
|
||
return takedrop_ucw(wi, o, am, x, xr);
|
||
}
|
||
|
||
B drop_ucw(B t, B o, B w, B x) {
|
||
if (!isF64(w)) return def_fn_ucw(t, o, w, x);
|
||
i64 wi = o2i64(w);
|
||
u64 am = wi<0? -wi : wi;
|
||
if (isAtm(x)) x = m_vec1(x);
|
||
ur xr = RNK(x); if (xr==0) xr = 1;
|
||
usz cam = SH(x)[0];
|
||
if (am>cam) am = cam;
|
||
return takedrop_ucw(-wi, o, cam-am, x, xr);
|
||
}
|
||
|
||
static B shape_uc1_t(B r, usz ia) {
|
||
if (!isArr(r) || RNK(r)!=1 || IA(r)!=ia) thrM("𝔽⌾⥊: 𝔽 changed the shape of the argument");
|
||
return r;
|
||
}
|
||
B shape_uc1(B t, B o, B x) {
|
||
if (!isArr(x) || RNK(x)==0) {
|
||
usz xia = isArr(x)? IA(x) : 1;
|
||
return C2(shape, emptyIVec(), shape_uc1_t(c1(o, shape_c1(t, x)), xia));
|
||
}
|
||
usz xia = IA(x);
|
||
if (RNK(x)==1) return shape_uc1_t(c1(o, x), xia);
|
||
ur xr = RNK(x);
|
||
ShArr* sh = ptr_inc(shObj(x));
|
||
return truncReshape(shape_uc1_t(c1(o, shape_c1(t, x)), xia), xia, xia, xr, sh);
|
||
}
|
||
|
||
B select_ucw(B t, B o, B w, B x);
|
||
|
||
B transp_uc1(B t, B o, B x) { return transp_im(m_f64(0), c1(o, transp_c1(t, x))); }
|
||
B reverse_uc1(B t, B o, B x) { return reverse_c1(m_f64(0), c1(o, reverse_c1(t, x))); }
|
||
|
||
B reverse_ix(B t, B w, B x) {
|
||
if (isAtm(x) || RNK(x)==0) thrM("⌽⁼: 𝕩 must have rank at least 1");
|
||
if (isF64(w)) return C2(reverse, m_f64(-o2fG(w)), x);
|
||
if (isAtm(w)) thrM("⌽⁼: 𝕨 must consist of integers");
|
||
return rotate_highrank(1, w, x);
|
||
}
|
||
|
||
B reverse_ucw(B t, B o, B w, B x) { return reverse_ix(m_f64(0), w, c1(o, reverse_c2(t, inc(w), x))); }
|
||
|
||
NOINLINE B enclose_im(B t, B x) {
|
||
if (isAtm(x) || RNK(x)!=0) thrM("<⁼: Argument wasn't a rank 0 array");
|
||
B r = IGet(x, 0);
|
||
dec(x);
|
||
return r;
|
||
}
|
||
B enclose_uc1(B t, B o, B x) {
|
||
return enclose_im(t, c1(o, m_atomUnit(x)));
|
||
}
|
||
|
||
void sfns_init(void) {
|
||
c(BFn,bi_pick)->uc1 = pick_uc1;
|
||
c(BFn,bi_reverse)->im = reverse_c1;
|
||
c(BFn,bi_reverse)->ix = reverse_ix;
|
||
c(BFn,bi_reverse)->uc1 = reverse_uc1;
|
||
c(BFn,bi_reverse)->ucw = reverse_ucw;
|
||
c(BFn,bi_pick)->ucw = pick_ucw;
|
||
c(BFn,bi_select)->ucw = select_ucw; // TODO move to new init fn
|
||
c(BFn,bi_shape)->uc1 = shape_uc1;
|
||
c(BFn,bi_transp)->uc1 = transp_uc1;
|
||
c(BFn,bi_transp)->im = transp_im;
|
||
c(BFn,bi_take)->ucw = take_ucw;
|
||
c(BFn,bi_drop)->ucw = drop_ucw;
|
||
c(BFn,bi_lt)->im = enclose_im;
|
||
c(BFn,bi_lt)->uc1 = enclose_uc1;
|
||
}
|