uCBQN/src/builtins/md2.c
2021-12-30 21:52:29 +02:00

270 lines
8.4 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 <math.h>
#include "../core.h"
#include "../utils/talloc.h"
#include "../builtins.h"
B md2BI_uc1(Md2* t, B o, B f, B g, B x) { return ((BMd2*)t)->uc1(t, o, f, g, x); }
B md2BI_ucw(Md2* t, B o, B f, B g, B w, B x) { return ((BMd2*)t)->ucw(t, o, f, g, w, x); }
B val_c1(Md2D* d, B x) { return c1(d->f, x); }
B val_c2(Md2D* d, B w, B x) { return c2(d->g, w,x); }
#if CATCH_ERRORS
B fillBy_c1(Md2D* d, B x) {
B xf=getFillQ(x);
B r = c1(d->f, x);
if(isAtm(r) || noFill(xf)) { dec(xf); return r; }
if (CATCH) { dec(catchMessage); return r; }
B fill = asFill(c1(d->g, xf));
popCatch();
return withFill(r, fill);
}
B fillBy_c2(Md2D* d, B w, B x) {
B wf=getFillQ(w); B xf=getFillQ(x);
B r = c2(d->f, w,x);
if(isAtm(r) || noFill(xf)) { dec(xf); dec(wf); return r; }
if (CATCH) { dec(catchMessage); return r; }
if (noFill(wf)) wf = incG(bi_asrt);
B fill = asFill(c2(d->g, wf, xf));
popCatch();
return withFill(r, fill);
}
B catch_c1(Md2D* d, B x) { if(CATCH) { dec(catchMessage); return c1(d->g, x); } inc(x); B r = c1(d->f, x); popCatch(); dec(x); return r; }
B catch_c2(Md2D* d, B w, B x) { if(CATCH) { dec(catchMessage); return c2(d->g, w,x); } inc(w); inc(x); B r = c2(d->f, w,x); popCatch(); dec(w); dec(x); return r; }
#else
B fillBy_c1(Md2D* d, B x) { return c1(d->f, x); }
B fillBy_c2(Md2D* d, B w, B x) { return c2(d->f, w,x); }
B catch_c1(Md2D* d, B x) { return c1(d->f, x); }
B catch_c2(Md2D* d, B w, B x) { return c2(d->f, w,x); }
#endif
extern B rt_undo;
void repeat_bounds(i64* bound, B g) { // doesn't consume
if (isArr(g)) {
SGetU(g)
usz ia = a(g)->ia;
for (usz i = 0; i < ia; i++) repeat_bounds(bound, GetU(g, i));
} else if (isNum(g)) {
i64 i = o2i64(g);
if (i<bound[0]) bound[0] = i;
if (i>bound[1]) bound[1] = i;
} else thrM("⍟: 𝔾 contained a non-number atom");
}
B repeat_replace(B g, B* q) { // doesn't consume
if (isArr(g)) {
SGetU(g)
usz ia = a(g)->ia;
M_HARR(r, ia);
for (usz i = 0; i < ia; i++) HARR_ADD(r, i, repeat_replace(GetU(g,i), q));
return HARR_FC(r, g);
} else {
return inc(q[o2i64u(g)]);
}
}
#define REPEAT_T(CN, END, ...) \
B g = CN(d->g, __VA_ARGS__ inc(x)); \
B f = d->f; \
if (isNum(g)) { \
i64 am = o2i64(g); \
if (am>=0) { \
for (i64 i = 0; i < am; i++) x = CN(f, __VA_ARGS__ x); \
END; \
return x; \
} \
} \
i64 bound[2] = {0,0}; \
repeat_bounds(bound, g); \
i64 min=(u64)-bound[0]; i64 max=(u64)bound[1]; \
TALLOC(B, all, min+max+1); \
B* q = all+min; \
q[0] = inc(x); \
if (min) { \
B x2 = inc(x); \
B fi = m1_d(incG(rt_undo), inc(f)); \
for (i64 i = 0; i < min; i++) q[-1-i] = inc(x2 = CN(fi, __VA_ARGS__ x2)); \
dec(x2); \
dec(fi); \
} \
for (i64 i = 0; i < max; i++) q[i+1] = inc(x = CN(f, __VA_ARGS__ x)); \
dec(x); \
B r = repeat_replace(g, q); \
dec(g); \
for (i64 i = 0; i < min+max+1; i++) dec(all[i]); \
END; TFREE(all); \
return r;
B repeat_c1(Md2D* d, B x) { REPEAT_T(c1,{} ); }
B repeat_c2(Md2D* d, B w, B x) { REPEAT_T(c2,dec(w), inc(w), ); }
#undef REPEAT_T
B before_c1(Md2D* d, B x) { return c2(d->g, c1iX(d->f, x), x); }
B before_c2(Md2D* d, B w, B x) { return c2(d->g, c1i (d->f, w), x); }
B after_c1(Md2D* d, B x) { return c2(d->f, x, c1iX(d->g, x)); }
B after_c2(Md2D* d, B w, B x) { return c2(d->f, w, c1i (d->g, x)); }
B atop_c1(Md2D* d, B x) { return c1(d->f, c1(d->g, x)); }
B atop_c2(Md2D* d, B w, B x) { return c1(d->f, c2(d->g, w, x)); }
B over_c1(Md2D* d, B x) { return c1(d->f, c1(d->g, x)); }
B over_c2(Md2D* d, B w, B x) { B xr=c1(d->g, x); return c2(d->f, c1(d->g, w), xr); }
B pick_c2(B t, B w, B x);
B cond_c1(Md2D* d, B x) { B f=d->f; B g=d->g;
B fr = c1iX(f, x);
if (isNum(fr)) {
if (isAtm(g)||rnk(g)!=1) thrM("◶: 𝕘 must have rank 1");
usz fri = WRAP(o2i64(fr), a(g)->ia, thrM("◶: 𝔽 out of bounds of 𝕘"));
return c1(IGetU(g, fri), x);
} else {
B fn = pick_c2(m_f64(0), fr, inc(g));
B r = c1(fn, x);
dec(fn);
return r;
}
}
B cond_c2(Md2D* d, B w, B x) { B g=d->g;
B fr = c2iWX(d->f, w, x);
if (isNum(fr)) {
if (isAtm(g)||rnk(g)!=1) thrM("◶: 𝕘 must have rank 1");
usz fri = WRAP(o2i64(fr), a(g)->ia, thrM("◶: 𝔽 out of bounds of 𝕘"));
return c2(IGetU(g, fri), w, x);
} else {
B fn = pick_c2(m_f64(0), fr, inc(g));
B r = c2(fn, w, x);
dec(fn);
return r;
}
}
extern B rt_under, bi_before;
B under_c1(Md2D* d, B x) { B f=d->f; B g=d->g;
if (!isVal(g)) { // ugh idk
B fn = m2_d(incG(rt_under), inc(f), inc(g));
B r = c1(fn, x);
dec(fn);
return r;
}
return TI(g,fn_uc1)(g, f, x);
}
B under_c2(Md2D* d, B w, B x) { B f=d->f; B g=d->g;
if (!isVal(g)) {
B fn = m2_d(incG(rt_under), inc(f), inc(g));
B r = c2(fn, w, x);
dec(fn);
return r;
}
B f2 = m2_d(incG(bi_before), c1(g, w), inc(f));
B r = TI(g,fn_uc1)(g, f2, x);
dec(f2);
return r;
}
B before_uc1(Md2* t, B o, B f, B g, B x) {
if (!isFun(g)) return def_m2_uc1(t, o, f, g, x);
return TI(g,fn_ucw)(g, o, inc(f), x);
}
B while_c1(Md2D* d, B x) { B f=d->f; B g=d->g;
while (o2b(c1(g,inc(x)))) x = c1(f, x);
return x;
}
B while_c2(Md2D* d, B w, B x) { B f=d->f; B g=d->g;
while (o2b(c2(g,inc(w),inc(x)))) x = c2(f, inc(w), x);
dec(w);
return x;
}
static B m2c1(B t, B f, B g, B x) { // consumes x
B fn = m2_d(inc(t), inc(f), inc(g));
B r = c1(fn, x);
dec(fn);
return r;
}
static B m2c2(B t, B f, B g, B w, B x) { // consumes w,x
B fn = m2_d(inc(t), inc(f), inc(g));
B r = c2(fn, w, x);
dec(fn);
return r;
}
B rank_c1(Md2D* d, B x) { B f = d->f; B g = d->g;
f64 kf;
bool gf = isFun(g);
if (RARE(gf)) g = c1(g, inc(x));
if (LIKELY(isNum(g))) {
kf = o2fu(g);
} else if (isArr(g)) {
usz gia = a(g)->ia;
if (!(gia>=1 && gia<=3)) thrM("⎉: 𝔾 result must have 1 to 3 elements");
SGetU(g)
if (!elNum(TI(g,elType))) for (i32 i = 0; i < gia; i++) o2f(GetU(g,i));
kf = GetU(g, gia==2).f;
} else thrM("⎉: Invalid 𝔾 result");
if (gf) dec(g);
i32 k = kf;
if (isAtm(x) || rnk(x)==0) {
if (floor(kf)!=kf) thrM("⎉: 𝕘 was a fractional number");
B r = c1(f, x);
return isAtm(r)? m_atomUnit(r) : r;
}
i32 xr = rnk(x);
usz* xsh = a(x)->sh;
if (k!=kf) {
if (floor(kf)!=kf) thrM("⎉: 𝕘 was a fractional number");
k = kf>0? 0 : xr;
} else {
k = k<0? (k+xr<0? xr : xr-(k+xr)) : (k>xr? 0 : xr-k);
}
if (Q_BI(f,lt) && a(x)->ia!=0 && rnk(x)>1) return toKCells(x, k);
usz cam = 1; for (usz i = 0; i < k; i++) cam*= xsh[i];
usz csz = 1; for (usz i = k; i < xr; i++) csz*= xsh[i];
ur cr = xr-k;
ShArr* csh;
if (cr>1) {
csh = m_shArr(cr);
memcpy(csh->a, xsh+k, cr*sizeof(usz));
}
BSS2A slice = TI(x,slice);
M_HARR(r, cam);
usz p = 0;
for (usz i = 0; i < cam; i++) {
Arr* s = slice(inc(x), p, csz); arr_shSetI(s, cr, csh);
HARR_ADD(r, i, c1(f, taga(s)));
p+= csz;
}
if (cr>1) ptr_dec(csh);
usz* rsh = HARR_FA(r, k);
if (k>1) memcpy(rsh, xsh, k*sizeof(usz));
dec(x);
return bqn_merge(HARR_O(r).b);
}
extern B rt_rank;
B rank_c2(Md2D* d, B w, B x) { B f = d->f; B g = d->g; // TODO
return m2c2(rt_rank, f, g, w, x);
}
extern B rt_depth;
B depth_c1(Md2D* d, B x) { return m2c1(rt_depth, d->f, d->g, x); }
B depth_c2(Md2D* d, B w, B x) { return m2c2(rt_depth, d->f, d->g, w, x); }
static void print_md2BI(B x) { printf("%s", pm2_repr(c(Md1,x)->extra)); }
void md2_init() {
TIi(t_md2BI,print) = print_md2BI;
TIi(t_md2BI,m2_uc1) = md2BI_uc1;
TIi(t_md2BI,m2_ucw) = md2BI_ucw;
c(BMd2,bi_before)->uc1 = before_uc1;
}