mirrors/janet
1
0
Fork 0
mirror of https://github.com/janet-lang/janet synced 2024-12-25 16:00:27 +00:00
Code Issues 1 Releases Wiki Activity

Add mod function to core.

Browse Source 
The `mod` function is a pair function with `%`, or te remainder
function and is distinct from it. This is taken from common lisp.
This commit is contained in:
Calvin Rose 2020-01-23 18:54:30 -06:00
parent b8d530da36
commit 28d41039b8
9 changed files with 108 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
src/core/asm.c
View File

@ -108,6 +108,7 @@ static const JanetInstructionDef janet_ops[] = {
{"mkstu", JOP_MAKE_STRUCT},
{"mktab", JOP_MAKE_TABLE},
{"mktup", JOP_MAKE_TUPLE},
{"mod", JOP_MODULO},
{"movf", JOP_MOVE_FAR},
{"movn", JOP_MOVE_NEAR},
{"mul", JOP_MULTIPLY},
@ -121,6 +122,7 @@ static const JanetInstructionDef janet_ops[] = {
{"pusha", JOP_PUSH_ARRAY},
{"put", JOP_PUT},
{"puti", JOP_PUT_INDEX},
{"rem", JOP_REMAINDER},
{"res", JOP_RESUME},
{"ret", JOP_RETURN},
{"retn", JOP_RETURN_NIL},

2
src/core/bytecode.c
View File

@ -41,6 +41,8 @@ enum JanetInstructionType janet_instructions[JOP_INSTRUCTION_COUNT] = {
JINT_SSS, /* JOP_MULTIPLY, */
JINT_SSI, /* JOP_DIVIDE_IMMEDIATE, */
JINT_SSS, /* JOP_DIVIDE, */
JINT_SSS, /* JOP_MODULO, */
JINT_SSS, /* JOP_REMAINDER, */
JINT_SSS, /* JOP_BAND, */
JINT_SSS, /* JOP_BOR, */
JINT_SSS, /* JOP_BXOR, */

10
src/core/cfuns.c
View File

@ -115,6 +115,12 @@ static JanetSlot do_get(JanetFopts opts, JanetSlot *args) {
static JanetSlot do_next(JanetFopts opts, JanetSlot *args) {
return opreduce(opts, args, JOP_NEXT, janet_wrap_nil());
}
static JanetSlot do_modulo(JanetFopts opts, JanetSlot *args) {
return opreduce(opts, args, JOP_MODULO, janet_wrap_nil());
}
static JanetSlot do_remainder(JanetFopts opts, JanetSlot *args) {
return opreduce(opts, args, JOP_REMAINDER, janet_wrap_nil());
}
static JanetSlot do_put(JanetFopts opts, JanetSlot *args) {
if (opts.flags & JANET_FOPTS_DROP) {
janetc_emit_sss(opts.compiler, JOP_PUT, args[0], args[1], args[2], 0);
@ -287,7 +293,9 @@ static const JanetFunOptimizer optimizers[] = {
{NULL, do_neq},
{fixarity2, do_propagate},
{fixarity2, do_get},
{fixarity2, do_next}
{fixarity2, do_next},
{fixarity2, do_modulo},
{fixarity2, do_remainder},
};
const JanetFunOptimizer *janetc_funopt(uint32_t flags) {

2
src/core/compile.h
View File

@ -58,6 +58,8 @@
#define JANET_FUN_PROP 26
#define JANET_FUN_GET 27
#define JANET_FUN_NEXT 28
#define JANET_FUN_MODULO 29
#define JANET_FUN_REMAINDER 30
/* Compiler typedefs */
typedef struct JanetCompiler JanetCompiler;

16
src/core/corelib.c
View File

@ -931,6 +931,14 @@ static const uint32_t next_asm[] = {
JOP_NEXT | (1 << 24),
JOP_RETURN
};
static const uint32_t modulo_asm[] = {
JOP_MODULO | (1 << 24),
JOP_RETURN
};
static const uint32_t remainder_asm[] = {
JOP_REMAINDER | (1 << 24),
JOP_RETURN
};
#endif /* ifdef JANET_BOOTSTRAP */
/*
@ -973,6 +981,14 @@ static void janet_load_libs(JanetTable *env) {
JanetTable *janet_core_env(JanetTable *replacements) {
JanetTable *env = (NULL != replacements) ? replacements : janet_table(0);
janet_quick_asm(env, JANET_FUN_MODULO,
"mod", 2, 2, 2, 2, modulo_asm, sizeof(modulo_asm),
JDOC("(mod dividend divisor)\n\n"
"Returns the modulo of dividend / divisor."));
janet_quick_asm(env, JANET_FUN_REMAINDER,
"%", 2, 2, 2, 2, remainder_asm, sizeof(remainder_asm),
JDOC("(% dividend divisor)\n\n"
"Returns the remainder of dividend / divisor."));
janet_quick_asm(env, JANET_FUN_NEXT,
"next", 2, 2, 2, 2, next_asm, sizeof(next_asm),
JDOC("(next ds &opt key)\n\n"

47
src/core/inttypes.c
View File

@ -202,7 +202,7 @@ static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
janet_arity(argc, 2, -1); \
T *box = janet_abstract(&it_##type##_type, sizeof(T)); \
*box = janet_unwrap_##type(argv[0]); \
for (int i = 1; i < argc; i++) \
for (int32_t i = 1; i < argc; i++) \
*box oper##= janet_unwrap_##type(argv[i]); \
return janet_wrap_abstract(box); \
} \
@ -221,7 +221,7 @@ static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
janet_arity(argc, 2, -1); \
T *box = janet_abstract(&it_##type##_type, sizeof(T)); \
*box = janet_unwrap_##type(argv[0]); \
for (int i = 1; i < argc; i++) { \
for (int32_t i = 1; i < argc; i++) { \
T value = janet_unwrap_##type(argv[i]); \
if (value == 0) janet_panic("division by zero"); \
*box oper##= value; \
@ -245,7 +245,7 @@ static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
janet_arity(argc, 2, -1); \
T *box = janet_abstract(&it_##type##_type, sizeof(T)); \
*box = janet_unwrap_##type(argv[0]); \
for (int i = 1; i < argc; i++) { \
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 == -1) && (*box == INT64_MIN)) janet_panic("INT64_MIN divided by -1"); \
@ -274,14 +274,43 @@ static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
return janet_wrap_boolean(v1 oper v2); \
}
static Janet cfun_it_s64_mod(int32_t argc, Janet *argv) {
janet_arity(argc, 2, -1);
int64_t *box = janet_abstract(&it_s64_type, sizeof(int64_t));
*box = janet_unwrap_s64(argv[0]);
for (int32_t i = 1; i < argc; i++) {
int64_t value = janet_unwrap_s64(argv[i]);
if (value == 0) janet_panic("division by zero");
int64_t x = *box % value;
if (x < 0) {
x = (*box < 0) ? x - *box : x + *box;
}
*box = x;
}
return janet_wrap_abstract(box);
}
static Janet cfun_it_s64_modi(int32_t argc, Janet *argv) {
janet_fixarity(argc, 2);
int64_t *box = janet_abstract(&it_s64_type, sizeof(int64_t));
int64_t op1 = janet_unwrap_s64(argv[0]);
int64_t op2 = janet_unwrap_s64(argv[1]);
int64_t x = op1 % op2;
if (x < 0) {
x = (op1 < 0) ? x - op1 : x + op1;
}
*box = x;
return janet_wrap_abstract(box);
}
OPMETHOD(int64_t, s64, add, +)
OPMETHOD(int64_t, s64, sub, -)
OPMETHODINVERT(int64_t, s64, subi, -)
OPMETHOD(int64_t, s64, mul, *)
DIVMETHOD_SIGNED(int64_t, s64, div, /)
DIVMETHOD_SIGNED(int64_t, s64, mod, %)
DIVMETHOD_SIGNED(int64_t, s64, rem, %)
DIVMETHODINVERT_SIGNED(int64_t, s64, divi, /)
DIVMETHODINVERT_SIGNED(int64_t, s64, modi, %)
DIVMETHODINVERT_SIGNED(int64_t, s64, remi, %)
OPMETHOD(int64_t, s64, and, &)
OPMETHOD(int64_t, s64, or, |)
OPMETHOD(int64_t, s64, xor, ^)
@ -328,8 +357,10 @@ static JanetMethod it_s64_methods[] = {
{"r*", cfun_it_s64_mul},
{"/", cfun_it_s64_div},
{"r/", cfun_it_s64_divi},
{"%", cfun_it_s64_mod},
{"r%", cfun_it_s64_modi},
{"mod", cfun_it_s64_mod},
{"rmod", cfun_it_s64_modi},
{"%", cfun_it_s64_rem},
{"r%", cfun_it_s64_remi},
{"<", cfun_it_s64_lt},
{">", cfun_it_s64_gt},
{"<=", cfun_it_s64_le},
@ -357,6 +388,8 @@ static JanetMethod it_u64_methods[] = {
{"r*", cfun_it_u64_mul},
{"/", cfun_it_u64_div},
{"r/", 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_lt},

12
src/core/math.c
View File

@ -223,13 +223,6 @@ static Janet janet_srand(int32_t argc, Janet *argv) {
return janet_wrap_nil();
}
static Janet janet_remainder(int32_t argc, Janet *argv) {
janet_fixarity(argc, 2);
double x = janet_getnumber(argv, 0);
double y = janet_getnumber(argv, 1);
return janet_wrap_number(fmod(x, y));
}
#define JANET_DEFINE_MATHOP(name, fop)\
static Janet janet_##name(int32_t argc, Janet *argv) {\
janet_fixarity(argc, 1); \
@ -281,11 +274,6 @@ static Janet janet_not(int32_t argc, Janet *argv) {
}
static const JanetReg math_cfuns[] = {
{
"%", janet_remainder,
JDOC("(% dividend divisor)\n\n"
"Returns the remainder of dividend / divisor.")
},
{
"not", janet_not,
JDOC("(not x)\n\nReturns the boolean inverse of x.")

37
src/core/vm.c
View File

@ -305,6 +305,8 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
&&label_JOP_MULTIPLY,
&&label_JOP_DIVIDE_IMMEDIATE,
&&label_JOP_DIVIDE,
&&label_JOP_MODULO,
&&label_JOP_REMAINDER,
&&label_JOP_BAND,
&&label_JOP_BOR,
&&label_JOP_BXOR,
@ -545,8 +547,6 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
&&label_unknown_op,
&&label_unknown_op,
&&label_unknown_op,
&&label_unknown_op,
&&label_unknown_op,
&&label_unknown_op
};
#endif
@ -642,6 +642,39 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
VM_OP(JOP_DIVIDE)
vm_binop( /);
VM_OP(JOP_MODULO)
{
Janet op1 = stack[B];
Janet op2 = stack[C];
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);
vm_pcnext();
} else {
vm_commit();
stack[A] = janet_binop_call("mod", "rmod", op1, op2);
vm_checkgc_pcnext();
}
}
VM_OP(JOP_REMAINDER)
{
Janet op1 = stack[B];
Janet op2 = stack[C];
if (janet_checktype(op1, JANET_NUMBER) && janet_checktype(op2, JANET_NUMBER)) {
double x1 = janet_unwrap_number(op1);
double x2 = janet_unwrap_number(op2);
stack[A] = janet_wrap_number(fmod(x1, x2));
vm_pcnext();
} else {
vm_commit();
stack[A] = janet_binop_call("%", "r%", op1, op2);
vm_checkgc_pcnext();
}
}
VM_OP(JOP_BAND)
vm_bitop(&);

2
src/include/janet.h
View File

@ -1024,6 +1024,8 @@ enum JanetOpCode {
JOP_MULTIPLY,
JOP_DIVIDE_IMMEDIATE,
JOP_DIVIDE,
JOP_MODULO,
JOP_REMAINDER,
JOP_BAND,
JOP_BOR,
JOP_BXOR,