native ⌾(F G), ⌾(F∘G), ⌾<, <⁼
This commit is contained in:
parent
a5e206d009
commit
9480ee9da2
@ -1480,6 +1480,16 @@ B select_ucw(B t, B o, B w, B x);
|
|||||||
B transp_uc1(B t, B o, B x) { return transp_c1(t, c1(o, transp_c1(t, x))); }
|
B transp_uc1(B t, B o, B x) { return transp_c1(t, c1(o, transp_c1(t, x))); }
|
||||||
B reverse_uc1(B t, B o, B x) { return reverse_c1(t, c1(o, reverse_c1(t, x))); }
|
B reverse_uc1(B t, B o, B x) { return reverse_c1(t, c1(o, reverse_c1(t, x))); }
|
||||||
|
|
||||||
|
NOINLINE B enclose_im(B t, B x) {
|
||||||
|
if (isAtm(x) || rnk(x)!=0) thrM("<⁼: Argument wasn't a rank 0 array");
|
||||||
|
B r = IGet(x, 0);
|
||||||
|
dec(x);
|
||||||
|
return r;
|
||||||
|
}
|
||||||
|
B enclose_uc1(B t, B o, B x) {
|
||||||
|
return enclose_im(t, c1(o, m_atomUnit(x)));
|
||||||
|
}
|
||||||
|
|
||||||
void sfns_init() {
|
void sfns_init() {
|
||||||
c(BFn,bi_pick)->uc1 = pick_uc1;
|
c(BFn,bi_pick)->uc1 = pick_uc1;
|
||||||
c(BFn,bi_reverse)->uc1 = reverse_uc1;
|
c(BFn,bi_reverse)->uc1 = reverse_uc1;
|
||||||
@ -1491,4 +1501,6 @@ void sfns_init() {
|
|||||||
c(BFn,bi_take)->ucw = take_ucw;
|
c(BFn,bi_take)->ucw = take_ucw;
|
||||||
c(BFn,bi_drop)->ucw = drop_ucw;
|
c(BFn,bi_drop)->ucw = drop_ucw;
|
||||||
c(BFn,bi_slash)->im = slash_im;
|
c(BFn,bi_slash)->im = slash_im;
|
||||||
|
c(BFn,bi_lt)->im = enclose_im;
|
||||||
|
c(BFn,bi_lt)->uc1 = enclose_uc1;
|
||||||
}
|
}
|
||||||
|
|||||||
@ -72,12 +72,13 @@ static B toConstant(B x) { // doesn't consume x
|
|||||||
return bi_N;
|
return bi_N;
|
||||||
}
|
}
|
||||||
static NFnDesc* ucwWrapDesc;
|
static NFnDesc* ucwWrapDesc;
|
||||||
|
static NFnDesc* uc1WrapDesc;
|
||||||
|
|
||||||
static B fork_uc1(B t, B o, B x) {
|
static B fork_uc1(B t, B o, B x) {
|
||||||
B f = toConstant(c(Fork, t)->f);
|
B f = toConstant(c(Fork, t)->f);
|
||||||
B g = c(Fork, t)->g;
|
B g = c(Fork, t)->g;
|
||||||
B h = c(Fork, t)->h;
|
B h = c(Fork, t)->h;
|
||||||
if (RARE(q_N(f) | !isFun(g) | !isFun(h))) { dec(f); return def_fn_uc1(t, o, x); } // flags check to not deconstruct builtins
|
if (RARE(q_N(f) | !isFun(g) | !isFun(h))) { dec(f); return def_fn_uc1(t, o, x); }
|
||||||
B args[] = {g, o, f};
|
B args[] = {g, o, f};
|
||||||
B tmp = m_nfn(ucwWrapDesc, tag(args, RAW_TAG));
|
B tmp = m_nfn(ucwWrapDesc, tag(args, RAW_TAG));
|
||||||
B r = TI(h,fn_uc1)(h,tmp,x);
|
B r = TI(h,fn_uc1)(h,tmp,x);
|
||||||
@ -85,13 +86,35 @@ static B fork_uc1(B t, B o, B x) {
|
|||||||
decG(tmp);
|
decG(tmp);
|
||||||
return r;
|
return r;
|
||||||
}
|
}
|
||||||
|
|
||||||
static B ucwWrap_c1(B t, B x) {
|
static B ucwWrap_c1(B t, B x) {
|
||||||
B* args = c(B, nfn_objU(t));
|
B* args = c(B, nfn_objU(t));
|
||||||
B g = args[0];
|
B g = args[0];
|
||||||
return TI(g,fn_ucw)(g, args[1], args[2], x);
|
return TI(g,fn_ucw)(g, args[1], args[2], x);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
NOINLINE B atop_uc1_impl(B x, B o, B g, B h) {
|
||||||
|
B args[] = {g, o};
|
||||||
|
B tmp = m_nfn(uc1WrapDesc, tag(args, RAW_TAG));
|
||||||
|
B r = TI(h,fn_uc1)(h,tmp,x);
|
||||||
|
decG(tmp);
|
||||||
|
return r;
|
||||||
|
}
|
||||||
|
static B atopM2_uc1(Md2* t, B o, B g, B h, B x) {
|
||||||
|
if (RARE(!isFun(g) | !isFun(h))) return def_m2_uc1(t, g, h, o, x);
|
||||||
|
return atop_uc1_impl(x, o, g, h);
|
||||||
|
}
|
||||||
|
static B atop_uc1(B t, B o, B x) {
|
||||||
|
B g = c(Atop, t)->g;
|
||||||
|
B h = c(Atop, t)->h;
|
||||||
|
if (RARE(!isFun(g) | !isFun(h))) return def_fn_uc1(t, o, x);
|
||||||
|
return atop_uc1_impl(x, o, g, h);
|
||||||
|
}
|
||||||
|
static B uc1Wrap_c1(B t, B x) {
|
||||||
|
B* args = c(B, nfn_objU(t));
|
||||||
|
B g = args[0];
|
||||||
|
return TI(g,fn_uc1)(g, args[1], x);
|
||||||
|
}
|
||||||
|
|
||||||
static B md1D_im(B t, B x) { Md1D* d = c(Md1D,t); return TIv(d->m1,m1_im)(d, x); }
|
static B md1D_im(B t, B x) { Md1D* d = c(Md1D,t); return TIv(d->m1,m1_im)(d, x); }
|
||||||
static B md1D_iw(B t, B w, B x) { Md1D* d = c(Md1D,t); return TIv(d->m1,m1_iw)(d, w, x); }
|
static B md1D_iw(B t, B w, B x) { Md1D* d = c(Md1D,t); return TIv(d->m1,m1_iw)(d, w, x); }
|
||||||
static B md1D_ix(B t, B w, B x) { Md1D* d = c(Md1D,t); return TIv(d->m1,m1_ix)(d, w, x); }
|
static B md1D_ix(B t, B w, B x) { Md1D* d = c(Md1D,t); return TIv(d->m1,m1_ix)(d, w, x); }
|
||||||
@ -126,5 +149,8 @@ void derv_init() {
|
|||||||
}
|
}
|
||||||
void dervPost_init() {
|
void dervPost_init() {
|
||||||
ucwWrapDesc = registerNFn(m_ascii0("(temporary function for ⌾)"), ucwWrap_c1, c2_bad);
|
ucwWrapDesc = registerNFn(m_ascii0("(temporary function for ⌾)"), ucwWrap_c1, c2_bad);
|
||||||
|
uc1WrapDesc = registerNFn(m_ascii0("(temporary function for ⌾)"), uc1Wrap_c1, c2_bad);
|
||||||
TIi(t_fork,fn_uc1) = fork_uc1; // in post probably to make sure it's not used while not fully initialized or something? idk
|
TIi(t_fork,fn_uc1) = fork_uc1; // in post probably to make sure it's not used while not fully initialized or something? idk
|
||||||
|
TIi(t_atop,fn_uc1) = atop_uc1;
|
||||||
|
c(BMd2,bi_atop)->uc1 = atopM2_uc1;
|
||||||
}
|
}
|
||||||
Loading…
Reference in New Issue
Block a user