native fns, runtime perf

This commit is contained in:
dzaima 2021-04-24 00:57:04 +03:00
parent b72edce148
commit 4f8dd1b178
14 changed files with 627 additions and 208 deletions

View File

@ -1,30 +1,51 @@
#include "h.h"
#include <math.h>
#define ffnx(name, expr, extra) B name(B t, B w, B x) { \
#define P1(N) { if( isArr(x)) return eachm_fn(N##_c1, bi_nothing, x); }
#define P2(N) { if(isArr(w)|isArr(x)) return eachd_fn(N##_c2, bi_nothing, w, x); }
#define ffnx(name, expr, extra) B name##_c2(B t, B w, B x) { \
if (isF64(w) & isF64(x)) return m_f64(expr); \
extra \
P2(name) \
thrM(#name ": invalid arithmetic"); \
}
#define ffn(name, op, extra) ffnx(name, w.f op x.f, extra)
ffn(add_c2, +, {
if (isC32(w) & isF64(x)) return m_c32((u32)w.u + o2i(x));
if (isF64(w) & isC32(x)) return m_c32((u32)x.u + o2i(w));
ffn(add, +, {
if (isC32(w) & isF64(x)) { u64 r = (u64)(u32)w.u + o2i64(x); if(r>CHR_MAX)thrM("+: Invalid character"); return m_c32(r); }
if (isF64(w) & isC32(x)) { u64 r = (u64)(u32)x.u + o2i64(w); if(r>CHR_MAX)thrM("+: Invalid character"); return m_c32(r); }
})
ffn(sub_c2, -, {
if (isC32(w) & isF64(x)) return m_c32((u32)w.u - o2i(x));
ffn(sub, -, {
if (isC32(w) & isF64(x)) { u64 r = (u64)(u32)w.u - o2i64(x); if(r>CHR_MAX)thrM("-: Invalid character"); return m_c32(r); }
if (isC32(w) & isC32(x)) return m_f64((u32)w.u - (i64)(u32)x.u);
})
ffn(mul_c2, *, {})
ffn(div_c2, /, {})
ffn(le_c2, <=, {
if (isC32(w) & isC32(x)) return m_f64(w.u<=x.u);
if (isF64(w) & isC32(x)) return m_f64(1);
if (isC32(w) & isF64(x)) return m_f64(0);
})
ffnx(pow_c2, pow(w.f,x.f), {})
ffnx(log_c2, log(x.f)/log(w.f), {})
ffn(mul, *, {})
ffn(and, *, {})
ffn(div, /, {})
ffnx(pow, pow(w.f,x.f), {})
ffnx(floor, fmin(w.f, x.f), {})
ffnx(ceil, fmax(w.f, x.f), {})
f64 pfmod(f64 a, f64 b) {
f64 r = fmod(a, b);
if (a<0 != b<0 && r) r+= b;
return r;
}
ffnx(stile, pfmod(x.f, w.f), {})
ffnx(log, log(x.f)/log(w.f), {})
ffnx(or, (w.f+x.f)-(w.f*x.f), {})
ffnx(not, 1+w.f-x.f, {})
#define CMP(X, N, G) \
ffn(N, X, { \
if (isC32(w) & isC32(x)) return m_f64(w.u X x.u); \
if (isF64(w) & isC32(x)) return m_f64(1-G); \
if (isC32(w) & isF64(x)) return m_f64(G); \
})
CMP(<=, le, 0)
CMP(>=, ge, 1)
CMP(< , lt, 0)
CMP(> , gt, 1)
#undef CMP
#undef ffn
#undef ffnx
@ -32,6 +53,7 @@ ffnx(log_c2, log(x.f)/log(w.f), {})
B decp_c1(B t, B x);
B eq_c2(B t, B w, B x) {
if(isF64(w)&isF64(x)) return m_i32(w.f==x.f);
P2(eq);
if (w.u==x.u) { dec(w);dec(x); return m_i32(1); }
// doesn't handle int=float
if (!isVal(w) | !isVal(x)) { dec(w);dec(x); return m_i32(0); }
@ -44,29 +66,51 @@ B eq_c2(B t, B w, B x) {
i32 wia = a(w)->ia;
i32 xia = a(x)->ia;
if (wia != xia) { dec(w);dec(x); return m_i32(0); }
for (i32 i = 0; i<wia; i++) if(!o2i(eq_c2(t,inc(wp[i]),inc(xp[i]))))
for (i32 i = 0; i<wia; i++) if(!equal(wp[i], xp[i]))
{ dec(w);dec(x); return m_i32(0); }
dec(w);dec(x); return m_i32(1);
}
B ne_c2(B t, B w, B x) {
if(isF64(w)&isF64(x)) return m_i32(w.f!=x.f);
P2(ne);
return m_i32(1-o2i(eq_c2(t,w,x)));
}
B add_c1(B t, B x) { return x; }
B sub_c1(B t, B x) { if (isF64(x)) return m_f64( -x.f ); thrM("negating non-number"); }
B mul_c1(B t, B x) { if (isF64(x)) return m_f64(x.f?x.f>0?1:-1:0); thrM("getting sign of non-number"); }
B div_c1(B t, B x) { if (isF64(x)) return m_f64( 1/x.f ); thrM("getting reciprocal of non-number"); }
B pow_c1(B t, B x) { if (isF64(x)) return m_f64( exp(x.f)); thrM("getting exp of non-number"); }
B floor_c1(B t, B x) { if (isF64(x)) return m_f64(floor(x.f)); thrM("getting floor of non-number"); }
B log_c1(B t, B x) { if (isF64(x)) return m_f64( log(x.f)); thrM("getting log of non-number"); }
B eq_c1(B t, B x) { B r = m_i32(isArr(x)? rnk(x) : 0); decR(x); return r; }
B sub_c1(B t, B x) { if (isF64(x)) return m_f64( -x.f ); P1( sub); thrM("-: Negating non-number"); }
B not_c1(B t, B x) { if (isF64(x)) return m_f64( 1-x.f ); P1( not); thrM("¬: Argument was not a number"); }
B mul_c1(B t, B x) { if (isF64(x)) return m_f64(x.f?x.f>0?1:-1:0); P1( mul); thrM("×: Getting sign of non-number"); }
B div_c1(B t, B x) { if (isF64(x)) return m_f64( 1/x.f ); P1( div); thrM("÷: Getting reciprocal of non-number"); }
B pow_c1(B t, B x) { if (isF64(x)) return m_f64( exp(x.f)); P1( pow); thrM("⋆: Getting exp of non-number"); }
B floor_c1(B t, B x) { if (isF64(x)) return m_f64(floor(x.f)); P1(floor); thrM("⌊: Argument was not a number"); }
B ceil_c1(B t, B x) { if (isF64(x)) return m_f64( ceil(x.f)); P1( ceil); thrM("⌈: Argument was not a number"); }
B stile_c1(B t, B x) { if (isF64(x)) return m_f64( fabs(x.f)); P1(stile); thrM("|: Argument was not a number"); }
B log_c1(B t, B x) { if (isF64(x)) return m_f64( log(x.f)); P1( log); thrM("⋆⁼: Getting log of non-number"); }
B lt_c1(B t, B x) { return m_unit(x); }
B eq_c1(B t, B x) { B r = m_i32(isArr(x)? rnk(x) : 0); decR(x); return r; }
B ne_c1(B t, B x) { B r = m_f64(isArr(x)&&rnk(x)? *a(x)->sh : 1); decR(x); return r; }
B rt_sortAsc, rt_sortDsc, rt_merge;
B and_c1(B t, B x) { return c1(rt_sortAsc, x); }
B or_c1(B t, B x) { return c1(rt_sortDsc, x); }
B gt_c1(B t, B x) { return c1(rt_merge, x); }
#define ba(NAME) bi_##NAME = mm_alloc(sizeof(Fun), t_fun_def, ftag(FUN_TAG)); c(Fun,bi_##NAME)->c2 = NAME##_c2; c(Fun,bi_##NAME)->c1 = NAME##_c1 ; c(Fun,bi_##NAME)->extra=pf_##NAME; gc_add(bi_##NAME);
#define bd(NAME) bi_##NAME = mm_alloc(sizeof(Fun), t_fun_def, ftag(FUN_TAG)); c(Fun,bi_##NAME)->c2 = NAME##_c2; c(Fun,bi_##NAME)->c1 = c1_invalid; c(Fun,bi_##NAME)->extra=pf_##NAME; gc_add(bi_##NAME);
#define bm(NAME) bi_##NAME = mm_alloc(sizeof(Fun), t_fun_def, ftag(FUN_TAG)); c(Fun,bi_##NAME)->c2 = c2_invalid;c(Fun,bi_##NAME)->c1 = NAME##_c1 ; c(Fun,bi_##NAME)->extra=pf_##NAME; gc_add(bi_##NAME);
#undef P1
#undef P2
B bi_add, bi_sub, bi_mul, bi_div, bi_pow, bi_floor, bi_eq, bi_le, bi_log;
void arith_init() { ba(add) ba(sub) ba(mul) ba(div) ba(pow) bm(floor) ba(eq) bd(le) ba(log) }
#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_nothing; 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_nothing; 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_nothing; gc_add(bi_##N);
B bi_add, bi_sub, bi_mul, bi_div, bi_pow, bi_floor, bi_ceil, bi_stile, bi_eq, bi_ne, bi_le, bi_ge, bi_lt, bi_gt, bi_and, bi_or, bi_not, bi_log;
static inline void arith_init() { ba(add) ba(sub) ba(mul) ba(div) ba(pow) ba(floor) ba(ceil) ba(stile) ba(eq) ba(ne) bd(le) bd(ge) ba(lt) ba(gt) ba(and) ba(or) ba(not) ba(log)
c(BFn,bi_add)->ident = c(BFn,bi_sub)->ident = c(BFn,bi_or )->ident = c(BFn,bi_eq)->ident = c(BFn,bi_ne)->ident = m_i32(0);
c(BFn,bi_mul)->ident = c(BFn,bi_div)->ident = c(BFn,bi_and)->ident = c(BFn,bi_eq)->ident = c(BFn,bi_ge)->ident = c(BFn,bi_pow)->ident = c(BFn,bi_not)->ident = m_i32(1);
c(BFn,bi_floor)->ident = m_f64(1.0/0.0);
c(BFn,bi_ceil )->ident = m_f64(-1.0/0.0);
}
#undef ba
#undef bd

View File

@ -69,7 +69,7 @@ bool eqStr(B w, u32* x) {
}
void c32arr_init() {
static inline void c32arr_init() {
ti[t_c32arr].get = c32arr_get; ti[t_c32slice].get = c32slice_get;
ti[t_c32arr].getU = c32arr_get; ti[t_c32slice].getU = c32slice_get;
ti[t_c32arr].slice = c32arr_slice; ti[t_c32slice].slice = c32slice_slice;

View File

@ -73,12 +73,12 @@ B m2_h(B m, B g) { return m_md2H(m, g); }
void derv_init() {
static inline void derv_init() {
ti[t_md1D].free = md1D_free; ti[t_md1D].visit = md1D_visit; ti[t_md1D].print = md1D_print; ti[t_md1D].decompose = md1D_decompose;
ti[t_md2D].free = md2D_free; ti[t_md2D].visit = md2D_visit; ti[t_md2D].print = md2D_print; ti[t_md2D].decompose = md2D_decompose;
ti[t_md2H].free = md2H_free; ti[t_md2H].visit = md2H_visit; ti[t_md2H].print = md2H_print; ti[t_md2H].decompose = md2H_decompose;
ti[t_fork].free = fork_free; ti[t_fork].visit = fork_visit; ti[t_fork].print = fork_print; ti[t_fork].decompose = fork_decompose;
ti[t_atop].free = atop_free; ti[t_atop].visit = atop_visit; ti[t_atop].print = atop_print; ti[t_atop].decompose = atop_decompose;
ti[t_md1_def].m1_d = m_md1D;
ti[t_md2_def].m2_d = m_md2D;
ti[t_md1BI].m1_d = m_md1D;
ti[t_md2BI].m2_d = m_md2D;
}

View File

@ -74,7 +74,7 @@ void fillarr_visit(B x) {
}
bool fillarr_canStore(B x) { return true; }
void fillarr_init() {
static inline void fillarr_init() {
ti[t_fillarr].get = fillarr_get; ti[t_fillslice].get = fillslice_get;
ti[t_fillarr].getU = fillarr_getU; ti[t_fillslice].getU = fillslice_getU;
ti[t_fillarr].slice = fillarr_slice; ti[t_fillslice].slice = fillslice_slice;

87
src/h.h
View File

@ -18,6 +18,7 @@
#define u64 uint64_t
#define f64 double
#define I32_MAX ((i32)((1LL<<31)-1))
#define CHR_MAX 1114111
#define U16_MAX ((u16)-1)
#define UD __builtin_unreachable();
#define NOINLINE __attribute__ ((noinline))
@ -62,10 +63,10 @@ const u16 VAL_TAG = 0b1111111111110 ; // 1111111111110........................
enum Type {
/* 0*/ t_empty, // empty bucket placeholder
/* 1*/ t_fun_def, t_fun_block,
/* 3*/ t_md1_def, t_md1_block,
/* 5*/ t_md2_def, t_md2_block,
/* 7*/ t_shape, // doesn't get visited, shouldn't be unallocated by gc
/* 1*/ t_funBI, t_fun_block,
/* 3*/ t_md1BI, t_md1_block,
/* 5*/ t_md2BI, t_md2_block,
/* 7*/ t_shape, // doesn't get visited, shouldn't be unallocated by gcWMd1
/* 8*/ t_fork, t_atop,
/*10*/ t_md1D, t_md2D, t_md2H,
@ -75,14 +76,17 @@ enum Type {
/*21*/ t_comp, t_block, t_body, t_scope,
/*25*/ t_freed,
#ifdef RT_PERF
/*26*/ t_funPerf, t_md1Perf, t_md2Perf,
#endif
t_COUNT
};
char* format_type(u8 u) {
switch(u) { default: return"(unknown type)";
case t_empty:return"empty"; case t_shape:return"shape";
case t_fun_def:return"fun_def"; case t_fun_block:return"fun_block";
case t_md1_def:return"md1_def"; case t_md1_block:return"md1_block";
case t_md2_def:return"md2_def"; case t_md2_block:return"md2_block";
case t_funBI:return"fun_def"; case t_fun_block:return"fun_block";
case t_md1BI:return"md1_def"; case t_md1_block:return"md1_block";
case t_md2BI:return"md2_def"; case t_md2_block:return"md2_block";
case t_fork:return"fork"; case t_atop:return"atop";
case t_md1D:return"md1D"; case t_md2D:return"md2D"; case t_md2H:return"md2H";
case t_harr :return"harr" ; case t_i32arr :return"i32arr" ; case t_fillarr :return"fillarr" ; case t_c32arr :return"c32arr" ;
@ -92,31 +96,33 @@ char* format_type(u8 u) {
}
}
#define FOR_PF(F) F(none, "(unknown fn)") \
F(add,"+") F(sub,"-") F(mul,"×") F(div,"÷") F(pow,"") F(floor,"") F(ceil,"") F(stile,"|") F(eq,"=") F(ne,"") F(le,"") F(ge,"") F(lt,"<") F(gt,">") F(and,"") F(or,"") F(not,"¬") F(log,"⋆⁼") /*arith.c*/ \
F(shape,"") F(pick,"") F(ud,"") F(pair,"{𝕨‿𝕩}") F(fne,"") F(feq,"") F(ltack,"") F(rtack,"") F(fmtF,"") F(fmtN,"") /*sfns.c*/ \
F(fork,"(fork)") F(atop,"(atop)") F(md1d,"(derived 1-modifier)") F(md2d,"(derived 2-modifier)") /*derv.c*/ \
F(type,"•Type") F(decp,"•Decompose") F(primInd,"•PrimInd") F(glyph,"•Glyph") F(fill,"•FillFn") /*sysfn.c*/ \
F(grLen,"•GroupLen") F(grOrd,"•groupOrd") F(asrt,"!") F(sys,"•getsys") F(internal,"•Internal") /*sysfn.c*/
enum PrimFns {
pf_none,
pf_add, pf_sub, pf_mul, pf_div, pf_pow, pf_floor, pf_eq, pf_le, pf_log, // arith.c
pf_shape, pf_pick, pf_ud, pf_pair, pf_fne, pf_feq, pf_lt, pf_rt, pf_fmtF, pf_fmtN, // sfns.c
pf_fork, pf_atop, pf_md1d, pf_md2d, // derv.c
pf_type, pf_decp, pf_primInd, pf_glyph, pf_fill, // sysfn.c
pf_grLen, pf_grOrd, pf_asrt, pf_sys, pf_internal, // sysfn.c
#define F(N,X) pf_##N,
FOR_PF(F)
#undef F
};
char* format_pf(u8 u) {
switch(u) { default: case pf_none: return"(unknown fn)";
case pf_add:return"+"; case pf_sub:return"-"; case pf_mul:return"×"; case pf_div:return"÷"; case pf_pow:return""; case pf_floor:return""; case pf_eq:return"="; case pf_le:return""; case pf_log:return"⋆⁼";
case pf_shape:return""; case pf_pick:return""; case pf_ud:return""; case pf_pair:return"{𝕨‿𝕩}"; case pf_fne:return""; case pf_feq:return""; case pf_lt:return""; case pf_rt:return""; case pf_fmtF:case pf_fmtN:return"";
case pf_fork:return"(fork)"; case pf_atop:return"(atop)"; case pf_md1d:return"(derived 1-modifier)"; case pf_md2d:return"(derived 2-modifier)";
case pf_type:return"•Type"; case pf_decp:return"•Decompose"; case pf_primInd:return"•PrimInd"; case pf_glyph:return"•Glyph"; case pf_fill:return"•FillFn";
case pf_grLen:return"•GroupLen"; case pf_grOrd:return"•groupOrd"; case pf_asrt:return"!"; case pf_sys:return"•getsys"; case pf_internal:return"•Internal";
switch(u) { default: return "(unknown fn)";
#define F(N,X) case pf_##N: return X;
FOR_PF(F)
#undef F
}
}
enum PrimMd1 {
pm1_none,
pm1_tbl, pm1_scan, // md1.c
pm1_tbl, pm1_each, pm1_fold, pm1_scan, // md1.c
};
char* format_pm1(u8 u) {
switch(u) {
default: case pf_none: return"(unknown 1-modifier)";
case pm1_tbl: return""; case pm1_scan: return"`";
case pm1_tbl: return""; case pm1_each: return"¨"; case pm1_fold: return"´"; case pm1_scan: return"`";
}
}
enum PrimMd2 {
@ -199,6 +205,7 @@ B m_v1(B a );
B m_v2(B a, B b );
B m_v3(B a, B b, B c );
B m_v4(B a, B b, B c, B d);
B m_unit(B a);
B m_str32(u32* s);
NORETURN void thr(B b);
NORETURN void thrM(char* s);
@ -286,12 +293,25 @@ void arr_shCopy(B n, B o) { // copy shape from o to n
a(n)->sh = a(o)->sh;
}
}
bool shEq(B w, B x) { assert(isArr(w)); assert(isArr(x));
bool eqShPrefix(usz* w, usz* x, ur len) {
return memcmp(w, x, len*sizeof(usz))==0;
}
ur minRank(B w, B x) { // assumes both are arrays
ur wr = rnk(w);
ur xr = rnk(x);
return wr<xr? wr : xr;
}
ur maxRank(B w, B x) { // assumes both are arrays
ur wr = rnk(w);
ur xr = rnk(x);
return wr>xr? wr : xr;
}
bool eqShape(B w, B x) { assert(isArr(w)); assert(isArr(x));
ur wr = rnk(w); usz* wsh = a(w)->sh;
ur xr = rnk(x); usz* xsh = a(x)->sh;
if (wr!=xr) return false;
if (wsh==xsh) return true;
return memcmp(wsh,xsh,wr*sizeof(usz))==0;
return eqShPrefix(wsh, xsh, wr);
}
usz arr_csz(B x) {
ur xr = rnk(x);
@ -349,6 +369,7 @@ typedef struct TypeInfo {
BBB2B m2_d; // consume all args; (m, f, g)
BS2B slice; // consumes; create slice from given starting position; add ia, rank, shape yourself
B2b canStore; // doesn't consume
B2B identity; // return identity element of this function; doesn't consume
B2v print; // doesn't consume
B2v visit; // call mm_visit for all referents
@ -359,6 +380,8 @@ TypeInfo ti[t_COUNT];
#define TI(x) (ti[v(x)->type])
B bi_nothing, bi_noVar, bi_badHdr, bi_optOut, bi_noFill;
void do_nothing(B x) { }
void empty_free(B x) { err("FREEING EMPTY\n"); }
void builtin_free(B x) { err("FREEING BUILTIN\n"); }
@ -369,6 +392,7 @@ void freeed_visit(B x) {
#endif
}
void def_print(B x) { printf("(%d=%s)", v(x)->type, format_type(v(x)->type)); }
B def_identity(B f) { return bi_nothing; }
B def_get (B x, usz n) { return inc(x); }
B def_getU(B x, usz n) { return x; }
B def_m1_d(B m, B f ) { return err("cannot derive this"); }
@ -376,17 +400,17 @@ B def_m2_d(B m, B f, B g) { return err("cannot derive this"); }
B def_slice(B x, usz s) { return err("cannot slice non-array!"); }
B def_decompose(B x) { return m_v2(m_i32((isFun(x)|isMd(x))? 0 : -1),x); }
bool def_canStore(B x) { return false; }
B bi_nothing, bi_noVar, bi_badHdr, bi_optOut, bi_noFill;
void hdr_init() {
static inline void hdr_init() {
for (i32 i = 0; i < t_COUNT; i++) {
ti[i].free = do_nothing;
ti[i].visit = def_visit;
ti[i].get = def_get;
ti[i].getU = def_get;
ti[i].getU = def_getU;
ti[i].print = def_print;
ti[i].m1_d = def_m1_d;
ti[i].m2_d = def_m2_d;
ti[i].isArr = false;
ti[i].identity = def_identity;
ti[i].decompose = def_decompose;
ti[i].slice = def_slice;
ti[i].canStore = def_canStore;
@ -395,8 +419,8 @@ void hdr_init() {
ti[t_freed].free = do_nothing;
ti[t_freed].visit = freeed_visit;
ti[t_shape].visit = do_nothing;
ti[t_fun_def].visit = ti[t_md1_def].visit = ti[t_md2_def].visit = do_nothing;
ti[t_fun_def].free = ti[t_md1_def].free = ti[t_md2_def].free = builtin_free;
ti[t_funBI].visit = ti[t_md1BI].visit = ti[t_md2BI].visit = do_nothing;
ti[t_funBI].free = ti[t_md1BI].free = ti[t_md2BI].free = builtin_free;
bi_nothing = tag(0, TAG_TAG);
bi_noVar = tag(1, TAG_TAG);
bi_badHdr = tag(2, TAG_TAG);
@ -491,7 +515,7 @@ bool equal(B w, B x) { // doesn't consume
bool xa = isArr(x);
if (wa!=xa) return false;
if (!wa) return o2iu(eq_c2(bi_nothing, inc(w), inc(x)))?1:0;
if (!shEq(w,x)) return false;
if (!eqShape(w,x)) return false;
usz ia = a(x)->ia;
BS2B xget = TI(x).get;
BS2B wget = TI(w).get;
@ -531,6 +555,10 @@ B c2(B f, B w, B x) { // BQN-call f dyadically; consumes w,x
if (isFun(f)) return VALIDATE(c(Fun,f)->c2(f, w, x));
return c2_rare(f, w, x);
}
B c1_modifier(B f, B w, B x) {
dec(w); dec(x);
thrM("Calling a modifier");
}
typedef struct Md1 {
@ -589,6 +617,7 @@ void arr_print(B x) { // should accept refc=0 arguments for debugging purposes
u64 nsTime() {
struct timespec t;
timespec_get(&t, TIME_UTC);
// clock_gettime(CLOCK_REALTIME, &t);
return t.tv_sec*1000000000ull + t.tv_nsec;
}

View File

@ -64,6 +64,7 @@ B m_v1(B a ) { HArr_p r = m_harrv(1); r.a[0] = a;
B m_v2(B a, B b ) { HArr_p r = m_harrv(2); r.a[0] = a; r.a[1] = b; return r.b; }
B m_v3(B a, B b, B c ) { HArr_p r = m_harrv(3); r.a[0] = a; r.a[1] = b; r.a[2] = c; return r.b; }
B m_v4(B a, B b, B c, B d) { HArr_p r = m_harrv(4); r.a[0] = a; r.a[1] = b; r.a[2] = c; r.a[3] = d; return r.b; }
B m_unit(B x) { HArr_p r = m_harrp(1); arr_shAlloc(r.b, 1, 0); r.a[0] = x; return r.b; }
typedef struct HSlice {
@ -97,7 +98,7 @@ void harr_visit(B x) {
}
bool harr_canStore(B x) { return true; }
void harr_init() {
static inline void harr_init() {
ti[t_harr].get = harr_get; ti[t_hslice].get = hslice_get;
ti[t_harr].getU = harr_getU; ti[t_hslice].getU = hslice_getU;
ti[t_harr].slice = harr_slice; ti[t_hslice].slice = hslice_slice;

View File

@ -63,7 +63,7 @@ B i32slice_get(B x, usz n) { VT(x,t_i32slice); return m_i32(c(I32Slice,x)->a[n])
void i32arr_free(B x) { decSh(x); }
bool i32arr_canStore(B x) { return q_i32(x); }
void i32arr_init() {
static inline void i32arr_init() {
ti[t_i32arr].get = i32arr_get; ti[t_i32slice].get = i32slice_get;
ti[t_i32arr].getU = i32arr_get; ti[t_i32slice].getU = i32slice_get;
ti[t_i32arr].slice = i32arr_slice; ti[t_i32slice].slice = i32slice_slice;

View File

@ -11,10 +11,12 @@
// #define DONT_FREE // don't actually ever free objects, such that they can be printed after being freed for debugging
// #define OBJ_COUNTER // store a unique allocation number with each object for easier analysis
#define FAKE_RUNTIME false // whether to disable the self-hosted runtime
// #define ALL_RUNTIME // don't use custom native runtime parts
// #define LOG_GC // log GC stats
// #define FORMATTER // use self-hosted formatter for output
// #define TIME // output runtime of every expression
// #define RT_PERF // time runtime primitives
#define rtLen 63
#include "h.h"
@ -26,12 +28,13 @@
#include "c32arr.c"
#include "utf.c"
#include "derv.c"
#include "arith.c"
#include "sfns.c"
#include "sysfn.c"
#include "arith.c"
#include "md1.c"
#include "md2.c"
#include "vm.c"
#include "rtPerf.c"
void pr(char* a, B b) {
printf("%s", a);
@ -75,6 +78,7 @@ void printAllocStats() {
#endif
#endif
}
int main() {
hdr_init();
harr_init();
@ -88,17 +92,27 @@ int main() {
sysfn_init();
derv_init();
comp_init();
rtPerf_init();
// fake runtime
B bi_N = bi_nothing;
B fruntime[] = {
/* +-×÷⋆√⌊⌈|¬ */ bi_add, bi_sub , bi_mul , bi_div, bi_pow, bi_N , bi_floor, bi_N , bi_N, bi_N,
/* ∧∨<>≠=≤≥≡≢ */ bi_N , bi_N , bi_N , bi_N , bi_N , bi_eq, bi_le , bi_N , bi_N, bi_fne,
/* ⊣⊢⥊∾≍↑↓↕«» */ bi_lt , bi_rt , bi_shape, bi_N , bi_N , bi_N , bi_N , bi_ud , bi_N, bi_N,
/* ⌽⍉/⍋⍒⊏⊑⊐⊒∊ */ bi_N , bi_N , bi_N , bi_N , bi_N , bi_N , bi_pick , bi_N , bi_N, bi_N,
/* ⍷⊔!˙˜˘¨⌜⁼´ */ bi_N , bi_N , bi_asrt , bi_N , bi_N , bi_N , bi_N , bi_tbl, bi_N, bi_N,
/* ˝`∘○⊸⟜⌾⊘◶⎉ */ bi_N , bi_scan, bi_N , bi_N , bi_N , bi_N , bi_N , bi_val, bi_N, bi_N,
/* ⚇⍟⎊ */ bi_N , bi_fill, bi_catch
/* +-×÷⋆√⌊⌈|¬ */ bi_add , bi_sub , bi_mul , bi_div, bi_pow, bi_N , bi_floor, bi_ceil, bi_stile, bi_not,
/* ∧∨<>≠=≤≥≡≢ */ bi_and , bi_or , bi_lt , bi_gt , bi_ne , bi_eq, bi_le , bi_ge , bi_feq , bi_fne,
/* ⊣⊢⥊∾≍↑↓↕«» */ bi_ltack, bi_rtack, bi_shape, bi_N , bi_N , bi_N , bi_N , bi_ud , bi_N , bi_N,
/* ⌽⍉/⍋⍒⊏⊑⊐⊒∊ */ bi_N , bi_N , bi_N , bi_N , bi_N , bi_N , bi_pick , bi_N , bi_N , bi_N,
/* ⍷⊔!˙˜˘¨⌜⁼´ */ bi_N , bi_N , bi_asrt , bi_N , bi_N , bi_N , bi_each , bi_tbl , bi_N , bi_fold,
/* ˝`∘○⊸⟜⌾⊘◶⎉ */ bi_N , bi_scan , bi_N , bi_N , bi_N , bi_N , bi_N , bi_val , bi_N , bi_N,
/* ⚇⍟⎊ */ bi_N , bi_fill , bi_catch
};
bool rtComplete[] = {
/* +-×÷⋆√⌊⌈|¬ */ 1,1,1,1,1,0,1,1,1,1,
/* ∧∨<>≠=≤≥≡≢ */ 1,1,1,1,1,1,1,1,1,1,
/* ⊣⊢⥊∾≍↑↓↕«» */ 1,1,0,0,0,0,0,0,0,0,
/* ⌽⍉/⍋⍒⊏⊑⊐⊒∊ */ 0,0,0,0,0,0,0,0,0,0,
/* ⍷⊔!˙˜˘¨⌜⁼´ */ 0,0,1,0,0,0,1,1,0,1,
/* ˝`∘○⊸⟜⌾⊘◶⎉ */ 0,1,0,0,0,0,0,1,0,0,
/* ⚇⍟⎊ */ 0,0,1
};
assert(sizeof(fruntime)/sizeof(B) == rtLen);
for (i32 i = 0; i < rtLen; i++) inc(fruntime[i]);
@ -109,14 +123,31 @@ int main() {
#include "runtime"
);
B rtRes = m_funBlock(runtime_b, 0); ptr_dec(runtime_b);
B rtObj = TI(rtRes).get(rtRes,0);
B rtObjRaw = TI(rtRes).get(rtRes,0);
B rtFinish = TI(rtRes).get(rtRes,1);
dec(rtRes);
B* runtime = toHArr(rtObj)->a;
runtimeLen = c(Arr,rtObj)->ia;
runtimeLen = c(Arr,rtObjRaw)->ia;
HArr_p runtimeH = m_harrc(rtObjRaw);
BS2B rtObjGet = TI(rtObjRaw).get;
rt_sortAsc = rtObjGet(rtObjRaw, 10); gc_add(rt_sortAsc);
rt_sortDsc = rtObjGet(rtObjRaw, 11); gc_add(rt_sortDsc);
rt_merge = rtObjGet(rtObjRaw, 13); gc_add(rt_merge);
for (usz i = 0; i < runtimeLen; i++) {
if (isVal(runtime[i])) v(runtime[i])->flags|= i+1;
#ifdef ALL_RUNTIME
B r = rtObjGet(rtObjRaw, i);
#else
B r = rtComplete[i]? inc(fruntime[i]) : rtObjGet(rtObjRaw, i);
#endif
r = rtPerf_wrap(r);
runtimeH.a[i] = r;
if (isVal(r)) v(r)->flags|= i+1;
}
dec(rtObjRaw);
B* runtime = runtimeH.a;
B rtObj = runtimeH.b;
dec(c1(rtFinish, m_v2(inc(bi_decp), inc(bi_primInd)))); dec(rtFinish);
@ -203,10 +234,12 @@ int main() {
pr("", res);
#endif
// heapVerify();
gc_forceGC();
#ifdef DEBUG
#endif
}
rtPerf_print();
popCatch();
CTR_FOR(CTR_PRINT)
// printf("done\n");fflush(stdout); while(1);

168
src/md1.c
View File

@ -1,101 +1,48 @@
#include "h.h"
B tbl_c1(B d, B x) { B f = c(Md1D,d)->f;
if (!isArr(x)) thrM("⌜: argument cannot be an atom");
usz ia = a(x)->ia;
if (ia==0) return x;
BS2B xget = TI(x).get;
usz i = 0;
B cr = c1(f, xget(x,0));
HArr_p rH;
if (TI(x).canStore(cr)) {
bool reuse = reusable(x);
if (v(x)->type==t_harr) {
B* xp = harr_ptr(x);
if (reuse) {
dec(xp[i]); xp[i++] = cr;
for (; i < ia; i++) xp[i] = c1(f, xp[i]);
return x;
} else {
HArr_p rp = m_harrc(x);
rp.a[i++] = cr;
for (; i < ia; i++) rp.a[i] = c1(f, inc(xp[i]));
dec(x);
return rp.b;
}
} else if (v(x)->type==t_i32arr) {
i32* xp = i32arr_ptr(x);
B r = reuse? x : m_i32arrc(x);
i32* rp = i32arr_ptr(r);
rp[i++] = o2iu(cr);
for (; i < ia; i++) {
cr = c1(f, m_i32(xp[i]));
if (!q_i32(cr)) {
rH = m_harrc(x);
for (usz j = 0; j < i; j++) rH.a[j] = m_i32(rp[j]);
if (!reuse) dec(r);
goto fallback;
}
rp[i] = o2iu(cr);
}
if (!reuse) dec(x);
return r;
} else if (v(x)->type==t_fillarr) {
B* xp = fillarr_ptr(x);
if (reuse) {
dec(c(FillArr,x)->fill);
c(FillArr,x)->fill = bi_noFill;
dec(xp[i]); xp[i++] = cr;
for (; i < ia; i++) xp[i] = c1(f, xp[i]);
return x;
} else {
HArr_p rp = m_harrc(x);
rp.a[i++] = cr;
for (; i < ia; i++) rp.a[i] = c1(f, inc(xp[i]));
dec(x);
return rp.b;
}
} else
rH = m_harrc(x);
} else
rH = m_harrc(x);
fallback:
rH.a[i++] = cr;
for (; i < ia; i++) rH.a[i] = c1(f, xget(x,i));
dec(x);
return rH.b;
return eachm(f, x);
}
B tbl_c2(B d, B w, B x) { B f = c(Md1D,d)->f;
if (isArr(w) & isArr(x)) {
usz wia = a(w)->ia; ur wr = rnk(w);
usz xia = a(x)->ia; ur xr = rnk(x);
usz ria = wia*xia; ur rr = wr+xr;
if (rr<xr) thrM("⌜: required result rank too large");
HArr_p r = m_harrp(ria);
usz* rsh = arr_shAlloc(r.b, ria, rr);
if (rsh) {
memcpy(rsh , a(w)->sh, wr*sizeof(usz));
memcpy(rsh+wr, a(x)->sh, xr*sizeof(usz));
if (isAtm(w) | isAtm(x)) {
if (isAtm(w)) w = m_unit(w);
if (isAtm(x)) x = m_unit(x);
}
usz wia = a(w)->ia; ur wr = rnk(w);
usz xia = a(x)->ia; ur xr = rnk(x);
usz ria = wia*xia; ur rr = wr+xr;
if (rr<xr) thrM("⌜: Required result rank too large");
HArr_p r = m_harrp(ria);
usz* rsh = arr_shAlloc(r.b, ria, rr);
if (rsh) {
memcpy(rsh , a(w)->sh, wr*sizeof(usz));
memcpy(rsh+wr, a(x)->sh, xr*sizeof(usz));
}
BS2B wget = TI(w).get;
BS2B xget = TI(x).get;
usz ri = 0;
for (usz wi = 0; wi < wia; wi++) {
B cw = wget(w,wi);
for (usz xi = 0; xi < xia; xi++) {
r.a[ri++] = c2(f, inc(cw), xget(x,xi));
}
BS2B wget = TI(w).get;
BS2B xget = TI(x).get;
usz ri = 0;
for (usz wi = 0; wi < wia; wi++) {
B cw = wget(w,wi);
for (usz xi = 0; xi < xia; xi++) {
r.a[ri++] = c2(f, inc(cw), xget(x,xi));
}
dec(cw);
}
dec(w); dec(x);
return r.b;
} else thrM("⌜: 𝕨 and 𝕩 must be arrays");
dec(cw);
}
dec(w); dec(x);
return r.b;
}
B each_c1(B d, B x) { B f = c(Md1D,d)->f;
return eachm(f, x);
}
B each_c2(B d, B w, B x) { B f = c(Md1D,d)->f;
return eachd(f, w, x);
}
B scan_c1(B d, B x) { B f = c(Md1D,d)->f;
if (!isArr(x) || rnk(x)==0) thrM("`: argument cannot have rank 0");
if (!isArr(x) || rnk(x)==0) thrM("`: Argument cannot have rank 0");
B xf = getFill(inc(x));
ur xr = rnk(x);
usz ia = a(x)->ia;
@ -122,15 +69,15 @@ B scan_c2(B d, B w, B x) { B f = c(Md1D,d)->f;
BS2B xget = reuse? TI(x).getU : TI(x).get;
if (isArr(w)) {
ur wr = rnk(w); usz* wsh = a(w)->sh; BS2B wget = TI(w).get;
if (wr+1 != xr) thrM("`: shape of 𝕨 must match the cell of 𝕩");
if (memcmp(wsh, xsh+1, wr)) thrM("`: shape of 𝕨 must match the cell of 𝕩");
if (wr+1 != xr) thrM("`: Shape of 𝕨 must match the cell of 𝕩");
if (memcmp(wsh, xsh+1, wr)) thrM("`: Shape of 𝕨 must match the cell of 𝕩");
if (ia==0) { ptr_dec(r.c); return x; } // only safe as r would have 0 items too
usz csz = arr_csz(x);
for (usz i = 0; i < csz; i++) r.a[i] = c2(f, wget(w,i), xget(x,i));
for (usz i = csz; i < ia; i++) r.a[i] = c2(f, inc(r.a[i-csz]), xget(x,i));
dec(w);
} else {
if (xr!=1) thrM("`: shape of 𝕨 must match the cell of 𝕩");
if (xr!=1) thrM("`: Shape of 𝕨 must match the cell of 𝕩");
if (ia==0) { ptr_dec(r.c); return x; }
B pr = r.a[0] = c2(f, w, xget(x,0));
for (usz i = 1; i < ia; i++) r.a[i] = pr = c2(f, inc(pr), xget(x,i));
@ -139,16 +86,43 @@ B scan_c2(B d, B w, B x) { B f = c(Md1D,d)->f;
return r.b;
}
B fold_c1(B d, B x) { B f = c(Md1D,d)->f;
if (!isArr(x) || rnk(x)!=1) thrM("´: argument must be a list");
usz ia = a(x)->ia;
if (ia==0) {
dec(x);
if (isFun(f)) {
B r = TI(f).identity(f);
if (!isNothing(r)) return inc(r);
}
thrM("´: No identity found");
}
BS2B xget = TI(x).get;
B c = xget(x, ia-1);
for (usz i = ia-1; i>0; i--) c = c2(f, xget(x, i-1), c);
dec(x);
return c;
}
B fold_c2(B d, B w, B x) { B f = c(Md1D,d)->f;
if (!isArr(x) || rnk(x)!=1) thrM("´: 𝕩 must be a list");
usz ia = a(x)->ia;
B c = w;
BS2B xget = TI(x).get;
for (usz i = ia; i>0; i--) c = c2(f, xget(x, i-1), c);
dec(x);
return c;
}
#define ba(NAME) bi_##NAME = mm_alloc(sizeof(Md1), t_md1_def, ftag(MD1_TAG)); c(Md1,bi_##NAME)->c2 = NAME##_c2; c(Md1,bi_##NAME)->c1 = NAME##_c1 ; c(Md1,bi_##NAME)->extra=pm1_##NAME; gc_add(bi_##NAME);
#define bd(NAME) bi_##NAME = mm_alloc(sizeof(Md1), t_md1_def, ftag(MD1_TAG)); c(Md1,bi_##NAME)->c2 = NAME##_c2; c(Md1,bi_##NAME)->c1 = c1_invalid; c(Md1,bi_##NAME)->extra=pm1_##NAME; gc_add(bi_##NAME);
#define bm(NAME) bi_##NAME = mm_alloc(sizeof(Md1), t_md1_def, ftag(MD1_TAG)); c(Md1,bi_##NAME)->c2 = c2_invalid;c(Md1,bi_##NAME)->c1 = NAME##_c1 ; c(Md1,bi_##NAME)->extra=pm1_##NAME; gc_add(bi_##NAME);
#define ba(NAME) bi_##NAME = mm_alloc(sizeof(Md1), t_md1BI, ftag(MD1_TAG)); c(Md1,bi_##NAME)->c2 = NAME##_c2; c(Md1,bi_##NAME)->c1 = NAME##_c1 ; c(Md1,bi_##NAME)->extra=pm1_##NAME; gc_add(bi_##NAME);
#define bd(NAME) bi_##NAME = mm_alloc(sizeof(Md1), t_md1BI, ftag(MD1_TAG)); c(Md1,bi_##NAME)->c2 = NAME##_c2; c(Md1,bi_##NAME)->c1 = c1_invalid; c(Md1,bi_##NAME)->extra=pm1_##NAME; gc_add(bi_##NAME);
#define bm(NAME) bi_##NAME = mm_alloc(sizeof(Md1), t_md1BI, ftag(MD1_TAG)); c(Md1,bi_##NAME)->c2 = c2_invalid;c(Md1,bi_##NAME)->c1 = NAME##_c1 ; c(Md1,bi_##NAME)->extra=pm1_##NAME; gc_add(bi_##NAME);
void print_md1_def(B x) { printf("%s", format_pm1(c(Md1,x)->extra)); }
B bi_tbl, bi_scan;
void md1_init() { ba(tbl) ba(scan)
ti[t_md1_def].print = print_md1_def;
B bi_tbl, bi_each, bi_fold, bi_scan;
static inline void md1_init() { ba(tbl) ba(each) ba(fold) ba(scan)
ti[t_md1BI].print = print_md1_def;
}
#undef ba

View File

@ -35,15 +35,15 @@ B catch_c1 (B d, B x) { return c1(c(Md2D,d)->f, x); }
B catch_c2 (B d, B w, B x) { return c2(c(Md2D,d)->f, w,x); }
#endif
#define ba(NAME) bi_##NAME = mm_alloc(sizeof(Md2), t_md2_def, ftag(MD2_TAG)); c(Md2,bi_##NAME)->c2 = NAME##_c2; c(Md2,bi_##NAME)->c1 = NAME##_c1; c(Md2,bi_##NAME)->extra=pm2_##NAME; gc_add(bi_##NAME);
#define bd(NAME) bi_##NAME = mm_alloc(sizeof(Md2), t_md2_def, ftag(MD2_TAG)); c(Md2,bi_##NAME)->c2 = NAME##_c2; c(Md2,bi_##NAME)->c1 = c1_invalid; c(Md1,bi_##NAME)->extra=pm2_##NAME; gc_add(bi_##NAME);
#define bm(NAME) bi_##NAME = mm_alloc(sizeof(Md2), t_md2_def, ftag(MD2_TAG)); c(Md2,bi_##NAME)->c2 = c2_invalid;c(Md2,bi_##NAME)->c1 = NAME##_c1; c(Md1,bi_##NAME)->extra=pm2_##NAME; gc_add(bi_##NAME);
#define ba(NAME) bi_##NAME = mm_alloc(sizeof(Md2), t_md2BI, ftag(MD2_TAG)); c(Md2,bi_##NAME)->c2 = NAME##_c2; c(Md2,bi_##NAME)->c1 = NAME##_c1; c(Md2,bi_##NAME)->extra=pm2_##NAME; gc_add(bi_##NAME);
#define bd(NAME) bi_##NAME = mm_alloc(sizeof(Md2), t_md2BI, ftag(MD2_TAG)); c(Md2,bi_##NAME)->c2 = NAME##_c2; c(Md2,bi_##NAME)->c1 = c1_invalid; c(Md1,bi_##NAME)->extra=pm2_##NAME; gc_add(bi_##NAME);
#define bm(NAME) bi_##NAME = mm_alloc(sizeof(Md2), t_md2BI, ftag(MD2_TAG)); c(Md2,bi_##NAME)->c2 = c2_invalid;c(Md2,bi_##NAME)->c1 = NAME##_c1; c(Md1,bi_##NAME)->extra=pm2_##NAME; gc_add(bi_##NAME);
void print_md2_def(B x) { printf("%s", format_pm2(c(Md1,x)->extra)); }
B bi_val, bi_fillBy, bi_catch;
void md2_init() { ba(val) ba(fillBy) ba(catch)
ti[t_md2_def].print = print_md2_def;
static inline void md2_init() { ba(val) ba(fillBy) ba(catch)
ti[t_md2BI].print = print_md2_def;
}
#undef ba

200
src/rtPerf.c Normal file
View File

@ -0,0 +1,200 @@
#ifdef RT_PERF
typedef struct WFun WFun;
struct WFun {
struct Fun;
u64 c1t, c2t;
u32 c1a, c2a;
B v;
WFun* prev;
};
WFun* lastWF;
void wf_visit(B x) { mm_visit(c(WFun,x)->v); }
B wf_identity(B x) {
B f = c(WFun,x)->v;
return inc(TI(f).identity(f));
}
u64 fwTotal;
B wf_c1(B t, B x) {
WFun* c = c(WFun,t);
B f = c->v;
BB2B fi = c(Fun,f)->c1;
u64 s = nsTime();
B r = fi(f, x);
u64 e = nsTime();
c->c1a++;
c->c1t+= e-s;
fwTotal+= e-s+20;
return r;
}
B wf_c2(B t, B w, B x) {
WFun* c = c(WFun,t);
B f = c->v;
BBB2B fi = c(Fun,f)->c2;
u64 s = nsTime();
B r = fi(f, w, x);
u64 e = nsTime();
c->c2a++;
c->c2t+= e-s;
fwTotal+= e-s+20;
return r;
}
typedef struct WMd1 WMd1;
struct WMd1 {
struct Md1;
u64 c1t, c2t;
u32 c1a, c2a;
B v;
WMd1* prev;
};
WMd1* lastWM1;
void wm1_visit(B x) { mm_visit(c(WMd1,x)->v); }
typedef struct WMd2 WMd2;
struct WMd2 {
struct Md2;
u64 c1t, c2t;
u32 c1a, c2a;
B v;
WMd2* prev;
};
WMd2* lastWM2;
void wm2_visit(B x) { mm_visit(c(WMd2,x)->v); }
B wm1_c1(B d, B x) { B f = c(Md1D,d)->f; B t = c(Md1D,d)->m1;
u64 pfwt=fwTotal; fwTotal = 0;
WMd1* c = c(WMd1,t);
B om = c->v;
u64 s = nsTime();
B fn = m1_d(inc(om), inc(f));
B r = c1(fn, x);
u64 e = nsTime();
dec(fn);
c->c1a++;
c->c1t+= e-s - fwTotal;
fwTotal = pfwt + e-s + 30;
return r;
}
B wm1_c2(B d, B w, B x) { B f = c(Md1D,d)->f; B t = c(Md1D,d)->m1;
u64 pfwt=fwTotal; fwTotal = 0;
WMd1* c = c(WMd1,t);
B om = c->v;
u64 s = nsTime();
B fn = m1_d(inc(om), inc(f));
B r = c2(fn, w, x);
u64 e = nsTime();
dec(fn);
c->c2a++;
c->c2t+= e-s - fwTotal;
fwTotal = pfwt + e-s + 30;
return r;
}
B wm2_c1(B d, B x) { B f = c(Md2D,d)->f; B g = c(Md2D,d)->g; B t = c(Md2D,d)->m2;
u64 pfwt=fwTotal; fwTotal = 0;
WMd1* c = c(WMd1,t);
B om = c->v;
u64 s = nsTime();
B fn = m2_d(inc(om), inc(f), inc(g));
B r = c1(fn, x);
u64 e = nsTime();
dec(fn);
c->c1a++;
c->c1t+= e-s - fwTotal;
fwTotal = pfwt + e-s + 30;
return r;
}
B wm2_c2(B d, B w, B x) { B f = c(Md2D,d)->f; B g = c(Md2D,d)->g; B t = c(Md2D,d)->m2;
u64 pfwt=fwTotal; fwTotal = 0;
WMd1* c = c(WMd1,t);
B om = c->v;
u64 s = nsTime();
B fn = m2_d(inc(om), inc(f), inc(g));
B r = c2(fn, w, x);
u64 e = nsTime();
dec(fn);
c->c2a++;
c->c2t+= e-s - fwTotal;
fwTotal = pfwt + e-s + 30;
return r;
}
B rtPerf_wrap(B t) {
if (isFun(t)) {
B r = mm_alloc(sizeof(WFun), t_funPerf, ftag(FUN_TAG));
c(Value,r)->extra = v(t)->extra;
c(Value,r)->flags = v(t)->flags;
c(Fun,r)->c1 = wf_c1;
c(Fun,r)->c2 = wf_c2;
c(WFun,r)->v = t;
c(WFun,r)->prev = lastWF;
c(WFun,r)->c1t = 0; c(WFun,r)->c1a = 0;
c(WFun,r)->c2t = 0; c(WFun,r)->c2a = 0;
lastWF = c(WFun,r);
return r;
}
if (isMd1(t)) {
B r = mm_alloc(sizeof(WMd1), t_md1Perf, ftag(MD1_TAG));
c(Value,r)->extra = v(t)->extra;
c(Value,r)->flags = v(t)->flags;
c(Md1,r)->c1 = wm1_c1;
c(Md1,r)->c2 = wm1_c2;
c(WMd1,r)->v = t;
c(WMd1,r)->prev = lastWM1;
c(WMd1,r)->c1t = 0; c(WMd1,r)->c1a = 0;
c(WMd1,r)->c2t = 0; c(WMd1,r)->c2a = 0;
lastWM1 = c(WMd1,r);
return r;
}
if (isMd2(t)) {
Md2* fc = c(Md2,t);
B r = mm_alloc(sizeof(WMd2), t_md2Perf, ftag(MD2_TAG));
c(Md2,r)->c1 = wm2_c1;
c(Md2,r)->c2 = wm2_c2;
c(Md2,r)->extra = fc->extra;
c(Md2,r)->flags = fc->flags;
c(WMd2,r)->v = t;
c(WMd2,r)->prev = lastWM2;
c(WMd2,r)->c1t = 0; c(WMd2,r)->c1a = 0;
c(WMd2,r)->c2t = 0; c(WMd2,r)->c2a = 0;
lastWM2 = c(WMd2,r);
return r;
}
return t;
}
void rtPerf_print() {
WFun* cf = lastWF;
while (cf) {
printRaw(c1(bi_fmtF, tag(cf,FUN_TAG)));
printf(": m=%d %.3fms | d=%d %.3fms\n", cf->c1a, cf->c1t/1e6, cf->c2a, cf->c2t/1e6);
cf = cf->prev;
}
WMd1* cm1 = lastWM1;
while (cm1) {
printRaw(c1(bi_fmtF, tag(cm1,MD1_TAG)));
printf(": m=%d %.3fms | d=%d %.3fms\n", cm1->c1a, cm1->c1t/1e6, cm1->c2a, cm1->c2t/1e6);
cm1 = cm1->prev;
}
WMd2* cm2 = lastWM2;
while (cm2) {
printRaw(c1(bi_fmtF, tag(cm2,MD2_TAG)));
printf(": m=%d %.3fms | d=%d %.3fms\n", cm2->c1a, cm2->c1t/1e6, cm2->c2a, cm2->c2t/1e6);
cm2 = cm2->prev;
}
}
static inline void rtPerf_init() {
ti[t_funPerf].visit = wf_visit; ti[t_funPerf].identity = wf_identity;
ti[t_md1Perf].visit = wm1_visit; ti[t_md1Perf].m1_d = m_md1D;
ti[t_md2Perf].visit = wm2_visit; ti[t_md2Perf].m2_d = m_md2D;
}
#else
static inline void rtPerf_init() { }
static inline B rtPerf_wrap(B f) { return f; }
static inline void rtPerf_print() { }
#endif

View File

@ -1,5 +1,118 @@
#include "h.h"
typedef struct BFn {
struct Fun;
B ident;
} BFn;
B eachd_fn(BBB2B f, B fo, B w, B x) { // consumes w,x; assumes at least one is array
usz wia; ur wr; BS2B wget;
usz xia; ur xr; BS2B xget;
if (isArr(w)) { wia = a(w)->ia; wr = rnk(w); wget = TI(w).get; } else { wia=1; wr=0; wget=def_get; }
if (isArr(x)) { xia = a(x)->ia; xr = rnk(x); xget = TI(x).get; } else { xia=1; xr=0; xget=def_get; }
bool wg = wr>xr;
if (isArr(w) & isArr(x) && !eqShPrefix(a(w)->sh, a(x)->sh, wg?xr:wr)) thrM("Mapping: Expected equal shape prefix");
HArr_p r = m_harrc(wg? w : x);
usz ria = r.c->ia;
if (wr==xr) for(usz i = 0; i < ria; i++) r.a[i] = f(fo, wget(w,i), xget(x,i));
else if (wr==0) { B c=wget(w, 0); for(usz i = 0; i < ria; i++) r.a[i] = f(fo, inc(c), xget(x,i)); dec(c); }
else if (xr==0) { B c=xget(x, 0); for(usz i = 0; i < ria; i++) r.a[i] = f(fo, wget(w,i), inc(c)); dec(c); }
else if (ria>0) {
usz min = wg? a(x)->ia : a(w)->ia;
usz ext = ria / min;
usz k = 0;
if (wg) for (usz i = 0; i < min; i++) { B c=xget(x,i); for (usz j = 0; j < ext; j++) { r.a[k] = f(fo, wget(w,k), inc(c)); k++; } }
else for (usz i = 0; i < min; i++) { B c=wget(w,i); for (usz j = 0; j < ext; j++) { r.a[k] = f(fo, inc(c), xget(x,k)); k++; } }
}
dec(w); dec(x);
return r.b;
}
B eachm_fn(BB2B f, B fo, B x) { // consumes x; x must be array
usz ia = a(x)->ia;
if (ia==0) return x;
BS2B xget = TI(x).get;
usz i = 0;
B cr = f(fo, xget(x,0));
HArr_p rH;
if (TI(x).canStore(cr)) {
bool reuse = reusable(x);
if (v(x)->type==t_harr) {
B* xp = harr_ptr(x);
if (reuse) {
dec(xp[i]); xp[i++] = cr;
for (; i < ia; i++) xp[i] = f(fo, xp[i]);
return x;
} else {
HArr_p rp = m_harrc(x);
rp.a[i++] = cr;
for (; i < ia; i++) rp.a[i] = f(fo, inc(xp[i]));
dec(x);
return rp.b;
}
} else if (v(x)->type==t_i32arr) {
i32* xp = i32arr_ptr(x);
B r = reuse? x : m_i32arrc(x);
i32* rp = i32arr_ptr(r);
rp[i++] = o2iu(cr);
for (; i < ia; i++) {
cr = f(fo, m_i32(xp[i]));
if (!q_i32(cr)) {
rH = m_harrc(x);
for (usz j = 0; j < i; j++) rH.a[j] = m_i32(rp[j]);
if (!reuse) dec(r);
goto fallback;
}
rp[i] = o2iu(cr);
}
if (!reuse) dec(x);
return r;
} else if (v(x)->type==t_fillarr) {
B* xp = fillarr_ptr(x);
if (reuse) {
dec(c(FillArr,x)->fill);
c(FillArr,x)->fill = bi_noFill;
dec(xp[i]); xp[i++] = cr;
for (; i < ia; i++) xp[i] = f(fo, xp[i]);
return x;
} else {
HArr_p rp = m_harrc(x);
rp.a[i++] = cr;
for (; i < ia; i++) rp.a[i] = f(fo, inc(xp[i]));
dec(x);
return rp.b;
}
} else
rH = m_harrc(x);
} else
rH = m_harrc(x);
fallback:
rH.a[i++] = cr;
for (; i < ia; i++) rH.a[i] = f(fo, xget(x,i));
dec(x);
return rH.b;
}
B eachm(B f, B x) { // complete F¨ x
if (!isArr(x)) return m_unit(c1(f, x));
if (isFun(f)) return eachm_fn(c(Fun,f)->c1, f, x);
if (isMd(f)) if (!isArr(x) || a(x)->ia) { decR(x); thrM("Calling a modifier"); }
HArr_p r = m_harrc(x);
for(usz i = 0; i < r.c->ia; i++) r.a[i] = inc(f);
dec(x);
return r.b;
}
B eachd(B f, B w, B x) { // complete w F¨ x
if (!isArr(w) & !isArr(x)) return m_unit(c2(f, w, x));
if (isFun(f)) return eachd_fn(c(Fun,f)->c2, f, w, x);
if (isArr(w) && isArr(x) && !eqShPrefix(a(w)->sh, a(x)->sh, minRank(w, x))) { decR(x); thrM("Mapping: Expected equal shape prefix"); }
if (isMd(f)) if ((isArr(w)&&a(w)->ia) || (isArr(x)&&a(x)->ia)) { decR(x); thrM("Calling a modifier"); } // case where both are scalars has already been taken care of
HArr_p r = m_harrc(!isArr(w)? x : rnk(w)>rnk(x)? w : x);
for(usz i = 0; i < r.c->ia; i++) r.a[i] = inc(f);
dec(w); dec(x);
return r.b;
}
B shape_c1(B t, B x) {
if (!isArr(x)) thrM("reshaping non-array");
usz ia = a(x)->ia;
@ -62,6 +175,25 @@ B ud_c1(B t, B x) {
B pair_c1(B t, B x) { return m_v1( x); }
B pair_c2(B t, B w, B x) { return m_v2(w, x); }
B ltack_c1(B t, B x) { return x; }
B ltack_c2(B t, B w, B x) { dec(x); return w; }
B rtack_c1(B t, B x) { return x; }
B rtack_c2(B t, B w, B x) { dec(w); return x; }
B fmtN_c1(B t, B x) {
const u64 BL = 100;
char buf[BL];
if (isF64(x)) snprintf(buf, BL, "%g", x.f);
else snprintf(buf, BL, "(fmtN: not given a number?)");
return m_str8(strlen(buf), buf);
}
B fmtF_c1(B t, B x) {
if (!isVal(x)) return m_str32(U"(fmtF: not given a function)");
u8 fl = v(x)->flags;
if (fl==0 || fl>=rtLen) return m_str32(U"(fmtF: not given a runtime primitive)");
dec(x);
return m_c32(U"+-×÷⋆√⌊⌈|¬∧∨<>≠=≤≥≡≢⊣⊢⥊∾≍↑↓↕«»⌽⍉/⍋⍒⊏⊑⊐⊒∊⍷⊔!˙˜˘¨⌜⁼´˝`∘○⊸⟜⌾⊘◶⎉⚇⍟"[fl-1]);
}
B fne_c1(B t, B x) {
if (isArr(x)) {
@ -82,43 +214,49 @@ B fne_c1(B t, B x) {
return m_i32arrv(0);
}
}
B lt_c1(B t, B x) { return x; }
B lt_c2(B t, B w, B x) { dec(x); return w; }
B rt_c1(B t, B x) { return x; }
B rt_c2(B t, B w, B x) { dec(w); return x; }
B fmtN_c1(B t, B x) {
const u64 BL = 100;
char buf[BL];
if (isF64(x)) snprintf(buf, BL, "%g", x.f);
else snprintf(buf, BL, "(fmtN: not given a number?)");
return m_str8(strlen(buf), buf);
u64 depth(B x) { // doesn't consume
if (!isArr(x)) return 0;
u64 r = 1;
usz ia = a(x)->ia;
BS2B xgetU = TI(x).getU;
for (usz i = 0; i < ia; i++) {
u64 n = depth(xgetU(x,i))+1;
if (n>r) r = n;
}
return r;
}
B fmtF_c1(B t, B x) {
if (!isVal(x)) return m_str32(U"(fmtF: not given a function)");
u8 fl = v(x)->flags;
if (fl==0 || fl>=rtLen) return m_str32(U"(fmtF: not given a runtime primitive)");
B feq_c1(B t, B x) {
u64 r = depth(x);
dec(x);
return m_c32(U"+-×÷⋆√⌊⌈|¬∧∨<>≠=≤≥≡≢⊣⊢⥊∾≍↑↓↕«»⌽⍉/⍋⍒⊏⊑⊐⊒∊⍷⊔!˙˜˘¨⌜⁼´˝`∘○⊸⟜⌾⊘◶⎉⚇⍟"[fl-1]);
return m_f64(r);
}
B feq_c2(B t, B w, B x) {
bool r = equal(w, x);
dec(w); dec(x);
return m_i32(r);
}
B fne_c2(B t, B w, B x) {
bool r = !equal(w, x);
dec(w); dec(x);
return m_i32(r);
}
#define ba(NAME) bi_##NAME = mm_alloc(sizeof(Fun), t_fun_def, ftag(FUN_TAG)); c(Fun,bi_##NAME)->c2 = NAME##_c2; c(Fun,bi_##NAME)->c1 = NAME##_c1 ; c(Fun,bi_##NAME)->extra=pf_##NAME; gc_add(bi_##NAME);
#define bd(NAME) bi_##NAME = mm_alloc(sizeof(Fun), t_fun_def, ftag(FUN_TAG)); c(Fun,bi_##NAME)->c2 = NAME##_c2; c(Fun,bi_##NAME)->c1 = c1_invalid; c(Fun,bi_##NAME)->extra=pf_##NAME; gc_add(bi_##NAME);
#define bm(NAME) bi_##NAME = mm_alloc(sizeof(Fun), t_fun_def, ftag(FUN_TAG)); c(Fun,bi_##NAME)->c2 = c2_invalid;c(Fun,bi_##NAME)->c1 = NAME##_c1 ; c(Fun,bi_##NAME)->extra=pf_##NAME; gc_add(bi_##NAME);
B funBI_identity(B x) {
return inc(c(BFn,x)->ident);
}
#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_nothing; 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_nothing; 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_nothing; gc_add(bi_##N);
void print_fun_def(B x) { printf("%s", format_pf(c(Fun,x)->extra)); }
B bi_shape, bi_pick, bi_ud, bi_pair, bi_fne, bi_feq, bi_lt, bi_rt, bi_fmtF, bi_fmtN;
void sfns_init() { ba(shape) ba(pick) bm(ud) ba(pair) bm(fne) bd(feq) ba(lt) ba(rt) bm(fmtF) bm(fmtN)
ti[t_fun_def].print = print_fun_def;
B bi_shape, bi_pick, bi_ud, bi_pair, bi_fne, bi_feq, bi_ltack, bi_rtack, bi_fmtF, bi_fmtN;
static inline void sfns_init() { ba(shape) ba(pick) bm(ud) ba(pair) ba(fne) ba(feq) ba(ltack) ba(rtack) bm(fmtF) bm(fmtN)
ti[t_funBI].print = print_fun_def;
ti[t_funBI].identity = funBI_identity;
}
#undef ba

View File

@ -131,12 +131,12 @@ B internal_c2(B t, B w, B x) {
B sys_c1(B t, B x);
#define ba(NAME) bi_##NAME = mm_alloc(sizeof(Fun), t_fun_def, ftag(FUN_TAG)); c(Fun,bi_##NAME)->c2 = NAME##_c2; c(Fun,bi_##NAME)->c1 = NAME##_c1 ; c(Fun,bi_##NAME)->extra=pf_##NAME; gc_add(bi_##NAME);
#define bd(NAME) bi_##NAME = mm_alloc(sizeof(Fun), t_fun_def, ftag(FUN_TAG)); c(Fun,bi_##NAME)->c2 = NAME##_c2; c(Fun,bi_##NAME)->c1 = c1_invalid; c(Fun,bi_##NAME)->extra=pf_##NAME; gc_add(bi_##NAME);
#define bm(NAME) bi_##NAME = mm_alloc(sizeof(Fun), t_fun_def, ftag(FUN_TAG)); c(Fun,bi_##NAME)->c2 = c2_invalid;c(Fun,bi_##NAME)->c1 = NAME##_c1 ; c(Fun,bi_##NAME)->extra=pf_##NAME; gc_add(bi_##NAME);
#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_nothing; 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_nothing; 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_nothing; 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;
void sysfn_init() { bm(type) bm(decp) bm(primInd) bm(glyph) ba(fill) ba(grLen) bd(grOrd) ba(asrt) bm(sys) bd(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

View File

@ -219,7 +219,7 @@ void v_set(Scope* sc, B s, B x, bool upd) { // frees s, doesn't consume x
sc->vars[(u32)s.u] = inc(x);
} else {
VT(s, t_harr);
if (!shEq(s, x)) err("spread assignment: mismatched shape");
if (!eqShape(s, x)) err("spread assignment: mismatched shape");
usz ia = a(x)->ia;
B* sp = harr_ptr(s);
BS2B xget = TI(x).get;
@ -501,7 +501,7 @@ B block_decompose(B x) { return m_v2(m_i32(1), x); }
B bl_m1d(B m, B f ) { Md1Block* c = c(Md1Block,m); return c->bl->imm? actualExec(c(Md1Block, m)->bl, c(Md1Block, m)->sc, 2, (B[]){m, f }) : m_md1D(m,f ); }
B bl_m2d(B m, B f, B g) { Md2Block* c = c(Md2Block,m); return c->bl->imm? actualExec(c(Md2Block, m)->bl, c(Md2Block, m)->sc, 3, (B[]){m, f, g}) : m_md2D(m,f,g); }
void comp_init() {
static inline void comp_init() {
ti[t_comp ].free = comp_free; ti[t_comp ].visit = comp_visit; ti[t_comp ].print = comp_print;
ti[t_body ].free = body_free; ti[t_body ].visit = body_visit; ti[t_body ].print = body_print;
ti[t_block ].free = block_free; ti[t_block ].visit = block_visit; ti[t_block ].print = block_print;