mirrors/janet
1
0
Fork 0
mirror of https://github.com/janet-lang/janet synced 2024-11-28 11:09:54 +00:00
Code Issues 1 Releases Wiki Activity

define (mod x 0) as x

Browse Source 
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))
This commit is contained in:
primo-ppcg 2023-06-30 16:15:04 +07:00
parent c83f3ec097
commit 8a62c742e6
3 changed files with 45 additions and 31 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
src/core/corelib.c
View File

@ -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 " "the reciprocal of x. Otherwise return the first value of xs repeatedly divided by the remaining "
"values.")); "values."));
templatize_varop(env, JANET_FUN_MODULO, "mod", 0, 1, JOP_MODULO, templatize_varop(env, JANET_FUN_MODULO, "mod", 0, 1, JOP_MODULO,
JDOC("(mod dividend divisor)\n\n" JDOC("(mod & xs)\n\n"
"Returns the modulo of dividend / divisor.")); "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, templatize_varop(env, JANET_FUN_REMAINDER, "%", 0, 1, JOP_REMAINDER,
JDOC("(% dividend divisor)\n\n" JDOC("(% & xs)\n\n"
"Returns the remainder of dividend / divisor.")); "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, templatize_varop(env, JANET_FUN_BAND, "band", -1, -1, JOP_BAND,
JDOC("(band & xs)\n\n" JDOC("(band & xs)\n\n"
"Returns the bit-wise and of all values in xs. Each x in xs must be an integer.")); "Returns the bit-wise and of all values in xs. Each x in xs must be an integer."));

59
src/core/inttypes.c
View File

