mirror of
https://github.com/janet-lang/janet
synced 2024-06-24 22:23:15 +00:00
Add righthand operator overloading.
This is like python. Now, we just need to readd fuzzy comparisons to have what python needs. Overloading math functions would be neat, too.
This commit is contained in:
Calvin Rose
parent
2f9ed8a572
commit
4fe005e3c3
|
|
@ -207,6 +207,15 @@ static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
|
|||
return janet_wrap_abstract(box); \
|
||||
} \
|
||||
|
||||
#define OPMETHODINVERT(T, type, name, oper) \
|
||||
static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
|
||||
janet_fixarity(argc, 2); \
|
||||
T *box = janet_abstract(&it_##type##_type, sizeof(T)); \
|
||||
*box = janet_unwrap_##type(argv[1]); \
|
||||
*box oper##= janet_unwrap_##type(argv[0]); \
|
||||
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); \
|
||||
|
|
@ -220,6 +229,17 @@ static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
|
|||
return janet_wrap_abstract(box); \
|
||||
} \
|
||||
|
||||
#define DIVMETHODINVERT(T, type, name, oper) \
|
||||
static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
|
||||
janet_fixarity(argc, 2); \
|
||||
T *box = janet_abstract(&it_##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"); \
|
||||
*box oper##= value; \
|
||||
return janet_wrap_abstract(box); \
|
||||
} \
|
||||
|
||||
#define DIVMETHOD_SIGNED(T, type, name, oper) \
|
||||
static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
|
||||
janet_arity(argc, 2, -1); \
|
||||
|
|
@ -234,6 +254,18 @@ static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
|
|||
return janet_wrap_abstract(box); \
|
||||
} \
|
||||
|
||||
#define DIVMETHODINVERT_SIGNED(T, type, name, oper) \
|
||||
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[1]); \
|
||||
T value = janet_unwrap_##type(argv[0]); \
|
||||
if (value == 0) janet_panic("division by zero"); \
|
||||
if ((value == -1) && (*box == INT64_MIN)) janet_panic("INT64_MIN divided by -1"); \
|
||||
*box oper##= value; \
|
||||
return janet_wrap_abstract(box); \
|
||||
} \
|
||||
|
||||
#define COMPMETHOD(T, type, name, oper) \
|
||||
static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
|
||||
janet_fixarity(argc, 2); \
|
||||
|
|
@ -244,9 +276,12 @@ static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
|
|||
|
||||
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, %)
|
||||
DIVMETHODINVERT_SIGNED(int64_t, s64, divi, /)
|
||||
DIVMETHODINVERT_SIGNED(int64_t, s64, modi, %)
|
||||
OPMETHOD(int64_t, s64, and, &)
|
||||
OPMETHOD(int64_t, s64, or, |)
|
||||
OPMETHOD(int64_t, s64, xor, ^)
|
||||
|
|
@ -261,9 +296,12 @@ COMPMETHOD(int64_t, s64, ne, !=)
|
|||
|
||||
OPMETHOD(uint64_t, u64, add, +)
|
||||
OPMETHOD(uint64_t, u64, sub, -)
|
||||
OPMETHODINVERT(uint64_t, u64, subi, -)
|
||||
OPMETHOD(uint64_t, u64, mul, *)
|
||||
DIVMETHOD(uint64_t, u64, div, /)
|
||||
DIVMETHOD(uint64_t, u64, mod, %)
|
||||
DIVMETHODINVERT(uint64_t, u64, divi, /)
|
||||
DIVMETHODINVERT(uint64_t, u64, modi, %)
|
||||
OPMETHOD(uint64_t, u64, and, &)
|
||||
OPMETHOD(uint64_t, u64, or, |)
|
||||
OPMETHOD(uint64_t, u64, xor, ^)
|
||||
|
|
@ -283,10 +321,15 @@ COMPMETHOD(uint64_t, u64, ne, !=)
|
|||
|
||||
static JanetMethod it_s64_methods[] = {
|
||||
{"+", cfun_it_s64_add},
|
||||
{"r+", cfun_it_s64_add},
|
||||
{"-", cfun_it_s64_sub},
|
||||
{"r-", cfun_it_s64_subi},
|
||||
{"*", cfun_it_s64_mul},
|
||||
{"r*", cfun_it_s64_mul},
|
||||
{"/", cfun_it_s64_div},
|
||||
{"r/", cfun_it_s64_divi},
|
||||
{"%", cfun_it_s64_mod},
|
||||
{"r%", cfun_it_s64_modi},
|
||||
{"<", cfun_it_s64_lt},
|
||||
{">", cfun_it_s64_gt},
|
||||
{"<=", cfun_it_s64_le},
|
||||
|
|
@ -294,8 +337,11 @@ static JanetMethod it_s64_methods[] = {
|
|||
{"=", cfun_it_s64_eq},
|
||||
{"!=", cfun_it_s64_ne},
|
||||
{"&", cfun_it_s64_and},
|
||||
{"r&", cfun_it_s64_and},
|
||||
{"|", cfun_it_s64_or},
|
||||
{"r|", cfun_it_s64_or},
|
||||
{"^", cfun_it_s64_xor},
|
||||
{"r^", cfun_it_s64_xor},
|
||||
{"<<", cfun_it_s64_lshift},
|
||||
{">>", cfun_it_s64_rshift},
|
||||
|
||||
|
|
@ -304,10 +350,15 @@ static JanetMethod it_s64_methods[] = {
|
|||
|
||||
static JanetMethod it_u64_methods[] = {
|
||||
{"+", cfun_it_u64_add},
|
||||
{"r+", cfun_it_u64_add},
|
||||
{"-", cfun_it_u64_sub},
|
||||
{"r-", cfun_it_u64_subi},
|
||||
{"*", cfun_it_u64_mul},
|
||||
{"r*", cfun_it_u64_mul},
|
||||
{"/", cfun_it_u64_div},
|
||||
{"r/", cfun_it_u64_divi},
|
||||
{"%", cfun_it_u64_mod},
|
||||
{"r%", cfun_it_u64_modi},
|
||||
{"<", cfun_it_u64_lt},
|
||||
{">", cfun_it_u64_gt},
|
||||
{"<=", cfun_it_u64_le},
|
||||
|
|
@ -315,8 +366,11 @@ static JanetMethod it_u64_methods[] = {
|
|||
{"=", cfun_it_u64_eq},
|
||||
{"!=", cfun_it_u64_ne},
|
||||
{"&", cfun_it_u64_and},
|
||||
{"r&", cfun_it_u64_and},
|
||||
{"|", cfun_it_u64_or},
|
||||
{"r|", cfun_it_u64_or},
|
||||
{"^", cfun_it_u64_xor},
|
||||
{"r^", cfun_it_u64_xor},
|
||||
{"<<", cfun_it_u64_lshift},
|
||||
{">>", cfun_it_u64_rshift},
|
||||
|
||||
|
|
|
|||
133
src/core/vm.c
133
src/core/vm.c
|
|
@ -118,12 +118,11 @@ JANET_THREAD_LOCAL jmp_buf *janet_vm_jmp_buf = NULL;
|
|||
#define vm_binop_immediate(op)\
|
||||
{\
|
||||
Janet op1 = stack[B];\
|
||||
vm_assert_type(op1, JANET_NUMBER);\
|
||||
if (!janet_checktype(op1, JANET_NUMBER)) {\
|
||||
vm_commit();\
|
||||
Janet _argv[2] = { op1, janet_wrap_number(CS) };\
|
||||
stack[A] = janet_mcall(#op, 2, _argv);\
|
||||
vm_pcnext();\
|
||||
vm_checkgc_pcnext();\
|
||||
} else {\
|
||||
double x1 = janet_unwrap_number(op1);\
|
||||
stack[A] = janet_wrap_number(x1 op CS);\
|
||||
|
|
@ -133,10 +132,16 @@ JANET_THREAD_LOCAL jmp_buf *janet_vm_jmp_buf = NULL;
|
|||
#define _vm_bitop_immediate(op, type1)\
|
||||
{\
|
||||
Janet op1 = stack[B];\
|
||||
vm_assert_type(op1, JANET_NUMBER);\
|
||||
type1 x1 = (type1) janet_unwrap_integer(op1);\
|
||||
stack[A] = janet_wrap_integer(x1 op CS);\
|
||||
vm_pcnext();\
|
||||
if (!janet_checktype(op1, JANET_NUMBER)) {\
|
||||
vm_commit();\
|
||||
Janet _argv[2] = { op1, janet_wrap_number(CS) };\
|
||||
stack[A] = janet_mcall(#op, 2, _argv);\
|
||||
vm_checkgc_pcnext();\
|
||||
} else {\
|
||||
type1 x1 = (type1) janet_unwrap_integer(op1);\
|
||||
stack[A] = janet_wrap_integer(x1 op CS);\
|
||||
vm_pcnext();\
|
||||
}\
|
||||
}
|
||||
#define vm_bitop_immediate(op) _vm_bitop_immediate(op, int32_t);
|
||||
#define vm_bitopu_immediate(op) _vm_bitop_immediate(op, uint32_t);
|
||||
|
|
@ -144,17 +149,15 @@ JANET_THREAD_LOCAL jmp_buf *janet_vm_jmp_buf = NULL;
|
|||
{\
|
||||
Janet op1 = stack[B];\
|
||||
Janet op2 = stack[C];\
|
||||
if (!janet_checktype(op1, JANET_NUMBER)) {\
|
||||
vm_commit();\
|
||||
Janet _argv[2] = { op1, op2 };\
|
||||
stack[A] = janet_mcall(#op, 2, _argv);\
|
||||
vm_pcnext();\
|
||||
} else {\
|
||||
vm_assert_type(op2, JANET_NUMBER);\
|
||||
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] = wrap(x1 op x2);\
|
||||
vm_pcnext();\
|
||||
} else {\
|
||||
vm_commit();\
|
||||
stack[A] = janet_binop_call(#op, "r" #op, op1, op2);\
|
||||
vm_checkgc_pcnext();\
|
||||
}\
|
||||
}
|
||||
#define vm_binop(op) _vm_binop(op, janet_wrap_number)
|
||||
|
|
@ -162,12 +165,16 @@ JANET_THREAD_LOCAL jmp_buf *janet_vm_jmp_buf = NULL;
|
|||
{\
|
||||
Janet op1 = stack[B];\
|
||||
Janet op2 = stack[C];\
|
||||
vm_assert_type(op1, JANET_NUMBER);\
|
||||
vm_assert_type(op2, JANET_NUMBER);\
|
||||
type1 x1 = (type1) janet_unwrap_integer(op1);\
|
||||
int32_t x2 = janet_unwrap_integer(op2);\
|
||||
stack[A] = janet_wrap_integer(x1 op x2);\
|
||||
vm_pcnext();\
|
||||
if (janet_checktype(op1, JANET_NUMBER) && janet_checktype(op2, JANET_NUMBER)) {\
|
||||
type1 x1 = (type1) janet_unwrap_integer(op1);\
|
||||
int32_t x2 = janet_unwrap_integer(op2);\
|
||||
stack[A] = janet_wrap_integer(x1 op x2);\
|
||||
vm_pcnext();\
|
||||
} else {\
|
||||
vm_commit();\
|
||||
stack[A] = janet_binop_call(#op, "r" #op, op1, op2);\
|
||||
vm_checkgc_pcnext();\
|
||||
}\
|
||||
}
|
||||
#define vm_bitop(op) _vm_bitop(op, int32_t)
|
||||
#define vm_bitopu(op) _vm_bitop(op, uint32_t)
|
||||
|
|
@ -175,15 +182,15 @@ JANET_THREAD_LOCAL jmp_buf *janet_vm_jmp_buf = NULL;
|
|||
{\
|
||||
Janet op1 = stack[B];\
|
||||
Janet op2 = stack[C];\
|
||||
if (!janet_checktype(op1, JANET_NUMBER) || !janet_checktype(op2, JANET_NUMBER)) {\
|
||||
vm_commit();\
|
||||
stack[A] = janet_wrap_boolean(janet_compare(op1, op2) op 0);\
|
||||
vm_pcnext();\
|
||||
} else {\
|
||||
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_boolean(x1 op x2);\
|
||||
vm_pcnext();\
|
||||
} else {\
|
||||
vm_commit();\
|
||||
stack[A] = janet_wrap_boolean(janet_compare(op1, op2) op 0);\
|
||||
vm_checkgc_pcnext();\
|
||||
}\
|
||||
}
|
||||
|
||||
|
|
@ -240,6 +247,60 @@ static Janet resolve_method(Janet name, JanetFiber *fiber) {
|
|||
return callee;
|
||||
}
|
||||
|
||||
/* Lookup method on value x */
|
||||
static Janet janet_method_lookup(Janet x, const char *name) {
|
||||
Janet kname = janet_ckeywordv(name);
|
||||
switch (janet_type(x)) {
|
||||
default:
|
||||
return janet_wrap_nil();
|
||||
case JANET_ABSTRACT: {
|
||||
Janet method;
|
||||
void *abst = janet_unwrap_abstract(x);
|
||||
JanetAbstractType *type = (JanetAbstractType *)janet_abstract_type(abst);
|
||||
if (!type->get || !(type->get)(abst, kname, &method)) {
|
||||
return janet_wrap_nil();
|
||||
} else {
|
||||
return method;
|
||||
}
|
||||
}
|
||||
case JANET_TABLE:
|
||||
return janet_table_get(janet_unwrap_table(x), kname);
|
||||
case JANET_STRUCT:
|
||||
return janet_struct_get(janet_unwrap_struct(x), kname);
|
||||
}
|
||||
}
|
||||
|
||||
/* Invoke a method once we have looked it up */
|
||||
static Janet janet_method_invoke(Janet method, int32_t argc, Janet *argv) {
|
||||
if (janet_checktype(method, JANET_CFUNCTION)) {
|
||||
return (janet_unwrap_cfunction(method))(argc, argv);
|
||||
} else if (janet_checktype(method, JANET_FUNCTION)) {
|
||||
JanetFunction *fun = janet_unwrap_function(method);
|
||||
return janet_call(fun, argc, argv);
|
||||
} else {
|
||||
janet_panicf("method is not callable: %v", method);
|
||||
}
|
||||
}
|
||||
|
||||
/* Call a method first on the righthand side, and then on the left hand side with a prefix */
|
||||
static Janet janet_binop_call(const char *lmethod, const char *rmethod, Janet lhs, Janet rhs) {
|
||||
Janet lm = janet_method_lookup(lhs, lmethod);
|
||||
if (janet_checktype(lm, JANET_NIL)) {
|
||||
/* Invert order for rmethod */
|
||||
Janet lr = janet_method_lookup(rhs, rmethod);
|
||||
Janet argv[2] = { rhs, lhs };
|
||||
if (janet_checktype(lr, JANET_NIL)) {
|
||||
janet_panicf("could not find method :%s for %v, or :%s for %v",
|
||||
lmethod, lhs,
|
||||
rmethod, rhs);
|
||||
}
|
||||
return janet_method_invoke(lr, 2, argv);
|
||||
} else {
|
||||
Janet argv[2] = { lhs, rhs };
|
||||
return janet_method_invoke(lm, 2, argv);
|
||||
}
|
||||
}
|
||||
|
||||
/* Interpreter main loop */
|
||||
static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
|
||||
|
||||
|
|
@ -1248,30 +1309,12 @@ Janet janet_mcall(const char *name, int32_t argc, Janet *argv) {
|
|||
/* At least 1 argument */
|
||||
if (argc < 1) janet_panicf("method :%s expected at least 1 argument");
|
||||
/* Find method */
|
||||
Janet method;
|
||||
if (janet_checktype(argv[0], JANET_ABSTRACT)) {
|
||||
void *abst = janet_unwrap_abstract(argv[0]);
|
||||
JanetAbstractType *type = (JanetAbstractType *)janet_abstract_type(abst);
|
||||
if (!type->get || !(type->get)(abst, janet_ckeywordv(name), &method))
|
||||
janet_panicf("abstract value %v does not implement :%s", argv[0], name);
|
||||
} else if (janet_checktype(argv[0], JANET_TABLE)) {
|
||||
JanetTable *table = janet_unwrap_table(argv[0]);
|
||||
method = janet_table_get(table, janet_ckeywordv(name));
|
||||
} else if (janet_checktype(argv[0], JANET_STRUCT)) {
|
||||
const JanetKV *st = janet_unwrap_struct(argv[0]);
|
||||
method = janet_struct_get(st, janet_ckeywordv(name));
|
||||
} else {
|
||||
Janet method = janet_method_lookup(argv[0], name);
|
||||
if (janet_checktype(method, JANET_NIL)) {
|
||||
janet_panicf("could not find method :%s for %v", name, argv[0]);
|
||||
}
|
||||
/* Invoke method */
|
||||
if (janet_checktype(method, JANET_CFUNCTION)) {
|
||||
return (janet_unwrap_cfunction(method))(argc, argv);
|
||||
} else if (janet_checktype(method, JANET_FUNCTION)) {
|
||||
JanetFunction *fun = janet_unwrap_function(method);
|
||||
return janet_call(fun, argc, argv);
|
||||
} else {
|
||||
janet_panicf("method %s has unexpected value %v", name, method);
|
||||
}
|
||||
return janet_method_invoke(method, argc, argv);
|
||||
}
|
||||
|
||||
/* Setup VM */
|
||||
|
|
|
|||
|
|
@ -164,6 +164,11 @@
|
|||
(defn test-expand [path temp]
|
||||
(string (module/expand-path path temp)))
|
||||
|
||||
# Right hand operators
|
||||
(assert (= (int/s64 (sum (range 10))) (sum (map int/s64 (range 10)))) "right hand operators 1")
|
||||
(assert (= (int/s64 (product (range 1 10))) (product (map int/s64 (range 1 10)))) "right hand operators 2")
|
||||
(assert (= (int/s64 15) (bor 10 (int/s64 5)) (bor (int/s64 10) 5)) "right hand operators 3")
|
||||
|
||||
(assert (= (test-expand "abc" ":cur:/:all:") "some-dir/abc") "module/expand-path 1")
|
||||
(assert (= (test-expand "./abc" ":cur:/:all:") "some-dir/abc") "module/expand-path 2")
|
||||
(assert (= (test-expand "abc/def.txt" ":cur:/:name:") "some-dir/def.txt") "module/expand-path 3")
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user