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 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() {
|
||||
c(BFn,bi_pick)->uc1 = pick_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_drop)->ucw = drop_ucw;
|
||||
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;
|
||||
}
|
||||
static NFnDesc* ucwWrapDesc;
|
||||
static NFnDesc* uc1WrapDesc;
|
||||
|
||||
static B fork_uc1(B t, B o, B x) {
|
||||
B f = toConstant(c(Fork, t)->f);
|
||||
B g = c(Fork, t)->g;
|
||||
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 tmp = m_nfn(ucwWrapDesc, tag(args, RAW_TAG));
|
||||
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);
|
||||
return r;
|
||||
}
|
||||
|
||||
static B ucwWrap_c1(B t, B x) {
|
||||
B* args = c(B, nfn_objU(t));
|
||||
B g = args[0];
|
||||
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_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); }
|
||||
@ -126,5 +149,8 @@ void derv_init() {
|
||||
}
|
||||
void dervPost_init() {
|
||||
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_atop,fn_uc1) = atop_uc1;
|
||||
c(BMd2,bi_atop)->uc1 = atopM2_uc1;
|
||||
}
|
||||
Loading…
Reference in New Issue
Block a user