diff --git a/src/arith.c b/src/arith.c index 07d0ee32..89ec5c61 100644 --- a/src/arith.c +++ b/src/arith.c @@ -1,30 +1,51 @@ #include "h.h" #include -#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; i0?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 diff --git a/src/c32arr.c b/src/c32arr.c index bef8589f..6ec449b0 100644 --- a/src/c32arr.c +++ b/src/c32arr.c @@ -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; diff --git a/src/derv.c b/src/derv.c index 9123ebcd..ae9fedce 100644 --- a/src/derv.c +++ b/src/derv.c @@ -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; } diff --git a/src/fillarr.c b/src/fillarr.c index ebedfe66..b2014d84 100644 --- a/src/fillarr.c +++ b/src/fillarr.c @@ -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; diff --git a/src/h.h b/src/h.h index 1e14cc04..016fd835 100644 --- a/src/h.h +++ b/src/h.h @@ -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 wrxr? 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; } diff --git a/src/harr.c b/src/harr.c index 86b2875d..915b8481 100644 --- a/src/harr.c +++ b/src/harr.c @@ -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; diff --git a/src/i32arr.c b/src/i32arr.c index ed229880..8dd7eee0 100644 --- a/src/i32arr.c +++ b/src/i32arr.c @@ -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; diff --git a/src/main.c b/src/main.c index c760e33c..dec67a88 100644 --- a/src/main.c +++ b/src/main.c @@ -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); diff --git a/src/md1.c b/src/md1.c index 1af34858..93123e3b 100644 --- a/src/md1.c +++ b/src/md1.c @@ -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 (rrsh, 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 (rrsh, 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 diff --git a/src/md2.c b/src/md2.c index 70a5a14f..f46ae9ab 100644 --- a/src/md2.c +++ b/src/md2.c @@ -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 diff --git a/src/rtPerf.c b/src/rtPerf.c new file mode 100644 index 00000000..b1c2882a --- /dev/null +++ b/src/rtPerf.c @@ -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 \ No newline at end of file diff --git a/src/sfns.c b/src/sfns.c index b4bf42e7..87e30733 100644 --- a/src/sfns.c +++ b/src/sfns.c @@ -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 diff --git a/src/sysfn.c b/src/sysfn.c index 0baef606..1761ce91 100644 --- a/src/sysfn.c +++ b/src/sysfn.c @@ -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 diff --git a/src/vm.c b/src/vm.c index 734fd2e8..957f258e 100644 --- a/src/vm.c +++ b/src/vm.c @@ -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;