native rank 2 ⍉

This commit is contained in:
dzaima 2021-12-19 16:43:37 +02:00
parent 3ac36bf18c
commit 7cc88fae9c
5 changed files with 49 additions and 7 deletions

View File

@ -4,7 +4,8 @@
/* arith */A(add,"+") A(sub,"-") A(mul,"×") A(div,"÷") A(pow,"") A(root,"") A(floor,"") A(ceil,"") A(stile,"|") A(eq,"=") \
/* arith */A(ne,"") D(le,"") D(ge,"") A(lt,"<") A(gt,">") A(and,"") A(or,"") A(not,"¬") A(log,"⋆⁼") \
/* fns.c*/A(ud,"") A(fne,"") A(feq,"") A(ltack,"") A(rtack,"") A(indexOf,"") A(memberOf,"") A(find,"") A(count,"") \
/* sfns.c*/A(shape,"") A(pick,"") A(pair,"") A(select,"") A(slash,"/") A(join,"") A(couple,"") A(shiftb,"»") A(shifta,"«") A(take,"") A(drop,"") A(group,"") A(reverse,"") \
/* sfns.c*/A(shape,"") A(pick,"") A(pair,"") A(select,"") A(slash,"/") A(join,"") A(couple,"") A(shiftb,"»") \
/* sfns.c*/A(shifta,"«") A(take,"") A(drop,"") A(group,"") A(reverse,"") A(transp,"") \
/* sort.c*/A(gradeUp,"") A(gradeDown,"") \
/* everything before the definition of •Type is defined to be pure, and everything after is not */ \
/* sysfn.c*/M(type,"•Type") M(decp,"•Decompose") M(primInd,"•PrimInd") M(glyph,"•Glyph") A(fill,"•FillFn") M(sys,"•getsys") A(grLen,"•GroupLen") D(grOrd,"•GroupOrd") \

View File

