inverse headers
This commit is contained in:
parent
896049ab12
commit
f55e349999
2
makefile
2
makefile
@ -115,7 +115,7 @@ ${bd}/%.o: src/jit/%.c
|
||||
@echo $< | cut -c 5-
|
||||
@$(CMD) $@.d -o $@ -c $<
|
||||
|
||||
builtins: ${addprefix ${bd}/, arithm.o arithd.o cmp.o sfns.o sort.o md1.o md2.o fns.o sysfn.o internal.o}
|
||||
builtins: ${addprefix ${bd}/, arithm.o arithd.o cmp.o sfns.o sort.o md1.o md2.o fns.o sysfn.o internal.o inverse.o}
|
||||
${bd}/%.o: src/builtins/%.c
|
||||
@echo $< | cut -c 5-
|
||||
@$(CMD) $@.d -o $@ -c $<
|
||||
|
||||
@ -10,6 +10,7 @@
|
||||
/* sysfn.c*/M(type,"•Type") M(decp,"•Decompose") M(primInd,"•PrimInd") M(glyph,"•Glyph") A(fill,"•FillFn") M(sys,"•getsys") A(grLen,"•GroupLen") D(grOrd,"•GroupOrd") \
|
||||
/* sysfn.c*/M(repr,"•Repr") M(fmt,"•Fmt") A(asrt,"!") A(casrt,"!") M(out,"•Out") M(show,"•Show") A(bqn,"•BQN") A(sh,"•SH") M(fromUtf8,"•FromUTF8") \
|
||||
/* sysfn.c*/D(cmp,"•Cmp") A(hash,"•Hash") M(unixTime,"•UnixTime") M(monoTime,"•MonoTime") M(delay,"•Delay") M(makeRand,"•MakeRand") M(reBQN,"•ReBQN") M(exit,"•Exit") M(getLine,"•GetLine") \
|
||||
/* inverse.c*/M(setInvReg, "(SetInvReg)") M(setInvSwap, "(SetInvSwap)") M(nativeInvReg, "(NativeInvReg)") M(nativeInvSwap, "(NativeInvSwap)") \
|
||||
/*internal.c*/M(itype,"•internal.Type") M(elType,"•internal.ElType") M(refc,"•internal.Refc") M(isPure,"•internal.IsPure") A(info,"•internal.Info") \
|
||||
/*internal.c*/M(squeeze,"•internal.Squeeze") M(deepSqueeze,"•internal.DeepSqueeze") \
|
||||
/*internal.c*/D(variation,"•internal.Variation") A(listVariations,"•internal.ListVariations") M(clearRefs,"•internal.ClearRefs") M(unshare,"•internal.Unshare")
|
||||
@ -34,6 +35,7 @@ enum PrimNumbers {
|
||||
/* ´˝`∘○⊸⟜⌾⊘◶ */ n_fold , n_reduce , n_scan , n_atop , n_over , n_before , n_after , n_under, n_val , n_cond,
|
||||
/* ⎉⚇⍟⎊ */ n_cells , n_depth2 , n_repeat, n_catch
|
||||
};
|
||||
extern B rt_invFnReg, rt_invFnSwap;
|
||||
|
||||
enum PrimFns { pf_none,
|
||||
#define F(N,X) pf_##N,
|
||||
|
||||
42
src/builtins/inverse.c
Normal file
42
src/builtins/inverse.c
Normal file
@ -0,0 +1,42 @@
|
||||
#include "../core.h"
|
||||
#include "../builtins.h"
|
||||
#include "../nfns.h"
|
||||
|
||||
|
||||
static NFnDesc* fun_invRegDesc;
|
||||
static NFnDesc* fun_invSwapDesc;
|
||||
|
||||
B fun_invReg_c1(B t, B x) {
|
||||
B f = nfn_objU(t);
|
||||
return TI(f, fn_im)(f, x);
|
||||
}
|
||||
B fun_invReg_c2(B t, B w, B x) {
|
||||
B f = nfn_objU(t);
|
||||
return TI(f, fn_ix)(f, w, x);
|
||||
}
|
||||
|
||||
B fun_invSwap_c1(B t, B x) {
|
||||
B f = nfn_objU(t);
|
||||
return TI(f, fn_is)(f, x);
|
||||
}
|
||||
B fun_invSwap_c2(B t, B w, B x) {
|
||||
B f = nfn_objU(t);
|
||||
return TI(f, fn_iw)(f, w, x);
|
||||
}
|
||||
|
||||
|
||||
B setInvReg_c1 (B t, B x) { rt_invFnReg = x; return inc(bi_nativeInvReg); }
|
||||
B setInvSwap_c1(B t, B x) { rt_invFnSwap = x; return inc(bi_nativeInvSwap); }
|
||||
B nativeInvReg_c1(B t, B x) {
|
||||
if (isFun(x)) return m_nfn(fun_invRegDesc, x);
|
||||
return c1(rt_invFnReg, x);
|
||||
}
|
||||
B nativeInvSwap_c1(B t, B x) {
|
||||
if (isFun(x)) return m_nfn(fun_invSwapDesc, x);
|
||||
return c1(rt_invFnSwap, x);
|
||||
}
|
||||
|
||||
void inverse_init() {
|
||||
fun_invRegDesc = registerNFn(m_str8l("(fun_invReg)"), fun_invReg_c1, fun_invReg_c2);
|
||||
fun_invSwapDesc = registerNFn(m_str8l("(fun_invSwap)"), fun_invSwap_c1, fun_invSwap_c2);
|
||||
}
|
||||
@ -36,7 +36,7 @@ void heapVerify() {
|
||||
heapVerify_mode=1; mm_forHeap(heapVerify_callVisit); gc_visitRoots();
|
||||
if (heap_observed) {
|
||||
printf("refc of last: %d\n", heap_observed->refc);
|
||||
heapVerify_mode=2; mm_forHeap(heap_getReferents);
|
||||
// heapVerify_mode=2; mm_forHeap(heap_getReferents);
|
||||
}
|
||||
heapVerify_mode=-1;
|
||||
}
|
||||
|
||||
8
src/h.h
8
src/h.h
@ -194,8 +194,10 @@ typedef union B {
|
||||
/*32*/ F(comp) F(block) F(body) F(scope) F(scopeExt) F(blBlocks) \
|
||||
/*38*/ F(ns) F(nsDesc) F(fldAlias) F(vfyObj) F(hashmap) F(temp) F(nfn) F(nfnDesc) \
|
||||
/*46*/ F(freed) F(harrPartial) \
|
||||
/*48*/ F(fun_invReg ) F(md1_invReg ) F(md2_invReg ) \
|
||||
/*51*/ F(fun_invSwap) F(md1_invSwap) F(md2_invSwap) \
|
||||
\
|
||||
/*48*/ IF_RT_WRAP(F(funWrap) F(md1Wrap) F(md2Wrap))
|
||||
/*54*/ IF_RT_WRAP(F(funWrap) F(md1Wrap) F(md2Wrap))
|
||||
|
||||
enum Type {
|
||||
#define F(X) t_##X,
|
||||
@ -447,6 +449,10 @@ typedef B (*M2C2)(Md2D*, B, B);
|
||||
F( BBBBB2B, m1_ucw) /* t,o,f, w,x→r; r≡O⌾(w⊸(F _T )) x; consumes w,x */ \
|
||||
F( BBBBB2B, m2_uc1) /* t,o,f,g, x→r; r≡O⌾( F _T_ G ) x; consumes x */ \
|
||||
F(BBBBBB2B, m2_ucw) /* t,o,f,g,w,x→r; r≡O⌾(w⊸(F _T_ G)) x; consumes w,x */ \
|
||||
F( BB2B, fn_im) /* t, x; function monadic inverse; consumes x */ \
|
||||
F( BB2B, fn_is) /* t, x; function equal-arg inverse; consumes x */ \
|
||||
F( BBB2B, fn_iw) /* t,w,x; function dyadic 𝕨-inverse; consumes w,x */ \
|
||||
F( BBB2B, fn_ix) /* t,w,x; function dyadic 𝕩-inverse; consumes w,x */ \
|
||||
\
|
||||
F(B2b, canStore) /* doesn't consume */ \
|
||||
F(u8, elType) /* guarantees that the corresponding i32any_ptr/f64any_ptr/c32any_ptr/… always succeeds */ \
|
||||
|
||||
25
src/load.c
25
src/load.c
@ -5,7 +5,7 @@
|
||||
#include "ns.h"
|
||||
#include "builtins.h"
|
||||
|
||||
#define FOR_INIT(F) F(base) F(harr) F(mutF) F(fillarr) F(tyarr) F(hash) F(sfns) F(fns) F(arith) F(md1) F(md2) F(derv) F(comp) F(rtWrap) F(ns) F(nfn) F(sysfn) F(load) F(sysfnPost) F(dervPost)
|
||||
#define FOR_INIT(F) F(base) F(harr) F(mutF) F(fillarr) F(tyarr) F(hash) F(sfns) F(fns) F(arith) F(md1) F(md2) F(derv) F(comp) F(rtWrap) F(ns) F(nfn) F(sysfn) F(inverse) F(load) F(sysfnPost) F(dervPost)
|
||||
#define F(X) void X##_init(void);
|
||||
FOR_INIT(F)
|
||||
#undef F
|
||||
@ -148,6 +148,8 @@ void load_gcFn() {
|
||||
mm_visit(comp_currPath);
|
||||
mm_visit(comp_currArgs);
|
||||
mm_visit(comp_currSrc);
|
||||
mm_visit(rt_invFnReg);
|
||||
mm_visit(rt_invFnSwap);
|
||||
}
|
||||
NOINLINE Block* bqn_comp(B str, B path, B args) { // consumes all
|
||||
B prevPath = comp_currPath ; comp_currPath = path;
|
||||
@ -267,9 +269,15 @@ void load_init() { // very last init function
|
||||
#endif
|
||||
|
||||
B rtRes = m_funBlock(runtime_b, 0); ptr_dec(runtime_b);
|
||||
B rtObjRaw = IGet(rtRes,0);
|
||||
B rtFinish = IGet(rtRes,1);
|
||||
SGet(rtRes);
|
||||
B rtObjRaw = Get(rtRes,0);
|
||||
B setPrims = Get(rtRes,1);
|
||||
B setInv = Get(rtRes,2);
|
||||
dec(rtRes);
|
||||
dec(c1(setPrims, m_hVec2(incG(bi_decp), incG(bi_primInd)))); dec(setPrims);
|
||||
dec(c2(setInv, incG(bi_setInvSwap), incG(bi_setInvReg))); dec(setInv);
|
||||
|
||||
|
||||
|
||||
if (c(Arr,rtObjRaw)->ia != rtLen) err("incorrectly defined rtLen!");
|
||||
HArr_p runtimeH = m_harrUc(rtObjRaw);
|
||||
@ -312,7 +320,6 @@ void load_init() { // very last init function
|
||||
dec(rtObjRaw);
|
||||
B* runtime = runtimeH.a;
|
||||
B rtObj = runtimeH.b;
|
||||
dec(c1(rtFinish, m_hVec2(incG(bi_decp), incG(bi_primInd)))); dec(rtFinish);
|
||||
load_rtObj = FAKE_RUNTIME? frtObj : rtObj;
|
||||
load_compArg = m_hVec2(load_rtObj, incG(bi_sys)); gc_add(FAKE_RUNTIME? rtObj : frtObj);
|
||||
gc_add(load_compArg);
|
||||
@ -399,6 +406,12 @@ static B def_m1_d(B m, B f ) { thrM("cannot derive this"); }
|
||||
static B def_m2_d(B m, B f, B g) { thrM("cannot derive this"); }
|
||||
static Arr* def_slice(B x, usz s, usz ia) { thrM("cannot slice non-array!"); }
|
||||
|
||||
B rt_invFnReg, rt_invFnSwap;
|
||||
B def_fn_im(B t, B x) { B fn = c(Fun,rt_invFnReg )->c1(rt_invFnReg, inc(t)); B r = c1(fn, x); dec(fn); return r; }
|
||||
B def_fn_is(B t, B x) { B fn = c(Fun,rt_invFnSwap)->c1(rt_invFnSwap, inc(t)); B r = c1(fn, x); dec(fn); return r; }
|
||||
B def_fn_iw(B t, B w, B x) { B fn = c(Fun,rt_invFnSwap)->c1(rt_invFnSwap, inc(t)); B r = c2(fn, w, x); dec(fn); return r; }
|
||||
B def_fn_ix(B t, B w, B x) { B fn = c(Fun,rt_invFnReg )->c1(rt_invFnReg, inc(t)); B r = c2(fn, w, x); dec(fn); return r; }
|
||||
|
||||
#ifdef DONT_FREE
|
||||
static B empty_get(Arr* x, usz n) {
|
||||
x->type = x->flags;
|
||||
@ -437,6 +450,10 @@ void base_init() { // very first init function
|
||||
TIi(i,m1_ucw) = def_m1_ucw;
|
||||
TIi(i,m2_uc1) = def_m2_uc1;
|
||||
TIi(i,m2_ucw) = def_m2_ucw;
|
||||
TIi(i,fn_im) = def_fn_im;
|
||||
TIi(i,fn_is) = def_fn_is;
|
||||
TIi(i,fn_iw) = def_fn_iw;
|
||||
TIi(i,fn_ix) = def_fn_ix;
|
||||
}
|
||||
TIi(t_empty,freeO) = empty_free; TIi(t_freed,freeO) = def_freeO;
|
||||
TIi(t_empty,freeF) = empty_free; TIi(t_freed,freeF) = def_freeF;
|
||||
|
||||
@ -14,8 +14,10 @@ NFnDesc* registerNFn(B name, BB2B c1, BBB2B c2); // should be called a constant
|
||||
B m_nfn(NFnDesc* desc, B obj); // consumes obj
|
||||
B nfn_name(B x); // doesn't consume
|
||||
static B nfn_objU(B t) {
|
||||
assert(isVal(t) && v(t)->type == t_nfn);
|
||||
return c(NFn,t)->obj;
|
||||
}
|
||||
static i32 nfn_data(B t) {
|
||||
assert(isVal(t) && v(t)->type == t_nfn);
|
||||
return c(NFn,t)->data;
|
||||
}
|
||||
|
||||
@ -23,6 +23,7 @@
|
||||
#include "../builtins/md1.c"
|
||||
#include "../builtins/md2.c"
|
||||
#include "../builtins/internal.c"
|
||||
#include "../builtins/inverse.c"
|
||||
#include "../vm.c"
|
||||
#include "../ns.c"
|
||||
#include "../nfns.c"
|
||||
|
||||
148
src/vm.c
148
src/vm.c
@ -102,11 +102,15 @@ static Body* m_body(i32 vam, i32 pos, u32 maxStack, u16 maxPSC) { // leaves varI
|
||||
body->varAm = (u16)vam;
|
||||
return body;
|
||||
}
|
||||
|
||||
|
||||
|
||||
typedef struct NextRequest {
|
||||
u32 off; // offset into bytecode where the two integers must be inserted
|
||||
u32 pos1; // offset into bodyI/bodyMap of what's wanted for monadic
|
||||
u32 pos2; // ↑ for dyadic; U32_MAX if not wanted
|
||||
} NextRequest;
|
||||
|
||||
Block* compileBlock(B block, Comp* comp, bool* bDone, u32* bc, usz bcIA, B allBlocks, B allBodies, B nameList, Scope* sc, i32 depth) {
|
||||
usz blIA = a(block)->ia;
|
||||
if (blIA!=3) thrM("VM compiler: Bad block info size");
|
||||
@ -116,69 +120,80 @@ Block* compileBlock(B block, Comp* comp, bool* bDone, u32* bc, usz bcIA, B allBl
|
||||
B bodyObj = GetU(block,2);
|
||||
i32 argAm = argCount(ty, imm);
|
||||
|
||||
i32* bodyI;
|
||||
i32 bodyAm1, bodyAm2, bodyILen;
|
||||
if (isArr(bodyObj)) {
|
||||
usz boia = a(bodyObj)->ia;
|
||||
if (boia!=1 && boia!=2) thrM("VM compiler: Unexpected body list length");
|
||||
// print(bodyObj); putchar('\n');
|
||||
SGetU(bodyObj)
|
||||
B b1 = GetU(bodyObj,0);
|
||||
B b2 = boia==1? b1 : GetU(bodyObj,1);
|
||||
if (!isArr(b1) || !isArr(b2)) thrM("VM compiler: Body list contained non-arrays");
|
||||
bodyAm1 = a(b1)->ia; SGetU(b1)
|
||||
bodyAm2 = a(b2)->ia; SGetU(b2)
|
||||
bodyILen = bodyAm1+bodyAm2;
|
||||
TALLOC(i32, bodyInds_, bodyILen+2); bodyI = bodyInds_; i32* bodyI2 = bodyInds_+bodyAm1+1;
|
||||
for (i32 i = 0; i < bodyAm1; i++) bodyI [i] = o2i(GetU(b1, i));
|
||||
for (i32 i = 0; i < bodyAm2; i++) bodyI2[i] = o2i(GetU(b2, i));
|
||||
for (i32 i = 1; i < bodyAm1; i++) if (bodyI [i]<=bodyI [i-1]) thrM("VM compiler: Expected body indices to be sorted");
|
||||
for (i32 i = 1; i < bodyAm2; i++) if (bodyI2[i]<=bodyI2[i-1]) thrM("VM compiler: Expected body indices to be sorted");
|
||||
bodyI[bodyAm1] = bodyI[bodyILen+1] = I32_MAX;
|
||||
} else {
|
||||
bodyILen = 2;
|
||||
TALLOC(i32, bodyInds_, bodyILen+2); bodyI = bodyInds_;
|
||||
bodyI[0] = bodyI[2] = o2i(bodyObj);
|
||||
bodyI[1] = bodyI[3] = I32_MAX;
|
||||
bodyAm1 = 1;
|
||||
bodyAm2 = 1;
|
||||
}
|
||||
// for (int i = 0; i < bodyILen+2; i++) printf("%d ", bodyI[i]); putchar('\n'); printf("things: %d %d\n", bodyAm1, bodyAm2);
|
||||
TSALLOC(i32, newBC, 20); // transformed bytecode
|
||||
TSALLOC(i32, mapBC, 20); // map of original bytecode to transformed
|
||||
TSALLOC(Block*, usedBlocks, 2); // list of blocks to be referenced by DFND, stored in result->blocks
|
||||
TSALLOC(Body*, bodies, 2); // list of bodies of this block
|
||||
TALLOC(Body*, bodyMap, bodyILen+2); // map from index in bodyI to the corresponding body
|
||||
TSALLOC(NextRequest, bodyReqs, 10); // list of SETH/PRED-s to fill out when bodyMap is complete
|
||||
|
||||
i32 pos1 = 0; // pos1 and pos2 always stay valid indexes in bodyI because bodyI is padded with -1s
|
||||
i32 pos2 = bodyAm1+1;
|
||||
i32 index1 = -1;
|
||||
i32 index2 = -1;
|
||||
if (bodyAm1==0 || bodyAm2==0) {
|
||||
i32 sz = TSSIZE(bodies);
|
||||
if (bodyAm1==0) index1 = sz;
|
||||
if (bodyAm2==0) index2 = sz;
|
||||
i32 bcStart = TSSIZE(newBC);
|
||||
// failed match body
|
||||
TSADD(newBC, FAIL);
|
||||
TSADD(mapBC, 0);
|
||||
Body* failBody = m_body(6, 0, 1, 0);
|
||||
failBody->nsDesc = NULL;
|
||||
TSADD(bodies, failBody);
|
||||
i32 failBodyI = 0;
|
||||
Body* startBodies[6] = {failBody,failBody,failBody,failBody,failBody,failBody};
|
||||
|
||||
Body* body = m_body(6, bcStart, 1, 0);
|
||||
body->nsDesc = NULL;
|
||||
TSADD(bodies, body);
|
||||
bool boArr = isArr(bodyObj);
|
||||
i32 boCount = boArr? a(bodyObj)->ia : 1;
|
||||
if (boCount<1 || boCount>5) thrM("VM compiler: Unexpected body list length");
|
||||
// if (boArr) { print(bodyObj); putchar('\n'); }
|
||||
i32 firstMPos = failBodyI;
|
||||
|
||||
for (i32 i = 0; i < 6; i+= 2) {
|
||||
if (i >= boCount) break;
|
||||
|
||||
i32* bodyPs;
|
||||
i32 mCount, dCount, mapLen;
|
||||
if (isArr(bodyObj)) {
|
||||
SGetU(bodyObj)
|
||||
B b1, b2;
|
||||
if (i==4) {
|
||||
b1 = bi_emptyHVec;
|
||||
b2 = GetU(bodyObj, 4);
|
||||
} else {
|
||||
b1 = GetU(bodyObj, i);
|
||||
b2 = i+1<boCount? GetU(bodyObj, i+1) : bi_emptyHVec;
|
||||
}
|
||||
bodyMap[bodyAm1] = bodyMap[bodyILen+1] = NULL;
|
||||
if (!isArr(b1) || !isArr(b2)) thrM("VM compiler: Body list contained non-arrays");
|
||||
mCount = a(b1)->ia; SGetU(b1)
|
||||
dCount = a(b2)->ia; SGetU(b2)
|
||||
mapLen = mCount+dCount;
|
||||
TALLOC(i32, bodyPs_, mapLen+2); bodyPs = bodyPs_;
|
||||
i32* bodyM = bodyPs;
|
||||
i32* bodyD = bodyPs + mCount+1;
|
||||
for (i32 i = 0; i < mCount; i++) bodyM[i] = o2i(GetU(b1, i));
|
||||
for (i32 i = 0; i < dCount; i++) bodyD[i] = o2i(GetU(b2, i));
|
||||
for (i32 i = 1; i < mCount; i++) if (bodyM[i]<=bodyM[i-1]) thrM("VM compiler: Expected body indices to be sorted");
|
||||
for (i32 i = 1; i < dCount; i++) if (bodyD[i]<=bodyD[i-1]) thrM("VM compiler: Expected body indices to be sorted");
|
||||
bodyM[mCount] = bodyD[dCount] = I32_MAX;
|
||||
} else {
|
||||
mapLen = 2;
|
||||
TALLOC(i32, bodyPs_, mapLen+2); bodyPs = bodyPs_;
|
||||
bodyPs[0] = bodyPs[2] = o2i(bodyObj);
|
||||
bodyPs[1] = bodyPs[3] = I32_MAX;
|
||||
mCount = dCount = 1;
|
||||
}
|
||||
// for (int i = 0; i < mapLen+2; i++) printf("%d ", bodyPs[i]); putchar('\n'); printf("things: %d %d\n", mCount, dCount);
|
||||
|
||||
TALLOC(Body*, bodyMap, mapLen+2); // map from index in bodyPs to the corresponding body
|
||||
TSALLOC(NextRequest, bodyReqs, 10); // list of SETH/PRED-s to fill out when bodyMap is complete
|
||||
|
||||
i32 pos1 = 0; // pos1 and pos2 always stay valid indexes in bodyPs because bodyPs is padded with -1s
|
||||
i32 pos2 = mCount+1;
|
||||
bodyMap[mCount] = bodyMap[mapLen+1] = NULL;
|
||||
bool firstM = true;
|
||||
bool firstD = true;
|
||||
|
||||
while (true) {
|
||||
i32 curr1 = bodyI[pos1];
|
||||
i32 curr2 = bodyI[pos2];
|
||||
i32 curr1 = bodyPs[pos1];
|
||||
i32 curr2 = bodyPs[pos2];
|
||||
i32 currBody = curr1<curr2? curr1 : curr2;
|
||||
if (currBody==I32_MAX) break;
|
||||
// printf("step %d %d: %d %d %d\n", pos1, pos2, curr1, curr2, currBody);
|
||||
u64 bodyIdx = TSSIZE(bodies);
|
||||
bool is1 = curr1==currBody; if (is1) { if (index1==-1) index1=bodyIdx; pos1++; }
|
||||
bool is2 = curr2==currBody; if (is2) { if (index2==-1) index2=bodyIdx; pos2++; }
|
||||
// printf("idxs: %d %d\n", index1, index2);
|
||||
bool is1 = curr1==currBody; if (is1) pos1++;
|
||||
bool is2 = curr2==currBody; if (is2) pos2++;
|
||||
// printf("idxs: %d %d\n", index1, firstD);
|
||||
|
||||
|
||||
B bodyRepr = IGetU(allBodies, currBody); if (!isArr(bodyRepr)) thrM("VM compiler: Body array contained non-array");
|
||||
@ -320,9 +335,9 @@ Block* compileBlock(B block, Comp* comp, bool* bDone, u32* bc, usz bcIA, B allBl
|
||||
for (u64 i = 0; i < vam; i++) body->varIDs[i] = -1;
|
||||
}
|
||||
|
||||
if (is1) { bodyMap[pos1-1] = body; if (firstM) { firstM=false; startBodies[i ] = body; if(i==0) firstMPos = TSSIZE(bodies); } }
|
||||
if (is2) { bodyMap[pos2-1] = body; if (firstD) { firstD=false; startBodies[i+1] = body; } }
|
||||
TSADD(bodies, body);
|
||||
if (is1) bodyMap[pos1-1] = body;
|
||||
if (is2) bodyMap[pos2-1] = body;
|
||||
}
|
||||
u64 bodyReqAm = TSSIZE(bodyReqs);
|
||||
for (u64 i = 0; i < bodyReqAm; i++) {
|
||||
@ -332,7 +347,10 @@ Block* compileBlock(B block, Comp* comp, bool* bDone, u32* bc, usz bcIA, B allBl
|
||||
}
|
||||
TSFREE(bodyReqs);
|
||||
TFREE(bodyMap);
|
||||
TFREE(bodyI);
|
||||
TFREE(bodyPs);
|
||||
}
|
||||
|
||||
|
||||
|
||||
usz blC = TSSIZE(usedBlocks);
|
||||
BlBlocks* nBl = NULL;
|
||||
@ -354,23 +372,24 @@ Block* compileBlock(B block, Comp* comp, bool* bDone, u32* bc, usz bcIA, B allBl
|
||||
bl->blocks = nBl==NULL? NULL : nBl->a;
|
||||
bl->map = map;
|
||||
bl->imm = imm;
|
||||
|
||||
bl->bodyCount = bodyCount;
|
||||
if (index1 != 0) { // this is a _mess_
|
||||
i32 sw0 = 0; i32 sw1 = index1;
|
||||
|
||||
Body* t = bodies[sw0]; bodies[sw0] = bodies[sw1]; bodies[sw1] = t;
|
||||
index1 = sw0;
|
||||
bl->dyBody = startBodies[1];
|
||||
bl->invMBody = startBodies[2];
|
||||
bl->invXBody = startBodies[3];
|
||||
bl->invWBody = startBodies[5];
|
||||
|
||||
if (index2==sw0) index2 = sw1;
|
||||
else if (index2==sw1) index2 = sw0;
|
||||
if (firstMPos != 0) { // swap body 0 and firstMPos so that the first body is the first monadic one
|
||||
Body* t = bodies[0];
|
||||
bodies[0] = bodies[firstMPos];
|
||||
bodies[firstMPos] = t;
|
||||
}
|
||||
|
||||
for (i32 i = 0; i < bodyCount; i++) {
|
||||
bl->bodies[i] = bodies[i];
|
||||
bodies[i]->bc = (u32*)nbc + bodies[i]->bcTmp;
|
||||
bodies[i]->bl = bl;
|
||||
}
|
||||
bl->dyBody = bodies[index2];
|
||||
TSFREE(bodies);
|
||||
return bl;
|
||||
}
|
||||
@ -795,6 +814,10 @@ B md1Bl_c2(Md1D* d, B w, B x) { Md1Block* b=c(Md1Block, d->m1); ptr_inc(d); retu
|
||||
B md2Bl_c1(Md2D* d, B x) { Md2Block* b=c(Md2Block, d->m2); ptr_inc(d); return execBlock(b->bl, b->bl->bodies[0], b->sc, 6, (B[]){tag(d,FUN_TAG), x, bi_N, inc(d->m2), inc(d->f), inc(d->g)}); }
|
||||
B md2Bl_c2(Md2D* d, B w, B x) { Md2Block* b=c(Md2Block, d->m2); ptr_inc(d); return execBlock(b->bl, b->bl->dyBody, b->sc, 6, (B[]){tag(d,FUN_TAG), x, w , inc(d->m2), inc(d->f), inc(d->g)}); }
|
||||
|
||||
B funBl_im(B t, B x) { FunBlock* b=c(FunBlock, t ); ptr_inc(b); return execBlock(b->bl, b->bl->invMBody, b->sc, 3, (B[]){t, x, bi_N }); }
|
||||
B funBl_iw(B t, B w, B x) { FunBlock* b=c(FunBlock, t ); ptr_inc(b); return execBlock(b->bl, b->bl->invWBody, b->sc, 3, (B[]){t, x, w }); }
|
||||
B funBl_ix(B t, B w, B x) { FunBlock* b=c(FunBlock, t ); ptr_inc(b); return execBlock(b->bl, b->bl->invXBody, b->sc, 3, (B[]){t, x, w }); }
|
||||
|
||||
B md1Bl_d(B m, B f ) { Md1Block* c = c(Md1Block,m); Block* bl=c(Md1Block, m)->bl; return c->bl->imm? execBlock(bl, bl->bodies[0], c(Md1Block, m)->sc, 2, (B[]){m, f }) : m_md1D(m,f ); }
|
||||
B md2Bl_d(B m, B f, B g) { Md2Block* c = c(Md2Block,m); Block* bl=c(Md2Block, m)->bl; return c->bl->imm? execBlock(bl, bl->bodies[0], c(Md2Block, m)->sc, 3, (B[]){m, f, g}) : m_md2D(m,f,g); }
|
||||
|
||||
@ -939,6 +962,11 @@ void comp_init() {
|
||||
TIi(t_fun_block,freeO) = funBl_freeO; TIi(t_fun_block,freeF) = funBl_freeF; TIi(t_fun_block,visit) = funBl_visit; TIi(t_fun_block,print) = funBl_print; TIi(t_fun_block,decompose) = block_decompose;
|
||||
TIi(t_md1_block,freeO) = md1Bl_freeO; TIi(t_md1_block,freeF) = md1Bl_freeF; TIi(t_md1_block,visit) = md1Bl_visit; TIi(t_md1_block,print) = md1Bl_print; TIi(t_md1_block,decompose) = block_decompose; TIi(t_md1_block,m1_d)=md1Bl_d;
|
||||
TIi(t_md2_block,freeO) = md2Bl_freeO; TIi(t_md2_block,freeF) = md2Bl_freeF; TIi(t_md2_block,visit) = md2Bl_visit; TIi(t_md2_block,print) = md2Bl_print; TIi(t_md2_block,decompose) = block_decompose; TIi(t_md2_block,m2_d)=md2Bl_d;
|
||||
|
||||
TIi(t_fun_block,fn_im) = funBl_im;
|
||||
TIi(t_fun_block,fn_iw) = funBl_iw;
|
||||
TIi(t_fun_block,fn_ix) = funBl_ix;
|
||||
|
||||
#ifndef GS_REALLOC
|
||||
allocStack((void**)&gStack, (void**)&gStackStart, (void**)&gStackEnd, sizeof(B), GS_SIZE);
|
||||
#endif
|
||||
|
||||
10
src/vm.h
10
src/vm.h
@ -95,8 +95,14 @@ struct Block {
|
||||
i32* map; // pointer in an owned I32Arr
|
||||
i32* bc; // pointer in an owned I32Arr
|
||||
i32 bodyCount;
|
||||
Body* dyBody; // pointer within bodies; not owned; TODO move to the second item of bodies or something
|
||||
Body* bodies[]; // bodies[0] is the first monadic body (also niladic body)
|
||||
|
||||
// pointers within bodies, not owned
|
||||
Body* dyBody;
|
||||
Body* invMBody;
|
||||
Body* invXBody;
|
||||
Body* invWBody;
|
||||
// bodies[0] is the first monadic body (also niladic body)
|
||||
Body* bodies[];
|
||||
};
|
||||
struct Body {
|
||||
struct Value;
|
||||
|
||||
Loading…
Reference in New Issue
Block a user