uCBQN/src/md1.c
2021-04-15 01:20:50 +03:00

156 lines
5.0 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 "h.h"
B tbl_c1(B d, B x) { B f = c(Md1D,d)->f;
if (!isArr(x)) thrM("⌜: argument cannot be an atom");
usz ia = a(x)->ia;
if (ia==0) return x;
BS2B xget = TI(x).get;
usz i = 0;
B cr = c1(f, xget(x,0));
HArr_p rH;
if (TI(x).canStore(cr)) {
bool reuse = reusable(x);
if (v(x)->type==t_harr) {
B* xp = harr_ptr(x);
if (reuse) {
dec(xp[i]); xp[i++] = cr;
for (; i < ia; i++) xp[i] = c1(f, xp[i]);
return x;
} else {
HArr_p rp = m_harrc(x);
rp.a[i++] = cr;
for (; i < ia; i++) rp.a[i] = c1(f, inc(xp[i]));
dec(x);
return rp.b;
}
} else if (v(x)->type==t_i32arr) {
i32* xp = i32arr_ptr(x);
B r = reuse? x : m_i32arrc(x);
i32* rp = i32arr_ptr(r);
rp[i++] = o2iu(cr);
for (; i < ia; i++) {
cr = c1(f, m_i32(xp[i]));
if (!q_i32(cr)) {
rH = m_harrc(x);
for (usz j = 0; j < i; j++) rH.a[j] = m_i32(rp[j]);
if (!reuse) dec(r);
goto fallback;
}
rp[i] = o2iu(cr);
}
if (!reuse) dec(x);
return r;
} else if (v(x)->type==t_fillarr) {
B* xp = fillarr_ptr(x);
if (reuse) {
dec(c(FillArr,x)->fill);
c(FillArr,x)->fill = bi_noFill;
dec(xp[i]); xp[i++] = cr;
for (; i < ia; i++) xp[i] = c1(f, xp[i]);
return x;
} else {
HArr_p rp = m_harrc(x);
rp.a[i++] = cr;
for (; i < ia; i++) rp.a[i] = c1(f, inc(xp[i]));
dec(x);
return rp.b;
}
} else
rH = m_harrc(x);
} else
rH = m_harrc(x);
fallback:
rH.a[i++] = cr;
for (; i < ia; i++) rH.a[i] = c1(f, xget(x,i));
dec(x);
return rH.b;
}
B tbl_c2(B d, B w, B x) { B f = c(Md1D,d)->f;
if (isArr(w) & isArr(x)) {
usz wia = a(w)->ia; ur wr = rnk(w);
usz xia = a(x)->ia; ur xr = rnk(x);
usz ria = wia*xia; ur rr = wr+xr;
if (rr<xr) thrM("⌜: required result rank too large");
HArr_p r = m_harrp(ria);
usz* rsh = arr_shAlloc(r.b, ria, rr);
if (rsh) {
memcpy(rsh , a(w)->sh, wr*sizeof(usz));
memcpy(rsh+wr, a(x)->sh, xr*sizeof(usz));
}
BS2B wget = TI(w).get;
BS2B xget = TI(x).get;
usz ri = 0;
for (usz wi = 0; wi < wia; wi++) {
B cw = wget(w,wi);
for (usz xi = 0; xi < xia; xi++) {
r.a[ri++] = c2(f, inc(cw), xget(x,xi));
}
dec(cw);
}
dec(w); dec(x);
return r.b;
} else thrM("⌜: 𝕨 and 𝕩 must be arrays");
}
B scan_c1(B d, B x) { B f = c(Md1D,d)->f;
if (!isArr(x) || rnk(x)==0) thrM("`: argument cannot have rank 0");
ur xr = rnk(x);
usz ia = a(x)->ia;
if (ia==0) return x;
bool reuse = v(x)->type==t_harr && reusable(x);
HArr_p r = reuse? harr_parts(inc(x)) : m_harrc(x);
BS2B xget = reuse? TI(x).getU : TI(x).get;
if (xr==1) {
r.a[0] = xget(x,0);
for (usz i = 1; i < ia; i++) r.a[i] = c2(f, inc(r.a[i-1]), xget(x,i));
} else {
usz csz = arr_csz(x);
for (usz i = 0; i < csz; i++) r.a[i] = xget(x,i);
for (usz i = csz; i < ia; i++) r.a[i] = c2(f, inc(r.a[i-csz]), xget(x,i));
}
dec(x);
return r.b;
}
B scan_c2(B d, B w, B x) { B f = c(Md1D,d)->f;
if (!isArr(x) || rnk(x)==0) thrM("`: 𝕩 cannot have rank 0");
ur xr = rnk(x); usz* xsh = a(x)->sh; usz ia = a(x)->ia;
bool reuse = v(x)->type==t_harr && reusable(x);
HArr_p r = reuse? harr_parts(inc(x)) : m_harrc(x);
BS2B xget = reuse? TI(x).getU : TI(x).get;
if (isArr(w)) {
ur wr = rnk(w); usz* wsh = a(w)->sh; BS2B wget = TI(w).get;
if (wr+1 != xr) thrM("`: shape of 𝕨 must match the cell of 𝕩");
if (memcmp(wsh, xsh+1, wr)) thrM("`: shape of 𝕨 must match the cell of 𝕩");
if (ia==0) { ptr_dec(r.c); return x; } // only safe as r would have 0 items too
usz csz = arr_csz(x);
for (usz i = 0; i < csz; i++) r.a[i] = c2(f, wget(w,i), xget(x,i));
for (usz i = csz; i < ia; i++) r.a[i] = c2(f, inc(r.a[i-csz]), xget(x,i));
dec(w);
} else {
if (xr!=1) thrM("`: shape of 𝕨 must match the cell of 𝕩");
if (ia==0) { ptr_dec(r.c); return x; }
B pr = r.a[0] = c2(f, w, xget(x,0));
for (usz i = 1; i < ia; i++) r.a[i] = pr = c2(f, inc(pr), xget(x,i));
}
dec(x);
return r.b;
}
#define ba(NAME) bi_##NAME = mm_alloc(sizeof(Md1), t_md1_def, ftag(MD1_TAG)); c(Md1,bi_##NAME)->c2 = NAME##_c2; c(Md1,bi_##NAME)->c1 = NAME##_c1 ; c(Md1,bi_##NAME)->extra=pm1_##NAME; gc_add(bi_##NAME);
#define bd(NAME) bi_##NAME = mm_alloc(sizeof(Md1), t_md1_def, ftag(MD1_TAG)); c(Md1,bi_##NAME)->c2 = NAME##_c2; c(Md1,bi_##NAME)->c1 = c1_invalid; c(Md1,bi_##NAME)->extra=pm1_##NAME; gc_add(bi_##NAME);
#define bm(NAME) bi_##NAME = mm_alloc(sizeof(Md1), t_md1_def, ftag(MD1_TAG)); c(Md1,bi_##NAME)->c2 = c2_invalid;c(Md1,bi_##NAME)->c1 = NAME##_c1 ; c(Md1,bi_##NAME)->extra=pm1_##NAME; gc_add(bi_##NAME);
void print_md1_def(B x) { printf("%s", format_pm1(c(Md1,x)->extra)); }
B bi_tbl, bi_scan;
void md1_init() { ba(tbl) ba(scan)
ti[t_md1_def].print = print_md1_def;
}
#undef ba
#undef bd
#undef bm