From d42a6516b76cbc39889fa0672845d324bae157d6 Mon Sep 17 00:00:00 2001 From: dzaima Date: Mon, 10 May 2021 16:15:34 +0300 Subject: [PATCH] =?UTF-8?q?native=20=F0=9D=95=A8=E2=8D=8B=F0=9D=95=A9?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- src/fns.c | 20 +++++++------- src/grade.c | 65 +++++++++++++++++++++++++++++++++++++++++++++ src/h.h | 21 ++++++++++++--- src/harr.c | 29 ++++++++++++++++++++ src/i32arr.c | 27 ++++++++++--------- src/load.c | 15 ++++++----- src/main.c | 4 ++- src/mut.c | 8 +++--- src/sfns.c | 15 +++-------- src/stuff.c | 75 +++++++++++++++++++++++++++++++++++++++------------- src/sysfn.c | 19 ++++++------- 11 files changed, 221 insertions(+), 77 deletions(-) create mode 100644 src/grade.c diff --git a/src/fns.c b/src/fns.c index 0c7d1a91..c60172e2 100644 --- a/src/fns.c +++ b/src/fns.c @@ -109,18 +109,18 @@ B fne_c2(B t, B w, B x) { } -#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_N; 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_N; 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_N; gc_add(bi_##N); +#define BI_A(N) { B t=bi_##N = mm_alloc(sizeof(BFn), t_funBI, ftag(FUN_TAG)); BFn*f=c(BFn,t); f->c2=N##_c2 ; f->c1=N##_c1 ; f->extra=pf_##N; f->ident=bi_N; gc_add(t); } +#define BI_D(N) { B t=bi_##N = mm_alloc(sizeof(BFn), t_funBI, ftag(FUN_TAG)); BFn*f=c(BFn,t); f->c2=N##_c2 ; f->c1=c1_invalid; f->extra=pf_##N; f->ident=bi_N; gc_add(t); } +#define BI_M(N) { B t=bi_##N = mm_alloc(sizeof(BFn), t_funBI, ftag(FUN_TAG)); BFn*f=c(BFn,t); f->c2=c2_invalid; f->c1=N##_c1 ; f->extra=pf_##N; f->ident=bi_N; gc_add(t); } +#define BI_VAR(N) B bi_##N; +#define BI_FNS0(F) F(BI_VAR,BI_VAR,BI_VAR) +#define BI_FNS1(F) F(BI_A,BI_M,BI_D) - -B bi_ud, bi_fne, bi_feq, bi_ltack, bi_rtack, bi_fmtF, bi_fmtN; -static inline void fns_init() { bm(ud) ba(fne) ba(feq) ba(ltack) ba(rtack) bm(fmtF) bm(fmtN) +#define F(A,M,D) M(ud) A(fne) A(feq) A(ltack) A(rtack) M(fmtF) M(fmtN) +BI_FNS0(F); +static inline void fns_init() { BI_FNS1(F) ti[t_funBI].print = print_funBI; ti[t_funBI].identity = funBI_identity; } - -#undef ba -#undef bd -#undef bm +#undef F \ No newline at end of file diff --git a/src/grade.c b/src/grade.c new file mode 100644 index 00000000..627a62fb --- /dev/null +++ b/src/grade.c @@ -0,0 +1,65 @@ +#include "h.h" + +B rt_gradeUp; +B gradeUp_c1(B t, B x) { + return c1(rt_gradeUp, x); +} +B gradeUp_c2(B t, B w, B x) { + if (isAtm(w) || rnk(w)==0) thrM("⍋: 𝕨 must have rank≥1"); + if (isAtm(x)) x = m_atomUnit(x); + ur wr = rnk(w); + ur xr = rnk(x); + + if (wr > 1) { + if (wr > xr+1) thrM("⍋: =𝕨 cannot be greater than =𝕩"); + i32 nxr = xr-wr+1; + x = toKCells(x, nxr); xr = nxr; + w = toCells(w); xr = 1; + } + + u8 we = TI(w).elType; usz wia = a(w)->ia; + u8 xe = TI(x).elType; usz xia = a(x)->ia; + + if (wia>I32_MAX-10) thrM("⍋: 𝕨 too big"); + B r = m_i32arrc(x); + i32* ri = i32arr_ptr(r); + + if (we==el_i32 & xe==el_i32) { + i32* wi = i32any_ptr(w); + i32* xi = i32any_ptr(x); + if (CHECK_VALID) for (usz i = 0; i < (i64)wia-1; i++) if (wi[i] > wi[i+1]) thrM("⍋: 𝕨 must be sorted"); + + for (usz i = 0; i < xia; i++) { + i32 c = xi[i]; + usz s = 0, e = wia+1; + while (e-s > 1) { + usz m = (s+(i64)e)/2; + if (c < wi[m-1]) e = m; + else s = m; + } + ri[i] = s; + } + } else { + BS2B wgetU = TI(w).getU; + BS2B xgetU = TI(x).getU; + if (CHECK_VALID) for (usz i = 0; i < wia-1; i++) if (compare(wgetU(w,i), wgetU(w,i+1)) > 0) thrM("⍋: 𝕨 must be sorted"); + + for (usz i = 0; i < xia; i++) { + B c = xgetU(x,i); + usz s = 0, e = wia+1; + while (e-s > 1) { + usz m = (s+e) / 2; + if (compare(c, wgetU(w,m-1)) < 0) e = m; + else s = m; + } + ri[i] = s; + } + } + dec(w);dec(x); + return r; +} + +#define F(A,M,D) A(gradeUp) +BI_FNS0(F); +static inline void grade_init() { BI_FNS1(F) } +#undef F diff --git a/src/h.h b/src/h.h index 9ba86719..e9b9756c 100644 --- a/src/h.h +++ b/src/h.h @@ -23,6 +23,7 @@ #define UD __builtin_unreachable(); #define NOINLINE __attribute__ ((noinline)) #define NORETURN __attribute__ ((noreturn)) +#define AUTO __auto_type typedef u32 usz; typedef u8 ur; @@ -106,8 +107,9 @@ char* format_type(u8 u) { /*fns.c*/ F(ud,"↕") F(fne,"≢") F(feq,"≡") F(ltack,"⊣") F(rtack,"⊢") F(fmtF,"•FmtF") F(fmtN,"•FmtN") \ /*sfns.c*/ F(shape,"⥊") F(pick,"⊑") F(pair,"{𝕨‿𝕩}") F(select,"⊏") F(slash,"/") F(join,"∾") F(couple,"≍") F(shiftb,"»") F(shifta,"«") F(take,"↑") F(drop,"↓") \ /*derv.c*/ F(fork,"(fork)") F(atop,"(atop)") F(md1d,"(derived 1-modifier)") F(md2d,"(derived 2-modifier)") \ + /*sort.c*/ F(gradeUp,"⍋") \ /*sysfn.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(bqn,"•bqn") F(internal,"•Internal") F(show,"•Show") F(out,"•Out") + /*sysfn.c*/ F(grLen,"•GroupLen") F(grOrd,"•groupOrd") F(asrt,"!") F(sys,"•getsys") F(bqn,"•BQN") F(cmp,"•Cmp") F(internal,"•Internal") F(show,"•Show") F(out,"•Out") enum PrimFns { #define F(N,X) pf_##N, @@ -216,19 +218,22 @@ void printUTF8(u32 c); void printRaw(B x); // doesn't consume void print(B x); // doesn't consume bool equal(B w, B x); // doesn't consume +i32 compare(B w, B x); // doesn't consume; -1 if wx, 0 if w≡x; 0==compare(NaN,NaN) void arr_print(B x); // doesn't consume u8 fillElType(B x); // doesn't consume bool eqShape(B w, B x); // doesn't consume usz arr_csz(B x); // doesn't consume bool atomEqual(B w, B x); // doesn't consume B toCells(B x); // consumes +B toKCells(B x, ur k); // consumes bool eqShPrefix(usz* w, usz* x, ur len); B m_v1(B a ); // consumes all B m_v2(B a, B b ); // consumes all B m_v3(B a, B b, B c ); // consumes all B m_v4(B a, B b, B c, B d); // consumes all -B m_unit(B a); // consumes +B m_unit (B x); // consumes +B m_hunit(B x); // consumes B m_str32(u32* s); // meant to be used as m_str32(U"{𝕨‿𝕩}"), so doesn't free for you B bqn_exec(B str); // consumes @@ -307,9 +312,13 @@ void arr_shVec(B x, usz ia) { srnk(x, 1); a(x)->sh = &a(x)->ia; } +ShArr* m_shArr(ur r) { + assert(r>1); + return ((ShArr*)mm_allocN(fsizeof(ShArr, a, usz, r), t_shape)); +} usz* arr_shAllocR(B x, ur r) { // allocates shape, sets rank srnk(x,r); - if (r>1) return a(x)->sh = ((ShArr*)mm_allocN(fsizeof(ShArr, a, usz, r), t_shape))->a; + if (r>1) return a(x)->sh = m_shArr(r)->a; a(x)->sh = &a(x)->ia; return 0; } @@ -317,6 +326,12 @@ usz* arr_shAllocI(B x, usz ia, ur r) { // allocates shape, sets ia,rank a(x)->ia = ia; return arr_shAllocR(x, r); } +void arr_shSetI(B x, usz ia, ur r, ShArr* sh) { + srnk(x,r); + a(x)->ia = ia; + if (r>1) { a(x)->sh = sh->a; ptr_inc(sh); } + else { a(x)->sh = &a(x)->ia; } +} void arr_shCopy(B n, B o) { // copy shape,rank,ia from o to n assert(isArr(o)); a(n)->ia = a(o)->ia; diff --git a/src/harr.c b/src/harr.c index 9b9f8900..a4fe798d 100644 --- a/src/harr.c +++ b/src/harr.c @@ -88,6 +88,35 @@ B toCells(B x) { dec(x); return harr_fv(r); } +B toKCells(B x, ur k) { + assert(isArr(x) && k<=rnk(x) && k>=0); + ur xr = rnk(x); usz* xsh = a(x)->sh; + ur cr = xr-k; + usz cam = 1; for (i32 i = 0; i < k ; i++) cam*= xsh[i]; + usz csz = 1; for (i32 i = k; i < xr; i++) csz*= xsh[i]; + + ShArr* csh; + if (cr>1) { + csh = m_shArr(cr); + for (i32 i = 0; i < cr; i++) csh->a[i] = xsh[i+k]; + } + + usz i = 0; + usz p = 0; + HArr_p r = m_harrs(cam, &i); + BS2B slice = TI(x).slice; + for (; i < cam; i++) { + B s = slice(inc(x), p); + arr_shSetI(s, csz, cr, csh); + r.a[i] = s; + p+= csz; + } + if (cr>1) ptr_dec(csh); + usz* rsh = harr_fa(r, k); + if (rsh) for (i32 i = 0; i < k; i++) rsh[i] = xsh[i]; + dec(x); + return r.b; +} B* harr_ptr(B x) { VT(x,t_harr); return c(HArr,x)->a; } diff --git a/src/i32arr.c b/src/i32arr.c index 0304ae0d..88fb42da 100644 --- a/src/i32arr.c +++ b/src/i32arr.c @@ -23,9 +23,22 @@ B m_i32arrp(usz ia) { // doesn't write shape/rank } -i32* i32arr_ptr(B x) { VT(x, t_i32arr); return c(I32Arr,x)->a; } +typedef struct I32Slice { + struct Slice; + i32* a; +} I32Slice; +B m_i32slice(B p, i32* ptr) { + I32Slice* r = mm_allocN(sizeof(I32Slice), t_i32slice); + r->p = p; + r->a = ptr; + return tag(r, ARR_TAG); +} + +i32* i32arr_ptr(B x) { VT(x, t_i32arr); return c(I32Arr,x)->a; } +i32* i32any_ptr(B x) { assert(isArr(x)); u8 t=v(x)->type; if(t==t_i32arr) return c(I32Arr,x)->a; assert(t==t_i32slice); return c(I32Slice,x)->a; } + NOINLINE B m_cai32(usz ia, i32* a) { B r = m_i32arrv(ia); i32* rp = i32arr_ptr(r); @@ -45,21 +58,9 @@ I32Arr* toI32Arr(B x) { } -typedef struct I32Slice { - struct Slice; - i32* a; -} I32Slice; -B m_i32slice(B p, i32* ptr) { - I32Slice* r = mm_allocN(sizeof(I32Slice), t_i32slice); - r->p = p; - r->a = ptr; - return tag(r, ARR_TAG); -} - B i32arr_slice (B x, usz s) {return m_i32slice(x , c(I32Arr ,x)->a+s); } B i32slice_slice(B x, usz s) { B r = m_i32slice(inc(c(Slice,x)->p), c(I32Slice,x)->a+s); dec(x); return r; } - B i32arr_get (B x, usz n) { VT(x,t_i32arr ); return m_i32(c(I32Arr ,x)->a[n]); } 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); } diff --git a/src/load.c b/src/load.c index 8e76932b..fdeab248 100644 --- a/src/load.c +++ b/src/load.c @@ -41,19 +41,19 @@ void bqn_setComp(B comp) { // consumes; doesn't unload old comp, but whatever static inline void load_init() { B fruntime[] = { - /* +-×÷⋆√⌊⌈|¬ */ 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_join , bi_couple, bi_take , bi_drop , bi_ud , bi_shifta, bi_shiftb, - /* ⌽⍉/⍋⍒⊏⊑⊐⊒∊ */ bi_N , bi_N , bi_slash, bi_N , bi_N , bi_select, bi_pick , bi_N , bi_N , bi_N, - /* ⍷⊔!˙˜˘¨⌜⁼´ */ bi_N , bi_N , bi_asrt , bi_const, bi_swap , bi_N , bi_each , bi_tbl , bi_N , bi_fold, - /* ˝`∘○⊸⟜⌾⊘◶⎉ */ bi_N , bi_scan , bi_atop , bi_over , bi_before, bi_after , bi_N , bi_val , bi_cond , bi_N, + /* +-×÷⋆√⌊⌈|¬ */ 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_join , bi_couple, bi_take , bi_drop , bi_ud , bi_shifta, bi_shiftb, + /* ⌽⍉/⍋⍒⊏⊑⊐⊒∊ */ bi_N , bi_N , bi_slash, bi_gradeUp, bi_N , bi_select, bi_pick , bi_N , bi_N , bi_N, + /* ⍷⊔!˙˜˘¨⌜⁼´ */ bi_N , bi_N , bi_asrt , bi_const , bi_swap , bi_N , bi_each , bi_tbl , bi_N , bi_fold, + /* ˝`∘○⊸⟜⌾⊘◶⎉ */ bi_N , bi_scan , bi_atop , bi_over , bi_before, bi_after , bi_N , bi_val , bi_cond , bi_N, /* ⚇⍟⎊ */ bi_N , bi_repeat, 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,1,1,0,0,0,1,1, - /* ⌽⍉/⍋⍒⊏⊑⊐⊒∊ */ 0,0,1,0,0,1,0,0,0,0, + /* ⌽⍉/⍋⍒⊏⊑⊐⊒∊ */ 0,0,1,1,0,1,0,0,0,0, /* ⍷⊔!˙˜˘¨⌜⁼´ */ 0,0,1,1,1,0,1,1,0,1, /* ˝`∘○⊸⟜⌾⊘◶⎉ */ 0,1,1,1,1,1,0,1,0,0, /* ⚇⍟⎊ */ 0,1,1 @@ -98,6 +98,7 @@ static inline void load_init() { rt_select = rtObjGet(rtObjRaw, 35); gc_add(rt_select); rt_slash = rtObjGet(rtObjRaw, 32); gc_add(rt_slash); rt_join = rtObjGet(rtObjRaw, 23); gc_add(rt_join); + rt_gradeUp = rtObjGet(rtObjRaw, 33); gc_add(rt_gradeUp); for (usz i = 0; i < runtimeLen; i++) { #ifdef ALL_R1 diff --git a/src/main.c b/src/main.c index d1f7f3d8..e43577d1 100644 --- a/src/main.c +++ b/src/main.c @@ -14,6 +14,7 @@ // #define ALL_R0 // use all of r0.bqn for runtime_0 // #define ALL_R1 // use all of r1.bqn for runtime #define VM_POS false // whether to store detailed execution position information for stacktraces +#define CHECK_VALID true // whether to check for valid arguments in places where that would be detrimental to performance (e.g. left argument sortedness of ⍋/⍒) #define EACH_FILLS false // whether to try to squeeze out fills for ¨ and ⌜ #define SFNS_FILLS true // whether to insert fills for structural functions (∾, ≍, etc) #define FAKE_RUNTIME false // whether to disable the self-hosted runtime @@ -49,6 +50,7 @@ #include "sfns.c" #include "sysfn.c" #include "arith.c" +#include "grade.c" #include "md1.c" #include "md2.c" #include "vm.c" @@ -75,7 +77,7 @@ int main() { // } // if (c_src) { // bqn_setComp(bqn_exec(fromUTF8(c_src, c_len))); - // // for (i32 i = 0; i < 100; i++) { dec(bqn_exec(fromUTF8(c_src, c_len))); gc_maybeGC(); } + // // for (i32 i = 0; i < 100; i++) { dec(bqn_exec(fromUTF8(c_src, c_len))); gc_maybeGC(); } rtPerf_print(); exit(0); // } else { // printf("couldn't read c.bqn\n"); // exit(1); diff --git a/src/mut.c b/src/mut.c index 434dbdb0..3b8435ad 100644 --- a/src/mut.c +++ b/src/mut.c @@ -129,10 +129,8 @@ void mut_copy(Mut* m, usz ms, B x, usz xs, usz l) { case el_MAX: AGAIN; case el_i32: { - i32* xp; - if (xt==t_i32arr) xp = i32arr_ptr(x); - else if (xt==t_i32slice) xp = c(I32Slice,x)->a; - else AGAIN; + if (xt!=t_i32arr & xt!=t_i32slice) AGAIN; + i32* xp = i32any_ptr(x); memcpy(((I32Arr*)m->val)->a+ms, xp+xs, l*4); return; } @@ -149,7 +147,7 @@ void mut_copy(Mut* m, usz ms, B x, usz xs, usz l) { if (xt==t_f64arr) xp = f64arr_ptr(x); else if (xt==t_f64slice) xp = c(F64Slice,x)->a; else if (xt==t_i32arr|xt==t_i32slice) { - i32* xp = xt==t_i32arr? i32arr_ptr(x) : c(I32Slice,x)->a; + i32* xp = i32any_ptr(x); f64* rp = ((F64Arr*)m->val)->a+ms; for (usz i = 0; i < l; i++) rp[i] = xp[i+xs]; return; diff --git a/src/sfns.c b/src/sfns.c index e2099051..e43a0a3e 100644 --- a/src/sfns.c +++ b/src/sfns.c @@ -571,14 +571,7 @@ B shifta_c2(B t, B w, B x) { return qWithFill(mut_fcd(r, x), f); } -#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_N; 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_N; 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_N; gc_add(bi_##N); - -B bi_shape, bi_pick, bi_pair, bi_select, bi_slash, bi_join, bi_couple, bi_shiftb, bi_shifta, bi_take, bi_drop; -static inline void sfns_init() { ba(shape) ba(pick) ba(pair) ba(select) ba(slash) ba(join) ba(couple) ba(shiftb) ba(shifta) bd(take) bd(drop) -} - -#undef ba -#undef bd -#undef bm +#define F(A,M,D) A(shape) A(pick) A(pair) A(select) A(slash) A(join) A(couple) A(shiftb) A(shifta) D(take) D(drop) +BI_FNS0(F); +static inline void sfns_init() { BI_FNS1(F) } +#undef F diff --git a/src/stuff.c b/src/stuff.c index 978f77f0..036f3f41 100644 --- a/src/stuff.c +++ b/src/stuff.c @@ -10,6 +10,24 @@ #endif +void empty_free(B x) { err("FREEING EMPTY\n"); } +void builtin_free(B x) { err("FREEING BUILTIN\n"); } +void def_visit(B x) { printf("(no visit for %d=%s)\n", v(x)->type, format_type(v(x)->type)); } +void freed_visit(B x) { + #ifndef CATCH_ERRORS + err("visiting t_freed\n"); + #endif +} +void def_print(B x) { printf("(%d=%s)", v(x)->type, format_type(v(x)->type)); } +B def_identity(B f) { return bi_N; } +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 ) { thrM("cannot derive this"); } +B def_m2_d(B m, B f, B g) { thrM("cannot derive this"); } +B def_slice(B x, usz s) { thrM("cannot slice non-array!"); } +bool def_canStore(B x) { return false; } + + void arr_print(B x) { // should accept refc=0 arguments for debugging purposes ur r = rnk(x); BS2B xgetU = TI(x).getU; @@ -125,6 +143,44 @@ bool equal(B w, B x) { // doesn't consume return true; } +#define CMP(W,X) ({ AUTO wt = (W); AUTO xt = (X); (wt>xt?1:0)-(wtia; wr=rnk(w); wsh=a(w)->sh; wgetU=TI(w).getU; } + if(xa) { xia=1; xr=0; xsh=NULL; xgetU=def_getU; } else { xia=a(x)->ia; xr=rnk(x); xsh=a(x)->sh; xgetU=TI(x).getU; } + if (wia==0 || xia==0) return CMP(wia, xia); + + i32 rc = CMP(wr+(wa?0:1), xr+(xa?0:1)); + ur rr = wrtype, format_type(v(x)->type)); } -void freed_visit(B x) { - #ifndef CATCH_ERRORS - err("visiting t_freed\n"); - #endif -} -void def_print(B x) { printf("(%d=%s)", v(x)->type, format_type(v(x)->type)); } -B def_identity(B f) { return bi_N; } -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 ) { thrM("cannot derive this"); } -B def_m2_d(B m, B f, B g) { thrM("cannot derive this"); } -B def_slice(B x, usz s) { thrM("cannot slice non-array!"); } -bool def_canStore(B x) { return false; } - static inline void hdr_init() { for (i32 i = 0; i < t_COUNT; i++) { ti[i].free = do_nothing; @@ -322,7 +361,7 @@ void printAllocStats() { #endif } -#define FOR_INIT(F) F(hdr) F(harr) F(fillarr) F(i32arr) F(c32arr) F(f64arr) F(arith) F(fns) F(sfns) F(md1) F(md2) F(sysfn) F(derv) F(comp) F(rtPerf) F(ns) F(load) +#define FOR_INIT(F) F(hdr) F(harr) F(fillarr) F(i32arr) F(c32arr) F(f64arr) F(fns) F(sfns) F(arith) F(grade) F(md1) F(md2) F(sysfn) F(derv) F(comp) F(rtPerf) F(ns) F(load) #define F(X) static inline void X##_init(); FOR_INIT(F) #undef F diff --git a/src/sysfn.c b/src/sysfn.c index 09692a67..6b5dc7cd 100644 --- a/src/sysfn.c +++ b/src/sysfn.c @@ -157,16 +157,16 @@ B bqn_c1(B t, B x) { return bqn_exec(x); } -#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_N; 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_N; 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_N; gc_add(bi_##N); +B cmp_c2(B t, B w, B x) { + B r = m_i32(compare(w, x)); + dec(w); dec(x); + return r; +} -B bi_type, bi_decp, bi_primInd, bi_glyph, bi_fill, bi_grLen, bi_grOrd, bi_asrt, bi_out, bi_show, bi_sys, bi_bqn, bi_internal; -static inline void sysfn_init() { bm(type) bm(decp) bm(primInd) bm(glyph) ba(fill) ba(grLen) bd(grOrd) ba(asrt) bm(out) bm(show) bm(sys) bm(bqn) bd(internal) } - -#undef ba -#undef bd -#undef bm +#define F(A,M,D) M(type) M(decp) M(primInd) M(glyph) A(fill) A(grLen) D(grOrd) A(asrt) M(out) M(show) M(sys) M(bqn) D(cmp) D(internal) +BI_FNS0(F); +static inline void sysfn_init() { BI_FNS1(F) } +#undef F B sys_c1(B t, B x) { assert(isArr(x)); @@ -182,6 +182,7 @@ B sys_c1(B t, B x) { else if (eqStr(c, U"decompose")) r.a[i] = inc(bi_decp); else if (eqStr(c, U"primind")) r.a[i] = inc(bi_primInd); else if (eqStr(c, U"bqn")) r.a[i] = inc(bi_bqn); + else if (eqStr(c, U"cmp")) r.a[i] = inc(bi_cmp); else { dec(x); thrM("Unknown system function"); } } return harr_fcd(r, x);