diff --git a/src/arith.c b/src/arith.c index f436b832..a61e5da4 100644 --- a/src/arith.c +++ b/src/arith.c @@ -156,49 +156,7 @@ B ne_c2(B t, B w, B x) { 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); + return bqn_merge(x); } B add_c1(B t, B x) { return x; } @@ -216,9 +174,8 @@ 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; -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 rt_sortDsc; +B or_c1(B t, B x) { return c1(rt_sortDsc, x); } #undef P1 #undef P2 diff --git a/src/fns.c b/src/fns.c index 1be6685b..cd9c59a0 100644 --- a/src/fns.c +++ b/src/fns.c @@ -13,6 +13,55 @@ B funBI_ucw(B t, B o, B w, B x) { return c(BFn,t)->ucw(t, o, w, x); } B funBI_identity(B x) { return inc(c(BFn,x)->ident); } +B bqn_merge(B x) { + assert(isArr(x)); + usz xia = a(x)->ia; + ur xr = rnk(x); + if (xia==0) { + B xf = getFillE(x); + if (isAtm(xf)) { dec(xf); return x; } + i32 xfr = rnk(xf); + B xff = getFillQ(xf); + B r = m_fillarrp(0); + fillarr_setFill(r, xff); + 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); +} + + void ud_rec(B** p, usz d, usz r, usz* pos, usz* sh) { if (d==r) { i32* rp; diff --git a/src/main.c b/src/main.c index b2be94ab..897f1511 100644 --- a/src/main.c +++ b/src/main.c @@ -45,8 +45,8 @@ #include "fns.c" #include "sfns.c" #include "sysfn.c" +#include "sort.c" #include "arith.c" -#include "grade.c" #include "md1.c" #include "md2.c" #include "vm.c" diff --git a/src/grade.c b/src/sort.c similarity index 76% rename from src/grade.c rename to src/sort.c index efef9652..c1e4219f 100644 --- a/src/grade.c +++ b/src/sort.c @@ -2,6 +2,7 @@ B rt_gradeUp; + static void gradeUp_rec(i32* b, i32* I, i32* O, usz s, usz e) { if (e-s<=1) return; usz m = (s+(u64)e)/2; @@ -91,7 +92,30 @@ B gradeUp_c2(B t, B w, B x) { return r; } +int sort_icmp(const void* w, const void* x) { return *(int*)w - *(int*)x; } +int sort_bcmp(const void* w, const void* x) { return compare(*(B*)w, *(B*)x); } +B rt_sortAsc; +B and_c1(B t, B x) { + if (isAtm(x) || rnk(x)==0) thrM("∧: Argument cannot have rank 0"); + if (rnk(x)!=1) return bqn_merge(and_c1(t, toCells(x))); + usz xia = a(x)->ia; + if (TI(x).elType==el_i32) { + i32* xp = i32any_ptr(x); + i32* rp; B r = m_i32arrv(&rp, xia); + memcpy(rp, xp, xia*4); + qsort(rp, xia, 4, sort_icmp); + dec(x); + return r; + } + HArr_p r = m_harrUv(xia); + BS2B xget = TI(x).get; + for (usz i = 0; i < xia; i++) r.a[i] = xget(x,i); + qsort(r.a, xia, sizeof(B), sort_bcmp); + dec(x); + return r.b; +} + #define F(A,M,D) A(gradeUp) BI_FNS0(F); -static inline void grade_init() { BI_FNS1(F) } +static inline void sort_init() { BI_FNS1(F) } #undef F diff --git a/src/stuff.c b/src/stuff.c index 4820baa8..f11b4ae8 100644 --- a/src/stuff.c +++ b/src/stuff.c @@ -283,6 +283,7 @@ bool equal(B w, B x) { // doesn't consume for (usz i = 0; i < ia; i++) if(!equal(wgetU(w,i),xgetU(x,i))) return false; return true; } +B bqn_merge(B x); #define CMP(W,X) ({ AUTO wt = (W); AUTO xt = (X); (wt>xt?1:0)-(wt