native 𝕨⍋𝕩
This commit is contained in:
parent
9bdacbbd7d
commit
d42a6516b7
20
src/fns.c
20
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
|
||||
65
src/grade.c
Normal file
65
src/grade.c
Normal file
@ -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
|
||||
21
src/h.h
21
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 w<x, 1 if w>x, 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;
|
||||
|
||||
29
src/harr.c
29
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; }
|
||||
|
||||
27
src/i32arr.c
27
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); }
|
||||
|
||||
15
src/load.c
15
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
|
||||
|
||||
@ -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);
|
||||
|
||||
@ -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;
|
||||
|
||||
15
src/sfns.c
15
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
|
||||
|
||||
75
src/stuff.c
75
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)-(wt<xt?1:0); })
|
||||
i32 compare(B w, B x) {
|
||||
if (isNum(w) & isNum(x)) return CMP(o2fu(w), o2fu(x));
|
||||
if (isC32(w) & isC32(x)) return CMP(o2cu(w), o2cu(x));
|
||||
if (isNum(w) & isC32(x)) return -1;
|
||||
if (isC32(w) & isNum(x)) return 1;
|
||||
if (isAtm(w) & isAtm(x)) thrM("Invalid comparison");
|
||||
bool wa=isAtm(w); usz wia; ur wr; usz* wsh; BS2B wgetU;
|
||||
bool xa=isAtm(x); usz xia; ur xr; usz* xsh; BS2B xgetU;
|
||||
if(wa) { wia=1; wr=0; wsh=NULL; wgetU=def_getU; } else { wia=a(w)->ia; 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 = wr<xr? wr : xr;
|
||||
i32 ri = 0; // matching shape tail
|
||||
i32 rm = 1;
|
||||
while (ri<rr && wsh[wr-1-ri] == xsh[xr-1-ri]) {
|
||||
rm*= wsh[wr-ri-1];
|
||||
ri++;
|
||||
}
|
||||
if (ri<rr) {
|
||||
usz wm = wsh[wr-1-ri];
|
||||
usz xm = xsh[xr-1-ri];
|
||||
rc = CMP(wm, xm);
|
||||
rm*= wm<xm? wm : xm;
|
||||
}
|
||||
for (int i = 0; i < rm; i++) {
|
||||
int c = compare(wgetU(w,i), xgetU(x,i));
|
||||
if (c!=0) return c;
|
||||
}
|
||||
return rc;
|
||||
}
|
||||
#undef CMP
|
||||
|
||||
|
||||
|
||||
|
||||
bool eqShPrefix(usz* w, usz* x, ur len) {
|
||||
return memcmp(w, x, len*sizeof(usz))==0;
|
||||
}
|
||||
@ -187,23 +243,6 @@ u8 fillElType(B x) {
|
||||
}
|
||||
#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; }
|
||||
|
||||
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
|
||||
|
||||
19
src/sysfn.c
19
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);
|
||||
|
||||
Loading…
Reference in New Issue
Block a user