#include "../core.h" #include "../utils/hash.h" #include "../utils/file.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) { print(x); 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); } B primInd_c1(B t, B x) { if (!isVal(x)) return m_i32(rtLen); if (v(x)->flags) { B r = m_i32(v(x)->flags-1); dec(x); return r; } dec(x); return m_i32(rtLen); } B glyph_c1(B t, B x) { return x; } B repr_c1(B t, B x) { #define BL 100 if (isF64(x)) { char buf[BL]; snprintf(buf, BL, "%g", x.f); return m_str8(strlen(buf), buf); } else { #ifdef FORMATTER return bqn_repr(x); #else thrM("•Repr: Cannot represent non-numbers"); #endif } } B fill_c1(B t, B x) { B r = getFillE(x); dec(x); return r; } 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_both(i64 ria, B x) { usz ia = a(x)->ia; BS2B xgetU = TI(x).getU; for (usz i = 0; i < ia; i++) { i64 c = o2i64u(xgetU(x, i)); if (c>ria) ria = c; } if (ria>USZ_MAX-1) thrOOM(); ria++; i32* rp; B r = m_i32arrv(&rp, ria); for (usz i = 0; i < ria; i++) rp[i] = 0; for (usz i = 0; i < ia; i++) { i64 n = o2i64u(xgetU(x, i)); if (n>=0) rp[n]++; assert(n>=-1); } dec(x); return r; } B grLen_c1(B t, B x) { return grLen_both( -1, x); } // assumes valid arguments B grLen_c2(B t, B w, B x) { return grLen_both(o2i64u(w)-1, x); } // assumes valid arguments B grOrd_c2(B t, B w, B x) { // assumes valid arguments usz wia = a(w)->ia; usz xia = a(x)->ia; if (wia==0) { dec(w); dec(x); return inc(bi_emptyIVec); } if (xia==0) { dec(w); return x; } BS2B wgetU = TI(w).getU; BS2B xgetU = TI(x).getU; TALLOC(usz, tmp, wia); tmp[0] = 0; for (usz i = 1; i < wia; i++) tmp[i] = tmp[i-1]+o2su(wgetU(w,i-1)); usz ria = tmp[wia-1]+o2su(wgetU(w,wia-1)); i32* rp; B r = m_i32arrv(&rp, ria); if (xia>=I32_MAX) thrM("⊔: Too large"); for (usz i = 0; i < xia; i++) { i64 c = o2i64(xgetU(x,i)); if (c>=0) rp[tmp[c]++] = i; } dec(w); dec(x); TFREE(tmp); return r; } 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); } bool isPureFn(B x); B internal_c2(B t, B w, B x) { B r; i32 id = o2i(w); if(id==0) { if(isVal(x)) { char* c = format_type(v(x)->type); r = m_str8(strlen(c), c); } 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 r = m_str32(U"tagged unknown"); } } else if(id==1) { r = isVal(x)? m_i32(v(x)->mmInfo & 0x7f) : m_str32(U"(not heap-allocated)"); } else if(id==2) { r = isVal(x)? m_i32(v(x)->refc) : m_str32(U"(not heap-allocated)"); } else if(id==3) { printf("%p\n", (void*)x.u); r = inc(x); } else if(id==4) { r = m_f64(isPureFn(x)); } else if(id==5) { r = bqn_squeeze(inc(x)); } else { dec(x); thrF("•Internal: 𝕨≡%i is invalid", id); } dec(x); return r; } B sys_c1(B t, B x); B out_c1(B t, B x) { printRaw(x); putchar('\n'); return x; } B show_c1(B t, B x) { #ifdef FORMATTER B fmt = bqn_fmt(inc(x)); printRaw(fmt); dec(fmt); #else print(x); #endif putchar('\n'); return x; } B bqn_c1(B t, B x) { if (isAtm(x) || rnk(x)!=1) thrM("•BQN: Argument must be a character vector"); if (a(x)->type!=t_c32arr && a(x)->type!=t_c32slice) { usz ia = a(x)->ia; BS2B xgetU = TI(x).getU; for (usz i = 0; i < ia; i++) if (!isC32(xgetU(x,i))) thrM("•BQN: Argument must be a character vector"); } return bqn_exec(x, bi_N, bi_N); } B cmp_c2(B t, B w, B x) { B r = m_i32(compare(w, x)); dec(w); dec(x); return r; } B hash_c2(B t, B w, B x) { u64 secret[4]; make_secret(o2i64(w), secret); u64 rv = bqn_hash(x, secret); dec(x); i32* rp; B r = m_i32arrv(&rp, 4); rp[0] = (u16)(rv>>48); rp[1] = (u16)(rv>>32); rp[2] = (u16)(rv>>16); rp[3] = (u16)(rv ); return r; } B hash_c1(B t, B x) { u64 rv = bqn_hash(x, wy_secret); dec(x); i32* rp; B r = m_i32arrv(&rp, 4); rp[0] = (u16)(rv>>48); rp[1] = (u16)(rv>>32); rp[2] = (u16)(rv>>16); rp[3] = (u16)(rv ); return r; } static B makeRel(B md) { // doesn't consume return m1_d(inc(md), path_dir(inc(comp_currPath))); } B sys_c1(B t, B x) { assert(isArr(x)); usz i = 0; HArr_p r = m_harrs(a(x)->ia, &i); BS2B xgetU = TI(x).getU; for (; i < a(x)->ia; i++) { B c = xgetU(x,i); if (eqStr(c, U"out")) r.a[i] = inc(bi_out); else if (eqStr(c, U"show")) r.a[i] = inc(bi_show); else if (eqStr(c, U"internal")) r.a[i] = inc(bi_internal); else if (eqStr(c, U"type")) r.a[i] = inc(bi_type); 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"bqn")) r.a[i] = inc(bi_bqn); else if (eqStr(c, U"cmp")) r.a[i] = inc(bi_cmp); else if (eqStr(c, U"timed")) r.a[i] = inc(bi_timed); else if (eqStr(c, U"hash")) r.a[i] = inc(bi_hash); else if (eqStr(c, U"repr")) r.a[i] = inc(bi_repr); else if (eqStr(c, U"fchars")) r.a[i] = makeRel(bi_fchars); else if (eqStr(c, U"fbytes")) r.a[i] = makeRel(bi_fbytes); else if (eqStr(c, U"flines")) r.a[i] = makeRel(bi_flines); else if (eqStr(c, U"import")) r.a[i] = makeRel(bi_import); else if (eqStr(c, U"args")) { if(isNothing(comp_currArgs)) thrM("No arguments present for •args"); r.a[i] = inc(comp_currArgs); } else { dec(x); thrF("Unknown system function •%R", c); } } return harr_fcd(r, x); }