From 88a97f393009fd2d9f4b873f834fd95d334def4b Mon Sep 17 00:00:00 2001 From: Juho Eerola Date: Sun, 28 Feb 2021 18:59:55 +0200 Subject: [PATCH 01/39] Conversions to c++ --- jsrc/CMakeLists.txt | 2 +- jsrc/{k.c => conversions.cpp} | 20 ++++++++++---------- 2 files changed, 11 insertions(+), 11 deletions(-) rename jsrc/{k.c => conversions.cpp} (98%) diff --git a/jsrc/CMakeLists.txt b/jsrc/CMakeLists.txt index 7c91ae9f..01260abc 100644 --- a/jsrc/CMakeLists.txt +++ b/jsrc/CMakeLists.txt @@ -91,7 +91,7 @@ target_sources(j PRIVATE io.c j.c jdlllic.c - k.c + conversions.cpp m.c parsing/p.c parsing/pv.c diff --git a/jsrc/k.c b/jsrc/conversions.cpp similarity index 98% rename from jsrc/k.c rename to jsrc/conversions.cpp index 72f90692..af40b66d 100644 --- a/jsrc/k.c +++ b/jsrc/conversions.cpp @@ -3,8 +3,10 @@ /* */ /* Conversions Amongst Internal Types */ +extern "C" { #include "j.h" #include "verbs/vcomp.h" +} #define CVCASE(a, b) (((a) << 3) + (b)) // The main cases fit in low 8 bits of mask @@ -105,7 +107,7 @@ jtBfromD(J jt, A w, void *yv, D fuzz) { static B jtIfromD(J jt, A w, void *yv, D fuzz) { D p, q, *v; - I i, k = 0, n, *x; + I i, n, *x; n = AN(w); v = DAV(w); x = (I *)yv; @@ -315,7 +317,7 @@ jtQfromD(J jt, A w, void *yv, I mode) { for (i = 0; i < n; ++i) { t = wv[i]; ASSERT(!_isnan(t), EVNAN); - if (neg = 0 > t) t = -t; + if ((neg = 0 > t)) t = -t; q.d = iv1; if (t == inf) q.n = jtvci(jt, XPINF); @@ -328,7 +330,7 @@ jtQfromD(J jt, A w, void *yv, I mode) { q.d = jtxd1(jt, d, mode); q = jtqstd(jt, q); } else { - if (recip = 1 > t) t = 1.0 / t; + if ((recip = 1 > t)) t = 1.0 / t; e = (I)(0xfff0 & *tv); e >>= 4; e -= 1023; @@ -413,7 +415,7 @@ jtXfromQ(J jt, A w, void *yv) { static B jtZfromD(J jt, A w, void *yv) { D *wv = DAV(w); - Z *zv = yv; + Z *zv = static_cast(yv); DQ(AN(w), zv++->re = *wv++;) return 1; } @@ -478,7 +480,6 @@ jtccvt(J jt, I tflagged, A w, A *y) { if (inputn > 0) { // if converting the leading values, just update the counts n = inputn; // set the counts for local use, and in the block to be converted } else { // if converting trailing values... - I offset = (n + inputn) << bplg(t); // byte offset to start of data AK(w) += (n + inputn) << bplg(wt); yv = (I *)((C *)yv + ((n + inputn) << bplg(t))); // advance input and output pointers to new area n = -inputn; // get positive # atoms to convert @@ -512,7 +513,7 @@ jtccvt(J jt, I tflagged, A w, A *y) { } switch (CVCASE(CTTZ(t), CTTZ(wt))) { case CVCASE(INTX, B01X): { - I *x = yv; + I *x = static_cast(yv); B *v = (B *)wv; DQ(n, *x++ = *v++;); } @@ -536,13 +537,13 @@ jtccvt(J jt, I tflagged, A w, A *y) { case CVCASE(RATX, INTX): GATV(d, XNUM, n, r, s); return jtXfromI(jt, w, AV(d)) && jtQfromX(jt, d, yv); case CVCASE(FLX, INTX): { D *x = (D *)yv; - I *v = wv; + I *v = static_cast(wv); DQ(n, *x++ = (D)*v++;); } return 1; case CVCASE(CMPXX, INTX): { Z *x = (Z *)yv; - I *v = wv; + I *v = static_cast(wv); DQ(n, x++->re = (D)*v++;); } return 1; @@ -710,8 +711,7 @@ jtxco1(J jt, A w) { A jtxco2(J jt, A a, A w) { A z; - B b; - I j, n, r, *s, t, *wv, *zu, *zv; + I j, n, r, t; n = AN(w); r = AR(w); t = AT(w); From 2ef23027827e603363633d0cf93ef80dfdf01372 Mon Sep 17 00:00:00 2001 From: Juho Eerola Date: Sat, 6 Mar 2021 18:44:11 +0200 Subject: [PATCH 02/39] Add templated functions for simple conversions --- jsrc/conversions.cpp | 78 ++++++++++++++++++-------------------------- 1 file changed, 31 insertions(+), 47 deletions(-) diff --git a/jsrc/conversions.cpp b/jsrc/conversions.cpp index af40b66d..b45cd466 100644 --- a/jsrc/conversions.cpp +++ b/jsrc/conversions.cpp @@ -3,8 +3,10 @@ /* */ /* Conversions Amongst Internal Types */ +#include + +#include "array.hpp" extern "C" { -#include "j.h" #include "verbs/vcomp.h" } @@ -26,13 +28,19 @@ jtC1fromC2(J jt, A w, void *yv) { return 1; } -static B -jtC2fromC1(J jt, A w, void *yv) { - UC *v; - US *x; - v = UAV(w); - x = (US *)yv; - DQ(AN(w), *x++ = *v++;); +template +[[nodiscard]] static auto +convert(J jt, array w, void *yv) -> bool { + From *v = reinterpret_cast(UAV(w)); + std::copy(v, v + AN(w), static_cast(yv)); + return 1; +} + +template +[[nodiscard]] static auto +convert(J jt, array w, void *yv, Transform t) -> bool { + From *v = reinterpret_cast(UAV(w)); + std::transform(v, v + AN(w), static_cast(yv), t); return 1; } @@ -56,26 +64,6 @@ jtC2fromC4(J jt, A w, void *yv) { return 1; } -static B -jtC4fromC1(J jt, A w, void *yv) { - UC *v; - C4 *x; - v = UAV(w); - x = (C4 *)yv; - DQ(AN(w), *x++ = *v++;); - return 1; -} - -static B -jtC4fromC2(J jt, A w, void *yv) { - US *v; - C4 *x; - v = USAV(w); - x = (C4 *)yv; - DQ(AN(w), *x++ = *v++;); - return 1; -} - static B jtBfromI(J jt, A w, void *yv) { B *x; @@ -155,14 +143,14 @@ jtDfromZ(J jt, A w, void *yv, D fuzz) { static B jtXfromB(J jt, A w, void *yv) { - B *v; - I n, u[1]; - X *x; - n = AN(w); - v = BAV(w); - x = (X *)yv; - DO(n, *u = v[i]; x[i] = jtvec(jt, INT, 1L, u);); - return !jt->jerr; + return convert(jt, + w, + yv, + [=](auto v) { + int64_t u[] = {v}; + return jtvec(jt, INT, 1L, u); + }) && + !jt->jerr; } static B @@ -230,10 +218,7 @@ jtxd1(J jt, D p, I mode) { static B jtXfromD(J jt, A w, void *yv, I mode) { - D *v = DAV(w); - X *x = (X *)yv; - DO(AN(w), x[i] = jtxd1(jt, v[i], mode);); - return !jt->jerr; + return convert(jt, w, yv, [=](auto v){ return jtxd1(jt, v, mode); }) && !jt->jerr; } static B @@ -297,9 +282,7 @@ jtDfromX(J jt, A w, void *yv) { static B jtQfromX(J jt, A w, void *yv) { - X *v = XAV(w), *x = (X *)yv; - DQ(AN(w), *x++ = *v++; *x++ = iv1;); - return 1; + return convert(jt, w, yv, [](auto v) -> Q { return {v, iv1}; }); } static B @@ -416,7 +399,8 @@ static B jtZfromD(J jt, A w, void *yv) { D *wv = DAV(w); Z *zv = static_cast(yv); - DQ(AN(w), zv++->re = *wv++;) return 1; + DQ(AN(w), zv++->re = *wv++;); + return 1; } // Convert the data in w to the type t. w and t must be noun types. A new buffer is always created (with a @@ -504,10 +488,10 @@ jtccvt(J jt, I tflagged, A w, A *y) { switch (CVCASE(CTTZ(t), CTTZ(wt))) { case CVCASE(LITX, C2TX): return jtC1fromC2(jt, w, yv); case CVCASE(LITX, C4TX): return jtC1fromC4(jt, w, yv); - case CVCASE(C2TX, LITX): return jtC2fromC1(jt, w, yv); + case CVCASE(C2TX, LITX): return convert(jt, w, yv); case CVCASE(C2TX, C4TX): return jtC2fromC4(jt, w, yv); - case CVCASE(C4TX, LITX): return jtC4fromC1(jt, w, yv); - case CVCASE(C4TX, C2TX): return jtC4fromC2(jt, w, yv); + case CVCASE(C4TX, LITX): return convert(jt, w, yv); + case CVCASE(C4TX, C2TX): return convert(jt, w, yv); default: ASSERT(0, EVDOMAIN); } } From 223413faf88954bd2376ec1f938e0cd16589ee5e Mon Sep 17 00:00:00 2001 From: Juho Eerola Date: Sat, 6 Mar 2021 18:46:03 +0200 Subject: [PATCH 03/39] Remove tautologically true #ifdef --- jsrc/conversions.cpp | 2 -- 1 file changed, 2 deletions(-) diff --git a/jsrc/conversions.cpp b/jsrc/conversions.cpp index b45cd466..68274d78 100644 --- a/jsrc/conversions.cpp +++ b/jsrc/conversions.cpp @@ -600,7 +600,6 @@ jtbcvt(J jt, C mode, A w) { FPREFIP; A y, z = w; if (!w) return 0; -#ifdef NANFLAG // there may be values (especially b types) that were nominally CMPX but might actually be integers. Those were // stored with the real part being the actual integer value and the imaginary part as the special 'flag' value. We // handle those here. If all the imaginary parts were flags, we accept all the integer parts and change the type @@ -629,7 +628,6 @@ jtbcvt(J jt, C mode, A w) { w = z; // this result is now eligible for further demotion } } -#endif // for all numerics, try Boolean/int/float in order, stopping when we find one that holds the data if (mode & 1 || !(AT(w) & XNUM + RAT)) { // if we are not stopping at XNUM/RAT // To avoid a needless copy, suppress conversion to B01 if type is B01, to INT if type is INT, etc From 7558baf6484d46563f238e3e61ea95a6d6fcb08f Mon Sep 17 00:00:00 2001 From: Juho Eerola Date: Sat, 6 Mar 2021 19:51:49 +0200 Subject: [PATCH 04/39] Add range check to `convert()` --- jsrc/conversions.cpp | 96 ++++++++++++++------------------------------ 1 file changed, 31 insertions(+), 65 deletions(-) diff --git a/jsrc/conversions.cpp b/jsrc/conversions.cpp index 68274d78..0dd8a51f 100644 --- a/jsrc/conversions.cpp +++ b/jsrc/conversions.cpp @@ -18,21 +18,28 @@ extern "C" { fuzz * \ ABS(v)) // used when v is known to be exact integer. It's close enough, maybe ULP too small on the high end -static B -jtC1fromC2(J jt, A w, void *yv) { - UC *x; - US c, *v; - v = USAV(w); - x = (C *)yv; - DQ(AN(w), c = *v++; if (!(256 > c)) return 0; *x++ = (UC)c;); - return 1; +template +[[nodiscard]] static constexpr auto +in_range(V value) -> bool { + return std::numeric_limits::min() <= value && value <= std::numeric_limits::max(); +} + +template +[[nodiscard]] static constexpr auto +in_range() -> bool { + return in_range(std::numeric_limits::min()) && in_range(std::numeric_limits::max()); } template [[nodiscard]] static auto convert(J jt, array w, void *yv) -> bool { - From *v = reinterpret_cast(UAV(w)); - std::copy(v, v + AN(w), static_cast(yv)); + From *v = reinterpret_cast(UAV(w)); + if constexpr (!in_range()) { + // TODO: replace with short circuiting solution + auto out = static_cast(yv); + return out + AN(w) == std::copy_if(v, v + AN(w), out, [](auto v) { return in_range(v); }); + } + std::copy(v, v + AN(w), static_cast(yv)); return 1; } @@ -44,37 +51,6 @@ convert(J jt, array w, void *yv, Transform t) -> bool { return 1; } -static B -jtC1fromC4(J jt, A w, void *yv) { - UC *x; - C4 c, *v; - v = C4AV(w); - x = (C *)yv; - DQ(AN(w), c = *v++; if (!(256 > c)) return 0; *x++ = (UC)c;); - return 1; -} - -static B -jtC2fromC4(J jt, A w, void *yv) { - US *x; - C4 c, *v; - v = C4AV(w); - x = (US *)yv; - DQ(AN(w), c = *v++; if (!(65536 > c)) return 0; *x++ = (US)c;); - return 1; -} - -static B -jtBfromI(J jt, A w, void *yv) { - B *x; - I n, p, *v; - n = AN(w); - v = AV(w); - x = (B *)yv; - DQ(n, p = *v++; *x++ = (B)p; if (p & -2) return 0;); - return 1; -} - static B jtBfromD(J jt, A w, void *yv, D fuzz) { B *x; @@ -451,7 +427,6 @@ jtccvt(J jt, I tflagged, A w, A *y) { RZ(*y = jtca(jt, w)); return 1; } - // else if(n&&t&JCHAR){ASSERT(HOMO(t,wt),EVDOMAIN); RZ(*y=jtuco1(jt,w)); return 1;} // Kludge on behalf of result assembly: we want to be able to stop converting after the valid cells. If // NOUNCVTVALIDCT is set in the type, we use the input *y as as override on the # cells to convert. We use it to // replace n (for use here) and yv, and AK(w) and AN(w) for the subroutines. If NOUNCVTVALIDCT is set, w is @@ -480,35 +455,29 @@ jtccvt(J jt, I tflagged, A w, A *y) { // Perform the conversion based on data types // For branch-table efficiency, we split the C2T and C4T and BIT conversions into one block, and // the rest in another - if ((t | wt) & - (C2T + C4T + BIT + SBT)) { // there are no SBT conversions, but we have to show domain error - // we must account for all NOUN types. Low 8 bits have most of them, and we know type can't be sparse. This - // picks up the others + if ((t | wt) & (C2T + C4T + BIT + SBT)) { + // there are no SBT conversions, but we have to show domain error we + // must account for all NOUN types. Low 8 bits have most of them, and + // we know type can't be sparse. This picks up the others ASSERT(!((t | wt) & SBT), EVDOMAIN); // No conversions for these types switch (CVCASE(CTTZ(t), CTTZ(wt))) { - case CVCASE(LITX, C2TX): return jtC1fromC2(jt, w, yv); - case CVCASE(LITX, C4TX): return jtC1fromC4(jt, w, yv); + case CVCASE(LITX, C2TX): return convert(jt, w, yv); + case CVCASE(LITX, C4TX): return convert(jt, w, yv); case CVCASE(C2TX, LITX): return convert(jt, w, yv); - case CVCASE(C2TX, C4TX): return jtC2fromC4(jt, w, yv); + case CVCASE(C2TX, C4TX): return convert(jt, w, yv); case CVCASE(C4TX, LITX): return convert(jt, w, yv); case CVCASE(C4TX, C2TX): return convert(jt, w, yv); default: ASSERT(0, EVDOMAIN); } } switch (CVCASE(CTTZ(t), CTTZ(wt))) { - case CVCASE(INTX, B01X): { - I *x = static_cast(yv); - B *v = (B *)wv; - DQ(n, *x++ = *v++;); - } + case CVCASE(INTX, B01X): + std::copy_n(static_cast(wv), n, static_cast(yv)); return 1; case CVCASE(XNUMX, B01X): return jtXfromB(jt, w, yv); case CVCASE(RATX, B01X): GATV(d, XNUM, n, r, s); return jtXfromB(jt, w, AV(d)) && jtQfromX(jt, d, yv); - case CVCASE(FLX, B01X): { - D *x = (D *)yv; - B *v = (B *)wv; - DQ(n, *x++ = *v++;); - } + case CVCASE(FLX, B01X): + std::copy_n(static_cast(wv), n, static_cast(yv)); return 1; case CVCASE(CMPXX, B01X): { Z *x = (Z *)yv; @@ -516,14 +485,11 @@ jtccvt(J jt, I tflagged, A w, A *y) { DQ(n, x++->re = *v++;); } return 1; - case CVCASE(B01X, INTX): return jtBfromI(jt, w, yv); + case CVCASE(B01X, INTX): return convert(jt, w, yv); case CVCASE(XNUMX, INTX): return jtXfromI(jt, w, yv); case CVCASE(RATX, INTX): GATV(d, XNUM, n, r, s); return jtXfromI(jt, w, AV(d)) && jtQfromX(jt, d, yv); - case CVCASE(FLX, INTX): { - D *x = (D *)yv; - I *v = static_cast(wv); - DQ(n, *x++ = (D)*v++;); - } + case CVCASE(FLX, INTX): + std::copy_n(static_cast(wv), n, static_cast(yv)); return 1; case CVCASE(CMPXX, INTX): { Z *x = (Z *)yv; From d3187f73fa219f65e3ad12449c59429723ba7d2c Mon Sep 17 00:00:00 2001 From: Juho Eerola Date: Sat, 6 Mar 2021 22:32:29 +0200 Subject: [PATCH 05/39] Refactor `jtDfromX()` --- jsrc/conversions.cpp | 31 ++++++++++--------------------- 1 file changed, 10 insertions(+), 21 deletions(-) diff --git a/jsrc/conversions.cpp b/jsrc/conversions.cpp index 0dd8a51f..a3cd3263 100644 --- a/jsrc/conversions.cpp +++ b/jsrc/conversions.cpp @@ -4,6 +4,8 @@ /* Conversions Amongst Internal Types */ #include +#include +#include #include "array.hpp" extern "C" { @@ -232,27 +234,14 @@ jtIfromX(J jt, A w, void *yv) { static B jtDfromX(J jt, A w, void *yv) { - D d, *x = (D *)yv /*,dm,dp*/; - I c, i, n, *v, wn; - X p, *wv; - // dp=1.7976931348623157e308; dm=-dp; - wn = AN(w); - wv = XAV(w); - for (i = 0; i < wn; ++i) { - p = wv[i]; - n = AN(p); - v = AV(p) + n - 1; - c = *v; - if (c == XPINF) - d = inf; - else if (c == XNINF) - d = infm; - else { - d = 0.0; - DQ(n, d = *v-- + d * XBASE;); - } - x[i] = d; - } + auto const wv = XAV(w); + std::transform(wv, wv + AN(w), static_cast(yv), [](auto p) { + auto const n = AN(p); + auto const v = std::reverse_iterator(AV(p) + n); + if (*v == XPINF) return inf; + if (*v == XNINF) return infm; + return std::accumulate(v, v + n, 0.0, [](auto d, auto v) { return v + d * XBASE; }); + }); return 1; } From f8d612b139016ce73b71b1f59910fcd73d475d9e Mon Sep 17 00:00:00 2001 From: Juho Eerola Date: Sat, 6 Mar 2021 23:12:17 +0200 Subject: [PATCH 06/39] Const refactor `jtDfromQ()` --- jsrc/conversions.cpp | 69 ++++++++++++++++++++++---------------------- 1 file changed, 34 insertions(+), 35 deletions(-) diff --git a/jsrc/conversions.cpp b/jsrc/conversions.cpp index a3cd3263..6991b7db 100644 --- a/jsrc/conversions.cpp +++ b/jsrc/conversions.cpp @@ -301,49 +301,48 @@ jtQfromD(J jt, A w, void *yv, I mode) { static B jtDfromQ(J jt, A w, void *yv) { - D d, f, n, *x, xb = (D)XBASE; - I cn, i, k, m, nn, pn, qn, r, *v, wn; - Q *wv; - X c, p, q, x2 = 0; - wn = AN(w); - wv = QAV(w); - x = (D *)yv; - nn = 308 / XBASEN; - for (i = 0; i < wn; ++i) { - p = wv[i].n; - pn = AN(p); - k = 1 == pn ? AV(p)[0] : 0; - q = wv[i].d; - qn = AN(q); + auto const xb = (D)XBASE; + auto const wn = AN(w); + auto const wv = QAV(w); + auto const x = (D *)yv; + auto const nn = 308 / XBASEN; + + // TODO: figure out nice algorithm for this + auto const add_digits = [&](auto n, auto v) { + auto f = 1.0; + auto d = 0.0; + DO(n, d += f * v[i]; f *= xb;); + return d; + }; + + X x2 = 0; + for (int64_t i = 0; i < wn; ++i) { + auto const p = wv[i].n; + auto const pn = AN(p); + auto const k = 1 == pn ? AV(p)[0] : 0; + auto const q = wv[i].d; + auto const qn = AN(q); if (k == XPINF) x[i] = inf; else if (k == XNINF) x[i] = infm; else if (pn <= nn && qn <= nn) { - n = 0.0; - f = 1.0; - v = AV(p); - DO(pn, n += f * v[i]; f *= xb;); - d = 0.0; - f = 1.0; - v = AV(q); - DO(qn, d += f * v[i]; f *= xb;); - x[i] = n / d; + auto const n = add_digits(pn, AV(p)); + auto const d = add_digits(qn, AV(q)); + x[i] = n / d; } else { - k = 5 + qn; if (!x2) if (!(x2 = jtxc(jt, 2L))) return 0; - if (!(c = jtxdiv(jt, jttake(jt, jtsc(jt, -(k + pn)), p), q, XMFLR))) return 0; - cn = AN(c); - m = MIN(cn, 5); - r = cn - (m + k); - v = AV(c) + cn - m; - n = 0.0; - f = 1.0; - DO(m, n += f * v[i]; f *= xb;); - d = 1.0; - DQ(ABS(r), d *= xb;); - x[i] = 0 > r ? n / d : n * d; + auto const k = 5 + qn; + auto c = jtxdiv(jt, jttake(jt, jtsc(jt, -(k + pn)), p), q, XMFLR); + if (!c) return 0; + auto const cn = AN(c); + auto const m = MIN(cn, 5); + auto const r = cn - (m + k); + auto const v = AV(c) + cn - m; + auto const n = add_digits(m, v); + auto d = std::pow(xb, std::abs(r)); + x[i] = 0 > r ? n / d : n * d; } } return 1; From d308fbf137e814934fd4448757316bd5e0201ad9 Mon Sep 17 00:00:00 2001 From: Juho Eerola Date: Sat, 6 Mar 2021 23:43:54 +0200 Subject: [PATCH 07/39] Refactor `jtXfromI()` --- jsrc/conversions.cpp | 31 +++++++++++++++---------------- 1 file changed, 15 insertions(+), 16 deletions(-) diff --git a/jsrc/conversions.cpp b/jsrc/conversions.cpp index 6991b7db..3295cd29 100644 --- a/jsrc/conversions.cpp +++ b/jsrc/conversions.cpp @@ -133,23 +133,22 @@ jtXfromB(J jt, A w, void *yv) { static B jtXfromI(J jt, A w, void *yv) { - B b; - I c, d, i, j, n, r, u[XIDIG], *v; - X *x; - n = AN(w); - v = AV(w); - x = (X *)yv; - for (i = 0; i < n; ++i) { - c = v[i]; - b = c == IMIN; - d = b ? -(1 + c) : ABS(c); - j = 0; - DO(XIDIG, u[i] = r = d % XBASE; d = d / XBASE; if (r) j = i;); - ++j; + I u[XIDIG]; + auto const v = AV(w); + std::transform(v, v + AN(w), static_cast(yv), [&](auto c) { + auto const b = c == IMIN; + auto d = b ? -(1 + c) : std::abs(c); + int64_t length = 0; + for (int64_t i = 0; i < XIDIG; ++i) { + u[i] = d % XBASE; + d = d / XBASE; + if (u[i]) length = i; + } + ++length; *u += b; - if (0 > c) DO(XIDIG, u[i] = -u[i];); - x[i] = jtvec(jt, INT, j, u); - } + if (0 > c) std::transform(u, u + XIDIG, u, [](auto v) { return -v; }); + return jtvec(jt, INT, length, u); + }); return !jt->jerr; } From bd251961b6b4682726099365f897a8b4cd5ead49 Mon Sep 17 00:00:00 2001 From: Juho Eerola Date: Sun, 7 Mar 2021 00:20:34 +0200 Subject: [PATCH 08/39] Extract couple helper functions --- jsrc/conversions.cpp | 36 +++++++++++++++++++++++------------- 1 file changed, 23 insertions(+), 13 deletions(-) diff --git a/jsrc/conversions.cpp b/jsrc/conversions.cpp index 3295cd29..ce61ed0a 100644 --- a/jsrc/conversions.cpp +++ b/jsrc/conversions.cpp @@ -131,6 +131,12 @@ jtXfromB(J jt, A w, void *yv) { !jt->jerr; } +template +static auto +inplace_negate(T& u, int64_t n) { + std::transform(u, u + n, u, [](auto v) { return -v; }); +} + static B jtXfromI(J jt, A w, void *yv) { I u[XIDIG]; @@ -146,7 +152,7 @@ jtXfromI(J jt, A w, void *yv) { } ++length; *u += b; - if (0 > c) std::transform(u, u + XIDIG, u, [](auto v) { return -v; }); + if (0 > c) inplace_negate(u, XIDIG); return jtvec(jt, INT, length, u); }); return !jt->jerr; @@ -187,8 +193,9 @@ jtxd1(J jt, D p, I mode) { if (!m) { u[0] = 0; ++m; - } else if (0 > p) - DO(m, u[i] = -u[i];); + } else if (0 > p) { + inplace_negate(u, m); + } A z = jtxstd(jt, jtvec(jt, INT, m, u)); EPILOG(z); } @@ -210,6 +217,14 @@ jtBfromX(J jt, A w, void *yv) { return 1; } +template +[[nodiscard]] static auto +value_from_X(X p) -> T { + auto const n = AN(p); + auto const v = std::reverse_iterator(AV(p) + n); + return std::accumulate(v, v + n, T{}, [](auto d, auto v) { return v + d * XBASE; }); +} + static B jtIfromX(J jt, A w, void *yv) { I a, i, m, n, *u, *x; @@ -222,11 +237,7 @@ jtIfromX(J jt, A w, void *yv) { for (i = 0; i < n; ++i) { c = v[i]; if (!(1 != jtxcompare(jt, q, c) && 1 != jtxcompare(jt, c, p))) return 0; - m = AN(c); - u = AV(c) + m - 1; - a = 0; - DO(m, a = *u-- + a * XBASE;); - x[i] = a; + x[i] = value_from_X(c); } return 1; } @@ -235,11 +246,10 @@ static B jtDfromX(J jt, A w, void *yv) { auto const wv = XAV(w); std::transform(wv, wv + AN(w), static_cast(yv), [](auto p) { - auto const n = AN(p); - auto const v = std::reverse_iterator(AV(p) + n); - if (*v == XPINF) return inf; - if (*v == XNINF) return infm; - return std::accumulate(v, v + n, 0.0, [](auto d, auto v) { return v + d * XBASE; }); + auto const c = AV(p)[AN(p)-1]; + if (c == XPINF) return inf; + if (c == XNINF) return infm; + return value_from_X(p); }); return 1; } From 12fc5b9910c600bd192b1ab6cc2c0aacc8c1c4f9 Mon Sep 17 00:00:00 2001 From: Juho Eerola Date: Sun, 7 Mar 2021 00:47:49 +0200 Subject: [PATCH 09/39] Refactor couple transforms --- jsrc/conversions.cpp | 40 ++++++++++++++++++++-------------------- 1 file changed, 20 insertions(+), 20 deletions(-) diff --git a/jsrc/conversions.cpp b/jsrc/conversions.cpp index ce61ed0a..c1e3d926 100644 --- a/jsrc/conversions.cpp +++ b/jsrc/conversions.cpp @@ -561,48 +561,48 @@ jtcvt(J jt, I t, A w) { A jtbcvt(J jt, C mode, A w) { FPREFIP; - A y, z = w; if (!w) return 0; + + auto const as_integer = [](auto const &v) { return *(I *)&v; }; + auto const isflag = [&](auto const &z) { return as_integer(z.im) == NANFLAG; }; + // there may be values (especially b types) that were nominally CMPX but might actually be integers. Those were // stored with the real part being the actual integer value and the imaginary part as the special 'flag' value. We // handle those here. If all the imaginary parts were flags, we accept all the integer parts and change the type // to integer. If none of the imaginary parts were flags, we leave the input unchanged. If some were flags, we // convert the flagged values to float and keep the result as complex + array result = w; if ((((AN(w) - 1) | (AT(w) & CMPX) - 1)) >= 0) { // not empty AND complex - I allflag = 1, anyflag = 0; - Z *wv = ZAV(w); - DO(AN(w), I isflag = *(I *)&wv[i].im == NANFLAG; allflag &= isflag; anyflag |= isflag;) - if (anyflag) { + Z *wv = ZAV(w); + auto flags = std::transform_reduce(wv, wv + AN(w), int64_t{}, std::plus{}, isflag); + if (flags) { I ipok = SGNIF(jtinplace, JTINPLACEWX) & AC(w); // both sign bits set (<0) if inplaceable - if (allflag) { - if (ipok >= 0) GATV(z, INT, AN(w), AR(w), AS(w)); - I *zv = IAV(z); // output area - DO(AN(w), zv[i] = *(I *)&wv[i].re;) // copy the results as integers + if (flags == AN(w)) { + if (ipok >= 0) GATV(result, INT, AN(w), AR(w), AS(w)); + std::transform(wv, wv + AN(w), IAV(result), [&](auto const &z) { return as_integer(z.re); }); } else { - if (ipok >= 0) GATV(z, CMPX, AN(w), AR(w), AS(w)); - Z *zv = ZAV(z); // output area - DO( - AN(w), - if (*(I *)&wv[i].im == NANFLAG) { - zv[i].re = (D) * (I *)&wv[i].re; - zv[i].im = 0.0; - } else { zv[i] = wv[i]; }) // copy floats, and converts any integers back to float + if (ipok >= 0) GATV(result, CMPX, AN(w), AR(w), AS(w)); + std::transform(wv, wv + AN(w), ZAV(result), [&](auto const &z) -> Z { + if (isflag(z)) return {.re = (D)as_integer(z.re), .im = 0.0}; + return z; // copy floats, and converts any integers back to float + }); } - w = z; // this result is now eligible for further demotion + w = result; // this result is now eligible for further demotion } } // for all numerics, try Boolean/int/float in order, stopping when we find one that holds the data if (mode & 1 || !(AT(w) & XNUM + RAT)) { // if we are not stopping at XNUM/RAT // To avoid a needless copy, suppress conversion to B01 if type is B01, to INT if type is INT, etc // set the NOFUZZ flag in jt to insist on an exact match so we won't lose precision + array y; jtinplace = (J)((I)jt + JTNOFUZZ); // demand exact match - z = !(mode & 14) && jtccvt(jtinplace, B01, w, &y) ? y + result = !(mode & 14) && jtccvt(jtinplace, B01, w, &y) ? y : (y = w, AT(w) & INT || (!(mode & 12) && jtccvt(jtinplace, INT, w, &y))) ? y : (y = w, AT(w) & FL || (!(mode & 8) && jtccvt(jtinplace, FL, w, &y))) ? y : w; // convert to enabled modes one by one, stopping when one works } - RNE(z); + RNE(result); } /* convert to lowest type. 0=mode: don't convert XNUM/RAT to other types */ A From 7372afb5f8c9cbc28c3485bc695eb482c20ee44a Mon Sep 17 00:00:00 2001 From: Juho Eerola Date: Sun, 7 Mar 2021 01:15:55 +0200 Subject: [PATCH 10/39] Remove some decl-init split --- jsrc/conversions.cpp | 130 ++++++++++++++++++------------------------- 1 file changed, 55 insertions(+), 75 deletions(-) diff --git a/jsrc/conversions.cpp b/jsrc/conversions.cpp index c1e3d926..19188b17 100644 --- a/jsrc/conversions.cpp +++ b/jsrc/conversions.cpp @@ -55,13 +55,10 @@ convert(J jt, array w, void *yv, Transform t) -> bool { static B jtBfromD(J jt, A w, void *yv, D fuzz) { - B *x; - D p, *v; - I n; - n = AN(w); - v = DAV(w); - x = (B *)yv; - DQ(n, p = *v++; if (p < -2 || 2 < p) return 0; // handle infinities + auto n = AN(w); + auto v = DAV(w); + auto x = (B *)yv; + DQ(n, auto p = *v++; if (p < -2 || 2 < p) return 0; // handle infinities I val = 2; val = (p == 0) ? 0 : val; val = FIEQ(p, 1.0, fuzz) ? 1 : val; @@ -72,15 +69,13 @@ jtBfromD(J jt, A w, void *yv, D fuzz) { static B jtIfromD(J jt, A w, void *yv, D fuzz) { - D p, q, *v; - I i, n, *x; - n = AN(w); - v = DAV(w); - x = (I *)yv; - for (i = 0; i < n; ++i) { - p = v[i]; - q = jround(p); - I rq = (I)q; + auto n = AN(w); + auto v = DAV(w); + auto x = (I *)yv; + for (int64_t i = 0; i < n; ++i) { + auto const p = v[i]; + auto const q = jround(p); + I rq = (I)q; if (!(p == q || FIEQ(p, q, fuzz))) return 0; // must equal int, possibly out of range // out-of-range values don't convert, handle separately if (p < (D)IMIN) { @@ -98,21 +93,18 @@ jtIfromD(J jt, A w, void *yv, D fuzz) { static B jtDfromZ(J jt, A w, void *yv, D fuzz) { - D d, *x; - I n; - Z *v; - n = AN(w); - v = ZAV(w); - x = (D *)yv; + auto const n = AN(w); + auto const *v = ZAV(w); + auto x = (D *)yv; if (fuzz) DQ( - n, d = ABS(v->im); if (d != inf && d <= fuzz * ABS(v->re)) { + n, auto d = std::abs(v->im); if (d != inf && d <= fuzz * std::abs(v->re)) { *x++ = v->re; v++; } else return 0;) else DQ( - n, d = v->im; if (!d) { + n, if (!v->im) { *x++ = v->re; v++; } else return 0;); @@ -161,9 +153,7 @@ jtXfromI(J jt, A w, void *yv) { static X jtxd1(J jt, D p, I mode) { PROLOG(0052); - A t; - D d, e = jttfloor(jt, p), q, r; - I m, *u; + D e = jttfloor(jt, p); switch (mode) { case XMFLR: p = e; break; case XMCEIL: p = ceil(p); break; @@ -176,15 +166,16 @@ jtxd1(J jt, D p, I mode) { } if (p == inf) return jtvci(jt, XPINF); if (p == -inf) return jtvci(jt, XNINF); + A t; GAT0(t, INT, 30, 1); - u = AV(t); - m = 0; - d = ABS(p); + auto u = AV(t); + int64_t m = 0; + auto d = std::abs(p); while (0 < d) { - q = floor(d / XBASE); - r = d - q * XBASE; - u[m++] = (I)r; - d = q; + auto const q = floor(d / XBASE); + auto const r = d - q * XBASE; + u[m++] = (I)r; + d = q; if (m == AN(t)) { RZ(t = jtext(jt, 0, t)); u = AV(t); @@ -207,13 +198,9 @@ jtXfromD(J jt, A w, void *yv, I mode) { static B jtBfromX(J jt, A w, void *yv) { - A q; - B *x; - I e; - X *v; - v = XAV(w); - x = (B *)yv; - DO(AN(w), q = v[i]; e = AV(q)[0]; if ((AN(q) ^ 1) | (e & -2)) return 0; x[i] = (B)e;); + auto v = XAV(w); + auto x = (B *)yv; + DO(AN(w), A q = v[i]; I e = AV(q)[0]; if ((AN(q) ^ 1) | (e & -2)) return 0; x[i] = (B)e;); return 1; } @@ -227,15 +214,14 @@ value_from_X(X p) -> T { static B jtIfromX(J jt, A w, void *yv) { - I a, i, m, n, *u, *x; - X c, p, q, *v; - v = XAV(w); - x = (I *)yv; - n = AN(w); + auto v = XAV(w); + auto x = (I *)yv; + auto n = AN(w); + X p, q; if (!(p = jtxc(jt, IMAX))) return 0; if (!(q = jtxminus(jt, jtnegate(jt, p), jtxc(jt, 1L)))) return 0; - for (i = 0; i < n; ++i) { - c = v[i]; + for (int64_t i = 0; i < n; ++i) { + auto c = v[i]; if (!(1 != jtxcompare(jt, q, c) && 1 != jtxcompare(jt, c, p))) return 0; x[i] = value_from_X(c); } @@ -359,10 +345,8 @@ jtDfromQ(J jt, A w, void *yv) { static B jtXfromQ(J jt, A w, void *yv) { - Q *v; - X *x; - v = QAV(w); - x = (X *)yv; + auto v = QAV(w); + auto x = (X *)yv; DQ(AN(w), if (!(jtequ(jt, iv1, v->d))) return 0; *x++ = v->n; ++v;); return !jt->jerr; } @@ -548,9 +532,8 @@ jtccvt(J jt, I tflagged, A w, A *y) { A jtcvt(J jt, I t, A w) { A y; - B b; - b = jtccvt(jt, t, w, &y); - ASSERT(b != 0, EVDOMAIN); + bool const b = jtccvt(jt, t, w, &y); + ASSERT(b, EVDOMAIN); return y; } @@ -635,14 +618,11 @@ jtpcvt(J jt, I t, A w) { A jtcvt0(J jt, A w) { - I n, t; - D *u; - t = AT(w); - n = AN(w); + auto const t = AT(w); + auto const n = (t & CMPX) ? 2 * AN(w) : AN(w); if (n && t & FL + CMPX) { - if (t & CMPX) n += n; - u = DAV(w); - DQ(n, if (*u == 0.0) *u = 0.0; ++u;); + auto u = DAV(w); + std::transform(u, u + n, u, [](auto v) { return v == 0.0 ? 0.0 : v; }); } return w; } /* convert -0 to 0 in place */ @@ -655,24 +635,24 @@ jtxco1(J jt, A w) { A jtxco2(J jt, A a, A w) { - A z; - I j, n, r, t; - n = AN(w); - r = AR(w); - t = AT(w); - ASSERT(t & DENSE, EVNONCE); + ASSERT(AT(w) & DENSE, EVNONCE); + I j; RE(j = jti0(jt, a)); switch (j) { case -2: return jtaslash1(jt, CDIV, w); case -1: return jtbcvt(jt, 1, w); case 1: return jtxco1(jt, w); case 2: - if (!(t & RAT)) RZ(w = jtcvt(jt, RAT, w)); - GATV(z, XNUM, 2 * n, r + 1, AS(w)); - AS(z)[r] = 2; - memcpy(AV(z), AV(w), 2 * n * SZI); - return z; - default: - ASSERT(0, EVDOMAIN); + if (!(AT(w) & RAT)) RZ(w = jtcvt(jt, RAT, w)); + { + auto const n = AN(w); + auto const r = AR(w); + A z; + GATV(z, XNUM, 2 * n, r + 1, AS(w)); + AS(z)[r] = 2; + memcpy(AV(z), AV(w), 2 * n * SZI); + return z; + } + default: ASSERT(0, EVDOMAIN); } } From 463b02fdc4295d8d197d60904bddecead6d40346 Mon Sep 17 00:00:00 2001 From: Juho Eerola Date: Sun, 7 Mar 2021 01:34:22 +0200 Subject: [PATCH 11/39] Add specialisations for `convert()` --- jsrc/conversions.cpp | 142 ++++++++++++++++++++++++------------------- 1 file changed, 78 insertions(+), 64 deletions(-) diff --git a/jsrc/conversions.cpp b/jsrc/conversions.cpp index 19188b17..e4313548 100644 --- a/jsrc/conversions.cpp +++ b/jsrc/conversions.cpp @@ -21,19 +21,19 @@ extern "C" { ABS(v)) // used when v is known to be exact integer. It's close enough, maybe ULP too small on the high end template -[[nodiscard]] static constexpr auto +[[nodiscard]] constexpr auto in_range(V value) -> bool { return std::numeric_limits::min() <= value && value <= std::numeric_limits::max(); } template -[[nodiscard]] static constexpr auto +[[nodiscard]] constexpr auto in_range() -> bool { return in_range(std::numeric_limits::min()) && in_range(std::numeric_limits::max()); } template -[[nodiscard]] static auto +[[nodiscard]] auto convert(J jt, array w, void *yv) -> bool { From *v = reinterpret_cast(UAV(w)); if constexpr (!in_range()) { @@ -46,15 +46,16 @@ convert(J jt, array w, void *yv) -> bool { } template -[[nodiscard]] static auto +[[nodiscard]] auto convert(J jt, array w, void *yv, Transform t) -> bool { From *v = reinterpret_cast(UAV(w)); std::transform(v, v + AN(w), static_cast(yv), t); return 1; } -static B -jtBfromD(J jt, A w, void *yv, D fuzz) { +template <> +[[nodiscard]] auto +convert(J jt, A w, void *yv, D fuzz) -> bool { auto n = AN(w); auto v = DAV(w); auto x = (B *)yv; @@ -67,8 +68,9 @@ jtBfromD(J jt, A w, void *yv, D fuzz) { return 1; } -static B -jtIfromD(J jt, A w, void *yv, D fuzz) { +template <> +[[nodiscard]] auto +convert(J jt, A w, void *yv, D fuzz) -> bool { auto n = AN(w); auto v = DAV(w); auto x = (I *)yv; @@ -91,8 +93,9 @@ jtIfromD(J jt, A w, void *yv, D fuzz) { return 1; } -static B -jtDfromZ(J jt, A w, void *yv, D fuzz) { +template <> +[[nodiscard]] auto +convert(J jt, A w, void *yv, D fuzz) -> bool { auto const n = AN(w); auto const *v = ZAV(w); auto x = (D *)yv; @@ -111,8 +114,9 @@ jtDfromZ(J jt, A w, void *yv, D fuzz) { return 1; } -static B -jtXfromB(J jt, A w, void *yv) { +template <> +[[nodiscard]] auto +convert(J jt, A w, void *yv) -> bool { return convert(jt, w, yv, @@ -129,8 +133,9 @@ inplace_negate(T& u, int64_t n) { std::transform(u, u + n, u, [](auto v) { return -v; }); } -static B -jtXfromI(J jt, A w, void *yv) { +template <> +[[nodiscard]] auto +convert(J jt, A w, void *yv) -> bool { I u[XIDIG]; auto const v = AV(w); std::transform(v, v + AN(w), static_cast(yv), [&](auto c) { @@ -191,13 +196,15 @@ jtxd1(J jt, D p, I mode) { EPILOG(z); } -static B -jtXfromD(J jt, A w, void *yv, I mode) { +template <> +[[nodiscard]] auto +convert(J jt, A w, void *yv, I mode) -> bool { return convert(jt, w, yv, [=](auto v){ return jtxd1(jt, v, mode); }) && !jt->jerr; } -static B -jtBfromX(J jt, A w, void *yv) { +template <> +[[nodiscard]] auto +convert(J jt, A w, void *yv) -> bool { auto v = XAV(w); auto x = (B *)yv; DO(AN(w), A q = v[i]; I e = AV(q)[0]; if ((AN(q) ^ 1) | (e & -2)) return 0; x[i] = (B)e;); @@ -212,8 +219,9 @@ value_from_X(X p) -> T { return std::accumulate(v, v + n, T{}, [](auto d, auto v) { return v + d * XBASE; }); } -static B -jtIfromX(J jt, A w, void *yv) { +template <> +[[nodiscard]] auto +convert(J jt, A w, void *yv) -> bool { auto v = XAV(w); auto x = (I *)yv; auto n = AN(w); @@ -228,8 +236,9 @@ jtIfromX(J jt, A w, void *yv) { return 1; } -static B -jtDfromX(J jt, A w, void *yv) { +template <> +[[nodiscard]] auto +convert(J jt, A w, void *yv) -> bool { auto const wv = XAV(w); std::transform(wv, wv + AN(w), static_cast(yv), [](auto p) { auto const c = AV(p)[AN(p)-1]; @@ -240,13 +249,15 @@ jtDfromX(J jt, A w, void *yv) { return 1; } -static B -jtQfromX(J jt, A w, void *yv) { +template <> +[[nodiscard]] auto +convert(J jt, A w, void *yv) -> bool { return convert(jt, w, yv, [](auto v) -> Q { return {v, iv1}; }); } -static B -jtQfromD(J jt, A w, void *yv, I mode) { +template <> +[[nodiscard]] auto +convert(J jt, A w, void *yv, I mode) -> bool { B neg, recip; D c, d, t, *wv; I e, i, n, *v; @@ -294,8 +305,9 @@ jtQfromD(J jt, A w, void *yv, I mode) { return !jt->jerr; } -static B -jtDfromQ(J jt, A w, void *yv) { +template <> +[[nodiscard]] auto +convert(J jt, A w, void *yv) -> bool { auto const xb = (D)XBASE; auto const wn = AN(w); auto const wv = QAV(w); @@ -343,8 +355,9 @@ jtDfromQ(J jt, A w, void *yv) { return 1; } -static B -jtXfromQ(J jt, A w, void *yv) { +template <> +[[nodiscard]] auto +convert(J jt, A w, void *yv) -> bool { auto v = QAV(w); auto x = (X *)yv; DQ(AN(w), if (!(jtequ(jt, iv1, v->d))) return 0; *x++ = v->n; ++v;); @@ -352,8 +365,9 @@ jtXfromQ(J jt, A w, void *yv) { } // Imaginary parts have already been cleared -static B -jtZfromD(J jt, A w, void *yv) { +template <> +[[nodiscard]] auto +convert(J jt, A w, void *yv) -> bool { D *wv = DAV(w); Z *zv = static_cast(yv); DQ(AN(w), zv++->re = *wv++;); @@ -455,8 +469,8 @@ jtccvt(J jt, I tflagged, A w, A *y) { case CVCASE(INTX, B01X): std::copy_n(static_cast(wv), n, static_cast(yv)); return 1; - case CVCASE(XNUMX, B01X): return jtXfromB(jt, w, yv); - case CVCASE(RATX, B01X): GATV(d, XNUM, n, r, s); return jtXfromB(jt, w, AV(d)) && jtQfromX(jt, d, yv); + case CVCASE(XNUMX, B01X): return convert(jt, w, yv); + case CVCASE(RATX, B01X): GATV(d, XNUM, n, r, s); return convert(jt, w, AV(d)) && convert(jt, d, yv); case CVCASE(FLX, B01X): std::copy_n(static_cast(wv), n, static_cast(yv)); return 1; @@ -467,8 +481,8 @@ jtccvt(J jt, I tflagged, A w, A *y) { } return 1; case CVCASE(B01X, INTX): return convert(jt, w, yv); - case CVCASE(XNUMX, INTX): return jtXfromI(jt, w, yv); - case CVCASE(RATX, INTX): GATV(d, XNUM, n, r, s); return jtXfromI(jt, w, AV(d)) && jtQfromX(jt, d, yv); + case CVCASE(XNUMX, INTX): return convert(jt, w, yv); + case CVCASE(RATX, INTX): GATV(d, XNUM, n, r, s); return convert(jt, w, AV(d)) && convert(jt, d, yv); case CVCASE(FLX, INTX): std::copy_n(static_cast(wv), n, static_cast(yv)); return 1; @@ -478,52 +492,52 @@ jtccvt(J jt, I tflagged, A w, A *y) { DQ(n, x++->re = (D)*v++;); } return 1; - case CVCASE(B01X, FLX): return jtBfromD(jt, w, yv, (I)jtinplace & JTNOFUZZ ? 0.0 : FUZZ); - case CVCASE(INTX, FLX): return jtIfromD(jt, w, yv, (I)jtinplace & JTNOFUZZ ? 0.0 : FUZZ); + case CVCASE(B01X, FLX): return convert(jt, w, yv, (I)jtinplace & JTNOFUZZ ? 0.0 : FUZZ); + case CVCASE(INTX, FLX): return convert(jt, w, yv, (I)jtinplace & JTNOFUZZ ? 0.0 : FUZZ); case CVCASE(XNUMX, FLX): - return jtXfromD(jt, w, yv, (jt->xmode & REPSGN(SGNIFNOT(tflagged, XCVTXNUMORIDEX))) | (tflagged >> XCVTXNUMCVX)); + return convert(jt, w, yv, (jt->xmode & REPSGN(SGNIFNOT(tflagged, XCVTXNUMORIDEX))) | (tflagged >> XCVTXNUMCVX)); case CVCASE(RATX, FLX): - return jtQfromD(jt, w, yv, (jt->xmode & REPSGN(SGNIFNOT(tflagged, XCVTXNUMORIDEX))) | (tflagged >> XCVTXNUMCVX)); - case CVCASE(CMPXX, FLX): return jtZfromD(jt, w, yv); + return convert(jt, w, yv, (jt->xmode & REPSGN(SGNIFNOT(tflagged, XCVTXNUMORIDEX))) | (tflagged >> XCVTXNUMCVX)); + case CVCASE(CMPXX, FLX): return convert(jt, w, yv); case CVCASE(B01X, CMPXX): GATV(d, FL, n, r, s); - if (!(jtDfromZ(jt, w, AV(d), (I)jtinplace & JTNOFUZZ ? 0.0 : FUZZ))) return 0; - return jtBfromD(jt, d, yv, (I)jtinplace & JTNOFUZZ ? 0.0 : FUZZ); + if (!(convert(jt, w, AV(d), (I)jtinplace & JTNOFUZZ ? 0.0 : FUZZ))) return 0; + return convert(jt, d, yv, (I)jtinplace & JTNOFUZZ ? 0.0 : FUZZ); case CVCASE(INTX, CMPXX): GATV(d, FL, n, r, s); - if (!(jtDfromZ(jt, w, AV(d), (I)jtinplace & JTNOFUZZ ? 0.0 : FUZZ))) return 0; - return jtIfromD(jt, d, yv, (I)jtinplace & JTNOFUZZ ? 0.0 : FUZZ); + if (!(convert(jt, w, AV(d), (I)jtinplace & JTNOFUZZ ? 0.0 : FUZZ))) return 0; + return convert(jt, d, yv, (I)jtinplace & JTNOFUZZ ? 0.0 : FUZZ); case CVCASE(XNUMX, CMPXX): GATV(d, FL, n, r, s); - if (!(jtDfromZ(jt, w, AV(d), (I)jtinplace & JTNOFUZZ ? 0.0 : FUZZ))) return 0; - return jtXfromD(jt, d, yv, (jt->xmode & REPSGN(SGNIFNOT(tflagged, XCVTXNUMORIDEX))) | (tflagged >> XCVTXNUMCVX)); + if (!(convert(jt, w, AV(d), (I)jtinplace & JTNOFUZZ ? 0.0 : FUZZ))) return 0; + return convert(jt, d, yv, (jt->xmode & REPSGN(SGNIFNOT(tflagged, XCVTXNUMORIDEX))) | (tflagged >> XCVTXNUMCVX)); case CVCASE(RATX, CMPXX): GATV(d, FL, n, r, s); - if (!(jtDfromZ(jt, w, AV(d), (I)jtinplace & JTNOFUZZ ? 0.0 : FUZZ))) return 0; - return jtQfromD(jt, d, yv, (jt->xmode & REPSGN(SGNIFNOT(tflagged, XCVTXNUMORIDEX))) | (tflagged >> XCVTXNUMCVX)); - case CVCASE(FLX, CMPXX): return jtDfromZ(jt, w, yv, (I)jtinplace & JTNOFUZZ ? 0.0 : FUZZ); - case CVCASE(B01X, XNUMX): return jtBfromX(jt, w, yv); - case CVCASE(INTX, XNUMX): return jtIfromX(jt, w, yv); - case CVCASE(RATX, XNUMX): return jtQfromX(jt, w, yv); - case CVCASE(FLX, XNUMX): return jtDfromX(jt, w, yv); + if (!(convert(jt, w, AV(d), (I)jtinplace & JTNOFUZZ ? 0.0 : FUZZ))) return 0; + return convert(jt, d, yv, (jt->xmode & REPSGN(SGNIFNOT(tflagged, XCVTXNUMORIDEX))) | (tflagged >> XCVTXNUMCVX)); + case CVCASE(FLX, CMPXX): return convert(jt, w, yv, (I)jtinplace & JTNOFUZZ ? 0.0 : FUZZ); + case CVCASE(B01X, XNUMX): return convert(jt, w, yv); + case CVCASE(INTX, XNUMX): return convert(jt, w, yv); + case CVCASE(RATX, XNUMX): return convert(jt, w, yv); + case CVCASE(FLX, XNUMX): return convert(jt, w, yv); case CVCASE(CMPXX, XNUMX): GATV(d, FL, n, r, s); - if (!(jtDfromX(jt, w, AV(d)))) return 0; - return jtZfromD(jt, d, yv); + if (!(convert(jt, w, AV(d)))) return 0; + return convert(jt, d, yv); case CVCASE(B01X, RATX): GATV(d, XNUM, n, r, s); - if (!(jtXfromQ(jt, w, AV(d)))) return 0; - return jtBfromX(jt, d, yv); + if (!(convert(jt, w, AV(d)))) return 0; + return convert(jt, d, yv); case CVCASE(INTX, RATX): GATV(d, XNUM, n, r, s); - if (!(jtXfromQ(jt, w, AV(d)))) return 0; - return jtIfromX(jt, d, yv); - case CVCASE(XNUMX, RATX): return jtXfromQ(jt, w, yv); - case CVCASE(FLX, RATX): return jtDfromQ(jt, w, yv); + if (!(convert(jt, w, AV(d)))) return 0; + return convert(jt, d, yv); + case CVCASE(XNUMX, RATX): return convert(jt, w, yv); + case CVCASE(FLX, RATX): return convert(jt, w, yv); case CVCASE(CMPXX, RATX): GATV(d, FL, n, r, s); - if (!(jtDfromQ(jt, w, AV(d)))) return 0; - return jtZfromD(jt, d, yv); + if (!(convert(jt, w, AV(d)))) return 0; + return convert(jt, d, yv); default: ASSERT(0, EVDOMAIN); } } From 77c010562bcf4191ad4d8e74b369f0e209f9265e Mon Sep 17 00:00:00 2001 From: Juho Eerola Date: Sun, 7 Mar 2021 01:56:00 +0200 Subject: [PATCH 12/39] Remove more decl-init split --- jsrc/conversions.cpp | 116 +++++++++++++++++++++---------------------- 1 file changed, 56 insertions(+), 60 deletions(-) diff --git a/jsrc/conversions.cpp b/jsrc/conversions.cpp index e4313548..f05bad61 100644 --- a/jsrc/conversions.cpp +++ b/jsrc/conversions.cpp @@ -258,34 +258,35 @@ convert(J jt, A w, void *yv) -> bool { template <> [[nodiscard]] auto convert(J jt, A w, void *yv, I mode) -> bool { - B neg, recip; - D c, d, t, *wv; - I e, i, n, *v; - Q q, *x; - S *tv; if (!(w)) return 0; - n = AN(w); - wv = DAV(w); - x = (Q *)yv; - tv = 3 + (S *)&t; - for (i = 0; i < n; ++i) { + auto const n = AN(w); + auto const wv = DAV(w); + auto x = (Q *)yv; + D t; + auto tv = 3 + (S *)&t; + Q q; + for (int64_t i = 0; i < n; ++i) { t = wv[i]; ASSERT(!_isnan(t), EVNAN); - if ((neg = 0 > t)) t = -t; + bool const neg = 0 > t; + if (neg) t = -t; q.d = iv1; if (t == inf) q.n = jtvci(jt, XPINF); else if (t == 0.0) q.n = iv0; else if (1.1102230246251565e-16 < t && t < 9.007199254740992e15) { - d = jround(1 / jtdgcd(jt, 1.0, t)); - c = jround(d * t); - q.n = jtxd1(jt, c, mode); - q.d = jtxd1(jt, d, mode); - q = jtqstd(jt, q); + auto const d = jround(1 / jtdgcd(jt, 1.0, t)); + auto const c = jround(d * t); + q = jtqstd(jt, + { + .n = jtxd1(jt, c, mode), + .d = jtxd1(jt, d, mode), + }); } else { - if ((recip = 1 > t)) t = 1.0 / t; - e = (I)(0xfff0 & *tv); + bool const recip = 1 > t; + if (recip) t = 1.0 / t; + auto e = (I)(0xfff0 & *tv); e >>= 4; e -= 1023; if (recip) { @@ -297,7 +298,7 @@ convert(J jt, A w, void *yv, I mode) -> bool { } } if (neg) { - v = AV(q.n); + auto v = AV(q.n); DQ(AN(q.n), *v = -*v; ++v;); } *x++ = q; @@ -381,13 +382,10 @@ convert(J jt, A w, void *yv) -> bool { B jtccvt(J jt, I tflagged, A w, A *y) { FPREFIP; - A d; - I n, r, *s, wt; - void *wv, *yv; - I t = tflagged & NOUN; + I const t = tflagged & NOUN; if (!w) return 0; - r = AR(w); - s = AS(w); + auto const r = AR(w); + auto const s = AS(w); if (((t | AT(w)) & SPARSE) != 0) { // Handle sparse RANK2T oqr = jt->ranks; @@ -415,8 +413,7 @@ jtccvt(J jt, I tflagged, A w, A *y) { jt->ranks = oqr; } // Now known to be non-sparse - n = AN(w); - wt = AT(w); + auto const wt = AT(w); // If type is already correct, return a clone - used to force a copy. Should get rid of this kludge if (TYPESEQ(t, wt)) { RZ(*y = jtca(jt, w)); @@ -427,13 +424,15 @@ jtccvt(J jt, I tflagged, A w, A *y) { // replace n (for use here) and yv, and AK(w) and AN(w) for the subroutines. If NOUNCVTVALIDCT is set, w is // modified: the caller must restore AN(w) and AK(w) if it needs it // TODO: same-length conversion could be done in place + auto n = AN(w); + A d; GA(d, t, n, r, s); - yv = voidAV(d); // allocate the same # atoms, even if we will convert fewer + auto yv = voidAV(d); // allocate the same # atoms, even if we will convert fewer if (tflagged & NOUNCVTVALIDCT) { - I inputn = *(I *)y; // fetch input, in case it is called for - if (inputn > 0) { // if converting the leading values, just update the counts - n = inputn; // set the counts for local use, and in the block to be converted - } else { // if converting trailing values... + I inputn = *(I *)y; // fetch input, in case it is called for + if (inputn > 0) { // if converting the leading values, just update the counts + n = inputn; // set the counts for local use, and in the block to be converted + } else { // if converting trailing values... AK(w) += (n + inputn) << bplg(wt); yv = (I *)((C *)yv + ((n + inputn) << bplg(t))); // advance input and output pointers to new area n = -inputn; // get positive # atoms to convert @@ -443,8 +442,8 @@ jtccvt(J jt, I tflagged, A w, A *y) { // If n and AN have been modified, it doesn't matter for rank-1 arguments whether the shape of the result is listed // as n or s[0] since only n atoms will be used. For higher ranks, we need the shape from s. So it's just as well // that we take the shape from s now - *y = d; - wv = voidAV(w); // return the address of the new block + *y = d; + auto wv = voidAV(w); // return the address of the new block if (t & CMPX) jtfillv(jt, t, n, (C *)yv); // why?? just fill in imaginary parts as we need to if (!n) return 1; // Perform the conversion based on data types @@ -466,14 +465,12 @@ jtccvt(J jt, I tflagged, A w, A *y) { } } switch (CVCASE(CTTZ(t), CTTZ(wt))) { - case CVCASE(INTX, B01X): - std::copy_n(static_cast(wv), n, static_cast(yv)); - return 1; + case CVCASE(INTX, B01X): std::copy_n(static_cast(wv), n, static_cast(yv)); return 1; case CVCASE(XNUMX, B01X): return convert(jt, w, yv); - case CVCASE(RATX, B01X): GATV(d, XNUM, n, r, s); return convert(jt, w, AV(d)) && convert(jt, d, yv); - case CVCASE(FLX, B01X): - std::copy_n(static_cast(wv), n, static_cast(yv)); - return 1; + case CVCASE(RATX, B01X): + GATV(d, XNUM, n, r, s); + return convert(jt, w, AV(d)) && convert(jt, d, yv); + case CVCASE(FLX, B01X): std::copy_n(static_cast(wv), n, static_cast(yv)); return 1; case CVCASE(CMPXX, B01X): { Z *x = (Z *)yv; B *v = (B *)wv; @@ -483,21 +480,21 @@ jtccvt(J jt, I tflagged, A w, A *y) { case CVCASE(B01X, INTX): return convert(jt, w, yv); case CVCASE(XNUMX, INTX): return convert(jt, w, yv); case CVCASE(RATX, INTX): GATV(d, XNUM, n, r, s); return convert(jt, w, AV(d)) && convert(jt, d, yv); - case CVCASE(FLX, INTX): - std::copy_n(static_cast(wv), n, static_cast(yv)); - return 1; + case CVCASE(FLX, INTX): std::copy_n(static_cast(wv), n, static_cast(yv)); return 1; case CVCASE(CMPXX, INTX): { Z *x = (Z *)yv; - I *v = static_cast(wv); + I *v = static_cast(wv); DQ(n, x++->re = (D)*v++;); } return 1; case CVCASE(B01X, FLX): return convert(jt, w, yv, (I)jtinplace & JTNOFUZZ ? 0.0 : FUZZ); case CVCASE(INTX, FLX): return convert(jt, w, yv, (I)jtinplace & JTNOFUZZ ? 0.0 : FUZZ); case CVCASE(XNUMX, FLX): - return convert(jt, w, yv, (jt->xmode & REPSGN(SGNIFNOT(tflagged, XCVTXNUMORIDEX))) | (tflagged >> XCVTXNUMCVX)); + return convert( + jt, w, yv, (jt->xmode & REPSGN(SGNIFNOT(tflagged, XCVTXNUMORIDEX))) | (tflagged >> XCVTXNUMCVX)); case CVCASE(RATX, FLX): - return convert(jt, w, yv, (jt->xmode & REPSGN(SGNIFNOT(tflagged, XCVTXNUMORIDEX))) | (tflagged >> XCVTXNUMCVX)); + return convert( + jt, w, yv, (jt->xmode & REPSGN(SGNIFNOT(tflagged, XCVTXNUMORIDEX))) | (tflagged >> XCVTXNUMCVX)); case CVCASE(CMPXX, FLX): return convert(jt, w, yv); case CVCASE(B01X, CMPXX): GATV(d, FL, n, r, s); @@ -510,11 +507,13 @@ jtccvt(J jt, I tflagged, A w, A *y) { case CVCASE(XNUMX, CMPXX): GATV(d, FL, n, r, s); if (!(convert(jt, w, AV(d), (I)jtinplace & JTNOFUZZ ? 0.0 : FUZZ))) return 0; - return convert(jt, d, yv, (jt->xmode & REPSGN(SGNIFNOT(tflagged, XCVTXNUMORIDEX))) | (tflagged >> XCVTXNUMCVX)); + return convert( + jt, d, yv, (jt->xmode & REPSGN(SGNIFNOT(tflagged, XCVTXNUMORIDEX))) | (tflagged >> XCVTXNUMCVX)); case CVCASE(RATX, CMPXX): GATV(d, FL, n, r, s); if (!(convert(jt, w, AV(d), (I)jtinplace & JTNOFUZZ ? 0.0 : FUZZ))) return 0; - return convert(jt, d, yv, (jt->xmode & REPSGN(SGNIFNOT(tflagged, XCVTXNUMORIDEX))) | (tflagged >> XCVTXNUMCVX)); + return convert( + jt, d, yv, (jt->xmode & REPSGN(SGNIFNOT(tflagged, XCVTXNUMORIDEX))) | (tflagged >> XCVTXNUMCVX)); case CVCASE(FLX, CMPXX): return convert(jt, w, yv, (I)jtinplace & JTNOFUZZ ? 0.0 : FUZZ); case CVCASE(B01X, XNUMX): return convert(jt, w, yv); case CVCASE(INTX, XNUMX): return convert(jt, w, yv); @@ -604,15 +603,13 @@ jtbcvt(J jt, C mode, A w) { A jticvt(J jt, A w) { + auto const n = AN(w); + auto const* v = DAV(w); A z; - D *v, x; - I i, n, *u; - n = AN(w); - v = DAV(w); GATV(z, INT, n, AR(w), AS(w)); - u = AV(z); - for (i = 0; i < n; ++i) { - x = *v++; + auto u = AV(z); + for (int64_t i = 0; i < n; ++i) { + auto x = *v++; if (x < IMIN || FLIMAX <= x) return w; // if conversion will fail, skip it *u++ = (I)x; } @@ -621,12 +618,11 @@ jticvt(J jt, A w) { A jtpcvt(J jt, I t, A w) { - A y; - B b; RANK2T oqr = jt->ranks; RESETRANK; - b = jtccvt(jt, t, w, &y); - jt->ranks = oqr; + A y; + bool const b = jtccvt(jt, t, w, &y); + jt->ranks = oqr; return b ? y : w; } /* convert w to type t, if possible, otherwise just return w */ From bda0f83819216bb1b254ed3d5a4cb78ea994b271 Mon Sep 17 00:00:00 2001 From: Juho Eerola Date: Sun, 7 Mar 2021 02:18:59 +0200 Subject: [PATCH 13/39] Add helper function --- jsrc/conversions.cpp | 24 +++++++++--------------- 1 file changed, 9 insertions(+), 15 deletions(-) diff --git a/jsrc/conversions.cpp b/jsrc/conversions.cpp index f05bad61..5fb800ca 100644 --- a/jsrc/conversions.cpp +++ b/jsrc/conversions.cpp @@ -365,13 +365,17 @@ convert(J jt, A w, void *yv) -> bool { return !jt->jerr; } +template +auto +set_real_part(Z *z, int64_t n, T *t) { + for (int64_t i = 0; i < n; ++i) z[i].re = t[i]; +} + // Imaginary parts have already been cleared template <> [[nodiscard]] auto convert(J jt, A w, void *yv) -> bool { - D *wv = DAV(w); - Z *zv = static_cast(yv); - DQ(AN(w), zv++->re = *wv++;); + set_real_part(static_cast(yv), AN(w), DAV(w)); return 1; } @@ -471,22 +475,12 @@ jtccvt(J jt, I tflagged, A w, A *y) { GATV(d, XNUM, n, r, s); return convert(jt, w, AV(d)) && convert(jt, d, yv); case CVCASE(FLX, B01X): std::copy_n(static_cast(wv), n, static_cast(yv)); return 1; - case CVCASE(CMPXX, B01X): { - Z *x = (Z *)yv; - B *v = (B *)wv; - DQ(n, x++->re = *v++;); - } - return 1; + case CVCASE(CMPXX, B01X): set_real_part(static_cast(yv), n, static_cast(wv)); return 1; case CVCASE(B01X, INTX): return convert(jt, w, yv); case CVCASE(XNUMX, INTX): return convert(jt, w, yv); case CVCASE(RATX, INTX): GATV(d, XNUM, n, r, s); return convert(jt, w, AV(d)) && convert(jt, d, yv); case CVCASE(FLX, INTX): std::copy_n(static_cast(wv), n, static_cast(yv)); return 1; - case CVCASE(CMPXX, INTX): { - Z *x = (Z *)yv; - I *v = static_cast(wv); - DQ(n, x++->re = (D)*v++;); - } - return 1; + case CVCASE(CMPXX, INTX): set_real_part(static_cast(yv), n, static_cast(wv)); return 1; case CVCASE(B01X, FLX): return convert(jt, w, yv, (I)jtinplace & JTNOFUZZ ? 0.0 : FUZZ); case CVCASE(INTX, FLX): return convert(jt, w, yv, (I)jtinplace & JTNOFUZZ ? 0.0 : FUZZ); case CVCASE(XNUMX, FLX): From 34a427da5bba8513350a2d32d0ab7e257073189e Mon Sep 17 00:00:00 2001 From: Juho Eerola Date: Sun, 7 Mar 2021 02:39:43 +0200 Subject: [PATCH 14/39] Use helper functions more --- jsrc/conversions.cpp | 22 ++++++++-------------- 1 file changed, 8 insertions(+), 14 deletions(-) diff --git a/jsrc/conversions.cpp b/jsrc/conversions.cpp index 5fb800ca..9d923bf6 100644 --- a/jsrc/conversions.cpp +++ b/jsrc/conversions.cpp @@ -129,16 +129,15 @@ convert(J jt, A w, void *yv) -> bool { template static auto -inplace_negate(T& u, int64_t n) { - std::transform(u, u + n, u, [](auto v) { return -v; }); +inplace_negate(T *u, int64_t n) { + std::transform(u, u + n, u, [](auto v) { return -v; }); } template <> [[nodiscard]] auto convert(J jt, A w, void *yv) -> bool { I u[XIDIG]; - auto const v = AV(w); - std::transform(v, v + AN(w), static_cast(yv), [&](auto c) { + auto const convert_one = [&](auto c) { auto const b = c == IMIN; auto d = b ? -(1 + c) : std::abs(c); int64_t length = 0; @@ -151,8 +150,8 @@ convert(J jt, A w, void *yv) -> bool { *u += b; if (0 > c) inplace_negate(u, XIDIG); return jtvec(jt, INT, length, u); - }); - return !jt->jerr; + }; + return convert(jt, w, yv, convert_one) && !jt->jerr; } static X @@ -239,14 +238,12 @@ convert(J jt, A w, void *yv) -> bool { template <> [[nodiscard]] auto convert(J jt, A w, void *yv) -> bool { - auto const wv = XAV(w); - std::transform(wv, wv + AN(w), static_cast(yv), [](auto p) { - auto const c = AV(p)[AN(p)-1]; + return convert(jt, w, yv, [](auto p) { + auto const c = AV(p)[AN(p) - 1]; if (c == XPINF) return inf; if (c == XNINF) return infm; return value_from_X(p); }); - return 1; } template <> @@ -297,10 +294,7 @@ convert(J jt, A w, void *yv, I mode) -> bool { q.d = jtca(jt, iv1); } } - if (neg) { - auto v = AV(q.n); - DQ(AN(q.n), *v = -*v; ++v;); - } + if (neg) inplace_negate(AV(q.n), AN(q.n)); *x++ = q; } return !jt->jerr; From ab99794b4e78f23288bd6b5115c5bcd96e180eb5 Mon Sep 17 00:00:00 2001 From: Juho Eerola Date: Sun, 7 Mar 2021 02:52:11 +0200 Subject: [PATCH 15/39] Parametrise `pointer_to_values()` return type --- jsrc/array.hpp | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/jsrc/array.hpp b/jsrc/array.hpp index 7499a49d..b4787816 100644 --- a/jsrc/array.hpp +++ b/jsrc/array.hpp @@ -35,9 +35,10 @@ num(int64_t n) { return reinterpret_cast(Bnum[n - NUMMIN]); } +template [[nodiscard]] inline auto -pointer_to_values(array x) -> int64_t* { - return reinterpret_cast(reinterpret_cast(x) + x->kchain.k); +pointer_to_values(array x) -> Value* { + return reinterpret_cast(reinterpret_cast(x) + x->kchain.k); } [[nodiscard]] constexpr auto From fe73293a4436b30975a841c4e6aae84506e51139 Mon Sep 17 00:00:00 2001 From: Juho Eerola Date: Sun, 7 Mar 2021 02:53:02 +0200 Subject: [PATCH 16/39] Replace `*AV()` macros with `pointer_to_values()` --- jsrc/conversions.cpp | 84 ++++++++++++++++++++++---------------------- 1 file changed, 42 insertions(+), 42 deletions(-) diff --git a/jsrc/conversions.cpp b/jsrc/conversions.cpp index 9d923bf6..ace30e0f 100644 --- a/jsrc/conversions.cpp +++ b/jsrc/conversions.cpp @@ -35,7 +35,7 @@ in_range() -> bool { template [[nodiscard]] auto convert(J jt, array w, void *yv) -> bool { - From *v = reinterpret_cast(UAV(w)); + auto *v = pointer_to_values(w); if constexpr (!in_range()) { // TODO: replace with short circuiting solution auto out = static_cast(yv); @@ -48,7 +48,7 @@ convert(J jt, array w, void *yv) -> bool { template [[nodiscard]] auto convert(J jt, array w, void *yv, Transform t) -> bool { - From *v = reinterpret_cast(UAV(w)); + auto *v = pointer_to_values(w); std::transform(v, v + AN(w), static_cast(yv), t); return 1; } @@ -57,7 +57,7 @@ template <> [[nodiscard]] auto convert(J jt, A w, void *yv, D fuzz) -> bool { auto n = AN(w); - auto v = DAV(w); + auto v = pointer_to_values(w); auto x = (B *)yv; DQ(n, auto p = *v++; if (p < -2 || 2 < p) return 0; // handle infinities I val = 2; @@ -72,7 +72,7 @@ template <> [[nodiscard]] auto convert(J jt, A w, void *yv, D fuzz) -> bool { auto n = AN(w); - auto v = DAV(w); + auto v = pointer_to_values(w); auto x = (I *)yv; for (int64_t i = 0; i < n; ++i) { auto const p = v[i]; @@ -97,7 +97,7 @@ template <> [[nodiscard]] auto convert(J jt, A w, void *yv, D fuzz) -> bool { auto const n = AN(w); - auto const *v = ZAV(w); + auto const *v = pointer_to_values(w); auto x = (D *)yv; if (fuzz) DQ( @@ -172,7 +172,7 @@ jtxd1(J jt, D p, I mode) { if (p == -inf) return jtvci(jt, XNINF); A t; GAT0(t, INT, 30, 1); - auto u = AV(t); + auto u = pointer_to_values(t); int64_t m = 0; auto d = std::abs(p); while (0 < d) { @@ -182,7 +182,7 @@ jtxd1(J jt, D p, I mode) { d = q; if (m == AN(t)) { RZ(t = jtext(jt, 0, t)); - u = AV(t); + u = pointer_to_values(t); } } if (!m) { @@ -204,9 +204,9 @@ convert(J jt, A w, void *yv, I mode) -> bool { template <> [[nodiscard]] auto convert(J jt, A w, void *yv) -> bool { - auto v = XAV(w); + auto v = pointer_to_values(w); auto x = (B *)yv; - DO(AN(w), A q = v[i]; I e = AV(q)[0]; if ((AN(q) ^ 1) | (e & -2)) return 0; x[i] = (B)e;); + DO(AN(w), A q = v[i]; I e = pointer_to_values(q)[0]; if ((AN(q) ^ 1) | (e & -2)) return 0; x[i] = (B)e;); return 1; } @@ -214,14 +214,14 @@ template [[nodiscard]] static auto value_from_X(X p) -> T { auto const n = AN(p); - auto const v = std::reverse_iterator(AV(p) + n); + auto const v = std::reverse_iterator(pointer_to_values(p) + n); return std::accumulate(v, v + n, T{}, [](auto d, auto v) { return v + d * XBASE; }); } template <> [[nodiscard]] auto convert(J jt, A w, void *yv) -> bool { - auto v = XAV(w); + auto v = pointer_to_values(w); auto x = (I *)yv; auto n = AN(w); X p, q; @@ -239,7 +239,7 @@ template <> [[nodiscard]] auto convert(J jt, A w, void *yv) -> bool { return convert(jt, w, yv, [](auto p) { - auto const c = AV(p)[AN(p) - 1]; + auto const c = pointer_to_values(p)[AN(p) - 1]; if (c == XPINF) return inf; if (c == XNINF) return infm; return value_from_X(p); @@ -257,7 +257,7 @@ template <> convert(J jt, A w, void *yv, I mode) -> bool { if (!(w)) return 0; auto const n = AN(w); - auto const wv = DAV(w); + auto const wv = pointer_to_values(w); auto x = (Q *)yv; D t; auto tv = 3 + (S *)&t; @@ -294,7 +294,7 @@ convert(J jt, A w, void *yv, I mode) -> bool { q.d = jtca(jt, iv1); } } - if (neg) inplace_negate(AV(q.n), AN(q.n)); + if (neg) inplace_negate(pointer_to_values(q.n), AN(q.n)); *x++ = q; } return !jt->jerr; @@ -305,7 +305,7 @@ template <> convert(J jt, A w, void *yv) -> bool { auto const xb = (D)XBASE; auto const wn = AN(w); - auto const wv = QAV(w); + auto const wv = pointer_to_values(w); auto const x = (D *)yv; auto const nn = 308 / XBASEN; @@ -321,7 +321,7 @@ convert(J jt, A w, void *yv) -> bool { for (int64_t i = 0; i < wn; ++i) { auto const p = wv[i].n; auto const pn = AN(p); - auto const k = 1 == pn ? AV(p)[0] : 0; + auto const k = 1 == pn ? pointer_to_values(p)[0] : 0; auto const q = wv[i].d; auto const qn = AN(q); if (k == XPINF) @@ -329,8 +329,8 @@ convert(J jt, A w, void *yv) -> bool { else if (k == XNINF) x[i] = infm; else if (pn <= nn && qn <= nn) { - auto const n = add_digits(pn, AV(p)); - auto const d = add_digits(qn, AV(q)); + auto const n = add_digits(pn, pointer_to_values(p)); + auto const d = add_digits(qn, pointer_to_values(q)); x[i] = n / d; } else { if (!x2) @@ -341,7 +341,7 @@ convert(J jt, A w, void *yv) -> bool { auto const cn = AN(c); auto const m = MIN(cn, 5); auto const r = cn - (m + k); - auto const v = AV(c) + cn - m; + auto const v = pointer_to_values(c) + cn - m; auto const n = add_digits(m, v); auto d = std::pow(xb, std::abs(r)); x[i] = 0 > r ? n / d : n * d; @@ -353,7 +353,7 @@ convert(J jt, A w, void *yv) -> bool { template <> [[nodiscard]] auto convert(J jt, A w, void *yv) -> bool { - auto v = QAV(w); + auto v = pointer_to_values(w); auto x = (X *)yv; DQ(AN(w), if (!(jtequ(jt, iv1, v->d))) return 0; *x++ = v->n; ++v;); return !jt->jerr; @@ -369,7 +369,7 @@ set_real_part(Z *z, int64_t n, T *t) { template <> [[nodiscard]] auto convert(J jt, A w, void *yv) -> bool { - set_real_part(static_cast(yv), AN(w), DAV(w)); + set_real_part(static_cast(yv), AN(w), pointer_to_values(w)); return 1; } @@ -399,8 +399,8 @@ jtccvt(J jt, I tflagged, A w, A *y) { case 3: // sparse to sparse t1 = DTYPE(t); GASPARSE(*y, t, 1, r, s); - yp = PAV(*y); - wp = PAV(w); + yp = pointer_to_values

(*y); + wp = pointer_to_values

(w); SPB(yp, a, jtca(jt, SPA(wp, a))); SPB(yp, i, jtca(jt, SPA(wp, i))); SPB(yp, e, jtcvt(jt, t1, SPA(wp, e))); @@ -425,7 +425,7 @@ jtccvt(J jt, I tflagged, A w, A *y) { auto n = AN(w); A d; GA(d, t, n, r, s); - auto yv = voidAV(d); // allocate the same # atoms, even if we will convert fewer + auto yv = pointer_to_values(d); // allocate the same # atoms, even if we will convert fewer if (tflagged & NOUNCVTVALIDCT) { I inputn = *(I *)y; // fetch input, in case it is called for if (inputn > 0) { // if converting the leading values, just update the counts @@ -441,7 +441,7 @@ jtccvt(J jt, I tflagged, A w, A *y) { // as n or s[0] since only n atoms will be used. For higher ranks, we need the shape from s. So it's just as well // that we take the shape from s now *y = d; - auto wv = voidAV(w); // return the address of the new block + auto wv = pointer_to_values(w); // return the address of the new block if (t & CMPX) jtfillv(jt, t, n, (C *)yv); // why?? just fill in imaginary parts as we need to if (!n) return 1; // Perform the conversion based on data types @@ -467,12 +467,12 @@ jtccvt(J jt, I tflagged, A w, A *y) { case CVCASE(XNUMX, B01X): return convert(jt, w, yv); case CVCASE(RATX, B01X): GATV(d, XNUM, n, r, s); - return convert(jt, w, AV(d)) && convert(jt, d, yv); + return convert(jt, w, pointer_to_values(d)) && convert(jt, d, yv); case CVCASE(FLX, B01X): std::copy_n(static_cast(wv), n, static_cast(yv)); return 1; case CVCASE(CMPXX, B01X): set_real_part(static_cast(yv), n, static_cast(wv)); return 1; case CVCASE(B01X, INTX): return convert(jt, w, yv); case CVCASE(XNUMX, INTX): return convert(jt, w, yv); - case CVCASE(RATX, INTX): GATV(d, XNUM, n, r, s); return convert(jt, w, AV(d)) && convert(jt, d, yv); + case CVCASE(RATX, INTX): GATV(d, XNUM, n, r, s); return convert(jt, w, pointer_to_values(d)) && convert(jt, d, yv); case CVCASE(FLX, INTX): std::copy_n(static_cast(wv), n, static_cast(yv)); return 1; case CVCASE(CMPXX, INTX): set_real_part(static_cast(yv), n, static_cast(wv)); return 1; case CVCASE(B01X, FLX): return convert(jt, w, yv, (I)jtinplace & JTNOFUZZ ? 0.0 : FUZZ); @@ -486,20 +486,20 @@ jtccvt(J jt, I tflagged, A w, A *y) { case CVCASE(CMPXX, FLX): return convert(jt, w, yv); case CVCASE(B01X, CMPXX): GATV(d, FL, n, r, s); - if (!(convert(jt, w, AV(d), (I)jtinplace & JTNOFUZZ ? 0.0 : FUZZ))) return 0; + if (!(convert(jt, w, pointer_to_values(d), (I)jtinplace & JTNOFUZZ ? 0.0 : FUZZ))) return 0; return convert(jt, d, yv, (I)jtinplace & JTNOFUZZ ? 0.0 : FUZZ); case CVCASE(INTX, CMPXX): GATV(d, FL, n, r, s); - if (!(convert(jt, w, AV(d), (I)jtinplace & JTNOFUZZ ? 0.0 : FUZZ))) return 0; + if (!(convert(jt, w, pointer_to_values(d), (I)jtinplace & JTNOFUZZ ? 0.0 : FUZZ))) return 0; return convert(jt, d, yv, (I)jtinplace & JTNOFUZZ ? 0.0 : FUZZ); case CVCASE(XNUMX, CMPXX): GATV(d, FL, n, r, s); - if (!(convert(jt, w, AV(d), (I)jtinplace & JTNOFUZZ ? 0.0 : FUZZ))) return 0; + if (!(convert(jt, w, pointer_to_values(d), (I)jtinplace & JTNOFUZZ ? 0.0 : FUZZ))) return 0; return convert( jt, d, yv, (jt->xmode & REPSGN(SGNIFNOT(tflagged, XCVTXNUMORIDEX))) | (tflagged >> XCVTXNUMCVX)); case CVCASE(RATX, CMPXX): GATV(d, FL, n, r, s); - if (!(convert(jt, w, AV(d), (I)jtinplace & JTNOFUZZ ? 0.0 : FUZZ))) return 0; + if (!(convert(jt, w, pointer_to_values(d), (I)jtinplace & JTNOFUZZ ? 0.0 : FUZZ))) return 0; return convert( jt, d, yv, (jt->xmode & REPSGN(SGNIFNOT(tflagged, XCVTXNUMORIDEX))) | (tflagged >> XCVTXNUMCVX)); case CVCASE(FLX, CMPXX): return convert(jt, w, yv, (I)jtinplace & JTNOFUZZ ? 0.0 : FUZZ); @@ -509,21 +509,21 @@ jtccvt(J jt, I tflagged, A w, A *y) { case CVCASE(FLX, XNUMX): return convert(jt, w, yv); case CVCASE(CMPXX, XNUMX): GATV(d, FL, n, r, s); - if (!(convert(jt, w, AV(d)))) return 0; + if (!(convert(jt, w, pointer_to_values(d)))) return 0; return convert(jt, d, yv); case CVCASE(B01X, RATX): GATV(d, XNUM, n, r, s); - if (!(convert(jt, w, AV(d)))) return 0; + if (!(convert(jt, w, pointer_to_values(d)))) return 0; return convert(jt, d, yv); case CVCASE(INTX, RATX): GATV(d, XNUM, n, r, s); - if (!(convert(jt, w, AV(d)))) return 0; + if (!(convert(jt, w, pointer_to_values(d)))) return 0; return convert(jt, d, yv); case CVCASE(XNUMX, RATX): return convert(jt, w, yv); case CVCASE(FLX, RATX): return convert(jt, w, yv); case CVCASE(CMPXX, RATX): GATV(d, FL, n, r, s); - if (!(convert(jt, w, AV(d)))) return 0; + if (!(convert(jt, w, pointer_to_values(d)))) return 0; return convert(jt, d, yv); default: ASSERT(0, EVDOMAIN); } @@ -557,16 +557,16 @@ jtbcvt(J jt, C mode, A w) { // convert the flagged values to float and keep the result as complex array result = w; if ((((AN(w) - 1) | (AT(w) & CMPX) - 1)) >= 0) { // not empty AND complex - Z *wv = ZAV(w); + Z *wv = pointer_to_values(w); auto flags = std::transform_reduce(wv, wv + AN(w), int64_t{}, std::plus{}, isflag); if (flags) { I ipok = SGNIF(jtinplace, JTINPLACEWX) & AC(w); // both sign bits set (<0) if inplaceable if (flags == AN(w)) { if (ipok >= 0) GATV(result, INT, AN(w), AR(w), AS(w)); - std::transform(wv, wv + AN(w), IAV(result), [&](auto const &z) { return as_integer(z.re); }); + std::transform(wv, wv + AN(w), pointer_to_values(result), [&](auto const &z) { return as_integer(z.re); }); } else { if (ipok >= 0) GATV(result, CMPX, AN(w), AR(w), AS(w)); - std::transform(wv, wv + AN(w), ZAV(result), [&](auto const &z) -> Z { + std::transform(wv, wv + AN(w), pointer_to_values(result), [&](auto const &z) -> Z { if (isflag(z)) return {.re = (D)as_integer(z.re), .im = 0.0}; return z; // copy floats, and converts any integers back to float }); @@ -592,10 +592,10 @@ jtbcvt(J jt, C mode, A w) { A jticvt(J jt, A w) { auto const n = AN(w); - auto const* v = DAV(w); + auto const* v = pointer_to_values(w); A z; GATV(z, INT, n, AR(w), AS(w)); - auto u = AV(z); + auto u = pointer_to_values(z); for (int64_t i = 0; i < n; ++i) { auto x = *v++; if (x < IMIN || FLIMAX <= x) return w; // if conversion will fail, skip it @@ -619,7 +619,7 @@ jtcvt0(J jt, A w) { auto const t = AT(w); auto const n = (t & CMPX) ? 2 * AN(w) : AN(w); if (n && t & FL + CMPX) { - auto u = DAV(w); + auto u = pointer_to_values(w); std::transform(u, u + n, u, [](auto v) { return v == 0.0 ? 0.0 : v; }); } return w; @@ -648,7 +648,7 @@ jtxco2(J jt, A a, A w) { A z; GATV(z, XNUM, 2 * n, r + 1, AS(w)); AS(z)[r] = 2; - memcpy(AV(z), AV(w), 2 * n * SZI); + memcpy(pointer_to_values(z), pointer_to_values(w), 2 * n * SZI); return z; } default: ASSERT(0, EVDOMAIN); From 300efec33467b3b636a54d4a29bc0247d32108a5 Mon Sep 17 00:00:00 2001 From: Juho Eerola Date: Sun, 7 Mar 2021 03:04:41 +0200 Subject: [PATCH 17/39] Use `array` instead of `A` --- jsrc/conversions.cpp | 76 ++++++++++++++++++++++---------------------- 1 file changed, 38 insertions(+), 38 deletions(-) diff --git a/jsrc/conversions.cpp b/jsrc/conversions.cpp index ace30e0f..6d20f4bf 100644 --- a/jsrc/conversions.cpp +++ b/jsrc/conversions.cpp @@ -55,7 +55,7 @@ convert(J jt, array w, void *yv, Transform t) -> bool { template <> [[nodiscard]] auto -convert(J jt, A w, void *yv, D fuzz) -> bool { +convert(J jt, array w, void *yv, D fuzz) -> bool { auto n = AN(w); auto v = pointer_to_values(w); auto x = (B *)yv; @@ -70,7 +70,7 @@ convert(J jt, A w, void *yv, D fuzz) -> bool { template <> [[nodiscard]] auto -convert(J jt, A w, void *yv, D fuzz) -> bool { +convert(J jt, array w, void *yv, D fuzz) -> bool { auto n = AN(w); auto v = pointer_to_values(w); auto x = (I *)yv; @@ -95,7 +95,7 @@ convert(J jt, A w, void *yv, D fuzz) -> bool { template <> [[nodiscard]] auto -convert(J jt, A w, void *yv, D fuzz) -> bool { +convert(J jt, array w, void *yv, D fuzz) -> bool { auto const n = AN(w); auto const *v = pointer_to_values(w); auto x = (D *)yv; @@ -116,7 +116,7 @@ convert(J jt, A w, void *yv, D fuzz) -> bool { template <> [[nodiscard]] auto -convert(J jt, A w, void *yv) -> bool { +convert(J jt, array w, void *yv) -> bool { return convert(jt, w, yv, @@ -135,7 +135,7 @@ inplace_negate(T *u, int64_t n) { template <> [[nodiscard]] auto -convert(J jt, A w, void *yv) -> bool { +convert(J jt, array w, void *yv) -> bool { I u[XIDIG]; auto const convert_one = [&](auto c) { auto const b = c == IMIN; @@ -170,7 +170,7 @@ jtxd1(J jt, D p, I mode) { } if (p == inf) return jtvci(jt, XPINF); if (p == -inf) return jtvci(jt, XNINF); - A t; + array t; GAT0(t, INT, 30, 1); auto u = pointer_to_values(t); int64_t m = 0; @@ -191,22 +191,22 @@ jtxd1(J jt, D p, I mode) { } else if (0 > p) { inplace_negate(u, m); } - A z = jtxstd(jt, jtvec(jt, INT, m, u)); + array z = jtxstd(jt, jtvec(jt, INT, m, u)); EPILOG(z); } template <> [[nodiscard]] auto -convert(J jt, A w, void *yv, I mode) -> bool { +convert(J jt, array w, void *yv, I mode) -> bool { return convert(jt, w, yv, [=](auto v){ return jtxd1(jt, v, mode); }) && !jt->jerr; } template <> [[nodiscard]] auto -convert(J jt, A w, void *yv) -> bool { +convert(J jt, array w, void *yv) -> bool { auto v = pointer_to_values(w); auto x = (B *)yv; - DO(AN(w), A q = v[i]; I e = pointer_to_values(q)[0]; if ((AN(q) ^ 1) | (e & -2)) return 0; x[i] = (B)e;); + DO(AN(w), array q = v[i]; I e = pointer_to_values(q)[0]; if ((AN(q) ^ 1) | (e & -2)) return 0; x[i] = (B)e;); return 1; } @@ -220,7 +220,7 @@ value_from_X(X p) -> T { template <> [[nodiscard]] auto -convert(J jt, A w, void *yv) -> bool { +convert(J jt, array w, void *yv) -> bool { auto v = pointer_to_values(w); auto x = (I *)yv; auto n = AN(w); @@ -237,7 +237,7 @@ convert(J jt, A w, void *yv) -> bool { template <> [[nodiscard]] auto -convert(J jt, A w, void *yv) -> bool { +convert(J jt, array w, void *yv) -> bool { return convert(jt, w, yv, [](auto p) { auto const c = pointer_to_values(p)[AN(p) - 1]; if (c == XPINF) return inf; @@ -248,13 +248,13 @@ convert(J jt, A w, void *yv) -> bool { template <> [[nodiscard]] auto -convert(J jt, A w, void *yv) -> bool { +convert(J jt, array w, void *yv) -> bool { return convert(jt, w, yv, [](auto v) -> Q { return {v, iv1}; }); } template <> [[nodiscard]] auto -convert(J jt, A w, void *yv, I mode) -> bool { +convert(J jt, array w, void *yv, I mode) -> bool { if (!(w)) return 0; auto const n = AN(w); auto const wv = pointer_to_values(w); @@ -302,7 +302,7 @@ convert(J jt, A w, void *yv, I mode) -> bool { template <> [[nodiscard]] auto -convert(J jt, A w, void *yv) -> bool { +convert(J jt, array w, void *yv) -> bool { auto const xb = (D)XBASE; auto const wn = AN(w); auto const wv = pointer_to_values(w); @@ -352,7 +352,7 @@ convert(J jt, A w, void *yv) -> bool { template <> [[nodiscard]] auto -convert(J jt, A w, void *yv) -> bool { +convert(J jt, array w, void *yv) -> bool { auto v = pointer_to_values(w); auto x = (X *)yv; DQ(AN(w), if (!(jtequ(jt, iv1, v->d))) return 0; *x++ = v->n; ++v;); @@ -368,7 +368,7 @@ set_real_part(Z *z, int64_t n, T *t) { // Imaginary parts have already been cleared template <> [[nodiscard]] auto -convert(J jt, A w, void *yv) -> bool { +convert(J jt, array w, void *yv) -> bool { set_real_part(static_cast(yv), AN(w), pointer_to_values(w)); return 1; } @@ -378,7 +378,7 @@ convert(J jt, A w, void *yv) -> bool { // 0 if error, 1 if success. If the conversion loses precision, error is returned // Calls through bcvt are tagged with a flag in jt, indicating to set fuzz=0 B -jtccvt(J jt, I tflagged, A w, A *y) { +jtccvt(J jt, I tflagged, array w, array *y) { FPREFIP; I const t = tflagged & NOUN; if (!w) return 0; @@ -423,7 +423,7 @@ jtccvt(J jt, I tflagged, A w, A *y) { // modified: the caller must restore AN(w) and AK(w) if it needs it // TODO: same-length conversion could be done in place auto n = AN(w); - A d; + array d; GA(d, t, n, r, s); auto yv = pointer_to_values(d); // allocate the same # atoms, even if we will convert fewer if (tflagged & NOUNCVTVALIDCT) { @@ -530,9 +530,9 @@ jtccvt(J jt, I tflagged, A w, A *y) { } // clear rank before calling ccvt - needed for sparse arrays only but returns the block as the result -A -jtcvt(J jt, I t, A w) { - A y; +auto +jtcvt(J jt, I t, array w) -> array { + array y; bool const b = jtccvt(jt, t, w, &y); ASSERT(b, EVDOMAIN); return y; @@ -542,8 +542,8 @@ jtcvt(J jt, I t, A w) { // and use 'exact' and 'no rank' for them. If mode=0, do not promote XNUM/RAT to fixed-length types. // If mode bit 1 is set, minimum precision is INT; if mode bit 2 is set, minimum precision is FL; if mode bit 3 is set, // minimum precision is CMPX Result is a new buffer, always -A -jtbcvt(J jt, C mode, A w) { +auto +jtbcvt(J jt, C mode, array w) -> array { FPREFIP; if (!w) return 0; @@ -556,7 +556,7 @@ jtbcvt(J jt, C mode, A w) { // to integer. If none of the imaginary parts were flags, we leave the input unchanged. If some were flags, we // convert the flagged values to float and keep the result as complex array result = w; - if ((((AN(w) - 1) | (AT(w) & CMPX) - 1)) >= 0) { // not empty AND complex + if ((((AN(w) - 1) | ((AT(w) & CMPX) - 1))) >= 0) { // not empty AND complex Z *wv = pointer_to_values(w); auto flags = std::transform_reduce(wv, wv + AN(w), int64_t{}, std::plus{}, isflag); if (flags) { @@ -589,11 +589,11 @@ jtbcvt(J jt, C mode, A w) { RNE(result); } /* convert to lowest type. 0=mode: don't convert XNUM/RAT to other types */ -A -jticvt(J jt, A w) { +auto +jticvt(J jt, array w) -> array { auto const n = AN(w); auto const* v = pointer_to_values(w); - A z; + array z; GATV(z, INT, n, AR(w), AS(w)); auto u = pointer_to_values(z); for (int64_t i = 0; i < n; ++i) { @@ -604,18 +604,18 @@ jticvt(J jt, A w) { return z; } -A -jtpcvt(J jt, I t, A w) { +auto +jtpcvt(J jt, I t, array w) -> array { RANK2T oqr = jt->ranks; RESETRANK; - A y; + array y; bool const b = jtccvt(jt, t, w, &y); jt->ranks = oqr; return b ? y : w; } /* convert w to type t, if possible, otherwise just return w */ -A -jtcvt0(J jt, A w) { +auto +jtcvt0(J jt, array w) -> array { auto const t = AT(w); auto const n = (t & CMPX) ? 2 * AN(w) : AN(w); if (n && t & FL + CMPX) { @@ -625,14 +625,14 @@ jtcvt0(J jt, A w) { return w; } /* convert -0 to 0 in place */ -A -jtxco1(J jt, A w) { +auto +jtxco1(J jt, array w) -> array { ASSERT(AT(w) & DENSE, EVNONCE); return jtcvt(jt, AT(w) & B01 + INT + XNUM ? XNUM : RAT, w); } -A -jtxco2(J jt, A a, A w) { +auto +jtxco2(J jt, array a, array w) -> array { ASSERT(AT(w) & DENSE, EVNONCE); I j; RE(j = jti0(jt, a)); @@ -645,7 +645,7 @@ jtxco2(J jt, A a, A w) { { auto const n = AN(w); auto const r = AR(w); - A z; + array z; GATV(z, XNUM, 2 * n, r + 1, AS(w)); AS(z)[r] = 2; memcpy(pointer_to_values(z), pointer_to_values(w), 2 * n * SZI); From b0069a628e0e6aac19da21ac971c23be047184e2 Mon Sep 17 00:00:00 2001 From: Juho Eerola Date: Sun, 7 Mar 2021 03:09:47 +0200 Subject: [PATCH 18/39] Until c++17 --- jsrc/conversions.cpp | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/jsrc/conversions.cpp b/jsrc/conversions.cpp index 6d20f4bf..8a2eee93 100644 --- a/jsrc/conversions.cpp +++ b/jsrc/conversions.cpp @@ -558,7 +558,9 @@ jtbcvt(J jt, C mode, array w) -> array { array result = w; if ((((AN(w) - 1) | ((AT(w) & CMPX) - 1))) >= 0) { // not empty AND complex Z *wv = pointer_to_values(w); - auto flags = std::transform_reduce(wv, wv + AN(w), int64_t{}, std::plus{}, isflag); + // FIXME: get proper c++17 support + // auto flags = std::transform_reduce(wv, wv + AN(w), int64_t{}, std::plus{}, isflag); + auto flags = std::accumulate(wv, wv + AN(w), int64_t{}, [&](auto sum, auto v) { return sum + isflag(v); }); if (flags) { I ipok = SGNIF(jtinplace, JTINPLACEWX) & AC(w); // both sign bits set (<0) if inplaceable if (flags == AN(w)) { From 5935520e51199d8f648820612e4864512e964f98 Mon Sep 17 00:00:00 2001 From: Juho Eerola Date: Sun, 7 Mar 2021 03:26:01 +0200 Subject: [PATCH 19/39] Use true/false for booleans, replace C-style casts --- jsrc/conversions.cpp | 351 +++++++++++++++++++++++-------------------- 1 file changed, 186 insertions(+), 165 deletions(-) diff --git a/jsrc/conversions.cpp b/jsrc/conversions.cpp index 8a2eee93..0531d1f3 100644 --- a/jsrc/conversions.cpp +++ b/jsrc/conversions.cpp @@ -38,59 +38,61 @@ convert(J jt, array w, void *yv) -> bool { auto *v = pointer_to_values(w); if constexpr (!in_range()) { // TODO: replace with short circuiting solution - auto out = static_cast(yv); + auto *out = static_cast(yv); return out + AN(w) == std::copy_if(v, v + AN(w), out, [](auto v) { return in_range(v); }); } std::copy(v, v + AN(w), static_cast(yv)); - return 1; + return true; } template [[nodiscard]] auto convert(J jt, array w, void *yv, Transform t) -> bool { auto *v = pointer_to_values(w); - std::transform(v, v + AN(w), static_cast(yv), t); - return 1; + std::transform(v, v + AN(w), static_cast(yv), t); + return true; } template <> [[nodiscard]] auto convert(J jt, array w, void *yv, D fuzz) -> bool { - auto n = AN(w); - auto v = pointer_to_values(w); - auto x = (B *)yv; - DQ(n, auto p = *v++; if (p < -2 || 2 < p) return 0; // handle infinities + auto n = AN(w); + auto *v = pointer_to_values(w); + auto *x = static_cast(yv); + DQ(n, auto p = *v++; if (p < -2 || 2 < p) return false; // handle infinities I val = 2; val = (p == 0) ? 0 : val; val = FIEQ(p, 1.0, fuzz) ? 1 : val; - if (val == 2) return 0; + if (val == 2) return false; *x++ = (B)val;) - return 1; + return true; } template <> [[nodiscard]] auto convert(J jt, array w, void *yv, D fuzz) -> bool { - auto n = AN(w); - auto v = pointer_to_values(w); - auto x = (I *)yv; + auto n = AN(w); + auto *v = pointer_to_values(w); + auto *x = static_cast(yv); for (int64_t i = 0; i < n; ++i) { auto const p = v[i]; auto const q = jround(p); - I rq = (I)q; - if (!(p == q || FIEQ(p, q, fuzz))) return 0; // must equal int, possibly out of range + I rq = static_cast(q); + if (!(p == q || FIEQ(p, q, fuzz))) { + return 0; // must equal int, possibly out of range + } // out-of-range values don't convert, handle separately - if (p < (D)IMIN) { - if (!(p >= IMIN * (1 + fuzz))) return 0; + if (p < static_cast IMIN) { + if (!(p >= IMIN * (1 + fuzz))) return false; rq = IMIN; } // if tolerantly < IMIN, error; else take IMIN else if (p >= FLIMAX) { - if (!(p <= -(D)IMIN * (1 + fuzz))) return 0; + if (!(p <= -static_cast IMIN * (1 + fuzz))) return false; rq = IMAX; } // if tolerantly > IMAX, error; else take IMAX *x++ = rq; } - return 1; + return true; } template <> @@ -98,20 +100,20 @@ template <> convert(J jt, array w, void *yv, D fuzz) -> bool { auto const n = AN(w); auto const *v = pointer_to_values(w); - auto x = (D *)yv; - if (fuzz) + auto *x = static_cast(yv); + if (fuzz != 0.0) DQ( n, auto d = std::abs(v->im); if (d != inf && d <= fuzz * std::abs(v->re)) { *x++ = v->re; v++; - } else return 0;) + } else return false;) else DQ( n, if (!v->im) { *x++ = v->re; v++; - } else return 0;); - return 1; + } else return false;); + return true; } template <> @@ -148,14 +150,14 @@ convert(J jt, array w, void *yv) -> bool { } ++length; *u += b; - if (0 > c) inplace_negate(u, XIDIG); + if (0 > c) { inplace_negate(u, XIDIG); } return jtvec(jt, INT, length, u); }; return convert(jt, w, yv, convert_one) && !jt->jerr; } -static X -jtxd1(J jt, D p, I mode) { +static auto +jtxd1(J jt, D p, I mode) -> X { PROLOG(0052); D e = jttfloor(jt, p); switch (mode) { @@ -166,26 +168,26 @@ jtxd1(J jt, D p, I mode) { p = e; break; case XMEXMT: - if (!TEQ(p, e)) return jtvec(jt, INT, 0L, &iotavec[-IOTAVECBEGIN]); + if (!TEQ(p, e)) { return jtvec(jt, INT, 0L, &iotavec[-IOTAVECBEGIN]); } } - if (p == inf) return jtvci(jt, XPINF); - if (p == -inf) return jtvci(jt, XNINF); - array t; - GAT0(t, INT, 30, 1); - auto u = pointer_to_values(t); + if (p == inf) { return jtvci(jt, XPINF); } + if (p == -inf) { return jtvci(jt, XNINF); } + array t = make_array(jt, 30, 1); + if (!t) return 0; + auto *u = pointer_to_values(t); int64_t m = 0; - auto d = std::abs(p); + auto d = std::abs(p); while (0 < d) { auto const q = floor(d / XBASE); auto const r = d - q * XBASE; - u[m++] = (I)r; + u[m++] = static_cast(r); d = q; if (m == AN(t)) { RZ(t = jtext(jt, 0, t)); u = pointer_to_values(t); } } - if (!m) { + if (m == 0) { u[0] = 0; ++m; } else if (0 > p) { @@ -198,38 +200,39 @@ jtxd1(J jt, D p, I mode) { template <> [[nodiscard]] auto convert(J jt, array w, void *yv, I mode) -> bool { - return convert(jt, w, yv, [=](auto v){ return jtxd1(jt, v, mode); }) && !jt->jerr; + return convert(jt, w, yv, [=](auto v) { return jtxd1(jt, v, mode); }) && !jt->jerr; } template <> [[nodiscard]] auto convert(J jt, array w, void *yv) -> bool { - auto v = pointer_to_values(w); - auto x = (B *)yv; - DO(AN(w), array q = v[i]; I e = pointer_to_values(q)[0]; if ((AN(q) ^ 1) | (e & -2)) return 0; x[i] = (B)e;); - return 1; + auto *v = pointer_to_values(w); + auto *x = static_cast(yv); + DO(AN(w), array q = v[i]; I e = pointer_to_values(q)[0]; if ((AN(q) ^ 1) | (e & -2)) return false; x[i] = (B)e;); + return true; } template [[nodiscard]] static auto value_from_X(X p) -> T { - auto const n = AN(p); - auto const v = std::reverse_iterator(pointer_to_values(p) + n); - return std::accumulate(v, v + n, T{}, [](auto d, auto v) { return v + d * XBASE; }); + auto const n = AN(p); + auto const v = std::reverse_iterator(pointer_to_values(p) + n); + return std::accumulate(v, v + n, T{}, [](auto d, auto v) { return v + d * XBASE; }); } template <> [[nodiscard]] auto convert(J jt, array w, void *yv) -> bool { - auto v = pointer_to_values(w); - auto x = (I *)yv; - auto n = AN(w); - X p, q; - if (!(p = jtxc(jt, IMAX))) return 0; - if (!(q = jtxminus(jt, jtnegate(jt, p), jtxc(jt, 1L)))) return 0; + auto *v = pointer_to_values(w); + auto *x = static_cast(yv); + auto n = AN(w); + X p = nullptr; + X q; + if ((p = jtxc(jt, IMAX)) == nullptr) return false; + if ((q = jtxminus(jt, jtnegate(jt, p), jtxc(jt, 1L))) == nullptr) return false; for (int64_t i = 0; i < n; ++i) { - auto c = v[i]; - if (!(1 != jtxcompare(jt, q, c) && 1 != jtxcompare(jt, c, p))) return 0; + auto *c = v[i]; + if (!(1 != jtxcompare(jt, q, c) && 1 != jtxcompare(jt, c, p))) return false; x[i] = value_from_X(c); } return 1; @@ -240,8 +243,8 @@ template <> convert(J jt, array w, void *yv) -> bool { return convert(jt, w, yv, [](auto p) { auto const c = pointer_to_values(p)[AN(p) - 1]; - if (c == XPINF) return inf; - if (c == XNINF) return infm; + if (c == XPINF) { return inf; } + if (c == XNINF) { return infm; } return value_from_X(p); }); } @@ -255,24 +258,24 @@ convert(J jt, array w, void *yv) -> bool { template <> [[nodiscard]] auto convert(J jt, array w, void *yv, I mode) -> bool { - if (!(w)) return 0; - auto const n = AN(w); - auto const wv = pointer_to_values(w); - auto x = (Q *)yv; - D t; - auto tv = 3 + (S *)&t; + if ((w) == nullptr) return false; + auto const n = AN(w); + auto *const wv = pointer_to_values(w); + auto *x = static_cast(yv); + D t = NAN; + auto *tv = 3 + reinterpret_cast(&t); Q q; for (int64_t i = 0; i < n; ++i) { t = wv[i]; ASSERT(!_isnan(t), EVNAN); bool const neg = 0 > t; - if (neg) t = -t; + if (neg) { t = -t; } q.d = iv1; - if (t == inf) + if (t == inf) { q.n = jtvci(jt, XPINF); - else if (t == 0.0) + } else if (t == 0.0) { q.n = iv0; - else if (1.1102230246251565e-16 < t && t < 9.007199254740992e15) { + } else if (1.1102230246251565e-16 < t && t < 9.007199254740992e15) { auto const d = jround(1 / jtdgcd(jt, 1.0, t)); auto const c = jround(d * t); q = jtqstd(jt, @@ -282,8 +285,8 @@ convert(J jt, array w, void *yv, I mode) -> bool { }); } else { bool const recip = 1 > t; - if (recip) t = 1.0 / t; - auto e = (I)(0xfff0 & *tv); + if (recip) { t = 1.0 / t; } + auto e = static_cast(0xfff0 & *tv); e >>= 4; e -= 1023; if (recip) { @@ -294,7 +297,7 @@ convert(J jt, array w, void *yv, I mode) -> bool { q.d = jtca(jt, iv1); } } - if (neg) inplace_negate(pointer_to_values(q.n), AN(q.n)); + if (neg) { inplace_negate(pointer_to_values(q.n), AN(q.n)); } *x++ = q; } return !jt->jerr; @@ -303,11 +306,11 @@ convert(J jt, array w, void *yv, I mode) -> bool { template <> [[nodiscard]] auto convert(J jt, array w, void *yv) -> bool { - auto const xb = (D)XBASE; - auto const wn = AN(w); - auto const wv = pointer_to_values(w); - auto const x = (D *)yv; - auto const nn = 308 / XBASEN; + auto const xb = static_cast(XBASE); + auto const wn = AN(w); + auto *const wv = pointer_to_values(w); + auto *const x = static_cast(yv); + auto const nn = 308 / XBASEN; // TODO: figure out nice algorithm for this auto const add_digits = [&](auto n, auto v) { @@ -317,44 +320,45 @@ convert(J jt, array w, void *yv) -> bool { return d; }; - X x2 = 0; + X x2 = nullptr; for (int64_t i = 0; i < wn; ++i) { - auto const p = wv[i].n; + auto *const p = wv[i].n; auto const pn = AN(p); auto const k = 1 == pn ? pointer_to_values(p)[0] : 0; - auto const q = wv[i].d; + auto *const q = wv[i].d; auto const qn = AN(q); - if (k == XPINF) + if (k == XPINF) { x[i] = inf; - else if (k == XNINF) + } else if (k == XNINF) { x[i] = infm; - else if (pn <= nn && qn <= nn) { + } else if (pn <= nn && qn <= nn) { auto const n = add_digits(pn, pointer_to_values(p)); auto const d = add_digits(qn, pointer_to_values(q)); x[i] = n / d; } else { - if (!x2) - if (!(x2 = jtxc(jt, 2L))) return 0; + if (x2 == nullptr) { + if ((x2 = jtxc(jt, 2L)) == nullptr) return false; + } auto const k = 5 + qn; - auto c = jtxdiv(jt, jttake(jt, jtsc(jt, -(k + pn)), p), q, XMFLR); - if (!c) return 0; + auto *c = jtxdiv(jt, jttake(jt, jtsc(jt, -(k + pn)), p), q, XMFLR); + if (c == nullptr) return false; auto const cn = AN(c); auto const m = MIN(cn, 5); auto const r = cn - (m + k); - auto const v = pointer_to_values(c) + cn - m; + auto *const v = pointer_to_values(c) + cn - m; auto const n = add_digits(m, v); auto d = std::pow(xb, std::abs(r)); x[i] = 0 > r ? n / d : n * d; } } - return 1; + return true; } template <> [[nodiscard]] auto convert(J jt, array w, void *yv) -> bool { - auto v = pointer_to_values(w); - auto x = (X *)yv; + auto *v = pointer_to_values(w); + auto *x = static_cast(yv); DQ(AN(w), if (!(jtequ(jt, iv1, v->d))) return 0; *x++ = v->n; ++v;); return !jt->jerr; } @@ -362,51 +366,49 @@ convert(J jt, array w, void *yv) -> bool { template auto set_real_part(Z *z, int64_t n, T *t) { - for (int64_t i = 0; i < n; ++i) z[i].re = t[i]; + for (int64_t i = 0; i < n; ++i) { z[i].re = t[i]; } } // Imaginary parts have already been cleared template <> [[nodiscard]] auto convert(J jt, array w, void *yv) -> bool { - set_real_part(static_cast(yv), AN(w), pointer_to_values(w)); - return 1; + set_real_part(static_cast(yv), AN(w), pointer_to_values(w)); + return true; } // Convert the data in w to the type t. w and t must be noun types. A new buffer is always created (with a // copy of the data if w is already of the right type), and returned in *y. Result is // 0 if error, 1 if success. If the conversion loses precision, error is returned // Calls through bcvt are tagged with a flag in jt, indicating to set fuzz=0 -B -jtccvt(J jt, I tflagged, array w, array *y) { +auto +jtccvt(J jt, I tflagged, array w, array *y) -> bool { FPREFIP; I const t = tflagged & NOUN; - if (!w) return 0; - auto const r = AR(w); - auto const s = AS(w); + if (w == nullptr) return false; + auto const r = AR(w); + auto *const s = AS(w); if (((t | AT(w)) & SPARSE) != 0) { // Handle sparse RANK2T oqr = jt->ranks; RESETRANK; - switch ((t & SPARSE ? 2 : 0) + (AT(w) & SPARSE ? 1 : 0)) { - I t1; - P *wp, *yp; + switch (((t & SPARSE) != 0 ? 2 : 0) + (AT(w) & SPARSE ? 1 : 0)) { case 1: RZ(w = jtdenseit(jt, w)); break; // sparse to dense case 2: RZ(*y = jtsparseit(jt, jtcvt(jt, DTYPE(t), w), IX(r), jtcvt(jt, DTYPE(t), jfalse))); jt->ranks = oqr; - return 1; // dense to sparse; convert type first (even if same dtype) + return true; // dense to sparse; convert type first (even if same dtype) case 3: // sparse to sparse - t1 = DTYPE(t); + I t1 = DTYPE(t); GASPARSE(*y, t, 1, r, s); - yp = pointer_to_values

(*y); - wp = pointer_to_values

(w); + P *yp = pointer_to_values

(*y); + P *wp = pointer_to_values

(w); SPB(yp, a, jtca(jt, SPA(wp, a))); SPB(yp, i, jtca(jt, SPA(wp, i))); SPB(yp, e, jtcvt(jt, t1, SPA(wp, e))); SPB(yp, x, jtcvt(jt, t1, SPA(wp, x))); jt->ranks = oqr; - return 1; + return true; } jt->ranks = oqr; } @@ -414,40 +416,43 @@ jtccvt(J jt, I tflagged, array w, array *y) { auto const wt = AT(w); // If type is already correct, return a clone - used to force a copy. Should get rid of this kludge if (TYPESEQ(t, wt)) { - RZ(*y = jtca(jt, w)); - return 1; + *y = jtca(jt, w); + return *y != nullptr; } // Kludge on behalf of result assembly: we want to be able to stop converting after the valid cells. If // NOUNCVTVALIDCT is set in the type, we use the input *y as as override on the # cells to convert. We use it to // replace n (for use here) and yv, and AK(w) and AN(w) for the subroutines. If NOUNCVTVALIDCT is set, w is // modified: the caller must restore AN(w) and AK(w) if it needs it // TODO: same-length conversion could be done in place - auto n = AN(w); - array d; - GA(d, t, n, r, s); - auto yv = pointer_to_values(d); // allocate the same # atoms, even if we will convert fewer - if (tflagged & NOUNCVTVALIDCT) { - I inputn = *(I *)y; // fetch input, in case it is called for - if (inputn > 0) { // if converting the leading values, just update the counts - n = inputn; // set the counts for local use, and in the block to be converted - } else { // if converting trailing values... + auto n = AN(w); + array d = jtga(jt, t, n, r, s); + if (!d) return false; + auto *yv = pointer_to_values(d); // allocate the same # atoms, even if we will convert fewer + if ((tflagged & NOUNCVTVALIDCT) != 0) { + I inputn = *reinterpret_cast(y); // fetch input, in case it is called for + if (inputn > 0) { // if converting the leading values, just update the counts + n = inputn; // set the counts for local use, and in the block to be converted + } else { // if converting trailing values... AK(w) += (n + inputn) << bplg(wt); - yv = (I *)((C *)yv + ((n + inputn) << bplg(t))); // advance input and output pointers to new area - n = -inputn; // get positive # atoms to convert + yv = reinterpret_cast(static_cast(yv) + + ((n + inputn) << bplg(t))); // advance input and output pointers to new area + n = -inputn; // get positive # atoms to convert } AN(w) = n; // change atomct of w to # atoms to convert } // If n and AN have been modified, it doesn't matter for rank-1 arguments whether the shape of the result is listed // as n or s[0] since only n atoms will be used. For higher ranks, we need the shape from s. So it's just as well // that we take the shape from s now - *y = d; - auto wv = pointer_to_values(w); // return the address of the new block - if (t & CMPX) jtfillv(jt, t, n, (C *)yv); // why?? just fill in imaginary parts as we need to - if (!n) return 1; + *y = d; + auto *wv = pointer_to_values(w); // return the address of the new block + if ((t & CMPX) != 0) { + jtfillv(jt, t, n, static_cast(yv)); // why?? just fill in imaginary parts as we need to + } + if (n == 0) return true; // Perform the conversion based on data types // For branch-table efficiency, we split the C2T and C4T and BIT conversions into one block, and // the rest in another - if ((t | wt) & (C2T + C4T + BIT + SBT)) { + if (((t | wt) & (C2T + C4T + BIT + SBT)) != 0) { // there are no SBT conversions, but we have to show domain error we // must account for all NOUN types. Low 8 bits have most of them, and // we know type can't be sparse. This picks up the others @@ -463,20 +468,24 @@ jtccvt(J jt, I tflagged, array w, array *y) { } } switch (CVCASE(CTTZ(t), CTTZ(wt))) { - case CVCASE(INTX, B01X): std::copy_n(static_cast(wv), n, static_cast(yv)); return 1; + case CVCASE(INTX, B01X): std::copy_n(static_cast(wv), n, static_cast(yv)); return true; case CVCASE(XNUMX, B01X): return convert(jt, w, yv); case CVCASE(RATX, B01X): GATV(d, XNUM, n, r, s); return convert(jt, w, pointer_to_values(d)) && convert(jt, d, yv); - case CVCASE(FLX, B01X): std::copy_n(static_cast(wv), n, static_cast(yv)); return 1; - case CVCASE(CMPXX, B01X): set_real_part(static_cast(yv), n, static_cast(wv)); return 1; + case CVCASE(FLX, B01X): std::copy_n(static_cast(wv), n, static_cast(yv)); return true; + case CVCASE(CMPXX, B01X): set_real_part(static_cast(yv), n, static_cast(wv)); return true; case CVCASE(B01X, INTX): return convert(jt, w, yv); case CVCASE(XNUMX, INTX): return convert(jt, w, yv); - case CVCASE(RATX, INTX): GATV(d, XNUM, n, r, s); return convert(jt, w, pointer_to_values(d)) && convert(jt, d, yv); - case CVCASE(FLX, INTX): std::copy_n(static_cast(wv), n, static_cast(yv)); return 1; - case CVCASE(CMPXX, INTX): set_real_part(static_cast(yv), n, static_cast(wv)); return 1; - case CVCASE(B01X, FLX): return convert(jt, w, yv, (I)jtinplace & JTNOFUZZ ? 0.0 : FUZZ); - case CVCASE(INTX, FLX): return convert(jt, w, yv, (I)jtinplace & JTNOFUZZ ? 0.0 : FUZZ); + case CVCASE(RATX, INTX): + GATV(d, XNUM, n, r, s); + return convert(jt, w, pointer_to_values(d)) && convert(jt, d, yv); + case CVCASE(FLX, INTX): std::copy_n(static_cast(wv), n, static_cast(yv)); return true; + case CVCASE(CMPXX, INTX): set_real_part(static_cast(yv), n, static_cast(wv)); return true; + case CVCASE(B01X, FLX): + return convert(jt, w, yv, ((I)jtinplace & JTNOFUZZ) != 0 ? 0.0 : FUZZ); + case CVCASE(INTX, FLX): + return convert(jt, w, yv, ((I)jtinplace & JTNOFUZZ) != 0 ? 0.0 : FUZZ); case CVCASE(XNUMX, FLX): return convert( jt, w, yv, (jt->xmode & REPSGN(SGNIFNOT(tflagged, XCVTXNUMORIDEX))) | (tflagged >> XCVTXNUMCVX)); @@ -486,44 +495,53 @@ jtccvt(J jt, I tflagged, array w, array *y) { case CVCASE(CMPXX, FLX): return convert(jt, w, yv); case CVCASE(B01X, CMPXX): GATV(d, FL, n, r, s); - if (!(convert(jt, w, pointer_to_values(d), (I)jtinplace & JTNOFUZZ ? 0.0 : FUZZ))) return 0; - return convert(jt, d, yv, (I)jtinplace & JTNOFUZZ ? 0.0 : FUZZ); + if (!(convert(jt, w, pointer_to_values(d), ((I)jtinplace & JTNOFUZZ) != 0 ? 0.0 : FUZZ))) { + return false; + } + return convert(jt, d, yv, ((I)jtinplace & JTNOFUZZ) != 0 ? 0.0 : FUZZ); case CVCASE(INTX, CMPXX): GATV(d, FL, n, r, s); - if (!(convert(jt, w, pointer_to_values(d), (I)jtinplace & JTNOFUZZ ? 0.0 : FUZZ))) return 0; - return convert(jt, d, yv, (I)jtinplace & JTNOFUZZ ? 0.0 : FUZZ); + if (!(convert(jt, w, pointer_to_values(d), ((I)jtinplace & JTNOFUZZ) != 0 ? 0.0 : FUZZ))) { + return false; + } + return convert(jt, d, yv, ((I)jtinplace & JTNOFUZZ) != 0 ? 0.0 : FUZZ); case CVCASE(XNUMX, CMPXX): GATV(d, FL, n, r, s); - if (!(convert(jt, w, pointer_to_values(d), (I)jtinplace & JTNOFUZZ ? 0.0 : FUZZ))) return 0; + if (!(convert(jt, w, pointer_to_values(d), ((I)jtinplace & JTNOFUZZ) != 0 ? 0.0 : FUZZ))) { + return false; + } return convert( jt, d, yv, (jt->xmode & REPSGN(SGNIFNOT(tflagged, XCVTXNUMORIDEX))) | (tflagged >> XCVTXNUMCVX)); case CVCASE(RATX, CMPXX): GATV(d, FL, n, r, s); - if (!(convert(jt, w, pointer_to_values(d), (I)jtinplace & JTNOFUZZ ? 0.0 : FUZZ))) return 0; + if (!(convert(jt, w, pointer_to_values(d), ((I)jtinplace & JTNOFUZZ) != 0 ? 0.0 : FUZZ))) { + return false; + } return convert( jt, d, yv, (jt->xmode & REPSGN(SGNIFNOT(tflagged, XCVTXNUMORIDEX))) | (tflagged >> XCVTXNUMCVX)); - case CVCASE(FLX, CMPXX): return convert(jt, w, yv, (I)jtinplace & JTNOFUZZ ? 0.0 : FUZZ); + case CVCASE(FLX, CMPXX): + return convert(jt, w, yv, ((I)jtinplace & JTNOFUZZ) != 0 ? 0.0 : FUZZ); case CVCASE(B01X, XNUMX): return convert(jt, w, yv); case CVCASE(INTX, XNUMX): return convert(jt, w, yv); case CVCASE(RATX, XNUMX): return convert(jt, w, yv); case CVCASE(FLX, XNUMX): return convert(jt, w, yv); case CVCASE(CMPXX, XNUMX): GATV(d, FL, n, r, s); - if (!(convert(jt, w, pointer_to_values(d)))) return 0; + if (!(convert(jt, w, pointer_to_values(d)))) return false; return convert(jt, d, yv); case CVCASE(B01X, RATX): GATV(d, XNUM, n, r, s); - if (!(convert(jt, w, pointer_to_values(d)))) return 0; + if (!(convert(jt, w, pointer_to_values(d)))) return false; return convert(jt, d, yv); case CVCASE(INTX, RATX): GATV(d, XNUM, n, r, s); - if (!(convert(jt, w, pointer_to_values(d)))) return 0; + if (!(convert(jt, w, pointer_to_values(d)))) return false; return convert(jt, d, yv); case CVCASE(XNUMX, RATX): return convert(jt, w, yv); case CVCASE(FLX, RATX): return convert(jt, w, yv); case CVCASE(CMPXX, RATX): GATV(d, FL, n, r, s); - if (!(convert(jt, w, pointer_to_values(d)))) return 0; + if (!(convert(jt, w, pointer_to_values(d)))) return false; return convert(jt, d, yv); default: ASSERT(0, EVDOMAIN); } @@ -532,8 +550,8 @@ jtccvt(J jt, I tflagged, array w, array *y) { // clear rank before calling ccvt - needed for sparse arrays only but returns the block as the result auto jtcvt(J jt, I t, array w) -> array { - array y; - bool const b = jtccvt(jt, t, w, &y); + array y = nullptr; + bool const b = jtccvt(jt, t, w, &y);; ASSERT(b, EVDOMAIN); return y; } @@ -545,7 +563,7 @@ jtcvt(J jt, I t, array w) -> array { auto jtbcvt(J jt, C mode, array w) -> array { FPREFIP; - if (!w) return 0; + if (w == nullptr) { return nullptr; } auto const as_integer = [](auto const &v) { return *(I *)&v; }; auto const isflag = [&](auto const &z) { return as_integer(z.im) == NANFLAG; }; @@ -557,19 +575,20 @@ jtbcvt(J jt, C mode, array w) -> array { // convert the flagged values to float and keep the result as complex array result = w; if ((((AN(w) - 1) | ((AT(w) & CMPX) - 1))) >= 0) { // not empty AND complex - Z *wv = pointer_to_values(w); + Z *wv = pointer_to_values(w); // FIXME: get proper c++17 support // auto flags = std::transform_reduce(wv, wv + AN(w), int64_t{}, std::plus{}, isflag); auto flags = std::accumulate(wv, wv + AN(w), int64_t{}, [&](auto sum, auto v) { return sum + isflag(v); }); - if (flags) { + if (flags != 0) { I ipok = SGNIF(jtinplace, JTINPLACEWX) & AC(w); // both sign bits set (<0) if inplaceable if (flags == AN(w)) { if (ipok >= 0) GATV(result, INT, AN(w), AR(w), AS(w)); - std::transform(wv, wv + AN(w), pointer_to_values(result), [&](auto const &z) { return as_integer(z.re); }); + std::transform( + wv, wv + AN(w), pointer_to_values(result), [&](auto const &z) { return as_integer(z.re); }); } else { if (ipok >= 0) GATV(result, CMPX, AN(w), AR(w), AS(w)); std::transform(wv, wv + AN(w), pointer_to_values(result), [&](auto const &z) -> Z { - if (isflag(z)) return {.re = (D)as_integer(z.re), .im = 0.0}; + if (isflag(z)) { return {.re = (D)as_integer(z.re), .im = 0.0}; }; return z; // copy floats, and converts any integers back to float }); } @@ -577,14 +596,14 @@ jtbcvt(J jt, C mode, array w) -> array { } } // for all numerics, try Boolean/int/float in order, stopping when we find one that holds the data - if (mode & 1 || !(AT(w) & XNUM + RAT)) { // if we are not stopping at XNUM/RAT + if (((mode & 1) != 0) || ((AT(w) & (XNUM + RAT)) == 0)) { // if we are not stopping at XNUM/RAT // To avoid a needless copy, suppress conversion to B01 if type is B01, to INT if type is INT, etc // set the NOFUZZ flag in jt to insist on an exact match so we won't lose precision - array y; + array y = nullptr; jtinplace = (J)((I)jt + JTNOFUZZ); // demand exact match - result = !(mode & 14) && jtccvt(jtinplace, B01, w, &y) ? y - : (y = w, AT(w) & INT || (!(mode & 12) && jtccvt(jtinplace, INT, w, &y))) ? y - : (y = w, AT(w) & FL || (!(mode & 8) && jtccvt(jtinplace, FL, w, &y))) + result = ((mode & 14) == 0) && jtccvt(jtinplace, B01, w, &y) ? y + : (y = w, AT(w) & INT || (((mode & 12) == 0) && jtccvt(jtinplace, INT, w, &y))) ? y + : (y = w, AT(w) & FL || (((mode & 8) == 0) && jtccvt(jtinplace, FL, w, &y))) ? y : w; // convert to enabled modes one by one, stopping when one works } @@ -593,15 +612,17 @@ jtbcvt(J jt, C mode, array w) -> array { auto jticvt(J jt, array w) -> array { - auto const n = AN(w); - auto const* v = pointer_to_values(w); - array z; + auto const n = AN(w); + auto const *v = pointer_to_values(w); + array z = nullptr; GATV(z, INT, n, AR(w), AS(w)); - auto u = pointer_to_values(z); + auto *u = pointer_to_values(z); for (int64_t i = 0; i < n; ++i) { auto x = *v++; - if (x < IMIN || FLIMAX <= x) return w; // if conversion will fail, skip it - *u++ = (I)x; + if (x < IMIN || FLIMAX <= x) { + return w; // if conversion will fail, skip it + } + *u++ = static_cast(x); } return z; } @@ -610,7 +631,7 @@ auto jtpcvt(J jt, I t, array w) -> array { RANK2T oqr = jt->ranks; RESETRANK; - array y; + array y = nullptr; bool const b = jtccvt(jt, t, w, &y); jt->ranks = oqr; return b ? y : w; @@ -619,9 +640,9 @@ jtpcvt(J jt, I t, array w) -> array { auto jtcvt0(J jt, array w) -> array { auto const t = AT(w); - auto const n = (t & CMPX) ? 2 * AN(w) : AN(w); - if (n && t & FL + CMPX) { - auto u = pointer_to_values(w); + auto const n = (t & CMPX) != 0 ? 2 * AN(w) : AN(w); + if ((n != 0) && ((t & (FL + CMPX)) != 0)) { + auto *u = pointer_to_values(w); std::transform(u, u + n, u, [](auto v) { return v == 0.0 ? 0.0 : v; }); } return w; @@ -630,24 +651,24 @@ jtcvt0(J jt, array w) -> array { auto jtxco1(J jt, array w) -> array { ASSERT(AT(w) & DENSE, EVNONCE); - return jtcvt(jt, AT(w) & B01 + INT + XNUM ? XNUM : RAT, w); + return jtcvt(jt, AT(w) & (B01 + INT + XNUM) ? XNUM : RAT, w); } auto jtxco2(J jt, array a, array w) -> array { ASSERT(AT(w) & DENSE, EVNONCE); - I j; + I j = 0; RE(j = jti0(jt, a)); switch (j) { case -2: return jtaslash1(jt, CDIV, w); case -1: return jtbcvt(jt, 1, w); case 1: return jtxco1(jt, w); case 2: - if (!(AT(w) & RAT)) RZ(w = jtcvt(jt, RAT, w)); + if ((AT(w) & RAT) == 0) RZ(w = jtcvt(jt, RAT, w)); { auto const n = AN(w); auto const r = AR(w); - array z; + array z = nullptr; GATV(z, XNUM, 2 * n, r + 1, AS(w)); AS(z)[r] = 2; memcpy(pointer_to_values(z), pointer_to_values(w), 2 * n * SZI); From b528de242d933359830195de16c6f4b66c50075a Mon Sep 17 00:00:00 2001 From: Juho Eerola Date: Sun, 7 Mar 2021 13:48:31 +0200 Subject: [PATCH 20/39] Add stdbool.h and extern "C" guards in j.h --- jsrc/j.h | 10 ++++++++++ jsrc/je.h | 2 +- 2 files changed, 11 insertions(+), 1 deletion(-) diff --git a/jsrc/j.h b/jsrc/j.h index 7a3a6dfa..95244680 100644 --- a/jsrc/j.h +++ b/jsrc/j.h @@ -3,6 +3,12 @@ /* */ /* Global Definitions */ +#ifdef __cplusplus +extern "C" { +#else +#include +#endif + #if defined(__clang_major__) && !defined(__clang__) #error need workaround by define __clang__ in preprocessor macro #endif @@ -1135,3 +1141,7 @@ _clearfp(void) { // Create (x&y) where x and y are signed, so we can test for overflow. #define XANDY(x, y) ((I)((UI)(x) & (UI)(y))) + +#ifdef __cplusplus +} +#endif diff --git a/jsrc/je.h b/jsrc/je.h index 080705df..344fa04e 100644 --- a/jsrc/je.h +++ b/jsrc/je.h @@ -551,7 +551,7 @@ extern A jtcreatecycliciterator(J, A, A); extern A jtcrelocalsyms(J, A, A, I, I, I); extern A jtcstr(J, C*); extern A jtcvt(J, I, A); -extern B jtccvt(J, I, A, A*); +extern bool jtccvt(J, I, A, A*); extern A jtcvz(J, I, A); extern A jtdaxis(J, I, A); extern A jtddtokens(J, A, I); From 079d17173c16e8b16fc6b9079471905611068753 Mon Sep 17 00:00:00 2001 From: Juho Eerola Date: Sun, 7 Mar 2021 15:12:36 +0200 Subject: [PATCH 21/39] Chain conversion pairs with && --- jsrc/conversions.cpp | 53 ++++++++++++++++---------------------------- 1 file changed, 19 insertions(+), 34 deletions(-) diff --git a/jsrc/conversions.cpp b/jsrc/conversions.cpp index 0531d1f3..45eaaa35 100644 --- a/jsrc/conversions.cpp +++ b/jsrc/conversions.cpp @@ -398,7 +398,7 @@ jtccvt(J jt, I tflagged, array w, array *y) -> bool { RZ(*y = jtsparseit(jt, jtcvt(jt, DTYPE(t), w), IX(r), jtcvt(jt, DTYPE(t), jfalse))); jt->ranks = oqr; return true; // dense to sparse; convert type first (even if same dtype) - case 3: // sparse to sparse + case 3: // sparse to sparse I t1 = DTYPE(t); GASPARSE(*y, t, 1, r, s); P *yp = pointer_to_values

(*y); @@ -482,10 +482,8 @@ jtccvt(J jt, I tflagged, array w, array *y) -> bool { return convert(jt, w, pointer_to_values(d)) && convert(jt, d, yv); case CVCASE(FLX, INTX): std::copy_n(static_cast(wv), n, static_cast(yv)); return true; case CVCASE(CMPXX, INTX): set_real_part(static_cast(yv), n, static_cast(wv)); return true; - case CVCASE(B01X, FLX): - return convert(jt, w, yv, ((I)jtinplace & JTNOFUZZ) != 0 ? 0.0 : FUZZ); - case CVCASE(INTX, FLX): - return convert(jt, w, yv, ((I)jtinplace & JTNOFUZZ) != 0 ? 0.0 : FUZZ); + case CVCASE(B01X, FLX): return convert(jt, w, yv, ((I)jtinplace & JTNOFUZZ) != 0 ? 0.0 : FUZZ); + case CVCASE(INTX, FLX): return convert(jt, w, yv, ((I)jtinplace & JTNOFUZZ) != 0 ? 0.0 : FUZZ); case CVCASE(XNUMX, FLX): return convert( jt, w, yv, (jt->xmode & REPSGN(SGNIFNOT(tflagged, XCVTXNUMORIDEX))) | (tflagged >> XCVTXNUMCVX)); @@ -495,54 +493,41 @@ jtccvt(J jt, I tflagged, array w, array *y) -> bool { case CVCASE(CMPXX, FLX): return convert(jt, w, yv); case CVCASE(B01X, CMPXX): GATV(d, FL, n, r, s); - if (!(convert(jt, w, pointer_to_values(d), ((I)jtinplace & JTNOFUZZ) != 0 ? 0.0 : FUZZ))) { - return false; - } - return convert(jt, d, yv, ((I)jtinplace & JTNOFUZZ) != 0 ? 0.0 : FUZZ); + return convert(jt, w, pointer_to_values(d), ((I)jtinplace & JTNOFUZZ) != 0 ? 0.0 : FUZZ) && + convert(jt, d, yv, ((I)jtinplace & JTNOFUZZ) != 0 ? 0.0 : FUZZ); case CVCASE(INTX, CMPXX): GATV(d, FL, n, r, s); - if (!(convert(jt, w, pointer_to_values(d), ((I)jtinplace & JTNOFUZZ) != 0 ? 0.0 : FUZZ))) { - return false; - } - return convert(jt, d, yv, ((I)jtinplace & JTNOFUZZ) != 0 ? 0.0 : FUZZ); + return convert(jt, w, pointer_to_values(d), ((I)jtinplace & JTNOFUZZ) != 0 ? 0.0 : FUZZ) && + convert(jt, d, yv, ((I)jtinplace & JTNOFUZZ) != 0 ? 0.0 : FUZZ); case CVCASE(XNUMX, CMPXX): GATV(d, FL, n, r, s); - if (!(convert(jt, w, pointer_to_values(d), ((I)jtinplace & JTNOFUZZ) != 0 ? 0.0 : FUZZ))) { - return false; - } - return convert( - jt, d, yv, (jt->xmode & REPSGN(SGNIFNOT(tflagged, XCVTXNUMORIDEX))) | (tflagged >> XCVTXNUMCVX)); + return convert(jt, w, pointer_to_values(d), ((I)jtinplace & JTNOFUZZ) != 0 ? 0.0 : FUZZ) && + convert( + jt, d, yv, (jt->xmode & REPSGN(SGNIFNOT(tflagged, XCVTXNUMORIDEX))) | (tflagged >> XCVTXNUMCVX)); case CVCASE(RATX, CMPXX): GATV(d, FL, n, r, s); - if (!(convert(jt, w, pointer_to_values(d), ((I)jtinplace & JTNOFUZZ) != 0 ? 0.0 : FUZZ))) { - return false; - } - return convert( - jt, d, yv, (jt->xmode & REPSGN(SGNIFNOT(tflagged, XCVTXNUMORIDEX))) | (tflagged >> XCVTXNUMCVX)); - case CVCASE(FLX, CMPXX): - return convert(jt, w, yv, ((I)jtinplace & JTNOFUZZ) != 0 ? 0.0 : FUZZ); + return convert(jt, w, pointer_to_values(d), ((I)jtinplace & JTNOFUZZ) != 0 ? 0.0 : FUZZ) && + convert( + jt, d, yv, (jt->xmode & REPSGN(SGNIFNOT(tflagged, XCVTXNUMORIDEX))) | (tflagged >> XCVTXNUMCVX)); + case CVCASE(FLX, CMPXX): return convert(jt, w, yv, ((I)jtinplace & JTNOFUZZ) != 0 ? 0.0 : FUZZ); case CVCASE(B01X, XNUMX): return convert(jt, w, yv); case CVCASE(INTX, XNUMX): return convert(jt, w, yv); case CVCASE(RATX, XNUMX): return convert(jt, w, yv); case CVCASE(FLX, XNUMX): return convert(jt, w, yv); case CVCASE(CMPXX, XNUMX): GATV(d, FL, n, r, s); - if (!(convert(jt, w, pointer_to_values(d)))) return false; - return convert(jt, d, yv); + return convert(jt, w, pointer_to_values(d)) && convert(jt, d, yv); case CVCASE(B01X, RATX): GATV(d, XNUM, n, r, s); - if (!(convert(jt, w, pointer_to_values(d)))) return false; - return convert(jt, d, yv); + return convert(jt, w, pointer_to_values(d)) && convert(jt, d, yv); case CVCASE(INTX, RATX): GATV(d, XNUM, n, r, s); - if (!(convert(jt, w, pointer_to_values(d)))) return false; - return convert(jt, d, yv); + return convert(jt, w, pointer_to_values(d)) && convert(jt, d, yv); case CVCASE(XNUMX, RATX): return convert(jt, w, yv); case CVCASE(FLX, RATX): return convert(jt, w, yv); case CVCASE(CMPXX, RATX): GATV(d, FL, n, r, s); - if (!(convert(jt, w, pointer_to_values(d)))) return false; - return convert(jt, d, yv); + return convert(jt, w, pointer_to_values(d)) && convert(jt, d, yv); default: ASSERT(0, EVDOMAIN); } } @@ -551,7 +536,7 @@ jtccvt(J jt, I tflagged, array w, array *y) -> bool { auto jtcvt(J jt, I t, array w) -> array { array y = nullptr; - bool const b = jtccvt(jt, t, w, &y);; + bool const b = jtccvt(jt, t, w, &y); ASSERT(b, EVDOMAIN); return y; } From acc08bad173e2c302d7a664e0c95f9803ee61a38 Mon Sep 17 00:00:00 2001 From: Juho Eerola Date: Sun, 7 Mar 2021 15:24:36 +0200 Subject: [PATCH 22/39] Inline `pointer_to_values()` with correct types --- jsrc/conversions.cpp | 11 +++++------ 1 file changed, 5 insertions(+), 6 deletions(-) diff --git a/jsrc/conversions.cpp b/jsrc/conversions.cpp index 45eaaa35..0b9c07cb 100644 --- a/jsrc/conversions.cpp +++ b/jsrc/conversions.cpp @@ -444,7 +444,6 @@ jtccvt(J jt, I tflagged, array w, array *y) -> bool { // as n or s[0] since only n atoms will be used. For higher ranks, we need the shape from s. So it's just as well // that we take the shape from s now *y = d; - auto *wv = pointer_to_values(w); // return the address of the new block if ((t & CMPX) != 0) { jtfillv(jt, t, n, static_cast(yv)); // why?? just fill in imaginary parts as we need to } @@ -468,20 +467,20 @@ jtccvt(J jt, I tflagged, array w, array *y) -> bool { } } switch (CVCASE(CTTZ(t), CTTZ(wt))) { - case CVCASE(INTX, B01X): std::copy_n(static_cast(wv), n, static_cast(yv)); return true; + case CVCASE(INTX, B01X): std::copy_n(pointer_to_values(w), n, static_cast(yv)); return true; case CVCASE(XNUMX, B01X): return convert(jt, w, yv); case CVCASE(RATX, B01X): GATV(d, XNUM, n, r, s); return convert(jt, w, pointer_to_values(d)) && convert(jt, d, yv); - case CVCASE(FLX, B01X): std::copy_n(static_cast(wv), n, static_cast(yv)); return true; - case CVCASE(CMPXX, B01X): set_real_part(static_cast(yv), n, static_cast(wv)); return true; + case CVCASE(FLX, B01X): std::copy_n(pointer_to_values(w), n, static_cast(yv)); return true; + case CVCASE(CMPXX, B01X): set_real_part(static_cast(yv), n, pointer_to_values(w)); return true; case CVCASE(B01X, INTX): return convert(jt, w, yv); case CVCASE(XNUMX, INTX): return convert(jt, w, yv); case CVCASE(RATX, INTX): GATV(d, XNUM, n, r, s); return convert(jt, w, pointer_to_values(d)) && convert(jt, d, yv); - case CVCASE(FLX, INTX): std::copy_n(static_cast(wv), n, static_cast(yv)); return true; - case CVCASE(CMPXX, INTX): set_real_part(static_cast(yv), n, static_cast(wv)); return true; + case CVCASE(FLX, INTX): std::copy_n(pointer_to_values(w), n, static_cast(yv)); return true; + case CVCASE(CMPXX, INTX): set_real_part(static_cast(yv), n, pointer_to_values(w)); return true; case CVCASE(B01X, FLX): return convert(jt, w, yv, ((I)jtinplace & JTNOFUZZ) != 0 ? 0.0 : FUZZ); case CVCASE(INTX, FLX): return convert(jt, w, yv, ((I)jtinplace & JTNOFUZZ) != 0 ? 0.0 : FUZZ); case CVCASE(XNUMX, FLX): From 3b340f7726bee237db29601984122f2d722e9b4f Mon Sep 17 00:00:00 2001 From: Juho Eerola Date: Sun, 7 Mar 2021 15:57:43 +0200 Subject: [PATCH 23/39] Remove pointer_to_values() type parameter default --- jsrc/array.hpp | 4 ++-- jsrc/conversions.cpp | 46 ++++++++++++++++++++++---------------------- 2 files changed, 25 insertions(+), 25 deletions(-) diff --git a/jsrc/array.hpp b/jsrc/array.hpp index b4787816..f7e5d46d 100644 --- a/jsrc/array.hpp +++ b/jsrc/array.hpp @@ -35,7 +35,7 @@ num(int64_t n) { return reinterpret_cast(Bnum[n - NUMMIN]); } -template +template [[nodiscard]] inline auto pointer_to_values(array x) -> Value* { return reinterpret_cast(reinterpret_cast(x) + x->kchain.k); @@ -50,7 +50,7 @@ is_sparse(array x) noexcept -> bool { template auto set_value_at(array x, int32_t index, T const& value) -> void { - pointer_to_values(x)[index] = value; + pointer_to_values(x)[index] = value; } // TODO: remove eventually, temporary while c_types exist diff --git a/jsrc/conversions.cpp b/jsrc/conversions.cpp index 0b9c07cb..8f63436e 100644 --- a/jsrc/conversions.cpp +++ b/jsrc/conversions.cpp @@ -174,7 +174,7 @@ jtxd1(J jt, D p, I mode) -> X { if (p == -inf) { return jtvci(jt, XNINF); } array t = make_array(jt, 30, 1); if (!t) return 0; - auto *u = pointer_to_values(t); + auto *u = pointer_to_values(t); int64_t m = 0; auto d = std::abs(p); while (0 < d) { @@ -184,7 +184,7 @@ jtxd1(J jt, D p, I mode) -> X { d = q; if (m == AN(t)) { RZ(t = jtext(jt, 0, t)); - u = pointer_to_values(t); + u = pointer_to_values(t); } } if (m == 0) { @@ -208,7 +208,7 @@ template <> convert(J jt, array w, void *yv) -> bool { auto *v = pointer_to_values(w); auto *x = static_cast(yv); - DO(AN(w), array q = v[i]; I e = pointer_to_values(q)[0]; if ((AN(q) ^ 1) | (e & -2)) return false; x[i] = (B)e;); + DO(AN(w), array q = v[i]; I e = pointer_to_values(q)[0]; if ((AN(q) ^ 1) | (e & -2)) return false; x[i] = (B)e;); return true; } @@ -216,7 +216,7 @@ template [[nodiscard]] static auto value_from_X(X p) -> T { auto const n = AN(p); - auto const v = std::reverse_iterator(pointer_to_values(p) + n); + auto const v = std::reverse_iterator(pointer_to_values(p) + n); return std::accumulate(v, v + n, T{}, [](auto d, auto v) { return v + d * XBASE; }); } @@ -242,7 +242,7 @@ template <> [[nodiscard]] auto convert(J jt, array w, void *yv) -> bool { return convert(jt, w, yv, [](auto p) { - auto const c = pointer_to_values(p)[AN(p) - 1]; + auto const c = pointer_to_values(p)[AN(p) - 1]; if (c == XPINF) { return inf; } if (c == XNINF) { return infm; } return value_from_X(p); @@ -297,7 +297,7 @@ convert(J jt, array w, void *yv, I mode) -> bool { q.d = jtca(jt, iv1); } } - if (neg) { inplace_negate(pointer_to_values(q.n), AN(q.n)); } + if (neg) { inplace_negate(pointer_to_values(q.n), AN(q.n)); } *x++ = q; } return !jt->jerr; @@ -324,7 +324,7 @@ convert(J jt, array w, void *yv) -> bool { for (int64_t i = 0; i < wn; ++i) { auto *const p = wv[i].n; auto const pn = AN(p); - auto const k = 1 == pn ? pointer_to_values(p)[0] : 0; + auto const k = 1 == pn ? pointer_to_values(p)[0] : 0; auto *const q = wv[i].d; auto const qn = AN(q); if (k == XPINF) { @@ -332,8 +332,8 @@ convert(J jt, array w, void *yv) -> bool { } else if (k == XNINF) { x[i] = infm; } else if (pn <= nn && qn <= nn) { - auto const n = add_digits(pn, pointer_to_values(p)); - auto const d = add_digits(qn, pointer_to_values(q)); + auto const n = add_digits(pn, pointer_to_values(p)); + auto const d = add_digits(qn, pointer_to_values(q)); x[i] = n / d; } else { if (x2 == nullptr) { @@ -345,7 +345,7 @@ convert(J jt, array w, void *yv) -> bool { auto const cn = AN(c); auto const m = MIN(cn, 5); auto const r = cn - (m + k); - auto *const v = pointer_to_values(c) + cn - m; + auto *const v = pointer_to_values(c) + cn - m; auto const n = add_digits(m, v); auto d = std::pow(xb, std::abs(r)); x[i] = 0 > r ? n / d : n * d; @@ -471,14 +471,14 @@ jtccvt(J jt, I tflagged, array w, array *y) -> bool { case CVCASE(XNUMX, B01X): return convert(jt, w, yv); case CVCASE(RATX, B01X): GATV(d, XNUM, n, r, s); - return convert(jt, w, pointer_to_values(d)) && convert(jt, d, yv); + return convert(jt, w, pointer_to_values(d)) && convert(jt, d, yv); case CVCASE(FLX, B01X): std::copy_n(pointer_to_values(w), n, static_cast(yv)); return true; case CVCASE(CMPXX, B01X): set_real_part(static_cast(yv), n, pointer_to_values(w)); return true; case CVCASE(B01X, INTX): return convert(jt, w, yv); case CVCASE(XNUMX, INTX): return convert(jt, w, yv); case CVCASE(RATX, INTX): GATV(d, XNUM, n, r, s); - return convert(jt, w, pointer_to_values(d)) && convert(jt, d, yv); + return convert(jt, w, pointer_to_values(d)) && convert(jt, d, yv); case CVCASE(FLX, INTX): std::copy_n(pointer_to_values(w), n, static_cast(yv)); return true; case CVCASE(CMPXX, INTX): set_real_part(static_cast(yv), n, pointer_to_values(w)); return true; case CVCASE(B01X, FLX): return convert(jt, w, yv, ((I)jtinplace & JTNOFUZZ) != 0 ? 0.0 : FUZZ); @@ -492,20 +492,20 @@ jtccvt(J jt, I tflagged, array w, array *y) -> bool { case CVCASE(CMPXX, FLX): return convert(jt, w, yv); case CVCASE(B01X, CMPXX): GATV(d, FL, n, r, s); - return convert(jt, w, pointer_to_values(d), ((I)jtinplace & JTNOFUZZ) != 0 ? 0.0 : FUZZ) && + return convert(jt, w, pointer_to_values(d), ((I)jtinplace & JTNOFUZZ) != 0 ? 0.0 : FUZZ) && convert(jt, d, yv, ((I)jtinplace & JTNOFUZZ) != 0 ? 0.0 : FUZZ); case CVCASE(INTX, CMPXX): GATV(d, FL, n, r, s); - return convert(jt, w, pointer_to_values(d), ((I)jtinplace & JTNOFUZZ) != 0 ? 0.0 : FUZZ) && + return convert(jt, w, pointer_to_values(d), ((I)jtinplace & JTNOFUZZ) != 0 ? 0.0 : FUZZ) && convert(jt, d, yv, ((I)jtinplace & JTNOFUZZ) != 0 ? 0.0 : FUZZ); case CVCASE(XNUMX, CMPXX): GATV(d, FL, n, r, s); - return convert(jt, w, pointer_to_values(d), ((I)jtinplace & JTNOFUZZ) != 0 ? 0.0 : FUZZ) && + return convert(jt, w, pointer_to_values(d), ((I)jtinplace & JTNOFUZZ) != 0 ? 0.0 : FUZZ) && convert( jt, d, yv, (jt->xmode & REPSGN(SGNIFNOT(tflagged, XCVTXNUMORIDEX))) | (tflagged >> XCVTXNUMCVX)); case CVCASE(RATX, CMPXX): GATV(d, FL, n, r, s); - return convert(jt, w, pointer_to_values(d), ((I)jtinplace & JTNOFUZZ) != 0 ? 0.0 : FUZZ) && + return convert(jt, w, pointer_to_values(d), ((I)jtinplace & JTNOFUZZ) != 0 ? 0.0 : FUZZ) && convert( jt, d, yv, (jt->xmode & REPSGN(SGNIFNOT(tflagged, XCVTXNUMORIDEX))) | (tflagged >> XCVTXNUMCVX)); case CVCASE(FLX, CMPXX): return convert(jt, w, yv, ((I)jtinplace & JTNOFUZZ) != 0 ? 0.0 : FUZZ); @@ -515,18 +515,18 @@ jtccvt(J jt, I tflagged, array w, array *y) -> bool { case CVCASE(FLX, XNUMX): return convert(jt, w, yv); case CVCASE(CMPXX, XNUMX): GATV(d, FL, n, r, s); - return convert(jt, w, pointer_to_values(d)) && convert(jt, d, yv); + return convert(jt, w, pointer_to_values(d)) && convert(jt, d, yv); case CVCASE(B01X, RATX): GATV(d, XNUM, n, r, s); - return convert(jt, w, pointer_to_values(d)) && convert(jt, d, yv); + return convert(jt, w, pointer_to_values(d)) && convert(jt, d, yv); case CVCASE(INTX, RATX): GATV(d, XNUM, n, r, s); - return convert(jt, w, pointer_to_values(d)) && convert(jt, d, yv); + return convert(jt, w, pointer_to_values(d)) && convert(jt, d, yv); case CVCASE(XNUMX, RATX): return convert(jt, w, yv); case CVCASE(FLX, RATX): return convert(jt, w, yv); case CVCASE(CMPXX, RATX): GATV(d, FL, n, r, s); - return convert(jt, w, pointer_to_values(d)) && convert(jt, d, yv); + return convert(jt, w, pointer_to_values(d)) && convert(jt, d, yv); default: ASSERT(0, EVDOMAIN); } } @@ -568,7 +568,7 @@ jtbcvt(J jt, C mode, array w) -> array { if (flags == AN(w)) { if (ipok >= 0) GATV(result, INT, AN(w), AR(w), AS(w)); std::transform( - wv, wv + AN(w), pointer_to_values(result), [&](auto const &z) { return as_integer(z.re); }); + wv, wv + AN(w), pointer_to_values(result), [&](auto const &z) { return as_integer(z.re); }); } else { if (ipok >= 0) GATV(result, CMPX, AN(w), AR(w), AS(w)); std::transform(wv, wv + AN(w), pointer_to_values(result), [&](auto const &z) -> Z { @@ -600,7 +600,7 @@ jticvt(J jt, array w) -> array { auto const *v = pointer_to_values(w); array z = nullptr; GATV(z, INT, n, AR(w), AS(w)); - auto *u = pointer_to_values(z); + auto *u = pointer_to_values(z); for (int64_t i = 0; i < n; ++i) { auto x = *v++; if (x < IMIN || FLIMAX <= x) { @@ -655,7 +655,7 @@ jtxco2(J jt, array a, array w) -> array { array z = nullptr; GATV(z, XNUM, 2 * n, r + 1, AS(w)); AS(z)[r] = 2; - memcpy(pointer_to_values(z), pointer_to_values(w), 2 * n * SZI); + memcpy(pointer_to_values(z), pointer_to_values(w), 2 * n * SZI); return z; } default: ASSERT(0, EVDOMAIN); From a0379e4efff87fc968850e2ab3e6bca1117ce668 Mon Sep 17 00:00:00 2001 From: Juho Eerola Date: Mon, 8 Mar 2021 01:31:53 +0200 Subject: [PATCH 24/39] Add checked transform variant of convert() --- jsrc/conversions.cpp | 137 ++++++++++++++++++++++--------------------- 1 file changed, 69 insertions(+), 68 deletions(-) diff --git a/jsrc/conversions.cpp b/jsrc/conversions.cpp index 8f63436e..4d97e46d 100644 --- a/jsrc/conversions.cpp +++ b/jsrc/conversions.cpp @@ -6,6 +6,7 @@ #include #include #include +#include #include "array.hpp" extern "C" { @@ -14,11 +15,12 @@ extern "C" { #define CVCASE(a, b) (((a) << 3) + (b)) // The main cases fit in low 8 bits of mask -// FIEQ are used in bcvt, where FUZZ may be set to 0 to ensure only exact values are demoted to lower precision -#define FIEQ(u, v, fuzz) \ - (ABS((u) - (v)) <= \ - fuzz * \ - ABS(v)) // used when v is known to be exact integer. It's close enough, maybe ULP too small on the high end +// fuzzy_equal() is used in bcvt, where FUZZ may be set to 0 to ensure only exact values are demoted to lower precision +// used when v is known to be exact integer. It's close enough, maybe ULP too small on the high end +[[nodiscard]] static auto +fuzzy_equal(double u, double v, double fuzz) -> bool { + return std::abs(u - v) <= fuzz * std::abs(v); +} template [[nodiscard]] constexpr auto @@ -32,88 +34,84 @@ in_range() -> bool { return in_range(std::numeric_limits::min()) && in_range(std::numeric_limits::max()); } -template +template +struct is_optional : std::false_type {}; + +template +struct is_optional> : std::true_type {}; + +template [[nodiscard]] auto -convert(J jt, array w, void *yv) -> bool { +value_if(bool cond, T value) -> std::optional { + return cond ? std::optional(value) : std::nullopt; +} + +template +[[nodiscard]] auto +convert(J jt, array w, void *yv, Transform t) -> bool { auto *v = pointer_to_values(w); - if constexpr (!in_range()) { - // TODO: replace with short circuiting solution - auto *out = static_cast(yv); - return out + AN(w) == std::copy_if(v, v + AN(w), out, [](auto v) { return in_range(v); }); + auto *result = static_cast(yv); + if constexpr (is_optional::value) { + for (int64_t i = 0; i < AN(w); ++i) { + auto opt = t(v[i]); + if (!opt) return false; + result[i] = opt.value(); + } + } else { + std::transform(v, v + AN(w), result, t); } - std::copy(v, v + AN(w), static_cast(yv)); return true; } -template +template [[nodiscard]] auto -convert(J jt, array w, void *yv, Transform t) -> bool { +convert(J jt, array w, void *yv) -> bool { + if constexpr (!in_range()) { + return convert(jt, w, yv, [](auto v) { return value_if(in_range(v), v); }); + } auto *v = pointer_to_values(w); - std::transform(v, v + AN(w), static_cast(yv), t); + std::copy(v, v + AN(w), static_cast(yv)); return true; } template <> [[nodiscard]] auto convert(J jt, array w, void *yv, D fuzz) -> bool { - auto n = AN(w); - auto *v = pointer_to_values(w); - auto *x = static_cast(yv); - DQ(n, auto p = *v++; if (p < -2 || 2 < p) return false; // handle infinities - I val = 2; - val = (p == 0) ? 0 : val; - val = FIEQ(p, 1.0, fuzz) ? 1 : val; - if (val == 2) return false; - *x++ = (B)val;) - return true; + auto const infinity = [](auto p) { return p < -2 || 2 < p; }; + return convert(jt, w, yv, [&](auto p) { + return value_if(!infinity(p) && (p == 0.0 || fuzzy_equal(p, 1.0, fuzz)), p != 0.0); + }); } template <> [[nodiscard]] auto convert(J jt, array w, void *yv, D fuzz) -> bool { - auto n = AN(w); - auto *v = pointer_to_values(w); - auto *x = static_cast(yv); - for (int64_t i = 0; i < n; ++i) { - auto const p = v[i]; + return convert(jt, w, yv, [&](auto p) -> std::optional { auto const q = jround(p); - I rq = static_cast(q); - if (!(p == q || FIEQ(p, q, fuzz))) { - return 0; // must equal int, possibly out of range + if (!(p == q || fuzzy_equal(p, q, fuzz))) { + return std::nullopt; // must equal int, possibly out of range } // out-of-range values don't convert, handle separately if (p < static_cast IMIN) { - if (!(p >= IMIN * (1 + fuzz))) return false; - rq = IMIN; + return value_if(p >= IMIN * (1 + fuzz), IMIN); } // if tolerantly < IMIN, error; else take IMIN else if (p >= FLIMAX) { - if (!(p <= -static_cast IMIN * (1 + fuzz))) return false; - rq = IMAX; + return value_if(p <= -static_cast IMIN * (1 + fuzz), IMAX); } // if tolerantly > IMAX, error; else take IMAX - *x++ = rq; - } - return true; + return q; + }); } template <> [[nodiscard]] auto convert(J jt, array w, void *yv, D fuzz) -> bool { - auto const n = AN(w); - auto const *v = pointer_to_values(w); - auto *x = static_cast(yv); - if (fuzz != 0.0) - DQ( - n, auto d = std::abs(v->im); if (d != inf && d <= fuzz * std::abs(v->re)) { - *x++ = v->re; - v++; - } else return false;) - else - DQ( - n, if (!v->im) { - *x++ = v->re; - v++; - } else return false;); - return true; + if (fuzz != 0.0) { + return convert(jt, w, yv, [&](auto const &v) { + auto const d = std::abs(v.im); + return value_if(d != inf && d <= fuzz * std::abs(v.re), v.re); + }); + } + return convert(jt, w, yv, [](auto v) { return value_if(!v.im, v.re); }); } template <> @@ -206,10 +204,10 @@ convert(J jt, array w, void *yv, I mode) -> bool { template <> [[nodiscard]] auto convert(J jt, array w, void *yv) -> bool { - auto *v = pointer_to_values(w); - auto *x = static_cast(yv); - DO(AN(w), array q = v[i]; I e = pointer_to_values(q)[0]; if ((AN(q) ^ 1) | (e & -2)) return false; x[i] = (B)e;); - return true; + return convert(jt, w, yv, [](auto q) { + auto const e = pointer_to_values(q)[0]; + return value_if(!((AN(q) ^ 1) | (e & -2)), e); + }); } template @@ -316,7 +314,10 @@ convert(J jt, array w, void *yv) -> bool { auto const add_digits = [&](auto n, auto v) { auto f = 1.0; auto d = 0.0; - DO(n, d += f * v[i]; f *= xb;); + std::for_each(v, v + n, [&](auto i) { + d += f * i; + f *= xb; + }); return d; }; @@ -357,10 +358,7 @@ convert(J jt, array w, void *yv) -> bool { template <> [[nodiscard]] auto convert(J jt, array w, void *yv) -> bool { - auto *v = pointer_to_values(w); - auto *x = static_cast(yv); - DQ(AN(w), if (!(jtequ(jt, iv1, v->d))) return 0; *x++ = v->n; ++v;); - return !jt->jerr; + return convert(jt, w, yv, [&](auto v) { return value_if(jtequ(jt, iv1, v.d), v.n); }) && !jt->jerr; } template @@ -641,14 +639,17 @@ jtxco1(J jt, array w) -> array { auto jtxco2(J jt, array a, array w) -> array { ASSERT(AT(w) & DENSE, EVNONCE); - I j = 0; - RE(j = jti0(jt, a)); + I j = jti0(jt, a); + if (jt->jerr != 0) return nullptr; switch (j) { case -2: return jtaslash1(jt, CDIV, w); case -1: return jtbcvt(jt, 1, w); case 1: return jtxco1(jt, w); case 2: - if ((AT(w) & RAT) == 0) RZ(w = jtcvt(jt, RAT, w)); + if ((AT(w) & RAT) == 0) { + w = jtcvt(jt, RAT, w); + if (!w) return nullptr; + } { auto const n = AN(w); auto const r = AR(w); From d860c288103f93bd9a5c1b4cc6f2949267f6aa60 Mon Sep 17 00:00:00 2001 From: Juho Eerola Date: Mon, 8 Mar 2021 02:25:46 +0200 Subject: [PATCH 25/39] Use convert() instead of raw loops --- jsrc/conversions.cpp | 88 +++++++++++++++++--------------------------- 1 file changed, 33 insertions(+), 55 deletions(-) diff --git a/jsrc/conversions.cpp b/jsrc/conversions.cpp index 4d97e46d..785bb5fd 100644 --- a/jsrc/conversions.cpp +++ b/jsrc/conversions.cpp @@ -221,19 +221,14 @@ value_from_X(X p) -> T { template <> [[nodiscard]] auto convert(J jt, array w, void *yv) -> bool { - auto *v = pointer_to_values(w); - auto *x = static_cast(yv); - auto n = AN(w); - X p = nullptr; - X q; - if ((p = jtxc(jt, IMAX)) == nullptr) return false; - if ((q = jtxminus(jt, jtnegate(jt, p), jtxc(jt, 1L))) == nullptr) return false; - for (int64_t i = 0; i < n; ++i) { - auto *c = v[i]; - if (!(1 != jtxcompare(jt, q, c) && 1 != jtxcompare(jt, c, p))) return false; - x[i] = value_from_X(c); - } - return 1; + X p = jtxc(jt, IMAX); + if (!p) return false; + X q = jtxminus(jt, jtnegate(jt, p), jtxc(jt, 1L)); + if (!q) return false; + return convert(jt, w, yv, [&](auto c) -> std::optional { + if (!(1 != jtxcompare(jt, q, c) && 1 != jtxcompare(jt, c, p))) return std::nullopt; + return value_from_X(c); + }); } template <> @@ -305,9 +300,6 @@ template <> [[nodiscard]] auto convert(J jt, array w, void *yv) -> bool { auto const xb = static_cast(XBASE); - auto const wn = AN(w); - auto *const wv = pointer_to_values(w); - auto *const x = static_cast(yv); auto const nn = 308 / XBASEN; // TODO: figure out nice algorithm for this @@ -322,37 +314,30 @@ convert(J jt, array w, void *yv) -> bool { }; X x2 = nullptr; - for (int64_t i = 0; i < wn; ++i) { - auto *const p = wv[i].n; + return convert(jt, w, yv, [&](auto nd) -> std::optional { + auto *const p = nd.n; auto const pn = AN(p); - auto const k = 1 == pn ? pointer_to_values(p)[0] : 0; - auto *const q = wv[i].d; + auto const kk = 1 == pn ? pointer_to_values(p)[0] : 0; + if (kk == XPINF) return inf; + if (kk == XNINF) return infm; + auto *const q = nd.d; auto const qn = AN(q); - if (k == XPINF) { - x[i] = inf; - } else if (k == XNINF) { - x[i] = infm; - } else if (pn <= nn && qn <= nn) { + if (pn <= nn && qn <= nn) { auto const n = add_digits(pn, pointer_to_values(p)); auto const d = add_digits(qn, pointer_to_values(q)); - x[i] = n / d; - } else { - if (x2 == nullptr) { - if ((x2 = jtxc(jt, 2L)) == nullptr) return false; - } - auto const k = 5 + qn; - auto *c = jtxdiv(jt, jttake(jt, jtsc(jt, -(k + pn)), p), q, XMFLR); - if (c == nullptr) return false; - auto const cn = AN(c); - auto const m = MIN(cn, 5); - auto const r = cn - (m + k); - auto *const v = pointer_to_values(c) + cn - m; - auto const n = add_digits(m, v); - auto d = std::pow(xb, std::abs(r)); - x[i] = 0 > r ? n / d : n * d; + return n / d; } - } - return true; + if (!x2 && !(x2 = jtxc(jt, 2L))) return std::nullopt; + auto const k = 5 + qn; + auto *c = jtxdiv(jt, jttake(jt, jtsc(jt, -(k + pn)), p), q, XMFLR); + if (!c) return std::nullopt; + auto const cn = AN(c); + auto const m = MIN(cn, 5); + auto const r = cn - (m + k); + auto const n = add_digits(m, pointer_to_values(c) + cn - m); + auto d = std::pow(xb, std::abs(r)); + return 0 > r ? n / d : n * d; + }); } template <> @@ -594,19 +579,12 @@ jtbcvt(J jt, C mode, array w) -> array { auto jticvt(J jt, array w) -> array { - auto const n = AN(w); - auto const *v = pointer_to_values(w); - array z = nullptr; - GATV(z, INT, n, AR(w), AS(w)); - auto *u = pointer_to_values(z); - for (int64_t i = 0; i < n; ++i) { - auto x = *v++; - if (x < IMIN || FLIMAX <= x) { - return w; // if conversion will fail, skip it - } - *u++ = static_cast(x); - } - return z; + array z = nullptr; + GATV(z, INT, AN(w), AR(w), AS(w)); + return convert( + jt, w, pointer_to_values(z), [](auto x) { return value_if(IMIN <= x && x < FLIMAX, x); }) + ? z + : w; // if conversion will fail, skip it } auto From 10504fcb820d219d240e07b1d5f37ac218ffb840 Mon Sep 17 00:00:00 2001 From: Juho Eerola Date: Mon, 8 Mar 2021 03:40:59 +0200 Subject: [PATCH 26/39] Replace std::copy_n() with convert() Also use std::copy_n() instead of std::copy() in convert() Also also, I kind of understand, but wtf: std::numeric_limits::min() and std::numeric_limits::lowest() Now fixed behaviour with double (and bool) --- jsrc/conversions.cpp | 13 ++++++++----- 1 file changed, 8 insertions(+), 5 deletions(-) diff --git a/jsrc/conversions.cpp b/jsrc/conversions.cpp index 785bb5fd..74d701d5 100644 --- a/jsrc/conversions.cpp +++ b/jsrc/conversions.cpp @@ -25,13 +25,16 @@ fuzzy_equal(double u, double v, double fuzz) -> bool { template [[nodiscard]] constexpr auto in_range(V value) -> bool { - return std::numeric_limits::min() <= value && value <= std::numeric_limits::max(); + if constexpr (std::is_same_v) + return true; + else + return std::numeric_limits::lowest() <= value && value <= std::numeric_limits::max(); } template [[nodiscard]] constexpr auto in_range() -> bool { - return in_range(std::numeric_limits::min()) && in_range(std::numeric_limits::max()); + return in_range(std::numeric_limits::lowest()) && in_range(std::numeric_limits::max()); } template @@ -450,19 +453,19 @@ jtccvt(J jt, I tflagged, array w, array *y) -> bool { } } switch (CVCASE(CTTZ(t), CTTZ(wt))) { - case CVCASE(INTX, B01X): std::copy_n(pointer_to_values(w), n, static_cast(yv)); return true; + case CVCASE(INTX, B01X): return convert(jt, w, yv); case CVCASE(XNUMX, B01X): return convert(jt, w, yv); case CVCASE(RATX, B01X): GATV(d, XNUM, n, r, s); return convert(jt, w, pointer_to_values(d)) && convert(jt, d, yv); - case CVCASE(FLX, B01X): std::copy_n(pointer_to_values(w), n, static_cast(yv)); return true; + case CVCASE(FLX, B01X): return convert(jt, w, yv); case CVCASE(CMPXX, B01X): set_real_part(static_cast(yv), n, pointer_to_values(w)); return true; case CVCASE(B01X, INTX): return convert(jt, w, yv); case CVCASE(XNUMX, INTX): return convert(jt, w, yv); case CVCASE(RATX, INTX): GATV(d, XNUM, n, r, s); return convert(jt, w, pointer_to_values(d)) && convert(jt, d, yv); - case CVCASE(FLX, INTX): std::copy_n(pointer_to_values(w), n, static_cast(yv)); return true; + case CVCASE(FLX, INTX): return convert(jt, w, yv); case CVCASE(CMPXX, INTX): set_real_part(static_cast(yv), n, pointer_to_values(w)); return true; case CVCASE(B01X, FLX): return convert(jt, w, yv, ((I)jtinplace & JTNOFUZZ) != 0 ? 0.0 : FUZZ); case CVCASE(INTX, FLX): return convert(jt, w, yv, ((I)jtinplace & JTNOFUZZ) != 0 ? 0.0 : FUZZ); From 194cbc44e70d179849154676317f355d862c9c29 Mon Sep 17 00:00:00 2001 From: Juho Eerola Date: Mon, 8 Mar 2021 04:36:06 +0200 Subject: [PATCH 27/39] Refactor conversions to complex (Z) --- jsrc/conversions.cpp | 29 +++++++++-------------------- 1 file changed, 9 insertions(+), 20 deletions(-) diff --git a/jsrc/conversions.cpp b/jsrc/conversions.cpp index 74d701d5..e48afc61 100644 --- a/jsrc/conversions.cpp +++ b/jsrc/conversions.cpp @@ -69,12 +69,15 @@ convert(J jt, array w, void *yv, Transform t) -> bool { template [[nodiscard]] auto convert(J jt, array w, void *yv) -> bool { - if constexpr (!in_range()) { + if constexpr (std::is_same_v) { + return convert(jt, w, yv, [](auto v) { return To{.re = static_cast(v), .im = {}}; }); + } else if constexpr (!in_range()) { return convert(jt, w, yv, [](auto v) { return value_if(in_range(v), v); }); + } else { + auto *v = pointer_to_values(w); + std::copy(v, v + AN(w), static_cast(yv)); + return true; } - auto *v = pointer_to_values(w); - std::copy(v, v + AN(w), static_cast(yv)); - return true; } template <> @@ -349,20 +352,6 @@ convert(J jt, array w, void *yv) -> bool { return convert(jt, w, yv, [&](auto v) { return value_if(jtequ(jt, iv1, v.d), v.n); }) && !jt->jerr; } -template -auto -set_real_part(Z *z, int64_t n, T *t) { - for (int64_t i = 0; i < n; ++i) { z[i].re = t[i]; } -} - -// Imaginary parts have already been cleared -template <> -[[nodiscard]] auto -convert(J jt, array w, void *yv) -> bool { - set_real_part(static_cast(yv), AN(w), pointer_to_values(w)); - return true; -} - // Convert the data in w to the type t. w and t must be noun types. A new buffer is always created (with a // copy of the data if w is already of the right type), and returned in *y. Result is // 0 if error, 1 if success. If the conversion loses precision, error is returned @@ -459,14 +448,14 @@ jtccvt(J jt, I tflagged, array w, array *y) -> bool { GATV(d, XNUM, n, r, s); return convert(jt, w, pointer_to_values(d)) && convert(jt, d, yv); case CVCASE(FLX, B01X): return convert(jt, w, yv); - case CVCASE(CMPXX, B01X): set_real_part(static_cast(yv), n, pointer_to_values(w)); return true; + case CVCASE(CMPXX, B01X): return convert(jt, w, yv); case CVCASE(B01X, INTX): return convert(jt, w, yv); case CVCASE(XNUMX, INTX): return convert(jt, w, yv); case CVCASE(RATX, INTX): GATV(d, XNUM, n, r, s); return convert(jt, w, pointer_to_values(d)) && convert(jt, d, yv); case CVCASE(FLX, INTX): return convert(jt, w, yv); - case CVCASE(CMPXX, INTX): set_real_part(static_cast(yv), n, pointer_to_values(w)); return true; + case CVCASE(CMPXX, INTX): return convert(jt, w, yv); case CVCASE(B01X, FLX): return convert(jt, w, yv, ((I)jtinplace & JTNOFUZZ) != 0 ? 0.0 : FUZZ); case CVCASE(INTX, FLX): return convert(jt, w, yv, ((I)jtinplace & JTNOFUZZ) != 0 ? 0.0 : FUZZ); case CVCASE(XNUMX, FLX): From 4c39a04257d15bee6dc536bd65ec3c896217a4e4 Mon Sep 17 00:00:00 2001 From: Juho Eerola Date: Mon, 8 Mar 2021 10:31:19 +0200 Subject: [PATCH 28/39] Make the CI compiler happy --- jsrc/conversions.cpp | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/jsrc/conversions.cpp b/jsrc/conversions.cpp index e48afc61..0c841e73 100644 --- a/jsrc/conversions.cpp +++ b/jsrc/conversions.cpp @@ -25,10 +25,12 @@ fuzzy_equal(double u, double v, double fuzz) -> bool { template [[nodiscard]] constexpr auto in_range(V value) -> bool { - if constexpr (std::is_same_v) + if constexpr (std::is_same_v) { + (void)value; return true; - else + } else { return std::numeric_limits::lowest() <= value && value <= std::numeric_limits::max(); + } } template @@ -74,6 +76,7 @@ convert(J jt, array w, void *yv) -> bool { } else if constexpr (!in_range()) { return convert(jt, w, yv, [](auto v) { return value_if(in_range(v), v); }); } else { + (void)jt; auto *v = pointer_to_values(w); std::copy(v, v + AN(w), static_cast(yv)); return true; From 7229958d32d9fd8cdccb6c254fd7634286f4e298 Mon Sep 17 00:00:00 2001 From: Juho Eerola Date: Wed, 17 Mar 2021 01:11:49 +0200 Subject: [PATCH 29/39] Add missing parentheses The macro definition had parentheses, which made it work --- jsrc/conversions.cpp | 19 +++++++++---------- 1 file changed, 9 insertions(+), 10 deletions(-) diff --git a/jsrc/conversions.cpp b/jsrc/conversions.cpp index 0c841e73..cf8007a2 100644 --- a/jsrc/conversions.cpp +++ b/jsrc/conversions.cpp @@ -54,7 +54,7 @@ value_if(bool cond, T value) -> std::optional { template [[nodiscard]] auto convert(J jt, array w, void *yv, Transform t) -> bool { - auto *v = pointer_to_values(w); + auto *v = pointer_to_values(w); auto *result = static_cast(yv); if constexpr (is_optional::value) { for (int64_t i = 0; i < AN(w); ++i) { @@ -87,9 +87,8 @@ template <> [[nodiscard]] auto convert(J jt, array w, void *yv, D fuzz) -> bool { auto const infinity = [](auto p) { return p < -2 || 2 < p; }; - return convert(jt, w, yv, [&](auto p) { - return value_if(!infinity(p) && (p == 0.0 || fuzzy_equal(p, 1.0, fuzz)), p != 0.0); - }); + return convert( + jt, w, yv, [&](auto p) { return value_if(!infinity(p) && (p == 0.0 || fuzzy_equal(p, 1.0, fuzz)), p != 0.0); }); } template <> @@ -101,11 +100,11 @@ convert(J jt, array w, void *yv, D fuzz) -> bool { return std::nullopt; // must equal int, possibly out of range } // out-of-range values don't convert, handle separately - if (p < static_cast IMIN) { + if (p < static_cast(IMIN)) { return value_if(p >= IMIN * (1 + fuzz), IMIN); } // if tolerantly < IMIN, error; else take IMIN else if (p >= FLIMAX) { - return value_if(p <= -static_cast IMIN * (1 + fuzz), IMAX); + return value_if(p <= -static_cast(IMIN) * (1 + fuzz), IMAX); } // if tolerantly > IMAX, error; else take IMAX return q; }); @@ -308,8 +307,8 @@ convert(J jt, array w, void *yv, I mode) -> bool { template <> [[nodiscard]] auto convert(J jt, array w, void *yv) -> bool { - auto const xb = static_cast(XBASE); - auto const nn = 308 / XBASEN; + auto const xb = static_cast(XBASE); + auto const nn = 308 / XBASEN; // TODO: figure out nice algorithm for this auto const add_digits = [&](auto n, auto v) { @@ -421,7 +420,7 @@ jtccvt(J jt, I tflagged, array w, array *y) -> bool { // If n and AN have been modified, it doesn't matter for rank-1 arguments whether the shape of the result is listed // as n or s[0] since only n atoms will be used. For higher ranks, we need the shape from s. So it's just as well // that we take the shape from s now - *y = d; + *y = d; if ((t & CMPX) != 0) { jtfillv(jt, t, n, static_cast(yv)); // why?? just fill in imaginary parts as we need to } @@ -445,7 +444,7 @@ jtccvt(J jt, I tflagged, array w, array *y) -> bool { } } switch (CVCASE(CTTZ(t), CTTZ(wt))) { - case CVCASE(INTX, B01X): return convert(jt, w, yv); + case CVCASE(INTX, B01X): return convert(jt, w, yv); case CVCASE(XNUMX, B01X): return convert(jt, w, yv); case CVCASE(RATX, B01X): GATV(d, XNUM, n, r, s); From c993b447179b9aeaf57c084331458f00e84ccd88 Mon Sep 17 00:00:00 2001 From: Juho Eerola Date: Wed, 17 Mar 2021 01:19:40 +0200 Subject: [PATCH 30/39] Replace `I` and `D` with correct types --- jsrc/conversions.cpp | 151 ++++++++++++++++++++++--------------------- jsrc/je.h | 6 +- 2 files changed, 82 insertions(+), 75 deletions(-) diff --git a/jsrc/conversions.cpp b/jsrc/conversions.cpp index cf8007a2..adf41b8f 100644 --- a/jsrc/conversions.cpp +++ b/jsrc/conversions.cpp @@ -72,7 +72,7 @@ template [[nodiscard]] auto convert(J jt, array w, void *yv) -> bool { if constexpr (std::is_same_v) { - return convert(jt, w, yv, [](auto v) { return To{.re = static_cast(v), .im = {}}; }); + return convert(jt, w, yv, [](auto v) { return To{.re = static_cast(v), .im = {}}; }); } else if constexpr (!in_range()) { return convert(jt, w, yv, [](auto v) { return value_if(in_range(v), v); }); } else { @@ -85,26 +85,26 @@ convert(J jt, array w, void *yv) -> bool { template <> [[nodiscard]] auto -convert(J jt, array w, void *yv, D fuzz) -> bool { +convert(J jt, array w, void *yv, double fuzz) -> bool { auto const infinity = [](auto p) { return p < -2 || 2 < p; }; - return convert( + return convert( jt, w, yv, [&](auto p) { return value_if(!infinity(p) && (p == 0.0 || fuzzy_equal(p, 1.0, fuzz)), p != 0.0); }); } template <> [[nodiscard]] auto -convert(J jt, array w, void *yv, D fuzz) -> bool { - return convert(jt, w, yv, [&](auto p) -> std::optional { +convert(J jt, array w, void *yv, double fuzz) -> bool { + return convert(jt, w, yv, [&](auto p) -> std::optional { auto const q = jround(p); if (!(p == q || fuzzy_equal(p, q, fuzz))) { return std::nullopt; // must equal int, possibly out of range } // out-of-range values don't convert, handle separately - if (p < static_cast(IMIN)) { + if (p < static_cast(IMIN)) { return value_if(p >= IMIN * (1 + fuzz), IMIN); } // if tolerantly < IMIN, error; else take IMIN else if (p >= FLIMAX) { - return value_if(p <= -static_cast(IMIN) * (1 + fuzz), IMAX); + return value_if(p <= -static_cast(IMIN) * (1 + fuzz), IMAX); } // if tolerantly > IMAX, error; else take IMAX return q; }); @@ -112,14 +112,14 @@ convert(J jt, array w, void *yv, D fuzz) -> bool { template <> [[nodiscard]] auto -convert(J jt, array w, void *yv, D fuzz) -> bool { +convert(J jt, array w, void *yv, double fuzz) -> bool { if (fuzz != 0.0) { - return convert(jt, w, yv, [&](auto const &v) { + return convert(jt, w, yv, [&](auto const &v) { auto const d = std::abs(v.im); return value_if(d != inf && d <= fuzz * std::abs(v.re), v.re); }); } - return convert(jt, w, yv, [](auto v) { return value_if(!v.im, v.re); }); + return convert(jt, w, yv, [](auto v) { return value_if(!v.im, v.re); }); } template <> @@ -143,8 +143,8 @@ inplace_negate(T *u, int64_t n) { template <> [[nodiscard]] auto -convert(J jt, array w, void *yv) -> bool { - I u[XIDIG]; +convert(J jt, array w, void *yv) -> bool { + int64_t u[XIDIG]; auto const convert_one = [&](auto c) { auto const b = c == IMIN; auto d = b ? -(1 + c) : std::abs(c); @@ -159,13 +159,13 @@ convert(J jt, array w, void *yv) -> bool { if (0 > c) { inplace_negate(u, XIDIG); } return jtvec(jt, INT, length, u); }; - return convert(jt, w, yv, convert_one) && !jt->jerr; + return convert(jt, w, yv, convert_one) && !jt->jerr; } static auto -jtxd1(J jt, D p, I mode) -> X { +jtxd1(J jt, double p, int64_t mode) -> X { PROLOG(0052); - D e = jttfloor(jt, p); + double e = jttfloor(jt, p); switch (mode) { case XMFLR: p = e; break; case XMCEIL: p = ceil(p); break; @@ -186,7 +186,7 @@ jtxd1(J jt, D p, I mode) -> X { while (0 < d) { auto const q = floor(d / XBASE); auto const r = d - q * XBASE; - u[m++] = static_cast(r); + u[m++] = static_cast(r); d = q; if (m == AN(t)) { RZ(t = jtext(jt, 0, t)); @@ -205,8 +205,8 @@ jtxd1(J jt, D p, I mode) -> X { template <> [[nodiscard]] auto -convert(J jt, array w, void *yv, I mode) -> bool { - return convert(jt, w, yv, [=](auto v) { return jtxd1(jt, v, mode); }) && !jt->jerr; +convert(J jt, array w, void *yv, int64_t mode) -> bool { + return convert(jt, w, yv, [=](auto v) { return jtxd1(jt, v, mode); }) && !jt->jerr; } template <> @@ -228,12 +228,12 @@ value_from_X(X p) -> T { template <> [[nodiscard]] auto -convert(J jt, array w, void *yv) -> bool { +convert(J jt, array w, void *yv) -> bool { X p = jtxc(jt, IMAX); if (!p) return false; X q = jtxminus(jt, jtnegate(jt, p), jtxc(jt, 1L)); if (!q) return false; - return convert(jt, w, yv, [&](auto c) -> std::optional { + return convert(jt, w, yv, [&](auto c) -> std::optional { if (!(1 != jtxcompare(jt, q, c) && 1 != jtxcompare(jt, c, p))) return std::nullopt; return value_from_X(c); }); @@ -241,8 +241,8 @@ convert(J jt, array w, void *yv) -> bool { template <> [[nodiscard]] auto -convert(J jt, array w, void *yv) -> bool { - return convert(jt, w, yv, [](auto p) { +convert(J jt, array w, void *yv) -> bool { + return convert(jt, w, yv, [](auto p) { auto const c = pointer_to_values(p)[AN(p) - 1]; if (c == XPINF) { return inf; } if (c == XNINF) { return infm; } @@ -258,12 +258,12 @@ convert(J jt, array w, void *yv) -> bool { template <> [[nodiscard]] auto -convert(J jt, array w, void *yv, I mode) -> bool { +convert(J jt, array w, void *yv, int64_t mode) -> bool { if ((w) == nullptr) return false; auto const n = AN(w); auto *const wv = pointer_to_values(w); auto *x = static_cast(yv); - D t = NAN; + double t = NAN; auto *tv = 3 + reinterpret_cast(&t); Q q; for (int64_t i = 0; i < n; ++i) { @@ -287,7 +287,7 @@ convert(J jt, array w, void *yv, I mode) -> bool { } else { bool const recip = 1 > t; if (recip) { t = 1.0 / t; } - auto e = static_cast(0xfff0 & *tv); + auto e = static_cast(0xfff0 & *tv); e >>= 4; e -= 1023; if (recip) { @@ -306,8 +306,8 @@ convert(J jt, array w, void *yv, I mode) -> bool { template <> [[nodiscard]] auto -convert(J jt, array w, void *yv) -> bool { - auto const xb = static_cast(XBASE); +convert(J jt, array w, void *yv) -> bool { + auto const xb = static_cast(XBASE); auto const nn = 308 / XBASEN; // TODO: figure out nice algorithm for this @@ -322,7 +322,7 @@ convert(J jt, array w, void *yv) -> bool { }; X x2 = nullptr; - return convert(jt, w, yv, [&](auto nd) -> std::optional { + return convert(jt, w, yv, [&](auto nd) -> std::optional { auto *const p = nd.n; auto const pn = AN(p); auto const kk = 1 == pn ? pointer_to_values(p)[0] : 0; @@ -359,9 +359,9 @@ convert(J jt, array w, void *yv) -> bool { // 0 if error, 1 if success. If the conversion loses precision, error is returned // Calls through bcvt are tagged with a flag in jt, indicating to set fuzz=0 auto -jtccvt(J jt, I tflagged, array w, array *y) -> bool { +jtccvt(J jt, int64_t tflagged, array w, array *y) -> bool { FPREFIP; - I const t = tflagged & NOUN; + int64_t const t = tflagged & NOUN; if (w == nullptr) return false; auto const r = AR(w); auto *const s = AS(w); @@ -376,7 +376,7 @@ jtccvt(J jt, I tflagged, array w, array *y) -> bool { jt->ranks = oqr; return true; // dense to sparse; convert type first (even if same dtype) case 3: // sparse to sparse - I t1 = DTYPE(t); + int64_t t1 = DTYPE(t); GASPARSE(*y, t, 1, r, s); P *yp = pointer_to_values

(*y); P *wp = pointer_to_values

(w); @@ -406,14 +406,14 @@ jtccvt(J jt, I tflagged, array w, array *y) -> bool { if (!d) return false; auto *yv = pointer_to_values(d); // allocate the same # atoms, even if we will convert fewer if ((tflagged & NOUNCVTVALIDCT) != 0) { - I inputn = *reinterpret_cast(y); // fetch input, in case it is called for - if (inputn > 0) { // if converting the leading values, just update the counts - n = inputn; // set the counts for local use, and in the block to be converted - } else { // if converting trailing values... + int64_t inputn = *reinterpret_cast(y); // fetch input, in case it is called for + if (inputn > 0) { // if converting the leading values, just update the counts + n = inputn; // set the counts for local use, and in the block to be converted + } else { // if converting trailing values... AK(w) += (n + inputn) << bplg(wt); - yv = reinterpret_cast(static_cast(yv) + - ((n + inputn) << bplg(t))); // advance input and output pointers to new area - n = -inputn; // get positive # atoms to convert + yv = reinterpret_cast( + static_cast(yv) + ((n + inputn) << bplg(t))); // advance input and output pointers to new area + n = -inputn; // get positive # atoms to convert } AN(w) = n; // change atomct of w to # atoms to convert } @@ -451,66 +451,73 @@ jtccvt(J jt, I tflagged, array w, array *y) -> bool { return convert(jt, w, pointer_to_values(d)) && convert(jt, d, yv); case CVCASE(FLX, B01X): return convert(jt, w, yv); case CVCASE(CMPXX, B01X): return convert(jt, w, yv); - case CVCASE(B01X, INTX): return convert(jt, w, yv); - case CVCASE(XNUMX, INTX): return convert(jt, w, yv); + case CVCASE(B01X, INTX): return convert(jt, w, yv); + case CVCASE(XNUMX, INTX): return convert(jt, w, yv); case CVCASE(RATX, INTX): GATV(d, XNUM, n, r, s); - return convert(jt, w, pointer_to_values(d)) && convert(jt, d, yv); + return convert(jt, w, pointer_to_values(d)) && convert(jt, d, yv); case CVCASE(FLX, INTX): return convert(jt, w, yv); case CVCASE(CMPXX, INTX): return convert(jt, w, yv); - case CVCASE(B01X, FLX): return convert(jt, w, yv, ((I)jtinplace & JTNOFUZZ) != 0 ? 0.0 : FUZZ); - case CVCASE(INTX, FLX): return convert(jt, w, yv, ((I)jtinplace & JTNOFUZZ) != 0 ? 0.0 : FUZZ); + case CVCASE(B01X, FLX): + return convert(jt, w, yv, ((int64_t)jtinplace & JTNOFUZZ) != 0 ? 0.0 : FUZZ); + case CVCASE(INTX, FLX): + return convert(jt, w, yv, ((int64_t)jtinplace & JTNOFUZZ) != 0 ? 0.0 : FUZZ); case CVCASE(XNUMX, FLX): - return convert( - jt, w, yv, (jt->xmode & REPSGN(SGNIFNOT(tflagged, XCVTXNUMORIDEX))) | (tflagged >> XCVTXNUMCVX)); + return convert( + jt, w, yv, int64_t{(jt->xmode & REPSGN(SGNIFNOT(tflagged, XCVTXNUMORIDEX))) | (tflagged >> XCVTXNUMCVX)}); case CVCASE(RATX, FLX): - return convert( - jt, w, yv, (jt->xmode & REPSGN(SGNIFNOT(tflagged, XCVTXNUMORIDEX))) | (tflagged >> XCVTXNUMCVX)); - case CVCASE(CMPXX, FLX): return convert(jt, w, yv); + return convert( + jt, w, yv, int64_t{(jt->xmode & REPSGN(SGNIFNOT(tflagged, XCVTXNUMORIDEX))) | (tflagged >> XCVTXNUMCVX)}); + case CVCASE(CMPXX, FLX): return convert(jt, w, yv); case CVCASE(B01X, CMPXX): GATV(d, FL, n, r, s); - return convert(jt, w, pointer_to_values(d), ((I)jtinplace & JTNOFUZZ) != 0 ? 0.0 : FUZZ) && - convert(jt, d, yv, ((I)jtinplace & JTNOFUZZ) != 0 ? 0.0 : FUZZ); + return convert( + jt, w, pointer_to_values(d), ((int64_t)jtinplace & JTNOFUZZ) != 0 ? 0.0 : FUZZ) && + convert(jt, d, yv, ((int64_t)jtinplace & JTNOFUZZ) != 0 ? 0.0 : FUZZ); case CVCASE(INTX, CMPXX): GATV(d, FL, n, r, s); - return convert(jt, w, pointer_to_values(d), ((I)jtinplace & JTNOFUZZ) != 0 ? 0.0 : FUZZ) && - convert(jt, d, yv, ((I)jtinplace & JTNOFUZZ) != 0 ? 0.0 : FUZZ); + return convert( + jt, w, pointer_to_values(d), ((int64_t)jtinplace & JTNOFUZZ) != 0 ? 0.0 : FUZZ) && + convert(jt, d, yv, ((int64_t)jtinplace & JTNOFUZZ) != 0 ? 0.0 : FUZZ); case CVCASE(XNUMX, CMPXX): GATV(d, FL, n, r, s); - return convert(jt, w, pointer_to_values(d), ((I)jtinplace & JTNOFUZZ) != 0 ? 0.0 : FUZZ) && - convert( - jt, d, yv, (jt->xmode & REPSGN(SGNIFNOT(tflagged, XCVTXNUMORIDEX))) | (tflagged >> XCVTXNUMCVX)); + return convert( + jt, w, pointer_to_values(d), ((int64_t)jtinplace & JTNOFUZZ) != 0 ? 0.0 : FUZZ) && + convert( + jt, d, yv, int64_t{(jt->xmode & REPSGN(SGNIFNOT(tflagged, XCVTXNUMORIDEX))) | (tflagged >> XCVTXNUMCVX)}); case CVCASE(RATX, CMPXX): GATV(d, FL, n, r, s); - return convert(jt, w, pointer_to_values(d), ((I)jtinplace & JTNOFUZZ) != 0 ? 0.0 : FUZZ) && - convert( - jt, d, yv, (jt->xmode & REPSGN(SGNIFNOT(tflagged, XCVTXNUMORIDEX))) | (tflagged >> XCVTXNUMCVX)); - case CVCASE(FLX, CMPXX): return convert(jt, w, yv, ((I)jtinplace & JTNOFUZZ) != 0 ? 0.0 : FUZZ); + return convert( + jt, w, pointer_to_values(d), ((int64_t)jtinplace & JTNOFUZZ) != 0 ? 0.0 : FUZZ) && + convert( + jt, d, yv, int64_t{(jt->xmode & REPSGN(SGNIFNOT(tflagged, XCVTXNUMORIDEX))) | (tflagged >> XCVTXNUMCVX)}); + case CVCASE(FLX, CMPXX): + return convert(jt, w, yv, ((int64_t)jtinplace & JTNOFUZZ) != 0 ? 0.0 : FUZZ); case CVCASE(B01X, XNUMX): return convert(jt, w, yv); - case CVCASE(INTX, XNUMX): return convert(jt, w, yv); + case CVCASE(INTX, XNUMX): return convert(jt, w, yv); case CVCASE(RATX, XNUMX): return convert(jt, w, yv); - case CVCASE(FLX, XNUMX): return convert(jt, w, yv); + case CVCASE(FLX, XNUMX): return convert(jt, w, yv); case CVCASE(CMPXX, XNUMX): GATV(d, FL, n, r, s); - return convert(jt, w, pointer_to_values(d)) && convert(jt, d, yv); + return convert(jt, w, pointer_to_values(d)) && convert(jt, d, yv); case CVCASE(B01X, RATX): GATV(d, XNUM, n, r, s); return convert(jt, w, pointer_to_values(d)) && convert(jt, d, yv); case CVCASE(INTX, RATX): GATV(d, XNUM, n, r, s); - return convert(jt, w, pointer_to_values(d)) && convert(jt, d, yv); + return convert(jt, w, pointer_to_values(d)) && convert(jt, d, yv); case CVCASE(XNUMX, RATX): return convert(jt, w, yv); - case CVCASE(FLX, RATX): return convert(jt, w, yv); + case CVCASE(FLX, RATX): return convert(jt, w, yv); case CVCASE(CMPXX, RATX): GATV(d, FL, n, r, s); - return convert(jt, w, pointer_to_values(d)) && convert(jt, d, yv); + return convert(jt, w, pointer_to_values(d)) && convert(jt, d, yv); default: ASSERT(0, EVDOMAIN); } } // clear rank before calling ccvt - needed for sparse arrays only but returns the block as the result auto -jtcvt(J jt, I t, array w) -> array { +jtcvt(J jt, int64_t t, array w) -> array { array y = nullptr; bool const b = jtccvt(jt, t, w, &y); ASSERT(b, EVDOMAIN); @@ -526,7 +533,7 @@ jtbcvt(J jt, C mode, array w) -> array { FPREFIP; if (w == nullptr) { return nullptr; } - auto const as_integer = [](auto const &v) { return *(I *)&v; }; + auto const as_integer = [](auto const &v) { return *(int64_t *)&v; }; auto const isflag = [&](auto const &z) { return as_integer(z.im) == NANFLAG; }; // there may be values (especially b types) that were nominally CMPX but might actually be integers. Those were @@ -541,7 +548,7 @@ jtbcvt(J jt, C mode, array w) -> array { // auto flags = std::transform_reduce(wv, wv + AN(w), int64_t{}, std::plus{}, isflag); auto flags = std::accumulate(wv, wv + AN(w), int64_t{}, [&](auto sum, auto v) { return sum + isflag(v); }); if (flags != 0) { - I ipok = SGNIF(jtinplace, JTINPLACEWX) & AC(w); // both sign bits set (<0) if inplaceable + int64_t ipok = SGNIF(jtinplace, JTINPLACEWX) & AC(w); // both sign bits set (<0) if inplaceable if (flags == AN(w)) { if (ipok >= 0) GATV(result, INT, AN(w), AR(w), AS(w)); std::transform( @@ -549,7 +556,7 @@ jtbcvt(J jt, C mode, array w) -> array { } else { if (ipok >= 0) GATV(result, CMPX, AN(w), AR(w), AS(w)); std::transform(wv, wv + AN(w), pointer_to_values(result), [&](auto const &z) -> Z { - if (isflag(z)) { return {.re = (D)as_integer(z.re), .im = 0.0}; }; + if (isflag(z)) { return {.re = (double)as_integer(z.re), .im = 0.0}; }; return z; // copy floats, and converts any integers back to float }); } @@ -561,7 +568,7 @@ jtbcvt(J jt, C mode, array w) -> array { // To avoid a needless copy, suppress conversion to B01 if type is B01, to INT if type is INT, etc // set the NOFUZZ flag in jt to insist on an exact match so we won't lose precision array y = nullptr; - jtinplace = (J)((I)jt + JTNOFUZZ); // demand exact match + jtinplace = (J)((int64_t)jt + JTNOFUZZ); // demand exact match result = ((mode & 14) == 0) && jtccvt(jtinplace, B01, w, &y) ? y : (y = w, AT(w) & INT || (((mode & 12) == 0) && jtccvt(jtinplace, INT, w, &y))) ? y : (y = w, AT(w) & FL || (((mode & 8) == 0) && jtccvt(jtinplace, FL, w, &y))) @@ -582,7 +589,7 @@ jticvt(J jt, array w) -> array { } auto -jtpcvt(J jt, I t, array w) -> array { +jtpcvt(J jt, int64_t t, array w) -> array { RANK2T oqr = jt->ranks; RESETRANK; array y = nullptr; @@ -611,7 +618,7 @@ jtxco1(J jt, array w) -> array { auto jtxco2(J jt, array a, array w) -> array { ASSERT(AT(w) & DENSE, EVNONCE); - I j = jti0(jt, a); + int64_t j = jti0(jt, a); if (jt->jerr != 0) return nullptr; switch (j) { case -2: return jtaslash1(jt, CDIV, w); diff --git a/jsrc/je.h b/jsrc/je.h index 344fa04e..daac60a3 100644 --- a/jsrc/je.h +++ b/jsrc/je.h @@ -550,8 +550,8 @@ extern I jtcountnl(J); extern A jtcreatecycliciterator(J, A, A); extern A jtcrelocalsyms(J, A, A, I, I, I); extern A jtcstr(J, C*); -extern A jtcvt(J, I, A); -extern bool jtccvt(J, I, A, A*); +extern A jtcvt(J, int64_t, A); +extern bool jtccvt(J, int64_t, A, A*); extern A jtcvz(J, I, A); extern A jtdaxis(J, I, A); extern A jtddtokens(J, A, I); @@ -640,7 +640,7 @@ extern A jtparsea(J, A*, I); extern B jtparseinit(J); extern A jtparsex(J, A*, I, CW*, DC); extern A jtpaxis(J, I, A); -extern A jtpcvt(J, I, A); +extern A jtpcvt(J, int64_t, A); extern A jtpee(J, A*, CW*, I, I, DC); extern A jtpfill(J, I, A); extern A jtpind(J, I, A); From b71a0207a3a2bd9bc94dc91b7bd7c6d780b26069 Mon Sep 17 00:00:00 2001 From: Juho Eerola Date: Wed, 17 Mar 2021 01:33:28 +0200 Subject: [PATCH 31/39] Extract transformation lambda to variable --- jsrc/conversions.cpp | 13 +++++-------- 1 file changed, 5 insertions(+), 8 deletions(-) diff --git a/jsrc/conversions.cpp b/jsrc/conversions.cpp index adf41b8f..bf1f057c 100644 --- a/jsrc/conversions.cpp +++ b/jsrc/conversions.cpp @@ -125,14 +125,11 @@ convert(J jt, array w, void *yv, double fuzz) -> bool { template <> [[nodiscard]] auto convert(J jt, array w, void *yv) -> bool { - return convert(jt, - w, - yv, - [=](auto v) { - int64_t u[] = {v}; - return jtvec(jt, INT, 1L, u); - }) && - !jt->jerr; + auto const convert_one = [=](auto v) { + int64_t u[] = {v}; + return jtvec(jt, INT, 1L, u); + }; + return convert(jt, w, yv, convert_one) && !jt->jerr; } template From 05d91c69cfcde5a6bff8c02c46b5e2a4164d887b Mon Sep 17 00:00:00 2001 From: Juho Eerola Date: Wed, 17 Mar 2021 01:52:00 +0200 Subject: [PATCH 32/39] Remove unnecessary special case --- jsrc/conversions.cpp | 7 +------ 1 file changed, 1 insertion(+), 6 deletions(-) diff --git a/jsrc/conversions.cpp b/jsrc/conversions.cpp index bf1f057c..f2f05d38 100644 --- a/jsrc/conversions.cpp +++ b/jsrc/conversions.cpp @@ -25,12 +25,7 @@ fuzzy_equal(double u, double v, double fuzz) -> bool { template [[nodiscard]] constexpr auto in_range(V value) -> bool { - if constexpr (std::is_same_v) { - (void)value; - return true; - } else { - return std::numeric_limits::lowest() <= value && value <= std::numeric_limits::max(); - } + return std::numeric_limits::lowest() <= value && value <= std::numeric_limits::max(); } template From 2110d69d3e37ecdff35540f5468f8facd87d5b36 Mon Sep 17 00:00:00 2001 From: Juho Eerola Date: Wed, 17 Mar 2021 01:58:57 +0200 Subject: [PATCH 33/39] Use std::negate{} --- jsrc/conversions.cpp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/jsrc/conversions.cpp b/jsrc/conversions.cpp index f2f05d38..9af83df9 100644 --- a/jsrc/conversions.cpp +++ b/jsrc/conversions.cpp @@ -130,7 +130,7 @@ convert(J jt, array w, void *yv) -> bool { template static auto inplace_negate(T *u, int64_t n) { - std::transform(u, u + n, u, [](auto v) { return -v; }); + std::transform(u, u + n, u, std::negate{}); } template <> From 86ae356ea83b451f23ba93c0f55b7a8da2b7b419 Mon Sep 17 00:00:00 2001 From: Juho Eerola Date: Wed, 17 Mar 2021 02:44:05 +0200 Subject: [PATCH 34/39] Use std::div() --- jsrc/conversions.cpp | 19 ++++++++++--------- 1 file changed, 10 insertions(+), 9 deletions(-) diff --git a/jsrc/conversions.cpp b/jsrc/conversions.cpp index 9af83df9..990f0933 100644 --- a/jsrc/conversions.cpp +++ b/jsrc/conversions.cpp @@ -7,6 +7,7 @@ #include #include #include +#include #include "array.hpp" extern "C" { @@ -138,13 +139,14 @@ template <> convert(J jt, array w, void *yv) -> bool { int64_t u[XIDIG]; auto const convert_one = [&](auto c) { - auto const b = c == IMIN; - auto d = b ? -(1 + c) : std::abs(c); + bool const b = c == IMIN; + int64_t d = b ? -(1 + c) : std::abs(c); int64_t length = 0; for (int64_t i = 0; i < XIDIG; ++i) { - u[i] = d % XBASE; - d = d / XBASE; - if (u[i]) length = i; + auto const [q, r] = std::div(d, int64_t{XBASE}); + u[i] = r; + d = q; + if (r) length = i; } ++length; *u += b; @@ -174,11 +176,10 @@ jtxd1(J jt, double p, int64_t mode) -> X { if (!t) return 0; auto *u = pointer_to_values(t); int64_t m = 0; - auto d = std::abs(p); + int64_t d = std::abs(p); while (0 < d) { - auto const q = floor(d / XBASE); - auto const r = d - q * XBASE; - u[m++] = static_cast(r); + auto const [q, r] = std::div(d, int64_t{XBASE}); + u[m++] = r; d = q; if (m == AN(t)) { RZ(t = jtext(jt, 0, t)); From d5cc1b9944ac47c9190502cc53d0639ce9b9091c Mon Sep 17 00:00:00 2001 From: Juho Eerola Date: Wed, 17 Mar 2021 11:14:43 +0200 Subject: [PATCH 35/39] Disable bool-compare warning --- CMakeLists.txt | 2 ++ 1 file changed, 2 insertions(+) diff --git a/CMakeLists.txt b/CMakeLists.txt index f24bd853..20109bf3 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -79,6 +79,8 @@ add_compile_options($<$:-Wno-char-subscripts>) add_compile_options($<$:-Wno-string-plus-int>) add_compile_options($<$:-Wno-missing-braces>) add_compile_options($<$:-Wno-unknown-pragmas>) +add_compile_options($<$:-Wno-bool-compare>) + add_subdirectory(jsrc) add_subdirectory(base64) From 0dbbd210557d30d5961e4bf17497d4409e1d2e0f Mon Sep 17 00:00:00 2001 From: Juho Eerola Date: Sun, 7 Mar 2021 04:23:00 +0200 Subject: [PATCH 36/39] Remove XNUM conversions --- jsrc/conversions.cpp | 19 ------------------- 1 file changed, 19 deletions(-) diff --git a/jsrc/conversions.cpp b/jsrc/conversions.cpp index 990f0933..936b540f 100644 --- a/jsrc/conversions.cpp +++ b/jsrc/conversions.cpp @@ -438,14 +438,12 @@ jtccvt(J jt, int64_t tflagged, array w, array *y) -> bool { } switch (CVCASE(CTTZ(t), CTTZ(wt))) { case CVCASE(INTX, B01X): return convert(jt, w, yv); - case CVCASE(XNUMX, B01X): return convert(jt, w, yv); case CVCASE(RATX, B01X): GATV(d, XNUM, n, r, s); return convert(jt, w, pointer_to_values(d)) && convert(jt, d, yv); case CVCASE(FLX, B01X): return convert(jt, w, yv); case CVCASE(CMPXX, B01X): return convert(jt, w, yv); case CVCASE(B01X, INTX): return convert(jt, w, yv); - case CVCASE(XNUMX, INTX): return convert(jt, w, yv); case CVCASE(RATX, INTX): GATV(d, XNUM, n, r, s); return convert(jt, w, pointer_to_values(d)) && convert(jt, d, yv); @@ -455,9 +453,6 @@ jtccvt(J jt, int64_t tflagged, array w, array *y) -> bool { return convert(jt, w, yv, ((int64_t)jtinplace & JTNOFUZZ) != 0 ? 0.0 : FUZZ); case CVCASE(INTX, FLX): return convert(jt, w, yv, ((int64_t)jtinplace & JTNOFUZZ) != 0 ? 0.0 : FUZZ); - case CVCASE(XNUMX, FLX): - return convert( - jt, w, yv, int64_t{(jt->xmode & REPSGN(SGNIFNOT(tflagged, XCVTXNUMORIDEX))) | (tflagged >> XCVTXNUMCVX)}); case CVCASE(RATX, FLX): return convert( jt, w, yv, int64_t{(jt->xmode & REPSGN(SGNIFNOT(tflagged, XCVTXNUMORIDEX))) | (tflagged >> XCVTXNUMCVX)}); @@ -472,12 +467,6 @@ jtccvt(J jt, int64_t tflagged, array w, array *y) -> bool { return convert( jt, w, pointer_to_values(d), ((int64_t)jtinplace & JTNOFUZZ) != 0 ? 0.0 : FUZZ) && convert(jt, d, yv, ((int64_t)jtinplace & JTNOFUZZ) != 0 ? 0.0 : FUZZ); - case CVCASE(XNUMX, CMPXX): - GATV(d, FL, n, r, s); - return convert( - jt, w, pointer_to_values(d), ((int64_t)jtinplace & JTNOFUZZ) != 0 ? 0.0 : FUZZ) && - convert( - jt, d, yv, int64_t{(jt->xmode & REPSGN(SGNIFNOT(tflagged, XCVTXNUMORIDEX))) | (tflagged >> XCVTXNUMCVX)}); case CVCASE(RATX, CMPXX): GATV(d, FL, n, r, s); return convert( @@ -486,20 +475,12 @@ jtccvt(J jt, int64_t tflagged, array w, array *y) -> bool { jt, d, yv, int64_t{(jt->xmode & REPSGN(SGNIFNOT(tflagged, XCVTXNUMORIDEX))) | (tflagged >> XCVTXNUMCVX)}); case CVCASE(FLX, CMPXX): return convert(jt, w, yv, ((int64_t)jtinplace & JTNOFUZZ) != 0 ? 0.0 : FUZZ); - case CVCASE(B01X, XNUMX): return convert(jt, w, yv); - case CVCASE(INTX, XNUMX): return convert(jt, w, yv); - case CVCASE(RATX, XNUMX): return convert(jt, w, yv); - case CVCASE(FLX, XNUMX): return convert(jt, w, yv); - case CVCASE(CMPXX, XNUMX): - GATV(d, FL, n, r, s); - return convert(jt, w, pointer_to_values(d)) && convert(jt, d, yv); case CVCASE(B01X, RATX): GATV(d, XNUM, n, r, s); return convert(jt, w, pointer_to_values(d)) && convert(jt, d, yv); case CVCASE(INTX, RATX): GATV(d, XNUM, n, r, s); return convert(jt, w, pointer_to_values(d)) && convert(jt, d, yv); - case CVCASE(XNUMX, RATX): return convert(jt, w, yv); case CVCASE(FLX, RATX): return convert(jt, w, yv); case CVCASE(CMPXX, RATX): GATV(d, FL, n, r, s); From 1950860c7b7de8356e20e748ff3946a4acd43ad2 Mon Sep 17 00:00:00 2001 From: Juho Eerola Date: Sat, 13 Feb 2021 00:57:37 +0200 Subject: [PATCH 37/39] Fix tests and remove empty test files --- test/CMakeLists.txt | 8 - test/g100.ijs | 4 - test/g100i.ijs | 5 - test/g121.ijs | 4 +- test/g122a.ijs | 2 - test/g128x5.ijs | 8 +- test/g200.ijs | 14 +- test/g200m.ijs | 9 +- test/g202b.ijs | 13 +- test/g211.ijs | 9 +- test/g212.ijs | 2 +- test/g221.ijs | 4 +- test/g222.ijs | 8 +- test/g320ip.ijs | 3 - test/g320ipt.ijs | 6 +- test/g3x.ijs | 10 +- test/g401.ijs | 14 +- test/g402.ijs | 3 +- test/g410.ijs | 17 +- test/g411.ijs | 12 - test/g420fg.ijs | 4 +- test/g421d.ijs | 1 - test/g421e.ijs | 9 +- test/g422.ijs | 10 - test/g422rk.ijs | 2 - test/g432.ijs | 6 - test/g520.ijs | 4 +- test/g520b.ijs | 4 - test/g521.ijs | 2 +- test/g530.ijs | 8 +- test/g531.ijs | 6 +- test/g600.ijs | 10 +- test/g601.ijs | 3 +- test/g602.ijs | 52 --- test/g640k.ijs | 4 +- test/g6x.ijs | 2 - test/g7x5.ijs | 121 +++---- test/g9x.ijs | 1 - test/ga.ijs | 18 - test/gassert.ijs | 4 +- test/gcompsc.ijs | 4 +- test/ge.ijs | 4 +- test/gesc.ijs | 10 +- test/gicap.ijs | 4 +- test/gicap2.ijs | 6 +- test/gico.ijs | 26 +- test/gintovfl.ijs | 27 +- test/giph.ijs | 10 +- test/gipht.ijs | 8 +- test/glocale.ijs | 17 - test/gmean.ijs | 8 +- test/gnan.ijs | 43 +-- test/gnum.ijs | 3 - test/gpco.ijs | 4 +- test/gpco2.ijs | 34 +- test/gpdd.ijs | 9 +- test/gpoly.ijs | 53 +-- test/gq.ijs | 145 +------- test/gq101.ijs | 11 +- test/gq132.ijs | 43 +-- test/gq201.ijs | 39 +-- test/gqco.ijs | 6 +- test/gqnonrat.ijs | 15 - test/gr1.ijs | 1 - test/gsp.ijs | 7 - test/gsp520sd.ijs | 2 - test/gt.ijs | 242 ------------- test/gx132.ijs | 32 -- test/gxco.ijs | 53 +-- test/gxco1.ijs | 817 -------------------------------------------- test/gxco2.ijs | 54 --- test/gxinf.ijs | 251 -------------- 72 files changed, 225 insertions(+), 2189 deletions(-) delete mode 100644 test/gt.ijs delete mode 100644 test/gx132.ijs delete mode 100644 test/gxco1.ijs delete mode 100644 test/gxco2.ijs delete mode 100644 test/gxinf.ijs diff --git a/test/CMakeLists.txt b/test/CMakeLists.txt index dc1e3fd2..be016eed 100644 --- a/test/CMakeLists.txt +++ b/test/CMakeLists.txt @@ -305,9 +305,7 @@ set(hare_test_cases #fast gpi # 0.150 seconds gpick # 0.170 seconds gpoly # 0.240 seconds - gq # 0.300 seconds gq101 # 0.490 seconds - gq132 # 0.160 seconds gq201 # 0.230 seconds gqco # 2.550 seconds gqnonrat # 0.240 seconds @@ -372,7 +370,6 @@ set(hare_test_cases #fast gspr # 0.160 seconds gspx # 0.210 seconds gstack # 0.190 seconds, Exception: SegFault, Only on Windows because of reduced stack size - gt # 0.170 seconds gthrow # 0.160 seconds gtrain # 0.170 seconds gtry # 0.160 seconds @@ -381,11 +378,6 @@ set(hare_test_cases #fast gunderai # 0.760 seconds gwhile # 0.160 seconds gx # 0.150 seconds - gx132 # 1.260 seconds - gxco # 0.660 seconds - gxco1 # 0.700 seconds - gxco2 # 0.260 seconds - gxinf # 0.160 seconds g18x g420 ) diff --git a/test/g100.ijs b/test/g100.ijs index 43185a7e..125a6890 100644 --- a/test/g100.ijs +++ b/test/g100.ijs @@ -65,10 +65,6 @@ NB. x+y ----------------------------------------------------------------- (IF64{8 4) = type _2e15+_3e15 (IF64{8 4) = type 2147483647+1 -x=: - y=: 1+i.100 -(x + <._1+2^IF64{31 63x) -: x + <._1+2^IF64{31 63 -(y + <. -2^IF64{31 63x) -: y + <. -2^IF64{31 63 - ( 2e8*>:i.20) -: +/\20$ 2e8 (_2e8*>:i.20) -: +/\20$_2e8 diff --git a/test/g100i.ijs b/test/g100i.ijs index c44a657e..a3acc2ac 100644 --- a/test/g100i.ijs +++ b/test/g100i.ijs @@ -100,11 +100,6 @@ plus=: 4 : 'x+y' NB. +/ X ---------------------------------------------------------------- -(+/ -: +/ @:x:) x=:_1e5+?2 7 5 23$2e5 -(+/"1 -: +/"1@:x:) x -(+/"2 -: +/"2@:x:) x -(+/"3 -: +/"3@:x:) x - 'domain error' -: +/ etx 3 4$'abc' 'domain error' -: +/"1 etx 3 4$'abc' 'domain error' -: +/ etx ;:'modus operandi' diff --git a/test/g121.ijs b/test/g121.ijs index 12d7c862..c978968d 100644 --- a/test/g121.ijs +++ b/test/g121.ijs @@ -228,8 +228,8 @@ f=: 4 : 0 1 ) -s=: 1 0 1 1 0; 3 1 4 5 0; 3 1 4 5 0 0.2; 3 1 4 5 0j2; 3 4 5 5 0x; '3145' -t=: 0 ; 'abc'; 0 3 4; 0 3.4; 0 3j4; 0 3 4x; <0 3;4 +s=: 1 0 1 1 0; 3 1 4 5 0; 3 1 4 5 0 0.2; 3 1 4 5 0j2; 3 4 5 5 0; '3145' +t=: 0 ; 'abc'; 0 3 4; 0 3.4; 0 3j4; 0 3 4; <0 3;4 s f&>/ t NB. obsolete 'length error' -: -.&0 1 2 etx i.5 2 diff --git a/test/g122a.ijs b/test/g122a.ijs index d99b90ef..6be2e54f 100644 --- a/test/g122a.ijs +++ b/test/g122a.ijs @@ -19,8 +19,6 @@ f=: 4 : 0 (< 100?@$100) f&> (100+i.4) ,&.>/ '';<"0 i.8 (< 100?@$0 ) f&> (100+i.4) ,&.>/ '';<"0 i.8 ( (100+i.4) ,&.>/ '';<"0 i.8 -(< x: 100?@$100) f&> (100+i.4) ,&.>/ '';<"0 i.8 -(< x: 100?@$0 ) f&> (100+i.4) ,&.>/ '';<"0 i.8 (<":&.>100?@$100) f&> (100+i.4) ,&.>/ '';<"0 i.8 1 = -:&$.~ i. 2 3 0 = -.@-:&$.~ i. 2 3 diff --git a/test/g128x5.ijs b/test/g128x5.ijs index b34937e3..23cb9105 100644 --- a/test/g128x5.ijs +++ b/test/g128x5.ijs @@ -63,8 +63,8 @@ NB. [x] 128!:8 y hashing ----------------------------------------------------- ('') -: $ (128!:8) i. 10 ('') -: $ (128!:8) i: 2.2j10 ('') -: $ (128!:8) ('a';5;7.8) , <"1 i. 3 4 5 -('') -: $ (128!:8) i. 22x -('') -: $ (128!:8) 5 %~ i. 22x +('') -: $ (128!:8) i. 22 +('') -: $ (128!:8) 5 %~ i. 22 100 ([ (> *. 0 <: ]) (128!:8)) 0 100 ([ (> *. 0 <: ]) (128!:8)) 1 @@ -80,8 +80,8 @@ NB. [x] 128!:8 y hashing ----------------------------------------------------- 100 ([ (> *. 0 <: ]) (128!:8)) i. 10 100 ([ (> *. 0 <: ]) (128!:8)) i: 2.2j10 100 ([ (> *. 0 <: ]) (128!:8)) ('a';5;7.8) , <"1 i. 3 4 5 -100 ([ (> *. 0 <: ]) (128!:8)) i. 22x -100 ([ (> *. 0 <: ]) (128!:8)) 5 %~ i. 22x +100 ([ (> *. 0 <: ]) (128!:8)) i. 22 +100 ([ (> *. 0 <: ]) (128!:8)) 5 %~ i. 22 diff --git a/test/g200.ijs b/test/g200.ijs index b729f179..31e66962 100644 --- a/test/g200.ijs +++ b/test/g200.ijs @@ -263,9 +263,7 @@ f"0 (i:2)+<.%:<:2^53 x=: 7700892415753674751 (3 (17 &|)@^ 9.5) -: 17|3 ^9.5 -(3 (17x&|)@^ 9.5) -: 17|3 ^9.5 (3.7 (17 &|)@^ 9 ) -: 17|3.7^9 -(3.7 (17x&|)@^ 9 ) -: 17|3.7^9 h=: 7927 y=: 1e5 4 2 @@ -289,13 +287,13 @@ _ -: 2.5 ^ _ 'domain error' -: _5.15 ^ etx _ 'domain error' -: _0.15 ^ etx __ -0 0 0 1 _ _ _ _ -: ({._ 1x)^ __ _5 _4 0 1 2 3x _ -0 0 0 1 __ _ __ -: ({.__ 1x)^ __ _5 _4 0 1 2 3x - 0 1 _ _ _ -: 0 1 2 3x _ ^ {. _ 1x -0 0 0 _ 1 0 0 0 -: __ _5 _4 0 1 2 3x _ ^ {. __ 1x +0 0 0 1 _ _ _ _ -: ({._ 1)^ __ _5 _4 0 1 2 3 _ +0 0 0 1 __ _ __ -: ({.__ 1)^ __ _5 _4 0 1 2 3 + 0 1 _ _ _ -: 0 1 2 3 _ ^ {. _ 1 +0 0 0 _ 1 0 0 0 -: __ _5 _4 0 1 2 3 _ ^ {. __ 1 -'domain error' -: _5x ^ etx {._ 1x -'domain error' -: __ 1x ^ etx {._ 1x +'domain error' -: _5 ^ etx {._ 1 +'domain error' -: __ 1 ^ etx {._ 1 0 0 0 1 _ _ _ _ -: ({._ 1r1)^ __ _5 _4 0 1 2 3r1 _ 0 0 0 1 __ _ __ -: ({.__ 1r1)^ __ _5 _4 0 1 2 3r1 diff --git a/test/g200m.ijs b/test/g200m.ijs index 689f5b99..a420e607 100644 --- a/test/g200m.ijs +++ b/test/g200m.ijs @@ -22,13 +22,8 @@ g=: 3 : 0 (f -: g) _1e3 2 _5 (f -: g) _1e3 _2 _5 -(f -: g) x: 1e6 2 500 -(f -: g) x: 1e6 _2 500 -(f -: g) x: _1e6 2 500 -(f -: g) x: _1e6 _2 500 - -1r4 -: 2 (1e6&|@^) _2x -125 625 1r25 -: 5 (1e6&|@^) 3 4 _2x +1r4 -: 2 (1e6&|@^) _2 +125 625 1r25 -: 5 (1e6&|@^) 3 4 _2 4!:55 ;:'f g' diff --git a/test/g202b.ijs b/test/g202b.ijs index 51f59944..52bd3980 100644 --- a/test/g202b.ijs +++ b/test/g202b.ijs @@ -2,22 +2,13 @@ NB. ^: with boxed right argument ---------------------------------------- (>: ^:(i.1000) 1 ) -: >: ^:(<1000) 1 -(>: ^:(i.1000) 1x ) -: >: ^:(<1000) 1x (>:&.>^:(i.1000) <1 ) -: >:&.>^:(<1000) <1 -NB. obsolete (>: ^:(i. 0) 1 ) -: >: ^:(< 0) 1 -NB. obsolete (>: ^:(i. 0) 1x ) -: >: ^:(< 0) 1x -NB. obsolete (>:&.>^:(i. 0) <1 ) -: >:&.>^:(< 0) <1 'domain error' -: ex '>:&.>^:(< 0) <1' (>: ^:(i.1000) 1 4 9 ) -: >: ^:(<1000) 1 4 9 -(>: ^:(i.1000) 1 4 9x) -: >: ^:(<1000) 1 4 9x (>:&.>^:(i.1000) <1 4 9 ) -: >:&.>^:(<1000) <1 4 9 -NB. obsolete (>: ^:(i. 0) 1 4 9 ) -: >: ^:(< 0) 1 4 9 -NB. obsolete (>: ^:(i. 0) 1 4 9x) -: >: ^:(< 0) 1 4 9x -NB. obsolete (>:&.>^:(i. 0) <1 4 9 ) -: >:&.>^:(< 0) <1 4 9 - f=: ^:a: '^:a:' -: 5!:5 <'f' @@ -31,8 +22,8 @@ spleak=: 3 : 0 1 ) -spleak '>: ^:(<1000) 1x' -spleak '>:&.>^:(<1000) <1 ' +spleak '>: ^:(<1000) 1' +spleak '>:&.>^:(<1000) <1' 'domain error' -: >:^:(<2.5) etx 1 'domain error' -: >:^:(<2j5) etx 1 diff --git a/test/g211.ijs b/test/g211.ijs index 8252ed60..17021fb9 100644 --- a/test/g211.ijs +++ b/test/g211.ijs @@ -41,7 +41,6 @@ c f&> <($d)$-~0j1 8192 -: type $. 10$2.7 16384 -: type $. 10$2j7 -'domain error' -: $. etx 2 37x 'domain error' -: $. etx 2 3r7 'nonce error' -: $. etx 3 4$'a' @@ -103,7 +102,6 @@ scheck@(1&$.)"(1) 3 5 7 11;"1 ,/(perm 4){"(2 1) 4 comb 4 'domain error' -: 1$. etx (10&u:'abc');0 1;0 'domain error' -: 1$. etx (<2 3 4);0 1;0 'domain error' -: 1$. etx (>IF64{3e9 4;3e19 4);0 1;0 -'domain error' -: 1$. etx 2 3 4;0 1;2x 'domain error' -: 1$. etx 2 3 4;0 1;2r3 'length error' -: 1$. etx 2 3 4;0 1;0;99 @@ -174,8 +172,7 @@ e=: (2;0 1 2)$.a (7$.e) = (2 2;i.3)$.c (7$.e) = (2 2;i.3)$.d -'domain error' -: 2 $.etx 0 1 2x -'domain error' -: 2 $.etx 0 1r2 +'domain error' -: 2 $.etx 0 1r2 'domain error' -: (2;'ab') $. etx $. i.2 3 'domain error' -: (2;<<2 ) $. etx $. i.2 3 @@ -232,12 +229,10 @@ y=: $. x 'domain error' -: 3 $.etx 0 1 2 'domain error' -: 3 $.etx 0 1.2 'domain error' -: 3 $.etx 0 1j2 -'domain error' -: 3 $.etx 0 1 2x 'domain error' -: 3 $.etx 0 1r2 'domain error' -: 3 $.etx 0 1;2 'domain error' -: (3;'a') $. etx $. i.2 3 -'domain error' -: (3;4x ) $. etx $. i.2 3 'domain error' -: (3;4r5) $. etx $. i.2 3 'domain error' -: (3;<<1) $. etx $. i.2 3 @@ -277,7 +272,6 @@ g=: 4 $. $. 'domain error' -: 4 $.etx 0 1 2 'domain error' -: 4 $.etx 0 1.2 'domain error' -: 4 $.etx 0 1j2 -'domain error' -: 4 $.etx 0 1 2x 'domain error' -: 4 $.etx 0 1r2 'domain error' -: 4 $.etx 0 1;2 @@ -306,7 +300,6 @@ f j./o.?2 45$20 'domain error' -: 5 $.etx 0 1 2 'domain error' -: 5 $.etx 0 1.2 'domain error' -: 5 $.etx 0 1j2 -'domain error' -: 5 $.etx 0 1 2x 'domain error' -: 5 $.etx 0 1r2 'domain error' -: 5 $.etx 0 1;2 diff --git a/test/g212.ijs b/test/g212.ijs index 9efcb26a..71e5a317 100644 --- a/test/g212.ijs +++ b/test/g212.ijs @@ -22,7 +22,7 @@ x add y ln=: 40&$: : (4 : 0) " 0 assert. 0:) (x:!.0 y)%2x^m + t=. (<:%>:) y%2^m if. x<-:#":t do. t=. (1+x) round t end. ln2=. 2*+/1r3 (^%]) 1+2*i.>.0.5*(%3)^.0.5*0.1^x+>.10^.1>.m lnr=. 2*+/t (^%]) 1+2*i.>.0.5*(|t)^.0.5*0.1^x diff --git a/test/g221.ijs b/test/g221.ijs index 78b42ddd..8710730c 100644 --- a/test/g221.ijs +++ b/test/g221.ijs @@ -66,8 +66,8 @@ test@:(t"_ {~ 877&, ?@$ (#t)"_)"0 >:i.5 [ t=: (u:&.>) ;:' miasma chthonic chro test@:(t"_ {~ 877&, ?@$ (#t)"_)"0 >:i.5 [ t=: (10&u:&.>) ;:' miasma chthonic chronic kakistocracy dado' test@:(t"_ {~ 877&, ?@$ (#t)"_)"0 >:i.5 [ t=: s:@<"0&.> ;:' miasma chthonic chronic kakistocracy dado' test@:(t"_ {~ 877&, ?@$ (#t)"_)"0 >:i.5 [ t=: <"0@s: ;:' miasma chthonic chronic kakistocracy dado' -test@:(t"_ {~ 877&, ?@$ (#t)"_)"0 >:i.5 [ t=: x: ?5$20 -test@:(t"_ {~ 877&, ?@$ (#t)"_)"0 >:i.5 [ t=: %/0 1+x:?2 5$20 +test@:(t"_ {~ 877&, ?@$ (#t)"_)"0 >:i.5 [ t=: ?5$20 +test@:(t"_ {~ 877&, ?@$ (#t)"_)"0 >:i.5 [ t=: %/0 1+?2 5$20 test@:(t"_ {~ 877&, ?@$ (#t)"_)"0 >:i.3 5 [ t=: u: ?5$65536 test@:(t"_ {~ 877&, ?@$ (#t)"_)"0 >:i.3 5 [ t=: 10&u: RAND32 ?5$C4MAX test@:(t"_ {~ 877&, ?@$ (#t)"_)"0 >:i.3 5 [ t=: s:' miasma chthonic chronic kakistocracy dado' diff --git a/test/g222.ijs b/test/g222.ijs index 7db2f33c..27c019ef 100644 --- a/test/g222.ijs +++ b/test/g222.ijs @@ -108,8 +108,8 @@ test@:(t"_ {~ 877&, ?@$ (#t)"_)"0 >:i.5 [ t=: (u:&.>) ;:' miasma chthonic chro test@:(t"_ {~ 877&, ?@$ (#t)"_)"0 >:i.5 [ t=: (10&u:&.>) ;:' miasma chthonic chronic kakistocracy dado' test@:(t"_ {~ 877&, ?@$ (#t)"_)"0 >:i.5 [ t=: s:@<"0&.> ;:' miasma chthonic chronic kakistocracy dado' test@:(t"_ {~ 877&, ?@$ (#t)"_)"0 >:i.5 [ t=: <"0@s: ;:' miasma chthonic chronic kakistocracy dado' -test@:(t"_ {~ 877&, ?@$ (#t)"_)"0 >:i.5 [ t=: x: ?5$20 -test@:(t"_ {~ 877&, ?@$ (#t)"_)"0 >:i.5 [ t=: %/0 1+x:?2 5$20 +test@:(t"_ {~ 877&, ?@$ (#t)"_)"0 >:i.5 [ t=: ?5$20 +test@:(t"_ {~ 877&, ?@$ (#t)"_)"0 >:i.5 [ t=: %/0 1+?2 5$20 test@:(t"_ {~ 877&, ?@$ (#t)"_)"0 >:i.3 5 [ t=: u: ?5$65536 test@:(t"_ {~ 877&, ?@$ (#t)"_)"0 >:i.3 5 [ t=: 10&u: RAND32 ?5$C4MAX test@:(t"_ {~ 877&, ?@$ (#t)"_)"0 >:i.3 5 [ t=: s:' miasma chthonic chronic kakistocracy dado' @@ -142,8 +142,8 @@ test@:(t"_ {~ 3 877&, ?@$ (#t)"_)"0 >:i.5 [ t=: (u:&.>) ;:' miasma chthonic ch test@:(t"_ {~ 3 877&, ?@$ (#t)"_)"0 >:i.5 [ t=: (10&u:&.>) ;:' miasma chthonic chronic kakistocracy dado' test@:(t"_ {~ 3 877&, ?@$ (#t)"_)"0 >:i.5 [ t=: s:@<"0&.> ;:' miasma chthonic chronic kakistocracy dado' test@:(t"_ {~ 3 877&, ?@$ (#t)"_)"0 >:i.5 [ t=: <"0@s: ;:' miasma chthonic chronic kakistocracy dado' -test@:(t"_ {~ 3 877&, ?@$ (#t)"_)"0 >:i.5 [ t=: x: ?5$20 -test@:(t"_ {~ 3 877&, ?@$ (#t)"_)"0 >:i.5 [ t=: %/0 1+x:?2 5$20 +test@:(t"_ {~ 3 877&, ?@$ (#t)"_)"0 >:i.5 [ t=: ?5$20 +test@:(t"_ {~ 3 877&, ?@$ (#t)"_)"0 >:i.5 [ t=: %/0 1+?2 5$20 test@:(t"_ {~ 3 877&, ?@$ (#t)"_)"0 >:i.3 5 [ t=: u: ?5$65536 test@:(t"_ {~ 3 877&, ?@$ (#t)"_)"0 >:i.3 5 [ t=: 10&u: RAND32 ?5$C4MAX test@:(t"_ {~ 3 877&, ?@$ (#t)"_)"0 >:i.3 5 [ t=: s:' miasma chthonic chronic kakistocracy dado' diff --git a/test/g320ip.ijs b/test/g320ip.ijs index 73aff913..3f3b98d2 100644 --- a/test/g320ip.ijs +++ b/test/g320ip.ijs @@ -309,9 +309,6 @@ NB. Not boxed a =: <"0 i. 1e5 2000 < 7!:2 '_5 {. a , a:' a -: <"0 i. 1e5 -NB. Not extended -a =: i. 100000x -2000 < 7!:2 '_5 {. a , _1' NB. Verify forms for indexing a =: i. 1e6 diff --git a/test/g320ipt.ijs b/test/g320ipt.ijs index 237d0482..9168e459 100644 --- a/test/g320ipt.ijs +++ b/test/g320ipt.ijs @@ -58,7 +58,7 @@ tip =: tbase -~ 6!:2 '(<1) ,~ (<2) ,~ (<3) ,~ (<4) ,~ (<5) ,~ (<6) ,~ (<7) ,~ <" tnip =: tbase -~ 6!:2 '(<1) , (<2) , (<3) , (<4) , (<5) , (<6) , (<7) , <"0 i. 1e6' THRESHOLD +. tip < 0.25 * tnip -0!:0 : +/~ i.4x +test y=: !i.10 +test y=: % >: +/~ i.4 test y=: $. (3 4 ?@$ 2) * 3 4 5 ?@$ 1e5 @@ -511,8 +511,8 @@ NB. (-:!.0 rx@xr) <"0@s: ;:'Cogito, ergo sum.' NB. (-:!.0 rx@xr) 0.07 ; (j./i.2 3 4) ; ,. s:@<"0&.> ;:'Cogito, ergo sum.' NB. (-:!.0 rx@xr) 0.07 ; (j./i.2 3 4) ; ,. <"0@s: ;:'Cogito, ergo sum.' (-:!.0 rx@xr) !100x -(-:!.0 rx@xr) +/ .*~^:(10) 2 2$0 1 1 1x -(-:!.0 rx@xr) (+%)/\44$1x +(-:!.0 rx@xr) +/ .*~^:(10) 2 2$0 1 1 1 +(-:!.0 rx@xr) (+%)/\44$1 (-:!.0 rx@xr) 5!:1 <'xrh' NB. 0 : string or box diff --git a/test/g401.ijs b/test/g401.ijs index 4c69c3d4..29012e69 100644 --- a/test/g401.ijs +++ b/test/g401.ijs @@ -25,7 +25,6 @@ f r.?12345 0 -: #. (0$0) (10 # 0) -: #.@> 10 # < (0$0) 0 -: #. (0$4) -0 -: #. (0$4x) 1 -: #. (,1) 2 -: #. 1 0 4 -: #. 1 0 0 @@ -37,11 +36,6 @@ f r.?12345 (2^61) -: #.62{.1 (i.4) -: #.4 2$0 0 0 1 1 0 1 1 -(_3r2+2x^n+1) = #. (n$1),1r2 [ n=: 30 -(_3r2+2x^n+1) = #. (n$1),1r2 [ n=: 34 -(_3r2+2x^n+1) = #. (n$1),1r2 [ n=: 62 -(_3r2+2x^n+1) = #. (n$1),1r2 [ n=: 66 - x -: #."0 x=: 10 ?@$ 2 x -: #."0 x=: 10 ?@$ 2e6 x -: #."0 x=: 10 ?@$ 200 @@ -142,10 +136,10 @@ NB. complex 444 -: 10 10 10 #. 4 12 345 -: 10#.i.2 3 -(_3r2+2x^n+1) = 2 #. (n$1),1r2 [ n=: 30 -(_3r2+2x^n+1) = 2 #. (n$1),1r2 [ n=: 34 -(_3r2+2x^n+1) = 2 #. (n$1),1r2 [ n=: 62 -(_3r2+2x^n+1) = 2 #. (n$1),1r2 [ n=: 66 +(_3r2+2^n+1) = 2 #. (n$1),1r2 [ n=: 30 +(_3r2+2^n+1) = 2 #. (n$1),1r2 [ n=: 34 +(_3r2+2^n+1) = 2 #. (n$1),1r2 [ n=: 62 +(_3r2+2^n+1) = 2 #. (n$1),1r2 [ n=: 66 'domain error' -: 'abc' #. etx 1 2 3 'domain error' -: (u:'abc') #. etx 1 2 3 diff --git a/test/g402.ijs b/test/g402.ijs index f0c70d2f..6441490e 100644 --- a/test/g402.ijs +++ b/test/g402.ijs @@ -2,7 +2,7 @@ NB. #:y ----------------------------------------------------------------- max =: >./@:|@, -bits =: ] (1 >. ] + [ >: 2x&^@]) <.@(2&^.)@(1&>.) +bits =: ] (1 >. ] + [ >: 2&^@]) <.@(2&^.)@(1&>.) abase1 =: #:~ $&2@bits@max NB. Boolean @@ -18,7 +18,6 @@ NB. integer (#: -: abase1) x=: 2147483647 (#: -: abase1) x=:_2147483648 25 9 2147483647 (#: -: abase1) imin -(#: -: abase1) imax (#: -: abase1) x=: imax,imin,_5e8+10 ?@$ 1e9 NB. floating point diff --git a/test/g410.ijs b/test/g410.ijs index 0f8504c5..0008ffbb 100644 --- a/test/g410.ijs +++ b/test/g410.ijs @@ -67,11 +67,6 @@ grecur =: grm`grp@.(0:.@>.@(%&(%:3r4))@|@im gamma =: (en Gauss ]) ` Stirling @. (20&<@|@im) " 0 @@ -155,20 +150,10 @@ r=.w^e NB.1%w if N<0, w otherwise NB. !y Stirling's approximation, Abramowitz & Stegun -------------------- -sbase =: %:@(2p1&%) * %&1x1 ^ ] -scorr =: 1 1r12 1r288 _139r51840 _571r2488320&p.@% -stirlg =: sbase * scorr NB. 6.1.37 - stirlf =: ^@(1r12&%) * %:@(2p1&*) * %&1x1 ^ ] NB. 6.1.38 -g =: stirlg@>: |@-.@% ! f =: stirlf |@-.@% ! -1e_8 > g 10 +i.2 5 -1e_8 > g 10.5+i.2 5 -1e_8 > g 10 +10*i.3 5 -1e_8 > g 10.5+10*i.3 5 - 5e_6 > f 10 +i.2 5 5e_6 > f 10.5+i.2 5 5e_6 > f 10 +10*i.3 5 @@ -439,7 +424,7 @@ NB. Types, for singleton and not 4!:55 ;:'fac g gamma Gauss gm gps grecur grm grow grp ' 4!:55 ;:'i iic ifc im i0 i1 i2 i3 j0 j1 k m n p' 4!:55 ;:'pascal0 pascal1 pascal2 q re' -4!:55 ;:'recur rm sbase scorr seed seed5 sinh start stirlf stirlg Stirling ' +4!:55 ;:'recur rm sbase scorr seed seed5 sinh start stirlf Stirling ' 4!:55 ;:'t test x y z ' diff --git a/test/g411.ijs b/test/g411.ijs index b664639a..8c7ef37d 100644 --- a/test/g411.ijs +++ b/test/g411.ijs @@ -338,17 +338,5 @@ v=:1+10^-i 'rank error' -: ex '>:!.1e_14 0' - -NB. x v!.f y where x is extended and v requires fill -------------------- - -(8x {.!.17 y) -: 8 {.!.17 y=: 1 2 -((17r2-1r2) {.!.17 y) -: 8 {.!.17 y -(8x $ !.17 y) -: 8 $ !.17 y=: 1 2 -((17r2-1r2) $ !.17 y) -: 8 $ !.17 y -(8x |.!.17 y) -: 8 |.!.17 y=: i.20 -((17r2-1r2) |.!.17 y) -: 8 |.!.17 y - - 4!:55 ;:'adot1 adot2 sdot0 f i k n p v x y' randfini'' - diff --git a/test/g420fg.ijs b/test/g420fg.ijs index 9f44080e..a635a3be 100644 --- a/test/g420fg.ijs +++ b/test/g420fg.ijs @@ -97,7 +97,6 @@ y=: 30 7 ?@$ >.imax%8 (+/x>.y) -: x +/@:>. y (4=3!:0 x) *. (imax-1) = x=: (2-1 1) +/@:* 1, imax-2 -(4=3!:0 x) *. (imax-2) = x=: _1 2 +/@:* 1, x:^:_1 <.imax%2x NB. x u"r"r y -------------------------------------------------------------------- @@ -179,8 +178,7 @@ f (#: i.@:(*/)) 4$5 NB. Test argument types (20 4 ?@$ 100) (+/@:*"1 -: +/@:*"_"1) 20 4 ?@$ 100 -(x: 20 4 ?@$ 100) (+/@:*"1 -: +/@:*"_"1) x: 20 4 ?@$ 100 -(1r5 * x: 20 4 ?@$ 100) (+/@:*"1 -: +/@:*"_"1) 1r7 * x: 20 4 ?@$ 100 +(1r5 * 20 4 ?@$ 100) (+/@:*"1 -: +/@:*"_"1) 1r7 * 20 4 ?@$ 100 (3j0.5 * 20 4 ?@$ 100) (+/@:*"1 -: +/@:*"_"1) 4j2 * 20 4 ?@$ 100 (+/@:*"1 -: +/@:*"_"1)&>/"1 ?@$&2&.> 2&#"0 (i. 32) , (254*8) + i. 100 'domain error' -: +/@:*"1~ etx 'abc' diff --git a/test/g421d.ijs b/test/g421d.ijs index 0b3db875..a49b0b7d 100644 --- a/test/g421d.ijs +++ b/test/g421d.ijs @@ -16,7 +16,6 @@ test=: 3 : 0 y testa i.900 y testa _450+i.900 y testa o. i.900 - y testa x: i.900 xx=:y{~?1000$#y assert. ((({.,#)/. i.@#) -: ((f,.g) i.@#)) xx assert. (((#,{.)/. i.@#) -: ((g,.f) i.@#)) xx diff --git a/test/g421e.ijs b/test/g421e.ijs index a97eb743..48a5f64c 100644 --- a/test/g421e.ijs +++ b/test/g421e.ijs @@ -14,7 +14,6 @@ data=: 4 : 0 case. 'I' do. y ?@$ 1e9 case. 'd' do. 1e_4 * _5e6 + y ?@$ 1e7 case. 'z' do. j./ 1e_4 * _5e6 + (2,y) ?@$ 1e7 - case. 'x' do. x: _5e8 + y ?@$ 1e9 case. 'q' do. x: 1e_4 * _5e8 + y ?@$ 1e9 case. 's' do. sdot0{~ y ?@$ #sdot0 end. @@ -35,9 +34,9 @@ test2=: 2 : 0 1 ) -+ test"0 'biIdxqz' ->. test"0 'biIdxqs' -<. test"0 'biIdxqs' ++ test"0 'biIdqz' +>. test"0 'biIdqs' +<. test"0 'biIdqs' +. test 'b' *. test 'b' @@ -52,7 +51,7 @@ test2=: 2 : 0 22 b. test"0 'iI' 23 b. test"0 'iI' -+ test2 *"0 'biIdxqz' ++ test2 *"0 'biIdqz' ~: test2 *. 'bs' diff --git a/test/g422.ijs b/test/g422.ijs index d7ef78d2..720b8b1d 100644 --- a/test/g422.ijs +++ b/test/g422.ijs @@ -387,16 +387,6 @@ e=: < 2 2 $ 1 2 5 6 (i.5) -: /: d,e,b,c,a (/:"1 p) -: /:"1 (d,e,b,c,a){~p=: (i.!5) A. i.5 -NB. extended integer -(/: -: /: @:x:) a=: _500+?100 $1000 -(/: -: /:@:(<"0)@:x:) a -(/: -: /: @:x:) a=: _500+?100 4$1000 -(/: -: /:@:(<"1)@:x:) a -(,1x) -: /:~ 1x -(,2x) -: /:~ 2x -(,3x) -: /:~ ,3x -(,4x) -: /:~ ,4x - NB. rationals (/: -: /: @:x:) a=: -:_500+?100 $1000 (/: -: /:@:(<"0)@:x:) a diff --git a/test/g422rk.ijs b/test/g422rk.ijs index 7f2987a7..392713e5 100644 --- a/test/g422rk.ijs +++ b/test/g422rk.ijs @@ -110,8 +110,6 @@ x=: (5 1e5 ?@$ 2) * 5 1e5 ?@$ 1000 (3 4 17$i.17) -: /:@/:"2 ] 3 4 17 0 $ 0 (3 4 17$i.17) -: rk "2 ] 3 4 17 0 $ 0 -(/:@/: -: /:@/:@x:)"1 ] 17 31 ?@$ 1000 - 'limit error' -: /:@/:"2 etx 0 $~ (IF64$2e9),1e9 11 17 0 diff --git a/test/g432.ijs b/test/g432.ijs index bff52ef1..538e770f 100644 --- a/test/g432.ijs +++ b/test/g432.ijs @@ -418,12 +418,6 @@ e=: < 2 2 $ 1 2 5 6 (i.5) -: /: d,e,b,c,a (\:"1 p) -: \:"1 (d,e,b,c,a){~p=: (i.!5) A. i.5 -NB. extended integer -(\: -: \: @:x:) a=: _500+?100 $1000 -(\: -: \:@:(<"0)@:x:) a -(\: -: \: @:x:) a=: _500+?100 4$1000 -(\: -: \:@:(<"1)@:x:) a - NB. rationals (\: -: \: @:x:) a=: -:_500+?100 $1000 (\: -: \:@:(<"0)@:x:) a diff --git a/test/g520.ijs b/test/g520.ijs index e8a26737..8b764ba8 100644 --- a/test/g520.ijs +++ b/test/g520.ijs @@ -951,7 +951,7 @@ x=: ?s$1e9 (i=: <0:&.>1{.s) ({ -: f) x (i=: <(0. + ?)&.>2{.s) ({ -: f) x (i=: <((0 j. 0) + ?)&.>3{.s) ({ -: f) x -(i=: <(0x + ?)&.>4{.s) ({ -: f) x +(i=: <(0 + ?)&.>4{.s) ({ -: f) x (i=: <(0r3 + ?)&.>5{.s) ({ -: f) x (i=: 6{.s) ({ -: f) x (i=: 7{.s) ({ -: f) x @@ -960,7 +960,7 @@ x=: ?s$1e9 (i=: <((?1$5){.&.><7$1)$&.>0:&.>1{.s) ({ -: f) x (i=: <((?2$5){.&.><7$1)$&.>(0. + ?)&.>2{.s) ({ -: f) x (i=: <((?3$5){.&.><7$1)$&.>((0 j. 0) + ?)&.>3{.s) ({ -: f) x -(i=: <((?4$5){.&.><7$1)$&.>(0x + ?)&.>4{.s) ({ -: f) x +(i=: <((?4$5){.&.><7$1)$&.>(0 + ?)&.>4{.s) ({ -: f) x (i=: <((?5$5){.&.><7$1)$&.>(0r3 + ?)&.>5{.s) ({ -: f) x (i=: <((?6$5){.&.><7$1)$&.>?&.>6{.s) ({ -: f) x (i=: <((?7$5){.&.><7$1)$&.>?&.>7{.s) ({ -: f) x diff --git a/test/g520b.ijs b/test/g520b.ijs index 66973710..905460d0 100644 --- a/test/g520b.ijs +++ b/test/g520b.ijs @@ -70,8 +70,6 @@ f2=: 3 : 0 assert. (b{x) -: i{x=: ? 2$2e9 assert. (b{x) -: i{x=: o. ? 2$2e9 assert. (b{x) -: i{x=: r. ? 2$2e5 - assert. (b{x) -: i{x=: x: ? 2$2e9 - assert. (b{x) -: i{x=: %/x:?2 2$2e9 assert. (b{x) -: i{x=: x{~ ? 2$#x=: ;:'Cogito, ergo sum. kakistocracy' assert. (b{x) -: i{x=: x{~ ? 2$#x=: (u:&.>) ;:'Cogito, ergo sum. kakistocracy' assert. (b{x) -: i{x=: x{~ ? 2$#x=: (10&u:&.>) ;:'Cogito, ergo sum. kakistocracy' @@ -87,8 +85,6 @@ f2"0 ] 1000+i.10 (b{"1 x) -: i{"1 x=: ? 5 2$2e9 (b{"1 x) -: i{"1 x=: o. ? 5 2$2e9 (b{"1 x) -: i{"1 x=: r. ? 5 2$2e5 -(b{"1 x) -: i{"1 x=: x: ? 5 2$2e9 -(b{"1 x) -: i{"1 x=: %/x:?2 5 2$2e9 (b{"1 x) -: i{"1 x=: x{~?5 2$#x=: ;:'Cogito, ergo sum. kakistocracy' (b{"1 x) -: i{"1 x=: x{~?5 2$#x=: (u:&.>) ;:'Cogito, ergo sum. kakistocracy' (b{"1 x) -: i{"1 x=: x{~?5 2$#x=: (10&u:&.>) ;:'Cogito, ergo sum. kakistocracy' diff --git a/test/g521.ijs b/test/g521.ijs index 62db7036..22d0528d 100644 --- a/test/g521.ijs +++ b/test/g521.ijs @@ -291,7 +291,7 @@ _3 _6 f ?5 6 4$100 3 f i.0 3 f 0$3.4 3 f 0$3j4 -3 f 0$12x +3 f 0$12 3 f 0$3r4 3 f 0$<'abc' 3 f 0$ etx -: >"0 etx)@> y NB. Test with different shapes/types of nonempty -ops =: (0);('a');(4);(1.5);(1j1);(a:);(5x);(4r6);(u:'a');(10 u:'a') +ops =: (0);('a');(4);(1.5);(1j1);(a:);(4r6);(u:'a');(10 u:'a') y =: <@(((ops {::~ ?@(#ops)) $~ 10 ?@$~ >:@?)&.>@(#&4)"0) ] 1 + 100000 ?@$ 3 (> etx -: >"0 etx)@> y NB. Test precision changes in long operation -ops =: (0);(4);(1.5);(1j1);(5x);(4r6) +ops =: (0);(4);(1.5);(1j1);(4r6) ((>@([ , 99999 # ])) -: (* i. 100000) (4 : 'x {:: y')"0 _ ,)"0/~ ops ops =: ('a');(u:'a');(10 u:'a') ((>@([ , 99999 # ])) -: (* i. 100000) (4 : 'x {:: y')"0 _ ,)"0/~ ops diff --git a/test/g601.ijs b/test/g601.ijs index a508b004..0302639d 100644 --- a/test/g601.ijs +++ b/test/g601.ijs @@ -144,8 +144,7 @@ _999 0 _999 3.4 -: _999 ". ', 0 ,,,, 3.4' _9j9 0 _9j9 3.4 -: _9j9 ". ', 0 ,,,, 3.4' _999 _999 1234 123-: _999 ". ',123 123, 1,,,,234 123,.' _9j9 _9j9 1234 123.4-: _9j9 ". ',123 123, 1,,,,234 1,23,.4' -12100 -: 0 ". '12,100x' -64 = 3!:0 ] 0 ". '12,100x' +12100 -: 0 ". '12,100' x -: _999 ". ": x=:?3 4$10000 x -: _999 ". ": x=:_1e4+?3 4$2e4 diff --git a/test/g602.ijs b/test/g602.ijs index be14f26f..5007ade9 100644 --- a/test/g602.ijs +++ b/test/g602.ijs @@ -64,9 +64,6 @@ f 3 7$ _ 3 __ 4 _. 6 (":x) -: }. ; ' ',&.>":&.>x=: 4 5,imax,1 _2 3 (":x) -: }. ; ' ',&.>":&.>x=: 4 5,imin,1 _2 3 -(":imax) -: ": <:2x^IF64{31 63 -(":imin) -: ": - 2x^IF64{31 63 - sqz=: #"1~ -.@(1 1&E.)@(*./)@(' '&=) (":x) -: sqz _3 }.@,\' ',.":,., x=: 2 3$imax,1 2 _3 (":x) -: sqz _3 }.@,\' ',.":,., x=: 2 3$imin,1 2 _3 @@ -387,58 +384,9 @@ f =: 4 : 0 NB. x":y on extended integers ------------------------------------------- -20j4 (": -: (": x:)) x=: _5e8+?20$1e9 -20j4 (": -: (": x:)) ,.x -20j4 (": -: (": x:)) 5 4$x -20j0 (": -: (": x:)) x -20j0 (": -: (": x:)) ,.x -20j0 (": -: (": x:)) 5 4$x -0j4 (": -: (": x:)) x -0j4 (": -: (": x:)) ,.x -0j4 (": -: (": x:)) 5 4$x -0 (": -: (": x:)) x -0 (": -: (": x:)) ,.x -0 (": -: (": x:)) 5 4$x - -0j_4 (": -: (": x:)) 123454 -0j_4 (": -: (": x:)) 123455 -0j_4 (": -: (": x:)) 123456 -0j_4 (": -: (": x:)) 123496 -0j_4 (": -: (": x:)) 123996 -0j_4 (": -: (": x:)) 129996 -0j_4 (": -: (": x:)) 199996 -0j_4 (": -: (": x:)) 999996 - -_14 (": -: (": x:)) 123454 -_14 (": -: (": x:)) 123455 -_14 (": -: (": x:)) 123456 -_14 (": -: (": x:)) 123496 -_14 (": -: (": x:)) 123996 -_14 (": -: (": x:)) 129996 -_14 (": -: (": x:)) 199996 -_14 (": -: (": x:)) 999996 - -0j_6 (": -: (": x:)) 1234 -0j_6 (": -: (": x:)) 1235 -0j_6 (": -: (": x:)) 1236 -0j_6 (": -: (": x:)) 1239 -0j_6 (": -: (": x:)) 1299 -0j_6 (": -: (": x:)) 1999 -0j_6 (": -: (": x:)) 9999 - -0j3 (": -: (": x:^:_1)) 12344x 12346 12347 % 10000x -0j3 (": -: (": x:^:_1)) 12349x 12399 12999 19999 99999 % 10000x -0j3 (": -: (": x:^:_1)) x=: %/x: (+ 0&=) _4e8+?2 20 5$1e9 - -12j3 (": -: (": x:^:_1)) 12344x 12346 12347 % 10000x -12j3 (": -: (": x:^:_1)) 12349x 12399 12999 19999 99999 % 10000x -12j3 (": -: (": x:^:_1)) x=: %/x: (+ 0&=) _4e8+?2 20 5$1e9 - '0.0000e0' -: 0j_4 ": 0r1 '0.0000' -: 0j4 ": 0r1 -2 50027 -: $ 0j25 ": ,. 10 ^ 0 50000x - 4!:55 ;:'a afte bc bcorn bint bl bot boxc boxed cleanZ edge efmt ' 4!:55 ;:'f f0 finite fmt fmtB fmtD fmtI fmtZ fmtZ1 frame ' diff --git a/test/g640k.ijs b/test/g640k.ijs index 7499c0a6..1fd459c7 100644 --- a/test/g640k.ijs +++ b/test/g640k.ijs @@ -247,7 +247,7 @@ testa=: 4 : 0 (i.NRNG) testa"0/ 2^28 30 , IF64#32 33 34 53 62 (i.NRNG) testa"0/10^7 8 9 , IF64#16 17 18 (i.NRNG) testa"0/13^6 7 8 , IF64#16 17 -2 testa"0 x: 5 55 +2 testa"0 5 55 ) NB. serial test: chi-square test on successive k-tuples @@ -272,7 +272,7 @@ testb=: 4 : 0 0 $ 0 : 0 (i.NRNG) testb"0/ 2 6 10 -2 testb"0 x: 2 22 +2 testb"0 2 22 ) NB. gap test: chi-square test on successive k-tuples diff --git a/test/g6x.ijs b/test/g6x.ijs index d68ecbb9..479a52a3 100644 --- a/test/g6x.ijs +++ b/test/g6x.ijs @@ -207,7 +207,6 @@ m=: sp '' 'domain error' -: 1 2 pmdata etx 20$'x' 'domain error' -: 1.2 pmdata etx 20$'x' 'domain error' -: 1j2 pmdata etx 20$'x' -'domain error' -: 1 2x pmdata etx 20$'x' 'domain error' -: 1r2 pmdata etx 20$'x' 'domain error' -: '01' pmdata etx 20$'x' 'domain error' -: (1;0) pmdata etx 20$'x' @@ -218,7 +217,6 @@ m=: sp '' 'domain error' -: pmctr etx 1.5 'domain error' -: pmctr etx 1j5 -'domain error' -: pmctr etx 10^100x 'domain error' -: pmctr etx 1r5 'domain error' -: pmctr etx <2 diff --git a/test/g7x5.ijs b/test/g7x5.ijs index 7f610e39..8871bd00 100644 --- a/test/g7x5.ijs +++ b/test/g7x5.ijs @@ -141,66 +141,67 @@ x=: 2 : 0 NB. 7!:5 on mapped arrays ----------------------------------------------- - -load'jmf' -3 : 0 '' -if. _1=nc<'MAPNAME_jmf_' do. - 'MAPNAME_jmf_ MAPFN_jmf_ MAPSN_jmf_ MAPFH_jmf_ MAPMH_jmf_ MAPADDRESS_jmf_ MAPHEADER_jmf_ MAPFSIZE_jmf_ MAPMSIZE_jmf_ MAPREFS_jmf_'=: i.10 -end. -1 -) -18!:4 <'base' -1 [ unmap_jmf_ 'q' -f=: <'a' -) - -NB. run foo calling goo calling foo (note perhaps nasty goo calling foo!) -1 [ 1 foo '' NB. a NB. ".&.> <'a' [ !a -(<,2) -: (<1,MAPREFS_jmf_) { showmap_jmf_'' -1 [ unmap_jmf_ 'a' - -18!:55 <'jmf' +NB. jmf is broken without extended +NB. load'jmf' +NB. 3 : 0 '' +NB. if. _1=nc<'MAPNAME_jmf_' do. +NB. 'MAPNAME_jmf_ MAPFN_jmf_ MAPSN_jmf_ MAPFH_jmf_ MAPMH_jmf_ MAPADDRESS_jmf_ MAPHEADER_jmf_ MAPFSIZE_jmf_ MAPMSIZE_jmf_ MAPREFS_jmf_'=: i.10 +NB. end. +NB. 1 +NB. ) +NB. 18!:4 <'base' +NB. 1 [ unmap_jmf_ 'q' +NB. f=: <'a' +NB. ) +NB. +NB. NB. run foo calling goo calling foo (note perhaps nasty goo calling foo!) +NB. 1 [ 1 foo '' NB. a NB. ".&.> <'a' [ !a +NB. (<,2) -: (<1,MAPREFS_jmf_) { showmap_jmf_'' +NB. 1 [ unmap_jmf_ 'a' +NB. +NB. 18!:55 <'jmf' +NB. 4!:55 ;:'adot1 adot2 fmapped gmapped sdot0 bp f g q sp x a foo goo' randfini'' diff --git a/test/g9x.ijs b/test/g9x.ijs index 98289aa2..0d612594 100644 --- a/test/g9x.ijs +++ b/test/g9x.ijs @@ -211,7 +211,6 @@ NB. 9!:18 and 9!:19 ----------------------------------------------------- 'domain error' -: 9!:19 etx _1e_13 'domain error' -: 9!:19 etx 1e_8 'domain error' -: 9!:19 etx 14 -'domain error' -: 9!:19 etx 14x 'rank error' -: 9!:19 etx ,1e_14 'rank error' -: 9!:19 etx 1 1 1$1e_14 diff --git a/test/ga.ijs b/test/ga.ijs index 698002fe..28ae9600 100644 --- a/test/ga.ijs +++ b/test/ga.ijs @@ -35,19 +35,11 @@ dfr =: /:^:2@,/ Adot1 =: (base #. rfd)@((ord pfill ])`C.@.boxed) " 1 Adot2 =: dfr@(base@] #: [) { ] -(A. -: Adot1) 7?12 -(A. -: Adot1) x=:(1=1,?6$3) <;.1 (7?12) - (?!5) (A. -: Adot2) 'xyzab' (?!5) (A. -: Adot2) u:'xyzab' (?!5) (A. -: Adot2) 10&u:'xyzab' (?!5) (A. -: Adot2) r.i.5 2 -5 -: A.0 3 2 1 -5 -: A.3 2 1 -5 -: A.0;2;3 1 -5 -: A.<3 1 - (_1 A. y) -: |. y=:1=?300 2$2 (_1 A. y) -: |. y=:(?400$#a.){a. (_1 A. y) -: |. y=:(?400$#adot1){adot1 @@ -93,17 +85,9 @@ Adot2 =: dfr@(base@] #: [) { ] ([ -: 3&A.^:_1@(3&A.)) x=:(?200$3){s:@<"0&.> ;:'Hey nonny nonny' ([ -: 3&A.^:_1@(3&A.)) x=:(?200$3){<"0@s: ;:'Hey nonny nonny' -([ -: A.&y^:_1@(A.&y)) x=:?100$#y=:~.'Antebellum' -([ -: A.&y^:_1@(A.&y)) x=:?100$#y=:~.u:'Antebellum' -([ -: A.&y^:_1@(A.&y)) x=:?100$#y=:~.10&u:'Antebellum' -([ -: A.&y^:_1@(A.&y)) x=:?100$#y=:~.s:@<"0 'Antebellum' -([ -: A.&y^:_1@(A.&y)) x=:?100$#y=:100?100 - 0 -: A. i.0 (i.1 0) -: (i.1) A. i.0 -(3 4$0) -: A."0 ]3 4 ?@$ 100 - 'domain error' -: A. etx 'abcd' 'domain error' -: A. etx 3 4;'abc' 'domain error' -: A. etx 3.4 5 @@ -126,8 +110,6 @@ p0 =: i.@! A. i. j=:?~!5 p=:j{p0 5 -j -: A.p -j -: A.@C.p p -: j A.i.5 grow =: [: ,/ 0&,.@:>: {"2 1 \:"1@=@(_1&,)@{. diff --git a/test/gassert.ijs b/test/gassert.ijs index 9524458c..545eda93 100644 --- a/test/gassert.ijs +++ b/test/gassert.ijs @@ -18,7 +18,7 @@ f=: 3 : 0 1 -: f }. 314 1 1 1 1 -: f }. 3.4 1 1 1 1 -: f }. 3j4 1 1 1 -1 -: f }. 31x 1 1 1 +1 -: f }. 31 1 1 1 1 -: f }. 3r4 1 1 1 'assertion failure' -: f etx 0 @@ -30,7 +30,7 @@ f=: 3 : 0 'assertion failure' -: f etx 1 2.3 'assertion failure' -: f etx 1 2j3 'assertion failure' -: f etx 1 2r3 -'assertion failure' -: f etx 1 233x +'assertion failure' -: f etx 1 233 'assertion failure' -: f etx s: ' 1 2 3' s=: 1 (5!:7) <'f' diff --git a/test/gcompsc.ijs b/test/gcompsc.ijs index 0cef7e20..6a252316 100644 --- a/test/gcompsc.ijs +++ b/test/gcompsc.ijs @@ -478,8 +478,8 @@ NB. Verify excluded-rank cases work 10 -: (i. 1 10) i."_&0@:E. (i. 10 5) NB. Verify reversion for other types -4 -: (i. 10x) +/@:> 5x -4 -: (i. 10x) +/@:> 11r2 +4 -: (i. 10) +/@:> 5 +4 -: (i. 10) +/@:> 11r2 4 -: 'abcdefegehie' +/@:= 'e' 'domain error' -: 'abcdefegehie' +/@:> etx 'e' diff --git a/test/ge.ijs b/test/ge.ijs index 72c5487c..1ef9bf2b 100644 --- a/test/ge.ijs +++ b/test/ge.ijs @@ -127,8 +127,8 @@ test@:(t"_ {~ 877&, ?@$ (#t)"_)"0 >:i.5 [ t=: (u:&.>) ;:' miasma chthonic chro test@:(t"_ {~ 877&, ?@$ (#t)"_)"0 >:i.5 [ t=: (10&u:&.>) ;:' miasma chthonic chronic kakistocracy dado' test@:(t"_ {~ 877&, ?@$ (#t)"_)"0 >:i.5 [ t=: s:@<"0&.> ;:' miasma chthonic chronic kakistocracy dado' test@:(t"_ {~ 877&, ?@$ (#t)"_)"0 >:i.5 [ t=: <"0@s: ;:' miasma chthonic chronic kakistocracy dado' -test@:(t"_ {~ 877&, ?@$ (#t)"_)"0 >:i.5 [ t=: x: ?5$20 -test@:(t"_ {~ 877&, ?@$ (#t)"_)"0 >:i.5 [ t=: %/0 1+x:?2 5$20 +test@:(t"_ {~ 877&, ?@$ (#t)"_)"0 >:i.5 [ t=: ?5$20 +test@:(t"_ {~ 877&, ?@$ (#t)"_)"0 >:i.5 [ t=: %/0 1+?2 5$20 test@:(t"_ {~ 877&, ?@$ (#t)"_)"0 >:i.3 5 [ t=: u: ?5$65536 test@:(t"_ {~ 877&, ?@$ (#t)"_)"0 >:i.3 5 [ t=: 10&u: RAND32 ?5$C4MAX test@:(t"_ {~ 877&, ?@$ (#t)"_)"0 >:i.3 5 [ t=: s:' miasma chthonic chronic kakistocracy dado' diff --git a/test/gesc.ijs b/test/gesc.ijs index 59425db8..ad7ffeae 100644 --- a/test/gesc.ijs +++ b/test/gesc.ijs @@ -64,10 +64,10 @@ A0=: 1 : 0 u E ~ a=. a{~600 2 ?@$ #a=. s: ' cogito ergo sum ',": 600 ?@$ 1000 u E ~ a=. a{~600 2 ?@$ #a=. s: u: 128+a.i. ' cogito ergo sum ',": 600 ?@$ 1000 u E ~ a=. a{~600 2 ?@$ #a=. s: 10&u: 65536+a.i. ' cogito ergo sum ',": 600 ?@$ 1000 - u E ~ a=. x: 600 ?@$ IF64{2e9 9e18 - u E ~ a=. x: 600 2 ?@$ 1000 - u E ~ a=. %/x: 0 1+2 600 ?@$ IF64{2e9 9e18 - u E ~ a=. %/x: 0 1+2 600 2 ?@$ 1000 + u E ~ a=. 600 ?@$ IF64{2e9 9e18 + u E ~ a=. 600 2 ?@$ 1000 + u E ~ a=. %/ 0 1+2 600 ?@$ IF64{2e9 9e18 + u E ~ a=. %/ 0 1+2 600 2 ?@$ 1000 u E ~ a=. 4 0$0 u E ~ a=. 4 0$'a' u E ~ a=. 4 0$u:'a' @@ -81,7 +81,7 @@ A0=: 1 : 0 u E ~ a=. 4 0$s: ' cogito' u E ~ a=. 4 0$s: u: 128+a.i. ' cogito' u E ~ a=. 4 0$s: 10&u: 65536+a.i. ' cogito' - u E ~ a=. 4 0$3x + u E ~ a=. 4 0$3 u E ~ a=. 4 0$3r4 ) diff --git a/test/gicap.ijs b/test/gicap.ijs index c77e73c1..af9e19cb 100644 --- a/test/gicap.ijs +++ b/test/gicap.ijs @@ -46,8 +46,8 @@ test@:(t"_ {~ 877&, ?@$ (#t)"_)"0 >:i.5 [ t=: (u:&.>) ;:' miasma chthonic chro test@:(t"_ {~ 877&, ?@$ (#t)"_)"0 >:i.5 [ t=: (10&u:&.>) ;:' miasma chthonic chronic kakistocracy dado' test@:(t"_ {~ 877&, ?@$ (#t)"_)"0 >:i.5 [ t=: s:@<"0&.> ;:' miasma chthonic chronic kakistocracy dado' test@:(t"_ {~ 877&, ?@$ (#t)"_)"0 >:i.5 [ t=: <"0@s: ;:' miasma chthonic chronic kakistocracy dado' -test@:(t"_ {~ 877&, ?@$ (#t)"_)"0 >:i.5 [ t=: x: ?5$20 -test@:(t"_ {~ 877&, ?@$ (#t)"_)"0 >:i.5 [ t=: %/0 1+x:?2 5$20 +test@:(t"_ {~ 877&, ?@$ (#t)"_)"0 >:i.5 [ t=: ?5$20 +test@:(t"_ {~ 877&, ?@$ (#t)"_)"0 >:i.5 [ t=: %/0 1+?2 5$20 test@:(t"_ {~ 877&, ?@$ (#t)"_)"0 >:i.3 5 [ t=: u: ?5$65536 test@:(t"_ {~ 877&, ?@$ (#t)"_)"0 >:i.3 5 [ t=: 10&u: RAND32 ?5$C4MAX test@:(t"_ {~ 877&, ?@$ (#t)"_)"0 >:i.3 5 [ t=: s:' miasma chthonic chronic kakistocracy dado' diff --git a/test/gicap2.ijs b/test/gicap2.ijs index 9c598fa6..e3096f71 100644 --- a/test/gicap2.ijs +++ b/test/gicap2.ijs @@ -62,8 +62,8 @@ test2=: 4 : 0 0 1 test2~0.1 * 200 ?@$ 250 t test2 0.5 * t=: 200 ?@$ 250 t test2~0.5 * t -t test2 x: t=: 200 ?@$ 250 -t test2~x: t +t test2 t=: 200 ?@$ 250 +t test2~ t t test2 1r2 * t=: 200 ?@$ 250 t test2~1r2 * t t test2 (500?1000){ t=: u: 1000 ?@$ 65536 @@ -105,7 +105,7 @@ test3=: 3 : 0 test3 -~0.5 test3 -~0j5 -test3 x: 0 +test3 0 test3 -~1r5 diff --git a/test/gico.ijs b/test/gico.ijs index 399e4485..7f0f50e5 100644 --- a/test/gico.ijs +++ b/test/gico.ijs @@ -29,12 +29,6 @@ ico=: 3 : '(y*-*y)+i.(_1^0>y)++:y' " 0 4 = type i: 10j10 4 = type i: 10j20 4 = type i: _10j5 -64 = type i: 10x -64 = type i: 2*5r2 -128 = type i: 5r2 -128 = type i: _5r2 - -(i:5r2) -: i: 2.5 f=: 3 : 0 " 0 n=: (?@# { ])@q: yy=: y @@ -197,8 +191,8 @@ a-:(a i:[&.(0j1&*)a){a (#a)=a i:4 5 6 7 8 (#a)=a i:'abcde' (b{({:(a=49)#i.#a),#a) -: (a=:(>:?40)$49 9 123) i: (b=:?40$2){49 _49 -(i.31) -: i:~2x^i. 31 -(i.31) -: i:~2x^i._31 +(i.31) -: i:~2^i. 31 +(i.31) -: i:~2^i._31 (30$29) -: i:~30$123456 (30$29) -: i:~30$_12345678 a -: (i:~a){a=:?4000$4000 NB. small integers @@ -313,8 +307,8 @@ a -: j{a (#a) -: a i:'abcd' (2$#a) -: a i:2 4$2 -0 -: (i.6 2 3x)i: i. 2 3x -6 -: (i.6 2 3x)i:2 3$9 +0 -: (i.6 2 3)i: i. 2 3 +6 -: (i.6 2 3)i:2 3$9 ($0) -: (6 2 3$9)i:0 2 3$5 (5 0 4$0) -: (6 2 3$9)i:5 0 4 2 3$5 @@ -331,14 +325,14 @@ a -: j{a (($b)$0) -: '' i:b=:'abc' (($b)$0) -: '' i:b=:u:'abc' (($b)$0) -: '' i:b=:10&u:'abc' -(($b)$0) -: ($0) i:b=:i. 3 4x -(($b)$0) -: (0$<'') i:b=:+&.>i.3 4x -0 0 -: (i.0 3 4x)i:b=:i.2 3 4x +(($b)$0) -: ($0) i:b=:i. 3 4 +(($b)$0) -: (0$<'') i:b=:+&.>i.3 4 +0 0 -: (i.0 3 4)i:b=:i.2 3 4 -3 3 3 3 3 -: (i.3 4x ) i: 5 4$'a' +3 3 3 3 3 -: (i.3 4 ) i: 5 4$'a' 3 3 3 3 3 -: (3 4$<'a') i: 5 4$'a' -3 3 3 3 3 -: (i.3 4x ) i: 5 4$u:'a' -3 3 3 3 3 -: (i.3 4x ) i: 5 4$u:'a' +3 3 3 3 3 -: (i.3 4 ) i: 5 4$u:'a' +3 3 3 3 3 -: (i.3 4 ) i: 5 4$u:'a' 3 3 3 3 3 -: (3 4$<'a') i: 5 4$10&u:'a' 3 3 3 3 3 -: (3 4$<'a') i: 5 4$10&u:'a' diff --git a/test/gintovfl.ijs b/test/gintovfl.ijs index 49ebdfc9..a24d9a99 100644 --- a/test/gintovfl.ijs +++ b/test/gintovfl.ijs @@ -4,7 +4,7 @@ NB. integer operations -------------------------------------------------- B =: IF64{31 63 V =: 1 : 'u ; u& x:' -E =: 1 : 'u -: u&.x:' +E =: 1 : 'u -: u' EI=: 1 : 'u E *. 4&=@type@:u' C =: 1 : 'u E *. u E~' CI=: 1 : 'u C *. 4&=@type@:u' @@ -19,7 +19,7 @@ NB. integers remain as integers ---------------------------------------- >: EI imin f=: 3 : 0 - xx=: y $ xi imax <.@% x: y + xx=: y $ xi imax <.@% y assert. +/ EI xx assert. +/\ EI xx assert. +/\. EI xx @@ -45,8 +45,8 @@ f 3 f 4 f"0 >: 5 ?@$ 100 -+: EI x=: xi imax <.@% 2x -+: EI x=: xi imin >.@% 2x ++: EI x=: xi imax <.@% 2 ++: EI x=: xi imin >.@% 2 f=: 3 : 0 n=: <. (0=(2^.yy)|B) -~ yy ^. imax [ yy=: y @@ -131,12 +131,12 @@ x - EI imin [ x=: - 1 + 10 ?@$ 1e6 0 1 _1 * CI imax 0 1 * CI imin -2 * CI xi imax <.@% 2x -x * CI xi imax <.@% x: x=: 1+20 ?@$ 10 -x * CI xi imax <.@% x: x=: 1+100 ?@$ 100 -2 * CI xi imin >.@% 2x -x * CI xi imin >.@% x: x=: 1+20 ?@$ 10 -x * CI xi imin >.@% x: x=: 1+100 ?@$ 100 +2 * CI xi imax <.@% 2 +x * CI xi imax <.@% x=: 1+20 ?@$ 10 +x * CI xi imax <.@% x=: 1+100 ?@$ 100 +2 * CI xi imin >.@% 2 +x * CI xi imin >.@% x=: 1+20 ?@$ 10 +x * CI xi imin >.@% x=: 1+100 ?@$ 100 imax *. CI 1,q: imax imin *. CI <. 1 (33 b.)~ 10 ?@$ IF64{30 62 NB. ^ did not always produce an exact power of 2 @@ -150,15 +150,14 @@ n #. EI 1 $~ <. n ^. 1 + imax * _1 + n=: 4 n #. EI 1 $~ <. n ^. 1 + imax * _1 + n=: 5 n (#. $&1:)"0 EI x=: <.n^.1+imax*_1+n=: 2+10 ?@$ 100 -x +/ .* CI y [ x=: 2$1 [ y=: 2$xi imax <.@% 2x -x +/ .* CI y [ x=: 3$1 [ y=: 3$xi imax <.@% 3x +x +/ .* CI y [ x=: 2$1 [ y=: 2$xi imax <.@% 2 +x +/ .* CI y [ x=: 3$1 [ y=: 3$xi imax <.@% 3 1 1 +/ .* CI y=: 1,imax-1 1 1 +/ .* CI y=: 1,imax-2 1 1 +/ .* CI y=: 1,imax-3 (2 - 1 1) +/@:* CI 1,imax-1 (2 - 1 1) +/@:* CI 1,imax-2 -_1 2 +/@:* CI 1,x:^:_1 <.imax%2x NB. integers overflowing into doubles ----------------------------------- @@ -209,7 +208,7 @@ imin * C x=: _50 + 10 ?@$ 100 -/ .* E x=: (=i.2) * >. 2 %: imax NB. -/ .* (1 : 'x (-: +. (IF64{0 1e15) > |@]) x&.x:') x=: 10 2 2 ?@$ <. 2^IF64{17 33 NB. If determinant is too small, its relative error can be --/ .* (1 : 'u -: u&.x:') x=: 10 2 2 ?@$ <. 2^17 NB. still failure for the above guard for J64 +-/ .* (1 : 'u -: u') x=: 10 2 2 ?@$ <. 2^17 NB. still failure for the above guard for J64 x +/ .* C y [ x=: 4 1 1 1 1 [ y=: 0 _1 0 1,imax x +/ .* C y [ x=: 4 1 1 1 2 [ y=: 0 0 0 0,imax diff --git a/test/giph.ijs b/test/giph.ijs index 3a8f6d34..c6379834 100644 --- a/test/giph.ijs +++ b/test/giph.ijs @@ -82,11 +82,11 @@ h=: 4 : 0 '' h j./ _1e4+2 1000 ?@$ 2e4 2 3 h j./ _1e4+2 1000 ?@$ 2e4 -'' g x: 1000 ?@$ 3e3 -2 3 g x: 1000 ?@$ 3e3 +'' g 1000 ?@$ 3e3 +2 3 g 1000 ?@$ 3e3 -'' g %/ x: 0 1 + 2 1000 ?@$ 3e3 -2 3 g %/ x: 0 1 + 2 1000 ?@$ 3e3 +'' g %/ 0 1 + 2 1000 ?@$ 3e3 +2 3 g %/ 0 1 + 2 1000 ?@$ 3e3 '' g ;:'Cogito, ergo sum. 4 20 and 10 years ago' 1 2 g ;:'Cogito, ergo sum. 4 20 and 10 years ago' @@ -132,7 +132,7 @@ f=: x&i. (i.~x) -: f x+0 (i.~x) -: f x+-~0.1 (i.~x) -: f x+-~0j1 -(i.~x) -: f x+-~1x +(i.~x) -: f x+-~1 (i.~x) -: f x+-~1r2 ((i.7 2) -. 2 3) -: -.& 2 3 i. 7 2 diff --git a/test/gipht.ijs b/test/gipht.ijs index 4195a8df..a11b3b27 100644 --- a/test/gipht.ijs +++ b/test/gipht.ijs @@ -35,10 +35,10 @@ x f0 0+x=: 1e4 4 ?@$ 0 x f0 0+x=: j./_1e4+2 1e4 ?@$ 2e4 x f0 0+x=: j./_1e4+2 1e4 4 ?@$ 2e4 1 [ 9!:57 (1) NB. disable auditing, since next line is slow -x f0 0+x=: x: 1e4 ?@$ 3e3 -x f0 0+x=: x: 1e4 4 ?@$ 3e3 -x f0 0+x=: %/x:0 1+2 1e4 ?@$ 3e3 -x f0 0+x=: %/x:0 1+2 1e4 4 ?@$ 3e3 +x f0 0+x=: 1e4 ?@$ 3e3 +x f0 0+x=: 1e4 4 ?@$ 3e3 +x f0 0+x=: %/0 1+2 1e4 ?@$ 3e3 +x f0 0+x=: %/0 1+2 1e4 4 ?@$ 3e3 1 [ 9!:57 (2) NB. possible garbage collect can louse up timing diff --git a/test/glocale.ijs b/test/glocale.ijs index 7e9a98f5..2f62ee93 100644 --- a/test/glocale.ijs +++ b/test/glocale.ijs @@ -56,14 +56,12 @@ x -: a__k [ k=: <'huh' 'locale error' -: ex 'ab__k' [ k=: 1e6 'domain error' -: ex 'ab__k' [ k=: 5.4 'domain error' -: ex 'ab__k' [ k=: 5j4 -'domain error' -: ex 'ab__k' [ k=: 5x 'domain error' -: ex 'ab__k' [ k=: 5r4 'domain error' -: ex 'ab__k' [ k=: <0 1 0 'domain error' -: ex 'ab__k' [ k=: e =: lcreate '' NB. Can't create numeric locale explicitly, even if number is high enough @@ -353,7 +341,6 @@ x_asdf_=: i.1e4 'domain error' -: lcreate etx <2.4 'domain error' -: lcreate etx <2j4 'domain error' -: lcreate etx <2r4 -'domain error' -: lcreate etx <23x 'domain error' -: _34 lcreate etx <'asdf' 'domain error' -: 3.4 lcreate etx <'asdf' @@ -449,14 +436,12 @@ _1 -: 4!:0 <'a' 'locale error' -: lswitch etx 15000 'domain error' -: lswitch etx 2.3 'domain error' -: lswitch etx 2j3 -'domain error' -: lswitch etx 2x 'domain error' -: lswitch etx 2r3 'domain error' -: lswitch etx <0 1 0 'domain error' -: lswitch etx <2 3 4 'domain error' -: lswitch etx <2 3.4 'domain error' -: lswitch etx <2 3j4 -'domain error' -: lswitch etx <2 3x 'domain error' -: lswitch etx <2 3r4 'domain error' -: lswitch etx <<'abc' @@ -585,7 +570,6 @@ ldestroy (0&".@>) (lcreate'') , (lcreate'') 'domain error' -: ldestroy etx 'abc' 'domain error' -: ldestroy etx 2 3.4 'domain error' -: ldestroy etx 2 3j4 -'domain error' -: ldestroy etx 2 3x 'domain error' -: ldestroy etx 2 3r4 'domain error' -: ldestroy etx 2;3 4 @@ -593,7 +577,6 @@ ldestroy (0&".@>) (lcreate'') , (lcreate'') 'domain error' -: ldestroy etx <2 3 4 'domain error' -: ldestroy etx <2 3.4 'domain error' -: ldestroy etx <2 3j4 -'domain error' -: ldestroy etx <2 3 4x 'domain error' -: ldestroy etx <2 3r4 'domain error' -: ldestroy etx <<'abc' 'domain error' -: ldestroy etx <<'234' diff --git a/test/gmean.ijs b/test/gmean.ijs index b2da1697..c8a4994b 100644 --- a/test/gmean.ijs +++ b/test/gmean.ijs @@ -21,12 +21,12 @@ f=: 4 : 0 0 1 2 3 f"0 _ t=: 13 17 37 ?@$ 4e8 0 1 2 3 f"0 _ t=: 0.1 * 13 17 37 ?@$ 1e4 0 1 2 3 f"0 _ t=: j./ 2 13 17 37 ?@$ 1e4 -0 1 2 3 f"0 _ t=: x: 2 3 5 ?@$ 1e4 +0 1 2 3 f"0 _ t=: 2 3 5 ?@$ 1e4 0 1 2 3 f"0 _ t=: 3r7 * 2 3 5 ?@$ 1e4 1 2 3 f"0 _ t=: $. (2 3 5 ?@$ 2000) * 2 3 5 ?@$ 2 1 2 3 f"0 _ t=: $. 0.1 * (2 3 5 ?@$ 2000) * 2 3 5 ?@$ 2 1 [ 9!:57 (1) NB. disable auditing, since next line is slow -0 1 2 3 f"0 _ t=: x: 13 17 37 ?@$ 1e4 +0 1 2 3 f"0 _ t=: 13 17 37 ?@$ 1e4 0 1 2 3 f"0 _ t=: 3r7 * 13 17 37 ?@$ 1e4 1 2 3 f"0 _ t=: $. (13 17 37 ?@$ 2000) * 13 17 37 ?@$ 2 1 2 3 f"0 _ t=: $. 0.1 * (13 17 37 ?@$ 2000) * 13 17 37 ?@$ 2 @@ -42,8 +42,8 @@ f=: 4 : 0 1 ) -f&>/~ 0 1;(i.100);(1e7*i.100);(0.1*i.100);((j. |.) i. 100);(i. 100x); (i. 100x) % 2 -(0 1;(i.100);1e7*i.100) f&>/ (, (x: ; 4r7&+)@(1&{::) (,<) ^@o.@j.@(2&{::)) (<200 2) ?@$&.> 2 2e9 0 +f&>/~ 0 1;(i.100);(1e7*i.100);(0.1*i.100);((j. |.) i. 100);(i. 100); (i. 100) % 2 +(0 1;(i.100);1e7*i.100) f&>/ (, ( ; 4r7&+)@(1&{::) (,<) ^@o.@j.@(2&{::)) (<200 2) ?@$&.> 2 2e9 0 4!:55 ;:'f mean r t xx yy' diff --git a/test/gnan.ijs b/test/gnan.ijs index 64ebac9a..ee8e74c4 100644 --- a/test/gnan.ijs +++ b/test/gnan.ijs @@ -1,11 +1,11 @@ 1:@:(dbr bind Debug)@:(9!:19)2^_44[(echo^:ECHOFILENAME) './gnan.ijs' NB. NaN ----------------------------------------------------------------- -t1=. }.&.> 3.4 _ __; 3j4 _ __; 34x _ __ ; 3r4 _ __ +t1=. }.&.> 3.4 _ __; 3j4 _ __; 34 _ __ ; 3r4 _ __ pinf=: {.&.> t1 ninf=: {:&.> t1 inf =: pinf,ninf -zero=: 0 ; -&.>~ 2 ; 3.4 ; 3j4 ; 3x ; 3r4 +zero=: 0 ; -&.>~ 2 ; 3.4 ; 3j4 ; 3 ; 3r4 znan=: {. _. 3j4 NB. =<>_ +*-% ^$~| .:,; #!/\ []{} "`@&? @@ -27,29 +27,16 @@ NB. +*-% ---------------------------------------------------------------- (<'NaN error') = inf +.etx&.>/ x=: 20 ?@$ 2 (<'NaN error') = inf +.etx&.>/~ x -(<'NaN error') = inf +.etx&.>/ x=: 0, _5e3+20 ?@$ 1e4 -(<'NaN error') = inf +.etx&.>/~ x (<'NaN error') = inf +.etx&.>/ x=: 0, o. _5e3+20 ?@$ 1e4 (<'NaN error') = inf +.etx&.>/~ x (<'NaN error') = inf +.etx&.>/ x=: 0, r. _5e3+20 ?@$ 1e4 (<'NaN error') = inf +.etx&.>/~ x -(<'NaN error') = inf +.etx&.>/ x=: 0, _5000 +20 ?@$ 10000 -(<'NaN error') = inf +.etx&.>/~ x (<'NaN error') = inf +.etx&.>/ x=: 0, 4%~_5000 +20 ?@$ 10000 (<'NaN error') = inf +.etx&.>/~ x 'domain error' -: _. +: etx 1 'domain error' -: 0 +: etx _. -(<0) = zero *&.>/ inf -(<0) = inf *&.>/ zero - -NB. x=: 4{. 2 (3!:3) 0j1 -NB. t=: _4{. 2 (3!:3) _. __ 0 _ -NB. y=: 3!:2&.> ( (,{;~i.#t){&.> / y -NB. (<0) = zero *&.> /~ y - (<'NaN error') = * etx&.> j./~ _ __ 'NaN error' -: 3j4 * etx _j__ @@ -57,14 +44,10 @@ NB. (<0) = zero *&.> /~ y (<'NaN error') = inf *.etx&.>/ x=: 20 ?@$ 2 (<'NaN error') = inf *.etx&.>/~ x -(<'NaN error') = inf *.etx&.>/ x=: 0, _5e3+20 ?@$ 1e4 -(<'NaN error') = inf *.etx&.>/~ x (<'NaN error') = inf *.etx&.>/ x=: 0, o. _5e3+20 ?@$ 1e4 (<'NaN error') = inf *.etx&.>/~ x (<'NaN error') = inf *.etx&.>/ x=: 0, r. _5e3+20 ?@$ 1e4 (<'NaN error') = inf *.etx&.>/~ x -(<'NaN error') = inf *.etx&.>/ x=: 0, _5000 +20 ?@$ 10000 -(<'NaN error') = inf *.etx&.>/~ x (<'NaN error') = inf *.etx&.>/ x=: 0, 4%~_5000 +20 ?@$ 10000 (<'NaN error') = inf *.etx&.>/~ x @@ -76,8 +59,6 @@ NB. (<0) = zero *&.> /~ y 'NaN error' -: (1$.1e9;0;_) - etx 1$.1e9;0;_ -(<0) = zero %&.>/ zero - (<'NaN error') = % etx&.>/~ inf 'NaN error' -: (1$.1e9;0;_) % etx 1$.1e9;0;__ @@ -96,24 +77,16 @@ NB. ^$~| ---------------------------------------------------------------- NB. funny business if moved as doubles (a.{~32$240 255) -: 32 $ 240 255{a. -(($zero)$,:inf) -: zero |&.>/ inf - -(<'NaN error') = inf | etx&.>/~ x=: 1+7 ?@$ 40 (<'NaN error') = inf | etx&.>/~ x=: r. 7 ?@$ 40 -(<'NaN error') = inf | etx&.>/~ x=: - 1+7 ?@$ 40 (<'NaN error') = inf | etx&.>/~ x=: 100%~ 1+7 ?@$ 40 (<'NaN error') = inf | etx&.>/~ x=: _100%~ 1+7 ?@$ 40 -x ="1 pinf |&>/ x=: 1+7 ?@$ 40 x ="1 pinf |&>/ x=: 100%~ 1+7 ?@$ 40 -pinf = pinf |&.>/ x=: - 1+7 ?@$ 40 pinf = pinf |&.>/ x=: _100%~ 1+7 ?@$ 40 -ninf = ninf |&.>/ x=: 1+7 ?@$ 40 ninf = ninf |&.>/ x=: 100%~ 1+7 ?@$ 40 -x ="1 ninf |&>/ x=: - 1+7 ?@$ 40 x ="1 ninf |&>/ x=: _100%~ 1+7 ?@$ 40 @@ -180,7 +153,6 @@ x -:&(3!:1) _2 (3!:5) 2 (3!:5) x=: 3 4 _. 'NaN error' -: %/ etx _ (2?1e9)}1$.1e9;0;1.5-0.5 (<'NaN error') = (+/%#)etx&.> pinf ,&.>/ ninf -(<'NaN error') = (+/%#)etx&.> (<2 3) ,&.> pinf ,&.>/ ninf (<'NaN error') = +//. etx&.> 2 2&$@(1&,)&.> pinf ,&.>/ ninf @@ -199,10 +171,7 @@ x -:&(3!:1) _2 (3!:5) 2 (3!:5) x=: 3 4 _. 'NaN error' -: 3 (+/%#)\ etx _ 4 __ 5 2 _ _ _ 5 -: 3 (+/%#)\ 1 2 3 _ 4 5 6 -(<,_ ) = 3 +/\ &.> 3#&.> pinf (<,__) = 3 +/\ &.> 3#&.> ninf -(<,_ ) = 3 (+/%#)\&.> 3#&.> pinf -(<,__) = 3 (+/%#)\&.> 3#&.> ninf (<'NaN error') = +/\. etx&.> pinf ,&.>/ ninf (<'NaN error') = -/\. etx&.> ,&.>/~ pinf @@ -224,14 +193,6 @@ NB. "`@&? --------------------------------------------------------------- (<,'_') = ":&.> pinf (<'__') = ":&.> ninf -x=: 1 _1 ; 3.5 _3.5 ; 3j4 _3j_4; 3 _3x ; 3r5 _3r5 -(<'NaN error') = x +/@:* etx&.>/ 2#&.>inf - -x=: 2#&.> 2; 3.5 ; 3j4 ; _3x ; 3r5 -(<'NaN error') = x -/@:* etx&.>/ 2#&.>inf - -(<0) = zero +/@:*&.>/ pinf ,&.>/ ninf - 'NaN error' -: +/@, etx 2 2$1 _ __ 'NaN error' -: +/@, etx $. 2 2$1 _ __ diff --git a/test/gnum.ijs b/test/gnum.ijs index 5340def6..3ce6eec9 100644 --- a/test/gnum.ijs +++ b/test/gnum.ijs @@ -54,9 +54,6 @@ x=: 1e4 ?@$ IF64{2e9 9e18 x eq ". ": x (-x) eq ". ": -x -(4=type x) *. 0 = (- y) - x=: ". '_',": y=: 2^IF64{31 63x -(4=type x) *. 0 = (<:y) - x=: ". ": <: y=: 2^IF64{31 63x - 1=type@> 0;1;0 1 4=type@> 00;01 8=type@> 1.2;1.0;1.;1. 0 diff --git a/test/gpco.ijs b/test/gpco.ijs index 904ebf27..1348ea07 100644 --- a/test/gpco.ijs +++ b/test/gpco.ijs @@ -31,8 +31,6 @@ NB. LeVeque, Fundamentals of Number Theory, Addison-Wesley, 1977, p. 5. 4 = 3!:0 p: 100 4 = 3!:0 p: {.100 4.5 -64 = 3!:0 p: 100x -64 = 3!:0 p: 100r1 'domain error' -: p: etx _1 'domain error' -: p: etx <.-2^31 @@ -42,7 +40,7 @@ NB. LeVeque, Fundamentals of Number Theory, Addison-Wesley, 1977, p. 5. 'domain error' -: p: etx 3j4 'limit error' -: p: etx 1e30 -'limit error' -: p: etx 10^30x +'limit error' -: p: etx 10^30 P100 =: 2 3 5 7 11 13 17 19 23 29 31 37 41 43 47 53 59 61 67 71 73 79 83 89 97 plt100 =: P100&< # P100"_ diff --git a/test/gpco2.ijs b/test/gpco2.ijs index e9d4bd05..1fe8ca1e 100644 --- a/test/gpco2.ijs +++ b/test/gpco2.ijs @@ -9,11 +9,7 @@ isprime=: (1 = #@q:) :: 0: "0 x=: <._1+2^31 (1&p: -: isprime) x- i.50 -(1&p: -: isprime) x- i.50x (1&p: -: isprime) x-2*i.50 -(1&p: -: isprime) x-2*i.50x -(1&p: -: isprime) x+ i:50 -(1&p: -: isprime) x+2*i:50 1 p: x=: p: 10 ?@$ 1e7 @@ -22,37 +18,30 @@ x=: <._1+2^31 x=: i: 30 b=: x e. i.&.(p:^:_1) 30 b -: 1 p: x=: i: 30 -b -: 1 p: x: x -b -: 1 p: x+-~0.5 -b -: 1 p: x+-~0j5 +b -: 1 p: x b -: 1 p: x+-~1r5 f1=: 3 : 0 c=. 4 p: y - assert. c -: 4 p: x: y + assert. c -: 4 p: y assert. 1 p: c assert. 0 p: ; (1+y) +&.> i.&.>c-1+y 1 ) -2 3 -: 4 p: __ 2 -2 3 -: 4 p: __ 2x (($x)$2) -: 4 p: x=: 100 ?@$ 2 (p: i.x) -: 4&p:^:( i.&.>y-1+c 1 @@ -61,12 +50,9 @@ f2=: 3 : 0 f2 x=: 3+100 ?@$ 1e8 f2 x=: p: 1+100 ?@$ 1e6 -(_4 p: 2.1) -: _4 p: 3 - tot=: 3 : '+/1=y+.i.y' " 0 0 1 1 = 5 p: 0 1 2 (tot -: 5&p:) i.4 5 -(tot -: 5&p:) i.4 5x (tot -: 5&p:) x=: 100 ?@$ 1000 tot=: 3 : 0 " 0 @@ -77,11 +63,6 @@ tot=: 3 : 0 " 0 (tot -: 5&p:) x=: 100 ?@$ 2e9 (tot -: 5&p:) x=: 1 + */"1 ] 5 10 ?@$ 100 -x=: 100 -y=: +/1000$0.1 -c=: _4 _1 0 1 2 3 4 5 -(c p:&.>x) -: c p:&.>y - '4&p:' -: _4&p: b. _1 'p:' -: _1&p: b. _1 '*/@(^/)"2 :.(2&p:)' -: 2&p: b. _1 @@ -102,10 +83,6 @@ c=: _4 _1 0 1 2 3 4 5 'domain error' -: 1 p: etx 13x _ 'domain error' -: 1 p: etx 13x __ -'domain error' -: 1 p: etx 1.3 _ -'domain error' -: 1 p: etx 1.3 __ -'domain error' -: 1 p: etx 1j3 _ -'domain error' -: 1 p: etx 1j3 __ 'domain error' -: 4 p: etx 2 3j4 'domain error' -: 4 p: etx '234' @@ -115,7 +92,6 @@ c=: _4 _1 0 1 2 3 4 5 'domain error' -: _4 p: etx 4 3 2 'domain error' -: _4 p: etx 4 3 2x -'domain error' -: _4 p: etx 1.9 12 'domain error' -: _4 p: etx _5 12 'domain error' -: _4 p: etx _5 12x 'domain error' -: _4 p: etx 0 1 0 0 diff --git a/test/gpdd.ijs b/test/gpdd.ijs index abdbdbf8..01601a08 100644 --- a/test/gpdd.ijs +++ b/test/gpdd.ijs @@ -10,13 +10,6 @@ NB. p.. y --------------------------------------------------------------- (,!6 ) -: p..^:6 ]7 $1 (,!88) -: p..^:88 ]89$1 -1: 0 : 0 NB. removed from 901 -( 2&o. t. i.10x) -: p.. 1&o. t. i.11x -(-@(1&o.) t. i.10x) -: p.. 2&o. t. i.11x -( 6&o. t. i.10x) -: p.. 5&o. t. i.11x -( 5&o. t. i.10x) -: p.. 6&o. t. i.11x -) - 'domain error' -: p.. etx 'abc' 'domain error' -: p.. etx u:'abc' 'domain error' -: p.. etx 10&u:'abc' @@ -25,7 +18,7 @@ NB. p.. y --------------------------------------------------------------- NB. x p.. y ------------------------------------------------------------- (1 2 1.5,4%3) -: 1 p.. 2 3 4 -(1 2 3r2 4r3) -: 1 p.. 2 3 4x +(1 2 3r2 4r3) -: 1 p.. 2 3 4 x -: ({.x) p.. p.. x=: ?10$100 diff --git a/test/gpoly.ijs b/test/gpoly.ijs index 900aca18..1cf18aba 100644 --- a/test/gpoly.ijs +++ b/test/gpoly.ijs @@ -34,34 +34,7 @@ test j./_10+?2 9$25 4!:55 ;:'c d r x z' (1;n$_1) -: p. n!~i.>:n=:>:?15 -(n!~i.>:n) -: p. :n) -: p. | (p.&< p. ]) r=:1 0 1 -1e_14 > | (p.&< p. ]) r=:1 0 1 1 -1e_14 > | (p.&< p. ]) r=:2 3 4 -1e_14 > | (p.&< p. ]) r=:2 3 4 5 -1e_14 > | (p.&< p. ]) r=:2 3 4.5 -1e_14 > | (p.&< p. ]) r=:2 3 4.5 6 -1e_14 > | (p.&< p. ]) r=:1j2 3j4 5 -1e_14 > | (p.&< p. ]) r=:1j2 3j4 5 6 -1e_14 > | (p.&< p. ]) r=:5j7 5j_7 1j2 - -(p./ y -(0 1;1 3;2.5 3.2;2j1 3j1;3x 2x;4r3 8r5) f&>/ y -(0 1 1;1 3 2;2.5 3.2 _1.4;2j1 3j1 0.5j_1;3x 2x 4x;4r3 8r5 6) f&>/ y +y =: (10 ?@$ 2);(_500 + 10 ?@$ 1000);(_5 10 p. 10 ?@$ 0);(j./ _5 10 p. 2 10 ?@$ 0);(_500 + 10 ?@$ 1000);(_2 (+ 0&=) _500 + 10 2 ?@$ 1000);_ __ 0 0 __ _ _ _ __ __ +(0;1;2.5;2j1;3;4r3) f&>/ y +(0 1;1 3;2.5 3.2;2j1 3j1;3 2;4r3 8r5) f&>/ y +(0 1 1;1 3 2;2.5 3.2 _1.4;2j1 3j1 0.5j_1;3 2 4;4r3 8r5 6) f&>/ y (<2.5 3.2 _1.4 _) f&>/ y (<2.5 3.2 _1.4 __) f&>/ y (<2.5 _1.4 _) f&>/ y @@ -283,11 +250,11 @@ y =: (10 ?@$ 2);(_500 + 10 ?@$ 1000);(_5 10 p. 10 ?@$ 0);(j./ _5 10 p. 2 10 ?@$ (<2.5 __ _1.4) f&>/ y (<2.5 _) f&>/ y (<2.5 __) f&>/ y -(0 1 1 0;1 3 2 0;2.5 3.2 _1.4 0;2j1 3j1 0.5j_1 0;3x 2x 4x 0;4r3 8r5 6 0) f&>/ y -(<@(1.9&;"0) 0;1;2.5;2j1;3x;4r3) f&>/ y -(<@(1.9&;"0) 0 1;1 3;2.5 3.2;2j1 3j1;3x 2x;4r3 8r5) f&>/ y -(<@(1.9&;"0) 0 1 1;1 3 2;2.5 3.2 _1.4;2j1 3j1 0.5j_1;3x 2x 4x;4r3 8r5 6) f&>/ y -(<@(1.9&;"0) 0 1 1 0;1 3 2 0;2.5 3.2 _1.4 0;2j1 3j1 0.5j_1 0;3x 2x 4x 0;4r3 8r5 6 0) f&>/ y +(0 1 1 0;1 3 2 0;2.5 3.2 _1.4 0;2j1 3j1 0.5j_1 0;3 2 4 0;4r3 8r5 6 0) f&>/ y +(<@(1.9&;"0) 0;1;2.5;2j1;3;4r3) f&>/ y +(<@(1.9&;"0) 0 1;1 3;2.5 3.2;2j1 3j1;3 2;4r3 8r5) f&>/ y +(<@(1.9&;"0) 0 1 1;1 3 2;2.5 3.2 _1.4;2j1 3j1 0.5j_1;3 2 4;4r3 8r5 6) f&>/ y +(<@(1.9&;"0) 0 1 1 0;1 3 2 0;2.5 3.2 _1.4 0;2j1 3j1 0.5j_1 0;3 2 4 0;4r3 8r5 6 0) f&>/ y NB. x p.!.s y ----------------------------------------------------------- diff --git a/test/gq.ijs b/test/gq.ijs index 2ab70de5..8042c49e 100644 --- a/test/gq.ijs +++ b/test/gq.ijs @@ -16,23 +16,15 @@ NB. = ------------------------------------------------------------------- a=: ?13$2 b=: b,-b=:%/1+?2 20$5 (a=/b) -: a ( [ =/ x:@]) b -(a=/b) -: a (x:@[ =/ ]) b -(a=/b) -: a (x:@[ =/ x:@]) b a=: _50+?13$100 b=: b,-b=:%/1+?2 20$5 (a=/b) -: a ( [ =/ x:@]) b -(a=/b) -: a (x:@[ =/ ]) b -(a=/b) -: a (x:@[ =/ x:@]) b a=: a,-a=:%/1+?2 20$20 b=: b,-b=:%/1+?2 20$20 (a= b) -: a ( [ = x:@]) b -(a= b) -: a (x:@[ = ]) b -(a= b) -: a (x:@[ = x:@]) b (a=/b) -: a ( [ =/ x:@]) b -(a=/b) -: a (x:@[ =/ ]) b -(a=/b) -: a (x:@[ =/ x:@]) b 1 0 1 -: 1r2 3r4 2r5 = 0.5 3j4 0.4 0 0 0 -: 1r2 = 'abc' @@ -44,23 +36,15 @@ NB. < ------------------------------------------------------------------- a=: ?13$2 b=: b,-b=:%/1+?2 20$20 (a ------------------------------------------------------------------- a=: ?13$2 b=: b,-b=:%/1+?2 20$20 (a>/b) -: a ( [ >/ x:@]) b -(a>/b) -: a (x:@[ >/ ]) b -(a>/b) -: a (x:@[ >/ x:@]) b a=: _5000+?13$10000 b=: b,-b=:%/1+?2 20$20 (a>/b) -: a ( [ >/ x:@]) b -(a>/b) -: a (x:@[ >/ ]) b -(a>/b) -: a (x:@[ >/ x:@]) b a=: a,-a=:%/1+?2 20$20 b=: b,-b=:%/1+?2 20$20 (a>/b) -: a ( [ >/ x:@]) b -(a>/b) -: a (x:@[ >/ ]) b -(a>/b) -: a (x:@[ >/ x:@]) b 'domain error' -: 1r2 > etx 3j4 'domain error' -: 1r2 > etx 'a' @@ -165,20 +127,14 @@ NB. >. ------------------------------------------------------------------ a=: ?13$2 b=: b,-b=:%/1+?2 20$20 (a>./b) -: a ( [ >./ x:@]) b -(a>./b) -: a (x:@[ >./ ]) b -(a>./b) -: a (x:@[ >./ x:@]) b a=: _5000+?13$10000 b=: b,-b=:%/1+?2 20$20 (a>./b) -: a ( [ >./ x:@]) b -(a>./b) -: a (x:@[ >./ ]) b -(a>./b) -: a (x:@[ >./ x:@]) b a=: a,-a=:%/1+?2 20$20 b=: b,-b=:%/1+?2 20$20 (a>./b) -: a ( [ >./ x:@]) b -(a>./b) -: a (x:@[ >./ ]) b -(a>./b) -: a (x:@[ >./ x:@]) b 'domain error' -: 1r2 >. etx 3j4 'domain error' -: 1r2 >. etx 'a' @@ -193,23 +149,15 @@ NB. >: ------------------------------------------------------------------ a=: ?13$2 b=: b,-b=:%/1+?2 20$20 (a>:/b) -: a ( [ >:/ x:@]) b -(a>:/b) -: a (x:@[ >:/ ]) b -(a>:/b) -: a (x:@[ >:/ x:@]) b a=: _5000+?13$10000 b=: b,-b=:%/1+?2 20$20 (a>:/b) -: a ( [ >:/ x:@]) b -(a>:/b) -: a (x:@[ >:/ ]) b -(a>:/b) -: a (x:@[ >:/ x:@]) b a=: a,-a=:%/1+?2 20$20 b=: b,-b=:%/1+?2 20$20 (a>: b) -: a ( [ >: x:@]) b -(a>: b) -: a (x:@[ >: ]) b -(a>: b) -: a (x:@[ >: x:@]) b (a>:/b) -: a ( [ >:/ x:@]) b -(a>:/b) -: a (x:@[ >:/ ]) b -(a>:/b) -: a (x:@[ >:/ x:@]) b 'domain error' -: 1r2 >: etx 3j4 'domain error' -: 1r2 >: etx 'a' @@ -233,11 +181,7 @@ _11r6 -: _1r2 + _4r3 a=: a,-a=:%/1+?2 20$20 b=: b,-b=:%/1+?2 20$20 -*./ 1e_14 > , (a+/b) - a (x:@[ +/ x:@]) b *./ 1e_14 > , (a+/b) - a ( [ +/ x:@]) b -*./ 1e_14 > , (a+/b) - a (x:@[ +/ ]) b - -(+/%x) -: +/ % x: x=:1+i.12 'domain error' -: 1r2 + etx 'a' 'domain error' -: 1r2 + etx <12 @@ -262,11 +206,7 @@ _2r3 -: _1r2 * 4r3 a=: a,-a=:%/1+?2 20$20 b=: b,-b=:%/1+?2 20$20 -(a*/b) -: a (x:@[ */ x:@]) b (a*/b) -: a ( [ */ x:@]) b -(a*/b) -: a (x:@[ */ ]) b - -1e_16 > | (*/%x) - */ % x: x=:1+i.9 'domain error' -: 1r2 * etx 'a' 'domain error' -: 1r2 * etx <12 @@ -291,11 +231,7 @@ _11r6 -: _1r2 - 4r3 a=: a,-a=:%/1+?2 20$20 b=: b,-b=:%/1+?2 20$20 -*./ 1e_14 > , (a-/b) - a (x:@[ -/ x:@]) b *./ 1e_14 > , (a-/b) - a ( [ -/ x:@]) b -*./ 1e_14 > , (a-/b) - a (x:@[ -/ ]) b - -(-/%x) -: -/ % x: x=:1+i.12 'domain error' -: 1r2 - etx 'a' 'domain error' -: 1r2 - etx <12 @@ -317,11 +253,7 @@ _3r8 -: _1r2 % 4r3 a=: a,-a=:%/1+?2 20$20 b=: b,-b=:%/1+?2 20$20 -(a%/b) -:!.1e_13 a (x:@[ %/ x:@]) b (a%/b) -:!.1e_13 a ( [ %/ x:@]) b -(a%/b) -:!.1e_13 a (x:@[ %/ ]) b - -(%/%x) -: %/ % x: x=:1+i.12 0 = 0 % 0r1 _ = 4 % 0r1 @@ -346,13 +278,10 @@ Hilbert=: x: @: % @: >: @: (+/~) @: i. (=i.#h) -: h +/ .* %. h=: Hilbert 6 (=i.#h) -: h +/ .* %. h=: Hilbert 7 -(%. -: %.@:x:) i.8 -(%. -: %.@:x:) ,8 -(%. -: %.@:x:) 8 (%. -: %.@:x:) i.0 -1e_13 > >./| , (%. - %.@:x:) x=:_50+?7 7$100 -1e_13 > >./| , (%. - %.@:x:) x=:_50+?7 5$100 - +1e_13 > >./| , (%. - %.@:) x=:_50+?7 7$100 +1e_13 > >./| , (%. - %.@:) x=:_50+?7 5$100 + 'domain error' -: %. etx 3 3$1r2 @@ -380,31 +309,18 @@ NB. ^ ------------------------------------------------------------------- (rat x) *. 0r1 = x=: 0r1 ^ 1 (rat x) *. 0r1 = x=: 0r1 ^ 5 -(rat x) *. 0r1 = x=: 0r1 ^ 5x -(xint x) *. 0r1 = x=: 0x ^ 1 -(xint x) *. 0r1 = x=: 0x ^ 5 -(xint x) *. 0r1 = x=: 0x ^ 5x (rat x) *. 0r1 = x=: 0r1 ^ 5r2 (rat x) *. 0r1 = x=: 0r1 ^ 1 2 3 5r2 (fl x) *. 0 = x=: 0r1 ^ 1p1 (rat x) *. 1r1 = x=: 0r1 ^ 0 -(rat x) *. 1r1 = x=: 0r1 ^ 0x (rat x) *. 1r1 = x=: 0r1 ^ 0r1 -(xint x) *. 1r1 = x=: 0x ^ 0 -(xint x) *. 1r1 = x=: 0x ^ 0x -(rat x) *. 1r1 = x=: 0x ^ 0r1 - -(xint x) *. 1r1 = x=: 1x ^ 5 -(xint x) *. 1r1 = x=: 1x ^ 5x -(rat x) *. 1r1 = x=: 1x ^ 5r2 -(xint x) *. 1r1 = x=: 1x ^ _5 -(rat x) *. 1r1 = x=: 1x ^ _5r2 -(xint x) *. 1r1 = x=: 1x ^ 0 -(xint x) *. 1r1 = x=: 1x ^ _5+i.11 +(rat x) *. 1r1 = x=: 0 ^ 0r1 + +(rat x) *. 1r1 = x=: 1 ^ 5r2 +(rat x) *. 1r1 = x=: 1 ^ _5r2 (rat x) *. 1r1 = x=: 1r1 ^ 5 -(rat x) *. 1r1 = x=: 1r1 ^ 5x (rat x) *. 1r1 = x=: 1r1 ^ 5r2 (rat x) *. 1r1 = x=: 1r1 ^ _5 (rat x) *. 1r1 = x=: 1r1 ^ _5r2 @@ -445,23 +361,15 @@ NB. ~: ------------------------------------------------------------------ a=: ?13$2 b=: b,-b=:%/1+?2 20$5 (a~:/b) -: a ( [ ~:/ x:@]) b -(a~:/b) -: a (x:@[ ~:/ ]) b -(a~:/b) -: a (x:@[ ~:/ x:@]) b a=: _50+?13$100 b=: b,-b=:%/1+?2 20$5 (a~:/b) -: a ( [ ~:/ x:@]) b -(a~:/b) -: a (x:@[ ~:/ ]) b -(a~:/b) -: a (x:@[ ~:/ x:@]) b a=: a,-a=:%/1+?2 20$20 b=: b,-b=:%/1+?2 20$20 (a~: b) -: a ( [ ~: x:@]) b -(a~: b) -: a (x:@[ ~: ]) b -(a~: b) -: a (x:@[ ~: x:@]) b (a~:/b) -: a ( [ ~:/ x:@]) b -(a~:/b) -: a (x:@[ ~:/ ]) b -(a~:/b) -: a (x:@[ ~:/ x:@]) b 0 1 0 -: 1r2 3r4 2r5 ~: 0.5 3j4 0.4 1 1 1 -: 1r2 ~: 'abc' @@ -484,12 +392,6 @@ x -: 0r1 | x=:0r1 _5r2 5r2 1234567890123456789r7777 _1234567890123456789r7777 NB. . ------------------------------------------------------------------- -(-/ .* -: -/ .*@:x:) x=:_500+? 3 3$1000 -(-/ .* -: -/ .*@:x:) x=: %/1+?2 3 3$1000 - -(+/ .* -: +/ .*@:x:) x=:_500+? 3 3$1000 -(+/ .* -: +/ .*@:x:) x=: %/1+?2 3 3$1000 - NB. : ------------------------------------------------------------------- @@ -504,11 +406,11 @@ f=: 3 : 0 NB. , ------------------------------------------------------------------- -(rat x) *. 512 3r2 -: x=: 512,3r2 -(rat x) *. 5r2 3r1 -: x=: 5r2,3 -(rat x) *. 5r1 3r2 -: x=: 5x ,3r2 -(rat x) *. 5r2 3r1 -: x=: 5r2,3x -(rat x) *. 5r2 3r1 -: x=: 5r2,3 +(rat x) *. 512 3r2 -: x=: 512,3r2 +(rat x) *. 5r2 3r1 -: x=: 5r2,3 +(rat x) *. 5r1 3r2 -: x=: 5 ,3r2 +(rat x) *. 5r2 3r1 -: x=: 5r2,3 +(rat x) *. 5r2 3r1 -: x=: 5r2,3 (rat x) *. 5r2 3r4 -: x=: 5r2,3r4 (fl x) *. 2.5 3.4 -: x=: 5r2,3.4 @@ -550,7 +452,7 @@ ir =: 3!:1 ri =: 3!:2 hex=: 3!:3 -x -: ri ir x=: %/*: x:1+?2 4 5$1000000 +x -: ri ir x=: %/*: 1+?2 4 5$1000000 x -: ri hex x @@ -568,7 +470,7 @@ NB. { ------------------------------------------------------------------- ({x;y) -: x ,&.>/ y [ x=:0 1 0 1 [ y=: 5r2 _1r5 ({x;y) -: x ,&.>/ y [ x=:1 2 314 [ y=: 5r2 _1r5 -({x;y) -: x ,&.>/ y [ x=:1 2 31x [ y=: 5r2 _1r5 +({x;y) -: x ,&.>/ y [ x=:1 2 31 [ y=: 5r2 _1r5 ({x;y) -: x ,&.>/ y [ x=:1 2 3.4 [ y=: 5r2 _1r5 ({x;y) -: x ,&.>/ y [ x=:1 2 3j4 [ y=: 5r2 _1r5 @@ -584,25 +486,10 @@ NB. e. ------------------------------------------------------------------ NB. i. ------------------------------------------------------------------ -(i.5) -: i. 5r1 - 'domain error' -: i. etx 5r2 'domain error' -: i. etx 12345678901234567890r1 -x=:?1000$1000 -y=: (1000?1000){x - -(x i. x) -: x i.&:x: x -(x i. y) -: x i.&:x: y - -x=:?1000 3$1000 -y=: (1000?1000){x - -(x i. x) -: x i.&:x: x -(x i. y) -: x i.&:x: y - - NB. o. ------------------------------------------------------------------ 0 = ( o. 2%3) - o. 2r3 @@ -642,8 +529,6 @@ c=: _4 11 _13r2 1r1 NB. q: ------------------------------------------------------------------ -(q: x) -: q: x: x=:?1e9 - 'domain error' -: q: etx 5r2 'domain error' -: q: etx _9r1 @@ -651,6 +536,6 @@ NB. q: ------------------------------------------------------------------ 9!:19 ct 4!:55 ;:'a b c cmpx ct f g fl h hex Hilbert ir' -4!:55 ;:'r rat ri stope x xint y' +4!:55 ;:'r rat ri stope x y' diff --git a/test/gq101.ijs b/test/gq101.ijs index ad849a3e..5b98cbf0 100644 --- a/test/gq101.ijs +++ b/test/gq101.ijs @@ -10,18 +10,11 @@ gcd=: 4 : 0 " 0 end. ) -x=: %/ 0 1x + ?2 100$2e9 -y=: %/ 0 1x + ?2 100$2e9 +x=: %/ 0 1 + ?2 100$2e9 +y=: %/ 0 1 + ?2 100$2e9 -x (+. -: gcd) y 0 (+. -: gcd) y x (+. -: gcd) 0 x (+. -: gcd) x -x=: (+%)/\90$1x -(i{x) (+. -: gcd) j{x [ i=: ?10$#x [ j=: ?10$#x - - 4!:55 ;:'gcd i j x y' - - diff --git a/test/gq132.ijs b/test/gq132.ijs index e25466cb..1aca1af3 100644 --- a/test/gq132.ijs +++ b/test/gq132.ijs @@ -18,45 +18,4 @@ rat %: *: 7r2 (%:_3.5) -: %:_7r2 - -NB. %: ------------------------------------------------------------------ - -NB. Pell Equation -NB. Integer solutions of 1=(x^2)-N*(y^2), N not a perfect square - -NB. continued fraction expansion of %:N -NB. do computations in Z[%:N] - -cfsqrt=: 3 : 0 - N=. y - p=. 0x - q=. 1x - r=. %:N - assert. r~:<.r NB. not a perfect square - m0=. <.q%~p+r - z=. $0 - while. 1 do. - m=. <.q%~p+r - t=. (m*q)-p - q=. q%~N-*:p-m*q - p=. t - if. m=2*m0 do. x: z return. end. - z=. z, m - end. -) - -test=: 3 : 0 - N=: y - v=: cfsqrt N - 'xx yy'=: 2 x: (+%)/v - (xx^2) - N*yy^2 -) - -*./ 1 _1 e.~ t=. test"0 (-. <.&.:%:) i.100 - -*./ 1 _1 e.~ t=. test 1+*:1+?1000 - - -4!:55 ;:'cfsqrt N rat t test v xx yy' - - +4!:55 <'rat' diff --git a/test/gq201.ijs b/test/gq201.ijs index 7af0855b..d2d07026 100644 --- a/test/gq201.ijs +++ b/test/gq201.ijs @@ -1,24 +1,23 @@ 1:@:(dbr bind Debug)@:(9!:19)2^_44[(echo^:ECHOFILENAME) './gq201.ijs' -NB. ^. on extended integers and rational numbers ------------------------ +NB. ^. on integers and rational numbers ------------------------ NB. test failed on small ct (comparison tolerance) ct =: 9!:18'' 9!:19[2^_40 test=: 4 : 0 - assert. y -: x ^. x ^ x: y + assert. y -: x ^. x ^ y 1 ) 2 test y=: 2+10 10?@$300 3 test y 10 test y -16 test y 12345 test 17 12345678 test 23 -31 -: 2 ^. x=:*/31$x: 2 +31 -: 2 ^. x=:*/31$2 31 -: 2 <.@^. x 31 -: 2 >.@^. x 30 -: 2 <.@^.<:x @@ -26,26 +25,18 @@ test=: 4 : 0 31 -: 2 <.@^.>:x 32 -: 2 >.@^.>:x -0 -: 314159 <.@^. x: 1 -0 -: 314159 >.@^. x: 1 +0 -: 314159 <.@^. 1 +0 -: 314159 >.@^. 1 y1=: (1-1e4)+10 11 ?@$ 2e4-1 y2=: (1-1e8)+10 11 ?@$ 2e8-1 y3=: (1-1e9)+10 11 ?@$ 2e9-1 -(t=:2+($y1)?@$50) (<.!.0@^. -: <.@^.&.x:) |y1+0=y1 -(t=:2+($y2)?@$50) (<.!.0@^. -: <.@^.&.x:) |y2+0=y2 -(t=:2+($y3)?@$50) (<.!.0@^. -: <.@^.&.x:) |y3+0=y3 - -(t=:2+($y1)?@$50) (>.!.0@^. -: >.@^.&.x:) |y1+0=y1 -(t=:2+($y2)?@$50) (>.!.0@^. -: >.@^.&.x:) |y2+0=y2 -(t=:2+($y3)?@$50) (>.!.0@^. -: >.@^.&.x:) |y3+0=y3 - 1 = 16x <.@^. {. 123 0.5 0 = 0x ^. _5 5 __ = 1 5 6 7 ^. 0x -__ 0 _ _ = 1x ^. 0 1 2 3 +__ 0 _ _ = 1 ^. 0 1 2 3 (^. 2.5) -: ^. 5r2 @@ -53,27 +44,9 @@ __ 0 _ _ = 1x ^. 0 1 2 3 (3.7 ^. 2.5) -: 37r10 ^. 2.5 (3.7 ^. 2.5) -: 37r10 ^. 5r2 -(2048*^.2) -: ^. 2x ^2048 - -1000 -: 10 ^. 10x^1000 -2048 -: 2 ^. 2x^2048 - phi=: -:>:%:5 ((^.phi)%~300*^.100%3 ) -: phi^.100r3^300 -test=: 4 : 0 - xx=: x - yy=: y - assert. xx (^. = ^.&x:) yy - assert. xx (^. = ^.&x:) -yy - assert. (-xx) (^. = ^.&x:) yy - assert. (-xx) (^. = ^.&x:) -yy - 1 -) - -(0.07;1;1.5;2;7.8;10) test&>/ 0;0.1;1;2;2.11;1234;1234.5 - - 9!:19 ct 4!:55 ;:'ct phi t test x xx y y1 y2 y3 yy' diff --git a/test/gqco.ijs b/test/gqco.ijs index 7993ffb1..6a56859c 100644 --- a/test/gqco.ijs +++ b/test/gqco.ijs @@ -74,8 +74,8 @@ x -: (p:i.{:$y) */ .^"1 y=:(1+p:^:_1 >./x) q: x=:>:?200$10000 (_ q: x) (<\@[ -: >:@i.@#@[ q:&.> ]) x=:*/>:?4$215 -300 3 -: 2 q: 27*2^300x -(i.0) -: 0 q: 1+2^1000x +50 3 -: 2 q: 27*2^50 NB. conversion to extended happens around 27*2^59 +(i.0) -: 0 q: 1+2^50 NB. q: ------------------------------------------------------------------ @@ -134,7 +134,7 @@ f=: 3 : 0 1 ) -f x=: */ x: p: 2 ?@$ 1e8 +f x=: */ p: 2 ?@$ 1e8 f x=: 10 #. 18 ?@$ 10 f x=: 1.3e13 diff --git a/test/gqnonrat.ijs b/test/gqnonrat.ijs index db61b324..bb6283d1 100644 --- a/test/gqnonrat.ijs +++ b/test/gqnonrat.ijs @@ -27,25 +27,10 @@ exp=: nexp exp0 ] NB. (ln x*y) = (ln x)+(ln y) NB. (ln x^e) = e * ln x -ln=: 4 : 0 - assert. 0:@+:@i.@[ diff --git a/test/gr1.ijs b/test/gr1.ijs index 76eb7533..1751cb72 100644 --- a/test/gr1.ijs +++ b/test/gr1.ijs @@ -25,7 +25,6 @@ _5r2 -: 5r_2 (fl x) *. 1 2 3e20 -: x=: 1 4r2 3e20 (cmpx x) *. 1 2 3j2 -: x=: 1 4r2 3j2 (rat x) *. 1r1 2r1 _3r1 -: x=: 1 2r1 _3x -(intx x) *. 1r1 2r1 _3r1 -: x=: 1 2x _3x (rat x) *. 1 0.5 _ -: x=: 1 1r2 _ (rat x) *. 1 0.5 __ -: x=: 1 1r2 __ diff --git a/test/gsp.ijs b/test/gsp.ijs index d4c12d0a..8ce37220 100644 --- a/test/gsp.ijs +++ b/test/gsp.ijs @@ -220,12 +220,5 @@ NB. S: CSCO, CONJ, 0L, sco, NB. t. CTDOT, ADV, tdot, 0L, NB. t: CTCO, ADV, tco, 0L, NB. T. CTCAP, CONJ, 0L, tcap, - -'nonce error' -: x: etx s -'nonce error' -: 1 x: etx s -'nonce error' -: 2 x: etx s - 4!:55 ;:'i s t x y' - - diff --git a/test/gsp520sd.ijs b/test/gsp520sd.ijs index 53ae1b91..eb523ce6 100644 --- a/test/gsp520sd.ijs +++ b/test/gsp520sd.ijs @@ -24,8 +24,6 @@ f&> c [ q=: 2 1 1 3$j./?2$2e6 'nonce error' -: ($.i.2 3) { etx ;:'a b c d e f' 'nonce error' -: ($.i.2 3) { etx u:&.> ;:'a b c d e f' 'nonce error' -: ($.i.2 3) { etx 10&u:&.> ;:'a b c d e f' -'nonce error' -: ($.i.2 3) { etx i.7x -'nonce error' -: ($.i.2 3) { etx 9 % 1+i.7x 'nonce error' -: ($.i.2 3) { etx s: ' a b c d e f' 'nonce error' -: ($.i.2 3) { etx s: u: 128+a.i. ' a b c d e f' 'nonce error' -: ($.i.2 3) { etx s: 10&u: 65536+a.i. ' a b c d e f' diff --git a/test/gt.ijs b/test/gt.ijs deleted file mode 100644 index c7cdbc98..00000000 --- a/test/gt.ijs +++ /dev/null @@ -1,242 +0,0 @@ -1:@:(dbr bind Debug)@:(9!:19)2^_44[(echo^:ECHOFILENAME) './gt.ijs' - -1: 0 : 0 NB. removed from 901 -NB. t. ------------------------------------------------------------------ - -(%!i.5) = ^ t. i.5 -1 1 0 0 0 = >: t. i.5 -_1 1 0 0 0 = <: t. i.5 -0 _1 0 0 0 = - t. i.5 -1 _1 0 0 0 = -. t. i.5 -0 2 0 0 0 = +: t. i.5 -0 0.5 0 0 0 = -: t. i.5 -0 0 1 0 0 = *: t. i.5 -0 0j1 0 0 0 = j. t. i.5 -0 1p1 0 0 0 = o. t. i.5 -_9 0 0 0 0 = _9: t. i.5 -_8 0 0 0 0 = _8: t. i.5 -_7 0 0 0 0 = _7: t. i.5 -_6 0 0 0 0 = _6: t. i.5 -_5 0 0 0 0 = _5: t. i.5 -_4 0 0 0 0 = _4: t. i.5 -_3 0 0 0 0 = _3: t. i.5 -_2 0 0 0 0 = _2: t. i.5 -_1 0 0 0 0 = _1: t. i.5 -0 0 0 0 0 = 0: t. i.5 -1 0 0 0 0 = 1: t. i.5 -2 0 0 0 0 = 2: t. i.5 -3 0 0 0 0 = 3: t. i.5 -4 0 0 0 0 = 4: t. i.5 -5 0 0 0 0 = 5: t. i.5 -6 0 0 0 0 = 6: t. i.5 -7 0 0 0 0 = 7: t. i.5 -8 0 0 0 0 = 8: t. i.5 -9 0 0 0 0 = 9: t. i.5 - -17.5 0 0 0 0 = 17.5"0 t. i.5 - -3 1 0 0 0 = 3&+ t. i.5 -_7.1 1 0 0 0 = +&_7.1 t. i.5 -9 1 0 0 0 = -&_9 t. i.5 -9 1 0 0 0 = -&_9 t. i.5 -0 _1.3 0 0 0 = _1.3&* t. i.5 -0 3.21 0 0 0 = *&3.21 t. i.5 -0 4 0 0 0 = %&0.25 t. i.5 -3 0j1 0 0 0 = 3&j. t. i.5 -0j4 1 0 0 0 = j.&4 t. i.5 -1 0 0 0 0 = ^&0 t. i.5 -0 1 0 0 0 = ^&1 t. i.5 -0 0 1 0 0 = ^&2 t. i.5 -0 0 0 1 0 = ^&3 t. i.5 -0 0 0 0 1 = ^&4 t. i.5 -(y,0) = y&p. t. i.5 [ y=:_50+?4$100 -(p. r) = r&p. t. i.5 [ r=:(>:?10);_5+?4$20 - -f=: ^&3 + (_3:**:) + (3:*]) + _1: -_1 3 _3 1 0 = f t. i.5 -f=: ^&3 + (_3 **:) + (3 *]) + _1: -_1 3 _3 1 0 = f t. i.5 - -f =: ! %~ p.@<@i. -g =: 3 : 'y&! t. i.1+y' -(f -: g)"0 x: i.3 5 - -f =: i.@>: ! ] -g =: 3 : '(:y' -(f -: g)"0 i.3 5 - -(3.2&^ = (3.2&^ t.i.20)&p.) x=:(2^_10)*?2 10$1000 - -s=: (2^_10)*_1000+?2000 -c=: (2^ _4)*_10+?5$20 -f=: c&(p.!.s) -x=: j./(2^_7)*_50+?2 2 10$100 -1e_8 > (f x) %&|~ (f - f T. (#c)) x - -'domain error' -: ex '1.2&! t.' -'domain error' -: ex 'p.&1 t.' - -'rank error' -: ex '(1 2 3"_ * *:) t.' -'rank error' -: ex '(1 2 3 * *:) t.' - -'length error' -: ex '1 2 3 t.' -'length error' -: ex '+`-`* t.' - - -NB. f@g t. ------------------------------------------------------------- - -p=: (8 %~ _10+?4$20)&p. -q=: (8 %~ _10+?3$20)&p. -sin =: 1&o. - -(p@q =!.1e_11 p@q T. 20) x=: (2^ _8)*_200+?30$400 -(q@p =!.1e_11 q@p T. 20) x - -(p@sin =!.1e_11 p@sin T. 40) x=: (2^_10)*_600+?30$1200 -(q@sin =!.1e_11 q@sin T. 40) x -(p@:^ =!.1e_11 p@:^ T. 40) x -(q@:^ =!.1e_11 q@:^ T. 40) x - - -NB. %@f t. ------------------------------------------------------------- - -pp =: [: +//. */ -1e_11 > 1 -&(m&{.) p pp q=:%@(p&p.) t. i.m [ p=:>:?n$10 [ m=: +:n=: 5 -1e_11 > 1 -&(m&{.) p pp q=:%@(p&p.) t. i.m [ p=:1,}._9+?n$19 [ m=: +:n=: >:?10 - -1 1 2 3 5 8 13 21 34 55 89 = %@(1 _1 _1&p.) t. i.11x - -0 1 1 2 3 5 8 13 21 34 55 89 = (0 1&p. % 1 _1 _1&p.) t. i.12x -0 1 1 2 3 5 8 13 21 34 55 89 = (%-.-*:) t. i.12x - -1 3 3 1 0 0 0 0 0 0 -: (1 5 10 10 5 1&p. % 1 2 1&p.) t. i.10 - -((n$1 _1)*^ t. i.n) = %@^ t. i.n=: 8 - -rp =: 1 : '%@(x&p.) t.' - -(1 ^i.n) = 1 _1 rp i.n=:20 -(2 ^i.n) = 1 _2 rp i.n -(_2 ^i.n) = 1 2 rp i.n -(2.71^i.n) = 1 _2.71 rp i.n -(0j1 ^i.n) = 1 0j_1 rp i.n -(c ^i.n) = (1,-c) rp i.n=:?20 [ c=:(_1^?2)*1+(2^_8)*?1e3 - -(n$1 ) = 1 _1 rp i.n=:20 -(n$1 0 ) = 1 0 _1 rp i.n -(0=k|i.n) = (1,(-k){._1) rp i.n=:?40 [ k=:?20 - -(n{.1 ) = 1 rp i.n=:20 -(n$1 ) = 1 _1 rp i.n -(>:i.n) = 1 _2 1 rp i.n -(+/\^:0 n{.1) = %@((1 _1&pp^:0 [ 1)&p.) t.i.n -(+/\^:1 n{.1) = %@((1 _1&pp^:1 [ 1)&p.) t.i.n -(+/\^:2 n{.1) = %@((1 _1&pp^:2 [ 1)&p.) t.i.n -(+/\^:k n{.1) = %@((1 _1&pp^:k [ 1)&p.) t.i.n=:?40 [ k=:?12 - -tangent=: 3 : 0 NB. tangent numbers from 0 to y Tn+1(x)=(1+x^2)Tn'(x) - f=. [: +//. 1 0 1"_ */ [: }. [ * i.@# - {."1 f^:(i.>:y) 0 1x -() - -B=: 3 : 0 NB. Bernoulli numbers from 0 to y - t=. 1,}.}:tangent y - (* $&_1 _1 1 1@#) _1,t*n*%(* <:)2x^n=. >:i.#t -() - -(B@<:@# -: ! * (% <:@^) t.) i.13x -(B@<:@# -: (% <:@^) t:) i.13x - - -NB. %:@f t. ------------------------------------------------------------ - -taysqrt=: 4 : 0 - n=. x - a=. (1+n){.y - c=. n{.%:{.a - d=. %2*{.c - i=. 0 - while. n>i=.>:i do. c=. c i}~ d * (i{a) - (+/ .* |.) }.i{.c end. - c -() - -pp=: [: +//. */ - -NB. *** c=: _5+?7$20 -NB. *** d=: %:@(c&p.) t. i.20 -NB. *** d -: 20 taysqrt c -NB. *** c -: (#c){. +//.@(*/)~ d -NB. *** 1e_12 > | (#c)}. 20{.+//.@(*/)~ d - - -NB. f^:n t. ------------------------------------------------------------ - -(>:^: 3 t. -: >:@>:@>: t.) i.2 10 -(>:^:_3 t. -: <:@<:@<: t.) i.2 10 - -f=: (1+?3$5)&p. -(f^:4 t. -: f@f@f@f t.) i.4 10 - - -NB. t. circle functions ----------------------------------------------- - -sin =: 1&o. -cos =: 2&o. -sinh =: 5&o. -cosh =: 6&o. -asin =: _1&o. -atan =: _3&o. -asinh =: _5&o. -atanh =: _7&o. - -0 1 0 _1 0 1 0 _1 0 1 -: sin t: i.10 -0 1 0 _1 0 1 0 _1 0 1 -: -: (^ - ^&-) &.j. t: i.10 -0 1 0 _1 0 1 0 _1 0 1 -: (0j2"0 %~ ^@j. - ^@-@j.) t: i.10 -0 1 0 _1 0 1 0 _1 0 1 -: (* '' H. 3r2@(_1r4&*)@*:)t: i.10 - -1 0 _1 0 1 0 _1 0 1 0 -: cos t: i.10 -1 0 _1 0 1 0 _1 0 1 0 -: -: (^@j. + ^@j.&-) t: i.10 -1 0 _1 0 1 0 _1 0 1 0 -: ( 2: %~ ^@j. + ^@-@j.) t: i.10 -1 0 _1 0 1 0 _1 0 1 0 -: '' H. 1r2@(_1r4&*)@*: t: i.10 - -0 1 0 1 0 1 0 1 0 1 -: sinh t: i.10 -0 1 0 1 0 1 0 1 0 1 -: -: (^ - ^&-) t: i.10 -0 1 0 1 0 1 0 1 0 1 -: (2: %~ ^ - ^@-) t: i.10 -0 1 0 1 0 1 0 1 0 1 -: (* '' H. 3r2@(1r4&*)@*:) t: i.10 - -1 0 1 0 1 0 1 0 1 0 -: cosh t: i.10 -1 0 1 0 1 0 1 0 1 0 -: -: (^ + ^&-) t: i.10 -1 0 1 0 1 0 1 0 1 0 -: (2: %~ ^ + ^@-) t: i.10 -1 0 1 0 1 0 1 0 1 0 -: '' H. 1r2@(1r4&*)@*: t: i.10 - -1e_16 > | (20{.1) - (*:@cos + *:@sin ) t. i.20 -1e_16 > | (20{.1) - (*:@cosh - *:@sinh) t. i.20 -1e_16 > | (20{.1) - ((cos ^2:) + (sin ^2:)) t. i.20 -1e_16 > | (20{.1) - ((cosh^2:) - (sinh^2:)) t. i.20 - -(sin = sin T. 20) x=: (2^_6)*_50+?2 10$100 -(cos = cos T. 20) x=: (2^_6)*_50+?2 10$100 -(sinh = sinh T. 20) x=: (2^_6)*_50+?2 10$100 -(cosh = cosh T. 20) x=: (2^_6)*_50+?2 10$100 - -(asin =!.1e_12 asin T. 20) x=: (2^_10)*?2 10$250 -(atan =!.1e_12 atan T. 20) x=: (2^_10)*?2 10$250 -(asinh =!.1e_12 asinh T. 20) x=: (2^_10)*?2 10$250 -(atanh =!.1e_12 atanh T. 20) x=: (2^_10)*?2 10$250 - -d=: [: 1e_13&>@| - % (+0&=)@] -x=: (2^_7)*_1e2+?20$2e2 -(f T. 20 d f=:sin + cos) x -(f T. 20 d f=:sin - cos) x -(f T. 20 d f=:sin * cos) x -(f T. 20 d f=:cos * ^ ) x -(f T. 80 d f=:sin % cos) x - -phi=: -:%:5 -0 1 1 2 3 5 8 13 21 34 55 89 -: (^@-: * sinh&.(phi&*)) t: i.12 - - -4!:55 ;:'asin asinh atan atanh B c cos cosh d f g k ' -4!:55 ;:'m n p phi pp q r rp s sin sinh tangent taysqrt x y ' - -) diff --git a/test/gx132.ijs b/test/gx132.ijs deleted file mode 100644 index 7386272e..00000000 --- a/test/gx132.ijs +++ /dev/null @@ -1,32 +0,0 @@ -1:@:(dbr bind Debug)@:(9!:19)2^_44[(echo^:ECHOFILENAME) './gx132.ijs' -NB. %: on extended integers --------------------------------------------- - -0 1 _ -: 0x %: 0 1 2x -0 1 _ -: 0 %: 0 1 2 - -(i:5) (%: -: %:&x:) 0 -(i:5) (%: -: %:&x:) 1 - -0 (%: -: %:&x:) i.5 -1 (%: -: %:&x:) i:5 - -2 (%: -: %:&x:) - 0 1 -2 (%: -: %:&x:) - 4 5 6 -3 (%: -: %:&x:) - 0 1 -3 (%: -: %:&x:) - 4 5 6 - -(%:%2) -: _2 %: 2x - -test=: 4 : 0 - n=: x: x - r=: x: y - yy=: r^n - assert. r = n %: yy - assert. (r-1) = n <.@%: yy-1 - assert. (r+1) = n >.@%: yy+1 - 1 -) - -4!:55 ;:'n r test yy' - - diff --git a/test/gxco.ijs b/test/gxco.ijs index fb4f1c27..31caec3a 100644 --- a/test/gxco.ijs +++ b/test/gxco.ijs @@ -1,20 +1,14 @@ 1:@:(dbr bind Debug)@:(9!:19)2^_44[(echo^:ECHOFILENAME) './gxco.ijs' NB. x: ------------------------------------------------------------------ -(x: 4) -: x: {: 3.4 4 -(x: 4) -: x: {: 3j4 4 +4 -: x: {: 3.4 4 +4 -: x: {: 3j4 4 7r2 -: x: 3.5 3r5 -: x: 3r5 7r100 -: x: 0.07 271r100 -: x: 2.71 -64 -: type x: 0 -64 -: type x: 1 -64 -: type x: 0 1 -64 -: type x: _5 999999 -64 -: type x: 2147483647 _2147483648 0 9 - 128 -: type x: -~2.5 128 -: type x: o. 0 128 -: type x: 1 2 3 4 5 6.5 @@ -22,10 +16,7 @@ NB. x: ------------------------------------------------------------------ 128 -: type x: _ 128 -: type x: __ -(2^ 53x) = x: 2^ 53 -(2^_53x) = x: 2^_53 -(=<.) x: !20+i.30 -(=<.) % x: % !20+i.30 +(2^_53) = x: 2^_53 'domain error' -: x: etx 3j5 'domain error' -: x: etx '345' @@ -40,47 +31,13 @@ NB. 'domain error' -: x: etx _. 'domain error' -: _3 x: etx 1.5 'domain error' -: 0 x: etx 1.5 -(0 1 0 1 ,. 1x) -: 2 x: 0 1 0 1 -(1 2 3 4 ,. 1x) -: 2 x: 1 2 3 4 -(3 5 7 9 ,. 2x) -: 2 x: 1 2 3 4+0.5 - (= x:) ,1 _1 */ 1e43 1e_43 (= x:) ,1 _1 */ 2^137 _137 (": -: ":@(+&(-~1r2)))@x:"0 ] ,1 _1 */ 1e43 1e_43 (": -: ":@(+&(-~1r2)))@x:"0 ] ,1 _1 */ 2^137 _137 -_ = 10^309x -0 = 1.2 % 10^309x +_ = 10^309 +0 = 1.2 % 10^309 'ill-formed number' -: ex '1x ___' - - -NB. x: conversion from rationals to floats ------------------------------ - -f=: 4 : 0 - p=: (_1^x ?@$ 2) * x ?@$ y - q=: 1 + x ?@$ y - d=: (p%q) - p %&x: q - assert. 0=d - 1 -) - -(10000 4 {~ 9!:57 (0) [ 9!:57 (1)) f"0 ]2*10^2 3 9 - -f1=: 4 : 0 - p=: (_1^x ?@$ 2) * x ?@$ y - q=: 2+($p) ?@$ 20 - e=: (_1^($p) ?@$ 2)*q^x:<._350*q^.10 - d=: p - _1 x: p + e - assert. 0 = d - 1 -) - -NB. f1"0 ]10^2 3 9 -(1000 4 {~ 9!:57 (0) [ 9!:57 (1)) f1"0 ]10^2 3 - - -4!:55 ;:'e d f f1 p q' - - diff --git a/test/gxco1.ijs b/test/gxco1.ijs deleted file mode 100644 index 15e6b3fd..00000000 --- a/test/gxco1.ijs +++ /dev/null @@ -1,817 +0,0 @@ -1:@:(dbr bind Debug)@:(9!:19)2^_44[(echo^:ECHOFILENAME) './gxco1.ijs' -NB. extended precision integers ----------------------------------------- - -NB. create test data - -x1=: (1-1e4)+10 11 ?@$ 2e4-1 -y1=: (1-1e4)+10 11 ?@$ 2e4-1 -x2=: (1-1e8)+10 11 ?@$ 2e8-1 -y2=: (1-1e8)+10 11 ?@$ 2e8-1 -x3=: (1-1e9)+10 11 ?@$ 2e9-1 -y3=: (1-1e9)+10 11 ?@$ 2e9-1 - - -NB. = ------------------------------------------------------------------- - -x1 (= -: =&.x:) y1 -x1 (= -: =&.x:) y2 -x1 (= -: =&.x:) y3 -x2 (= -: =&.x:) y1 -x2 (= -: =&.x:) y2 -x2 (= -: =&.x:) y3 -0 (= -: =&.x:) y1 -0 (= -: =&.x:) y2 -0 (= -: =&.x:) y3 - -x1 (= -: =&.x:) x=:x1+($x1) ?@$ 2 -x2 (= -: =&.x:) x=:x2+($x2) ?@$ 2 -x3 (= -: =&.x:) x=:x3+($x3) ?@$ 2 - -(($x3)$0) -: x3 = ($x3)$a. -(($x3)$0) -: x3 = ($x3)$a: - -(= -: =@:x:) y1 -(= -: =@:x:) y2 -(= -: =@:x:) y3 - -(= -: =&.x:)~ y1 -(= -: =&.x:)~ y2 -(= -: =&.x:)~ y3 - -0 0 1 -: 3 3.4 4 = x: 4 -0 0 1 -: 3 3j4 4 = x: 4 -0 0 0 -: '3j4' = x: 4 -0 0 0 -: (<"0 'abc') = x: 4 - -(x1=y) -: (x: x1) = y=:x1+0.5*($x1)?@$2 -(x2=y) -: (x: x2) = y=:x2+0.5*($x2)?@$2 -(x3=y) -: (x: x3) = y=:x3+0.5*($x3)?@$2 - -(x1=y) -: (x: x1) = y=:x1+j./(2,$x1)?@$2 -(x2=y) -: (x: x2) = y=:x2+j./(2,$x1)?@$2 -(x3=y) -: (x: x3) = y=:x3+j./(2,$x1)?@$2 - - -NB. < ------------------------------------------------------------------- - -x1 (< -: <&.x:) y1 -x1 (< -: <&.x:) y2 -x1 (< -: <&.x:) y3 -x2 (< -: <&.x:) y1 -x2 (< -: <&.x:) y2 -x2 (< -: <&.x:) y3 -0 (< -: <&.x:) y1 -0 (< -: <&.x:) y2 -0 (< -: <&.x:) y3 - -x1 (< -: <&.x:) x=:x1+($x1)?@$2 -x2 (< -: <&.x:) x=:x2+($x2)?@$2 -x3 (< -: <&.x:) x=:x3+($x3)?@$2 - -(< -: <&.x:)~ y1 -(< -: <&.x:)~ y2 -(< -: <&.x:)~ y3 - -'domain error' -: (x: x1) < etx 3j4 -'domain error' -: (x: x1) < etx 'a' -'domain error' -: (x: x1) < etx <12 - - -NB. <. ------------------------------------------------------------------ - -(<. -: <.&.x:) y1 -(<. -: <.&.x:) y2 -(<. -: <.&.x:) y3 - -x1 (<. -: <.&.x:) y1 -x1 (<. -: <.&.x:) y2 -x2 (<. -: <.&.x:) y1 -x2 (<. -: <.&.x:) y2 -0 (<. -: <.&.x:) y1 -0 (<. -: <.&.x:) y2 - -'domain error' -: (x: x1) <. etx 3j4 -'domain error' -: (x: x1) <. etx 'a' -'domain error' -: (x: x1) <. etx <12 - - -NB. <: ------------------------------------------------------------------ - -(<: -: <:&.x:) y1 -(<: -: <:&.x:) y2 -(<: -: <:&.x:) y3 - -x1 (<: -: <:&.x:) y1 -x1 (<: -: <:&.x:) y2 -x2 (<: -: <:&.x:) y1 -x2 (<: -: <:&.x:) y2 -0 (<: -: <:&.x:) y1 -0 (<: -: <:&.x:) y2 - -'domain error' -: (x: x1) <: etx 3j4 -'domain error' -: (x: x1) <: etx 'a' -'domain error' -: (x: x1) <: etx <12 - - -NB. > ------------------------------------------------------------------- - -x1 (> -: >&.x:) y1 -x1 (> -: >&.x:) y2 -x1 (> -: >&.x:) y3 -x2 (> -: >&.x:) y1 -x2 (> -: >&.x:) y2 -x2 (> -: >&.x:) y3 -0 (> -: >&.x:) y1 -0 (> -: >&.x:) y2 -0 (> -: >&.x:) y3 - -x1 (> -: >&.x:) x=:x1+($x1)?@$2 -x2 (> -: >&.x:) x=:x2+($x2)?@$2 -x3 (> -: >&.x:) x=:x3+($x3)?@$2 - -(> -: >&.x:)~ y1 -(> -: >&.x:)~ y2 -(> -: >&.x:)~ y3 - -(><"0 x1) -: ><"0 x: x1 -(><"1 x1) -: ><"1 x: x1 -(><"0 x2) -: ><"0 x: x2 -(><"1 x2) -: ><"1 x: x2 -(><"0 x3) -: ><"0 x: x3 -(><"1 x3) -: ><"1 x: x3 - -(>(<"_1 x1),<"_1 y1) -: >(<"_1 x: x1),<"_1 y1 - -3.5 4 -: > 3.5; 4x -3j5 4 -: > 3j5; 4x - -'domain error' -: (x: x1) > etx 3j4 -'domain error' -: (x: x1) > etx 'a' -'domain error' -: (x: x1) > etx <12 - -'domain error' -: > etx 'abc';x: 4 -'domain error' -: > etx (<12);x: 4 - - -NB. >. ------------------------------------------------------------------ - -(>. -: >.&.x:) y1 -(>. -: >.&.x:) y2 -(>. -: >.&.x:) y3 - -x1 (>. -: >.&.x:) y1 -x1 (>. -: >.&.x:) y2 -x2 (>. -: >.&.x:) y1 -x2 (>. -: >.&.x:) y2 -0 (>. -: >.&.x:) y1 -0 (>. -: >.&.x:) y2 - -'domain error' -: (x: x1) >. etx 3j4 -'domain error' -: (x: x1) >. etx 'a' -'domain error' -: (x: x1) >. etx <12 - - -NB. >: ------------------------------------------------------------------ - -x1 (>: -: >:&.x:) y1 -x1 (>: -: >:&.x:) y2 -x1 (>: -: >:&.x:) y3 -x2 (>: -: >:&.x:) y1 -x2 (>: -: >:&.x:) y2 -x2 (>: -: >:&.x:) y3 -0 (>: -: >:&.x:) y1 -0 (>: -: >:&.x:) y2 -0 (>: -: >:&.x:) y3 - -x1 (>: -: >:&.x:) x=:x1+($x1)?@$2 -x2 (>: -: >:&.x:) x=:x2+($x2)?@$2 -x3 (>: -: >:&.x:) x=:x3+($x3)?@$2 - -(>: -: >:&.x:)~ y1 -(>: -: >:&.x:)~ y2 -(>: -: >:&.x:)~ y3 - -'domain error' -: (x: x1) >: etx 3j4 -'domain error' -: (x: x1) >: etx 'a' -'domain error' -: (x: x1) >: etx <12 - - -NB. + ------------------------------------------------------------------- - -(+ -: +&.x:) y1 -(+ -: +&.x:) y2 -(+ -: +&.x:) y3 - -x1 (+ -: +&.x:) y1 -x1 (+ -: +&.x:) y2 -x1 (+ -: +&.x:) y3 -x2 (+ -: +&.x:) y1 -x2 (+ -: +&.x:) y2 -x2 (+ -: +&.x:) y3 -x3 (+ -: +&.x:) y1 -x3 (+ -: +&.x:) y2 -x3 (+ -: +&.x:) y3 - -(x1+3.4) -: (x: x1) + 3.4 -(x1+3j4) -: (x: x1) + 3j4 - -'domain error' -: (x: x1) + etx 'a' -'domain error' -: (x: x1) + etx <12 - - -NB. +. ------------------------------------------------------------------ - -(+. -: +.&.x:) y1 -(+. -: +.&.x:) y2 -(+. -: +.&.x:) y3 - -0 1 1 1 -: 0 0 1 1 +. 0 1 0 1 - -(3.5 +. 4) -: 3.5 +. 4x -(3j5 +. 4) -: 3j5 +. 4x - -'domain error' -: (x: x1) +. etx 'a' -'domain error' -: (x: x1) +. etx <12 - - -NB. +: ------------------------------------------------------------------ - -(+: -: +:&.x:) y1 -(+: -: +:&.x:) y2 -(+: -: +:&.x:) y3 - -0 0 1 1 (+: -: +:&.x:) 0 1 0 1 - -'domain error' -: (x: 1 2 3) +: etx x: 0 1 0 -'domain error' -: (x: x1) +: etx 3.4 -'domain error' -: (x: x1) +: etx 3j4 -'domain error' -: (x: x1) +: etx 'a' -'domain error' -: (x: x1) +: etx <12 - - -NB. * ------------------------------------------------------------------- - -x1=: (1-1e4)+10 11?@$2e4-1 -y1=: (1-1e4)+10 11?@$2e4-1 -x2=: (1-1e8)+10 11?@$2e8-1 -y2=: (1-1e8)+10 11?@$2e8-1 -x3=: (1-1e9)+10 11?@$2e9-1 -y3=: (1-1e9)+10 11?@$2e9-1 - -(* -: *&.x:) y1 -(* -: *&.x:) y2 -(* -: *&.x:) y3 - -x1 (* -: *&.x:) y1 -x1 (* -: *&.x:) y2 -x1 (* -: *&.x:) y3 -x2 (* -: *&.x:) y1 -x2 (* -: *&.x:) y2 -x2 (* -: *&.x:) y3 -x3 (* -: *&.x:) y1 -x3 (* -: *&.x:) y2 -x3 (* -: *&.x:) y3 - -x=: */8192$2x -x = *~ */4096$2x -x = *~ */2048$4x -x = *~ */1024$16x -x = *~ */ 512$256x -x = *~ */ 256$65536x -x = *~ */ 128$65536x^2 -x = *~ */ 64$65536x^4 -x = *~ */ 32$65536x^8 - -y=: x: ?10$40 -(y^n) = */@(n&$)"0 y [ n=:?4000 -(y^n) = */@(n&$)"0 y [ n=:?4000 -(y^n) = */@(n&$)"0 y [ n=:?4000 - -(3.5 * 4) -: 3.5 * 4x -(3j5 * 4) -: 3j5 * 4x - -'domain error' -: (x: x1) * etx 'a' -'domain error' -: (x: x1) * etx <12 - - -NB. *. ------------------------------------------------------------------ - -x1=: (1-1e4)+10 11?@$2e4-1 -y1=: (1-1e4)+10 11?@$2e4-1 -y2=: (1-1e8)+10 11?@$2e8-1 -y3=: (1-1e9)+10 11?@$2e9-1 - -0 0 0 1 -: 0 0 1 1 *. 0 1 0 1 - -(3.5 *. 4) -: 3.5 *. 4x -(3j5 *. 4) -: 3j5 *. 4x - -'domain error' -: (x: x1) *. etx 'a' -'domain error' -: (x: x1) *. etx <12 - - -NB. *: ------------------------------------------------------------------ - -(*: -: *:&.x:) y1 -(*: -: *:&.x:) y2 -(*: -: *:&.x:) y3 - -0 0 1 1 (*: -: *:&.x:) 0 1 0 1 - -'domain error' -: (x: 1 2 3) *: etx x: 0 1 0 -'domain error' -: (x: x1) *: etx 3.4 -'domain error' -: (x: x1) *: etx 3j4 -'domain error' -: (x: x1) *: etx 'a' -'domain error' -: (x: x1) *: etx <12 - - -NB. - ------------------------------------------------------------------- - -(- -: -&.x:) y1 -(- -: -&.x:) y2 -(- -: -&.x:) y3 - -x1 (- -: -&.x:) y1 -x1 (- -: -&.x:) y2 -x1 (- -: -&.x:) y3 -x2 (- -: -&.x:) y1 -x2 (- -: -&.x:) y2 -x2 (- -: -&.x:) y3 -x3 (- -: -&.x:) y1 -x3 (- -: -&.x:) y2 -x3 (- -: -&.x:) y3 - -(x1 - 3.4) -: (x: x1) - 3.4 -(x1 - 3j4) -: (x: x1) - 3j4 - -'domain error' -: (x: x1) - etx 'a' -'domain error' -: (x: x1) - etx <12 - - -NB. % ------------------------------------------------------------------- - -(<.!.0@% -: <.@%&.x:) y1+0=y1 -(<.!.0@% -: <.@%&.x:) y2+0=y2 -(<.!.0@% -: <.@%&.x:) y3+0=y3 - -(>.!.0@% -: >.@%&.x:) y1+0=y1 -(>.!.0@% -: >.@%&.x:) y2+0=y2 -(>.!.0@% -: >.@%&.x:) y3+0=y3 - -x1 (<.!.0@% -: <.@%&.x:) y1+0=y1 -x1 (<.!.0@% -: <.@%&.x:) y2+0=y2 -x1 (<.!.0@% -: <.@%&.x:) y3+0=y3 -x2 (<.!.0@% -: <.@%&.x:) y1+0=y1 -x2 (<.!.0@% -: <.@%&.x:) y2+0=y2 -x2 (<.!.0@% -: <.@%&.x:) y3+0=y3 -x3 (<.!.0@% -: <.@%&.x:) y1+0=y1 -x3 (<.!.0@% -: <.@%&.x:) y2+0=y2 -x3 (<.!.0@% -: <.@%&.x:) y3+0=y3 - -x1 (>.!.0@% -: >.@%&.x:) y1+0=y1 -x1 (>.!.0@% -: >.@%&.x:) y2+0=y2 -x1 (>.!.0@% -: >.@%&.x:) y3+0=y3 -x2 (>.!.0@% -: >.@%&.x:) y1+0=y1 -x2 (>.!.0@% -: >.@%&.x:) y2+0=y2 -x2 (>.!.0@% -: >.@%&.x:) y3+0=y3 -x3 (>.!.0@% -: >.@%&.x:) y1+0=y1 -x3 (>.!.0@% -: >.@%&.x:) y2+0=y2 -x3 (>.!.0@% -: >.@%&.x:) y3+0=y3 - -(% -: %&.x:)~ y1 -(% -: %&.x:)~ y2 -(% -: %&.x:)~ y3 - -e=:$0 -e -: 2x % '' -e -: 2x % $0 -e -: 2x % 0$a: -e -: 2x <.@% '' -e -: 2x <.@% $0 -e -: 2x <.@% 0$a: -e -: 2x >.@% '' -e -: 2x >.@% $0 -e -: 2x >.@% 0$a: - -_ -: % x: 0 -_ -: 4 % x: 0 -__ -: _4 % x: 0 - - -NB. %: ------------------------------------------------------------------ - -0 -: %: x: 0 -5 -: %: x: 25 -(%: -: %:@x:) *~i.2 10 - -(<.!.0@%: -: <.@%:@x:) i.2 10 -(<.!.0@%: -: <.@%:@x:) 1e3*i.2 10 -(<.!.0@%: -: <.@%:@x:) 1e4*i.2 10 -(<.!.0@%: -: <.@%:@x:) 1e5*i.2 10 -(<.!.0@%: -: <.@%:@x:) 1e8*i.2 10 -(<.!.0@%: -: <.@%:@x:) 1e9*i.2 10 - -(>.!.0@%: -: >.@%:@x:) i.2 10 -(>.!.0@%: -: >.@%:@x:) 1e3*i.2 10 -(>.!.0@%: -: >.@%:@x:) 1e4*i.2 10 -(>.!.0@%: -: >.@%:@x:) 1e5*i.2 10 -(>.!.0@%: -: >.@%:@x:) 1e8*i.2 10 -(>.!.0@%: -: >.@%:@x:) 1e9*i.2 10 - -NB. 0 1 _ -: 0x %: 0 1 2x -NB. 0 1 _ -: 0 %: 0 1 2 - -f=: 3 : '((*~s)<:y)*.y<:*~1+s=.<.@%: y' - -f"0 !x:i.5 10 -f"0 (i.2 10)**/20$x:1e4 - -( %: 2) -: %: x: 2 -(<.@%: _5) -: <.@%: x: _5 -(>.@%: _5) -: >.@%: x: _5 - -root=: 4 : 0 - r=.x - a=.y - f=. ([ * (a&+)@((r-1)&*)@(^&r)) <.@% r&*@(^&r) - f^:_ [1 -) - - -NB. ^ ------------------------------------------------------------------- - -x1 (^ -: ^&.x:) y=:10 11?@$100 -x2 (^ -: ^&.x:) y -x3 (^ -: ^&.x:) y - -1 = 1^x: _3 0 3 -1 = 1^y1 -1 = 1^y2 -1 = 1^y3 -1 = 1^ 1e50 - -1 0 0 0 0 -: 0 ^ x: i.5 -(0=t) -: 0^t=:|y1 -(0=t) -: 0^t=:|y2 -(0=t) -: 0^t=:|y3 -0 -: 0^ 1e50 - -x1 (^ -: ^&.x:) t=:($x1)?@$50 -x2 (^ -: ^&.x:) t=:($x2)?@$50 -x3 (^ -: ^&.x:) t=:($x3)?@$50 - -3 (<.!.0@^ -: <.@^&x:) t=:_3+i.7 -_3 (<.!.0@^ -: <.@^&x:) t -3 (>.!.0@^ -: >.@^&x:) t=:_3+i.7 -_3 (>.!.0@^ -: >.@^&x:) t - -f=: 100&|@^ -(3 f e) -: 3 f 20|e -(4 f e) -: 4 f (10|e)+10*10: a * k - b=: b * k - k=: >:k - end. - (a*d) <.@% b -) - -e1=: 3 : 0 - (+/ , {.) */\. }. (i.y),1x -) - -x=: ^/~ 10%~i:10 -y=: ^/~ 10%~i:9 -y -: 1 1}. _1 _1}.x - - -NB. ~. ------------------------------------------------------------------ - -(~. x) -: ~. x: x=:_1e9+?100$2e9 -(~.<"0 x) -: ~.<"0 x: x - -NB. ~: ------------------------------------------------------------------ - -(x1~:y) -: (x: x1) ~: y=:x1+0.5*($x1)?@$2 -(x2~:y) -: (x: x2) ~: y=:x2+0.5*($x2)?@$2 -(x3~:y) -: (x: x3) ~: y=:x3+0.5*($x3)?@$2 - -(x1~:y) -: (x: x1) ~: y=:x1+j./(2,$x1)?@$2 -(x2~:y) -: (x: x2) ~: y=:x2+j./(2,$x1)?@$2 -(x3~:y) -: (x: x3) ~: y=:x3+j./(2,$x1)?@$2 - -1 1 0 -: 3 3.4 4 ~: x:4 -1 1 0 -: 3 3j4 4 ~: x:4 -1 1 1 -: '3j4' ~:x:4 - - -NB. | ------------------------------------------------------------------- - -(| -: |&.x:) y1 -(| -: |&.x:) y2 -(| -: |&.x:) y3 - -x1 (| -: |&.x:) y1 -x1 (| -: |&.x:) y2 -x1 (| -: |&.x:) y3 -x2 (| -: |&.x:) y1 -x2 (| -: |&.x:) y2 -x2 (| -: |&.x:) y3 -x3 (| -: |&.x:) y1 -x3 (| -: |&.x:) y2 -x3 (| -: |&.x:) y3 - -0 0 0 -: (x: _123 0 1234) | 0 - -x=: 15 15 _15 _15 -y=: 4 _4 4 _4 * x -(x|y) -: x |&.x: y - -(| -: | &.x:) y1 -(| -: | &.x:) y2 -(| -: | &.x:) y3 -(| -: | &.x:) _1e8 _1e4 0 1e4 1e8 - -(| -: | &.x:)~ y1 -(| -: | &.x:)~ y2 -(| -: | &.x:)~ y3 -(| -: | &.x:)~ _1e8 _1e4 0 1e4 1e8 - -(|/~ -: |/~@:x:) _20+i.41 -(|/~ -: |/~@:x:) 1e4+_20+i.41 -(|/~ -: |/~@:x:) 20e4+_20+i.41 -(|/~ -: |/~@:x:) 27e4+_20+i.41 -(|/~ -: |/~@:x:) (imin+i. 20),(imax-i. 20),((<.-:imin)+i: 20),((<.-:imax)+i: 20),i: 20 - -(x1 | 3.4) -: (x: x1) | etx 3.4 -(x1 | 3j4) -: (x: x1) | etx 3j4 - -'domain error' -: (x: x1) | etx 'a' -'domain error' -: (x: x1) | etx <12 - - -NB. . ------------------------------------------------------------------- - -x=: _1e6+ 5 13 ?@$ 2e6 -y=: _1e6+13 7 ?@$ 2e6 -x (+/ .* -: +/ .*&.x:) y -x (+/ .* -: +/ .*&.x:) 1 -x (+/ .* -: +/ .*&.x:) 2 -x (+/ .* -: +/@(*"1 _))&:x: y - -((x: x) +/ .* 1) -: (x: x) +/ .* 13$1 -((x: x) +/ .* 2) -: (x: x) +/ .* 13$2 - - -NB. : ------------------------------------------------------------------- - -f=: 3 : 'if. y do. ''non-zero'' else. ''zero'' end.' - -'zero' -: f 0 -'zero' -: f x: 0 - -'non-zero' -: f 12 -'non-zero' -: f x: 12 - - -NB. #. ------------------------------------------------------------------ - -(#. -: #.&:x:) x1 -(#. -: #.&:x:) x2 -(#. -: #.&:x:) x3 - -3 (#. -: #.&:x:) x1 -3 (#. -: #.&:x:) x2 -3 (#. -: #.&:x:) x3 - - -NB. #: ------------------------------------------------------------------ - -(!x:20) -: #. #: !x:20 -(!x:40) -: #. #: !x:40 -(!x:60) -: #. #: !x:60 - -(!x:20) -: 10 #. (90$10) #: !x:20 -(!x:40) -: 10 #. (90$10) #: !x:40 -(!x:60) -: 10 #. (90$10) #: !x:60 - - -NB. ! ------------------------------------------------------------------- - -min=: [ <. -~ -arg=: |.@(] - i.@min) ,. >:@i.@min -f =: (% +./)@:* -bc =: {. @ (f/) @ arg " 0 - -ind =: i.@(0&>.)@([ <. -~) -pf =: -.&0 @: , @: q: -num =: pf @ (] - ind) -den =: pf @ (1: + ind) -exp =: , +//. ,&# # 1 _1"_ -bct =: num (exp */@:x:@:# ~.@,) den - -x (! -: bct"0) 10+x=:i.11 - -bc2=: ((i.@[ -~ ]) %&(*/) >:@i.@[)&x: - -NB. 3!:x ---------------------------------------------------------------- - -y=: !x:2 10?@$200 -y -: 3!:2 (3!:1) y - - -NB. /: ------------------------------------------------------------------ - -(/: -: /:@: x:) y=:_100+2000?@$200 -(/: -: /:@:(<"0)@:x:) y -(/: -: /:@: x:) y=:_1e9+2000?@$2e9 -(/: -: /:@:(<"0)@:x:) y - -test=: 4 : '(/:(<"_1 x),<"_1 y) -: /:(<"_1 x: x),<"_1 y' - -(x=:_1e9+100 ?@$2e9) test y=: o._1e9+100 ?@$2e9 -(x=:_1e9+100 2?@$2e9) test y=: -:_1e9+100 ?@$2e9 -(x=:_1e9+100 ?@$2e9) test y=: -:_1e9+100 2?@$2e9 -(x=:_1e9+100 2?@$2e9) test y=: o._1e9+100 2?@$2e9 - - -NB. \: ------------------------------------------------------------------ - -(\: -: \:@: x:) y=:_100+2000?@$200 -(\: -: \:@:(<"0)@:x:) y -(\: -: \:@: x:) y=:_1e9+2000?@$2e9 -(\: -: \:@:(<"0)@:x:) y - -test=: 4 : '(\:(<"_1 x),<"_1 y) -: \:(<"_1 x: x),<"_1 y' - -(x=:_1e9+100 ?@$2e9) test y=: o._1e9+100 ?@$2e9 -(x=:_1e9+100 2?@$2e9) test y=: -:_1e9+100 ?@$2e9 -(x=:_1e9+100 ?@$2e9) test y=: -:_1e9+100 2?@$2e9 -(x=:_1e9+100 2?@$2e9) test y=: o._1e9+100 2?@$2e9 - - -NB. ". ------------------------------------------------------------------ - -(x: y) -: ". ;(":&.>y),&.><'x ' [ y=: +: _1e9+200?@$2e9 -(x: y) -: ". ;(":&.>y),&.><'x ' [ y=: ,y1 -(x: y) -: ". ;(":&.>y),&.><'x ' [ y=: ,y2 -(x: y) -: ". ;(":&.>y),&.><'x ' [ y=: ,y3 - -(x: 123 _99 456789) -: _99 ". '123x foo 456789' - -3.4 45 -: 3.4 ". etx '123x 45' - -'ill-formed number' -: ". etx '1234ex' -'ill-formed number' -: ". etx '123x _x x' -'ill-formed number' -: ". etx '3j4x' -'ill-formed number' -: ". etx '123.4 34x' - - -NB. extended integer comparisons ---------------------------------------- - -x=: 2 2.2 2.5 3 3.5 3.7 4 -y=: _4 _3 _2 _1 0 1 2 3 4 - -x (< -: (< x:)) 3 -x (<: -: (<: x:)) 3 -x (= -: (= x:)) 3 -x (~: -: (~: x:)) 3 -x (>: -: (>: x:)) 3 -x (> -: (> x:)) 3 - -(-x) (< -: (< x:)) _3 -(-x) (<: -: (<: x:)) _3 -(-x) (= -: (= x:)) _3 -(-x) (~: -: (~: x:)) _3 -(-x) (>: -: (>: x:)) _3 -(-x) (> -: (> x:)) _3 - -(x,-x) (< / -: (< x:)"0/) y -(x,-x) (<:/ -: (<: x:)"0/) y -(x,-x) (= / -: (= x:)"0/) y -(x,-x) (~:/ -: (~: x:)"0/) y -(x,-x) (>:/ -: (>: x:)"0/) y -(x,-x) (> / -: (> x:)"0/) y - -3 (< -: x:@[ < ]) x -3 (<: -: x:@[ <: ]) x -3 (= -: x:@[ = ]) x -3 (~: -: x:@[ ~: ]) x -3 (>: -: x:@[ >: ]) x -3 (> -: x:@[ > ]) x - -_3 (< -: x:@[ < ]) -x -_3 (<: -: x:@[ <: ]) -x -_3 (= -: x:@[ = ]) -x -_3 (~: -: x:@[ ~: ]) -x -_3 (>: -: x:@[ >: ]) -x -_3 (> -: x:@[ > ]) -x - -y (< / -: (x:@[ < ])"0/) x,-x -y (<:/ -: (x:@[ <: ])"0/) x,-x -y (= / -: (x:@[ = ])"0/) x,-x -y (~:/ -: (x:@[ ~: ])"0/) x,-x -y (>:/ -: (x:@[ >: ])"0/) x,-x -y (> / -: (x:@[ > ])"0/) x,-x - -x=: 10?@$20 -y=: 0.5*20?@$40 -(x i. y) -: (x: x) i. y -(y i. x) -: y i. x: x - - -NB. A. ------------------------------------------------------------------ - -(<: ! #y) = A. |. y=:i.50 - -'index error' -: ( !50x) A. etx i.50 -'index error' -: (->:!50x) A. etx i.50 - - -NB. e. ------------------------------------------------------------------ - -x=:1000?@$500 -y=:0.25 * 1200?@$2000 - -(x e. y) -: (x: x) e. y -(y e. x) -: y e. x: x - - -NB. i. ------------------------------------------------------------------ - -(type -: type@i.) x: 5 -(type -: type@i.) x: 0 -(type -: type@i.) x: 4 5 -(type -: type@i.) x: _4 5 -(type -: type@i.) x: 4 0 - -(x:@i. -: i.@:x:) 5 -(x:@i. -: i.@:x:) 4 5 -(x:@i. -: i.@:x:) _4 5 - -x=:_1e9+400?@$2e9 -y=:x+0.5*($x)?@$2 - -(x i. y) -: (x: x) i. y -(y i. x) -: y i. x: x - -(x i. x) -: (<"0 x: x) i. <"0 x -(x i. x) -: (<"0 x) i. <"0 x: x -(x i. x) -: (<"0 x: x) i. <"0 x: x - -(x i. y) -: (<"0 x: x) i. <"0 y - -NB. j. ------------------------------------------------------------------ - -(j. x: x1) -: j. x1 - - -NB. p. ------------------------------------------------------------------ - -x=: _100+7?@$200 -c=: _100+? 200 - -(c;x) (p. -: x:^:_1@(p.x:)) y1 -(c;x) (p. -: x:^:_1@(p.x:)) y2 -(c;x) (p. -: x:^:_1@(p.x:)) y3 - -x (p. -: x:^:_1@:p.&:x:) y1 -x (p. -: x:^:_1@:p.&:x:) y2 -x (p. -: x:^:_1@:p.&:x:) y3 - -NB. q: ------------------------------------------------------------------ - -f=: 3 : 0 - x=: q: y - (y=*/x: x) *. *./x e. p:i.>:p:^:_1 {:x -) - -f !20x - -18 8 4 2 1 1 1 1 -: _ q: !20 -(!20x) -: */ (p: i.#x)^x:x=: _ q: !20x - -H =: %@>:@(+/~)@i. NB. Hilbert matrix -det=: -/ .* - -4!:55 ;:'arg bc bc2 bct c den det e e0 e1 exp f H ind min n' -4!:55 ;:'num pf root t test x x1 x2 x3 y y1 y2 y3' - - diff --git a/test/gxco2.ijs b/test/gxco2.ijs deleted file mode 100644 index c361ea6a..00000000 --- a/test/gxco2.ijs +++ /dev/null @@ -1,54 +0,0 @@ -1:@:(dbr bind Debug)@:(9!:19)2^_44[(echo^:ECHOFILENAME) './gxco2.ijs' -NB. extended precision integers ----------------------------------------- - -NB. create test data - -x1=: (1-1e4)+10 11 ?@$ 2e4-1 -y1=: (1-1e4)+10 11 ?@$ 2e4-1 -x2=: (1-1e8)+10 11 ?@$ 2e8-1 -y2=: (1-1e8)+10 11 ?@$ 2e8-1 -x3=: (1-1e9)+10 11 ?@$ 2e9-1 -y3=: (1-1e9)+10 11 ?@$ 2e9-1 - - -NB. o. ------------------------------------------------------------------ - -0x = o. 0x -0x = <.@o. 0x -0x = >.@o. 0x - -0 -: o. x: 0 -0 -: <.@o. x: 0 -0 -: >.@o. x: 0 - -f=: }:@":@(<.@o.) -g=: (<.&# {. [) -: (<.&# {. ]) - -(10x^ 50) g&f 10x^300 -(10x^100) g&f 10x^300 -(10x^150) g&f 10x^300 -(10x^200) g&f 10x^300 - -(o. 1) -: o. 1x -(o. _2) -: o. _2x - -( 0 o. 5) -: 0 o. x: 5 -( 1 o. 5) -: 1 o. x: 5 -( 2 o. 5) -: 2 o. x: 5 -( 3 o. 5) -: 3 o. x: 5 -( 4 o. 5) -: 4 o. x: 5 -( 5 o. 5) -: 5 o. x: 5 -( 6 o. 5) -: 6 o. x: 5 -( 7 o. 5) -: 7 o. x: 5 -(_1 o. 5) -: _1 o. x: 5 -(_2 o. 5) -: _2 o. x: 5 -(_3 o. 5) -: _3 o. x: 5 -(_4 o. 5) -: _4 o. x: 5 -(_5 o. 5) -: _5 o. x: 5 -(_6 o. 5) -: _6 o. x: 5 -(_7 o. 5) -: _7 o. x: 5 - - -4!:55 ;:'f g x x1 x2 x3 y y1 y2 y3' - - diff --git a/test/gxinf.ijs b/test/gxinf.ijs deleted file mode 100644 index f094f1c5..00000000 --- a/test/gxinf.ijs +++ /dev/null @@ -1,251 +0,0 @@ -1:@:(dbr bind Debug)@:(9!:19)2^_44[(echo^:ECHOFILENAME) './gxinf.ijs' -NB. x: and infinity ----------------------------------------------------- - -match=: -:&(3!:1) -xi =: x:^:_1 - -( 64=type x), 5 _ -: x=: 5x _ -( 128=type x), 5 _ -: x=: 5r1 _ - -(128 -: type x), _ 1r2 match x=:x: _ 0.5 -(128 -: type x), __ 1r2 match x=:x: __ 0.5 - -(8 -: type x), _ __ 225 match x=:xi _ __ 225x -(8 -: type x), _ __ 2 match x=:xi _ __ 2x -(8 -: type x), _ __ 0.5 match x=:xi _ __ 1r2 - -0r1 -: 5r_ -0r1 -: _5r_ - -'ill-formed number' -: ex ' _r_ ' -'ill-formed number' -: ex ' _r__' -'ill-formed number' -: ex '__r_ ' -'ill-formed number' -: ex '__r__' - - -NB. infinite integers and rationals and comparatives -------------------- - -_ 5x = _ 5x -__ 5x = __ 5x -_ 5r1 = _ 5r1 -__ 5r1 = __ 5r1 -_ 5x = _ 5r1 -__ 5x = __ 5r1 - -0 0 -: _ 2x = 99999x -0 0 -: _ 2x = _99999x -0 0 -: __ 2x = 99999x -0 0 -: __ 2x = _99999x - -pinf=: {. _ 5x -ninf=: {. __ 5x - -pinf > ninf -pinf > _99999x -pinf > - 10^100x -pinf > 0x -pinf > 99999x -pinf > 10^100x - -( 10^100x) > ninf -99999x > ninf -0x > ninf -_99999x > ninf -(- 10^100x) > ninf - --. pinf > pinf --. ( 10^100x) > pinf --. (-10^100x) > pinf --. ninf > pinf --. ninf > 0x --. ninf > ninf - -pinf >: ninf -pinf >: _99999x -pinf >: - 10^100x -pinf >: 0x -pinf >: 99999x -pinf >: 10^100x -pinf >: pinf - -( 10^100x) >: ninf -99999x >: ninf -0x >: ninf -_99999x >: ninf -(- 10^100x) >: ninf -ninf >: ninf - --. ( 10^100x) >: pinf --. (-10^100x) >: pinf --. ninf >: pinf --. ninf >: 0x - - -NB. infinite integers and rationals and primitives ---------------------- - -_ 5x match _ 2x + _ 3x -_ 5x match _ 2x + 5 3x -_ 5x match _ 2x + _5 3x -__ 5x match __ 2x + __ 3x -__ 5x match __ 2x + 5 3x -__ 5x match __ 2x + _5 3x - -_ 5r2 match _ 2r2 + _ 3r2 -_ 5r2 match _ 2r2 + 5 3r2 -_ 5r2 match _ 2r2 + _5 3r2 -__ 5r2 match __ 2r2 + __ 3r2 -__ 5r2 match __ 2r2 + 5 3r2 -__ 5r2 match __ 2r2 + _5 3r2 - -'NaN error' -: _ 2x + etx __ 5x -'NaN error' -: _ 2r1 + etx __ 5r4 -'NaN error' -: __ 2x + etx _ 5x -'NaN error' -: __ 2r1 + etx _ 5r4 - - -y=: }. 5x _ __ -'NaN error' -: y +. etx 12x -'NaN error' -: y +. etx _12x -'NaN error' -: 12x +. etx y -'NaN error' -: _12x +. etx y -'NaN error' -: y +. etx y -'NaN error' -: y +. etx |.y - -y=: }. 5r1 _ __ -'NaN error' -: y +. etx 12x -'NaN error' -: y +. etx _12x -'NaN error' -: 12x +. etx y -'NaN error' -: _12x +. etx y -'NaN error' -: y +. etx y -'NaN error' -: y +. etx |.y - -_ 5x match _ 8x - __ 3x -_ 5x match _ 8x - 5 3x -_ 5x match _ 8x - _5 3x -__ 5x match __ 8x - _ 3x -__ 5x match __ 8x - 5 3x -__ 5x match __ 8x - _5 3x - -__ _5x match _ 8x -~__ 3x -__ _5x match _ 8x -~ 5 3x -__ _5x match _ 8x -~_5 3x -_ _5x match __ 8x -~ _ 3x -_ _5x match __ 8x -~ 5 3x -_ _5x match __ 8x -~_5 3x - -_ 5r2 match _ 8r2 - __ 3r2 -_ 5r2 match _ 8r2 - 5 3r2 -_ 5r2 match _ 8r2 - _5 3r2 -__ 5r2 match __ 8r2 - _ 3r2 -__ 5r2 match __ 8r2 - 5 3r2 -__ 5r2 match __ 8r2 - _5 3r2 - -__ _5r2 match _ 8r2 -~__ 3r2 -__ _5r2 match _ 8r2 -~ 5 3r2 -__ _5r2 match _ 8r2 -~_5 3r2 -_ _5r2 match __ 8r2 -~ _ 3r2 -_ _5r2 match __ 8r2 -~ 5 3r2 -_ _5r2 match __ 8r2 -~_5 3r2 - -'NaN error' -: _ 2x - etx _ 5x -'NaN error' -: _ 2r1 - etx _ 5r4 -'NaN error' -: __ 2x - etx __ 5x -'NaN error' -: __ 2r1 - etx __ 5r4 - - -_1 = * {. __ 2x -_1 = * {. __ 2r3 -1 = * {. _ 2x -1 = * {. _ 2r3 - -0 0 -: 0 * _ 2x -0 0 -: 0 * __ 2x -0 0 -: 0 * _ 2r5 -0 0 -: 0 * __ 2r5 - - -y=: }. 5x _ __ -'NaN error' -: y *. etx 12x -'NaN error' -: y *. etx _12x -'NaN error' -: 12x *. etx y -'NaN error' -: _12x *. etx y - -x=: {. _ 5x -y=: {. __ 5x - -'NaN error' -: x *. etx x -'NaN error' -: x *. etx y -'NaN error' -: y *. etx x -'NaN error' -: y *. etx y - -y=: }. 5r1 _ __ -'NaN error' -: y *. etx 1r2 -'NaN error' -: y *. etx _1r2 -'NaN error' -: 1r2 *. etx y -'NaN error' -: _1r2 *. etx y - -x=: {. _ 5r2 -y=: {. __ 5r2 - -'NaN error' -: x *. etx x -'NaN error' -: x *. etx y -'NaN error' -: y *. etx x -'NaN error' -: y *. etx y - - 5r0 -: %0x -_5r0 -: -%0x - 5r0 -: %0r1 -_5r0 -: -%0r1 - -x=: {. _ 5x -(64=type y), x = y=: 5x % 0x -(64=type y),(-x) = y=: _5x % 0x -(64=type y), 0x = y=: 5x % x -(64=type y), 0x = y=: _5x % x - -x=: {. _ 5x -y=: {. __ 5x -'NaN error' -: x % etx x -'NaN error' -: x % etx y -'NaN error' -: y % etx x -'NaN error' -: y % etx y - -x=: {. _ 5r2 -y=: {. __ 5r2 -'NaN error' -: x % etx x -'NaN error' -: x % etx y -'NaN error' -: y % etx x -'NaN error' -: y % etx y - - -pinf = | pinf,ninf - -y=: }. 2x _ __ -(<'NaN error') = 5 _5x | etx&.>/ y -(2 2$5 _ __ _5x) -: y |/ 5 _5x -y -: 0x | y - -y=: }. 2r3 _ __ -(<'NaN error') = 5 _5r1 |etx&.>/ y -(2 2$5 _ __ _5r1) -: y |/ 5 _5r1 -y -: 0r1 | y - -_ 2 match ! _ 2 - -( 64 -: type x), '_ __ 5' -: ": x=:_ __ 5x -(128 -: type x), '_ __ 5r3' -: ": x=:_ __ 5r3 - -'domain error' -: p: etx {. _ 12x -'domain error' -: p: etx {. __ 12x -'domain error' -: p: etx {. _ 12r7 -'domain error' -: p: etx {. __ 12r7 - -'domain error' -: q: etx {. _ 12x -'domain error' -: q: etx {. __ 12x -'domain error' -: q: etx {. _ 12r7 -'domain error' -: q: etx {. __ 12r7 - - -4!:55 ;:'match ninf pinf x xi y' - - From 931bd6823c08d4618cd1e2bfc980bdbb94f13fdb Mon Sep 17 00:00:00 2001 From: Juho Eerola Date: Sun, 7 Mar 2021 04:31:48 +0200 Subject: [PATCH 38/39] Remove unused XNUM conversion functions --- jsrc/conversions.cpp | 17 ----------------- 1 file changed, 17 deletions(-) diff --git a/jsrc/conversions.cpp b/jsrc/conversions.cpp index 936b540f..60bc4f59 100644 --- a/jsrc/conversions.cpp +++ b/jsrc/conversions.cpp @@ -196,12 +196,6 @@ jtxd1(J jt, double p, int64_t mode) -> X { EPILOG(z); } -template <> -[[nodiscard]] auto -convert(J jt, array w, void *yv, int64_t mode) -> bool { - return convert(jt, w, yv, [=](auto v) { return jtxd1(jt, v, mode); }) && !jt->jerr; -} - template <> [[nodiscard]] auto convert(J jt, array w, void *yv) -> bool { @@ -232,17 +226,6 @@ convert(J jt, array w, void *yv) -> bool { }); } -template <> -[[nodiscard]] auto -convert(J jt, array w, void *yv) -> bool { - return convert(jt, w, yv, [](auto p) { - auto const c = pointer_to_values(p)[AN(p) - 1]; - if (c == XPINF) { return inf; } - if (c == XNINF) { return infm; } - return value_from_X(p); - }); -} - template <> [[nodiscard]] auto convert(J jt, array w, void *yv) -> bool { From 0e095fed3e73908797eb4a6ca1c61ed5d9f9d21d Mon Sep 17 00:00:00 2001 From: Juho Eerola Date: Mon, 8 Mar 2021 04:41:42 +0200 Subject: [PATCH 39/39] Make conversion to XNUM error in jtxco1() --- jsrc/conversions.cpp | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/jsrc/conversions.cpp b/jsrc/conversions.cpp index 60bc4f59..6dcc4891 100644 --- a/jsrc/conversions.cpp +++ b/jsrc/conversions.cpp @@ -569,7 +569,8 @@ jtcvt0(J jt, array w) -> array { auto jtxco1(J jt, array w) -> array { ASSERT(AT(w) & DENSE, EVNONCE); - return jtcvt(jt, AT(w) & (B01 + INT + XNUM) ? XNUM : RAT, w); + ASSERT(!(AT(w) & (B01 + INT + XNUM)), EVDOMAIN); + return jtcvt(jt, RAT, w); } auto