diff --git a/src/fillarr.c b/src/fillarr.c index 5720fefd..d442ee42 100644 --- a/src/fillarr.c +++ b/src/fillarr.c @@ -6,22 +6,6 @@ typedef struct FillArr { B a[]; } FillArr; -B asFill(B x) { // consumes - if (isArr(x)) { - HArr_p r = m_harrUc(x); - usz ia = r.c->ia; - BS2B xget = TI(x).get; - bool noFill = false; - for (usz i = 0; i < ia; i++) if ((r.a[i]=asFill(xget(x,i))).u == bi_noFill.u) noFill = true; - dec(x); - if (noFill) { ptr_dec(r.c); return bi_noFill; } - return r.b; - } - if (isF64(x)|isI32(x)) return m_i32(0); - if (isC32(x)) return m_c32(' '); - dec(x); - return bi_noFill; -} B getFillQ(B x) { // doesn't consume; can return bi_noFill bool defZero = true; #ifdef CATCH_ERRORS @@ -51,6 +35,24 @@ B getFillE(B x) { // errors if there's no fill } bool noFill(B x) { return x.u == bi_noFill.u; } +B asFill(B x) { // consumes + if (isArr(x)) { + HArr_p r = m_harrUc(x); + usz ia = r.c->ia; + BS2B xget = TI(x).get; + bool noFill = false; + for (usz i = 0; i < ia; i++) if ((r.a[i]=asFill(xget(x,i))).u == bi_noFill.u) noFill = true; + B xf = getFillQ(x); + dec(x); + if (noFill) { ptr_dec(r.c); return bi_noFill; } + return withFill(r.b, xf); + } + if (isF64(x)|isI32(x)) return m_i32(0); + if (isC32(x)) return m_c32(' '); + dec(x); + return bi_noFill; +} + B m_fillarrp(usz ia) { return m_arr(fsizeof(FillArr,a,B,ia), t_fillarr); } diff --git a/src/h.h b/src/h.h index f01e1d44..0bec01e3 100644 --- a/src/h.h +++ b/src/h.h @@ -117,7 +117,7 @@ char* format_type(u8 u) { /*arith.c*/ F(add,"+") F(sub,"-") F(mul,"×") F(div,"÷") F(pow,"⋆") F(floor,"⌊") F(ceil,"⌈") F(stile,"|") F(eq,"=") \ /*arith.c*/ F(ne,"≠") F(le,"≤") F(ge,"≥") F(lt,"<") F(gt,">") F(and,"∧") F(or,"∨") F(not,"¬") F(log,"⋆⁼") \ /*fns.c*/ F(ud,"↕") F(fne,"≢") F(feq,"≡") F(ltack,"⊣") F(rtack,"⊢") F(fmtF,"•FmtF") F(fmtN,"•FmtN") \ - /*sfns.c*/ F(shape,"⥊") F(pick,"⊑") F(pair,"{𝕨‿𝕩}") F(select,"⊏") F(slash,"/") F(join,"∾") F(couple,"≍") F(shiftb,"»") F(shifta,"«") F(take,"↑") F(drop,"↓") \ + /*sfns.c*/ F(shape,"⥊") F(pick,"⊑") F(pair,"{𝕨‿𝕩}") F(select,"⊏") F(slash,"/") F(join,"∾") F(couple,"≍") F(shiftb,"»") F(shifta,"«") F(take,"↑") F(drop,"↓") F(group,"⊔") \ /*derv.c*/ F(fork,"(fork)") F(atop,"(atop)") F(md1d,"(derived 1-modifier)") F(md2d,"(derived 2-modifier)") \ /*sort.c*/ F(gradeUp,"⍋") \ /*sysfn.c*/ F(type,"•Type") F(decp,"•Decompose") F(primInd,"•PrimInd") F(glyph,"•Glyph") F(fill,"•FillFn") \ @@ -239,6 +239,7 @@ usz arr_csz(B x); // doesn't consume bool atomEqual(B w, B x); // doesn't consume B toCells(B x); // consumes B toKCells(B x, ur k); // consumes +B withFill(B x, B f); // consumes both bool eqShPrefix(usz* w, usz* x, ur len); B m_v1(B a ); // consumes all @@ -251,8 +252,9 @@ B m_str32(u32* s); // meant to be used as m_str32(U"{𝕨‿𝕩}"), so doesn't B bqn_exec(B str); // consumes -NORETURN void thr(B b); -NORETURN void thrM(char* s); +NOINLINE NORETURN void thr(B b); +NOINLINE NORETURN void thrM(char* s); +NOINLINE NORETURN void thrOOM(); jmp_buf* prepareCatch(); #ifdef CATCH_ERRORS #define CATCH setjmp(*prepareCatch()) // use as `if (CATCH) { /*handle error; dec(catchMessage);*/ } /*potentially erroring thing*/ popCatch();` diff --git a/src/load.c b/src/load.c index 32bd8322..884b90fe 100644 --- a/src/load.c +++ b/src/load.c @@ -45,7 +45,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_N , bi_N , bi_slash, bi_gradeUp, bi_N , bi_select, bi_pick , bi_N , bi_N , bi_N, - /* ⍷⊔!˙˜˘¨⌜⁼´ */ bi_N , bi_N , 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_N , bi_each , bi_tbl , bi_N , bi_fold, /* ˝`∘○⊸⟜⌾⊘◶⎉ */ bi_N , bi_scan , bi_atop , bi_over , bi_before, bi_after , bi_N , bi_val , bi_cond , bi_N, /* ⚇⍟⎊ */ bi_N , bi_repeat, bi_catch }; @@ -54,7 +54,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, /* ⌽⍉/⍋⍒⊏⊑⊐⊒∊ */ 0,0,1,1,0,1,1,0,0,0, - /* ⍷⊔!˙˜˘¨⌜⁼´ */ 0,0,1,1,1,0,1,1,0,1, + /* ⍷⊔!˙˜˘¨⌜⁼´ */ 0,1,1,1,1,0,1,1,0,1, /* ˝`∘○⊸⟜⌾⊘◶⎉ */ 0,1,1,1,1,1,0,1,0,0, /* ⚇⍟⎊ */ 0,1,1 }; @@ -103,6 +103,7 @@ static inline void load_init() { rt_pick = rtObjGet(rtObjRaw, 36); gc_add(rt_pick); rt_take = rtObjGet(rtObjRaw, 25); gc_add(rt_take); rt_drop = rtObjGet(rtObjRaw, 26); gc_add(rt_drop); + rt_group = rtObjGet(rtObjRaw, 41); gc_add(rt_group); for (usz i = 0; i < runtimeLen; i++) { #ifdef ALL_R1 diff --git a/src/sfns.c b/src/sfns.c index 0613143f..b7027770 100644 --- a/src/sfns.c +++ b/src/sfns.c @@ -339,7 +339,7 @@ B slash_c2(B t, B w, B x) { usz xia = a(x)->ia; B xf = getFillQ(x); if (wia!=xia) thrM("/: Lengths of components of 𝕨 must match 𝕩"); - i64 wsum = isum(w); if (wsum>USZ_MAX) thrM("/: Result too large"); + i64 wsum = isum(w); if (wsum>USZ_MAX) thrOOM(); usz ria = wsum; usz ri = 0; if (TI(w).elType==el_i32) { @@ -620,10 +620,66 @@ B shifta_c2(B t, B w, B x) { return qWithFill(mut_fcd(r, x), f); } +B rt_group; +B group_c1(B t, B x) { + return c1(rt_group, x); +} +B group_c2(B t, B w, B x) { + if (isArr(w)&isArr(x) && rnk(w)==1 && rnk(x)==1) { + usz wia = a(w)->ia; + usz xia = a(x)->ia; + if (wia-xia > 1) thrM("⊔: ≠𝕨 must be either ≠𝕩 or one bigger"); + + BS2B wgetU = TI(w).getU; + i64 ria = wia==xia? -1 : o2i64(wgetU(w, xia))-1; + for (usz i = 0; i < xia; i++) { + if (!isNum(w)) goto base; + i64 c = o2i64(wgetU(w, i)); + if (c>ria) ria = c; + } + if (ria>USZ_MAX-1) thrOOM(); + ria++; + i32 len[ria]; + i32 pos[ria]; + for (usz i = 0; i < ria; i++) len[i] = pos[i] = 0; + for (usz i = 0; i < xia; i++) { + i64 n = o2i64u(wgetU(w, i)); + if (n>=0) len[n]++; + } + + B r = m_fillarrp(ria); + arr_shVec(r, ria); + fillarr_setFill(r, m_f64(0)); + B* rp = fillarr_ptr(r); + for (usz i = 0; i < ria; i++) rp[i] = m_f64(0); // don't break if allocation errors + B xf = getFillQ(x); + + + for (usz i = 0; i < ria; i++) { + B c = m_fillarrp(len[i]); + fillarr_setFill(c, inc(xf)); + a(c)->ia = 0; + rp[i] = c; + } + B rf = m_fillarrp(ria); + arr_shVec(rf, 0); + fillarr_setFill(rf, xf); + fillarr_setFill(r, rf); + BS2B xget = TI(x).get; + for (usz i = 0; i < xia; i++) { + i64 n = o2i64u(wgetU(w, i)); + if (n>=0) fillarr_ptr(rp[n])[pos[n]++] = xget(x, i); + } + for (usz i = 0; i < ria; i++) { arr_shVec(rp[i], len[i]); } + dec(w); dec(x); + return r; + } + base: + return c2(rt_group, w, x); +} - -#define F(A,M,D) A(shape) A(pick) A(pair) A(select) A(slash) A(join) A(couple) A(shiftb) A(shifta) A(take) A(drop) +#define F(A,M,D) A(shape) A(pick) A(pair) A(select) A(slash) A(join) A(couple) A(shiftb) A(shifta) A(take) A(drop) A(group) BI_FNS0(F); static inline void sfns_init() { BI_FNS1(F) } #undef F diff --git a/src/stuff.c b/src/stuff.c index 036f3f41..d4675079 100644 --- a/src/stuff.c +++ b/src/stuff.c @@ -227,7 +227,7 @@ u8 fillElType(B x) { if (!isVal(x)) return x; VALIDATEP(v(x)); if(isArr(x)!=TI(x).isArr && v(x)->type!=t_freed && v(x)->type!=t_harrPartial) { - printf("wat %d %p\n", v(x)->type, (void*)x.u); + printf("bad array tag/type: type=%d, obj=%p\n", v(x)->type, (void*)x.u); print(x); err("\nk"); } diff --git a/src/sysfn.c b/src/sysfn.c index 62878e45..60d8bfa9 100644 --- a/src/sysfn.c +++ b/src/sysfn.c @@ -47,49 +47,32 @@ B fill_c2(B t, B w, B x) { // TODO not set fill for typed arrays return x; } -B grLen_c1(B t, B x) { // assumes valid arguments - i64 ria = -1; +B grLen_both(i64 ria, B x) { usz ia = a(x)->ia; BS2B xgetU = TI(x).getU; for (usz i = 0; i < ia; i++) { i64 c = o2i64u(xgetU(x, i)); if (c>ria) ria = c; } + if (ria>USZ_MAX-1) thrOOM(); ria++; i32* rp; B r = m_i32arrv(&rp, ria); for (usz i = 0; i < ria; i++) rp[i] = 0; for (usz i = 0; i < ia; i++) { i64 n = o2i64u(xgetU(x, i)); - if (n>USZ_MAX) thrM("grLen: Bad item in 𝕩"); - else if (n>=0) rp[n]++; - } - dec(x); - return r; -} -B grLen_c2(B t, B w, B x) { // assumes valid arguments - i64 ria = o2i64u(w)-1; - usz ia = a(x)->ia; - BS2B xgetU = TI(x).getU; - for (usz i = 0; i < ia; i++) { - i64 c = o2i64u(xgetU(x, i)); - if (c>ria) ria = c; - } - ria++; - i32* rp; B r = m_i32arrv(&rp, ria); - for (usz i = 0; i < ria; i++) rp[i] = 0; - for (usz i = 0; i < ia; i++) { - i64 n = o2i64u(xgetU(x, i)); - if (n==(usz)n) rp[n]++; - else if (n!=-1) thrM("grLen: Too large"); + if (n>=0) rp[n]++; + assert(n>=-1); } dec(x); return r; } +B grLen_c1(B t, B x) { return grLen_both( -1, x); } // assumes valid arguments +B grLen_c2(B t, B w, B x) { return grLen_both(o2i64u(w)-1, x); } // assumes valid arguments B grOrd_c2(B t, B w, B x) { // assumes valid arguments usz wia = a(w)->ia; usz xia = a(x)->ia; - if (wia==0) { dec(w); dec(x); return c1(bi_ud, m_i32(0)); } + if (wia==0) { dec(w); dec(x); return inc(bi_emptyIVec); } if (xia==0) { dec(w); return x; } BS2B wgetU = TI(w).getU; BS2B xgetU = TI(x).getU; @@ -98,7 +81,7 @@ B grOrd_c2(B t, B w, B x) { // assumes valid arguments for (usz i = 1; i < wia; i++) tmp[i] = tmp[i-1]+o2su(wgetU(w,i-1)); usz ria = tmp[wia-1]+o2su(wgetU(w,wia-1)); i32* rp; B r = m_i32arrv(&rp, ria); - if (xia>=I32_MAX) thrM("grOrd: Too large"); + if (xia>=I32_MAX) thrM("⊔: Too large"); for (usz i = 0; i < xia; i++) { i64 c = o2i64(xgetU(x,i)); if (c>=0) rp[tmp[c]++] = i; diff --git a/src/vm.c b/src/vm.c index f6ebc90c..722a43b6 100644 --- a/src/vm.c +++ b/src/vm.c @@ -697,7 +697,7 @@ NOINLINE NORETURN void thr(B msg) { NOINLINE NORETURN void thrM(char* s) { thr(fromUTF8(s, strlen(s))); } - +NOINLINE NORETURN void thrOOM() { thrM("Out of memory"); } NOINLINE void vm_pst(Env* s, Env* e) {