uCBQN/src/builtins/md2.c
dzaima 54cec2fdf5 split up CATCH_ERRORS into functional and semantic options
allows running a non-heapverify build that functions exactly as a heapverify one, while allowing ⎊ to function
2024-04-04 02:52:08 +03:00

264 lines
9.3 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/talloc.h"
#include "../utils/calls.h"
#include "../nfns.h"
#include "../builtins.h"
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 SEMANTIC_CATCH
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) { freeThrown(); 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) { freeThrown(); return r; }
if (noFill(wf)) wf = incG(bi_asrt);
B fill = asFill(c2(d->g, wf, xf));
popCatch();
return withFill(r, fill);
}
#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); }
#endif
#if defined(SEMANTIC_CATCH_BI)? SEMANTIC_CATCH_BI : SEMANTIC_CATCH
extern GLOBAL B lastErrMsg; // sysfn.c
typedef struct ReObj {
struct CustomObj;
B msg;
} ReObj;
void re_visit(Value* v) { mm_visit(((ReObj*)v)->msg); }
void re_freeO(Value* v) { dec(lastErrMsg); lastErrMsg = ((ReObj*)v)->msg; }
void pushRe(void) {
ReObj* o = m_customObj(sizeof(ReObj), re_visit, re_freeO);
o->msg = lastErrMsg;
gsAdd(tag(o,OBJ_TAG));
lastErrMsg = inc(thrownMsg);
freeThrown();
}
B catch_c1(Md2D* d, B x) { if(CATCH) { pushRe(); B r = c1(d->g, x); dec(gsPop()); return r; } B r = c1(d->f, inc(x)); popCatch(); dec(x); return r; }
B catch_c2(Md2D* d, B w, B x) { if(CATCH) { pushRe(); B r = c2(d->g, w,x); dec(gsPop()); return r; } B r = c2(d->f, inc(w),inc(x)); popCatch(); dec(w); dec(x); return r; }
#else
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 GLOBAL B rt_undo;
void repeat_bounds(i64* bound, B g) { // doesn't consume
#define UPD_BOUNDS(B,I) ({ i64 i_ = (I); if (i_<bound[0]) bound[0] = i_; if (i_>bound[1]) bound[1] = i_; })
if (isArr(g)) {
usz ia = IA(g);
if (ia == 0) return;
u8 ge = TI(g,elType);
if (elNum(ge)) {
i64 bres[2];
if (!getRange_fns[ge](tyany_ptr(g), bres, ia)) thrM("⍟: 𝔾 contained non-integer (or integer was out of range)");
if (bres[0]<bound[0]) bound[0] = bres[0];
if (bres[1]>bound[1]) bound[1] = bres[1];
} else {
SGetU(g)
for (usz i = 0; i < ia; i++) repeat_bounds(bound, GetU(g, i));
}
} else if (isNum(g)) {
if (!q_i64(g)) thrM("⍟: 𝔾 contained non-integer (or integer was out of range)");
i64 c = o2i64G(g);
if (c<bound[0]) bound[0] = c;
if (c>bound[1]) bound[1] = c;
} else thrM("⍟: 𝔾 contained non-number");
}
B repeat_replaceR(B g, B* q);
FORCE_INLINE B repeat_replace(B g, B* q) { // doesn't consume
if (isArr(g)) return repeat_replaceR(g, q);
else return inc(q[o2i64G(g)]);
}
NOINLINE B repeat_replaceR(B g, B* q) {
SGetU(g)
usz ia = IA(g);
M_HARR(r, ia);
for (usz i = 0; i < ia; i++) HARR_ADD(r, i, repeat_replace(GetU(g,i), q));
return any_squeeze(HARR_FC(r, 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(bi_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
NOINLINE B before_c1F(Md2D* d, B x, B f) { errMd(f); return c2(d->g, c1G(f,inc(x)), x); }
NOINLINE B after_c1F (Md2D* d, B x, B g) { errMd(g); return c2(d->f, x, c1G(g,inc(x))); }
B before_c1(Md2D* d, B x) { B f=d->f; return isCallable(f)? before_c1F(d, x, f) : c2(d->g, inc(f), x); }
B after_c1 (Md2D* d, B x) { B g=d->g; return isCallable(g)? after_c1F (d, x, g) : c2(d->f, x, inc(g)); }
B before_c2(Md2D* d, B w, B x) { return c2(d->g, c1I(d->f, w), 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 when index is a number");
usz fri = WRAP(o2i64(fr), IA(g), thrM("◶: Index out of bounds of 𝕘"));
return c1(IGetU(g, fri), x);
} else {
B fn = C2(pick, 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 when index is a number");
usz fri = WRAP(o2i64(fr), IA(g), thrM("◶: Index out of bounds of 𝕘"));
return c2(IGetU(g, fri), w, x);
} else {
B fn = C2(pick, fr, inc(g));
B r = c2(fn, w, x);
dec(fn);
return r;
}
}
B under_c1(Md2D* d, B x) { B f=d->f; B g=d->g;
return (LIKELY(isVal(g))? TI(g,fn_uc1) : def_fn_uc1)(g, f, x);
}
B under_c2(Md2D* d, B w, B x) { B f=d->f; B g=d->g;
B f2 = m2_d(incG(bi_before), c1(g, w), inc(f));
B r = (LIKELY(isVal(g))? TI(g,fn_uc1) : def_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 before_im(Md2D* d, B x) { return isFun(d->g) && !isCallable(d->f)? TI(d->g,fn_ix)(d->g, inc(d->f), x) : def_m2_im(d, x); }
B after_im (Md2D* d, B x) { return isFun(d->f) && !isCallable(d->g)? TI(d->f,fn_iw)(d->f, inc(d->g), x) : def_m2_im(d, x); }
B while_c1(Md2D* d, B x) { B f=d->f; B g=d->g;
FC1 ff = c1fn(f);
FC1 gf = c1fn(g);
while (o2b(gf(g,inc(x)))) x = ff(f, x);
return x;
}
B while_c2(Md2D* d, B w, B x) { B f=d->f; B g=d->g;
FC2 ff = c2fn(f);
FC2 gf = c2fn(g);
while (o2b(gf(g,inc(w),inc(x)))) x = ff(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);
decG(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);
decG(fn);
return r;
}
// TODO fills on EACH_FILLS
B depthf_c1(B t, B x) {
if (isArr(x)) return eachm_fn(t, x, depthf_c1);
else return c1(t, x);
}
B depthf_c2(B t, B w, B x) {
if (isArr(w) || isArr(x)) return eachd_fn(t, w, x, depthf_c2);
else return c2(t, w, x);
}
extern GLOBAL B rt_depth;
B depth_c1(Md2D* d, B x) {
if (isF64(d->g) && o2fG(d->g)==0) {
if (isArr(x)) return eachm_fn(d->f, x, depthf_c1);
else return c1(d->f, x);
}
SLOW3("!F⚇𝕨 𝕩", d->g, x, d->f);
return m2c1(rt_depth, d->f, d->g, x);
}
B depth_c2(Md2D* d, B w, B x) {
if (isF64(d->g) && o2fG(d->g)==0) {
if (isArr(w) || isArr(x)) return eachd_fn(d->f, w, x, depthf_c2);
else return c2(d->f, w, x);
}
SLOW3("!𝕨 𝔽⚇f 𝕩", w, x, d->g);
return m2c2(rt_depth, d->f, d->g, w, x);
}
static void print_md2BI(FILE* f, B x) { fprintf(f, "%s", pm2_repr(c(Md1,x)->extra)); }
static B md2BI_im(Md2D* d, B x) { return ((BMd2*)d->m2)->im(d, x); }
static B md2BI_iw(Md2D* d, B w, B x) { return ((BMd2*)d->m2)->iw(d, w, x); }
static B md2BI_ix(Md2D* d, B w, B x) { return ((BMd2*)d->m2)->ix(d, w, x); }
static B md2BI_uc1(Md2* t, B o, B f, B g, B x) { return ((BMd2*)t)->uc1(t, o, f, g, x); }
static 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); }
void md2_init(void) {
TIi(t_md2BI,print) = print_md2BI;
TIi(t_md2BI,m2_im) = md2BI_im;
TIi(t_md2BI,m2_iw) = md2BI_iw;
TIi(t_md2BI,m2_ix) = md2BI_ix;
TIi(t_md2BI,m2_uc1) = md2BI_uc1;
TIi(t_md2BI,m2_ucw) = md2BI_ucw;
c(BMd2,bi_before)->uc1 = before_uc1;
c(BMd2,bi_after)->im = after_im;
c(BMd2,bi_before)->im = before_im;
}