diff --git a/buildg b/buildg new file mode 100755 index 00000000..fe2565d4 --- /dev/null +++ b/buildg @@ -0,0 +1,2 @@ +#!/usr/bin/env bash +clang -std=gnu11 -O3 -g -Wall -Wno-microsoft-anon-tag -fms-extensions -o BQN src/main.c -lm diff --git a/src/c32arr.c b/src/c32arr.c index 235e02d0..c3eb5822 100644 --- a/src/c32arr.c +++ b/src/c32arr.c @@ -70,7 +70,7 @@ bool c32arr_canStore(B x) { return isC32(x); } bool eqStr(B w, u32* x) { - if (!isArr(w) || rnk(w)!=1) return false; + if (isAtm(w) || rnk(w)!=1) return false; BS2B wgetU = TI(w).getU; u64 i = 0; while (x[i]) { diff --git a/src/fillarr.c b/src/fillarr.c index aa4b8935..c3f12d22 100644 --- a/src/fillarr.c +++ b/src/fillarr.c @@ -111,6 +111,22 @@ B m_unit(B x) { c(FillArr,r)->a[0] = x; return r; } +B m_atomUnit(B x) { + if (isNum(x)) { + B r; + if (q_i32(x)) { r=m_i32arrp(1); i32arr_ptr(r)[0] = o2iu(x); } + else { r=m_f64arrp(1); f64arr_ptr(r)[0] = o2fu(x); } + arr_shAllocR(r,0); + return r; + } + if (isC32(x)) { + B r = m_c32arrp(1); + c32arr_ptr(r)[0] = o2cu(x); + arr_shAllocR(r,0); + return r; + } + return m_unit(x); +} void validateFill(B x) { if (isArr(x)) { @@ -157,45 +173,69 @@ B withFill(B x, B fill) { // consumes both } usz ia = a(x)->ia; if (isNum(fill)) { - BS2B xgetU = TI(x).getU; - { - B r = m_i32arrc(x); i32* rp = i32arr_ptr(r); - for (usz i = 0; i < ia; i++) { - B c = xgetU(x, i); - if (!q_i32(c)) { dec(r); goto l_f64; } - rp[i] = o2iu(c); + if (v(x)->type==t_harr) { + B* xp = harr_ptr(x); + { + B r = m_i32arrc(x); i32* rp = i32arr_ptr(r); + for (usz i = 0; i < ia; i++) { + B c = xp[i]; + if (!q_i32(c)) { dec(r); goto h_f64; } + rp[i] = o2iu(c); + } + dec(x); + return r; } - dec(x); - return r; - } - l_f64: { - B r = m_f64arrc(x); f64* rp = f64arr_ptr(r); - for (usz i = 0; i < ia; i++) { - B c = xgetU(x, i); - if (!q_f64(c)) { dec(r); goto base; } - rp[i] = o2fu(c); + h_f64: { + B r = m_f64arrc(x); f64* rp = f64arr_ptr(r); + for (usz i = 0; i < ia; i++) { + B c = xp[i]; + if (!q_f64(c)) { dec(r); goto base; } + rp[i] = o2fu(c); + } + dec(x); + return r; } - dec(x); - return r; + } else { + BS2B xgetU = TI(x).getU; + { + B r = m_i32arrc(x); i32* rp = i32arr_ptr(r); + for (usz i = 0; i < ia; i++) { + B c = xgetU(x, i); + if (!q_i32(c)) { dec(r); goto g_f64; } + rp[i] = o2iu(c); + } + dec(x); + return r; + } + g_f64: { + B r = m_f64arrc(x); f64* rp = f64arr_ptr(r); + for (usz i = 0; i < ia; i++) { + B c = xgetU(x, i); + if (!q_f64(c)) { dec(r); goto base; } + rp[i] = o2fu(c); + } + dec(x); + return r; + } + + // bool ints = true; + // for (usz i = 0; i < ia; i++) { + // B c = xgetU(x, i); + // if (!isNum(c)) goto base; + // if (!q_i32(c)) ints = false; + // } + // if (ints) { + // B r = m_i32arrc(x); i32* rp = i32arr_ptr(r); + // for (usz i = 0; i < ia; i++) rp[i] = o2iu(xgetU(x, i)); + // dec(x); + // return r; + // } else { + // B r = m_f64arrc(x); f64* rp = f64arr_ptr(r); + // for (usz i = 0; i < ia; i++) rp[i] = o2fu(xgetU(x, i)); + // dec(x); + // return r; + // } } - - // bool ints = true; - // for (usz i = 0; i < ia; i++) { - // B c = xgetU(x, i); - // if (!isNum(c)) goto base; - // if (!q_i32(c)) ints = false; - // } - // if (ints) { - // B r = m_i32arrc(x); i32* rp = i32arr_ptr(r); - // for (usz i = 0; i < ia; i++) rp[i] = o2iu(xgetU(x, i)); - // dec(x); - // return r; - // } else { - // B r = m_f64arrc(x); f64* rp = f64arr_ptr(r); - // for (usz i = 0; i < ia; i++) rp[i] = o2fu(xgetU(x, i)); - // dec(x); - // return r; - // } } else if (isC32(fill)) { B r = m_c32arrc(x); u32* rp = c32arr_ptr(r); BS2B xgetU = TI(x).getU; diff --git a/src/fns.c b/src/fns.c index 76edec2a..cfd92539 100644 --- a/src/fns.c +++ b/src/fns.c @@ -73,7 +73,7 @@ B fne_c1(B t, B x) { } } u64 depth(B x) { // doesn't consume - if (!isArr(x)) return 0; + if (isAtm(x)) return 0; if (TI(x).arrD1) return 1; u64 r = 0; usz ia = a(x)->ia; diff --git a/src/h.h b/src/h.h index 35fe99b9..0d0c95d1 100644 --- a/src/h.h +++ b/src/h.h @@ -282,7 +282,7 @@ bool isVal(B x) { return (x.u - (((u64)VAL_TAG<<51) + 1)) < ((1ull<<51) - 1); } bool isF64(B x) { return (x.u<<1) - ((0xFFEull<<52) + 2) >= (1ull<<52) - 2; } bool isNum(B x) { return isF64(x)|isI32(x); } -bool isAtm(B x) { return !isVal(x); } +bool isAtm(B x) { return !isArr(x); } bool noFill(B x); // shape mess diff --git a/src/md1.c b/src/md1.c index ac6fda24..ed7527b3 100644 --- a/src/md1.c +++ b/src/md1.c @@ -53,8 +53,8 @@ B tbl_c2(B d, B w, B x) { B f = c(Md1D,d)->f; B wf, xf; if (EACH_FILLS) wf = getFill(inc(w)); if (EACH_FILLS) xf = getFill(inc(x)); - if (isAtm(w)) w = m_hunit(w); - if (isAtm(x)) x = m_hunit(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; @@ -94,7 +94,7 @@ B each_c2(B d, B w, B x) { B f = c(Md1D,d)->f; B scan_c1(B d, B x) { B f = c(Md1D,d)->f; - if (!isArr(x) || rnk(x)==0) thrM("`: Argument cannot have rank 0"); + if (isAtm(x) || rnk(x)==0) thrM("`: Argument cannot have rank 0"); B xf = getFill(inc(x)); ur xr = rnk(x); usz ia = a(x)->ia; @@ -116,7 +116,7 @@ B scan_c1(B d, B x) { B f = c(Md1D,d)->f; 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 (!isArr(x) || rnk(x)==0) thrM("`: ๐•ฉ cannot have rank 0"); + 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 = getFill(inc(w)); bool reuse = (v(x)->type==t_harr && reusable(x)) | !ia; @@ -143,7 +143,7 @@ B scan_c2(B d, B w, B x) { B f = c(Md1D,d)->f; } B fold_c1(B d, B x) { B f = c(Md1D,d)->f; - if (!isArr(x) || rnk(x)!=1) thrM("ยด: argument must be a list"); + if (isAtm(x) || rnk(x)!=1) thrM("ยด: argument must be a list"); usz ia = a(x)->ia; if (ia==0) { dec(x); @@ -160,7 +160,7 @@ B fold_c1(B d, B x) { B f = c(Md1D,d)->f; return c; } B fold_c2(B d, B w, B x) { B f = c(Md1D,d)->f; - if (!isArr(x) || rnk(x)!=1) thrM("ยด: ๐•ฉ must be a list"); + if (isAtm(x) || rnk(x)!=1) thrM("ยด: ๐•ฉ must be a list"); usz ia = a(x)->ia; B c = w; BS2B xget = TI(x).get; diff --git a/src/md2.c b/src/md2.c index 6afb7cb3..2a7b7cf3 100644 --- a/src/md2.c +++ b/src/md2.c @@ -10,7 +10,7 @@ B val_c2(B d, B w, B x) { return c2(c(Md2D,d)->g, w,x); } B fillBy_c1(B d, B x) { B xf=getFill(inc(x)); B r = c1(c(Md2D,d)->f, x); - if(!isArr(r) || noFill(xf)) { dec(xf); return r; } + if(isAtm(r) || noFill(xf)) { dec(xf); return r; } if (CATCH) { dec(catchMessage); return r; } B fill = asFill(c1(c(Md2D,d)->g, xf)); popCatch(); @@ -19,7 +19,7 @@ B fillBy_c1(B d, B x) { B fillBy_c2(B d, B w, B x) { B wf=getFill(inc(w)); B xf=getFill(inc(x)); B r = c2(c(Md2D,d)->f, w,x); - if(!isArr(r) || noFill(xf)) { dec(xf); dec(wf); return r; } + if(isAtm(r) || noFill(xf)) { dec(xf); dec(wf); return r; } if (CATCH) { dec(catchMessage); return r; } if (noFill(wf)) wf = inc(bi_asrt); B fill = asFill(c2(c(Md2D,d)->g, wf, xf)); @@ -104,14 +104,14 @@ B over_c1(B d, B x) { return c1(c(Md2D,d)->f, c1(c(Md2D,d)->g, x)); } B over_c2(B d, B w, B x) { B xr=c1(c(Md2D,d)->g, x); return c2(c(Md2D,d)->f, c1(c(Md2D,d)->g, w), xr); } B cond_c1(B d, B x) { B g=c(Md2D,d)->g; - if (!isArr(g)||rnk(g)!=1) thrM("โ—ถ: ๐•˜ must have rank 1"); + if (isAtm(g)||rnk(g)!=1) thrM("โ—ถ: ๐•˜ must have rank 1"); i64 fr = o2i64(c1(c(Md2D,d)->f, inc(x))); if (fr<0) fr+= a(g)->ia; if ((u64)fr >= a(g)->ia) thrM("โ—ถ: ๐”ฝ out of bounds of ๐•˜"); return c1(TI(g).getU(g, fr), x); } B cond_c2(B d, B w, B x) { B g=c(Md2D,d)->g; - if (!isArr(g)||rnk(g)!=1) thrM("โ—ถ: ๐•˜ must have rank 1"); + if (isAtm(g)||rnk(g)!=1) thrM("โ—ถ: ๐•˜ must have rank 1"); i64 fr = o2i64(c2(c(Md2D,d)->f, inc(w), inc(x))); if (fr<0) fr+= a(g)->ia; if ((u64)fr >= a(g)->ia) thrM("โ—ถ: ๐”ฝ out of bounds of ๐•˜"); diff --git a/src/sfns.c b/src/sfns.c index 3ea56bea..22d5d78c 100644 --- a/src/sfns.c +++ b/src/sfns.c @@ -3,8 +3,8 @@ static inline B mv(B* p, usz n) { B r = p [n]; p [n] = m_f64(0); return r; } static inline B hmv(HArr_p p, usz n) { B r = p.a[n]; p.a[n] = m_f64(0); return r; } B eachd_fn(BBB2B f, B fo, B w, B x) { // consumes w,x; assumes at least one is array - if (!isArr(w)) w = m_hunit(w); - if (!isArr(x)) x = m_hunit(x); + if (isAtm(w)) w = m_atomUnit(w); + if (isAtm(x)) x = m_atomUnit(x); ur wr = rnk(w); BS2B wget = TI(w).get; ur xr = rnk(x); BS2B xget = TI(x).get; bool wg = wr>xr; @@ -128,9 +128,9 @@ B eachm_fn(BB2B f, B fo, B x) { // consumes x; x must be array return harr_fcd(rH, x); } B eachm(B f, B x) { // complete Fยจ x without fills - if (!isArr(x)) return m_hunit(c1(f, x)); + if (isAtm(x)) return m_hunit(c1(f, x)); if (isFun(f)) return eachm_fn(c(Fun,f)->c1, f, x); - if (isMd(f)) if (!isArr(x) || a(x)->ia) { decR(x); thrM("Calling a modifier"); } + if (isMd(f)) if (isAtm(x) || a(x)->ia) { decR(x); thrM("Calling a modifier"); } usz ia = a(x)->ia; MAKE_MUT(r, ia); @@ -139,11 +139,11 @@ B eachm(B f, B x) { // complete Fยจ x without fills } B eachd(B f, B w, B x) { // complete w Fยจ x without fills - if (!isArr(w) & !isArr(x)) return m_hunit(c2(f, w, x)); + if (isAtm(w) & isAtm(x)) return m_hunit(c2(f, w, x)); return eachd_fn(c2fn(f), f, w, x); } B shape_c1(B t, B x) { - if (!isArr(x)) thrM("โฅŠ: deshaping non-array"); + if (isAtm(x)) thrM("โฅŠ: deshaping non-array"); usz ia = a(x)->ia; if (reusable(x)) { decSh(x); @@ -155,8 +155,8 @@ B shape_c1(B t, B x) { return r; } B shape_c2(B t, B w, B x) { - if (!isArr(x)) { dec(x); dec(w); thrM("โฅŠ: Reshaping non-array"); } - if (!isArr(w)) return shape_c1(t, x); + if (isAtm(x)) { dec(x); dec(w); thrM("โฅŠ: Reshaping non-array"); } + if (isAtm(w)) return shape_c1(t, x); BS2B wget = TI(w).get; usz wia = a(w)->ia; if (wia>UR_MAX) thrM("โฅŠ: Result rank too large"); @@ -172,7 +172,7 @@ B shape_c2(B t, B w, B x) { } B pick_c1(B t, B x) { - if (!isArr(x)) return x; + if (isAtm(x)) return x; if (a(x)->ia==0) { B r = getFill(x); if (noFill(r)) thrM("โŠ‘: called on empty array without fill"); @@ -184,7 +184,7 @@ B pick_c1(B t, B x) { } B pick_c2(B t, B w, B x) { // usz wu = o2s(w); - // if (!isArr(x)) { dec(x); dec(w); thrM("โŠ‘: ๐•ฉ wasn't an array"); } + // if (isAtm(x)) { dec(x); dec(w); thrM("โŠ‘: ๐•ฉ wasn't an array"); } // if (wu >= a(x)->ia) thrM("โŠ‘: ๐•จ is greater than length of ๐•ฉ"); // no bounds check for now B r = TI(x).get(x, o2su(w)); dec(x); @@ -193,7 +193,7 @@ B pick_c2(B t, B w, B x) { B rt_select; B select_c1(B t, B x) { - if (!isArr(x)) thrM("โŠ: Argument cannot be an atom"); + if (isAtm(x)) thrM("โŠ: Argument cannot be an atom"); ur xr = rnk(x); if (xr==0) thrM("โŠ: Argument cannot be rank 0"); if (a(x)->sh[0]==0) thrM("โŠ: Argument shape cannot start with 0"); @@ -208,9 +208,9 @@ B select_c1(B t, B x) { return r; } B select_c2(B t, B w, B x) { - if (!isArr(x)) thrM("โŠ: ๐•ฉ cannot be an atom"); + if (isAtm(x)) thrM("โŠ: ๐•ฉ cannot be an atom"); ur xr = rnk(x); - if (!isArr(w)) { + if (isAtm(w)) { if (xr==0) thrM("โŠ: ๐•ฉ cannot be a unit"); usz csz = arr_csz(x); usz cam = a(x)->sh[0]; @@ -224,19 +224,36 @@ B select_c2(B t, B w, B x) { } B xf = getFill(inc(x)); BS2B xget = TI(x).get; + usz wia = a(w)->ia; + if (xr==1) { - usz wia = a(w)->ia; usz xia = a(x)->ia; - HArr_p r = m_harrUc(w); - if(v(w)->type==t_i32arr | v(w)->type==t_i32slice) { - i32* wp = v(w)->type==t_i32arr? i32arr_ptr(w) : c(I32Slice,w)->a; - for (usz i = 0; i < wia; i++) { - i64 c = wp[i]; - if (c<0) c+= xia; - if (c<0 | c>=xia) thrM("โŠ: Indexing out-of-bounds"); - r.a[i] = xget(x, c); + if (v(w)->type==t_i32arr | v(w)->type==t_i32slice) { + i32* wp = v(w)->type==t_i32slice? c(I32Slice,w)->a : i32arr_ptr(w); + if (v(x)->type==t_i32arr) { + B r = m_i32arrc(w); i32* rp = i32arr_ptr(r); + i32* xp = i32arr_ptr(x); + for (usz i = 0; i < wia; i++) { + i64 c = wp[i]; + if (c<0) c+= xia; + if (c<0 | c>=xia) thrM("โŠ: Indexing out-of-bounds"); + rp[i] = xp[c]; + } + dec(w); dec(x); + return r; + } else { + HArr_p r = m_harrUc(w); + for (usz i = 0; i < wia; i++) { + i64 c = wp[i]; + if (c<0) c+= xia; + if (c<0 | c>=xia) thrM("โŠ: Indexing out-of-bounds"); + r.a[i] = xget(x, c); + } + dec(w); dec(x); + return withFill(r.b,xf); } } else { + HArr_p r = m_harrUc(w); BS2B wgetU = TI(w).getU; for (usz i = 0; i < wia; i++) { B cw = wgetU(w, i); @@ -246,12 +263,12 @@ B select_c2(B t, B w, B x) { if ((usz)c >= xia) thrM("โŠ: Indexing out-of-bounds"); r.a[i] = xget(x, c); } + dec(w); dec(x); + return withFill(r.b,xf); } - dec(w); dec(x); - return withFill(r.b,xf); } else { BS2B wgetU = TI(w).getU; - ur wr = rnk(w); usz wia = a(w)->ia; + ur wr = rnk(w); ur rr = wr+xr-1; if (xr==0) thrM("โŠ: ๐•ฉ cannot be a unit"); if (rr>UR_MAX) thrM("โŠ: Result rank too large"); @@ -283,7 +300,7 @@ B select_c2(B t, B w, B x) { B rt_slash; B slash_c1(B t, B x) { - if (!isArr(x)) thrM("/: Argument must be a list"); + if (isAtm(x)) thrM("/: Argument must be a list"); if (rnk(x)!=1) thrM("/: Argument must have rank 1"); i64 s = isum(x); if(s<0) thrM("/: Argument must consist of natural numbers"); @@ -345,12 +362,12 @@ B slicev(B x, usz s, usz ia) { return r; } B take_c2(B t, B w, B x) { - if (!isArr(x) || rnk(x)!=1) thrM("โ†‘: NYI 1โ‰ =๐•ฉ"); + if (isAtm(x) || rnk(x)!=1) thrM("โ†‘: NYI 1โ‰ =๐•ฉ"); i64 v = o2i64(w); usz ia = a(x)->ia; return v<0? slicev(x, ia+v, -v) : slicev(x, 0, v); } B drop_c2(B t, B w, B x) { - if (!isArr(x) || rnk(x)!=1) thrM("โ†“: NYI 1โ‰ =๐•ฉ"); + if (isAtm(x) || rnk(x)!=1) thrM("โ†“: NYI 1โ‰ =๐•ฉ"); i64 v = o2i64(w); usz ia = a(x)->ia; return v<0? slicev(x, 0, v+ia) : slicev(x, v, ia-v); } @@ -361,8 +378,8 @@ B join_c1(B t, B x) { } B join_c2(B t, B w, B x) { B f = fill_both(w, x); - if (!isArr(w)) w = m_hunit(w); ur wr = rnk(w); usz wia = a(w)->ia; usz* wsh = a(w)->sh; - if (!isArr(x)) x = m_hunit(x); ur xr = rnk(x); usz xia = a(x)->ia; usz* xsh = a(x)->sh; + if (isAtm(w)) w = m_atomUnit(w); ur wr = rnk(w); usz wia = a(w)->ia; usz* wsh = a(w)->sh; + if (isAtm(x)) x = m_atomUnit(x); ur xr = rnk(x); usz xia = a(x)->ia; usz* xsh = a(x)->sh; ur c = wr>xr?wr:xr; if (c==0) { HArr_p r = m_harrUv(2); @@ -398,7 +415,7 @@ static void shift_check(B w, B x) { } B shiftb_c1(B t, B x) { - if (!isArr(x) || rnk(x)==0) thrM("ยป: Argument cannot be a scalar"); + if (isAtm(x) || rnk(x)==0) thrM("ยป: Argument cannot be a scalar"); usz ia = a(x)->ia; if (ia==0) return x; B xf = getFillE(inc(x)); @@ -410,8 +427,8 @@ B shiftb_c1(B t, B x) { return qWithFill(mut_fcd(r, x), xf); } B shiftb_c2(B t, B w, B x) { - if (!isArr(x) || rnk(x)==0) thrM("ยป: ๐•ฉ cannot be a scalar"); - if (!isArr(w)) w = m_hunit(w); + if (isAtm(x) || rnk(x)==0) thrM("ยป: ๐•ฉ cannot be a scalar"); + if (isAtm(w)) w = m_atomUnit(w); shift_check(w, x); B f = fill_both(w, x); usz wia = a(w)->ia; @@ -425,7 +442,7 @@ B shiftb_c2(B t, B w, B x) { } B shifta_c1(B t, B x) { - if (!isArr(x) || rnk(x)==0) thrM("ยซ: Argument cannot be a scalar"); + if (isAtm(x) || rnk(x)==0) thrM("ยซ: Argument cannot be a scalar"); usz ia = a(x)->ia; if (ia==0) return x; B xf = getFillE(inc(x)); @@ -436,8 +453,8 @@ B shifta_c1(B t, B x) { return qWithFill(mut_fcd(r, x), xf); } B shifta_c2(B t, B w, B x) { - if (!isArr(x) || rnk(x)==0) thrM("ยซ: ๐•ฉ cannot be a scalar"); - if (!isArr(w)) w = m_hunit(w); + if (isAtm(x) || rnk(x)==0) thrM("ยซ: ๐•ฉ cannot be a scalar"); + if (isAtm(w)) w = m_atomUnit(w); shift_check(w, x); B f = fill_both(w, x); usz wia = a(w)->ia; diff --git a/src/vm.c b/src/vm.c index 90d4566c..ca3e08ff 100644 --- a/src/vm.c +++ b/src/vm.c @@ -218,7 +218,7 @@ void v_set(Scope* pscs[], B s, B x, bool upd) { // doesn't consume sc->vars[(u32)s.u] = inc(x); } else { VT(s, t_harr); - if (!isArr(x) || !eqShape(s, x)) thrM("Assignment: Mismatched shape for spread assignment"); + if (isAtm(x) || !eqShape(s, x)) thrM("Assignment: Mismatched shape for spread assignment"); usz ia = a(x)->ia; B* sp = harr_ptr(s); BS2B xgetU = TI(x).getU;