From 8a62c742e6e22a9548f37a66433d42d2e108058e Mon Sep 17 00:00:00 2001 From: primo-ppcg Date: Fri, 30 Jun 2023 16:15:04 +0700 Subject: [PATCH] define `(mod x 0)` as `x` See: Knuth, Donald E., _The Art of Computer Programming: Volume 1: Fundamental Algorithms_, pp. 15 ([link](https://books.google.com/books?id=x9AsAwAAQBAJ&pg=PA15)) --- src/core/corelib.c | 9 ++++--- src/core/inttypes.c | 59 ++++++++++++++++++++++++++------------------- src/core/vm.c | 8 ++++-- 3 files changed, 45 insertions(+), 31 deletions(-) diff --git a/src/core/corelib.c b/src/core/corelib.c index 46a078e1..4b326496 100644 --- a/src/core/corelib.c +++ b/src/core/corelib.c @@ -1173,11 +1173,12 @@ JanetTable *janet_core_env(JanetTable *replacements) { "the reciprocal of x. Otherwise return the first value of xs repeatedly divided by the remaining " "values.")); templatize_varop(env, JANET_FUN_MODULO, "mod", 0, 1, JOP_MODULO, - JDOC("(mod dividend divisor)\n\n" - "Returns the modulo of dividend / divisor.")); + JDOC("(mod & xs)\n\n" + "Returns the result of applying the modulo operator on the first value of xs with each remaining value. " + "`(mod x 0)` is defined to be `x`.")); templatize_varop(env, JANET_FUN_REMAINDER, "%", 0, 1, JOP_REMAINDER, - JDOC("(% dividend divisor)\n\n" - "Returns the remainder of dividend / divisor.")); + JDOC("(% & xs)\n\n" + "Returns the remainder of dividing the first value of xs by each remaining value.")); templatize_varop(env, JANET_FUN_BAND, "band", -1, -1, JOP_BAND, JDOC("(band & xs)\n\n" "Returns the bit-wise and of all values in xs. Each x in xs must be an integer.")); diff --git a/src/core/inttypes.c b/src/core/inttypes.c index 3910a866..c576e89d 100644 --- a/src/core/inttypes.c +++ b/src/core/inttypes.c @@ -431,7 +431,7 @@ static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \ } \ #define OPMETHODINVERT(T, type, name, oper) \ -static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \ +static Janet cfun_it_##type##_##name##i(int32_t argc, Janet *argv) { \ janet_fixarity(argc, 2); \ T *box = janet_abstract(&janet_##type##_type, sizeof(T)); \ *box = janet_unwrap_##type(argv[1]); \ @@ -440,6 +440,11 @@ static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \ return janet_wrap_abstract(box); \ } \ +#define DIVZERO(name) DIVZERO_##name +#define DIVZERO_div janet_panic("division by zero") +#define DIVZERO_rem janet_panic("division by zero") +#define DIVZERO_mod return janet_wrap_abstract(box) + #define DIVMETHOD(T, type, name, oper) \ static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \ janet_arity(argc, 2, -1); \ @@ -447,19 +452,19 @@ static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \ *box = janet_unwrap_##type(argv[0]); \ for (int32_t i = 1; i < argc; i++) { \ T value = janet_unwrap_##type(argv[i]); \ - if (value == 0) janet_panic("division by zero"); \ + if (value == 0) DIVZERO(name); \ *box oper##= value; \ } \ return janet_wrap_abstract(box); \ } \ #define DIVMETHODINVERT(T, type, name, oper) \ -static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \ +static Janet cfun_it_##type##_##name##i(int32_t argc, Janet *argv) { \ janet_fixarity(argc, 2); \ T *box = janet_abstract(&janet_##type##_type, sizeof(T)); \ *box = janet_unwrap_##type(argv[1]); \ T value = janet_unwrap_##type(argv[0]); \ - if (value == 0) janet_panic("division by zero"); \ + if (value == 0) DIVZERO(name); \ *box oper##= value; \ return janet_wrap_abstract(box); \ } \ @@ -471,7 +476,7 @@ static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \ *box = janet_unwrap_##type(argv[0]); \ for (int32_t i = 1; i < argc; i++) { \ T value = janet_unwrap_##type(argv[i]); \ - if (value == 0) janet_panic("division by zero"); \ + if (value == 0) DIVZERO(name); \ if ((value == -1) && (*box == INT64_MIN)) janet_panic("INT64_MIN divided by -1"); \ *box oper##= value; \ } \ @@ -479,12 +484,12 @@ static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \ } \ #define DIVMETHODINVERT_SIGNED(T, type, name, oper) \ -static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \ +static Janet cfun_it_##type##_##name##i(int32_t argc, Janet *argv) { \ janet_fixarity(argc, 2); \ T *box = janet_abstract(&janet_##type##_type, sizeof(T)); \ *box = janet_unwrap_##type(argv[1]); \ T value = janet_unwrap_##type(argv[0]); \ - if (value == 0) janet_panic("division by zero"); \ + if (value == 0) DIVZERO(name); \ if ((value == -1) && (*box == INT64_MIN)) janet_panic("INT64_MIN divided by -1"); \ *box oper##= value; \ return janet_wrap_abstract(box); \ @@ -517,11 +522,12 @@ static Janet cfun_it_s64_mod(int32_t argc, Janet *argv) { int64_t *box = janet_abstract(&janet_s64_type, sizeof(int64_t)); int64_t op1 = janet_unwrap_s64(argv[0]); int64_t op2 = janet_unwrap_s64(argv[1]); - if (op2 == 0) janet_panic("division by zero"); - int64_t x = op1 % op2; - *box = (op1 > 0) - ? ((op2 > 0) ? x : (0 == x ? x : x + op2)) - : ((op2 > 0) ? (0 == x ? x : x + op2) : x); + if (op2 == 0) { + *box = op1; + } else { + int64_t x = op1 % op2; + *box = (((op1 ^ op2) < 0) && (x != 0)) ? x + op2 : x; + } return janet_wrap_abstract(box); } @@ -530,22 +536,23 @@ static Janet cfun_it_s64_modi(int32_t argc, Janet *argv) { int64_t *box = janet_abstract(&janet_s64_type, sizeof(int64_t)); int64_t op2 = janet_unwrap_s64(argv[0]); int64_t op1 = janet_unwrap_s64(argv[1]); - if (op2 == 0) janet_panic("division by zero"); - int64_t x = op1 % op2; - *box = (op1 > 0) - ? ((op2 > 0) ? x : (0 == x ? x : x + op2)) - : ((op2 > 0) ? (0 == x ? x : x + op2) : x); + if (op2 == 0) { + *box = op1; + } else { + int64_t x = op1 % op2; + *box = (((op1 ^ op2) < 0) && (x != 0)) ? x + op2 : x; + } return janet_wrap_abstract(box); } OPMETHOD(int64_t, s64, add, +) OPMETHOD(int64_t, s64, sub, -) -OPMETHODINVERT(int64_t, s64, subi, -) +OPMETHODINVERT(int64_t, s64, sub, -) OPMETHOD(int64_t, s64, mul, *) DIVMETHOD_SIGNED(int64_t, s64, div, /) DIVMETHOD_SIGNED(int64_t, s64, rem, %) -DIVMETHODINVERT_SIGNED(int64_t, s64, divi, /) -DIVMETHODINVERT_SIGNED(int64_t, s64, remi, %) +DIVMETHODINVERT_SIGNED(int64_t, s64, div, /) +DIVMETHODINVERT_SIGNED(int64_t, s64, rem, %) OPMETHOD(int64_t, s64, and, &) OPMETHOD(int64_t, s64, or, |) OPMETHOD(int64_t, s64, xor, ^) @@ -553,12 +560,14 @@ OPMETHOD(int64_t, s64, lshift, <<) OPMETHOD(int64_t, s64, rshift, >>) OPMETHOD(uint64_t, u64, add, +) OPMETHOD(uint64_t, u64, sub, -) -OPMETHODINVERT(uint64_t, u64, subi, -) +OPMETHODINVERT(uint64_t, u64, sub, -) OPMETHOD(uint64_t, u64, mul, *) DIVMETHOD(uint64_t, u64, div, /) +DIVMETHOD(uint64_t, u64, rem, %) DIVMETHOD(uint64_t, u64, mod, %) -DIVMETHODINVERT(uint64_t, u64, divi, /) -DIVMETHODINVERT(uint64_t, u64, modi, %) +DIVMETHODINVERT(uint64_t, u64, div, /) +DIVMETHODINVERT(uint64_t, u64, rem, %) +DIVMETHODINVERT(uint64_t, u64, mod, %) OPMETHOD(uint64_t, u64, and, &) OPMETHOD(uint64_t, u64, or, |) OPMETHOD(uint64_t, u64, xor, ^) @@ -610,8 +619,8 @@ static JanetMethod it_u64_methods[] = { {"rdiv", cfun_it_u64_divi}, {"mod", cfun_it_u64_mod}, {"rmod", cfun_it_u64_modi}, - {"%", cfun_it_u64_mod}, - {"r%", cfun_it_u64_modi}, + {"%", cfun_it_u64_rem}, + {"r%", cfun_it_u64_remi}, {"&", cfun_it_u64_and}, {"r&", cfun_it_u64_and}, {"|", cfun_it_u64_or}, diff --git a/src/core/vm.c b/src/core/vm.c index e013fc78..cdc932ce 100644 --- a/src/core/vm.c +++ b/src/core/vm.c @@ -709,8 +709,12 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) { if (janet_checktype(op1, JANET_NUMBER) && janet_checktype(op2, JANET_NUMBER)) { double x1 = janet_unwrap_number(op1); double x2 = janet_unwrap_number(op2); - double intres = x2 * floor(x1 / x2); - stack[A] = janet_wrap_number(x1 - intres); + if (x2 == 0) { + stack[A] = janet_wrap_number(x1); + } else { + double intres = x2 * floor(x1 / x2); + stack[A] = janet_wrap_number(x1 - intres); + } vm_pcnext(); } else { vm_commit();