uCBQN/src/builtins/internal.c
2025-05-11 20:28:23 +03:00

443 lines
14 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/file.h"
#include "../builtins.h"
#include "../ns.h"
#include "../utils/cstr.h"
B itype_c1(B t, B x) {
B r;
if(isVal(x)) {
r = m_c8vec_0(type_repr(TY(x)));
} else {
if (isF64(x)) r = m_c8vec_0("tagged f64");
else if (isC32(x)) r = m_c8vec_0("tagged c32");
else if (isTag(x)) r = m_c8vec_0("tagged tag");
else if (isVar(x)) r = m_c8vec_0("tagged var");
else if (isExt(x)) r = m_c8vec_0("tagged extvar");
else r = m_c8vec_0("tagged unknown");
}
dec(x);
return r;
}
B elType_c1(B t, B x) {
B r = m_i32(isArr(x)? TI(x,elType) : selfElType(x));
dec(x);
return r;
}
B refc_c1(B t, B x) {
B r = isVal(x)? m_i32(v(x)->refc) : m_c8vec_0("(not heap-allocated)");
dec(x);
return r;
}
B squeeze_c1(B t, B x) {
if (!isArr(x)) return x;
return any_squeeze(x);
}
B deepSqueeze_c1(B t, B x) {
return squeeze_deep(x);
}
B isPure_c1(B t, B x) {
B r = m_f64(isPureFn(x));
dec(x);
return r;
}
B info_c2(B t, B w, B x) {
B s = emptyCVec();
i32 m = o2i(w);
if (isVal(x)) {
if (m) AFMT("%xl: ", x.u);
else AFMT("%xl: ", x.u>>48);
Value* xv = v(x);
AFMT("refc:%i ", xv->refc);
if (m) {
AFMT("mmInfo:%i ", xv->mmInfo);
AFMT("flags:%i ", xv->flags);
AFMT("extra:%i ", xv->extra);
}
AFMT("type:%i=%S ", PTY(xv), type_repr(PTY(xv)));
AFMT("alloc:%l", mm_size(xv));
decG(x);
} else {
AFMT("%xl: ", x.u);
A8("not heap-allocated");
}
return s;
}
B info_c1(B t, B x) {
return info_c2(t, m_i32(0), x);
}
#define FOR_VARIATION(F) F(Ai8 ) F(Si8 ) F(Ai8Inc ) F(Si8Inc ) \
F(Ai16) F(Si16) F(Ai16Inc) F(Si16Inc) \
F(Ai32) F(Si32) F(Ai32Inc) F(Si32Inc) \
F(Ac8 ) F(Sc8 ) F(Ac8Inc ) F(Sc8Inc ) \
F(Ac16) F(Sc16) F(Ac16Inc) F(Sc16Inc) \
F(Ac32) F(Sc32) F(Ac32Inc) F(Sc32Inc) \
F(Af64) F(Sf64) F(Af64Inc) F(Sf64Inc) \
F(Ah) F(Sh) F(AhInc) F(ShInc) \
F(Af) F(Sf) F(AfInc) F(SfInc) \
F(Ab) F(AbInc)
#define F(X) STATIC_GLOBAL B v_##X;
FOR_VARIATION(F)
#undef F
STATIC_GLOBAL B listVariations_def;
B listVariations_c2(B t, B w, B x) {
if (!isArr(x)) thrM("𝕨 •internal.ListVariations 𝕩: 𝕩 must be an array");
if (!isArr(w) || RNK(w)!=1) thrM("𝕨 •internal.ListVariations 𝕩: 𝕨 must be a list");
usz wia = IA(w);
SGetU(w)
bool c_incr=false, c_rmFill=false;
for (usz i = 0; i < wia; i++) {
u32 c = o2c(GetU(w, i));
if (c=='i') c_incr=true;
else if (c=='f') c_rmFill=true;
else thrF("𝕨 internal.ListVariations 𝕩: Unknown option '%c' in 𝕨", c);
}
decG(w);
u8 xe = TI(x,elType);
B xf = getFillQ(x);
bool ah = c_rmFill || noFill(xf);
bool ai8=false, ai16=false, ai32=false, af64=false,
ac8=false, ac16=false, ac32=false, abit=false;
usz xia = IA(x);
SGetU(x)
if (isNum(xf)) {
i32 min=I32_MAX, max=I32_MIN;
if (xe==el_i8 ) { i8* xp = i8any_ptr (x); for (usz i = 0; i < xia; i++) { if (xp[i]>max) max=xp[i]; if (xp[i]<min) min=xp[i]; } }
else if (xe==el_i16) { i16* xp = i16any_ptr(x); for (usz i = 0; i < xia; i++) { if (xp[i]>max) max=xp[i]; if (xp[i]<min) min=xp[i]; } }
else if (xe==el_i32) { i32* xp = i32any_ptr(x); for (usz i = 0; i < xia; i++) { if (xp[i]>max) max=xp[i]; if (xp[i]<min) min=xp[i]; } }
else if (xe==el_f64) { f64* xp = f64any_ptr(x); for (usz i = 0; i < xia; i++) { if (xp[i]>max) max=xp[i]; if (xp[i]<min) min=xp[i]; if(xp[i]!=(i32)xp[i]) goto onlyF64; } }
else for (usz i = 0; i < xia; i++) { B c = GetU(x, i); if (!isF64(c)) goto noSpec; if (c.f>max) max=c.f; if (c.f<min) min=c.f; }
ai8 = min==(i8 )min && max==(i8 )max;
ai16 = min==(i16)min && max==(i16)max;
ai32 = min==(i32)min && max==(i32)max;
abit = min>=0 && max<=1;
onlyF64:
af64 = true;
} else if (isC32(xf)) {
u32 max = 0;
if (xe!=el_c8) for (usz i = 0; i < xia; i++) {
B c = GetU(x, i);
if (!isC32(c)) goto noSpec;
if (o2cG(c)>max) max = o2cG(c);
}
ac8 = max == (u8 )max;
ac16 = max == (u16)max;
ac32 = true;
}
noSpec:;
B r = emptyHVec();
if(abit) { r=vec_addN(r,incG(v_Ab )); if(c_incr) { r=vec_addN(r,incG(v_AbInc )); } }
if(ai8 ) { r=vec_addN(r,incG(v_Ai8 ));r=vec_addN(r,incG(v_Si8 )); if(c_incr) { r=vec_addN(r,incG(v_Ai8Inc ));r=vec_addN(r,incG(v_Si8Inc )); } }
if(ai16) { r=vec_addN(r,incG(v_Ai16));r=vec_addN(r,incG(v_Si16)); if(c_incr) { r=vec_addN(r,incG(v_Ai16Inc));r=vec_addN(r,incG(v_Si16Inc)); } }
if(ai32) { r=vec_addN(r,incG(v_Ai32));r=vec_addN(r,incG(v_Si32)); if(c_incr) { r=vec_addN(r,incG(v_Ai32Inc));r=vec_addN(r,incG(v_Si32Inc)); } }
if(ac8 ) { r=vec_addN(r,incG(v_Ac8 ));r=vec_addN(r,incG(v_Sc8 )); if(c_incr) { r=vec_addN(r,incG(v_Ac8Inc ));r=vec_addN(r,incG(v_Sc8Inc )); } }
if(ac16) { r=vec_addN(r,incG(v_Ac16));r=vec_addN(r,incG(v_Sc16)); if(c_incr) { r=vec_addN(r,incG(v_Ac16Inc));r=vec_addN(r,incG(v_Sc16Inc)); } }
if(ac32) { r=vec_addN(r,incG(v_Ac32));r=vec_addN(r,incG(v_Sc32)); if(c_incr) { r=vec_addN(r,incG(v_Ac32Inc));r=vec_addN(r,incG(v_Sc32Inc)); } }
if(af64) { r=vec_addN(r,incG(v_Af64));r=vec_addN(r,incG(v_Sf64)); if(c_incr) { r=vec_addN(r,incG(v_Af64Inc));r=vec_addN(r,incG(v_Sf64Inc)); } }
if(ah) { r=vec_addN(r,incG(v_Ah ));r=vec_addN(r,incG(v_Sh )); if(c_incr) { r=vec_addN(r,incG(v_AhInc ));r=vec_addN(r,incG(v_ShInc )); } }
{ r=vec_addN(r,incG(v_Af ));r=vec_addN(r,incG(v_Sf )); if(c_incr) { r=vec_addN(r,incG(v_AfInc ));r=vec_addN(r,incG(v_SfInc )); } }
decG(x);
dec(xf);
return r;
}
B listVariations_c1(B t, B x) {
return listVariations_c2(t, incG(listVariations_def), x);
}
static bool u8_get(u8** cv, u8* cE, const char* x) {
u8* c = *cv;
while (true) {
if (!*x) {
*cv = c;
return true;
}
if (c==cE || *c!=*x) return false;
c++; x++;
}
}
STATIC_GLOBAL B variation_refs;
B variation_c2(B t, B w, B x) {
if (!isArr(w)) thrM("𝕨 •internal.Variation 𝕩: Non-array 𝕨");
if (!isArr(x)) thrM("𝕨 •internal.Variation 𝕩: Non-array 𝕩");
usz xia = IA(x);
C8Arr* wc = toC8Arr(w);
u8* wp = c8arrv_ptr(wc);
u8* wpE = wp+PIA(wc);
if (PIA(wc)==0) thrM("𝕨 •internal.Variation 𝕩: Zero-length 𝕨");
B res;
if (*wp == 'A' || *wp == 'S') {
bool slice = *wp == 'S';
wp++;
if (u8_get(&wp, wpE, "b" )) res = taga(cpyBitArr(incG(x)));
else if (u8_get(&wp, wpE, "i8" )) res = taga(cpyI8Arr (incG(x)));
else if (u8_get(&wp, wpE, "i16")) res = taga(cpyI16Arr(incG(x)));
else if (u8_get(&wp, wpE, "i32")) res = taga(cpyI32Arr(incG(x)));
else if (u8_get(&wp, wpE, "c8" )) res = taga(cpyC8Arr (incG(x)));
else if (u8_get(&wp, wpE, "c16")) res = taga(cpyC16Arr(incG(x)));
else if (u8_get(&wp, wpE, "c32")) res = taga(cpyC32Arr(incG(x)));
else if (u8_get(&wp, wpE, "f64")) res = taga(cpyF64Arr(incG(x)));
else if (u8_get(&wp, wpE, "h" )) res = taga(cpyHArr (incG(x)));
else if (u8_get(&wp, wpE, "f")) {
Arr* r = m_fillarrp(xia);
fillarr_setFill(r, getFillR(x));
arr_shCopy(r, x);
COPY_TO(fillarrv_ptr(r), el_B, 0, x, 0, xia);
NOGC_E;
res = taga(r);
} else thrF("𝕨 •internal.Variation 𝕩: Bad type \"%R\"", taga(wc));
if (slice) {
Arr* slice = TI(res,slice)(incG(res), 0, IA(res));
arr_shCopy(slice, res);
decG(res);
res = taga(slice);
}
if (u8_get(&wp, wpE, "Inc")) {
if (!variation_refs.u) {
variation_refs = emptyHVec();
}
variation_refs = vec_addN(variation_refs, incG(res));
}
if (wp!=wpE) thrM("𝕨 •internal.Variation 𝕩: Bad 𝕨");
} else thrM("𝕨 •internal.Variation 𝕩: Bad start of 𝕨");
decG(x);
ptr_dec(wc);
return res;
}
B clearRefs_c1(B t, B x) {
dec(x);
if (!isArr(variation_refs)) return m_f64(0);
usz res = IA(variation_refs);
decG(variation_refs);
variation_refs = m_f64(0);
return m_f64(res);
}
static NOINLINE B unshareShape(Arr* x) {
ur xr = PRNK(x);
if (xr<=1) return taga(x);
ShArr* sh = m_shArr(xr);
shcpy(sh->a, x->sh, xr);
arr_shReplace(x, xr, sh);
return taga(x);
}
static B unshare(B x) { // doesn't consume
if (!isArr(x)) return inc(x);
usz xia = IA(x);
switch (TY(x)) {
case t_bitarr: return unshareShape((Arr*)cpyBitArr(incG(x)));
case t_i8arr: case t_i8slice: return unshareShape((Arr*)cpyI8Arr (incG(x)));
case t_i16arr: case t_i16slice: return unshareShape((Arr*)cpyI16Arr(incG(x)));
case t_i32arr: case t_i32slice: return unshareShape((Arr*)cpyI32Arr(incG(x)));
case t_c8arr: case t_c8slice: return unshareShape((Arr*)cpyC8Arr (incG(x)));
case t_c16arr: case t_c16slice: return unshareShape((Arr*)cpyC16Arr(incG(x)));
case t_c32arr: case t_c32slice: return unshareShape((Arr*)cpyC32Arr(incG(x)));
case t_f64arr: case t_f64slice: return unshareShape((Arr*)cpyF64Arr(incG(x)));
case t_harr: case t_hslice: {
B* xp = TY(x)==t_harr? harr_ptr(x) : hslice_ptr(x);
M_HARR(r, xia)
for (usz i = 0; i < xia; i++) HARR_ADD(r, i, unshare(xp[i]));
return unshareShape(a(HARR_FC(r, x)));
}
case t_fillarr: case t_fillslice: {
Arr* r = arr_shCopy(m_fillarr0p(xia), x);
fillarr_setFill(r, unshare(getFillR(x)));
B* rp = fillarrv_ptr(r);
B* xp = arr_bptr(x);
for (usz i = 0; i < xia; i++) rp[i] = unshare(xp[i]);
return unshareShape(r);
}
default: thrF("•internal.Unshare 𝕩: Cannot unshare array with type %i=%S", TY(x), type_repr(TY(x)));
}
}
B eequal_c2(B t, B w, B x) {
bool r = eequal(w, x);
dec(w); dec(x);
return m_i32(r);
}
#ifdef TEST_BITCPY
#include "../utils/mut.h"
#endif
#if NATIVE_COMPILER
extern B native_comp;
void switchComp(void);
#endif
#if TEST_CELL_FILLS
extern i32 fullCellFills;
extern i32 cellFillErrored;
#endif
#if TEST_RANGE
#include "../utils/calls.h"
#endif
#if TEST_GROUP_STAT
extern void (*const si_group_statistics_i8)(void*,usz,uint8_t*,usz*,uint8_t*,usz*,int8_t*);
extern void (*const si_group_statistics_i16)(void*,usz,uint8_t*,usz*,uint8_t*,usz*,int16_t*);
extern void (*const si_group_statistics_i32)(void*,usz,uint8_t*,usz*,uint8_t*,usz*,int32_t*);
#endif
B internalTemp_c1(B t, B x) {
#if TEST_GROUP_STAT
u8 bad; usz neg; u8 sort; usz change; i32 max;
#define CASE(T) \
if (TI(x,elType)==el_##T) { T max_t; si_group_statistics_##T(tyany_ptr(x), IA(x), &bad, &neg, &sort, &change, &max_t); max = max_t; } \
else
CASE(i8) CASE(i16) CASE(i32)
thrM("bad eltype");
#undef CASE
decG(x);
f64* rp; B r = m_f64arrv(&rp, 5);
rp[0] = bad; rp[1] = neg; rp[2] = sort; rp[3] = change; rp[4] = max;
return r;
#endif
#if TEST_RANGE
i64 buf[2];
bool b = getRange_fns[TI(x,elType)](tyany_ptr(x), buf, IA(x));
decG(x);
f64* rp;
B r = m_f64arrv(&rp, 3);
rp[0] = buf[0];
rp[1] = buf[1];
rp[2] = b;
return r;
#endif
#if TEST_CELL_FILLS
if (isNum(x)) fullCellFills = o2iG(x);
B r = m_i32(cellFillErrored);
cellFillErrored = 0;
return r;
#endif
#if NATIVE_COMPILER
switchComp();
B r = bqn_exec(x, bi_N);
switchComp();
return r;
#endif
#ifdef TEST_BITCPY
SGetU(x)
bit_cpyN(bitarr_ptr(GetU(x,0)), o2s(GetU(x,1)), bitany_ptr(GetU(x,2)), o2s(GetU(x,3)), o2s(GetU(x,4)));
#endif
return x;
}
B internalTemp_c2(B t, B w, B x) {
#if NATIVE_COMPILER
return c2(native_comp, w, x);
#endif
#ifdef TEST_MUT
SGetU(x)
FILL_TO(tyarr_ptr(w), o2s(GetU(x,0)), o2s(GetU(x,1)), GetU(x,2), o2s(GetU(x,3)));
dec(w);
#endif
return x;
}
B heapDump_c1(B t, B x) {
if (!isArr(x)) {
cbqn_heapDump(NULL);
} else {
char* s = toCStr(x);
cbqn_heapDump(s);
freeCStr(s);
}
return x;
}
B internalGC_c1(B t, B x) {
#if ENABLE_GC
gc_forceGC(false);
dec(x); return m_f64(1);
#else
dec(x); return m_f64(0);
#endif
}
void heap_printInfoStr(char* str);
B vfyStr(B x, char* name, char* arg);
B heapStats_c1(B t, B x) {
if (isC32(x)) {
f64* rp; B r = m_f64arrv(&rp, 2);
rp[0] = mm_heapAlloc;
rp[1] = tot_heapUsed();
return r;
}
vfyStr(x, "•internal.HeapStats", "𝕩");
char* cs = toCStr(x);
heap_printInfoStr(cs);
freeCStr(cs);
return m_f64(1);
}
B iObjFlags_c1(B t, B x) {
u8 r = v(x)->flags;
decG(x);
return m_i32(r);
}
B iObjFlags_c2(B t, B w, B x) {
v(x)->flags = o2iG(w);
return x;
}
B iHasFill_c1(B t, B x) {
B f = getFillR(x);
dec(x);
if (noFill(f)) return m_f64(0);
dec(f);
return m_f64(1);
}
B iPureKeep_c1(B t, B x) { return x; }
B iKeep_c1(B t, B x) { return x; }
B iProperties_c2(B t, B w, B x) {
if (w.u!=m_c32(0).u || x.u != m_c32(0).u) thrM("𝕨 •internal.Properties 𝕩: bad arg");
i32* rp;
B r = m_i32arrv(&rp, 3);
rp[0] = sizeof(usz)*8;
rp[1] = PROPER_FILLS;
rp[2] = EACH_FILLS;
return r;
}
B unshare_c1(B t, B x) {
if (!isArr(x)) thrM("•internal.Unshare 𝕩: 𝕩 must be an array");
B r = unshare(x);
decG(x);
return r;
}
STATIC_GLOBAL B internalNS;
B getInternalNS(void) {
if (internalNS.u == 0) {
#define F(X) v_##X = m_c8vec_0(#X);
FOR_VARIATION(F)
#undef F
listVariations_def = m_c8vec_0("if");
gc_add(listVariations_def);
gc_add_ref(&variation_refs);
#define F(X) gc_add_ref(&v_##X); // 38 refs
FOR_VARIATION(F)
#undef F
#define F(X) incG(bi_##X),
Body* d = m_nnsDesc("type","eltype","refc","squeeze","ispure","info", "keep", "purekeep","listvariations","variation","clearrefs", "hasfill","unshare","deepsqueeze","heapdump","eequal", "gc", "temp","heapstats", "objflags", "properties");
internalNS = m_nns(d,F(itype)F(elType)F(refc)F(squeeze)F(isPure)F(info)F(iKeep)F(iPureKeep)F(listVariations)F(variation)F(clearRefs)F(iHasFill)F(unshare)F(deepSqueeze)F(heapDump)F(eequal)F(internalGC)F(internalTemp)F(heapStats)F(iObjFlags)F(iProperties));
#undef F
gc_add(internalNS);
}
return incG(internalNS);
}