uCBQN/src/builtins/internal.c
2021-06-01 22:12:34 +03:00

245 lines
7.2 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/mut.h"
B itype_c1(B t, B x) {
B r;
if(isVal(x)) {
r = m_str8l(format_type(v(x)->type));
} else {
if (isF64(x)) r = m_str32(U"tagged f64");
else if (isI32(x)) r = m_str32(U"tagged i32");
else if (isC32(x)) r = m_str32(U"tagged c32");
else if (isTag(x)) r = m_str32(U"tagged tag");
else if (isVar(x)) r = m_str32(U"tagged var");
else if (isExt(x)) r = m_str32(U"tagged extvar");
else r = m_str32(U"tagged unknown");
}
dec(x);
return r;
}
B refc_c1(B t, B x) {
B r = isVal(x)? m_i32(v(x)->refc) : m_str32(U"(not heap-allocated)");
dec(x);
return r;
}
B squeeze_c1(B t, B x) {
if (!isArr(x)) return x;
return bqn_squeeze(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 = inc(bi_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 ", xv->type, format_type(xv->type));
AFMT("alloc:%l", mm_size(xv));
dec(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);
}
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 = a(w)->ia;
BS2B wgetU = TI(w).getU;
bool c_incr=false, c_rmFill=false;
for (usz i = 0; i < wia; i++) {
u32 c = o2c(wgetU(w, i));
if (c=='i') c_incr=true;
else if (c=='f') c_rmFill=true;
else thrF("internal.ListVariations: Unknown option '%c' in 𝕨", c);
}
dec(w);
B xf = getFillQ(x);
bool ah = c_rmFill || noFill(xf);
bool ai32=false, af64=false, ac32=false;
usz xia = a(x)->ia;
BS2B xgetU = TI(x).getU;
if (isNum(xf)) {
ai32=af64=true;
for (usz i = 0; i < xia; i++) {
B c = xgetU(x, i);
if (!isNum(c)) { ai32=af64=false; break; }
if (!q_i32(c)) ai32=false;
}
} else if (isC32(xf)) {
ac32=true;
for (usz i = 0; i < xia; i++) {
B c = xgetU(x, i);
if (!isC32(c)) { ac32=false; break; }
}
} else ai32=af64=false;
B r = inc(bi_emptyHVec);
if(ai32) { r=vec_add(r,m_str32(U"Ai32")); r=vec_add(r,m_str32(U"Si32")); if(c_incr) {r=vec_add(r,m_str32(U"Ai32Inc")); r=vec_add(r,m_str32(U"Si32Inc"));} }
if(af64) { r=vec_add(r,m_str32(U"Af64")); r=vec_add(r,m_str32(U"Sf64")); if(c_incr) {r=vec_add(r,m_str32(U"Af64Inc")); r=vec_add(r,m_str32(U"Sf64Inc"));} }
if(ac32) { r=vec_add(r,m_str32(U"Ac32")); r=vec_add(r,m_str32(U"Sc32")); if(c_incr) {r=vec_add(r,m_str32(U"Ac32Inc")); r=vec_add(r,m_str32(U"Sc32Inc"));} }
if(ah) { r=vec_add(r,m_str32(U"Ah" )); r=vec_add(r,m_str32(U"Sh" )); if(c_incr) {r=vec_add(r,m_str32(U"AhInc")); r=vec_add(r,m_str32(U"ShInc")); } }
{ r=vec_add(r,m_str32(U"Af" )); r=vec_add(r,m_str32(U"Sf" )); if(c_incr) {r=vec_add(r,m_str32(U"AfInc")); r=vec_add(r,m_str32(U"SfInc")); } }
dec(x);
dec(xf);
return r;
}
B listVariations_c1(B t, B x) {
return listVariations_c2(t, m_str32(U"if"), x);
}
static bool u32_get(u32** cv, u32* cE, u32* x) {
u32* c = *cv;
while (true) {
if (!*x) {
*cv = c;
return true;
}
if (c==cE || *c!=*x) return false;
c++; x++;
}
}
static B variation_refs;
static bool variation_rootAdded;
static void variation_root() {
mm_visit(variation_refs);
}
B variation_c2(B t, B w, B x) {
if (!isArr(x)) thrM("•internal.Variation: Non-array 𝕩");
usz xia = a(x)->ia;
BS2B xget = TI(x).get;
BS2B xgetU = TI(x).getU;
C32Arr* wc = toC32Arr(w);
u32* wp = wc->a;
u32* wpE = wp+wc->ia;
if (wc->ia==0) thrM("•internal.Variation: Zero-length 𝕨");
B res;
if (*wp == 'A' || *wp == 'S') {
bool slice = *wp == 'S';
wp++;
if (u32_get(&wp, wpE, U"i32")) {
i32* tp; res = m_i32arrc(&tp, x);
for (usz i = 0; i < xia; i++) tp[i] = o2i(xgetU(x,i));
} else if (u32_get(&wp, wpE, U"f64")) {
f64* tp; res = m_f64arrc(&tp, x);
for (usz i = 0; i < xia; i++) tp[i] = o2f(xgetU(x,i));
} else if (u32_get(&wp, wpE, U"c32")) {
u32* tp; res = m_c32arrc(&tp, x);
for (usz i = 0; i < xia; i++) tp[i] = o2c(xgetU(x,i));
} else if (u32_get(&wp, wpE, U"h")) {
HArr_p t = m_harrUc(x);
for (usz i = 0; i < xia; i++) t.a[i] = xget(x,i);
res = t.b;
} else if (u32_get(&wp, wpE, U"f")) {
res = m_fillarrp(xia);
fillarr_setFill(res, getFillQ(x));
arr_shCopy(res, x);
B* rp = fillarr_ptr(res);
for (usz i = 0; i < xia; i++) rp[i] = xget(x,i);
} else thrF("•internal.Variation: Bad type \"%R\"", tag(wc,ARR_TAG));
if (slice) {
B slice = TI(res).slice(res, 0);
arr_shCopy(slice, res);
res = slice;
}
if (u32_get(&wp, wpE, U"Inc")) {
if (!variation_refs.u) {
variation_refs = inc(bi_emptyHVec);
if (!variation_rootAdded) { gc_addFn(variation_root); variation_rootAdded = true; }
}
variation_refs = vec_add(variation_refs, inc(res));
}
if (wp!=wpE) thrM("•internal.Variation: Bad 𝕨");
} else thrM("•internal.Variation: Bad start of 𝕨");
dec(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 = a(variation_refs)->ia;
dec(variation_refs);
variation_refs = m_f64(0);
return m_f64(res);
}
static B unshare(B x) {
if (!isArr(x)) return x;
usz xia = a(x)->ia;
switch (v(x)->type) {
case t_i32arr: {
i32* rp; B r = m_i32arrc(&rp, x);
memcpy(rp, i32arr_ptr(x), xia*4);
return r;
}
case t_c32arr: {
u32* rp; B r = m_c32arrc(&rp, x);
memcpy(rp, c32arr_ptr(x), xia*4);
return r;
}
case t_f64arr: {
f64* rp; B r = m_f64arrc(&rp, x);
memcpy(rp, f64arr_ptr(x), xia*8);
return r;
}
case t_harr: {
HArr_p r = m_harrUc(x);
B* xp = harr_ptr(x);
for (usz i = 0; i < xia; i++) r.a[i] = unshare(xp[i]);
return r.b;
}
case t_fillarr: {
B r = m_fillarrp(xia); arr_shCopy(r, x);
fillarr_setFill(r, unshare(c(FillArr,x)->fill));
B* rp = fillarr_ptr(r); B* xp = fillarr_ptr(x);
for (usz i = 0; i < xia; i++) rp[i] = unshare(xp[i]);
return r;
}
default: thrF("•internal.Unshare: Cannot unshare array with type %i=%S", v(x)->type, format_type((v(x)->type)));
}
}
B unshare_c1(B t, B x) {
if (!isArr(x)) thrM("•internal.Unshare: Argument must be an array");
B r = unshare(x);
dec(x);
return r;
}
static B internalNS;
B getInternalNS() {
if (internalNS.u == 0) {
#define F(X) inc(bi_##X),
B fn = bqn_exec(m_str32(U"{⟨ Type, Refc, Squeeze, IsPure, Info, ListVariations, Variation, ClearRefs, Unshare⟩⇐𝕩}"), inc(bi_emptyCVec), inc(bi_emptySVec));
B arg = m_caB(9, (B[]){F(itype)F(refc)F(squeeze)F(isPure)F(info)F(listVariations)F(variation)F(clearRefs)F(unshare)});
#undef F
internalNS = c1(fn,arg);
gc_add(internalNS);
dec(fn);
}
return inc(internalNS);
}