uCBQN/src/sysfn.c
2021-04-25 01:35:52 +03:00

160 lines
4.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 "h.h"
B type_c1(B t, B x) {
i32 r = -1;
if (isArr(x)) r = 0;
else if (isI32(x)) r = 1;
else if (isF64(x)) r = 1;
else if (isC32(x)) r = 2;
else if (isFun(x)) r = 3;
else if (isMd1(x)) r = 4;
else if (isMd2(x)) r = 5;
if (r==-1) return err("getting type");
decR(x);
return m_i32(r);
}
B decp_c1(B t, B x) {
if (!isVal(x)) return m_v2(m_i32(-1), x);
if (v(x)->flags) return m_v2(m_i32(0), x);
return TI(x).decompose(x);
}
usz runtimeLen;
B primInd_c1(B t, B x) {
if (!isVal(x)) return m_i32(runtimeLen);
if (v(x)->flags) { B r = m_i32(v(x)->flags-1); dec(x); return r; }
dec(x);
return m_i32(runtimeLen);
}
B glyph_c1(B t, B x) {
return x;
}
B fill_c1(B t, B x) {
B f = getFill(x);
if (noFill(f)) return m_f64(0); // thrM("No fill found");
return f;
}
B fill_c2(B t, B w, B x) { // TODO not set fill for typed arrays
if (isArr(x)) {
B fill = asFill(w);
if (noFill(fill)) return x;
return withFill(x, fill);
}
dec(w);
return x;
}
B grLen_c1(B t, B x) {
i64 ria = -1;
usz ia = a(x)->ia;
BS2B xget = TI(x).get;
for (usz i = 0; i < ia; i++) {
i64 c = o2i64(xget(x, i));
if (c>ria) ria = c;
}
ria++;
HArr_p r = m_harrv(ria);
for (usz i = 0; i < ria; i++) r.a[i] = m_f64(0);
for (usz i = 0; i < ia; i++) {
i64 n = o2i64(xget(x, i));
if (n>=0) r.a[n].f++;
}
dec(x);
return r.b;
}
B grLen_c2(B t, B w, B x) {
i64 ria = o2i64(w)-1;
usz ia = a(x)->ia;
BS2B xget = TI(x).get;
for (usz i = 0; i < ia; i++) {
i64 c = o2i64(xget(x, i));
if (c>ria) ria = c;
}
ria++;
HArr_p r = m_harrv(ria);
for (usz i = 0; i < ria; i++) r.a[i] = m_f64(0);
for (usz i = 0; i < ia; i++) {
i64 n = o2i64(xget(x, i));
if (n>=0) r.a[n].f++;
}
dec(x);
return r.b;
}
B grOrd_c2(B t, B w, B x) {
usz wia = a(w)->ia;
usz xia = a(x)->ia;
if (wia==0) { dec(w); dec(x); return c1(bi_ud, m_i32(0)); }
if (xia==0) { dec(w); return x; }
BS2B wget = TI(w).get;
BS2B xget = TI(x).get;
usz tmp[wia];
tmp[0] = 0;
for (int i = 1; i < wia; i++) tmp[i] = tmp[i-1]+o2s(wget(w,i-1));
usz ria = tmp[wia-1]+o2s(wget(w,wia-1));
HArr_p r = m_harrv(ria);
for (usz i = 0; i < xia; i++) {
i64 c = o2i64(xget(x,i));
if (c>=0) r.a[tmp[c]++] = m_usz(i);
}
dec(w);
dec(x);
return r.b;
}
B asrt_c1(B t, B x) {
if (isI32(x) && 1==(i32)x.u) return x;
if (isF64(x) && 1==x.f) return x;
dec(x);
thrM("assertion error");
}
B asrt_c2(B t, B w, B x) {
if (isI32(x) && 1==(u32)x.u) { dec(w); return x; }
if (isF64(x) && 1==x.f) { dec(w); return x; }
dec(x);
thr(w);
}
B internal_c2(B t, B w, B x) {
B r;
u64 id = o2s(w);
if(id==0) { char* c = format_type(v(x)->type); r = m_str8(strlen(c), c); }
else if(id==1) { r = m_i32(v(x)->mmInfo); }
else if(id==2) { r = m_i32(v(x)->refc); }
else return err("Unknown •Internal 𝕨");
dec(x);
return r;
}
B sys_c1(B t, B x);
#define ba(N) bi_##N = mm_alloc(sizeof(BFn), t_funBI, ftag(FUN_TAG)); c(Fun,bi_##N)->c2 = N##_c2 ;c(Fun,bi_##N)->c1 = N##_c1 ; c(Fun,bi_##N)->extra=pf_##N; c(BFn,bi_##N)->ident=bi_N; gc_add(bi_##N);
#define bd(N) bi_##N = mm_alloc(sizeof(BFn), t_funBI, ftag(FUN_TAG)); c(Fun,bi_##N)->c2 = N##_c2 ;c(Fun,bi_##N)->c1 = c1_invalid; c(Fun,bi_##N)->extra=pf_##N; c(BFn,bi_##N)->ident=bi_N; gc_add(bi_##N);
#define bm(N) bi_##N = mm_alloc(sizeof(BFn), t_funBI, ftag(FUN_TAG)); c(Fun,bi_##N)->c2 = c2_invalid;c(Fun,bi_##N)->c1 = N##_c1 ; c(Fun,bi_##N)->extra=pf_##N; c(BFn,bi_##N)->ident=bi_N; gc_add(bi_##N);
B bi_type, bi_decp, bi_primInd, bi_glyph, bi_fill, bi_grLen, bi_grOrd, bi_asrt, bi_sys, bi_internal;
static inline void sysfn_init() { bm(type) bm(decp) bm(primInd) bm(glyph) ba(fill) ba(grLen) bd(grOrd) ba(asrt) bm(sys) bd(internal) }
#undef ba
#undef bd
#undef bm
B sys_c1(B t, B x) {
assert(isArr(x));
HArr_p r = m_harrc(x);
BS2B xgetU = TI(x).getU;
for (usz i = 0; i < a(x)->ia; i++) {
B c = xgetU(x,i);
if (eqStr(c, U"internal")) r.a[i] = inc(bi_internal);
else if (eqStr(c, U"eq")) r.a[i] = inc(bi_feq);
else if (eqStr(c, U"decompose")) r.a[i] = inc(bi_decp);
else if (eqStr(c, U"primind")) r.a[i] = inc(bi_primInd);
else if (eqStr(c, U"type")) r.a[i] = inc(bi_type);
else err("Unknown system function");
}
dec(x);
return r.b;
}