@ -431,7 +431,7 @@ static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
} \ } \
#define OPMETHODINVERT(T, type, name, oper) \ #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); \ janet_fixarity(argc, 2); \
T *box = janet_abstract(&janet_##type##_type, sizeof(T)); \ T *box = janet_abstract(&janet_##type##_type, sizeof(T)); \
*box = janet_unwrap_##type(argv[1]); \ *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); \ 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) \ #define DIVMETHOD(T, type, name, oper) \
static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \ static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
janet_arity(argc, 2, -1); \ 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]); \ *box = janet_unwrap_##type(argv[0]); \
for (int32_t i = 1; i < argc; i++) { \ for (int32_t i = 1; i < argc; i++) { \
T value = janet_unwrap_##type(argv[i]); \ T value = janet_unwrap_##type(argv[i]); \
if (value == 0) janet_panic("division by zero"); \ if (value == 0) DIVZERO(name); \
*box oper##= value; \ *box oper##= value; \
} \ } \
return janet_wrap_abstract(box); \ return janet_wrap_abstract(box); \
} \ } \
#define DIVMETHODINVERT(T, type, name, oper) \ #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); \ janet_fixarity(argc, 2); \
T *box = janet_abstract(&janet_##type##_type, sizeof(T)); \ T *box = janet_abstract(&janet_##type##_type, sizeof(T)); \
*box = janet_unwrap_##type(argv[1]); \ *box = janet_unwrap_##type(argv[1]); \
T value = janet_unwrap_##type(argv[0]); \ T value = janet_unwrap_##type(argv[0]); \
if (value == 0) janet_panic("division by zero"); \ if (value == 0) DIVZERO(name); \
*box oper##= value; \ *box oper##= value; \
return janet_wrap_abstract(box); \ 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]); \ *box = janet_unwrap_##type(argv[0]); \
for (int32_t i = 1; i < argc; i++) { \ for (int32_t i = 1; i < argc; i++) { \
T value = janet_unwrap_##type(argv[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"); \ if ((value == -1) && (*box == INT64_MIN)) janet_panic("INT64_MIN divided by -1"); \
*box oper##= value; \ *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) \ #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); \ janet_fixarity(argc, 2); \
T *box = janet_abstract(&janet_##type##_type, sizeof(T)); \ T *box = janet_abstract(&janet_##type##_type, sizeof(T)); \
*box = janet_unwrap_##type(argv[1]); \ *box = janet_unwrap_##type(argv[1]); \
T value = janet_unwrap_##type(argv[0]); \ 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"); \ if ((value == -1) && (*box == INT64_MIN)) janet_panic("INT64_MIN divided by -1"); \
*box oper##= value; \ *box oper##= value; \
return janet_wrap_abstract(box); \ 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 *box = janet_abstract(&janet_s64_type, sizeof(int64_t));
int64_t op1 = janet_unwrap_s64(argv[0]); int64_t op1 = janet_unwrap_s64(argv[0]);
int64_t op2 = janet_unwrap_s64(argv[1]); int64_t op2 = janet_unwrap_s64(argv[1]);
if (op2 == 0) janet_panic("division by zero"); if (op2 == 0) {
int64_t x = op1 % op2; *box = op1;
*box = (op1 > 0) } else {
? ((op2 > 0) ? x : (0 == x ? x : x + op2)) int64_t x = op1 % op2;
: ((op2 > 0) ? (0 == x ? x : x + op2) : x); *box = (((op1 ^ op2) < 0) && (x != 0)) ? x + op2 : x;
}
return janet_wrap_abstract(box); 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 *box = janet_abstract(&janet_s64_type, sizeof(int64_t));
int64_t op2 = janet_unwrap_s64(argv[0]); int64_t op2 = janet_unwrap_s64(argv[0]);
int64_t op1 = janet_unwrap_s64(argv[1]); int64_t op1 = janet_unwrap_s64(argv[1]);
if (op2 == 0) janet_panic("division by zero"); if (op2 == 0) {
int64_t x = op1 % op2; *box = op1;
*box = (op1 > 0) } else {
? ((op2 > 0) ? x : (0 == x ? x : x + op2)) int64_t x = op1 % op2;
: ((op2 > 0) ? (0 == x ? x : x + op2) : x); *box = (((op1 ^ op2) < 0) && (x != 0)) ? x + op2 : x;
}
return janet_wrap_abstract(box); return janet_wrap_abstract(box);
} }
OPMETHOD(int64_t, s64, add, +) OPMETHOD(int64_t, s64, add, +)
OPMETHOD(int64_t, s64, sub, -) OPMETHOD(int64_t, s64, sub, -)
OPMETHODINVERT(int64_t, s64, subi, -) OPMETHODINVERT(int64_t, s64, sub, -)
OPMETHOD(int64_t, s64, mul, *) OPMETHOD(int64_t, s64, mul, *)
DIVMETHOD_SIGNED(int64_t, s64, div, /) DIVMETHOD_SIGNED(int64_t, s64, div, /)
DIVMETHOD_SIGNED(int64_t, s64, rem, %) DIVMETHOD_SIGNED(int64_t, s64, rem, %)
DIVMETHODINVERT_SIGNED(int64_t, s64, divi, /) DIVMETHODINVERT_SIGNED(int64_t, s64, div, /)
DIVMETHODINVERT_SIGNED(int64_t, s64, remi, %) DIVMETHODINVERT_SIGNED(int64_t, s64, rem, %)
OPMETHOD(int64_t, s64, and, &) OPMETHOD(int64_t, s64, and, &)
OPMETHOD(int64_t, s64, or, |) OPMETHOD(int64_t, s64, or, |)
OPMETHOD(int64_t, s64, xor, ^) OPMETHOD(int64_t, s64, xor, ^)
@ -553,12 +560,14 @@ OPMETHOD(int64_t, s64, lshift, <<)
OPMETHOD(int64_t, s64, rshift, >>) OPMETHOD(int64_t, s64, rshift, >>)
OPMETHOD(uint64_t, u64, add, +) OPMETHOD(uint64_t, u64, add, +)
OPMETHOD(uint64_t, u64, sub, -) OPMETHOD(uint64_t, u64, sub, -)
OPMETHODINVERT(uint64_t, u64, subi, -) OPMETHODINVERT(uint64_t, u64, sub, -)
OPMETHOD(uint64_t, u64, mul, *) OPMETHOD(uint64_t, u64, mul, *)
DIVMETHOD(uint64_t, u64, div, /) DIVMETHOD(uint64_t, u64, div, /)
DIVMETHOD(uint64_t, u64, rem, %)
DIVMETHOD(uint64_t, u64, mod, %) DIVMETHOD(uint64_t, u64, mod, %)
DIVMETHODINVERT(uint64_t, u64, divi, /) DIVMETHODINVERT(uint64_t, u64, div, /)
DIVMETHODINVERT(uint64_t, u64, modi, %) DIVMETHODINVERT(uint64_t, u64, rem, %)
DIVMETHODINVERT(uint64_t, u64, mod, %)
OPMETHOD(uint64_t, u64, and, &) OPMETHOD(uint64_t, u64, and, &)
OPMETHOD(uint64_t, u64, or, |) OPMETHOD(uint64_t, u64, or, |)
OPMETHOD(uint64_t, u64, xor, ^) OPMETHOD(uint64_t, u64, xor, ^)
@ -610,8 +619,8 @@ static JanetMethod it_u64_methods[] = {
{"rdiv", cfun_it_u64_divi}, {"rdiv", cfun_it_u64_divi},
{"mod", cfun_it_u64_mod}, {"mod", cfun_it_u64_mod},
{"rmod", cfun_it_u64_modi}, {"rmod", cfun_it_u64_modi},
{"%", cfun_it_u64_mod}, {"%", cfun_it_u64_rem},
{"r%", cfun_it_u64_modi}, {"r%", cfun_it_u64_remi},
{"&", cfun_it_u64_and}, {"&", cfun_it_u64_and},
{"r&", cfun_it_u64_and}, {"r&", cfun_it_u64_and},
{"|", cfun_it_u64_or}, {"|", cfun_it_u64_or},

8
src/core/vm.c
View File

@ -709,8 +709,12 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
if (janet_checktype(op1, JANET_NUMBER) && janet_checktype(op2, JANET_NUMBER)) { if (janet_checktype(op1, JANET_NUMBER) && janet_checktype(op2, JANET_NUMBER)) {
double x1 = janet_unwrap_number(op1); double x1 = janet_unwrap_number(op1);
double x2 = janet_unwrap_number(op2); double x2 = janet_unwrap_number(op2);
double intres = x2 * floor(x1 / x2); if (x2 == 0) {
stack[A] = janet_wrap_number(x1 - intres); stack[A] = janet_wrap_number(x1);
} else {
double intres = x2 * floor(x1 / x2);
stack[A] = janet_wrap_number(x1 - intres);
}
vm_pcnext(); vm_pcnext();
} else { } else {
vm_commit(); vm_commit();