diff --git a/src/builtins.h b/src/builtins.h index 59445123..d8bba361 100644 --- a/src/builtins.h +++ b/src/builtins.h @@ -23,7 +23,7 @@ /*md1.c*/A(timed,"•_timed") #define FOR_PM2(A,M,D) \ - /*md2.c*/A(val,"⊘") A(repeat,"⍟") A(fillBy,"•_fillBy_") A(catch,"⎊") \ + /*md2.c*/A(val,"⊘") A(repeat,"⍟") A(rank,"⎉") A(fillBy,"•_fillBy_") A(catch,"⎊") \ /*md2.c*/A(atop,"∘") A(over,"○") A(before,"⊸") A(after,"⟜") A(cond,"◶") A(under,"⌾") \ /* everything before the definition of •_while_ is defined to be pure, and everything after is not */ \ /*md2.c*/A(while,"•_while_") @@ -35,12 +35,19 @@ enum PrimNumbers { /* »⌽⍉/⍋⍒⊏⊑⊐⊒ */ n_shiftb , n_reverse, n_transp, n_slash, n_gradeUp, n_gradeDown, n_select, n_pick , n_indexOf, n_count, /* ∊⍷⊔!˙˜˘¨⌜⁼ */ n_memberOf, n_find , n_group , n_asrt , n_const , n_swap , n_cell , n_each , n_tbl , n_undo, /* ´˝`∘○⊸⟜⌾⊘◶ */ n_fold , n_reduce , n_scan , n_atop , n_over , n_before , n_after , n_under, n_val , n_cond, - /* ⎉⚇⍟⎊ */ n_cells , n_depth2 , n_repeat, n_catch + /* ⎉⚇⍟⎊ */ n_rank , n_depth2 , n_repeat, n_catch }; extern B rt_invFnReg, rt_invFnSwap; extern BB2B rt_invFnRegFn; extern BB2B rt_invFnSwapFn; + +#ifdef RT_WRAP +#define Q_BI(X, T) ({ B x_ = (X); isFun(x_) && v(x_)->flags-1 == n_##T; }) +#else +#define Q_BI(X, T) ((X).u == bi_##T.u) +#endif + enum PrimFns { pf_none, #define F(N,X) pf_##N, FOR_PFN(F,F,F) diff --git a/src/builtins/md1.c b/src/builtins/md1.c index dc73817c..13e71c38 100644 --- a/src/builtins/md1.c +++ b/src/builtins/md1.c @@ -352,7 +352,7 @@ B cell_c1(Md1D* d, B x) { B f = d->f; ShArr* csh; if (cr>1) { csh = m_shArr(cr); - memcpy(csh->a, a(x)->sh+1, sizeof(usz)*cr); + memcpy(csh->a, a(x)->sh+1, cr*sizeof(usz)); } BSS2A slice = TI(x,slice); M_HARR(r, cam); diff --git a/src/builtins/md2.c b/src/builtins/md2.c index 96c5ffad..d2eed816 100644 --- a/src/builtins/md2.c +++ b/src/builtins/md2.c @@ -1,3 +1,4 @@ +#include #include "../core.h" #include "../utils/talloc.h" #include "../builtins.h" @@ -176,6 +177,80 @@ B while_c2(Md2D* d, B w, B x) { B f=d->f; B g=d->g; return x; } +B m1c(B t, B f, B g, B x) { // consumes x + B fn = m2_d(inc(t), inc(f), inc(g)); + B r = c1(fn, x); + dec(fn); + return r; +} +B m2c(B t, B f, B g, B w, B x) { // consumes w,x + B fn = m2_d(inc(t), inc(f), inc(g)); + B r = c2(fn, w, x); + dec(fn); + return r; +} + +B rank_c1(Md2D* d, B x) { B f = d->f; B g = d->g; + f64 kf; + bool gf = isFun(g); + if (RARE(gf)) g = c1(g, inc(x)); + if (LIKELY(isNum(g))) { + kf = o2fu(g); + } else if (isArr(g)) { + usz gia = a(g)->ia; + if (!(gia>=1 && gia<=3)) thrM("⎉: 𝔾 result must have 1 to 3 elements"); + SGetU(g) + if (!elNum(TI(g,elType))) for (i32 i = 0; i < gia; i++) o2f(GetU(g,i)); + kf = GetU(g, gia==2).f; + } else thrM("⎉: Invalid 𝔾 result"); + if (gf) dec(g); + i32 k = kf; + + if (isAtm(x) || rnk(x)==0) { + if (floor(kf)!=kf) thrM("⎉: 𝕘 was a fractional number"); + B r = c1(f, x); + return isAtm(r)? m_atomUnit(r) : r; + } + i32 xr = rnk(x); + usz* xsh = a(x)->sh; + if (k!=kf) { + if (floor(kf)!=kf) thrM("⎉: 𝕘 was a fractional number"); + k = kf>0? 0 : xr; + } else { + k = k<0? (k+xr<0? xr : xr-(k+xr)) : (k>xr? 0 : xr-k); + } + if (Q_BI(f,lt) && a(x)->ia!=0 && rnk(x)>1) return toKCells(x, k); + + usz cam = 1; for (usz i = 0; i < k; i++) cam*= xsh[i]; + usz csz = 1; for (usz i = k; i < xr; i++) csz*= xsh[i]; + ur cr = xr-k; + ShArr* csh; + if (cr>1) { + csh = m_shArr(cr); + memcpy(csh->a, xsh+k, cr*sizeof(usz)); + } + + + BSS2A slice = TI(x,slice); + M_HARR(r, cam); + usz p = 0; + for (usz i = 0; i < cam; i++) { + Arr* s = slice(inc(x), p, csz); arr_shSetI(s, cr, csh); + HARR_ADD(r, i, c1(f, taga(s))); + p+= csz; + } + + if (cr>1) ptr_dec(csh); + usz* rsh = HARR_FA(r, k); + if (k>1) memcpy(rsh, xsh, k*sizeof(usz)); + + dec(x); + return bqn_merge(HARR_O(r).b); +} +extern B rt_rank; +B rank_c2(Md2D* d, B w, B x) { B f = d->f; B g = d->g; // TODO + return m2c(rt_rank, f, g, w, x); +} static void print_md2BI(B x) { printf("%s", pm2_repr(c(Md1,x)->extra)); } void md2_init() { diff --git a/src/h.h b/src/h.h index b767e7be..6a760ae5 100644 --- a/src/h.h +++ b/src/h.h @@ -385,7 +385,7 @@ static i32 o2i (B x) { if (x.f!=(f64)(i32)x.f) thrM("Expected integer"); retur static usz o2s (B x) { if (x.f!=(f64)(usz)x.f) thrM("Expected non-negative integer"); return (usz)x.f; } static i64 o2i64 (B x) { if (x.f!=(f64)(i64)x.f) thrM("Expected integer"); return (i64)x.f; } static u64 o2u64 (B x) { if (x.f!=(f64)(u64)x.f) thrM("Expected integer"); return (u64)x.f; } -static f64 o2f (B x) { if (!isNum(x)) thrM("Expected integer"); return x.f; } +static f64 o2f (B x) { if (!isNum(x)) thrM("Expected number"); return x.f; } static u32 o2c (B x) { if (!isC32(x)) thrM("Expected character"); return (u32)x.u; } static i32 o2iu (B x) { return (i32)x.f; } static u32 o2cu (B x) { return (u32)x.u; } diff --git a/src/load.c b/src/load.c index 50fcaa67..8fc9c982 100644 --- a/src/load.c +++ b/src/load.c @@ -103,7 +103,7 @@ B comp_currSrc; B comp_currRe; B rt_merge, rt_undo, rt_select, rt_slash, rt_join, rt_ud, rt_pick,rt_take, rt_drop, - rt_group, rt_under, rt_reverse, rt_indexOf, rt_count, rt_memberOf, rt_find, rt_cell; + rt_group, rt_under, rt_reverse, rt_indexOf, rt_count, rt_memberOf, rt_find, rt_cell, rt_rank; Block* load_compObj(B x, B src, B path, Scope* sc) { // consumes x,src SGet(x) usz xia = a(x)->ia; @@ -323,7 +323,7 @@ void load_init() { // very last init function /* »⌽⍉/⍋⍒⊏⊑⊐⊒ */ bi_shiftb , bi_reverse, bi_N , bi_slash, bi_gradeUp, bi_gradeDown, bi_select, bi_pick , bi_indexOf, bi_count, /* ∊⍷⊔!˙˜˘¨⌜⁼ */ bi_memberOf, bi_find , bi_group , bi_asrt , bi_const , bi_swap , bi_cell , bi_each , bi_tbl , bi_undo, /* ´˝`∘○⊸⟜⌾⊘◶ */ bi_fold , bi_N , bi_scan , bi_atop , bi_over , bi_before , bi_after , bi_under, bi_val , bi_cond, - /* ⎉⚇⍟⎊ */ bi_N , bi_N , bi_repeat, bi_catch + /* ⎉⚇⍟⎊ */ bi_rank , bi_N , bi_repeat, bi_catch }; bool rtComplete[] = { @@ -333,7 +333,7 @@ void load_init() { // very last init function /* »⌽⍉/⍋⍒⊏⊑⊐⊒ */ 1,1,0,1,1,1,1,1,1,1, /* ∊⍷⊔!˙˜˘¨⌜⁼ */ 1,1,1,1,1,1,1,1,1,1, /* ´˝`∘○⊸⟜⌾⊘◶ */ 1,0,1,1,1,1,1,1,1,1, - /* ⎉⚇⍟⎊ */ 0,0,1,1 + /* ⎉⚇⍟⎊ */ 1,0,1,1 }; assert(sizeof(fruntime)/sizeof(B) == rtLen); for (u64 i = 0; i < rtLen; i++) inc(fruntime[i]); @@ -390,6 +390,7 @@ void load_init() { // very last init function rt_memberOf= Get(rtObjRaw, n_memberOf); gc_add(rt_memberOf); rt_find = Get(rtObjRaw, n_find ); gc_add(rt_find); rt_cell = Get(rtObjRaw, n_cell ); gc_add(rt_cell); + rt_rank = Get(rtObjRaw, n_rank ); gc_add(rt_rank); for (usz i = 0; i < rtLen; i++) { #ifdef RT_WRAP