#include "../nfns.h" #include "../vm.h" #include "../ns.h" #include "../utils/mut.h" // minimal compiler, capable of running mlochbaum/BQN/src/bootstrap/boot2.bqn // supports: // parentheses, βŸ¨β€¦βŸ© literals, β€’-values // non-destructuring variable assignment // function, 1-modifier, and 2-modifier invocation // value and function class variables, namespace .-access // input must be either an immediate expression, or a block potentially containing 𝕨 or 𝕩 // goal is to either error, or compile correctly B native_comp; #ifndef FAST_NATIVE_COMP #define FAST_NATIVE_COMP 1 #endif NOINLINE B nc_emptyI32Vec() { i32* rp; return m_i32arrv(&rp, 0); } B nc_ivec1(i32 a ) { i32* rp; B r = m_i32arrv(&rp, 1); rp[0]=a; return r; } B nc_ivec2(i32 a, i32 b ) { i32* rp; B r = m_i32arrv(&rp, 2); rp[0]=a; rp[1]=b; return r; } B nc_ivec3(i32 a, i32 b, i32 c) { i32* rp; B r = m_i32arrv(&rp, 3); rp[0]=a; rp[1]=b; rp[2]=c; return r; } NOINLINE void nc_iadd(B* w, i32 x) { // consumes x assert(TY(*w)==t_i32arr); *w = vec_add(*w, m_f64(x)); } NOINLINE void nc_ijoin(B* w, B x) { // doesn't consume x assert(TY(*w)==t_i32arr && TI(x,elType)==el_i32); #if FAST_NATIVE_COMP *w = vec_join(*w, incG(x)); #else SGetU(x) usz ia = IA(x); for (usz i = 0; i < ia; i++) nc_iadd(w, o2i(GetU(x, i))); #endif } #define nc_equal equal NOINLINE void nc_add(B* w, B x) { // consumes x *w = vec_add(*w, x); } NOINLINE B nc_pop(B* wp) { B w = *wp; assert(isArr(w) && v(w)->refc==1 && IA(w)>0); B r = IGetU(w, a(w)->ia-1); a(w)->ia--; #if VERIFY_TAIL assert(TY(w) == t_harr); ux start = offsetof(HArr, a) + a(w)->ia * sizeof(B); FINISH_OVERALLOC(a(w), start, start+sizeof(B)); #endif return r; } NOINLINE B nc_literal(B val) { HArr_p r = m_harr0p(1); r.a[0] = val; arr_shAtm((Arr*)r.c); return r.b; } static bool nc_up(u32 c) { return (c>='A' & c<='Z'); } static bool nc_al(u32 c) { return (c>='a' & c<='z') | nc_up(c); } static bool nc_num(u32 c) { return (c>='0' & c<='9'); } B sys_c1(B, B); NOINLINE B nc_tokenize(B prims, B sysvs, u32* chars, usz len, bool* hasBlock) { B r = emptyHVec(); usz i = 0; usz pi = USZ_MAX; while (i < len) { u32 c = chars[i++]; if (i==pi) thrF("Native compiler: Tokenizer stuck on \\u%xi / %i", c, c); B val; switch (c) { case U'∞': val = nc_literal(m_f64(1.0/0)); break; case U'Ο€': val = nc_literal(m_f64(3.141592653589793)); break; case '@': val = nc_literal(m_c32(0)); break; case ' ': continue; case'0'...'9': case U'Β―': { // numbers bool neg = c==U'Β―'; if (!neg) i--; else if (!nc_num(chars[i])) thrM("Native compiler: Standalone negative sign"); f64 num = 0; while (nc_num(chars[i])) num = num*10 + (chars[i++]-'0'); if (neg) num = -num; val = nc_literal(m_f64(num)); break; } case '"': { // string literal usz i0 = i; while ('"'!=chars[i]) { i++; if (i>=len) thrM("Native compiler: Unclosed string literal"); } if (chars[i+1]=='"') thrM("Native compiler: No support for escaped quote characters in strings"); usz ia = i-i0; u32* vp; val = nc_literal(m_c32arrv(&vp, ia)); memcpy(vp, chars+i0, ia*sizeof(u32)); i++; break; } case '\'': { // character literal if (i+1 >= len || chars[i+1] != '\'') thrM("Native compiler: Unclosed character literal"); val = nc_literal(m_c32(chars[i])); i+= 2; break; } case '#': { // comments while (iβ‰ =≀β‰₯β‰‘β‰’βŠ£βŠ’β₯ŠβˆΎβ‰β‹ˆβ†‘β†“β†•Β«Β»βŒ½β‰/β‹β’βŠβŠ‘βŠβŠ’βˆŠβ·βŠ”!Λ™ΛœΛ˜Β¨βŒœβΌΒ΄Λ`βˆ˜β—‹βŠΈβŸœβŒΎβŠ˜β—ΆβŽ‰βš‡βŸβŽŠ"; usz j = 0; while(primRepr[j]) { if (primRepr[j]==c) { val = nc_literal(IGet(prims, j)); goto add; } j++; } thrF("Native compiler: Can't tokenize \\u%xi / %i", c, c); } } add: nc_add(&r, val); } return r; } usz addObj(B* objs, B val) { // consumes val nc_add(objs, val); return IA(*objs)-1; } i32 nc_ty(B x) { return o2iG(IGetU(x, 0)); } B nc_generate(B p1) { // consumes // printf("p1: "); printI(p1); printf("\n"); usz p1ia = IA(p1); B listFinal; if (p1ia == 1) { // simple case of 1 element listFinal = p1; toFinal:; B elFinal = IGet(listFinal, 0); if(nc_ty(elFinal)>3) thrM("Native compiler: Unexpected assignment"); decG(listFinal); return elFinal; } // merge 1-modifiers SGetU(p1) B p2 = emptyHVec(); { usz i = 0; while (i < p1ia) { B e = incG(GetU(p1, i)); u8 e0t = nc_ty(e); usz j = i+1; if (e0t==4 || e0t==5) goto add; if (!(e0t==0 || e0t==3)) thrM("Native compiler: Unexpected type in expression"); while (j0) { B en1 = GetU(p2, i-1); u8 en1t = nc_ty(en1); // printf("e @ %d: ", i); printI(e); printf("\n"); if (en1t==4 || en1t==5) { // assignment if (!explicit && i!=1) thrM("Native compiler: Assignment in the middle of tacit code"); B bc = nc_emptyI32Vec(); nc_ijoin(&bc, IGetU(e, 1)); nc_ijoin(&bc, IGetU(en1, 1)); if (tyE != o2iG(IGetU(en1, 2))) thrM("Native compiler: Wrong assignment class"); nc_iadd(&bc, en1t==4? SETN : SETU); decG(e); e = m_hvec2(m_f64(explicit? 3 : 0), bc); i-= 1; continue; } if (en1t!=0) thrM("Native compiler: Expected but didn't get function"); if (i>=2) { // dyadic call, fork B en2 = GetU(p2, i-2); if (nc_ty(en2)==3 || (!explicit && nc_ty(en2)==0)) { B bc = nc_emptyI32Vec(); nc_ijoin(&bc, IGetU(e, 1)); nc_ijoin(&bc, IGetU(en1, 1)); nc_ijoin(&bc, IGetU(en2, 1)); nc_iadd(&bc, explicit? FN2O : TR3O); decG(e); e = m_hvec2(m_f64(explicit? 3 : 0), bc); i-= 2; continue; } } // monadic call, atop B bc = nc_emptyI32Vec(); nc_ijoin(&bc, IGetU(e, 1)); nc_ijoin(&bc, IGetU(en1, 1)); nc_iadd(&bc, explicit? FN1O : TR2D); decG(e); e = m_hvec2(m_f64(explicit? 3 : 0), bc); i-= 1; } // printf("e: "); printI(e); printf("\n"); decG(p2); return e; } #if FAST_NATIVE_COMP #include "../utils/hash.h" typedef H_b2i** Vars; u32 nc_var(Vars vars, B name) { // doesn't consume bool had; u64 p = mk_b2i(vars, name, &had); if (had) return (*vars)->a[p].val; return (*vars)->a[p].val = (*vars)->pop-1; } #else typedef B* Vars; u32 nc_var(Vars vars, B name) { // doesn't consume B o = *vars; usz ia = IA(o); SGetU(o) for (usz i = 0; i < ia; i++) if (nc_equal(GetU(o, i), name)) return i; nc_add(vars, incG(name)); return ia; } #endif B nc_parseStatements(B tokens, usz i0, usz* i1, u32 close, B* objs, Vars vars) { SGetU(tokens) usz tia = IA(tokens); usz i = i0; B statements = emptyHVec(); B parts = emptyHVec(); // list of lists; first element indicates class: 0:fn; 1:md1; 2:md2; 3:subject; 4:v←; 5:v↩ while (true) { B ct; if (i==tia) ct = m_c32(0); else ct = GetU(tokens, i++); // printf("next token: "); printI(ct); printf("\n"); if (isC32(ct)) { u32 ctc = o2cG(ct); if (ctc=='\0' || ctc==close || ctc==',') { if (IA(parts)>0) { nc_add(&statements, nc_generate(parts)); parts = emptyHVec(); } if (ctc==close) { decG(parts); break; } if (ctc=='\0') thrM("Native compiler: Unclosed"); if (close==U')') thrM("Native compiler: Multiple statements in parens"); } else if (ctc=='(' || ctc==U'⟨') { usz iM; B res = nc_parseStatements(tokens, i, &iM, ctc=='('? ')' : U'⟩', objs, vars); i = iM; nc_add(&parts, res); } else if (ctc==U'{' || ctc==U'}') { thrM("Native compiler: Nested blocks aren't supported"); } else if (ctc==U'←' || ctc==U'↩') { thrM("Native compiler: Invalid assignment"); } else if (ctc=='.') { if (IA(parts)==0 || i==i0+1) thrM("Native compiler: Expected value before '.'"); B ns = nc_pop(&parts); if (nc_ty(ns) != 3) thrM("Native compiler: Expected subject before '.'"); if (i==tia) thrM("Native compiler: Expression ended with '.'"); B name = GetU(tokens, i++); if (!isArr(name) || RNK(name)!=1) thrM("Native compiler: Expected name to follow '.'"); B bc = nc_emptyI32Vec(); nc_ijoin(&bc, IGetU(ns, 1)); decG(ns); nc_iadd(&bc, FLDG); nc_iadd(&bc, str2gid(IGetU(name,1))); nc_add(&parts, m_hvec2(IGet(name,0), bc)); } else thrF("Native compiler: Unexpected character token \\u%xi / %i", ctc, ctc); } else if (isArr(ct)) { if (RNK(ct)==0) { // literal B val = IGetU(ct, 0); usz j = addObj(objs, inc(val)); i32 type = isFun(val)? 0 : isMd1(val)? 1 : isMd2(val)? 2 : 3; nc_add(&parts, m_hvec2(m_f64(type), nc_ivec2(PUSH, j))); } else { // name u8 ty = nc_ty(ct); u8 rty = ty; assert(ty<=3); if (ipop; free_b2i(vars0); #else *varCount = IA(vars0); decG(vars0); #endif i1 = nc_skipSeparators(tokens, i1); if (i1 != IA(tokens)) thrM("Native compiler: Code present after block end"); B r = TO_GET(r0, 1); decG(toFree); return r; } B nativeComp_c2(B t, B w, B x) { SGetU(w) B prims = GetU(w,0); B sysvs = GetU(w,1); bool fnBlock = false; // tokenize usz xia = IA(x); u32* xBuf; B xBufO = m_c32arrv(&xBuf, xia+1); SGetU(x) for (usz i = 0; i < xia; i++) xBuf[i] = o2c(GetU(x, i)); xBuf[xia] = 0; B tokens = nc_tokenize(prims, sysvs, xBuf, xia, &fnBlock); decG(xBufO); // parse B objs = emptyHVec(); i32* bc0; B bytecode = m_i32arrv(&bc0, fnBlock? 3 : 0); usz i0 = nc_skipSeparators(tokens, 0); bool anyBlock = i0