native 𝔽˘𝕩 and >
This commit is contained in:
parent
0e650d6038
commit
e140f9350b
52
src/arith.c
52
src/arith.c
@ -87,7 +87,7 @@ static inline B arith_recd(BBB2B f, B w, B x) {
|
||||
} \
|
||||
thrM(#NAME ": invalid arithmetic"); \
|
||||
}
|
||||
#else // !TYPED_ARITH
|
||||
#else // if !TYPED_ARITH
|
||||
#define ffnx(name, expr, extra) B name##_c2(B t, B w, B x) { \
|
||||
if (isF64(w) & isF64(x)) return m_f64(expr); \
|
||||
extra \
|
||||
@ -153,6 +153,53 @@ B ne_c2(B t, B w, B x) {
|
||||
return r;
|
||||
}
|
||||
|
||||
B rt_merge;
|
||||
B gt_c1(B t, B x) {
|
||||
if (isAtm(x)) return x;
|
||||
usz xia = a(x)->ia;
|
||||
ur xr = rnk(x);
|
||||
if (xia==0) {
|
||||
B xf = getFillE(x);
|
||||
if (isAtm(xf)) { dec(xf); return x; }
|
||||
B r = m_fillarrp(0);
|
||||
i32 xfr = rnk(xf);
|
||||
fillarr_setFill(r, getFillQ(xf));
|
||||
if (xr+xfr > UR_MAX) thrM(">: Result rank too large");
|
||||
usz* rsh = arr_shAllocI(r, 0, xr+xfr);
|
||||
if (rsh) {
|
||||
memcpy (rsh , a(x)->sh, xr *sizeof(usz));
|
||||
if(xfr)memcpy(rsh+xr, a(xf)->sh, xfr*sizeof(usz));
|
||||
}
|
||||
return r;
|
||||
}
|
||||
|
||||
BS2B xgetU = TI(x).getU;
|
||||
B x0 = xgetU(x, 0);
|
||||
usz* elSh = isArr(x0)? a(x0)->sh : NULL;
|
||||
ur elR = isArr(x0)? rnk(x0) : 0;
|
||||
usz elIA = isArr(x0)? a(x0)->ia : 1;
|
||||
B fill = getFillQ(x0);
|
||||
if (xr+elR > UR_MAX) thrM(">: Result rank too large");
|
||||
|
||||
MAKE_MUT(r, xia*elIA);
|
||||
usz rp = 0;
|
||||
for (usz i = 0; i < xia; i++) {
|
||||
B c = xgetU(x, i);
|
||||
if (isArr(c)? (elR!=rnk(c) || !eqShPrefix(elSh, a(c)->sh, elR)) : elR!=0) { mut_pfree(r, rp); thrF(">: Elements didn't have equal shapes (contained %H and %H)", x0, c); }
|
||||
if (isArr(c)) mut_copy(r, rp, c, 0, elIA);
|
||||
else mut_set(r, rp, c);
|
||||
if (!noFill(fill)) fill = fill_or(fill, getFillQ(c));
|
||||
rp+= elIA;
|
||||
}
|
||||
B rb = mut_fp(r);
|
||||
usz* rsh = arr_shAllocR(rb, xr+elR);
|
||||
if (rsh) {
|
||||
memcpy (rsh , a(x)->sh, xr *sizeof(usz));
|
||||
if (elSh)memcpy(rsh+xr, elSh, elR*sizeof(usz));
|
||||
}
|
||||
dec(x);
|
||||
return withFill(rb,fill);
|
||||
}
|
||||
|
||||
B add_c1(B t, B x) { return x; }
|
||||
B sub_c1(B t, B x) { if (isF64(x)) return m_f64( -x.f ); P1( sub); thrM("-: Negating non-number"); }
|
||||
@ -169,10 +216,9 @@ B lt_c1(B t, B x) { return m_unit(x); }
|
||||
B eq_c1(B t, B x) { B r = m_i32(isArr(x)? rnk(x) : 0); decR(x); return r; }
|
||||
B ne_c1(B t, B x) { B r = m_f64(isArr(x)&&rnk(x)? *a(x)->sh : 1); decR(x); return r; }
|
||||
|
||||
B rt_sortAsc, rt_sortDsc, rt_merge;
|
||||
B rt_sortAsc, rt_sortDsc;
|
||||
B and_c1(B t, B x) { return c1(rt_sortAsc, x); }
|
||||
B or_c1(B t, B x) { return c1(rt_sortDsc, x); }
|
||||
B gt_c1(B t, B x) { return c1(rt_merge, x); }
|
||||
|
||||
#undef P1
|
||||
#undef P2
|
||||
|
||||
@ -55,7 +55,7 @@ B asFill(B x) { // consumes
|
||||
return bi_noFill;
|
||||
}
|
||||
|
||||
B m_fillarrp(usz ia) {
|
||||
B m_fillarrp(usz ia) { // doesn't set ia
|
||||
return m_arr(fsizeof(FillArr,a,B,ia), t_fillarr);
|
||||
}
|
||||
void fillarr_setFill(B x, B fill) { // consumes fill
|
||||
|
||||
8
src/h.h
8
src/h.h
@ -145,14 +145,14 @@ char* format_pf(u8 u) {
|
||||
}
|
||||
enum PrimMd1 {
|
||||
pm1_none,
|
||||
pm1_tbl, pm1_each, pm1_fold, pm1_scan, pm1_const, pm1_swap, pm1_timed, // md1.c
|
||||
pm1_fchars, pm1_fbytes, pm1_flines, pm1_import, // md1.c
|
||||
pm1_tbl, pm1_each, pm1_fold, pm1_scan, pm1_const, pm1_swap, pm1_cell, // md1.c
|
||||
pm1_timed, pm1_fchars, pm1_fbytes, pm1_flines, pm1_import, // md1.c
|
||||
};
|
||||
char* format_pm1(u8 u) {
|
||||
switch(u) {
|
||||
default: case pf_none: return"(unknown 1-modifier)";
|
||||
case pm1_tbl:return"⌜"; case pm1_each:return"¨"; case pm1_fold:return"´"; case pm1_scan:return"`"; case pm1_const:return"˙"; case pm1_swap:return"˜"; case pm1_timed:return"•_timed";
|
||||
case pm1_fchars:return"•FChars"; case pm1_fbytes:return"•FBytes"; case pm1_flines:return"•FLines"; case pm1_import:return"•Import";
|
||||
case pm1_tbl:return"⌜"; case pm1_each:return"¨"; case pm1_fold:return"´"; case pm1_scan:return"`"; case pm1_const:return"˙"; case pm1_swap:return"˜"; case pm1_cell:return"˘";
|
||||
case pm1_timed:return"•_timed"; case pm1_fchars:return"•FChars"; case pm1_fbytes:return"•FBytes"; case pm1_flines:return"•FLines"; case pm1_import:return"•Import";
|
||||
}
|
||||
}
|
||||
enum PrimMd2 {
|
||||
|
||||
26
src/harr.c
26
src/harr.c
@ -76,14 +76,28 @@ B toCells(B x) {
|
||||
usz cam = a(x)->sh[0];
|
||||
usz csz = arr_csz(x);
|
||||
usz i = 0;
|
||||
HArr_p r = m_harrs(cam, &i);
|
||||
BS2B slice = TI(x).slice;
|
||||
usz p = 0;
|
||||
for (; i < cam; i++) {
|
||||
B s = slice(inc(x), p);
|
||||
arr_shVec(s, csz);
|
||||
r.a[i] = s;
|
||||
p+= csz;
|
||||
HArr_p r = m_harrs(cam, &i);
|
||||
if (rnk(x)==2) {
|
||||
for (; i < cam; i++) {
|
||||
B s = slice(inc(x), p);
|
||||
arr_shVec(s, csz);
|
||||
r.a[i] = s;
|
||||
p+= csz;
|
||||
}
|
||||
} else {
|
||||
usz cr = rnk(x)-1;
|
||||
ShArr* csh = m_shArr(cr);
|
||||
usz* xsh = a(x)->sh;
|
||||
for (i32 i = 0; i < cr; i++) csh->a[i] = xsh[i+1];
|
||||
for (; i < cam; i++) {
|
||||
B s = slice(inc(x), p);
|
||||
arr_shSetI(s, csz, cr, csh);
|
||||
r.a[i] = s;
|
||||
p+= csz;
|
||||
}
|
||||
ptr_dec(csh);
|
||||
}
|
||||
dec(x);
|
||||
return harr_fv(r);
|
||||
|
||||
@ -66,7 +66,7 @@ static inline void load_init() {
|
||||
/* ∧∨<>≠=≤≥≡≢ */ 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_take , bi_drop , bi_ud , bi_shifta, bi_shiftb,
|
||||
/* ⌽⍉/⍋⍒⊏⊑⊐⊒∊ */ bi_reverse, bi_N , bi_slash, bi_gradeUp, bi_N , bi_select, bi_pick , bi_indexOf, bi_N , bi_N,
|
||||
/* ⍷⊔!˙˜˘¨⌜⁼´ */ bi_N , bi_group , bi_asrt , bi_const , bi_swap , bi_N , bi_each , bi_tbl , bi_N , bi_fold,
|
||||
/* ⍷⊔!˙˜˘¨⌜⁼´ */ bi_N , bi_group , bi_asrt , bi_const , bi_swap , bi_cell , bi_each , bi_tbl , bi_N , 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
|
||||
};
|
||||
@ -75,7 +75,7 @@ static inline void load_init() {
|
||||
/* ∧∨<>≠=≤≥≡≢ */ 1,1,1,1,1,1,1,1,1,1,
|
||||
/* ⊣⊢⥊∾≍↑↓↕«» */ 1,1,0,1,1,1,1,1,1,1,
|
||||
/* ⌽⍉/⍋⍒⊏⊑⊐⊒∊ */ 1,0,1,1,0,1,1,1,0,0,
|
||||
/* ⍷⊔!˙˜˘¨⌜⁼´ */ 0,1,1,1,1,0,1,1,0,1,
|
||||
/* ⍷⊔!˙˜˘¨⌜⁼´ */ 0,1,1,1,1,1,1,1,0,1,
|
||||
/* ˝`∘○⊸⟜⌾⊘◶⎉ */ 0,1,1,1,1,1,1,1,0,0,
|
||||
/* ⚇⍟⎊ */ 0,1,1
|
||||
};
|
||||
@ -128,6 +128,7 @@ static inline void load_init() {
|
||||
rt_under = rtObjGet(rtObjRaw, 56); gc_add(rt_under);
|
||||
rt_reverse = rtObjGet(rtObjRaw, 30); gc_add(rt_reverse);
|
||||
rt_indexOf = rtObjGet(rtObjRaw, 37); gc_add(rt_indexOf);
|
||||
rt_cell = rtObjGet(rtObjRaw, 45); gc_add(rt_cell);
|
||||
|
||||
for (usz i = 0; i < runtimeLen; i++) {
|
||||
#ifdef ALL_R1
|
||||
|
||||
42
src/md1.c
42
src/md1.c
@ -64,7 +64,7 @@ B tbl_c2(B d, B w, B x) { B f = c(Md1D,d)->f;
|
||||
usz wia = a(w)->ia; ur wr = rnk(w);
|
||||
usz xia = a(x)->ia; ur xr = rnk(x);
|
||||
usz ria = wia*xia; ur rr = wr+xr;
|
||||
if (rr<xr) thrF("⌜: Required result rank too large (%i≡=𝕨, %i≡=𝕩)", wr, xr);
|
||||
if (rr<xr) thrF("⌜: Result rank too large (%i≡=𝕨, %i≡=𝕩)", wr, xr);
|
||||
|
||||
BS2B wgetU = TI(w).getU;
|
||||
BS2B xget = TI(x).get;
|
||||
@ -252,14 +252,50 @@ B import_c2(B d, B w, B x) { B f = c(Md1D,d)->f;
|
||||
return bqn_execFile(path_resolve(f, x), w);
|
||||
}
|
||||
|
||||
B rt_cell;
|
||||
B cell_c1(B d, B x) { B f = c(Md1D,d)->f;
|
||||
if (isAtm(x) || rnk(x)==0) {
|
||||
B r = c1(f, x);
|
||||
return isAtm(r)? m_atomUnit(r) : r;
|
||||
}
|
||||
if (f.u == bi_lt.u) return toCells(x);
|
||||
usz cr = rnk(x)-1;
|
||||
usz cam = a(x)->sh[0];
|
||||
usz csz = arr_csz(x);
|
||||
ShArr* csh; if (cr>1) csh = m_shArr(cr);
|
||||
usz i = 0;
|
||||
BS2B slice = TI(x).slice;
|
||||
HArr_p r = m_harrs(cam, &i);
|
||||
usz p = 0;
|
||||
for (; i < cam; i++) {
|
||||
B s = slice(inc(x), p);
|
||||
arr_shSetI(s, csz, cr, csh);
|
||||
r.a[i] = c1(f, s);
|
||||
p+= csz;
|
||||
}
|
||||
if (cr>1) ptr_dec(csh);
|
||||
dec(x);
|
||||
return c1(bi_gt, harr_fv(r));
|
||||
}
|
||||
B cell_c2(B d, B w, B x) { B f = c(Md1D,d)->f;
|
||||
if ((isAtm(x) || rnk(x)==0) && (isAtm(w) || rnk(w)==0)) {
|
||||
B r = c2(f, w, x);
|
||||
return isAtm(r)? m_atomUnit(r) : r;
|
||||
}
|
||||
B fn = m1_d(inc(rt_cell), inc(f)); // TODO
|
||||
B r = c2(fn, w, x);
|
||||
dec(fn);
|
||||
return r;
|
||||
}
|
||||
|
||||
#define ba(NAME) bi_##NAME = mm_alloc(sizeof(Md1), t_md1BI, ftag(MD1_TAG)); c(Md1,bi_##NAME)->c2 = NAME##_c2; c(Md1,bi_##NAME)->c1 = NAME##_c1 ; c(Md1,bi_##NAME)->extra=pm1_##NAME; gc_add(bi_##NAME);
|
||||
#define bd(NAME) bi_##NAME = mm_alloc(sizeof(Md1), t_md1BI, ftag(MD1_TAG)); c(Md1,bi_##NAME)->c2 = NAME##_c2; c(Md1,bi_##NAME)->c1 = c1_invalid; c(Md1,bi_##NAME)->extra=pm1_##NAME; gc_add(bi_##NAME);
|
||||
#define bm(NAME) bi_##NAME = mm_alloc(sizeof(Md1), t_md1BI, ftag(MD1_TAG)); c(Md1,bi_##NAME)->c2 = c2_invalid;c(Md1,bi_##NAME)->c1 = NAME##_c1 ; c(Md1,bi_##NAME)->extra=pm1_##NAME; gc_add(bi_##NAME);
|
||||
|
||||
void print_md1BI(B x) { printf("%s", format_pm1(c(Md1,x)->extra)); }
|
||||
|
||||
B bi_tbl, bi_each, bi_fold, bi_scan, bi_const, bi_swap, bi_timed, bi_fchars, bi_fbytes, bi_flines, bi_import;
|
||||
static inline void md1_init() { ba(tbl) ba(each) ba(fold) ba(scan) ba(const) ba(swap) ba(timed) bm(fchars) bm(fbytes) bm(flines) ba(import)
|
||||
B bi_tbl, bi_each, bi_fold, bi_scan, bi_const, bi_swap, bi_cell, bi_timed, bi_fchars, bi_fbytes, bi_flines, bi_import;
|
||||
static inline void md1_init() { ba(tbl) ba(each) ba(fold) ba(scan) ba(const) ba(swap) ba(cell) ba(timed) bm(fchars) bm(fbytes) bm(flines) ba(import)
|
||||
ti[t_md1BI].print = print_md1BI;
|
||||
}
|
||||
|
||||
|
||||
@ -50,7 +50,7 @@ B mut_fv(Mut* m) { assert(m->type!=el_MAX);
|
||||
srnk(r, 1);
|
||||
return r;
|
||||
}
|
||||
B mut_fp(Mut* m) { assert(m->type!=el_MAX);
|
||||
B mut_fp(Mut* m) { assert(m->type!=el_MAX); // has ia set
|
||||
return tag(m->val, ARR_TAG);
|
||||
}
|
||||
B mut_fc(Mut* m, B x) { assert(m->type!=el_MAX);
|
||||
@ -77,7 +77,7 @@ u8 el_or(u8 a, u8 b) {
|
||||
#undef M
|
||||
}
|
||||
|
||||
void mut_pfree(Mut* m, usz n) { // free the first n-1 elements
|
||||
void mut_pfree(Mut* m, usz n) { // free the first n elements
|
||||
if (m->type==el_B) harr_pfree(tag(m->val,ARR_TAG), n);
|
||||
else mm_free((Value*) m->val);
|
||||
}
|
||||
|
||||
Loading…
Reference in New Issue
Block a user