@ -1180,6 +1180,46 @@ B reverse_uc1(B t, B o, B x) {
return reverse_c1(t, c1(o, reverse_c1(t, x)));
}
extern B rt_transp;
B transp_c1(B t, B x) {
if (RARE(isAtm(x))) return m_atomUnit(x);
if (rnk(x)==1) return x;
if (rnk(x)==2) {
usz ia = a(x)->ia;
usz h = a(x)->sh[0];
usz w = a(x)->sh[1];
Arr* r;
switch(TI(x,elType)) { default: UD;
case el_i8: { i8* xp=i8any_ptr (x); i8* rp; r=m_i8arrp (&rp,ia); for(usz y=0;y<h;y++) for(usz x=0;x<w;x++) rp[x*h+y] = xp[y*w+x]; break; }
case el_i16: { i16* xp=i16any_ptr(x); i16* rp; r=m_i16arrp(&rp,ia); for(usz y=0;y<h;y++) for(usz x=0;x<w;x++) rp[x*h+y] = xp[y*w+x]; break; }
case el_i32: { i32* xp=i32any_ptr(x); i32* rp; r=m_i32arrp(&rp,ia); for(usz y=0;y<h;y++) for(usz x=0;x<w;x++) rp[x*h+y] = xp[y*w+x]; break; }
case el_c8: { u8* xp=c8any_ptr (x); u8* rp; r=m_c8arrp (&rp,ia); for(usz y=0;y<h;y++) for(usz x=0;x<w;x++) rp[x*h+y] = xp[y*w+x]; break; }
case el_c16: { u16* xp=c16any_ptr(x); u16* rp; r=m_c16arrp(&rp,ia); for(usz y=0;y<h;y++) for(usz x=0;x<w;x++) rp[x*h+y] = xp[y*w+x]; break; }
case el_c32: { u32* xp=c32any_ptr(x); u32* rp; r=m_c32arrp(&rp,ia); for(usz y=0;y<h;y++) for(usz x=0;x<w;x++) rp[x*h+y] = xp[y*w+x]; break; }
case el_B: case el_bit: { // can't be bothered to implement a bitarr transpose
B* xp = arr_bptr(x);
B xf = getFillR(x);
if (xp==NULL) { HArr* xa=cpyHArr(x); x=taga(xa); xp=xa->a; } // TODO extract this to an inline function
HArr_p p = m_harrUp(ia);
for(usz y=0;y<h;y++) for(usz x=0;x<w;x++) p.a[x*h+y] = inc(xp[y*w+x]);
usz* rsh = arr_shAlloc((Arr*)p.c, 2);
rsh[0] = w; rsh[1] = h;
dec(x); return qWithFill(p.b, xf);
}
}
usz* rsh = arr_shAlloc(r, 2);
rsh[0] = w; rsh[1] = h;
dec(x); return taga(r);
}
return c1(rt_transp, x);
}
B transp_c2(B t, B w, B x) {
return c2(rt_transp, w, x);
}
B pick_uc1(B t, B o, B x) {
if (isAtm(x) || a(x)->ia==0) return def_fn_uc1(t, o, x);
B xf = getFillQ(x);

View File

@ -72,7 +72,7 @@ static B m_emptyFVec(B f) { // consumes f
return taga(r);
}
static B m_unit(B x) {
static B m_unit(B x) { // consumes
B xf = asFill(inc(x));
if (noFill(xf)) {
HArr_p r = m_harrUp(1);
@ -87,7 +87,7 @@ static B m_unit(B x) {
return taga(r);
}
static B m_atomUnit(B x) {
static B m_atomUnit(B x) { // consumes
if (isNum(x)) {
Arr* r;
i32 xi = (i32)x.f;

View File

@ -104,7 +104,7 @@ static B m_hunit(B x) {
static B* harr_ptr(B x) { VTY(x,t_harr); return c(HArr,x)->a; }
static B* hany_ptr(B x) { return v(x)->type==t_hslice? c(HSlice,x)->a : harr_ptr(x); }
HArr* cpyHArr(B x);
HArr* cpyHArr(B x); // consumes
static HArr* toHArr(B x) { return v(x)->type==t_harr? c(HArr,x) : cpyHArr(x); }
B m_caB(usz ia, B* a);

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_rank;
rt_group, rt_under, rt_reverse, rt_indexOf, rt_count, rt_memberOf, rt_find, rt_cell, rt_rank, rt_transp;
Block* load_compObj(B x, B src, B path, Scope* sc) { // consumes x,src
SGet(x)
usz xia = a(x)->ia;
@ -320,7 +320,7 @@ void load_init() { // very last init function
/* +-×÷⋆√⌊⌈|¬ */ bi_add , bi_sub , bi_mul , bi_div , bi_pow , bi_root , 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_pair , bi_take , bi_drop , bi_ud , bi_shifta,
/* »⌽⍉/⍋⍒⊏⊑⊐⊒ */ bi_shiftb , bi_reverse, bi_N , bi_slash, bi_gradeUp, bi_gradeDown, bi_select, bi_pick , bi_indexOf, bi_count,
/* »⌽⍉/⍋⍒⊏⊑⊐⊒ */ bi_shiftb , bi_reverse, bi_transp, 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_rank , bi_N , bi_repeat, bi_catch
@ -330,7 +330,7 @@ void load_init() { // very last init function
/* +-×÷⋆√⌊⌈|¬ */ 1,1,1,1,1,1,1,1,1,1,
/* ∧∨<>≠=≤≥≡≢ */ 1,1,1,1,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,1,1,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,
/* ⎉⚇⍟⎊ */ 1,0,1,1
@ -391,6 +391,7 @@ void load_init() { // very last init function
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);
rt_transp = Get(rtObjRaw, n_transp ); gc_add(rt_transp);
for (usz i = 0; i < rtLen; i++) {
#ifdef RT_WRAP