901 lines
28 KiB
C
901 lines
28 KiB
C
#include <stdarg.h>
|
||
#include "../core.h"
|
||
#include "../utils/mut.h"
|
||
#include "../utils/utf.h"
|
||
#include "../utils/talloc.h"
|
||
#include "../builtins.h"
|
||
|
||
bool please_tail_call_err = true;
|
||
|
||
bool inErr;
|
||
NORETURN NOINLINE void err(char* s) {
|
||
if (inErr) {
|
||
fputs("\nCBQN encountered fatal error during information printing of another fatal error. Exiting without printing more info.", stderr);
|
||
#ifdef DEBUG
|
||
__builtin_trap();
|
||
#endif
|
||
exit(1);
|
||
}
|
||
inErr = true;
|
||
fputs(s, stderr); fputc('\n', stderr); fflush(stderr);
|
||
vm_pstLive(); fflush(stderr); fflush(stdout);
|
||
print_vmStack(); fflush(stderr);
|
||
fputs("CBQN interpreter entered unexpected state, exiting.\n", stderr);
|
||
#ifdef DEBUG
|
||
__builtin_trap();
|
||
#endif
|
||
exit(1);
|
||
}
|
||
|
||
NOINLINE B c1_rare(B f, B x) { dec(x);
|
||
if (isMd(f)) thrM("Calling a modifier");
|
||
return inc(VALIDATE(f));
|
||
}
|
||
NOINLINE B c2_rare(B f, B w, B x) { dec(w); dec(x);
|
||
if (isMd(f)) thrM("Calling a modifier");
|
||
return inc(VALIDATE(f));
|
||
}
|
||
NOINLINE void value_freeR(Value* x) { value_free(x); }
|
||
NOINLINE void decA_rare(B x) { dec(x); }
|
||
void noop_visit(Value* x) { }
|
||
NOINLINE B c1_bad(B f, B x) { thrM("This function can't be called monadically"); }
|
||
NOINLINE B c2_bad(B f, B w, B x) { thrM("This function can't be called dyadically"); }
|
||
NOINLINE B m1c1_bad(Md1D* d, B x) { thrM("This 1-modifier can't be called monadically"); }
|
||
NOINLINE B m1c2_bad(Md1D* d, B w, B x) { thrM("This 1-modifier can't be called dyadically"); }
|
||
NOINLINE B m2c1_bad(Md2D* d, B x) { thrM("This 2-modifier can't be called monadically"); }
|
||
NOINLINE B m2c2_bad(Md2D* d, B w, B x) { thrM("This 2-modifier can't be called dyadically"); }
|
||
|
||
NOINLINE B md_c1(B t, B x) { thrM("Cannot call a modifier"); }
|
||
NOINLINE B md_c2(B t, B w, B x) { thrM("Cannot call a modifier"); }
|
||
NOINLINE B arr_c1(B t, B x) { return inc(t); }
|
||
NOINLINE B arr_c2(B t, B w, B x) { return inc(t); }
|
||
|
||
|
||
extern B rt_under, bi_before;
|
||
static B rtUnder_c1(B f, B g, B x) { // consumes x
|
||
B fn = m2_d(inc(rt_under), inc(f), inc(g));
|
||
B r = c1(fn, x);
|
||
decG(fn);
|
||
return r;
|
||
}
|
||
static B rtUnder_cw(B f, B g, B w, B x) { // consumes w,x
|
||
B fn = m2_d(inc(rt_under), inc(f), m2_d(inc(bi_before), w, inc(g)));
|
||
B r = c1(fn, x);
|
||
decG(fn);
|
||
return r;
|
||
}
|
||
B def_fn_uc1(B t, B o, B x) { return rtUnder_c1(o, t, x); }
|
||
B def_fn_ucw(B t, B o, B w, B x) { return rtUnder_cw(o, t, w, x); }
|
||
B def_m1_uc1(Md1* t, B o, B f, B x) { B t2 = m1_d(tag(ptr_inc(t),MD1_TAG),inc(f) ); B r = rtUnder_c1(o, t2, x); decG(t2); return r; }
|
||
B def_m1_ucw(Md1* t, B o, B f, B w, B x) { B t2 = m1_d(tag(ptr_inc(t),MD1_TAG),inc(f) ); B r = rtUnder_cw(o, t2, w, x); decG(t2); return r; }
|
||
B def_m2_uc1(Md2* t, B o, B f, B g, B x) { B t2 = m2_d(tag(ptr_inc(t),MD2_TAG),inc(f),inc(g)); B r = rtUnder_c1(o, t2, x); decG(t2); return r; }
|
||
B def_m2_ucw(Md2* t, B o, B f, B g, B w, B x) { B t2 = m2_d(tag(ptr_inc(t),MD2_TAG),inc(f),inc(g)); B r = rtUnder_cw(o, t2, w, x); decG(t2); return r; }
|
||
B def_decompose(B x) {
|
||
return m_hVec2(m_i32(isCallable(x)? (isImpureBuiltin(x)? 1 : 0) : -1),x);
|
||
}
|
||
|
||
B bi_emptyHVec, bi_emptyIVec, bi_emptyCVec, bi_emptySVec;
|
||
|
||
NOINLINE TStack* ts_e(TStack* o, u32 elsz, u64 am) { u64 size = o->size;
|
||
u64 alsz = mm_round(fsizeof(TStack, data, u8, (size+am)*elsz));
|
||
TStack* n;
|
||
if (alsz==mm_size((Value*)o)) {
|
||
n = o;
|
||
} else {
|
||
n = (TStack*)mm_alloc(alsz, t_temp);
|
||
memcpy(n->data, o->data, o->cap*elsz);
|
||
mm_free((Value*)o);
|
||
n->size = size;
|
||
}
|
||
n->cap = (mm_size((Value*)n)-offsetof(TStack,data))/elsz;
|
||
return n;
|
||
}
|
||
|
||
void fprint(FILE* f, B x);
|
||
void farr_print(FILE* f, B x) { // should accept refc=0 arguments for debugging purposes
|
||
ur r = rnk(x);
|
||
SGetU(x)
|
||
usz ia = a(x)->ia;
|
||
if (r!=1) {
|
||
if (r==0) {
|
||
fprintf(f, "<");
|
||
fprint(f, GetU(x,0));
|
||
return;
|
||
}
|
||
usz* sh = a(x)->sh;
|
||
for (i32 i = 0; i < r; i++) {
|
||
if(i==0)fprintf(f, N64d,(u64)sh[i]);
|
||
else fprintf(f, "‿"N64d,(u64)sh[i]);
|
||
}
|
||
fprintf(f, "⥊");
|
||
} else if (ia>0) {
|
||
for (usz i = 0; i < ia; i++) {
|
||
B c = GetU(x,i);
|
||
if (!isC32(c) || (u32)c.u=='\n') goto reg;
|
||
}
|
||
fprintf(f, "\"");
|
||
for (usz i = 0; i < ia; i++) fprintUTF8(f, (u32)GetU(x,i).u); // c32, no need to decrement
|
||
fprintf(f, "\"");
|
||
return;
|
||
}
|
||
reg:;
|
||
fprintf(f, "⟨");
|
||
for (usz i = 0; i < ia; i++) {
|
||
if (i!=0) fprintf(f, ", ");
|
||
fprint(f, GetU(x,i));
|
||
}
|
||
fprintf(f, "⟩");
|
||
}
|
||
|
||
void fprint(FILE* f, B x) {
|
||
if (isF64(x)) {
|
||
NUM_FMT_BUF(buf, x.f);
|
||
fprintf(f, "%s", buf);
|
||
} else if (isC32(x)) {
|
||
if ((u32)x.u>=32) { fprintf(f, "'"); fprintUTF8(f, (u32)x.u); fprintf(f, "'"); }
|
||
else if((u32)x.u>15) fprintf(f, "\\x%x", (u32)x.u);
|
||
else fprintf(f, "\\x0%x", (u32)x.u);
|
||
} else if (isVal(x)) {
|
||
#ifdef DEBUG
|
||
if (isVal(x) && (v(x)->type==t_freed || v(x)->type==t_empty)) {
|
||
u8 t = v(x)->type;
|
||
v(x)->type = v(x)->flags;
|
||
fprintf(f, t==t_freed?"FREED:":"EMPTY:");
|
||
TI(x,print)(f, x);
|
||
v(x)->type = t;
|
||
return;
|
||
}
|
||
#endif
|
||
TI(x,print)(f, x);
|
||
}
|
||
else if (isVar(x)) fprintf(f, "(var d=%d i=%d)", (u16)(x.u>>32), (i32)x.u);
|
||
else if (isExt(x)) fprintf(f, "(extvar d=%d i=%d)", (u16)(x.u>>32), (i32)x.u);
|
||
else if (x.u==bi_N.u) fprintf(f, "·");
|
||
else if (x.u==bi_optOut.u) fprintf(f, "(value optimized out)");
|
||
else if (x.u==bi_noVar.u) fprintf(f, "(unset variable placeholder)");
|
||
else if (x.u==bi_okHdr.u) fprintf(f, "(accepted SETH placeholder)");
|
||
else if (x.u==bi_noFill.u) fprintf(f, "(no fill placeholder)");
|
||
else fprintf(f, "(todo tag "N64x")", x.u>>48);
|
||
}
|
||
|
||
NOINLINE void fprintRaw(FILE* f, B x) {
|
||
if (isAtm(x)) {
|
||
if (isF64(x)) { NUM_FMT_BUF(buf, x.f); fprintf(f, "%s", buf); }
|
||
else if (isC32(x)) fprintUTF8(f, (u32)x.u);
|
||
else thrM("•Out: Unexpected argument type");
|
||
} else {
|
||
usz ia = a(x)->ia;
|
||
SGetU(x)
|
||
for (usz i = 0; i < ia; i++) {
|
||
B c = GetU(x,i);
|
||
#if !CATCH_ERRORS
|
||
if (c.u==0 || noFill(c)) { fprintf(f, " "); continue; }
|
||
#endif
|
||
if (!isC32(c)) thrM("•Out: Unexpected element in argument");
|
||
fprintUTF8(f, (u32)c.u);
|
||
}
|
||
}
|
||
}
|
||
|
||
NOINLINE void printRaw(B x) {
|
||
fprintRaw(stdout, x);
|
||
}
|
||
NOINLINE void arr_print(B x) {
|
||
farr_print(stdout, x);
|
||
}
|
||
NOINLINE void print(B x) {
|
||
fprint(stdout, x);
|
||
}
|
||
|
||
i32 num_fmt(char buf[30], f64 x) {
|
||
// for (int i = 0; i < 30; i++) buf[i] = 'a';
|
||
snprintf(buf, 30, "%.16g", x); // should be %.17g to (probably?) never lose precision, but that also makes things ugly
|
||
i32 len = strlen(buf);
|
||
i32 neg = buf[0]=='-'?1:0;
|
||
if (buf[neg] == 'i') {
|
||
i32 o = neg*2;
|
||
if (neg) { buf[0] = 0xC2; buf[1] = 0xAF; }
|
||
buf[o] = 0xE2; buf[o+1] = 0x88; buf[o+2] = 0x9E; buf[o+3] = 0; len = o+3;
|
||
} else if (buf[neg] == 'n') {
|
||
buf[0] = 'N'; buf[1] = 'a'; buf[2] = 'N'; buf[3] = 0; len = 3;
|
||
} else {
|
||
if (buf[0] == '-') {
|
||
memmove(buf+2, buf+1, len);
|
||
buf[0] = 0xC2; buf[1] = 0xAF; // "¯""
|
||
len+= 1;
|
||
}
|
||
for (i32 i = 0; i < len; i++) {
|
||
if (buf[i] == 'e') {
|
||
if (buf[i+1] == '+') {
|
||
memcpy(buf+i+1, buf+i+2, len-i-1);
|
||
len-= 1;
|
||
break;
|
||
} else if (buf[i+1] == '-') {
|
||
memcpy(buf+i+3, buf+i+2, len-i-1);
|
||
buf[i+1] = 0xC2; buf[i+2] = 0xAF;
|
||
}
|
||
}
|
||
}
|
||
}
|
||
return len;
|
||
}
|
||
|
||
static B appendRaw(B s, B x) { assert(isArr(x) && rnk(x)==1); // consumes x
|
||
if (TI(x,elType)==el_c32) AJOIN(x);
|
||
else {
|
||
B sq = chr_squeezeChk(x);
|
||
if (!elChr(TI(sq,elType))) FL_KEEP(sq, ~fl_squoze);
|
||
AJOIN(sq);
|
||
}
|
||
return s;
|
||
}
|
||
NOINLINE B do_fmt(B s, char* p, va_list a) {
|
||
char buf[30];
|
||
char c;
|
||
char* lp = p;
|
||
while (*p != 0) { c = *p++;
|
||
if (c!='%') continue;
|
||
if (lp!=p-1) AJOIN(fromUTF8(lp, p-1-lp));
|
||
switch(c = *p++) { default: printf("Unknown format character '%c'", c); err(""); UD;
|
||
case 'R': {
|
||
B b = va_arg(a, B);
|
||
if (isNum(b)) AFMT("%f", o2f(b));
|
||
else s = appendRaw(s, inc(b));
|
||
break;
|
||
}
|
||
case 'B': {
|
||
B b = va_arg(a, B);
|
||
s = appendRaw(s, bqn_repr(inc(b)));
|
||
break;
|
||
}
|
||
case 'H': {
|
||
B o = va_arg(a, B);
|
||
ur r = isArr(o)? rnk(o) : 0;
|
||
usz* sh = isArr(o)? a(o)->sh : NULL;
|
||
if (r==0) AU("⟨⟩");
|
||
else if (r==1) AFMT("⟨%s⟩", sh[0]);
|
||
else {
|
||
for (i32 i = 0; i < r; i++) {
|
||
if(i) AU("‿");
|
||
AFMT("%s", sh[i]);
|
||
}
|
||
}
|
||
break;
|
||
}
|
||
case 'S': {
|
||
A8(va_arg(a, char*));
|
||
break;
|
||
}
|
||
case 'U': {
|
||
AU(va_arg(a, char*));
|
||
break;
|
||
}
|
||
case 'u': case 'x': case 'i': case 'l': {
|
||
i32 mode = c=='u'? 1 : c=='x'? 2 : 0;
|
||
if (mode) c = *p++;
|
||
assert(c);
|
||
if (mode) {
|
||
assert(c=='l'||c=='i');
|
||
if (c=='i') snprintf(buf, 30, mode==1? "%u" : "%x", va_arg(a, u32));
|
||
else snprintf(buf, 30, mode==1? N64u : N64x, va_arg(a, u64));
|
||
} else {
|
||
if (c=='i') {
|
||
i32 v = va_arg(a, i32);
|
||
if (v<0) AU("¯");
|
||
snprintf(buf, 30, N64u, (u64)(v<0?-v:v));
|
||
} else { assert(c=='l');
|
||
i64 v = va_arg(a, i64);
|
||
if (v<0) AU("¯");
|
||
if (v==I64_MIN) snprintf(buf, 30, "9223372036854775808");
|
||
else snprintf(buf, 30, N64u, (u64)(v<0?-v:v));
|
||
}
|
||
}
|
||
A8(buf);
|
||
break;
|
||
}
|
||
case 's': {
|
||
usz v = va_arg(a, usz);
|
||
snprintf(buf, 30, sizeof(usz)==4? "%u" : N64u, v);
|
||
A8(buf);
|
||
break;
|
||
}
|
||
case 'p': {
|
||
snprintf(buf, 30, "%p", va_arg(a, void*));
|
||
A8(buf);
|
||
break;
|
||
}
|
||
case 'f': {
|
||
NUM_FMT_BUF(buf, va_arg(a, f64));
|
||
AU(buf);
|
||
break;
|
||
}
|
||
case 'c': {
|
||
buf[0] = va_arg(a, int); buf[1] = 0;
|
||
A8(buf);
|
||
break;
|
||
}
|
||
case '%': {
|
||
buf[0] = '%'; buf[1] = 0;
|
||
A8(buf);
|
||
break;
|
||
}
|
||
}
|
||
lp = p;
|
||
}
|
||
if (lp!=p) AJOIN(fromUTF8(lp, p-lp));
|
||
return s;
|
||
}
|
||
NOINLINE B append_fmt(B s, char* p, ...) {
|
||
va_list a;
|
||
va_start(a, p);
|
||
B r = do_fmt(s, p, a);
|
||
va_end(a);
|
||
return r;
|
||
}
|
||
NOINLINE B make_fmt(char* p, ...) {
|
||
va_list a;
|
||
va_start(a, p);
|
||
B r = do_fmt(emptyCVec(), p, a);
|
||
va_end(a);
|
||
return r;
|
||
}
|
||
NOINLINE void print_fmt(char* p, ...) {
|
||
va_list a;
|
||
va_start(a, p);
|
||
B r = do_fmt(emptyCVec(), p, a);
|
||
va_end(a);
|
||
printRaw(r);
|
||
decG(r);
|
||
}
|
||
NOINLINE void thrF(char* p, ...) {
|
||
va_list a;
|
||
va_start(a, p);
|
||
B r = do_fmt(emptyCVec(), p, a);
|
||
va_end(a);
|
||
thr(r);
|
||
}
|
||
|
||
|
||
#define CMP(W,X) ({ AUTO wt = (W); AUTO xt = (X); (wt>xt?1:0)-(wt<xt?1:0); })
|
||
NOINLINE i32 compareR(B w, B x) {
|
||
if (isNum(w) & isC32(x)) return -1;
|
||
if (isC32(w) & isNum(x)) return 1;
|
||
if (isAtm(w) & isAtm(x)) thrM("Invalid comparison");
|
||
bool wa=isAtm(w); usz wia; ur wr; usz* wsh; AS2B wgetU; Arr* wArr;
|
||
bool xa=isAtm(x); usz xia; ur xr; usz* xsh; AS2B xgetU; Arr* xArr;
|
||
if(wa) { wia=1; wr=0; wsh=NULL; } else { wia=a(w)->ia; wr=rnk(w); wsh=a(w)->sh; wgetU=TI(w,getU); wArr = a(w); }
|
||
if(xa) { xia=1; xr=0; xsh=NULL; } else { xia=a(x)->ia; xr=rnk(x); xsh=a(x)->sh; xgetU=TI(x,getU); xArr = a(x); }
|
||
if (wia==0 || xia==0) return CMP(wia, xia);
|
||
|
||
i32 rc = CMP(wr+(wa?0:1), xr+(xa?0:1));
|
||
ur rr = wr<xr? wr : xr;
|
||
i32 ri = 0; // matching shape tail
|
||
i32 rm = 1;
|
||
while (ri<rr && wsh[wr-1-ri] == xsh[xr-1-ri]) {
|
||
rm*= wsh[wr-ri-1];
|
||
ri++;
|
||
}
|
||
if (ri<rr) {
|
||
usz wm = wsh[wr-1-ri];
|
||
usz xm = xsh[xr-1-ri];
|
||
rc = CMP(wm, xm);
|
||
rm*= wm<xm? wm : xm;
|
||
}
|
||
for (u64 i = 0; i < (u64)rm; i++) {
|
||
int c = compare(wa? w : wgetU(wArr,i), xa? x : xgetU(xArr,i));
|
||
if (c!=0) return c;
|
||
}
|
||
return rc;
|
||
}
|
||
#undef CMP
|
||
|
||
NOINLINE bool atomEqualR(B w, B x) {
|
||
if (v(w)->type!=v(x)->type) return false;
|
||
B2B dcf = TI(w,decompose);
|
||
if (dcf == def_decompose) return false;
|
||
B wd=dcf(inc(w)); B* wdp = harr_ptr(wd);
|
||
B xd=dcf(inc(x)); B* xdp = harr_ptr(xd);
|
||
if (o2i(wdp[0])<=1) { decG(wd);decG(xd); return false; }
|
||
usz wia = a(wd)->ia;
|
||
if (wia!=a(xd)->ia) { decG(wd);decG(xd); return false; }
|
||
for (u64 i = 0; i<wia; i++) if(!equal(wdp[i], xdp[i]))
|
||
{ decG(wd);decG(xd); return false; }
|
||
decG(wd);decG(xd); return true;
|
||
}
|
||
|
||
#if SINGELI
|
||
#pragma GCC diagnostic push
|
||
#pragma GCC diagnostic ignored "-Wunused-variable"
|
||
#include "../singeli/gen/equal.c"
|
||
#pragma GCC diagnostic pop
|
||
|
||
typedef bool (*EqFn)(u8* a, u8* b, u64 l, u64 data);
|
||
bool notEq(u8* a, u8* b, u64 l, u64 data) { return false; }
|
||
|
||
#define F(X) avx2_equal_##X
|
||
EqFn eqFns[] = {
|
||
F(1_1), F(1_8), F(1_16), F(1_32), F(1_f64), notEq, notEq, notEq,
|
||
F(1_8), F(8_8), F(s8_16), F(s8_32), F(s8_f64), notEq, notEq, notEq,
|
||
F(1_16), F(s8_16), F(8_8), F(s16_32), F(s16_f64), notEq, notEq, notEq,
|
||
F(1_32), F(s8_32), F(s16_32), F(8_8), F(s32_f64), notEq, notEq, notEq,
|
||
F(1_f64), F(s8_f64), F(s16_f64), F(s32_f64), F(f64_f64), notEq, notEq, notEq,
|
||
notEq, notEq, notEq, notEq, notEq, F(8_8), F(u8_16), F(u8_32),
|
||
notEq, notEq, notEq, notEq, notEq, F(u8_16), F(8_8), F(u16_32),
|
||
notEq, notEq, notEq, notEq, notEq, F(u8_32), F(u16_32), F(8_8),
|
||
};
|
||
#undef F
|
||
static const u8 n = 99;
|
||
u8 eqFnData[] = { // for the main diagonal, amount to shift length by; otherwise, whether to swap arguments
|
||
0,0,0,0,0,n,n,n,
|
||
1,0,0,0,0,n,n,n,
|
||
1,1,1,0,0,n,n,n,
|
||
1,1,1,2,0,n,n,n,
|
||
1,1,1,1,0,n,n,n,
|
||
n,n,n,n,n,0,0,0,
|
||
n,n,n,n,n,1,1,0,
|
||
n,n,n,n,n,1,1,2,
|
||
};
|
||
#endif
|
||
|
||
NOINLINE bool equalSlow(B w, B x, usz ia);
|
||
NOINLINE bool equal(B w, B x) { // doesn't consume
|
||
bool wa = isAtm(w);
|
||
bool xa = isAtm(x);
|
||
if (wa!=xa) return false;
|
||
if (wa) return atomEqual(w, x);
|
||
ur wr = rnk(w);
|
||
ur xr = rnk(x);
|
||
if (wr!=xr) return false;
|
||
usz ia = a(x)->ia;
|
||
if (LIKELY(wr==1)) {
|
||
if (ia != a(w)->ia) return false;
|
||
} else {
|
||
usz* wsh = a(w)->sh;
|
||
usz* xsh = a(x)->sh;
|
||
if (wsh!=xsh) for (usz i = 0; i < wr; i++) if (wsh[i]!=xsh[i]) return false;
|
||
}
|
||
if (ia==0) return true;
|
||
u8 we = TI(w,elType);
|
||
u8 xe = TI(x,elType);
|
||
|
||
#if SINGELI
|
||
if (we<=el_c32 && xe<=el_c32) { // remove & pass a(w) and a(x) to fn so it can do basic loop
|
||
u8* wp = tyany_ptr(w);
|
||
u8* xp = tyany_ptr(x);
|
||
u64 idx = we*8 + xe;
|
||
return eqFns[idx](wp, xp, ia, eqFnData[idx]);
|
||
}
|
||
#else
|
||
if (((we==el_f64 | we==el_i32) && (xe==el_f64 | xe==el_i32))) {
|
||
if (we==el_i32) { i32* wp = i32any_ptr(w);
|
||
if(xe==el_i32) { i32* xp = i32any_ptr(x); for (usz i = 0; i < ia; i++) if(wp[i]!=xp[i]) return false; }
|
||
else { f64* xp = f64any_ptr(x); for (usz i = 0; i < ia; i++) if(wp[i]!=xp[i]) return false; }
|
||
} else { f64* wp = f64any_ptr(w);
|
||
if(xe==el_i32) { i32* xp = i32any_ptr(x); for (usz i = 0; i < ia; i++) if(wp[i]!=xp[i]) return false; }
|
||
else { f64* xp = f64any_ptr(x); for (usz i = 0; i < ia; i++) if(wp[i]!=xp[i]) return false; }
|
||
}
|
||
return true;
|
||
}
|
||
if (we==el_c32 && xe==el_c32) {
|
||
u32* wp = c32any_ptr(w);
|
||
u32* xp = c32any_ptr(x);
|
||
for (usz i = 0; i < ia; i++) if(wp[i]!=xp[i]) return false;
|
||
return true;
|
||
}
|
||
#endif
|
||
return equalSlow(w, x, ia);
|
||
}
|
||
bool equalSlow(B w, B x, usz ia) {
|
||
SLOW2("equal", w, x);
|
||
SGetU(x)
|
||
SGetU(w)
|
||
for (usz i = 0; i < ia; i++) if(!equal(GetU(w,i),GetU(x,i))) return false;
|
||
return true;
|
||
}
|
||
|
||
bool atomEEqual(B w, B x) { // doesn't consume (not that that matters really currently)
|
||
if (w.u==x.u) return true;
|
||
#if EEQUAL_NEGZERO
|
||
if (isF64(w)&isF64(x)) return w.f==x.f;
|
||
#endif
|
||
if(isF64(w)|isF64(x)) return false;
|
||
if (!isVal(w) | !isVal(x)) return false;
|
||
if (v(w)->type!=v(x)->type) return false;
|
||
B2B dcf = TI(w,decompose);
|
||
if (dcf == def_decompose) return false;
|
||
B wd=dcf(inc(w)); B* wdp = harr_ptr(wd);
|
||
B xd=dcf(inc(x)); B* xdp = harr_ptr(xd);
|
||
if (o2i(wdp[0])<=1) { decG(wd);decG(xd); return false; }
|
||
usz wia = a(wd)->ia;
|
||
if (wia!=a(xd)->ia) { decG(wd);decG(xd); return false; }
|
||
for (u64 i = 0; i<wia; i++) if(!eequal(wdp[i], xdp[i]))
|
||
{ decG(wd);decG(xd); return false; }
|
||
decG(wd);dec(xd); return true;
|
||
}
|
||
bool eequal(B w, B x) { // doesn't consume
|
||
if (w.u==x.u) return true;
|
||
bool wa = isAtm(w);
|
||
bool xa = isAtm(x);
|
||
if (wa!=xa) return false;
|
||
if (wa) return atomEEqual(w, x);
|
||
// B wf = getFillQ(w);
|
||
// B xf = getFillQ(x);
|
||
// bool feq = eequal(wf, xf);
|
||
// dec(wf); dec(xf);
|
||
// if (!feq) return false;
|
||
if (!eqShape(w,x)) return false;
|
||
u8 we = TI(w,elType);
|
||
u8 xe = TI(x,elType);
|
||
if (we==el_f64 && xe==el_f64) {
|
||
usz ia = a(x)->ia;
|
||
f64* wp = f64any_ptr(w);
|
||
f64* xp = f64any_ptr(x);
|
||
u64 r = 1;
|
||
for (usz i = 0; i < ia; i++) {
|
||
#if EEQUAL_NEGZERO
|
||
r&= (wp[i]==xp[i]) | (wp[i]!=wp[i] & xp[i]!=xp[i]);
|
||
#else
|
||
r&= ((u64*)wp)[i] == ((u64*)xp)[i];
|
||
#endif
|
||
}
|
||
return r;
|
||
}
|
||
if (we!=el_B && xe!=el_B) return equal(w, x);
|
||
usz ia = a(x)->ia;
|
||
SGetU(x)
|
||
SGetU(w)
|
||
for (usz i = 0; i < ia; i++) if(!eequal(GetU(w,i),GetU(x,i))) return false;
|
||
return true;
|
||
}
|
||
|
||
u64 depth(B x) { // doesn't consume
|
||
if (isAtm(x)) return 0;
|
||
if (TI(x,arrD1)) return 1;
|
||
u64 r = 0;
|
||
usz ia = a(x)->ia;
|
||
SGetU(x)
|
||
for (usz i = 0; i < ia; i++) {
|
||
u64 n = depth(GetU(x,i));
|
||
if (n>r) r = n;
|
||
}
|
||
return r+1;
|
||
}
|
||
void tyarr_freeO(Value* x) { decSh(x); }
|
||
void slice_freeO(Value* x) { ptr_dec(((Slice*)x)->p); decSh(x); }
|
||
void tyarr_freeF(Value* x) { tyarr_freeO(x); mm_free(x); }
|
||
void slice_freeF(Value* x) { slice_freeO(x); mm_free(x); }
|
||
void slice_visit(Value* x) { mm_visitP(((Slice*)x)->p); }
|
||
void slice_print(B x) { arr_print(x); }
|
||
|
||
char* type_repr(u8 u) {
|
||
switch(u) { default: return "(unknown type)";
|
||
#define F(X) case t_##X: return #X;
|
||
FOR_TYPE(F)
|
||
#undef F
|
||
}
|
||
}
|
||
char* eltype_repr(u8 u) {
|
||
switch(u) { default: return "(bad elType)";
|
||
case el_bit: return "el_bit"; case el_f64: return "el_f64"; case el_B: return "el_B";
|
||
case el_i8: return "el_i8"; case el_c8: return "el_c8";
|
||
case el_i16: return "el_i16"; case el_c16: return "el_c16";
|
||
case el_i32: return "el_i32"; case el_c32: return "el_c32";
|
||
}
|
||
}
|
||
bool isPureFn(B x) { // doesn't consume
|
||
if (isCallable(x)) {
|
||
if (isPrim(x)) return true;
|
||
B2B dcf = TI(x,decompose);
|
||
B xd = dcf(inc(x));
|
||
B* xdp = harr_ptr(xd);
|
||
i32 t = o2iu(xdp[0]);
|
||
if (t<2) { decG(xd); return t==0; }
|
||
usz xdia = a(xd)->ia;
|
||
for (u64 i = 1; i<xdia; i++) if(!isPureFn(xdp[i])) { decG(xd); return false; }
|
||
decG(xd); return true;
|
||
} else if (isArr(x)) {
|
||
usz ia = a(x)->ia;
|
||
SGetU(x)
|
||
for (usz i = 0; i < ia; i++) if (!isPureFn(GetU(x,i))) return false;
|
||
return true;
|
||
} else return isNum(x) || isC32(x);
|
||
}
|
||
|
||
B num_squeeze(B x) {
|
||
usz ia = a(x)->ia;
|
||
u8 xe = TI(x,elType);
|
||
usz i = 0;
|
||
u32 or = 0; // using bitwise or as an approximate ⌈´
|
||
switch (xe) { default: UD;
|
||
case el_bit: goto r_x;
|
||
case el_i8: { i8* xp = i8any_ptr (x); for (; i < ia; i++) { i32 c = xp[i]; or|= ((u32)c & ~1) ^ (u32)(c>>31); } goto r_or; }
|
||
case el_i16: { i16* xp = i16any_ptr(x); for (; i < ia; i++) { i32 c = xp[i]; or|= ((u32)c & ~1) ^ (u32)(c>>31); } goto r_or; }
|
||
case el_i32: { i32* xp = i32any_ptr(x); for (; i < ia; i++) { i32 c = xp[i]; or|= ((u32)c & ~1) ^ (u32)(c>>31); } goto r_or; }
|
||
case el_f64: {
|
||
f64* xp = f64any_ptr(x);
|
||
for (; i < ia; i++) {
|
||
f64 cf = xp[i];
|
||
i32 c = (i32)cf;
|
||
if (c!=cf) goto r_x; // already f64
|
||
or|= ((u32)c & ~1) ^ (u32)(c>>31);
|
||
}
|
||
goto r_or;
|
||
}
|
||
case el_B: case el_c8: case el_c16: case el_c32:; /*fallthrough*/
|
||
}
|
||
|
||
B* xp = arr_bptr(x);
|
||
if (xp!=NULL) {
|
||
for (; i < ia; i++) {
|
||
if (RARE(!q_i32(xp[i]))) {
|
||
while (i<ia) if (!isF64(xp[i++])) goto r_x;
|
||
goto r_f64;
|
||
}
|
||
i32 c = o2iu(xp[i]);
|
||
or|= ((u32)c & ~1) ^ (u32)(c>>31);
|
||
}
|
||
goto r_or;
|
||
}
|
||
|
||
SGetU(x)
|
||
for (; i < ia; i++) {
|
||
B cr = GetU(x,i);
|
||
if (RARE(!q_i32(cr))) {
|
||
while (i<ia) if (!isF64(GetU(x,i++))) goto r_x;
|
||
goto r_f64;
|
||
}
|
||
i32 c = o2iu(cr);
|
||
or|= ((u32)c & ~1) ^ (u32)(c>>31);
|
||
}
|
||
r_or:
|
||
if (or==0) goto r_bit;
|
||
else if (or<=(u32)I8_MAX ) goto r_i8;
|
||
else if (or<=(u32)I16_MAX) goto r_i16;
|
||
else goto r_i32;
|
||
|
||
r_x : return FL_SET(x, fl_squoze);
|
||
r_bit: return FL_SET(taga(toBitArr(x)), fl_squoze);
|
||
r_i8 : return FL_SET(toI8Any (x), fl_squoze);
|
||
r_i16: return FL_SET(toI16Any(x), fl_squoze);
|
||
r_i32: return FL_SET(toI32Any(x), fl_squoze);
|
||
r_f64: return FL_SET(toF64Any(x), fl_squoze);
|
||
}
|
||
B chr_squeeze(B x) {
|
||
usz ia = a(x)->ia;
|
||
u8 xe = TI(x,elType);
|
||
if (xe==el_c8) goto r_x;
|
||
usz i = 0;
|
||
i32 or = 0;
|
||
if (xe==el_c16) {
|
||
u16* xp = c16any_ptr(x);
|
||
for (; i < ia; i++) if (xp[i] != (u8)xp[i]) goto r_x;
|
||
goto r_c8;
|
||
}
|
||
if (xe==el_c32) {
|
||
u32* xp = c32any_ptr(x);
|
||
bool c8 = true;
|
||
for (; i < ia; i++) {
|
||
if (xp[i] != (u16)xp[i]) goto r_c32;
|
||
if (xp[i] != (u8 )xp[i]) c8 = false;
|
||
}
|
||
if (c8) goto r_c8;
|
||
else goto r_c16;
|
||
}
|
||
|
||
B* xp = arr_bptr(x);
|
||
if (xp!=NULL) {
|
||
for (; i < ia; i++) {
|
||
if (!isC32(xp[i])) goto r_x;
|
||
or|= o2cu(xp[i]);
|
||
}
|
||
} else {
|
||
SGetU(x)
|
||
for (; i < ia; i++) {
|
||
B cr = GetU(x,i);
|
||
if (!isC32(cr)) goto r_x;
|
||
or|= o2cu(cr);
|
||
}
|
||
}
|
||
if (or<=U8_MAX ) r_c8: return FL_SET(toC8Any(x), fl_squoze);
|
||
else if (or<=U16_MAX) r_c16: return FL_SET(toC16Any(x), fl_squoze);
|
||
else r_c32: return FL_SET(toC32Any(x), fl_squoze);
|
||
r_x: return FL_SET(x, fl_squoze);
|
||
}
|
||
|
||
B any_squeeze(B x) {
|
||
assert(isArr(x));
|
||
if (FL_HAS(x,fl_squoze)) return x;
|
||
if (a(x)->ia==0) return FL_SET(x, fl_squoze); // TODO return a version of the smallest type
|
||
B x0 = IGetU(x, 0);
|
||
if (isNum(x0)) return num_squeeze(x);
|
||
else if (isC32(x0)) return chr_squeeze(x);
|
||
return FL_SET(x, fl_squoze);
|
||
}
|
||
|
||
B squeeze_deep(B x) {
|
||
if (!isArr(x)) return x;
|
||
x = any_squeeze(x);
|
||
if (TI(x,elType)!=el_B) return x;
|
||
usz ia = a(x)->ia;
|
||
M_HARR(r, ia)
|
||
B* xp = arr_bptr(x);
|
||
B xf = getFillQ(x);
|
||
if (xp!=NULL) {
|
||
for (usz i=0; i<ia; i++) { HARR_ADD(r, i, squeeze_deep(inc(xp[i]))); }
|
||
} else {
|
||
SGet(x);
|
||
for (usz i=0; i<ia; i++) { HARR_ADD(r, i, squeeze_deep(Get(x,i))); }
|
||
}
|
||
return any_squeeze(qWithFill(HARR_FCD(r, x), xf));
|
||
}
|
||
|
||
B bqn_merge(B x) {
|
||
assert(isArr(x));
|
||
usz xia = a(x)->ia;
|
||
ur xr = rnk(x);
|
||
if (xia==0) {
|
||
B xf = getFillE(x);
|
||
if (isAtm(xf)) { dec(xf); return x; }
|
||
i32 xfr = rnk(xf);
|
||
B xff = getFillQ(xf);
|
||
Arr* r = m_fillarrp(0);
|
||
fillarr_setFill(r, xff);
|
||
if (xr+xfr > UR_MAX) thrM(">: Result rank too large");
|
||
usz* rsh = arr_shAlloc(r, xr+xfr);
|
||
if (rsh) {
|
||
memcpy (rsh , a(x)->sh, xr *sizeof(usz));
|
||
if(xfr)memcpy(rsh+xr, a(xf)->sh, xfr*sizeof(usz));
|
||
}
|
||
decG(x); dec(xf);
|
||
return taga(r);
|
||
}
|
||
|
||
SGetU(x)
|
||
B x0 = GetU(x, 0);
|
||
usz* elSh = isArr(x0)? a(x0)->sh : NULL;
|
||
ur elR = isArr(x0)? rnk(x0) : 0;
|
||
usz elIA = isArr(x0)? a(x0)->ia : 1;
|
||
B fill = getFillQ(x0);
|
||
if (xr+elR > UR_MAX) thrM(">: Result rank too large");
|
||
|
||
MAKE_MUT(r, xia*elIA);
|
||
usz rp = 0;
|
||
for (usz i = 0; i < xia; i++) {
|
||
B c = GetU(x, i);
|
||
if (isArr(c)? (elR!=rnk(c) || !eqShPrefix(elSh, a(c)->sh, elR)) : elR!=0) { mut_pfree(r, rp); thrF(">: Elements didn't have equal shapes (contained shapes %H and %H)", x0, c); }
|
||
if (isArr(c)) mut_copy(r, rp, c, 0, elIA);
|
||
else mut_set(r, rp, inc(c));
|
||
if (!noFill(fill)) fill = fill_or(fill, getFillQ(c));
|
||
rp+= elIA;
|
||
}
|
||
Arr* ra = mut_fp(r);
|
||
usz* rsh = arr_shAlloc(ra, xr+elR);
|
||
if (rsh) {
|
||
memcpy (rsh , a(x)->sh, xr *sizeof(usz));
|
||
if (elSh)memcpy(rsh+xr, elSh, elR*sizeof(usz));
|
||
}
|
||
decG(x);
|
||
return withFill(taga(ra),fill);
|
||
}
|
||
|
||
#ifdef ALLOC_STAT
|
||
u64* ctr_a = 0;
|
||
u64* ctr_f = 0;
|
||
u64 actrc = 21000;
|
||
u64 talloc = 0;
|
||
#ifdef ALLOC_SIZES
|
||
u32** actrs;
|
||
#endif
|
||
#endif
|
||
|
||
NOINLINE void print_allocStats() {
|
||
#ifdef ALLOC_STAT
|
||
printf("total ever allocated: "N64u"\n", talloc);
|
||
printf("allocated heap size: "N64u"\n", mm_heapAlloc);
|
||
printf("used heap size: "N64u"\n", mm_heapUsed());
|
||
ctr_a[t_harr]+= ctr_a[t_harrPartial];
|
||
ctr_a[t_harrPartial] = 0;
|
||
printf("ctrA←"); for (i64 i = 0; i < t_COUNT; i++) { if(i)printf("‿"); printf(N64u, ctr_a[i]); } printf("\n");
|
||
printf("ctrF←"); for (i64 i = 0; i < t_COUNT; i++) { if(i)printf("‿"); printf(N64u, ctr_f[i]); } printf("\n");
|
||
printf("names←⟨"); for (i64 i = 0; i < t_COUNT; i++) { if(i)printf(","); printf("\"%s\"", type_repr(i)); } printf("⟩\n");
|
||
u64 leakedCount = 0;
|
||
for (i64 i = 0; i < t_COUNT; i++) leakedCount+= ctr_a[i]-ctr_f[i];
|
||
printf("leaked object count: "N64u"\n", leakedCount);
|
||
#ifdef ALLOC_SIZES
|
||
for(i64 i = 0; i < actrc; i++) {
|
||
u32* c = actrs[i];
|
||
bool any = false;
|
||
for (i64 j = 0; j < t_COUNT; j++) if (c[j]) any=true;
|
||
if (any) {
|
||
printf(N64u, i*4);
|
||
for (i64 k = 0; k < t_COUNT; k++) printf("‿%u", c[k]);
|
||
printf("\n");
|
||
}
|
||
}
|
||
#endif
|
||
#endif
|
||
}
|
||
|
||
// for gdb
|
||
B info_c2(B, B, B);
|
||
Value* g_v(B x) { return v(x); }
|
||
Arr* g_a(B x) { return a(x); }
|
||
B g_t (void* x) { return tag(x,OBJ_TAG); }
|
||
B g_ta(void* x) { return tag(x,ARR_TAG); }
|
||
B g_tf(void* x) { return tag(x,FUN_TAG); }
|
||
void g_p(B x) { print(x); putchar(10); fflush(stdout); }
|
||
void g_i(B x) { B r = info_c2(x, m_f64(1), inc(x)); print(r); dec(r); putchar(10); fflush(stdout); }
|
||
void g_pv(void* x) { print(tag(x,OBJ_TAG)); putchar(10); fflush(stdout); }
|
||
void g_iv(void* x) { B xo = tag(x, OBJ_TAG); B r = info_c2(xo, m_f64(1), inc(xo)); print(r); dec(r); putchar(10); fflush(stdout); }
|
||
void g_pst(void) { vm_pstLive(); }
|
||
|
||
#ifdef DEBUG
|
||
#ifdef OBJ_COUNTER
|
||
#define PRINT_ID(X) fprintf(stderr, "Object ID: "N64u"\n", (X)->uid)
|
||
#else
|
||
#define PRINT_ID(X)
|
||
#endif
|
||
NOINLINE Value* VALIDATEP(Value* x) {
|
||
if (x->refc<=0 || (x->refc>>28) == 'a' || x->type==t_empty) {
|
||
PRINT_ID(x);
|
||
fprintf(stderr, "bad refcount for type %d: %d\nattempting to print: ", x->type, x->refc); fflush(stderr);
|
||
fprint(stderr, tag(x,OBJ_TAG)); fputc('\n', stderr); fflush(stderr);
|
||
err("");
|
||
}
|
||
if (TIv(x,isArr)) {
|
||
Arr* a = (Arr*)x;
|
||
if (prnk(x)<=1) assert(a->sh == &a->ia);
|
||
else {
|
||
u64 p = 1;
|
||
for (usz i=0; i < prnk(x); i++) p*= a->sh[i];
|
||
assert(p == a->ia);
|
||
VALIDATE(tag(shObjP(x),OBJ_TAG));
|
||
}
|
||
}
|
||
return x;
|
||
}
|
||
NOINLINE B VALIDATE(B x) {
|
||
if (!isVal(x)) return x;
|
||
VALIDATEP(v(x));
|
||
if(isArr(x)!=TI(x,isArr) && v(x)->type!=t_freed && v(x)->type!=t_harrPartial) {
|
||
fprintf(stderr, "bad array tag/type: type=%d, obj=%p\n", v(x)->type, (void*)x.u);
|
||
PRINT_ID(v(x));
|
||
fprint(stderr, x);
|
||
err("\n");
|
||
}
|
||
return x;
|
||
}
|
||
NOINLINE NORETURN void assert_fail(char* expr, char* file, int line, const char fn[]) {
|
||
fprintf(stderr, "%s:%d: %s: Assertion `%s` failed.\n", file, line, fn, expr);
|
||
err("");
|
||
}
|
||
#endif
|
||
#if WARN_SLOW==1
|
||
static void warn_ln(B x) {
|
||
if (isArr(x)) print_fmt("%s items, %S, shape=%H\n", a(x)->ia, eltype_repr(TI(x,elType)), x);
|
||
else {
|
||
fprintf(stderr, "atom: ");
|
||
fprintRaw(stderr, x = bqn_fmt(inc(x))); dec(x);
|
||
fputc('\n', stderr);
|
||
}
|
||
}
|
||
void warn_slow1(char* s, B x) {
|
||
if (isArr(x) && a(x)->ia<100) return;
|
||
fprintf(stderr, "slow %s: ", s); warn_ln(x);
|
||
fflush(stderr);
|
||
}
|
||
void warn_slow2(char* s, B w, B x) {
|
||
if ((isArr(w)||isArr(x)) && (!isArr(w) || a(w)->ia<50) && (!isArr(x) || a(x)->ia<50)) return;
|
||
fprintf(stderr, "slow %s:\n 𝕨: ", s); warn_ln(w);
|
||
fprintf(stderr, " 𝕩: "); warn_ln(x);
|
||
fflush(stderr);
|
||
}
|
||
void warn_slow3(char* s, B w, B x, B y) {
|
||
if ((isArr(w)||isArr(x)) && (!isArr(w) || a(w)->ia<50) && (!isArr(x) || a(x)->ia<50)) return;
|
||
fprintf(stderr, "slow %s:\n 𝕨: ", s); warn_ln(w);
|
||
fprintf(stderr, " 𝕩: "); warn_ln(x);
|
||
fprintf(stderr, " f: "); warn_ln(y);
|
||
fflush(stderr);
|
||
}
|
||
#endif
|