#include "h.h" bool isPureFn(B x) { // doesn't consume if (!isFun(x) && !isMd(x)) return true; if (v(x)->flags) return true; B2B dcf = TI(x).decompose; B xd = dcf(inc(x)); B* xdp = harr_ptr(xd); i32 t = o2iu(xdp[0]); if (t<2) { dec(xd); return t==0; } usz xdia = a(xd)->ia; for (i32 i = 1; if; if (!EACH_FILLS) return eachm(f, x); B xf = getFillQ(x); return homFil1(f, eachm(f, x), xf); } B tbl_c2(B d, B w, B x) { B f = c(Md1D,d)->f; B wf, xf; if (EACH_FILLS) wf = getFillQ(w); if (EACH_FILLS) xf = getFillQ(x); if (isAtm(w)) w = m_atomUnit(w); if (isAtm(x)) x = m_atomUnit(x); 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 (rrsh, wr*sizeof(usz)); memcpy(rsh+wr, a(x)->sh, xr*sizeof(usz)); } dec(w); dec(x); if (EACH_FILLS) return homFil2(f, r.b, wf, xf); return r.b; } B each_c1(B d, B x) { B f = c(Md1D,d)->f; if (!EACH_FILLS) return eachm(f, x); B xf = getFillQ(x); return homFil1(f, eachm(f, x), xf); } B each_c2(B d, B w, B x) { B f = c(Md1D,d)->f; if (!EACH_FILLS) return eachd(f, w, x); B wf = getFillQ(w); B xf = getFillQ(x); return homFil2(f, eachd(f, w, x), wf, xf); } B scan_c1(B d, B x) { B f = c(Md1D,d)->f; if (isAtm(x) || rnk(x)==0) thrM("`: Argument cannot have rank 0"); B xf = getFillQ(x); ur xr = rnk(x); usz ia = a(x)->ia; if (ia==0) return x; bool reuse = v(x)->type==t_harr && reusable(x); usz i = 0; HArr_p r = reuse? harr_parts(x) : m_harrs(a(x)->ia, &i); BS2B xget = reuse? TI(x).getU : TI(x).get; BBB2B fc2 = c2fn(f); if (xr==1) { r.a[i] = xget(x,0); i++; for (i = 1; i < ia; i++) r.a[i] = fc2(f, inc(r.a[i-1]), xget(x,i)); } else { usz csz = arr_csz(x); for (; i < csz; i++) r.a[i] = xget(x,i); for (; i < ia; i++) r.a[i] = fc2(f, inc(r.a[i-csz]), xget(x,i)); } return withFill(reuse? x : harr_fcd(r, x), xf); } B scan_c2(B d, B w, B x) { B f = c(Md1D,d)->f; if (isAtm(x) || rnk(x)==0) thrM("`: ๐•ฉ cannot have rank 0"); ur xr = rnk(x); usz* xsh = a(x)->sh; usz ia = a(x)->ia; B wf = getFillQ(w); bool reuse = (v(x)->type==t_harr && reusable(x)) | !ia; usz i = 0; HArr_p r = reuse? harr_parts(x) : m_harrs(a(x)->ia, &i); BS2B xget = reuse? TI(x).getU : TI(x).get; BBB2B fc2 = c2fn(f); if (isArr(w)) { ur wr = rnk(w); usz* wsh = a(w)->sh; BS2B wget = TI(w).get; if (wr+1 != xr) thrM("`: Shape of ๐•จ must match the cell of ๐•ฉ"); if (memcmp(wsh, xsh+1, wr)) thrM("`: Shape of ๐•จ must match the cell of ๐•ฉ"); if (ia==0) return x; usz csz = arr_csz(x); for (; i < csz; i++) r.a[i] = fc2(f, wget(w,i), xget(x,i)); for (; i < ia; i++) r.a[i] = fc2(f, inc(r.a[i-csz]), xget(x,i)); dec(w); } else { if (xr!=1) thrM("`: Shape of ๐•จ must match the cell of ๐•ฉ"); if (ia==0) return x; B pr = r.a[0] = fc2(f, w, xget(x,0)); i++; for (; i < ia; i++) r.a[i] = pr = fc2(f, inc(pr), xget(x,i)); } return withFill(reuse? x : harr_fcd(r, x), wf); } B fold_c1(B d, B x) { B f = c(Md1D,d)->f; if (isAtm(x) || rnk(x)!=1) thrM("ยด: argument must be a list"); usz ia = a(x)->ia; if (ia==0) { dec(x); if (isFun(f)) { B r = TI(f).identity(f); if (!isNothing(r)) return inc(r); } thrM("ยด: No identity found"); } BS2B xget = TI(x).get; B c = xget(x, ia-1); BBB2B fc2 = c2fn(f); for (usz i = ia-1; i>0; i--) c = fc2(f, xget(x, i-1), c); dec(x); return c; } B fold_c2(B d, B w, B x) { B f = c(Md1D,d)->f; if (isAtm(x) || rnk(x)!=1) thrM("ยด: ๐•ฉ must be a list"); usz ia = a(x)->ia; B c = w; BS2B xget = TI(x).get; BBB2B fc2 = c2fn(f); for (usz i = ia; i>0; i--) c = fc2(f, xget(x, i-1), c); dec(x); return c; } B const_c1(B d , B x) { dec(x); return inc(c(Md1D,d)->f); } B const_c2(B d, B w, B x) { dec(w); dec(x); return inc(c(Md1D,d)->f); } B swap_c1(B d , B x) { return c2(c(Md1D,d)->f, inc(x), x); } B swap_c2(B d, B w, B x) { return c2(c(Md1D,d)->f, x , w); } #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_md1_def(B x) { printf("%s", format_pm1(c(Md1,x)->extra)); } B bi_tbl, bi_each, bi_fold, bi_scan, bi_const, bi_swap; static inline void md1_init() { ba(tbl) ba(each) ba(fold) ba(scan) ba(const) ba(swap) ti[t_md1BI].print = print_md1_def; } #undef ba #undef bd #undef bm