native monadic ⎉

This commit is contained in:
dzaima 2021-12-19 15:17:02 +02:00
parent d873ce0d81
commit 88c5a16678
5 changed files with 90 additions and 7 deletions

View File

@ -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)

View File

@ -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);

View File

@ -1,3 +1,4 @@
#include <math.h>
#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() {

View File

@ -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; }

View File

@ -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