uCBQN/src/builtins/md1.c
2022-08-20 08:30:03 +03:00

614 lines
26 KiB
C
Raw Blame History

This file contains ambiguous Unicode characters

This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

#include "../core.h"
#include "../utils/each.h"
#include "../utils/file.h"
#include "../utils/time.h"
#include "../utils/mut.h"
#include "../builtins.h"
static B homFil1(B f, B r, B xf) {
assert(EACH_FILLS);
if (isPureFn(f)) {
if (f.u==bi_eq.u || f.u==bi_ne.u || f.u==bi_feq.u) { dec(xf); return toI32Any(r); } // ≠ may return ≥2⋆31, but whatever, this thing is stupid anyway
if (f.u==bi_fne.u) { dec(xf); return withFill(r, m_harrUv(0).b); }
if (!noFill(xf)) {
if (CATCH) { freeThrown(); return r; }
B rf = asFill(c1(f, xf));
popCatch();
return withFill(r, rf);
}
}
dec(xf);
return r;
}
static B homFil2(B f, B r, B wf, B xf) {
assert(EACH_FILLS);
if (isPureFn(f)) {
if (f.u==bi_feq.u || f.u==bi_fne.u) { dec(wf); dec(xf); return toI32Any(r); }
if (!noFill(wf) && !noFill(xf)) {
if (CATCH) { freeThrown(); return r; }
B rf = asFill(c2(f, wf, xf));
popCatch();
return withFill(r, rf);
}
}
dec(wf); dec(xf);
return r;
}
B tbl_c1(Md1D* d, B x) { B f = d->f;
if (!EACH_FILLS) return eachm(f, x);
B xf = getFillQ(x);
return homFil1(f, eachm(f, x), xf);
}
B slash_c2(B f, B w, B x);
B shape_c2(B f, B w, B x);
B tbl_c2(Md1D* d, B w, B x) { B f = d->f;
B wf, xf;
if (EACH_FILLS) wf = getFillQ(w);
if (EACH_FILLS) xf = getFillQ(x);
if (isAtm(w)) w = m_atomUnit(w);
if (isAtm(x)) x = m_atomUnit(x);
ur wr = rnk(w); usz wia = IA(w);
ur xr = rnk(x); usz xia = IA(x);
ur rr = wr+xr; usz ria = uszMul(wia, xia);
if (rr<xr) thrF("⌜: Result rank too large (%i≡=𝕨, %i≡=𝕩)", wr, xr);
B r;
usz* rsh;
BBB2B fc2 = c2fn(f);
if (!EACH_FILLS && isFun(f) && isPervasiveDy(f) && TI(w,arrD1)) {
if (TI(x,arrD1) && xia<80 && wia>130) {
Arr* wd = arr_shVec(TI(w,slice)(incG(w), 0, wia));
r = fc2(f, slash_c2(f, m_i32(xia), taga(wd)), shape_c2(f, m_f64(ria), incG(x)));
} else if (xia>7) {
SGet(w)
M_HARR(r, wia)
for (usz wi = 0; wi < wia; wi++) HARR_ADD(r, wi, fc2(f, Get(w,wi), incG(x)));
r = bqn_merge(HARR_FV(r));
} else goto generic;
if (rnk(r)>1) {
srnk(r, 0); // otherwise the following arr_shAlloc failing will result in r->sh dangling
ptr_dec(shObj(r));
}
rsh = arr_shAlloc(a(r), rr);
} else {
generic:;
SGetU(w) SGet(x)
M_HARR(r, ria)
for (usz wi = 0; wi < wia; wi++) {
B cw = GetU(w,wi);
for (usz xi = 0; xi < xia; xi++) HARR_ADDA(r, fc2(f, inc(cw), Get(x,xi)));
}
rsh = HARR_FA(r, rr);
r = HARR_O(r).b;
}
if (rsh) {
shcpy(rsh , a(w)->sh, wr);
shcpy(rsh+wr, a(x)->sh, xr);
}
decG(w); decG(x);
if (EACH_FILLS) return homFil2(f, r, wf, xf);
return r;
}
B each_c1(Md1D* d, B x) { B f = d->f;
if (!EACH_FILLS) return eachm(f, x);
B xf = getFillQ(x);
return homFil1(f, eachm(f, x), xf);
}
B each_c2(Md1D* d, B w, B x) { B f = d->f;
if (!EACH_FILLS) return eachd(f, w, x);
B wf = getFillQ(w);
B xf = getFillQ(x);
return homFil2(f, eachd(f, w, x), wf, xf);
}
B scan_ne(u64 p, u64* xp, u64 ia) {
u64* rp; B r=m_bitarrv(&rp,ia);
for (usz i = 0; i < BIT_N(ia); i++) {
u64 c = xp[i];
u64 r = c ^ (c<<1);
r^= r<< 2; r^= r<< 4; r^= r<<8;
r^= r<<16; r^= r<<32; r^= p;
rp[i] = r;
p = -(r>>63); // repeat sign bit
}
return r;
}
static bool fold_ne(u64* x, u64 am) {
u64 r = 0;
for (u64 i = 0; i < (am>>6); i++) r^= x[i];
if (am&63) r^= x[am>>6]<<(64-am & 63);
return POPC(r) & 1;
}
static i64 bit_diff(u64* x, u64 am) {
i64 r = 0;
u64 a = 0xAAAAAAAAAAAAAAAA;
for (u64 i = 0; i < (am>>6); i++) r+= POPC(x[i]^a);
if (am&63) r+= POPC((x[am>>6]^a)<<(64-am & 63));
return r - (i64)(am/2);
}
#if SINGELI
#pragma GCC diagnostic push
#pragma GCC diagnostic ignored "-Wunused-variable"
#include "../singeli/gen/scan.c"
#pragma GCC diagnostic pop
#endif
#if !USE_VALGRIND
static u64 vg_rand(u64 x) { return x; }
#endif
B scan_c1(Md1D* d, B x) { B f = d->f;
if (isAtm(x) || rnk(x)==0) thrM("`: Argument cannot have rank 0");
ur xr = rnk(x);
usz ia = IA(x);
if (ia==0) return x;
B xf = getFillQ(x);
u8 xe = TI(x,elType);
if (xr==1 && xe<=el_f64 && isFun(f) && v(f)->flags) {
u8 rtid = v(f)->flags-1;
if (xe==el_bit) {
u64* xp=bitarr_ptr(x);
if (rtid==n_add && ia<I32_MAX) { i32* rp; B r=m_i32arrv(&rp, ia);
#if SINGELI
avx2_bcs32(xp, rp, ia);
#else
i32 c=0; for (usz i=0; i<ia; i++) { c+= bitp_get(xp,i); rp[i]=c; }
#endif
decG(x); return r; }
if (rtid==n_or | rtid==n_ceil ) { u64* rp; B r=m_bitarrv(&rp,ia); usz n=BIT_N(ia); u64 xi; usz i=0; while(i<n) if ((xi= vg_rand(xp[i]))!=0) { rp[i] = -(xi&-xi) ; i++; while(i<n) rp[i++] = ~0LL; break; } else rp[i++]= 0 ; decG(x); return r; }
if (rtid==n_and | rtid==n_mul | rtid==n_floor) { u64* rp; B r=m_bitarrv(&rp,ia); usz n=BIT_N(ia); u64 xi; usz i=0; while(i<n) if ((xi=~vg_rand(xp[i]))!=0) { rp[i] = (xi&-xi)-1; i++; while(i<n) rp[i++] = 0 ; break; } else rp[i++]=~0LL; decG(x); return r; }
if (rtid==n_ne) { B r=scan_ne(0, xp, ia); decG(x); return r; }
goto base;
}
if (rtid==n_add) { // +
if (xe==el_i8 ) { i8* xp=i8any_ptr (x); i32* rp; B r=m_i32arrv(&rp, ia); i32 c=0; for (usz i=0; i<ia; i++) { if(addOn(c,xp[i]))goto base; rp[i]=c; } decG(x); return r; }
if (xe==el_i16) { i16* xp=i16any_ptr(x); i32* rp; B r=m_i32arrv(&rp, ia); i32 c=0; for (usz i=0; i<ia; i++) { if(addOn(c,xp[i]))goto base; rp[i]=c; } decG(x); return r; }
if (xe==el_i32) { i32* xp=i32any_ptr(x); i32* rp; B r=m_i32arrv(&rp, ia); i32 c=0; for (usz i=0; i<ia; i++) { if(addOn(c,xp[i]))goto base; rp[i]=c; } decG(x); return r; }
}
if (rtid==n_floor) { // ⌊
#if SINGELI
if (xe==el_i8 ) { i8* rp; B r=m_i8arrv (&rp, ia); avx2_scan_min8 (i8any_ptr (x), rp, ia); decG(x); return r; }
if (xe==el_i16) { i16* rp; B r=m_i16arrv(&rp, ia); avx2_scan_min16(i16any_ptr(x), rp, ia); decG(x); return r; }
if (xe==el_i32) { i32* rp; B r=m_i32arrv(&rp, ia); avx2_scan_min32(i32any_ptr(x), rp, ia); decG(x); return r; }
#else
if (xe==el_i8 ) { i8* xp=i8any_ptr (x); i8* rp; B r=m_i8arrv (&rp, ia); i8 c=I8_MAX ; for (usz i=0; i<ia; i++) { if (xp[i]<c)c=xp[i]; rp[i]=c; } decG(x); return r; }
if (xe==el_i16) { i16* xp=i16any_ptr(x); i16* rp; B r=m_i16arrv(&rp, ia); i16 c=I16_MAX; for (usz i=0; i<ia; i++) { if (xp[i]<c)c=xp[i]; rp[i]=c; } decG(x); return r; }
if (xe==el_i32) { i32* xp=i32any_ptr(x); i32* rp; B r=m_i32arrv(&rp, ia); i32 c=I32_MAX; for (usz i=0; i<ia; i++) { if (xp[i]<c)c=xp[i]; rp[i]=c; } decG(x); return r; }
#endif
}
if (rtid==n_ceil) { // ⌈
#if SINGELI
if (xe==el_i8 ) { i8* rp; B r=m_i8arrv (&rp, ia); avx2_scan_max8 (i8any_ptr (x), rp, ia); decG(x); return r; }
if (xe==el_i16) { i16* rp; B r=m_i16arrv(&rp, ia); avx2_scan_max16(i16any_ptr(x), rp, ia); decG(x); return r; }
if (xe==el_i32) { i32* rp; B r=m_i32arrv(&rp, ia); avx2_scan_max32(i32any_ptr(x), rp, ia); decG(x); return r; }
#else
if (xe==el_i8 ) { i8* xp=i8any_ptr (x); i8* rp; B r=m_i8arrv (&rp, ia); i8 c=I8_MIN ; for (usz i=0; i<ia; i++) { if (xp[i]>c)c=xp[i]; rp[i]=c; } decG(x); return r; }
if (xe==el_i16) { i16* xp=i16any_ptr(x); i16* rp; B r=m_i16arrv(&rp, ia); i16 c=I16_MIN; for (usz i=0; i<ia; i++) { if (xp[i]>c)c=xp[i]; rp[i]=c; } decG(x); return r; }
if (xe==el_i32) { i32* xp=i32any_ptr(x); i32* rp; B r=m_i32arrv(&rp, ia); i32 c=I32_MIN; for (usz i=0; i<ia; i++) { if (xp[i]>c)c=xp[i]; rp[i]=c; } decG(x); return r; }
#endif
}
if (rtid==n_ne) { // ≠
f64 x0 = IGetU(x,0).f; if (x0!=0 && x0!=1) goto base;
if (xe==el_i8 ) { i8* xp=i8any_ptr (x); u64* rp; B r=m_bitarrv(&rp,ia); bool c=x0; rp[0]=c; for (usz i=1; i<ia; i++) { c = c!=xp[i]; bitp_set(rp,i,c); } decG(x); return r; }
if (xe==el_i16) { i16* xp=i16any_ptr(x); u64* rp; B r=m_bitarrv(&rp,ia); bool c=x0; rp[0]=c; for (usz i=1; i<ia; i++) { c = c!=xp[i]; bitp_set(rp,i,c); } decG(x); return r; }
if (xe==el_i32) { i32* xp=i32any_ptr(x); u64* rp; B r=m_bitarrv(&rp,ia); bool c=x0; rp[0]=c; for (usz i=1; i<ia; i++) { c = c!=xp[i]; bitp_set(rp,i,c); } decG(x); return r; }
}
if (rtid==n_or) { //
if (xe==el_i8 ) { i8* xp=i8any_ptr (x); u64* rp; B r=m_bitarrv(&rp,ia); bool c=0; for (usz i=0; i<ia; i++) { if ((xp[i]&1)!=xp[i])goto base; c|=xp[i]; bitp_set(rp,i,c); } decG(x); return r; }
if (xe==el_i16) { i16* xp=i16any_ptr(x); u64* rp; B r=m_bitarrv(&rp,ia); bool c=0; for (usz i=0; i<ia; i++) { if ((xp[i]&1)!=xp[i])goto base; c|=xp[i]; bitp_set(rp,i,c); } decG(x); return r; }
if (xe==el_i32) { i32* xp=i32any_ptr(x); u64* rp; B r=m_bitarrv(&rp,ia); bool c=0; for (usz i=0; i<ia; i++) { if ((xp[i]&1)!=xp[i])goto base; c|=xp[i]; bitp_set(rp,i,c); } decG(x); return r; }
}
}
base:;
SLOW2("𝕎` 𝕩", f, x);
bool reuse = v(x)->type==t_harr && reusable(x);
HArr_p r = reuse? harr_parts(REUSE(x)) : m_harr0c(x);
AS2B xget = reuse? TI(x,getU) : TI(x,get); Arr* xa = a(x);
BBB2B fc2 = c2fn(f);
if (xr==1) {
r.a[0] = xget(xa,0);
for (usz i=1; i<ia; i++) r.a[i] = fc2(f, inc(r.a[i-1]), xget(xa,i));
} else {
usz csz = arr_csz(x);
usz i = 0;
for (; i<csz; i++) r.a[i] = xget(xa,i);
for (; i<ia; i++) r.a[i] = fc2(f, inc(r.a[i-csz]), xget(xa,i));
}
if (!reuse) decG(x);
return withFill(r.b, xf);
}
B scan_c2(Md1D* d, B w, B x) { B f = d->f;
if (isAtm(x) || rnk(x)==0) thrM("`: 𝕩 cannot have rank 0");
ur xr = rnk(x); usz* xsh = a(x)->sh; usz ia = IA(x);
B wf = getFillQ(w);
u8 xe = TI(x,elType);
if (xr==1 && q_i32(w) && xe<el_f64 && isFun(f) && v(f)->flags) {
u8 rtid = v(f)->flags-1;
i32 wv = o2iu(w);
if (xe==el_bit) {
u64* xp=bitarr_ptr(x);
if (rtid==n_add) { i32* rp; B r=m_i32arrv(&rp, ia); i64 c=wv; for (usz i=0; i<ia; i++) { c+= bitp_get(xp,i); rp[i]=c; } decG(x); return r; }
if (rtid==n_ne) { B r=scan_ne(-(u64)(q_ibit(wv)?wv:1&~*xp), xp, ia); decG(x); return r; }
goto base;
}
if (rtid==n_add) { // +
if (xe==el_i8 ) { i8* xp=i8any_ptr (x); i32* rp; B r=m_i32arrv(&rp, ia); i32 c=wv; for (usz i=0; i<ia; i++) { if(addOn(c,xp[i]))goto base; rp[i]=c; } decG(x); return r; }
if (xe==el_i16) { i16* xp=i16any_ptr(x); i32* rp; B r=m_i32arrv(&rp, ia); i32 c=wv; for (usz i=0; i<ia; i++) { if(addOn(c,xp[i]))goto base; rp[i]=c; } decG(x); return r; }
if (xe==el_i32) { i32* xp=i32any_ptr(x); i32* rp; B r=m_i32arrv(&rp, ia); i32 c=wv; for (usz i=0; i<ia; i++) { if(addOn(c,xp[i]))goto base; rp[i]=c; } decG(x); return r; }
}
if (rtid==n_floor) { // ⌊
if (xe==el_i8 && wv==(i8 )wv) { i8* xp=i8any_ptr (x); i8* rp; B r=m_i8arrv (&rp, ia); i8 c=wv; for (usz i=0; i<ia; i++) { if (xp[i]<c)c=xp[i]; rp[i]=c; } decG(x); return r; }
if (xe==el_i16 && wv==(i16)wv) { i16* xp=i16any_ptr(x); i16* rp; B r=m_i16arrv(&rp, ia); i16 c=wv; for (usz i=0; i<ia; i++) { if (xp[i]<c)c=xp[i]; rp[i]=c; } decG(x); return r; }
if (xe==el_i32 && wv==(i32)wv) { i32* xp=i32any_ptr(x); i32* rp; B r=m_i32arrv(&rp, ia); i32 c=wv; for (usz i=0; i<ia; i++) { if (xp[i]<c)c=xp[i]; rp[i]=c; } decG(x); return r; }
}
if (rtid==n_ceil) { // ⌈
if (xe==el_i8 && wv==(i8 )wv) { i8* xp=i8any_ptr (x); i8* rp; B r=m_i8arrv (&rp, ia); i8 c=wv; for (usz i=0; i<ia; i++) { if (xp[i]>c)c=xp[i]; rp[i]=c; } decG(x); return r; }
if (xe==el_i16 && wv==(i16)wv) { i16* xp=i16any_ptr(x); i16* rp; B r=m_i16arrv(&rp, ia); i16 c=wv; for (usz i=0; i<ia; i++) { if (xp[i]>c)c=xp[i]; rp[i]=c; } decG(x); return r; }
if (xe==el_i32 && wv==(i32)wv) { i32* xp=i32any_ptr(x); i32* rp; B r=m_i32arrv(&rp, ia); i32 c=wv; for (usz i=0; i<ia; i++) { if (xp[i]>c)c=xp[i]; rp[i]=c; } decG(x); return r; }
}
if (rtid==n_ne) { // ≠
if (!q_ibit(wv)) goto base; bool c=wv;
if (xe==el_i8 ) { i8* xp=i8any_ptr (x); u64* rp; B r=m_bitarrv(&rp, ia); for (usz i=0; i<ia; i++) { c^= xp[i]; bitp_set(rp,i,c); } decG(x); return r; }
if (xe==el_i16) { i16* xp=i16any_ptr(x); u64* rp; B r=m_bitarrv(&rp, ia); for (usz i=0; i<ia; i++) { c^= xp[i]; bitp_set(rp,i,c); } decG(x); return r; }
if (xe==el_i32) { i32* xp=i32any_ptr(x); u64* rp; B r=m_bitarrv(&rp, ia); for (usz i=0; i<ia; i++) { c^= xp[i]; bitp_set(rp,i,c); } decG(x); return r; }
}
}
base:;
SLOW3("𝕨 F` 𝕩", w, x, f);
bool reuse = (v(x)->type==t_harr && reusable(x)) | !ia;
usz i = 0;
HArr_p r = reuse? harr_parts(REUSE(x)) : m_harr0c(x);
AS2B xget = reuse? TI(x,getU) : TI(x,get); Arr* xa = a(x);
BBB2B fc2 = c2fn(f);
if (isArr(w)) {
ur wr = rnk(w); usz* wsh = a(w)->sh; SGet(w)
if (wr+1!=xr || !eqShPart(wsh, xsh+1, wr)) thrF("`: Shape of 𝕨 must match the cell of 𝕩 (%H ≡ ≢𝕨, %H ≡ ≢𝕩)", w, x);
if (ia==0) return x;
usz csz = arr_csz(x);
for (; i < csz; i++) r.a[i] = fc2(f, Get(w,i), xget(xa,i));
for (; i < ia; i++) r.a[i] = fc2(f, inc(r.a[i-csz]), xget(xa,i));
decG(w);
} else {
if (xr!=1) thrF("`: Shape of 𝕨 must match the cell of 𝕩 (%H ≡ ≢𝕨, %H ≡ ≢𝕩)", w, x);
if (ia==0) return x;
B pr = r.a[0] = fc2(f, w, xget(xa,0)); i++;
for (; i < ia; i++) r.a[i] = pr = fc2(f, inc(pr), xget(xa,i));
}
if (!reuse) decG(x);
return withFill(r.b, wf);
}
B fold_c1(Md1D* d, B x) { B f = d->f;
if (isAtm(x) || rnk(x)!=1) thrF("´: Argument must be a list (%H ≡ ≢𝕩)", x);
usz ia = IA(x);
if (ia==0) {
decG(x);
if (isFun(f)) {
B r = TI(f,identity)(f);
if (!q_N(r)) return inc(r);
}
thrM("´: No identity found");
}
u8 xe = TI(x,elType);
if (isFun(f) && v(f)->flags && xe<=el_f64) {
u8 rtid = v(f)->flags-1;
if (xe==el_bit) {
u64* xp = bitarr_ptr(x);
if (rtid==n_add) { B r = m_f64(bit_sum (xp, ia)); decG(x); return r; }
if (rtid==n_sub) { B r = m_f64(bit_diff(xp, ia)); decG(x); return r; }
if (rtid==n_and | rtid==n_mul | rtid==n_floor) { bool r=1; for (usz i=0; i<(ia>>6); i++) if (~xp[i]){r=0;break;} if(~bitp_l1(xp,ia))r=0; decG(x); return m_i32(r); }
if (rtid==n_or | rtid==n_ceil ) { bool r=0; for (usz i=0; i<(ia>>6); i++) if ( xp[i]){r=1;break;} if( bitp_l0(xp,ia))r=1; decG(x); return m_i32(r); }
if (rtid==n_ne) { bool r=fold_ne(xp, ia) ; decG(x); return m_i32(r); }
if (rtid==n_eq) { bool r=fold_ne(xp, ia) ^ (1&~ia); decG(x); return m_i32(r); }
goto base;
}
if (rtid==n_add) { // +
if (xe==el_i8 ) { i8* xp = i8any_ptr (x); i64 c=0; for (usz i=0; i<ia; i++) c+= xp[i]; decG(x); return m_f64(c); } // won't worry about 64TB array sum float inaccuracy for now
if (xe==el_i16) { i16* xp = i16any_ptr(x); i32 c=0; for (usz i=0; i<ia; i++) if (addOn(c,xp[i]))goto base; decG(x); return m_i32(c); }
if (xe==el_i32) { i32* xp = i32any_ptr(x); i32 c=0; for (usz i=0; i<ia; i++) if (addOn(c,xp[i]))goto base; decG(x); return m_i32(c); }
if (xe==el_f64) { f64* xp = f64any_ptr(x); f64 c=0; for (usz i=ia; i--; ) c+= xp[i]; decG(x); return m_f64(c); }
}
if (rtid==n_mul | rtid==n_and) { // ×/∧
if (xe==el_i8 ) { i8* xp = i8any_ptr (x); i32 c=1; for (usz i=ia; i--; ) if (mulOn(c,xp[i]))goto base; decG(x); return m_f64(c); }
if (xe==el_i16) { i16* xp = i16any_ptr(x); i32 c=1; for (usz i=ia; i--; ) if (mulOn(c,xp[i]))goto base; decG(x); return m_i32(c); }
if (xe==el_i32) { i32* xp = i32any_ptr(x); i32 c=1; for (usz i=ia; i--; ) if (mulOn(c,xp[i]))goto base; decG(x); return m_i32(c); }
if (xe==el_f64) { f64* xp = f64any_ptr(x); f64 c=1; for (usz i=ia; i--; ) c*= xp[i]; decG(x); return m_f64(c); }
}
if (rtid==n_floor) { // ⌊
if (xe==el_i8 ) { i8* xp = i8any_ptr (x); i8 c=I8_MAX ; for (usz i=0; i<ia; i++) if (xp[i]<c) c=xp[i]; decG(x); return m_i32(c); }
if (xe==el_i16) { i16* xp = i16any_ptr(x); i16 c=I16_MAX; for (usz i=0; i<ia; i++) if (xp[i]<c) c=xp[i]; decG(x); return m_i32(c); }
if (xe==el_i32) { i32* xp = i32any_ptr(x); i32 c=I32_MAX; for (usz i=0; i<ia; i++) if (xp[i]<c) c=xp[i]; decG(x); return m_i32(c); }
}
if (rtid==n_ceil) { // ⌈
if (xe==el_i8 ) { i8* xp = i8any_ptr (x); i8 c=I8_MIN ; for (usz i=0; i<ia; i++) if (xp[i]>c) c=xp[i]; decG(x); return m_i32(c); }
if (xe==el_i16) { i16* xp = i16any_ptr(x); i16 c=I16_MIN; for (usz i=0; i<ia; i++) if (xp[i]>c) c=xp[i]; decG(x); return m_i32(c); }
if (xe==el_i32) { i32* xp = i32any_ptr(x); i32 c=I32_MIN; for (usz i=0; i<ia; i++) if (xp[i]>c) c=xp[i]; decG(x); return m_i32(c); }
}
if (rtid==n_or) { //
if (xe==el_i8 ) { i8* xp = i8any_ptr (x); bool r=0; for (usz i=0; i<ia; i++) { i8 c=xp[i]; if (c!=0&&c!=1)goto base; r|=c; } decG(x); return m_i32(r); }
if (xe==el_i16) { i16* xp = i16any_ptr(x); bool r=0; for (usz i=0; i<ia; i++) { i16 c=xp[i]; if (c!=0&&c!=1)goto base; r|=c; } decG(x); return m_i32(r); }
if (xe==el_i32) { i32* xp = i32any_ptr(x); bool r=0; for (usz i=0; i<ia; i++) { i32 c=xp[i]; if (c!=0&&c!=1)goto base; r|=c; } decG(x); return m_i32(r); }
}
}
base:;
SLOW2("𝕎´ 𝕩", f, x);
SGet(x)
BBB2B fc2 = c2fn(f);
B c;
if (TI(x,elType)==el_i32) {
i32* xp = i32any_ptr(x);
c = m_i32(xp[ia-1]);
for (usz i = ia-1; i>0; i--) c = fc2(f, m_i32(xp[i-1]), c);
} else {
c = Get(x, ia-1);
for (usz i = ia-1; i>0; i--) c = fc2(f, Get(x, i-1), c);
}
decG(x);
return c;
}
B fold_c2(Md1D* d, B w, B x) { B f = d->f;
if (isAtm(x) || rnk(x)!=1) thrF("´: 𝕩 must be a list (%H ≡ ≢𝕩)", x);
usz ia = IA(x);
u8 xe = TI(x,elType);
if (q_i32(w) && isFun(f) && v(f)->flags && xe<el_f64) {
i32 wi = o2iu(w);
u8 rtid = v(f)->flags-1;
if (xe==el_bit) {
u64* xp = bitarr_ptr(x);
if (rtid==n_add) { B r = m_f64(wi + bit_sum (xp, ia)); decG(x); return r; }
if (rtid==n_sub) { B r = m_f64((ia&1?-wi:wi) + bit_diff(xp, ia)); decG(x); return r; }
if (wi!=(wi&1)) goto base;
if (rtid==n_and | rtid==n_mul | rtid==n_floor) { bool r=wi; if ( r) { for (usz i=0; i<(ia>>6); i++) if (~xp[i]){r=0;break;} if(~bitp_l1(xp,ia))r=0; } decG(x); return m_i32(r); }
if (rtid==n_or | rtid==n_ceil ) { bool r=wi; if (!r) { for (usz i=0; i<(ia>>6); i++) if ( xp[i]){r=1;break;} if( bitp_l0(xp,ia))r=1; } decG(x); return m_i32(r); }
if (rtid==n_ne) { bool r=wi^fold_ne(xp, ia) ; decG(x); return m_i32(r); }
if (rtid==n_eq) { bool r=wi^fold_ne(xp, ia) ^ (1&ia); decG(x); return m_i32(r); }
goto base;
}
if (rtid==n_add) { // +
if (xe==el_i8 ) { i8* xp = i8any_ptr (x); i64 c=wi; for (usz i=0; i<ia; i++) c+=xp[i]; decG(x); return m_f64(c); }
if (xe==el_i16) { i16* xp = i16any_ptr(x); i32 c=wi; for (usz i=0; i<ia; i++) if (addOn(c,xp[i]))goto base; decG(x); return m_i32(c); }
if (xe==el_i32) { i32* xp = i32any_ptr(x); i32 c=wi; for (usz i=0; i<ia; i++) if (addOn(c,xp[i]))goto base; decG(x); return m_i32(c); }
}
if (rtid==n_mul | rtid==n_and) { // ×/∧
if (xe==el_i8 ) { i8* xp = i8any_ptr (x); i32 c=wi; for (usz i=ia; i--; ) if (mulOn(c,xp[i]))goto base; decG(x); return m_i32(c); }
if (xe==el_i16) { i16* xp = i16any_ptr(x); i32 c=wi; for (usz i=ia; i--; ) if (mulOn(c,xp[i]))goto base; decG(x); return m_i32(c); }
if (xe==el_i32) { i32* xp = i32any_ptr(x); i32 c=wi; for (usz i=ia; i--; ) if (mulOn(c,xp[i]))goto base; decG(x); return m_i32(c); }
}
if (rtid==n_floor) { // ⌊
if (xe==el_i8 ) { i8* xp = i8any_ptr (x); i32 c=wi; for (usz i=0; i<ia; i++) if (xp[i]<c) c=xp[i]; decG(x); return m_i32(c); }
if (xe==el_i16) { i16* xp = i16any_ptr(x); i32 c=wi; for (usz i=0; i<ia; i++) if (xp[i]<c) c=xp[i]; decG(x); return m_i32(c); }
if (xe==el_i32) { i32* xp = i32any_ptr(x); i32 c=wi; for (usz i=0; i<ia; i++) if (xp[i]<c) c=xp[i]; decG(x); return m_i32(c); }
}
if (rtid==n_ceil) { // ⌈
if (xe==el_i8 ) { i8* xp = i8any_ptr (x); i32 c=wi; for (usz i=0; i<ia; i++) if (xp[i]>c) c=xp[i]; decG(x); return m_i32(c); }
if (xe==el_i16) { i16* xp = i16any_ptr(x); i32 c=wi; for (usz i=0; i<ia; i++) if (xp[i]>c) c=xp[i]; decG(x); return m_i32(c); }
if (xe==el_i32) { i32* xp = i32any_ptr(x); i32 c=wi; for (usz i=0; i<ia; i++) if (xp[i]>c) c=xp[i]; decG(x); return m_i32(c); }
}
if (rtid==n_or && (wi&1)==wi) { //
if (xe==el_i8 ) { i8* xp = i8any_ptr (x); bool q=wi; for (usz i=0; i<ia; i++) { i8 c=xp[i]; if (c!=0&&c!=1)goto base; q|=c; } decG(x); return m_i32(q); }
if (xe==el_i16) { i16* xp = i16any_ptr(x); bool q=wi; for (usz i=0; i<ia; i++) { i16 c=xp[i]; if (c!=0&&c!=1)goto base; q|=c; } decG(x); return m_i32(q); }
if (xe==el_i32) { i32* xp = i32any_ptr(x); bool q=wi; for (usz i=0; i<ia; i++) { i32 c=xp[i]; if (c!=0&&c!=1)goto base; q|=c; } decG(x); return m_i32(q); }
}
}
base:;
SLOW3("𝕨 F´ 𝕩", w, x, f);
B c = w;
SGet(x)
BBB2B fc2 = c2fn(f);
for (usz i = ia; i>0; i--) c = fc2(f, Get(x, i-1), c);
decG(x);
return c;
}
B const_c1(Md1D* d, B x) { dec(x); return inc(d->f); }
B const_c2(Md1D* d, B w, B x) { dec(w); dec(x); return inc(d->f); }
B swap_c1(Md1D* d, B x) { return c2(d->f, inc(x), x); }
B swap_c2(Md1D* d, B w, B x) { return c2(d->f, x , w); }
B timed_c2(Md1D* d, B w, B x) { B f = d->f;
i64 am = o2i64(w);
incBy(x, am);
dec(x);
u64 sns = nsTime();
for (i64 i = 0; i < am; i++) dec(c1(f, x));
u64 ens = nsTime();
return m_f64((ens-sns)/(1e9*am));
}
B timed_c1(Md1D* d, B x) { B f = d->f;
u64 sns = nsTime();
dec(c1(f, x));
u64 ens = nsTime();
return m_f64((ens-sns)*1e-9);
}
static B m1c1(B t, B f, B x) { // consumes x
B fn = m1_d(inc(t), inc(f));
B r = c1(fn, x);
decG(fn);
return r;
}
static B m1c2(B t, B f, B w, B x) { // consumes w,x
B fn = m1_d(inc(t), inc(f));
B r = c2(fn, w, x);
decG(fn);
return r;
}
#define S_SLICES(X) \
BSS2A X##_slc = TI(X,slice); \
usz X##_csz = 1; \
usz X##_cr = rnk(X)-1; \
ShArr* X##_csh; \
if (X##_cr>1) { \
X##_csh = m_shArr(X##_cr); \
NOUNROLL for (usz i = 0; i < X##_cr; i++) { \
usz v = a(X)->sh[i+1]; \
X##_csz*= v; \
X##_csh->a[i] = v; \
} \
} else if (X##_cr!=0) X##_csz*= a(X)->sh[1];
#define SLICE(X, S) ({ Arr* r_ = X##_slc(incG(X), S, X##_csz); arr_shSetI(r_, X##_cr, X##_csh); taga(r_); })
#define E_SLICES(X) if (X##_cr>1) ptr_dec(X##_csh); decG(X);
#pragma GCC diagnostic push
#ifdef __clang__
#pragma GCC diagnostic ignored "-Wsometimes-uninitialized"
// no gcc case because gcc is gcc and does gcc things instead of doing what it's asked to do
#endif
extern B to_fill_cell_k(B x, ur k, char* err); // from md2.c
static B to_fill_cell_1(B x) { // consumes x
return to_fill_cell_k(x, 1, "˘: Empty argument too large (%H ≡ ≢𝕩)");
}
static B merge_fill_result_1(B rc) {
u64 rr = isArr(rc)? rnk(rc)+1ULL : 1;
if (rr>UR_MAX) thrM("˘: Result rank too large");
B rf = getFillQ(rc);
Arr* r = m_fillarrp(0);
fillarr_setFill(r, rf);
usz* rsh = arr_shAlloc(r, rr);
if (rr>1) {
rsh[0] = 0;
shcpy(rsh+1, a(rc)->sh, rr-1);
}
dec(rc);
return taga(r);
}
B cell2_empty(B f, B w, B x, ur wr, ur xr) {
if (!isPureFn(f) || !CATCH_ERRORS) { dec(w); dec(x); return emptyHVec(); }
if (wr) w = to_fill_cell_1(w);
if (xr) x = to_fill_cell_1(x);
if (CATCH) return emptyHVec();
B rc = c2(f, w, x);
popCatch();
return merge_fill_result_1(rc);
}
B cell_c1(Md1D* d, B x) { B f = d->f;
if (isAtm(x) || rnk(x)==0) {
B r = c1(f, x);
return isAtm(r)? m_atomUnit(r) : r;
}
if (Q_BI(f,lt) && IA(x)!=0 && rnk(x)>1) return toCells(x);
usz cam = a(x)->sh[0];
if (cam==0) {
if (!isPureFn(f) || !CATCH_ERRORS) { decG(x); return emptyHVec(); }
B cf = to_fill_cell_1(x);
if (CATCH) return emptyHVec();
B rc = c1(f, cf);
popCatch();
return merge_fill_result_1(rc);
}
S_SLICES(x)
M_HARR(r, cam);
for (usz i=0,p=0; i<cam; i++,p+=x_csz) HARR_ADD(r, i, c1(f, SLICE(x, p)));
E_SLICES(x)
return bqn_merge(HARR_FV(r));
}
B cell_c2(Md1D* d, B w, B x) { B f = d->f;
bool wr = isAtm(w)? 0 : rnk(w);
bool xr = isAtm(x)? 0 : rnk(x);
B r;
if (wr==0 && xr==0) return isAtm(r = c2(f, w, x))? m_atomUnit(r) : r;
if (wr==0) {
usz cam = a(x)->sh[0];
if (cam==0) return cell2_empty(f, w, x, wr, xr);
S_SLICES(x)
M_HARR(r, cam);
for (usz i=0,p=0; i<cam; i++,p+=x_csz) HARR_ADD(r, i, c2iW(f, w, SLICE(x, p)));
E_SLICES(x) dec(w);
r = HARR_FV(r);
} else if (xr==0) {
usz cam = a(w)->sh[0];
if (cam==0) return cell2_empty(f, w, x, wr, xr);
S_SLICES(w)
M_HARR(r, cam);
for (usz i=0,p=0; i<cam; i++,p+=w_csz) HARR_ADD(r, i, c2iX(f, SLICE(w, p), x));
E_SLICES(w) dec(x);
r = HARR_FV(r);
} else {
usz cam = a(w)->sh[0];
if (cam==0) return cell2_empty(f, w, x, wr, xr);
if (cam != a(x)->sh[0]) thrF("˘: Leading axis of arguments not equal (%H ≡ ≢𝕨, %H ≡ ≢𝕩)", w, x);
S_SLICES(w) S_SLICES(x)
M_HARR(r, cam);
for (usz i=0,wp=0,xp=0; i<cam; i++,wp+=w_csz,xp+=x_csz) HARR_ADD(r, i, c2(f, SLICE(w, wp), SLICE(x, xp)));
E_SLICES(w) E_SLICES(x)
r = HARR_FV(r);
}
return bqn_merge(r);
}
extern B rt_insert;
B insert_c1(Md1D* d, B x) { B f = d->f;
if (isAtm(x) || rnk(x)==0) thrM("˝: 𝕩 must have rank at least 1");
usz xia = IA(x);
if (xia==0) return m1c1(rt_insert, f, x);
if (rnk(x)==1 && isFun(f) && isPervasiveDy(f)) {
return m_atomUnit(fold_c1(d, x));
}
S_SLICES(x)
usz p = xia-x_csz;
B r = SLICE(x, p);
while(p!=0) {
p-= x_csz;
r = c2(f, SLICE(x, p), r);
}
E_SLICES(x)
return r;
}
B insert_c2(Md1D* d, B w, B x) { B f = d->f;
if (isAtm(x) || rnk(x)==0) thrM("˝: 𝕩 must have rank at least 1");
usz xia = IA(x);
B r = w;
if (xia!=0) {
S_SLICES(x)
usz p = xia;
while(p!=0) {
p-= x_csz;
r = c2(f, SLICE(x, p), r);
}
E_SLICES(x)
}
return r;
}
#pragma GCC diagnostic pop
static void print_md1BI(FILE* f, B x) { fprintf(f, "%s", pm1_repr(c(Md1,x)->extra)); }
static B md1BI_im(Md1D* d, B x) { return ((BMd1*)d->m1)->im(d, x); }
static B md1BI_iw(Md1D* d, B w, B x) { return ((BMd1*)d->m1)->iw(d, w, x); }
static B md1BI_ix(Md1D* d, B w, B x) { return ((BMd1*)d->m1)->ix(d, w, x); }
void md1_init() {
TIi(t_md1BI,print) = print_md1BI;
TIi(t_md1BI,m1_im) = md1BI_im;
TIi(t_md1BI,m1_iw) = md1BI_iw;
TIi(t_md1BI,m1_ix) = md1BI_ix;
}