From 3f79fc377313b1791668c200911ef429f358b5da Mon Sep 17 00:00:00 2001 From: dzaima Date: Sat, 22 Jan 2022 19:30:24 +0200 Subject: [PATCH] =?UTF-8?q?native=20monadic=20=CB=9D?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- src/builtins/md1.c | 33 +++++++++++++++++++++++++++------ 1 file changed, 27 insertions(+), 6 deletions(-) diff --git a/src/builtins/md1.c b/src/builtins/md1.c index f5d3c7e9..de787df4 100644 --- a/src/builtins/md1.c +++ b/src/builtins/md1.c @@ -368,10 +368,16 @@ static B m1c2(B t, B f, B w, B x) { // consumes w,x } \ } else if (X##_cr!=0) X##_csz*= a(X)->sh[1]; -#define SLICE(X, S) ({ Arr* r_ = X##_slc(inc(X), S, X##_csz); arr_shSetI(r_, X##_cr, X##_csh); r_; }) +#define SLICE(X, S) ({ Arr* r_ = X##_slc(inc(X), S, X##_csz); arr_shSetI(r_, X##_cr, X##_csh); taga(r_); }) #define E_SLICES(X) if (X##_cr>1) ptr_dec(X##_csh); dec(X); +#pragma GCC diagnostic push +#ifdef __clang__ + #pragma GCC diagnostic ignored "-Wsometimes-uninitialized" + // no gcc case because gcc is gcc and does gcc things instead of doing what it's asked to do +#endif + extern B rt_cell; B cell_c1(Md1D* d, B x) { B f = d->f; if (isAtm(x) || rnk(x)==0) { @@ -417,7 +423,7 @@ B cell_c1(Md1D* d, B x) { B f = d->f; } S_SLICES(x) M_HARR(r, cam); - for (usz i=0,p=0; if; usz cam = a(x)->sh[0]; if (cam==0) goto zero; S_SLICES(x) M_HARR(r, cam); - for (usz i=0,p=0; ish[0]; if (cam==0) goto zero; S_SLICES(w) M_HARR(r, cam); - for (usz i=0,p=0; if; if (cam != a(x)->sh[0]) thrF("˘: Leading axis of arguments not equal (%H ≡ ≢𝕨, %H ≡ ≢𝕩)", w, x); S_SLICES(w) S_SLICES(x) M_HARR(r, cam); - for (usz i=0,wp=0,xp=0; if; } extern B rt_insert; -B insert_c1(Md1D* d, B x) { return m1c1(rt_insert, d->f, x); } +B insert_c1(Md1D* d, B x) { B f = d->f; + if (isAtm(x) || rnk(x)==0) thrM("˝: 𝕩 must have rank at least 1"); + usz xia = a(x)->ia; + if (xia==0) return m1c1(rt_insert, f, x); + + S_SLICES(x) + usz p = xia-x_csz; + B r = SLICE(x, p); + while(p!=0) { + p-= x_csz; + r = c2(f, SLICE(x, p), r); + } + E_SLICES(x) + return r; +} B insert_c2(Md1D* d, B w, B x) { return m1c2(rt_insert, d->f, w, x); } +#pragma GCC diagnostic pop static void print_md1BI(B x) { printf("%s", pm1_repr(c(Md1,x)->extra)); } void md1_init() {